From f877e124a20d4f94c82c36e6b7a99b4e9663e204 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 10 Nov 2020 15:50:27 +1100 Subject: [PATCH 001/503] fetch magic on the first stacked filetest, not the last fixes #18293 --- pp_sys.c | 2 +- t/op/filetest.t | 10 +++++++++- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/pp_sys.c b/pp_sys.c index 66c5d9aade65..5c9f768eaf9d 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3067,7 +3067,7 @@ S_try_amagic_ftest(pTHX_ char chr) { SV *const arg = *PL_stack_sp; assert(chr != '?'); - if (!(PL_op->op_private & OPpFT_STACKING)) SvGETMAGIC(arg); + if (!(PL_op->op_private & OPpFT_STACKED)) SvGETMAGIC(arg); if (SvAMAGIC(arg)) { diff --git a/t/op/filetest.t b/t/op/filetest.t index fe9724c59ab1..7c471c050c8e 100644 --- a/t/op/filetest.t +++ b/t/op/filetest.t @@ -9,7 +9,7 @@ BEGIN { set_up_inc(qw '../lib ../cpan/Perl-OSType/lib'); } -plan(tests => 57 + 27*14); +plan(tests => 58 + 27*14); if ($^O =~ /MSWin32|cygwin|msys/ && !is_miniperl) { require Win32; # for IsAdminUser() @@ -385,3 +385,11 @@ SKIP: { ok(!-f "TEST\0-", '-f on name with \0'); ok(!-r "TEST\0-", '-r on name with \0'); } + +{ + # github #18293 + "" =~ /(.*)/; + my $x = $1; # call magic on $1, setting the pv to "" + "test.pl" =~ /(.*)/; + ok(-f -r $1, "stacked handles on a name with magic"); +} From 03d1b1167a106ef32c5b3ed83d1ded4ee98f9673 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Thu, 12 Nov 2020 19:55:04 +0000 Subject: [PATCH 002/503] Update ExtUtils-MakeMaker to CPAN version 7.54 [DELTA] 7.54 Thu 12 Nov 19:23:18 GMT 2020 No changes since v7.53_01 7.53_01 Tue 10 Nov 03:34:42 GMT 2020 Regression fixes: - Fixed Darwin cflags override Meta fixes: - Updated URLs to use https --- Porting/Maintainers.pl | 2 +- .../lib/ExtUtils/Command.pm | 2 +- .../lib/ExtUtils/Command/MM.pm | 2 +- .../lib/ExtUtils/Liblist.pm | 2 +- .../lib/ExtUtils/Liblist/Kid.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm | 2 +- .../lib/ExtUtils/MM_BeOS.pm | 2 +- .../lib/ExtUtils/MM_Cygwin.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm | 2 +- .../lib/ExtUtils/MM_Darwin.pm | 23 ++++++++++++++----- .../lib/ExtUtils/MM_MacOS.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm | 2 +- .../lib/ExtUtils/MM_OS390.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm | 2 +- .../lib/ExtUtils/MM_UWIN.pm | 2 +- .../lib/ExtUtils/MM_Unix.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm | 2 +- .../lib/ExtUtils/MM_Win32.pm | 2 +- .../lib/ExtUtils/MM_Win95.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm | 2 +- .../lib/ExtUtils/MakeMaker.pm | 2 +- .../lib/ExtUtils/MakeMaker/Config.pm | 2 +- .../lib/ExtUtils/MakeMaker/FAQ.pod | 2 +- .../lib/ExtUtils/MakeMaker/Locale.pm | 2 +- .../lib/ExtUtils/MakeMaker/Tutorial.pod | 2 +- .../lib/ExtUtils/MakeMaker/version.pm | 2 +- .../lib/ExtUtils/MakeMaker/version/regex.pm | 2 +- .../lib/ExtUtils/Mkbootstrap.pm | 2 +- .../lib/ExtUtils/Mksymlists.pm | 2 +- .../lib/ExtUtils/testlib.pm | 2 +- 34 files changed, 50 insertions(+), 39 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 8d9f5c7b20ff..61a7125b40f6 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -467,7 +467,7 @@ package Maintainers; }, 'ExtUtils::MakeMaker' => { - 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.52.tar.gz', + 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.54.tar.gz', 'FILES' => q[cpan/ExtUtils-MakeMaker], 'EXCLUDED' => [ qr{^t/lib/Test/}, diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm index 6bbe48fcc418..f38e2e71a7cb 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm @@ -8,7 +8,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '7.52'; +$VERSION = '7.54'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm index 9aa734f2ad24..19646f6ba32e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm @@ -10,7 +10,7 @@ our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist test_s cp_nonempty); -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm index 4e7435fdfc65..247da71d0302 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm @@ -3,7 +3,7 @@ package ExtUtils::Liblist; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use File::Spec; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm index 196abfcbc6ab..1292db500da9 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm @@ -11,7 +11,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm index 37952fc8091c..6d3057c9dd52 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm @@ -4,7 +4,7 @@ use strict; use warnings; use ExtUtils::MakeMaker::Config; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::Liblist; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm index b469bb20811e..5d9a0b68a909 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_AIX; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm index 9fbdc793cd23..d5fc51d7a5a8 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_Any; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use Carp; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm index 09b11630be2e..9bc31c658ccf 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm @@ -27,7 +27,7 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm index 42790061bc6d..8f8d9b5c4833 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm @@ -10,7 +10,7 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm index 9b078b5c5ad6..205e171520fe 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_DOS; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm index e906c2440435..b6ab73cecef3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm @@ -8,7 +8,7 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; @@ -53,11 +53,22 @@ Over-ride Apple's automatic setting of -Werror =cut sub cflags { - my $self = shift; - - $self->{CCFLAGS} .= ($self->{CCFLAGS} ? ' ' : '').'-Wno-error=implicit-function-declaration'; - - $self->SUPER::cflags(@_); + my($self,$libperl)=@_; + return $self->{CFLAGS} if $self->{CFLAGS}; + return '' unless $self->needs_linking(); + + my $base = $self->SUPER::cflags($libperl); + + foreach (split /\n/, $base) { + /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2; + }; + $self->{CCFLAGS} .= " -Wno-error=implicit-function-declaration"; + + return $self->{CFLAGS} = qq{ +CCFLAGS = $self->{CCFLAGS} +OPTIMIZE = $self->{OPTIMIZE} +PERLTYPE = $self->{PERLTYPE} +}; } 1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm index c224cd963eba..5df5ce06a1d2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_MacOS; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; sub new { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm index f352ed43bb6d..6b79f553ac1d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm @@ -23,7 +23,7 @@ use warnings; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm index f16d4bfd6915..b9b7cd07c1d9 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm @@ -6,7 +6,7 @@ use warnings; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm index d80cd8a3958c..ba488791d457 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_OS390; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm index 70f0197e698d..1a45a1b60cf9 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_QNX; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm index ca0b482a6eda..50dfe1beb8ca 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_UWIN; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm index c24fb3edb031..d6a9772f73fc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '7.52'; +$VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm index b4d612800d78..e692985298a8 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm @@ -16,7 +16,7 @@ BEGIN { use File::Basename; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm index 277850a58f7d..586b80578554 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_VOS; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm index 7597f22981e1..5115c79a7fd6 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm @@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw(neatvalue _sprintf562); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; $ENV{EMXSHELL} = 'sh'; # to run `commands` diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm index d43eb51dc5e4..84ddc1bf5225 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_Win95; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm index 5aec641304a3..f7fb833ccfa2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm @@ -3,7 +3,7 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; our @ISA = qw(ExtUtils::MM); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm index 4309b84cf0ae..64fce4e69731 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm @@ -25,7 +25,7 @@ my %Recognized_Att_Keys; our %macro_fsentity; # whether a macro is a filesystem name our %macro_dep; # whether a macro is a dependency -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; # Emulate something resembling CVS $Revision$ diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm index f1aca0f2ddc4..57b75f60a87e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm @@ -3,7 +3,7 @@ package ExtUtils::MakeMaker::Config; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use Config (); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod index c2769364f231..f17c845441d9 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; 1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm index 000e75df7513..1bf39f40ea1d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm @@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Locale; use strict; use warnings; -our $VERSION = "7.52"; +our $VERSION = "7.54"; $VERSION =~ tr/_//d; use base 'Exporter'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod index 5023b933114c..2ca48a1a936b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm index 174058efd709..9b96f91c916d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm @@ -16,7 +16,7 @@ use warnings; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = '7.52'; +$VERSION = '7.54'; $VERSION =~ tr/_//d; $CLASS = 'version'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm index 8445bd160be1..d642b32767ab 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm @@ -11,7 +11,7 @@ use warnings; use vars qw($VERSION $CLASS $STRICT $LAX); -$VERSION = '7.52'; +$VERSION = '7.54'; $VERSION =~ tr/_//d; #--------------------------------------------------------------------------# diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm index 8af07f8c1c97..0e0764b316e5 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; require Exporter; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm index 6ff186a0d69f..cc57540517ea 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm @@ -11,7 +11,7 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; sub Mksymlists { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm index 72ae8d73dcf3..3e4f10cbdba4 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm @@ -3,7 +3,7 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = '7.52'; +our $VERSION = '7.54'; $VERSION =~ tr/_//d; use Cwd; From cae6fd476d927587e8a4d6a822086cca63e99f43 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Fri, 13 Nov 2020 07:25:24 -0500 Subject: [PATCH 003/503] pod/perlfunc.pod: Correct one typo For: https://github.com/Perl/perl5/issues/18315; thanks to valtkus. --- pod/perlfunc.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index b2ebeb797ad6..37583f23e63b 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -7840,7 +7840,7 @@ pattern argument to split; in Perl 5.18.0 and later this special case is triggered by any expression which evaluates to the simple string S>. As of Perl 5.28, this special-cased whitespace splitting works as expected in -the scope of L<< S>|feature/The +the scope of L<< S>|feature/The 'unicode_strings' feature >>. In previous versions, and outside the scope of that feature, it exhibits L: characters that are whitespace according to Unicode rules but not according to ASCII rules can be From df39a12d64011dffe679c5a69efd99323cf54701 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Nov 2020 11:11:09 -0700 Subject: [PATCH 004/503] perlop: Enhance a tr/// example This more clearly demonstrates that the /s option squeezes based on the result rather than the source --- pod/perlop.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perlop.pod b/pod/perlop.pod index ddaf430b8b60..1387dd69789a 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -2670,8 +2670,8 @@ If the C modifier is specified, sequences of characters, all in a row, that were transliterated to the same character are squashed down to a single instance of that character. - my $a = "aaaba" - $a =~ tr/a/a/s # $a now is "aba" + my $a = "aaabbbca"; + $a =~ tr/ab/dd/s; # $a now is "dcd" If the C modifier is used, the I is always interpreted exactly as specified. Otherwise, if the I is shorter From a5d5855671af6956a8d1a13e419457afdffeb416 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 09:20:52 -0600 Subject: [PATCH 005/503] op.h: Restrict scope of multiconcat symbols to core These are internal only --- op.h | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/op.h b/op.h index 975071756240..be193038a417 100644 --- a/op.h +++ b/op.h @@ -1072,6 +1072,8 @@ C is non-null. For a higher-level interface, see C>. #endif +#if defined(PERL_CORE) || defined(PERL_EXT) + /* Stuff for OP_MULTDEREF/pp_multideref. */ /* actions */ @@ -1111,6 +1113,8 @@ C is non-null. For a higher-level interface, see C>. #define MDEREF_MASK 0x7F #define MDEREF_SHIFT 7 +#endif /* end CORE/EXT only */ + #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C) # define FATAL_ABOVE_FF_MSG \ "Use of strings with code points over 0xFF as arguments to " \ From 2ce8ebb919bfe7077689980597adeb0bf69ec3c3 Mon Sep 17 00:00:00 2001 From: Marcus Holland-Moritz Date: Fri, 13 Nov 2020 20:12:06 +0000 Subject: [PATCH 006/503] IPC-SysV: Synch with CPAN release 2.09 From Changes: * Fix GitHub #8: Comparison between signed and unsigned integer * Merge PR #9: Fix compile warnings with -Wsign-compare * Merge PR #11: Avoid indirect call syntax Committer: Additional email address for contributor to keep porting tests happy --- Porting/Maintainers.pl | 2 +- Porting/checkAUTHORS.pl | 1 + cpan/IPC-SysV/SysV.xs | 2 +- cpan/IPC-SysV/lib/IPC/Msg.pm | 4 ++-- cpan/IPC-SysV/lib/IPC/Semaphore.pm | 4 ++-- cpan/IPC-SysV/lib/IPC/SharedMem.pm | 2 +- cpan/IPC-SysV/lib/IPC/SysV.pm | 2 +- cpan/IPC-SysV/t/ipcsysv.t | 4 ++-- cpan/IPC-SysV/t/msg.t | 6 +++--- cpan/IPC-SysV/t/pod.t | 8 ++++---- cpan/IPC-SysV/t/podcov.t | 4 ++-- cpan/IPC-SysV/t/sem.t | 4 ++-- cpan/IPC-SysV/t/shm.t | 4 ++-- 13 files changed, 24 insertions(+), 23 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 61a7125b40f6..86e81d7d7993 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -668,7 +668,7 @@ package Maintainers; }, 'IPC::SysV' => { - 'DISTRIBUTION' => 'MHX/IPC-SysV-2.08.tar.gz', + 'DISTRIBUTION' => 'MHX/IPC-SysV-2.09.tar.gz', 'FILES' => q[cpan/IPC-SysV], 'EXCLUDED' => [ qw( const-c.inc diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl index b6a8fc57b253..3124fe057602 100755 --- a/Porting/checkAUTHORS.pl +++ b/Porting/checkAUTHORS.pl @@ -726,6 +726,7 @@ sub _raw_address { + perl5\100tux.freedom.nl mhx mhx-perl\100gmx.net + mhx\100r2d2.(none) ++ mhx\100cpan.org mst mst\100shadowcat.co.uk + matthewt\100hercule.scsys.co.uk nicholas nick\100ccl4.org diff --git a/cpan/IPC-SysV/SysV.xs b/cpan/IPC-SysV/SysV.xs index 6a0329cfe8a9..6690718aa859 100644 --- a/cpan/IPC-SysV/SysV.xs +++ b/cpan/IPC-SysV/SysV.xs @@ -379,7 +379,7 @@ memwrite(addr, sv, pos, size) char *caddr = (char *) sv2addr(addr); STRLEN len; const char *src = SvPV_const(sv, len); - int n = ((int) len > size) ? size : (int) len; + unsigned int n = ((unsigned int) len > size) ? size : (unsigned int) len; Copy(src, caddr + pos, n, char); if (n < size) { diff --git a/cpan/IPC-SysV/lib/IPC/Msg.pm b/cpan/IPC-SysV/lib/IPC/Msg.pm index 051539da1c06..281b22020172 100644 --- a/cpan/IPC-SysV/lib/IPC/Msg.pm +++ b/cpan/IPC-SysV/lib/IPC/Msg.pm @@ -15,7 +15,7 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.08'; +$VERSION = '2.09'; # Figure out if we have support for native sized types my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' }; @@ -42,7 +42,7 @@ my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' }; } sub new { - @_ == 3 || croak 'new IPC::Msg ( KEY , FLAGS )'; + @_ == 3 || croak 'IPC::Msg->new( KEY , FLAGS )'; my $class = shift; my $id = msgget($_[0],$_[1]); diff --git a/cpan/IPC-SysV/lib/IPC/Semaphore.pm b/cpan/IPC-SysV/lib/IPC/Semaphore.pm index 9284e7acaf5d..a8f61b26c8e6 100644 --- a/cpan/IPC-SysV/lib/IPC/Semaphore.pm +++ b/cpan/IPC-SysV/lib/IPC/Semaphore.pm @@ -16,7 +16,7 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.08'; +$VERSION = '2.09'; # Figure out if we have support for native sized types my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' }; @@ -39,7 +39,7 @@ my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' }; } sub new { - @_ == 4 || croak 'new ' . __PACKAGE__ . '( KEY, NSEMS, FLAGS )'; + @_ == 4 || croak __PACKAGE__ . '->new( KEY, NSEMS, FLAGS )'; my $class = shift; my $id = semget($_[0],$_[1],$_[2]); diff --git a/cpan/IPC-SysV/lib/IPC/SharedMem.pm b/cpan/IPC-SysV/lib/IPC/SharedMem.pm index 5ebec7bb2967..e1fbc850b3c2 100644 --- a/cpan/IPC-SysV/lib/IPC/SharedMem.pm +++ b/cpan/IPC-SysV/lib/IPC/SharedMem.pm @@ -15,7 +15,7 @@ use strict; use vars qw($VERSION); use Carp; -$VERSION = '2.08'; +$VERSION = '2.09'; # Figure out if we have support for native sized types my $N = do { my $foo = eval { pack "L!", 0 }; $@ ? '' : '!' }; diff --git a/cpan/IPC-SysV/lib/IPC/SysV.pm b/cpan/IPC-SysV/lib/IPC/SysV.pm index 0d531723eb0f..ebafceb9385e 100644 --- a/cpan/IPC-SysV/lib/IPC/SysV.pm +++ b/cpan/IPC-SysV/lib/IPC/SysV.pm @@ -18,7 +18,7 @@ use Config; require Exporter; @ISA = qw(Exporter); -$VERSION = '2.08'; +$VERSION = '2.09'; # To support new constants, just add them to @EXPORT_OK # and the C/XS code will be generated automagically. diff --git a/cpan/IPC-SysV/t/ipcsysv.t b/cpan/IPC-SysV/t/ipcsysv.t index 277490b4e3b4..8bbea07fd0f7 100644 --- a/cpan/IPC-SysV/t/ipcsysv.t +++ b/cpan/IPC-SysV/t/ipcsysv.t @@ -13,8 +13,8 @@ use warnings; our %Config; BEGIN { - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); diff --git a/cpan/IPC-SysV/t/msg.t b/cpan/IPC-SysV/t/msg.t index b31beb1a303e..c216202e06be 100644 --- a/cpan/IPC-SysV/t/msg.t +++ b/cpan/IPC-SysV/t/msg.t @@ -18,8 +18,8 @@ BEGIN { @INC = '../lib' if -d '../lib' && -d '../ext'; } - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); @@ -44,7 +44,7 @@ my $msq = sub { return $code->(); } return $code->(); -}->(sub { new IPC::Msg(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) }); +}->(sub { IPC::Msg->new(IPC_PRIVATE, S_IRWXU | S_IRWXG | S_IRWXO) }); unless (defined $msq) { my $info = "IPC::Msg->new failed: $!"; diff --git a/cpan/IPC-SysV/t/pod.t b/cpan/IPC-SysV/t/pod.t index 3cc06d86c539..d3fee6b30545 100644 --- a/cpan/IPC-SysV/t/pod.t +++ b/cpan/IPC-SysV/t/pod.t @@ -18,8 +18,8 @@ BEGIN { @INC = '../lib' if -d '../lib' && -d '../ext'; } - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); @@ -51,12 +51,12 @@ eval { require Test::Pod; $Test::Pod::VERSION >= 0.95 or die "Test::Pod version only $Test::Pod::VERSION"; - import Test::Pod tests => scalar @pods; + Test::Pod->import( tests => scalar @pods ); }; if ($@) { require Test::More; - import Test::More skip_all => "testing pod requires Test::Pod"; + Test::More->import( skip_all => "testing pod requires Test::Pod" ); } else { for my $pod (@pods) { diff --git a/cpan/IPC-SysV/t/podcov.t b/cpan/IPC-SysV/t/podcov.t index 7aa2da9178ee..7067482ec8c1 100644 --- a/cpan/IPC-SysV/t/podcov.t +++ b/cpan/IPC-SysV/t/podcov.t @@ -18,8 +18,8 @@ BEGIN { @INC = '../lib' if -d '../lib' && -d '../ext'; } - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); diff --git a/cpan/IPC-SysV/t/sem.t b/cpan/IPC-SysV/t/sem.t index 2c0da6ba3385..1f1d06a97b84 100644 --- a/cpan/IPC-SysV/t/sem.t +++ b/cpan/IPC-SysV/t/sem.t @@ -18,8 +18,8 @@ BEGIN { @INC = '../lib' if -d '../lib' && -d '../ext'; } - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); diff --git a/cpan/IPC-SysV/t/shm.t b/cpan/IPC-SysV/t/shm.t index 454c18625f4c..5f4282ce4f0d 100644 --- a/cpan/IPC-SysV/t/shm.t +++ b/cpan/IPC-SysV/t/shm.t @@ -18,8 +18,8 @@ BEGIN { @INC = '../lib' if -d '../lib' && -d '../ext'; } - require Test::More; import Test::More; - require Config; import Config; + require Test::More; Test::More->import; + require Config; Config->import; if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { plan(skip_all => 'IPC::SysV was not built'); From 054b5d1d1db5a12a7eb788f5c4263a75f0e71b15 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Sat, 14 Nov 2020 09:40:45 +0000 Subject: [PATCH 007/503] PPPort version on CPAN is 3.62 --- Porting/Maintainers.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 86e81d7d7993..5d3894eaad22 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -340,7 +340,7 @@ package Maintainers; }, 'Devel::PPPort' => { - 'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.57.tar.gz', + 'DISTRIBUTION' => 'ATOOMIC/Devel-PPPort-3.62.tar.gz', 'FILES' => q[dist/Devel-PPPort], 'EXCLUDED' => [ 'PPPort.pm', # we use PPPort_pm.PL instead From 7fc0439ba3e5226f493dfd0ae10bd35298e83fff Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Sat, 14 Nov 2020 09:59:47 +0000 Subject: [PATCH 008/503] Update ExtUtils-CBuilder to CPAN version 0.280235 [DELTA] 0.280235 - 2020-11-01 Fix: - Fix compilation on darwin with XCode 12 (-Werror=implicit-function-declaration) Thanks to DrHyde for the patch. --- Porting/Maintainers.pl | 2 +- dist/ExtUtils-CBuilder/Changes | 7 +++++++ dist/ExtUtils-CBuilder/Makefile.PL | 4 ++-- dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm | 2 +- dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Unix.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/VMS.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/aix.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/android.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/cygwin.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/darwin.pm | 6 +++++- .../lib/ExtUtils/CBuilder/Platform/dec_osf.pm | 2 +- .../lib/ExtUtils/CBuilder/Platform/os2.pm | 2 +- 17 files changed, 28 insertions(+), 17 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 5d3894eaad22..21254f3ec20c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -428,7 +428,7 @@ package Maintainers; }, 'ExtUtils::CBuilder' => { - 'DISTRIBUTION' => 'AMBS/ExtUtils-CBuilder-0.280234.tar.gz', + 'DISTRIBUTION' => 'AMBS/ExtUtils-CBuilder-0.280235.tar.gz', 'FILES' => q[dist/ExtUtils-CBuilder], 'EXCLUDED' => [ qw(README.mkdn), diff --git a/dist/ExtUtils-CBuilder/Changes b/dist/ExtUtils-CBuilder/Changes index bb7e565062a1..5cb89e424040 100644 --- a/dist/ExtUtils-CBuilder/Changes +++ b/dist/ExtUtils-CBuilder/Changes @@ -1,5 +1,12 @@ Revision history for Perl extension ExtUtils::CBuilder. +0.280235 - 2020-11-01 + + Fix: + + - Fix compilation on darwin with XCode 12 (-Werror=implicit-function-declaration) + Thanks to DrHyde for the patch. + 0.280234 - 2020-01-21 Update: diff --git a/dist/ExtUtils-CBuilder/Makefile.PL b/dist/ExtUtils-CBuilder/Makefile.PL index 7dac2abac378..5b7dd5dc7447 100644 --- a/dist/ExtUtils-CBuilder/Makefile.PL +++ b/dist/ExtUtils-CBuilder/Makefile.PL @@ -1,4 +1,4 @@ -# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.012. +# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.015. use strict; use warnings; @@ -29,7 +29,7 @@ my %WriteMakefileArgs = ( "TEST_REQUIRES" => { "Test::More" => "0.47" }, - "VERSION" => "0.280234", + "VERSION" => "0.280235", "test" => { "TESTS" => "t/*.t" } diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm index 60b1662d58ee..3286015ef3fd 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder.pm @@ -7,7 +7,7 @@ use Perl::OSType qw/os_type/; use warnings; use strict; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA; # We only use this once - don't waste a symbol table entry on it. diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm index 638014352c63..a72a7cb34f78 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Base.pm @@ -9,7 +9,7 @@ use Text::ParseWords; use IPC::Cmd qw(can_run); use File::Temp qw(tempfile); -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION # More details about C/C++ compilers: # http://developers.sun.com/sunstudio/documentation/product/compiler.jsp diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm index e73933fea1f5..4005366e4454 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Unix.pm @@ -4,7 +4,7 @@ use warnings; use strict; use ExtUtils::CBuilder::Base; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Base); sub link_executable { diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm index dc3e91b7b984..f0ce477441e7 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/VMS.pm @@ -4,7 +4,7 @@ use warnings; use strict; use ExtUtils::CBuilder::Base; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Base); use File::Spec::Functions qw(catfile catdir); diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm index 35093d16f12d..b017d7ab5a93 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows.pm @@ -8,7 +8,7 @@ use File::Spec; use ExtUtils::CBuilder::Base; use IO::File; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Base); =begin comment diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm index 98bdb2d367fe..35e80278db82 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/BCC.pm @@ -1,6 +1,6 @@ package ExtUtils::CBuilder::Platform::Windows::BCC; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION use strict; use warnings; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm index 5854d57a8f31..46650e94cd20 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/GCC.pm @@ -1,6 +1,6 @@ package ExtUtils::CBuilder::Platform::Windows::GCC; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION use warnings; use strict; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm index 6a9158020bd1..3f8337da78ae 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/Windows/MSVC.pm @@ -1,6 +1,6 @@ package ExtUtils::CBuilder::Platform::Windows::MSVC; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION use warnings; use strict; diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm index 8b1572d782af..57ceb8a22fc7 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/aix.pm @@ -5,7 +5,7 @@ use strict; use ExtUtils::CBuilder::Platform::Unix; use File::Spec; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm index 70eb6cf98709..591651537329 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/android.pm @@ -6,7 +6,7 @@ use File::Spec; use ExtUtils::CBuilder::Platform::Unix; use Config; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); # The Android linker will not recognize symbols from diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm index 40d93357ffe4..9474bfda5e1b 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/cygwin.pm @@ -5,7 +5,7 @@ use strict; use File::Spec; use ExtUtils::CBuilder::Platform::Unix; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); # TODO: If a specific exe_file name is requested, if the exe created diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm index 28deb76580e2..3787f39d0049 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/darwin.pm @@ -4,7 +4,7 @@ use warnings; use strict; use ExtUtils::CBuilder::Platform::Unix; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub compile { @@ -15,6 +15,10 @@ sub compile { # it's mistakenly in Config.pm as both. Make the correction here. local $cf->{ccflags} = $cf->{ccflags}; $cf->{ccflags} =~ s/-flat_namespace//; + + # XCode 12 makes this fatal, breaking tons of XS modules + $cf->{ccflags} .= ($cf->{ccflags} ? ' ' : '').'-Wno-error=implicit-function-declaration'; + $self->SUPER::compile(@_); } diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm index 1185f06344fc..98cb235f98a0 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/dec_osf.pm @@ -5,7 +5,7 @@ use strict; use ExtUtils::CBuilder::Platform::Unix; use File::Spec; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub link_executable { diff --git a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm index b9fae17c28f5..8e1377f12c25 100644 --- a/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm +++ b/dist/ExtUtils-CBuilder/lib/ExtUtils/CBuilder/Platform/os2.pm @@ -4,7 +4,7 @@ use warnings; use strict; use ExtUtils::CBuilder::Platform::Unix; -our $VERSION = '0.280234'; # VERSION +our $VERSION = '0.280235'; # VERSION our @ISA = qw(ExtUtils::CBuilder::Platform::Unix); sub need_prelink { 1 } From 4c032c4685c1990604f7a27376b28db5d7d204dd Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Sat, 14 Nov 2020 10:00:51 +0000 Subject: [PATCH 009/503] Update File-Fetch to CPAN version 1.00 [DELTA] 1.00 Wed Nov 11 12:49:58 2020 * Fixed the mitigations for CVE-2016-1238 * Mentioned https support in CHANGES file --- Porting/Maintainers.pl | 2 +- cpan/File-Fetch/lib/File/Fetch.pm | 15 +++++++++++---- 2 files changed, 12 insertions(+), 5 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 21254f3ec20c..ec805d9c151f 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -508,7 +508,7 @@ package Maintainers; }, 'File::Fetch' => { - 'DISTRIBUTION' => 'BINGOS/File-Fetch-0.56.tar.gz', + 'DISTRIBUTION' => 'BINGOS/File-Fetch-1.00.tar.gz', 'FILES' => q[cpan/File-Fetch], }, diff --git a/cpan/File-Fetch/lib/File/Fetch.pm b/cpan/File-Fetch/lib/File/Fetch.pm index 90c62e96bee4..76c641d2e7b6 100644 --- a/cpan/File-Fetch/lib/File/Fetch.pm +++ b/cpan/File-Fetch/lib/File/Fetch.pm @@ -22,7 +22,7 @@ use vars qw[ $VERBOSE $PREFER_BIN $FROM_EMAIL $USER_AGENT $FTP_PASSIVE $TIMEOUT $DEBUG $WARN $FORCEIPV4 ]; -$VERSION = '0.56'; +$VERSION = '1.00'; $VERSION = eval $VERSION; # avoid warnings with development releases $PREFER_BIN = 0; # XXX TODO implement $FROM_EMAIL = 'File-Fetch@example.com'; @@ -52,9 +52,6 @@ local $Params::Check::VERBOSE = 1; local $Module::Load::Conditional::VERBOSE = 0; local $Module::Load::Conditional::VERBOSE = 0; -### Fix CVE-2016-1238 ### -local $Module::Load::Conditional::FORCE_SAFE_INC = 1; - ### see what OS we are on, important for file:// uris ### use constant ON_WIN => ($^O eq 'MSWin32'); use constant ON_VMS => ($^O eq 'VMS'); @@ -576,6 +573,8 @@ sub _lwp_fetch { $use_list->{'LWP::Protocol::https'} = '0'; } + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load( modules => $use_list ) ) { $METHOD_FAIL->{'lwp'} = 1; return; @@ -633,6 +632,8 @@ sub _httptiny_fetch { }; + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'httptiny'} = 1; return; @@ -672,6 +673,8 @@ sub _httplite_fetch { 'MIME::Base64' => '0', }; + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'httplite'} = 1; return; @@ -752,6 +755,8 @@ sub _iosock_fetch { 'IO::Select' => '0.0', }; + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load(modules => $use_list) ) { $METHOD_FAIL->{'iosock'} = 1; return; @@ -835,6 +840,8 @@ sub _netftp_fetch { ### required modules ### my $use_list = { 'Net::FTP' => 0 }; + ### Fix CVE-2016-1238 ### + local $Module::Load::Conditional::FORCE_SAFE_INC = 1; unless( can_load( modules => $use_list ) ) { $METHOD_FAIL->{'netftp'} = 1; return; From 2cd163274121ba332c8fb8648d0926fe8bb35144 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Sat, 14 Nov 2020 10:02:19 +0000 Subject: [PATCH 010/503] Update Test-Simple to CPAN version 1.302183 [DELTA] 1.302183 2020-10-21 20:10:36-07:00 America/Los_Angeles - avoid closing over scalar in BEGIN block in cmp_ok eval --- MANIFEST | 1 + Porting/Maintainers.pl | 2 +- cpan/Test-Simple/lib/Test/Builder.pm | 7 +++++-- .../Test-Simple/lib/Test/Builder/Formatter.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/Module.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/Tester.pm | 2 +- .../lib/Test/Builder/Tester/Color.pm | 2 +- cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm | 2 +- cpan/Test-Simple/lib/Test/More.pm | 2 +- cpan/Test-Simple/lib/Test/Simple.pm | 2 +- cpan/Test-Simple/lib/Test/Tester.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/Capture.pm | 2 +- .../lib/Test/Tester/CaptureRunner.pm | 2 +- cpan/Test-Simple/lib/Test/Tester/Delegate.pm | 2 +- cpan/Test-Simple/lib/Test/use/ok.pm | 2 +- cpan/Test-Simple/lib/Test2.pm | 2 +- cpan/Test-Simple/lib/Test2/API.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Breakage.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Context.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Instance.pm | 2 +- .../lib/Test2/API/InterceptResult.pm | 2 +- .../lib/Test2/API/InterceptResult/Event.pm | 2 +- .../lib/Test2/API/InterceptResult/Facet.pm | 2 +- .../lib/Test2/API/InterceptResult/Hub.pm | 2 +- .../lib/Test2/API/InterceptResult/Squasher.pm | 2 +- cpan/Test-Simple/lib/Test2/API/Stack.pm | 2 +- cpan/Test-Simple/lib/Test2/Event.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Bail.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Diag.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Encoding.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Exception.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Fail.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Generic.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Note.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Ok.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Pass.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Plan.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Skip.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Subtest.pm | 2 +- .../lib/Test2/Event/TAP/Version.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/V2.pm | 2 +- cpan/Test-Simple/lib/Test2/Event/Waiting.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet.pm | 2 +- .../Test-Simple/lib/Test2/EventFacet/About.pm | 2 +- .../lib/Test2/EventFacet/Amnesty.pm | 2 +- .../lib/Test2/EventFacet/Assert.pm | 2 +- .../lib/Test2/EventFacet/Control.pm | 2 +- .../Test-Simple/lib/Test2/EventFacet/Error.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Info.pm | 2 +- .../lib/Test2/EventFacet/Info/Table.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm | 2 +- .../lib/Test2/EventFacet/Parent.pm | 2 +- cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm | 2 +- .../lib/Test2/EventFacet/Render.pm | 2 +- .../Test-Simple/lib/Test2/EventFacet/Trace.pm | 2 +- cpan/Test-Simple/lib/Test2/Formatter.pm | 2 +- cpan/Test-Simple/lib/Test2/Formatter/TAP.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm | 2 +- .../lib/Test2/Hub/Interceptor/Terminator.pm | 2 +- cpan/Test-Simple/lib/Test2/Hub/Subtest.pm | 2 +- cpan/Test-Simple/lib/Test2/IPC.pm | 2 +- cpan/Test-Simple/lib/Test2/IPC/Driver.pm | 2 +- .../Test-Simple/lib/Test2/IPC/Driver/Files.pm | 2 +- cpan/Test-Simple/lib/Test2/Tools/Tiny.pm | 2 +- cpan/Test-Simple/lib/Test2/Util.pm | 2 +- .../lib/Test2/Util/ExternalMeta.pm | 2 +- .../lib/Test2/Util/Facets2Legacy.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/HashBase.pm | 2 +- cpan/Test-Simple/lib/Test2/Util/Trace.pm | 2 +- cpan/Test-Simple/lib/ok.pm | 2 +- .../t/Legacy/Regression/is_capture.t | 20 +++++++++++++++++++ 73 files changed, 96 insertions(+), 72 deletions(-) create mode 100644 cpan/Test-Simple/t/Legacy/Regression/is_capture.t diff --git a/MANIFEST b/MANIFEST index 003b2203e48d..0e4790b938b7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2396,6 +2396,7 @@ cpan/Test-Simple/t/Legacy/Regression/6_cmp_ok.t cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t cpan/Test-Simple/t/Legacy/Regression/789-read-only.t cpan/Test-Simple/t/Legacy/Regression/870-experimental-warnings.t +cpan/Test-Simple/t/Legacy/Regression/is_capture.t cpan/Test-Simple/t/Legacy/require_ok.t cpan/Test-Simple/t/Legacy/run_test.t cpan/Test-Simple/t/Legacy/simple.t diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index ec805d9c151f..54b1edb95641 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1078,7 +1078,7 @@ package Maintainers; }, 'Test::Simple' => { - 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302182.tar.gz', + 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302183.tar.gz', 'FILES' => q[cpan/Test-Simple], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/Test-Simple/lib/Test/Builder.pm b/cpan/Test-Simple/lib/Test/Builder.pm index 2d938889c6c9..6c3cceec9975 100644 --- a/cpan/Test-Simple/lib/Test/Builder.pm +++ b/cpan/Test-Simple/lib/Test/Builder.pm @@ -4,7 +4,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { if( $] < 5.008 ) { @@ -963,10 +963,13 @@ sub cmp_ok { my($pack, $file, $line) = $ctx->trace->call(); my $warning_bits = $ctx->trace->warning_bits; + # convert this to a code string so the BEGIN doesn't have to close + # over it, which can lead to issues with Devel::Cover + my $bits_code = defined $warning_bits ? qq["\Q$warning_bits\E"] : 'undef'; # This is so that warnings come out at the caller's level $succ = eval qq[ -BEGIN {\${^WARNING_BITS} = \$warning_bits}; +BEGIN {\${^WARNING_BITS} = $bits_code}; #line $line "(eval in cmp_ok) $file" \$test = (\$got $type \$expect); 1; diff --git a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm index 3356f3b6f1de..e2acbc58314f 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Formatter.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Formatter.pm @@ -2,7 +2,7 @@ package Test::Builder::Formatter; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Formatter::TAP; our @ISA = qw(Test2::Formatter::TAP) } diff --git a/cpan/Test-Simple/lib/Test/Builder/Module.pm b/cpan/Test-Simple/lib/Test/Builder/Module.pm index 59adcce7c878..40cf5d61f7d9 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Module.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Module.pm @@ -7,7 +7,7 @@ use Test::Builder; require Exporter; our @ISA = qw(Exporter); -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; =head1 NAME diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester.pm b/cpan/Test-Simple/lib/Test/Builder/Tester.pm index cda01c6af319..5bbe300fb354 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester; use strict; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test::Builder; use Symbol; diff --git a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm index 3f6694ac1ed5..1fb4a694c013 100644 --- a/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm +++ b/cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm @@ -1,7 +1,7 @@ package Test::Builder::Tester::Color; use strict; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; require Test::Builder::Tester; diff --git a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm index 127fddbfdf41..6e04f5c53d6c 100644 --- a/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm +++ b/cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm @@ -2,7 +2,7 @@ package Test::Builder::TodoDiag; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event::Diag; our @ISA = qw(Test2::Event::Diag) } diff --git a/cpan/Test-Simple/lib/Test/More.pm b/cpan/Test-Simple/lib/Test/More.pm index 4028930b41d0..7212d25d6af5 100644 --- a/cpan/Test-Simple/lib/Test/More.pm +++ b/cpan/Test-Simple/lib/Test/More.pm @@ -17,7 +17,7 @@ sub _carp { return warn @_, " at $file line $line\n"; } -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); diff --git a/cpan/Test-Simple/lib/Test/Simple.pm b/cpan/Test-Simple/lib/Test/Simple.pm index 30e811c9be88..b8a6c7ca402b 100644 --- a/cpan/Test-Simple/lib/Test/Simple.pm +++ b/cpan/Test-Simple/lib/Test/Simple.pm @@ -4,7 +4,7 @@ use 5.006; use strict; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test::Builder::Module; our @ISA = qw(Test::Builder::Module); diff --git a/cpan/Test-Simple/lib/Test/Tester.pm b/cpan/Test-Simple/lib/Test/Tester.pm index c31a36fa3eac..506734ea8bc0 100644 --- a/cpan/Test-Simple/lib/Test/Tester.pm +++ b/cpan/Test-Simple/lib/Test/Tester.pm @@ -18,7 +18,7 @@ require Exporter; use vars qw( @ISA @EXPORT ); -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; @EXPORT = qw( run_tests check_tests check_test cmp_results show_space ); @ISA = qw( Exporter ); diff --git a/cpan/Test-Simple/lib/Test/Tester/Capture.pm b/cpan/Test-Simple/lib/Test/Tester/Capture.pm index 8e15594901f4..71324b03d18e 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Capture.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Capture.pm @@ -2,7 +2,7 @@ use strict; package Test::Tester::Capture; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test::Builder; diff --git a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm index 38ffb46a843f..ffd6e99f2e8c 100644 --- a/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm +++ b/cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm @@ -3,7 +3,7 @@ use strict; package Test::Tester::CaptureRunner; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test::Tester::Capture; diff --git a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm index 7ff59d6048ec..826c21e71e31 100644 --- a/cpan/Test-Simple/lib/Test/Tester/Delegate.pm +++ b/cpan/Test-Simple/lib/Test/Tester/Delegate.pm @@ -3,7 +3,7 @@ use warnings; package Test::Tester::Delegate; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Scalar::Util(); diff --git a/cpan/Test-Simple/lib/Test/use/ok.pm b/cpan/Test-Simple/lib/Test/use/ok.pm index 6758b34d7833..1e2f0df2c1ca 100644 --- a/cpan/Test-Simple/lib/Test/use/ok.pm +++ b/cpan/Test-Simple/lib/Test/use/ok.pm @@ -1,7 +1,7 @@ package Test::use::ok; use 5.005; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; __END__ diff --git a/cpan/Test-Simple/lib/Test2.pm b/cpan/Test-Simple/lib/Test2.pm index 68f7622474f3..7b8984beaf21 100644 --- a/cpan/Test-Simple/lib/Test2.pm +++ b/cpan/Test-Simple/lib/Test2.pm @@ -2,7 +2,7 @@ package Test2; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; 1; diff --git a/cpan/Test-Simple/lib/Test2/API.pm b/cpan/Test-Simple/lib/Test2/API.pm index 30d30fdae81a..6c663468ab0c 100644 --- a/cpan/Test-Simple/lib/Test2/API.pm +++ b/cpan/Test-Simple/lib/Test2/API.pm @@ -9,7 +9,7 @@ BEGIN { $ENV{TEST2_ACTIVE} = 1; } -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; my $INST; diff --git a/cpan/Test-Simple/lib/Test2/API/Breakage.pm b/cpan/Test-Simple/lib/Test2/API/Breakage.pm index 9cb3e932f57e..b661b9e2b8af 100644 --- a/cpan/Test-Simple/lib/Test2/API/Breakage.pm +++ b/cpan/Test-Simple/lib/Test2/API/Breakage.pm @@ -2,7 +2,7 @@ package Test2::API::Breakage; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::Util qw/pkg_to_file/; diff --git a/cpan/Test-Simple/lib/Test2/API/Context.pm b/cpan/Test-Simple/lib/Test2/API/Context.pm index c79f4d6e19f7..f94993c8e85f 100644 --- a/cpan/Test-Simple/lib/Test2/API/Context.pm +++ b/cpan/Test-Simple/lib/Test2/API/Context.pm @@ -2,7 +2,7 @@ package Test2::API::Context; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/confess croak/; diff --git a/cpan/Test-Simple/lib/Test2/API/Instance.pm b/cpan/Test-Simple/lib/Test2/API/Instance.pm index 1f7593fd3895..8a0ef99e3d30 100644 --- a/cpan/Test-Simple/lib/Test2/API/Instance.pm +++ b/cpan/Test-Simple/lib/Test2/API/Instance.pm @@ -2,7 +2,7 @@ package Test2::API::Instance; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; our @CARP_NOT = qw/Test2::API Test2::API::Instance Test2::IPC::Driver Test2::Formatter/; use Carp qw/confess carp/; diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm index fdf866258823..a679ac4806ef 100644 --- a/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult.pm @@ -2,7 +2,7 @@ package Test2::API::InterceptResult; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Scalar::Util qw/blessed/; use Test2::Util qw/pkg_to_file/; diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm index c0db58e43585..860f4966ee8a 100644 --- a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Event.pm @@ -2,7 +2,7 @@ package Test2::API::InterceptResult::Event; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use List::Util qw/first/; use Test2::Util qw/pkg_to_file/; diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm index e1877bf502b2..ca4a9b38b5bd 100644 --- a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Facet.pm @@ -2,7 +2,7 @@ package Test2::API::InterceptResult::Facet; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm index 15b2afccbcbb..aeb92c7b54e4 100644 --- a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Hub.pm @@ -2,7 +2,7 @@ package Test2::API::InterceptResult::Hub; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase; diff --git a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm index facf16c85c4d..ace805e7816d 100644 --- a/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm +++ b/cpan/Test-Simple/lib/Test2/API/InterceptResult/Squasher.pm @@ -2,7 +2,7 @@ package Test2::API::InterceptResult::Squasher; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/croak/; use List::Util qw/first/; diff --git a/cpan/Test-Simple/lib/Test2/API/Stack.pm b/cpan/Test-Simple/lib/Test2/API/Stack.pm index 2d5d1f049a2a..b5585a8ef4af 100644 --- a/cpan/Test-Simple/lib/Test2/API/Stack.pm +++ b/cpan/Test-Simple/lib/Test2/API/Stack.pm @@ -2,7 +2,7 @@ package Test2::API::Stack; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::Hub(); diff --git a/cpan/Test-Simple/lib/Test2/Event.pm b/cpan/Test-Simple/lib/Test2/Event.pm index afd876ce34f5..99a6fd43cb1c 100644 --- a/cpan/Test-Simple/lib/Test2/Event.pm +++ b/cpan/Test-Simple/lib/Test2/Event.pm @@ -2,7 +2,7 @@ package Test2::Event; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Scalar::Util qw/blessed reftype/; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Bail.pm b/cpan/Test-Simple/lib/Test2/Event/Bail.pm index eef1f5688ac7..9b5092def83d 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Bail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Bail.pm @@ -2,7 +2,7 @@ package Test2::Event::Bail; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Diag.pm b/cpan/Test-Simple/lib/Test2/Event/Diag.pm index f696c9000117..fb7523523384 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Diag.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Diag.pm @@ -2,7 +2,7 @@ package Test2::Event::Diag; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm index 917142df3310..831fcebb4da5 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Encoding.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Encoding.pm @@ -2,7 +2,7 @@ package Test2::Event::Encoding; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Exception.pm b/cpan/Test-Simple/lib/Test2/Event/Exception.pm index b890fc231341..a02a6012ac18 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Exception.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Exception.pm @@ -2,7 +2,7 @@ package Test2::Event::Exception; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Fail.pm b/cpan/Test-Simple/lib/Test2/Event/Fail.pm index af09cbf2bd06..7a1eaa94f24e 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Fail.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Fail.pm @@ -2,7 +2,7 @@ package Test2::Event::Fail; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::EventFacet::Info; diff --git a/cpan/Test-Simple/lib/Test2/Event/Generic.pm b/cpan/Test-Simple/lib/Test2/Event/Generic.pm index ce8c1487c8b6..409fb77bc496 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Generic.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Generic.pm @@ -5,7 +5,7 @@ use warnings; use Carp qw/croak/; use Scalar::Util qw/reftype/; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } use Test2::Util::HashBase; diff --git a/cpan/Test-Simple/lib/Test2/Event/Note.pm b/cpan/Test-Simple/lib/Test2/Event/Note.pm index cfa0e270c083..13613f8c9612 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Note.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Note.pm @@ -2,7 +2,7 @@ package Test2::Event::Note; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Ok.pm b/cpan/Test-Simple/lib/Test2/Event/Ok.pm index 9b3c43bc2639..d39c1dbf844a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Ok.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Ok.pm @@ -2,7 +2,7 @@ package Test2::Event::Ok; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Pass.pm b/cpan/Test-Simple/lib/Test2/Event/Pass.pm index f43f0d11e870..b5050459ce7d 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Pass.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Pass.pm @@ -2,7 +2,7 @@ package Test2::Event::Pass; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::EventFacet::Info; diff --git a/cpan/Test-Simple/lib/Test2/Event/Plan.pm b/cpan/Test-Simple/lib/Test2/Event/Plan.pm index 7b1531ddacee..cc9d8049e33d 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Plan.pm @@ -2,7 +2,7 @@ package Test2::Event::Plan; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Skip.pm b/cpan/Test-Simple/lib/Test2/Event/Skip.pm index ebc5ff1f60f8..75d7db1bd8ed 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Skip.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Skip.pm @@ -2,7 +2,7 @@ package Test2::Event::Skip; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } diff --git a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm index ac5ca0a483e1..89081fa2251a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Subtest.pm @@ -2,7 +2,7 @@ package Test2::Event::Subtest; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event::Ok; our @ISA = qw(Test2::Event::Ok) } use Test2::Util::HashBase qw{subevents buffered subtest_id subtest_uuid}; diff --git a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm index d283a07e743d..bb90cc5f4920 100644 --- a/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm +++ b/cpan/Test-Simple/lib/Test2/Event/TAP/Version.pm @@ -2,7 +2,7 @@ package Test2::Event::TAP::Version; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Event/V2.pm b/cpan/Test-Simple/lib/Test2/Event/V2.pm index 913a72cac8de..accab090d6cb 100644 --- a/cpan/Test-Simple/lib/Test2/Event/V2.pm +++ b/cpan/Test-Simple/lib/Test2/Event/V2.pm @@ -2,7 +2,7 @@ package Test2::Event::V2; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Scalar::Util qw/reftype/; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm index d2d4467b930b..0f92a910b79a 100644 --- a/cpan/Test-Simple/lib/Test2/Event/Waiting.pm +++ b/cpan/Test-Simple/lib/Test2/Event/Waiting.pm @@ -2,7 +2,7 @@ package Test2::Event::Waiting; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Event; our @ISA = qw(Test2::Event) } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet.pm b/cpan/Test-Simple/lib/Test2/EventFacet.pm index a1c25b297497..171e005f8593 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet.pm @@ -2,7 +2,7 @@ package Test2::EventFacet; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::Util::HashBase qw/-details/; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm index 92406dbb807a..50dfa4dfe01c 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/About.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/About.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::About; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -package -no_display -uuid -eid }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm index c6a398ec68b3..fb65846f16d5 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Amnesty.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Amnesty; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm index f3f5a93fe058..ffe2b054393b 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Assert.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Assert; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -pass -no_debug -number }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm index 6775c170294f..891d38f6dd4d 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Control.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Control; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -global -terminate -halt -has_callback -encoding -phase }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm index 16cfa42bc658..407e7e736802 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Error.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Error; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; sub facet_key { 'errors' } sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm index a1bb14d9e7df..35a75c13a72c 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Hub.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Hub; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; sub is_list { 1 } sub facet_key { 'hubs' } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm index 1f877f119028..2aa38e96bd7d 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Info.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Info; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm index 750a834a9712..351e88b4fa84 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Info/Table.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Info::Table; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm index 88de563ac68c..17f78bd59d49 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Meta.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Meta; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use vars qw/$AUTOLOAD/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm index 4f440c0f25a7..82521cd63d56 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Parent.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Parent; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm index 91ed3f63ec38..99349b357550 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Plan.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Plan; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } use Test2::Util::HashBase qw{ -count -skip -none }; diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm index a04cc59f2351..8cc8b7a8e52b 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Render.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Render; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; sub is_list { 1 } diff --git a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm index 87e452bdd0b6..6c4e4550b519 100644 --- a/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/EventFacet/Trace.pm @@ -2,7 +2,7 @@ package Test2::EventFacet::Trace; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::EventFacet; our @ISA = qw(Test2::EventFacet) } diff --git a/cpan/Test-Simple/lib/Test2/Formatter.pm b/cpan/Test-Simple/lib/Test2/Formatter.pm index bec33fede79b..981baba2d1da 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter.pm @@ -2,7 +2,7 @@ package Test2::Formatter; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; my %ADDED; diff --git a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm index 8dc2cc96881b..0b1e9475d005 100644 --- a/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm +++ b/cpan/Test-Simple/lib/Test2/Formatter/TAP.pm @@ -2,7 +2,7 @@ package Test2::Formatter::TAP; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::Util qw/clone_io/; diff --git a/cpan/Test-Simple/lib/Test2/Hub.pm b/cpan/Test-Simple/lib/Test2/Hub.pm index 8b8f1a9de38a..207099b25028 100644 --- a/cpan/Test-Simple/lib/Test2/Hub.pm +++ b/cpan/Test-Simple/lib/Test2/Hub.pm @@ -2,7 +2,7 @@ package Test2::Hub; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/carp croak confess/; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm index f8c03af571d5..13930c55bd47 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::Hub::Interceptor::Terminator(); diff --git a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm index a360c34ffa79..b37f505745bf 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Interceptor/Terminator.pm @@ -2,7 +2,7 @@ package Test2::Hub::Interceptor::Terminator; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; 1; diff --git a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm index e2aaa8788f1d..7c75eed0a878 100644 --- a/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm +++ b/cpan/Test-Simple/lib/Test2/Hub/Subtest.pm @@ -2,7 +2,7 @@ package Test2::Hub::Subtest; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::Hub; our @ISA = qw(Test2::Hub) } use Test2::Util::HashBase qw/nested exit_code manual_skip_all/; diff --git a/cpan/Test-Simple/lib/Test2/IPC.pm b/cpan/Test-Simple/lib/Test2/IPC.pm index 20c316306933..1f6478b6add0 100644 --- a/cpan/Test-Simple/lib/Test2/IPC.pm +++ b/cpan/Test-Simple/lib/Test2/IPC.pm @@ -2,7 +2,7 @@ package Test2::IPC; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Test2::API::Instance; diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm index 19d24100871d..35978070e201 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/confess/; diff --git a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm index de1c3f230ebd..a443c9193a1e 100644 --- a/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm +++ b/cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm @@ -2,7 +2,7 @@ package Test2::IPC::Driver::Files; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Test2::IPC::Driver; our @ISA = qw(Test2::IPC::Driver) } diff --git a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm index 1c7fef6c3bba..c9c5bb3215c2 100644 --- a/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm +++ b/cpan/Test-Simple/lib/Test2/Tools/Tiny.pm @@ -16,7 +16,7 @@ use Test2::API qw/context run_subtest test2_stack/; use Test2::Hub::Interceptor(); use Test2::Hub::Interceptor::Terminator(); -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; BEGIN { require Exporter; our @ISA = qw(Exporter) } our @EXPORT = qw{ diff --git a/cpan/Test-Simple/lib/Test2/Util.pm b/cpan/Test-Simple/lib/Test2/Util.pm index 5f683894f067..b78f80a9040d 100644 --- a/cpan/Test-Simple/lib/Test2/Util.pm +++ b/cpan/Test-Simple/lib/Test2/Util.pm @@ -2,7 +2,7 @@ package Test2::Util; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use POSIX(); use Config qw/%Config/; diff --git a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm index 8504d3016c35..cfa0a5699b8d 100644 --- a/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm +++ b/cpan/Test-Simple/lib/Test2/Util/ExternalMeta.pm @@ -2,7 +2,7 @@ package Test2::Util::ExternalMeta; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/croak/; diff --git a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm index 35fcace671f8..0e0ed65dbbcb 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Facets2Legacy.pm @@ -2,7 +2,7 @@ package Test2::Util::Facets2Legacy; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use Carp qw/croak confess/; use Scalar::Util qw/blessed/; diff --git a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm index 94a6725ff6a4..da1bf916a85b 100644 --- a/cpan/Test-Simple/lib/Test2/Util/HashBase.pm +++ b/cpan/Test-Simple/lib/Test2/Util/HashBase.pm @@ -2,7 +2,7 @@ package Test2::Util::HashBase; use strict; use warnings; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; ################################################################# # # diff --git a/cpan/Test-Simple/lib/Test2/Util/Trace.pm b/cpan/Test-Simple/lib/Test2/Util/Trace.pm index b1b4e529b8c0..b374064cbe48 100644 --- a/cpan/Test-Simple/lib/Test2/Util/Trace.pm +++ b/cpan/Test-Simple/lib/Test2/Util/Trace.pm @@ -6,7 +6,7 @@ use strict; our @ISA = ('Test2::EventFacet::Trace'); -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; 1; diff --git a/cpan/Test-Simple/lib/ok.pm b/cpan/Test-Simple/lib/ok.pm index a8813433beaa..880e4371bb58 100644 --- a/cpan/Test-Simple/lib/ok.pm +++ b/cpan/Test-Simple/lib/ok.pm @@ -1,5 +1,5 @@ package ok; -our $VERSION = '1.302182'; +our $VERSION = '1.302183'; use strict; use Test::More (); diff --git a/cpan/Test-Simple/t/Legacy/Regression/is_capture.t b/cpan/Test-Simple/t/Legacy/Regression/is_capture.t new file mode 100644 index 000000000000..1b8c73e10c45 --- /dev/null +++ b/cpan/Test-Simple/t/Legacy/Regression/is_capture.t @@ -0,0 +1,20 @@ +use strict; +use warnings; +use Test2::Tools::Tiny; + +# this test is only relevant under Devel::Cover + +require Test::More; + +my $destroy = 0; +sub CountDestroy::DESTROY { $destroy++ } + +my $obj = bless {}, 'CountDestroy'; + +Test::More::is($obj, $obj, 'compare object to itself using is'); + +undef $obj; + +is $destroy, 1, 'undef object destroyed after being passed to is'; + +done_testing; From 185eb2d3f6e86edc749ad9b20f1b6a1e0b231ad7 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Sat, 14 Nov 2020 10:11:54 +0000 Subject: [PATCH 011/503] Update Net-Ping to CPAN version 2.74 [DELTA] 2.74 2020-09-09 09:21:39 rurban Features - Add ICMPv6_NI_REPLY support. Bugfixes - Fix icmp payload offset to match icmpv6 (JimC Leones GH #21) Skip the 20 byte header to reliably find the various return types. This unifies icmpv6 with icmp better. - Fix $SOCKET::VERSION eval (Petr Pavlu, PR #22) META Changes - Fix and improve the META repository as hashref, license as arrayref (Tom Hukins, PR #19) - add TEST_REQUIRES - sort MANIFEST - add windows smokers: appveyor Test fixes - Improve the tcp test to localhost, when there is no route to localhost (freebsd mostly) - TODO a flaky 450_service.t on 127.0.0.1 on port 2 on Windows (analog to freebsd, ...) (Christian Walde, PR #20) - Skip 501_ping_icmpv6.t when icmpv6 cannot be initialized. Mostly due to missing icmpv6 support. (GH #15) - add more xt tests: t/602_kwalitee.t, t/603_meta.t, t/604_manifest.t --- Porting/Maintainers.pl | 8 +++++- dist/Net-Ping/Changes | 23 +++++++++++++++ dist/Net-Ping/lib/Net/Ping.pm | 52 +++++++++++++++++----------------- dist/Net-Ping/t/200_ping_tcp.t | 20 +++++++++++-- 4 files changed, 73 insertions(+), 30 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 54b1edb95641..cc5732fd0e85 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -843,13 +843,19 @@ package Maintainers; }, 'Net::Ping' => { - 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.73.tar.gz', + 'DISTRIBUTION' => 'RURBAN/Net-Ping-2.74.tar.gz', 'FILES' => q[dist/Net-Ping], 'EXCLUDED' => [ + qr{^\.[awc]}, qw(README.md.PL), qw(t/020_external.t), qw(t/600_pod.t), qw(t/601_pod-coverage.t), + qw(t/602_kwalitee.t), + qw(t/603_meta.t), + qw(t/604_manifest.t), + qw(t/appveyor-test.bat), + ], 'CUSTOMIZED' => [ qw{ diff --git a/dist/Net-Ping/Changes b/dist/Net-Ping/Changes index 51d655078960..9e5e9e80d1b3 100644 --- a/dist/Net-Ping/Changes +++ b/dist/Net-Ping/Changes @@ -1,5 +1,28 @@ CHANGES ------- +2.74 2020-09-09 09:21:39 rurban + Features + - Add ICMPv6_NI_REPLY support. + Bugfixes + - Fix icmp payload offset to match icmpv6 (JimC Leones GH #21) + Skip the 20 byte header to reliably find the various return types. + This unifies icmpv6 with icmp better. + - Fix $SOCKET::VERSION eval (Petr Pavlu, PR #22) + META Changes + - Fix and improve the META repository as hashref, license as arrayref + (Tom Hukins, PR #19) + - add TEST_REQUIRES + - sort MANIFEST + - add windows smokers: appveyor + Test fixes + - Improve the tcp test to localhost, when there is no route to localhost + (freebsd mostly) + - TODO a flaky 450_service.t on 127.0.0.1 on port 2 on Windows (analog to freebsd, ...) + (Christian Walde, PR #20) + - Skip 501_ping_icmpv6.t when icmpv6 cannot be initialized. Mostly due to missing + icmpv6 support. (GH #15) + - add more xt tests: t/602_kwalitee.t, t/603_meta.t, t/604_manifest.t + 2.73 Thu Feb 27 14:32:25 CET 2020 (rurban) Bugfixes - Fix shadowing of hash options in constructor (Patrick Heesom, RT #131919) diff --git a/dist/Net-Ping/lib/Net/Ping.pm b/dist/Net-Ping/lib/Net/Ping.pm index 779e55daeda0..19bb51ec1acd 100644 --- a/dist/Net-Ping/lib/Net/Ping.pm +++ b/dist/Net-Ping/lib/Net/Ping.pm @@ -8,6 +8,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION $def_timeout $def_proto $def_factor $def_family $max_datasize $pingstring $hires $source_verify $syn_forking); use Fcntl qw( F_GETFL F_SETFL O_NONBLOCK ); +use Socket 2.007; use Socket qw( SOCK_DGRAM SOCK_STREAM SOCK_RAW AF_INET PF_INET IPPROTO_TCP SOL_SOCKET SO_ERROR SO_BROADCAST IPPROTO_IP IP_TOS IP_TTL @@ -21,7 +22,7 @@ use Time::HiRes; @ISA = qw(Exporter); @EXPORT = qw(pingecho); @EXPORT_OK = qw(wakeonlan); -$VERSION = "2.73_01"; +$VERSION = "2.74"; # Globals @@ -46,7 +47,7 @@ my $NIx_NOSERV = eval { Socket::NIx_NOSERV() } || 2; #my $IPV6_HOPLIMIT = eval { Socket::IPV6_HOPLIMIT() }; # ping6 -h 0-255 my $qr_family = qr/^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/; my $qr_family4 = qr/^(?:(?:(:?ip)?v?4)|${\AF_INET})$/; -my $Socket_VERSION = eval { $Socket::VERSION }; +my $Socket_VERSION = eval $Socket::VERSION; if ($^O =~ /Win32/i) { # Hack to avoid this Win32 spewage: @@ -644,10 +645,11 @@ sub ping_external { # h2ph "asm/socket.h" # require "asm/socket.ph"; use constant SO_BINDTODEVICE => 25; -use constant ICMP_ECHOREPLY => 0; # ICMP packet types +use constant ICMP_ECHOREPLY => 0; # ICMP packet types use constant ICMPv6_ECHOREPLY => 129; # ICMP packet types -use constant ICMP_UNREACHABLE => 3; # ICMP packet types +use constant ICMP_UNREACHABLE => 3; # ICMP packet types use constant ICMPv6_UNREACHABLE => 1; # ICMP packet types +use constant ICMPv6_NI_REPLY => 140; # ICMP packet types use constant ICMP_ECHO => 8; use constant ICMPv6_ECHO => 128; use constant ICMP_TIME_EXCEEDED => 11; # ICMP packet types @@ -781,31 +783,25 @@ sub ping_icmp $from_saddr = recv($self->{fh}, $recv_msg, 1500, ICMP_FLAGS); $recv_msg_len = length($recv_msg) - length($self->{data}); ($from_port, $from_ip) = _unpack_sockaddr_in($from_saddr, $ip->{family}); - ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, 20, 2)); + # ICMP echo includes the header and ICMPv6 doesn't. + # IPv4 length($recv_msg) is 28 (20 header + 8 payload) + # while IPv6 length is only 8 (sans header). + my $off = ($ip->{family} == AF_INET) ? 20 : 0; # payload offset + ($from_type, $from_subcode) = unpack("C2", substr($recv_msg, $off, 2)); if ($from_type == ICMP_TIMESTAMP_REPLY) { - ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4)) - if length $recv_msg >= 28; - } elsif ($from_type == ICMP_ECHOREPLY) { + ($from_pid, $from_seq) = unpack("n3", substr($recv_msg, $off + 4, 4)) + if length $recv_msg >= $off + 8; + } elsif ($from_type == ICMP_ECHOREPLY || $from_type == ICMPv6_ECHOREPLY) { #warn "ICMP_ECHOREPLY: ", $ip->{family}, " ",$recv_msg, ":", length($recv_msg); - ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 24, 4)) - if ($ip->{family} == AF_INET && $recv_msg_len == 28); + ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, $off + 4, 4)) + if $recv_msg_len == $off + 8; + } elsif ($from_type == ICMPv6_NI_REPLY) { ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 4, 4)) - if ($ip->{family} == $AF_INET6 && $recv_msg_len == 8); - } elsif ($from_type == ICMPv6_ECHOREPLY) { - #($from_pid, $from_seq) = unpack("n3", substr($recv_msg, 24, 4)) - # if length $recv_msg >= 28; - #($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 24, 4)) - # if ($ip->{family} == AF_INET && length $recv_msg == 28); - #warn "ICMPv6_ECHOREPLY: ", $ip->{family}, " ",$recv_msg, ":", length($recv_msg); - ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 4, 4)) - if ($ip->{family} == $AF_INET6 && $recv_msg_len == 8); - #} elsif ($from_type == ICMPv6_NI_REPLY) { - # ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 4, 4)) - # if ($ip->{family} == $AF_INET6 && length $recv_msg == 8); + if ($ip->{family} == $AF_INET6 && length $recv_msg == 8); } else { #warn "ICMP: ", $from_type, " ",$ip->{family}, " ",$recv_msg, ":", length($recv_msg); - ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, 52, 4)) - if length $recv_msg >= 56; + ($from_pid, $from_seq) = unpack("n2", substr($recv_msg, $off + 32, 4)) + if length $recv_msg >= $off + 36; } $self->{from_ip} = $from_ip; $self->{from_type} = $from_type; @@ -2023,6 +2019,10 @@ Net::Ping - check a remote host for reachability } $p->close(); + $p = Net::Ping->new("icmpv6"); + $ip = "[fd00:dead:beef::4e]"; + print "$ip is alive.\n" if $p->ping($ip); + $p = Net::Ping->new("tcp", 2); # Try connecting to the www port instead of the echo port $p->port_number(scalar(getservbyname("http", "tcp"))); @@ -2368,7 +2368,7 @@ X The L method used with the icmp protocol. -=item $p->ping_icmpv6([$host, $timeout, $family]) I +=item $p->ping_icmpv6([$host, $timeout, $family]) X The L method used with the icmpv6 protocol. @@ -2574,7 +2574,7 @@ L =head1 COPYRIGHT -Copyright (c) 2017-2018, Reini Urban. All rights reserved. +Copyright (c) 2017-2020, Reini Urban. All rights reserved. Copyright (c) 2016, cPanel Inc. All rights reserved. diff --git a/dist/Net-Ping/t/200_ping_tcp.t b/dist/Net-Ping/t/200_ping_tcp.t index 47168b014ad9..e2bfe18c37df 100644 --- a/dist/Net-Ping/t/200_ping_tcp.t +++ b/dist/Net-Ping/t/200_ping_tcp.t @@ -44,14 +44,28 @@ eval { }; like($@, qr/message type only supported on 'icmp' protocol/, "message_type() API only concern 'icmp' protocol"); -isnt($p->ping("localhost"), 0, 'Test on the default port'); +my $localhost = $p->ping("localhost"); +if ($localhost) { + isnt($p->ping("localhost"), 0, 'Test on the default port'); +} else { + ok(1, "SKIP localhost on the default port on $^O"); +} # Change to use the more common web port. # This will pull from /etc/services on UNIX. # (Make sure getservbyname works in scalar context.) -isnt($p->{port_num} = (getservbyname("http", "tcp") || 80), undef); +isnt($p->{port_num} = (getservbyname("http", "tcp") || 80), undef, "getservbyname http"); -isnt($p->ping("localhost"), 0, 'Test localhost on the web port'); +if ($localhost) { + isnt($p->ping("localhost"), 0, 'Test localhost on the web port'); +} else { + my $result = $p->ping("localhost"); + if ($result) { + isnt($p->ping("localhost"), 0, "localhost on the web port unexpectedly worked on $^O"); + } else { + ok(1, "SKIP localhost on the web port on $^O"); + } +} is($p->ping($fail_ip), 0, "Can't reach $fail_ip"); From cfe2ff853c23d79ea3a2677abd7a55bafc8e717f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Nov 2020 14:44:29 -0700 Subject: [PATCH 012/503] perlapi: Fix up some MRO documentation mro_get_private_data() is core only; instead the public is supposed to use MRO_GET_PRIVATE_DATA(), which we now indicate is documented in perlmroapi, as well as HvMROMETA() --- embed.fnc | 2 +- pod/perlmroapi.pod | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/embed.fnc b/embed.fnc index fbfced5451d9..e96cf2be8b56 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3553,7 +3553,7 @@ XExop |void |emulate_cop_io |NN const COP *const c|NN SV *const sv : Used by SvRX and SvRXOK XExop |REGEXP *|get_re_arg|NULLOK SV *sv -Aopdh |SV* |mro_get_private_data|NN struct mro_meta *const smeta \ +Coph |SV* |mro_get_private_data|NN struct mro_meta *const smeta \ |NN const struct mro_alg *const which Aopdh |SV* |mro_set_private_data|NN struct mro_meta *const smeta \ |NN const struct mro_alg *const which \ diff --git a/pod/perlmroapi.pod b/pod/perlmroapi.pod index e0a4f704dca9..ad6d1e3eb127 100644 --- a/pod/perlmroapi.pod +++ b/pod/perlmroapi.pod @@ -79,7 +79,7 @@ stash, and a pointer to your C structure: meta = HvMROMETA(stash); private_sv = MRO_GET_PRIVATE_DATA(meta, &my_mro_alg); -=for apidoc mro_get_private_data +=for apidoc Amh|struct mro_meta *|HvMROMETA|HV *hv =for apidoc Amh|SV*|MRO_GET_PRIVATE_DATA|struct mro_meta *const smeta|const struct mro_alg *const which To set your private value, call C: From 1c137c72d5dc07332a55a4895542d2b805d4684e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Nov 2020 12:14:42 -0700 Subject: [PATCH 013/503] perlop: Note tr/// delimiters may be any printables --- pod/perlop.pod | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/pod/perlop.pod b/pod/perlop.pod index 1387dd69789a..51303be3a2a2 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -2584,7 +2584,8 @@ Unless the C option is used, the string specified with C<=~> must be a scalar variable, an array element, a hash element, or an assignment to one of those; in other words, an lvalue. -If the characters delimiting I and I +The characters delimitting I and I +can be any printable character, not just forward slashes. If they are single quotes (C'I'>), the only interpolation is removal of C<\> from pairs of C<\\>. From d1388a9f14b371b498f17bd56e201989bc88d12e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Nov 2020 13:13:49 -0700 Subject: [PATCH 014/503] embed.fnc: Add detail to u flag description --- embed.fnc | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/embed.fnc b/embed.fnc index e96cf2be8b56..48f2b8b3dac7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -512,9 +512,11 @@ : : For example, the expansion of STR_WITH_LEN is a comma separated pair of : values, so would have this flag; or some macros take preprocessor -: tokens, so would have this flag. This flag is an indication to -: downstream tools, such as Devel::PPPort, that this requires special -: handling. +: tokens, so would have this flag. +: +: This also is used for entries that require processing for use, such as +: being compiled by xsubpp. This flag is an indication to downstream +: tools, such as Devel::PPPort, that this requires special handling. : : U autodoc.pl will not output a usage example : From e207d6495b6cf122726e0f05a14616be7cac9c74 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 15 Nov 2020 12:54:51 -0700 Subject: [PATCH 015/503] Revert "op.h: Restrict scope of multiconcat symbols to core" This reverts commit a5d5855671af6956a8d1a13e419457afdffeb416. It turns out that CPAN modules are using these values; whether they should be using them or not, I don't know. --- op.h | 4 ---- 1 file changed, 4 deletions(-) diff --git a/op.h b/op.h index be193038a417..975071756240 100644 --- a/op.h +++ b/op.h @@ -1072,8 +1072,6 @@ C is non-null. For a higher-level interface, see C>. #endif -#if defined(PERL_CORE) || defined(PERL_EXT) - /* Stuff for OP_MULTDEREF/pp_multideref. */ /* actions */ @@ -1113,8 +1111,6 @@ C is non-null. For a higher-level interface, see C>. #define MDEREF_MASK 0x7F #define MDEREF_SHIFT 7 -#endif /* end CORE/EXT only */ - #if defined(PERL_IN_DOOP_C) || defined(PERL_IN_PP_C) # define FATAL_ABOVE_FF_MSG \ "Use of strings with code points over 0xFF as arguments to " \ From 54525b93d52a52326368ccf8a330d5b2d1e56089 Mon Sep 17 00:00:00 2001 From: Giovanni Tataranni Date: Fri, 6 Nov 2020 14:25:21 +0100 Subject: [PATCH 016/503] fix typo in pod/perlfunc.pod --- pod/perlfunc.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 37583f23e63b..d509eee584b0 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -5856,7 +5856,7 @@ symbol table the compiler uses for the rest of that block. You can refer to identifiers in other packages than the current one by prefixing the identifier with the package name and a double colon, as in C<$SomePack::var> or C. If package name is omitted, the C
-package as assumed. That is, C<$::sail> is equivalent to +package is assumed. That is, C<$::sail> is equivalent to C<$main::sail> (as well as to C<$main'sail>, still seen in ancient code, mostly from Perl 4). From 634c46dd7f5e5d370e3a06288d26390764b2e3fa Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 16 Nov 2020 09:43:36 +1100 Subject: [PATCH 017/503] Giovanni Tataranni is now a perl author --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 6644eb825bb3..6ce4fe7b30c6 100644 --- a/AUTHORS +++ b/AUTHORS @@ -460,6 +460,7 @@ Gerd Knops Gerrit P. Haase Gideon Israel Dsouza Giles Lean +Giovanni Tataranni Gisle Aas GitHub Glenn D. Golden From 607eaf26a99ff76ab48877e68f1d7b005dc51575 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Sun, 11 Oct 2020 12:26:27 +0100 Subject: [PATCH 018/503] pp_split: no SWITCHSTACK in @ary = split(...) optimisation --- pp.c | 93 ++++++++++++++++++++++++++++------------------------ t/op/split.t | 23 ++++++++++++- 2 files changed, 72 insertions(+), 44 deletions(-) diff --git a/pp.c b/pp.c index b0f67b1cf885..ce16c56e63a4 100644 --- a/pp.c +++ b/pp.c @@ -6011,6 +6011,7 @@ PP(pp_split) /* handle @ary = split(...) optimisation */ if (PL_op->op_private & OPpSPLIT_ASSIGN) { + realarray = 1; if (!(PL_op->op_flags & OPf_STACKED)) { if (PL_op->op_private & OPpSPLIT_LEX) { if (PL_op->op_private & OPpLVAL_INTRO) @@ -6033,30 +6034,10 @@ PP(pp_split) oldsave = PL_savestack_ix; } - realarray = 1; - PUTBACK; - av_extend(ary,0); - (void)sv_2mortal(SvREFCNT_inc_simple_NN(sv)); - av_clear(ary); - SPAGAIN; if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg)); - } - else { - if (!AvREAL(ary)) { - AvREAL_on(ary); - AvREIFY_off(ary); - - /* Note: the above av_clear(ary) above should */ - /* have set AvFILLp(ary) = -1, so this Zero() */ - /* may well be superfluous. */ - - /* don't free mere refs */ - Zero(AvARRAY(ary), AvFILLp(ary) + 1, SV*); - } - /* temporarily switch stacks */ - SAVESWITCHSTACK(PL_curstack, ary); + } else { make_mortal = 0; } } @@ -6378,29 +6359,56 @@ PP(pp_split) LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ SPAGAIN; if (realarray) { - if (!mg) { - if (SvSMAGICAL(ary)) { - PUTBACK; + if (!mg) { + PUTBACK; + if(AvREAL(ary)) { + if (av_count(ary) > 0) + av_clear(ary); + } else { + AvREAL_on(ary); + AvREIFY_off(ary); + + if (AvMAX(ary) > -1) { + /* don't free mere refs */ + Zero(AvARRAY(ary), AvMAX(ary), SV*); + } + } + if(AvMAX(ary) < iters) + av_extend(ary,iters); + SPAGAIN; + + /* Need to copy the SV*s from the stack into ary */ + Copy(SP + 1 - iters, AvARRAY(ary), iters, SV*); + AvFILLp(ary) = iters - 1; + + if (SvSMAGICAL(ary)) { + PUTBACK; mg_set(MUTABLE_SV(ary)); SPAGAIN; - } - if (gimme == G_ARRAY) { - EXTEND(SP, iters); - Copy(AvARRAY(ary), SP + 1, iters, SV*); - SP += iters; - RETURN; - } + } + + if (gimme != G_ARRAY) { + /* SP points to the final SV* pushed to the stack. But the SV* */ + /* are not going to be used from the stack. Point SP to below */ + /* the first of these SV*. */ + SP -= iters; + PUTBACK; + } } else { - PUTBACK; - ENTER_with_name("call_PUSH"); - call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); - LEAVE_with_name("call_PUSH"); - SPAGAIN; + PUTBACK; + av_extend(ary,iters); + av_clear(ary); + + ENTER_with_name("call_PUSH"); + call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); + LEAVE_with_name("call_PUSH"); + SPAGAIN; + if (gimme == G_ARRAY) { SSize_t i; /* EXTEND should not be needed - we just popped them */ - EXTEND(SP, iters); + EXTEND_SKIP(SP, iters); for (i=0; i < iters; i++) { SV **svp = av_fetch(ary, i, FALSE); PUSHs((svp) ? *svp : &PL_sv_undef); @@ -6409,13 +6417,12 @@ PP(pp_split) } } } - else { - if (gimme == G_ARRAY) - RETURN; - } - GETTARGET; - XPUSHi(iters); + if (gimme != G_ARRAY) { + GETTARGET; + XPUSHi(iters); + } + RETURN; } diff --git a/t/op/split.t b/t/op/split.t index ce6b0be12a07..1d78a45bde43 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -7,7 +7,7 @@ BEGIN { require './charset_tools.pl'; } -plan tests => 187; +plan tests => 193; $FS = ':'; @@ -663,6 +663,19 @@ is "@a", '1 2 3', 'assignment to split-to-array (stacked)'; is (+@a, 0, "empty utf8 string"); } +# correct stack adjustments (gh#18232) +{ + sub foo { return @_ } + my @a = foo(1, scalar split " ", "a b"); + is(join('', @a), "12", "Scalar split to a sub parameter"); +} + +{ + sub foo { return @_ } + my @a = foo(1, scalar(@x = split " ", "a b")); + is(join('', @a), "12", "Split to @x then use scalar result as a sub parameter"); +} + fresh_perl_is(<<'CODE', '', {}, "scalar split stack overflow"); map{int"";split//.0>60for"0000000000000000"}split// for"00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000" CODE @@ -682,3 +695,11 @@ CODE ok(eq_array(\@result,['a','b']), "Resulting in ('a','b')"); } } + +# check that the (@ary = split) optimisation survives @ary being modified + +fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");', + '',{},'(@ary = split ...) survives @ary being Renew()ed'); +fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");', + '',{},'(@ary = split ...) survives an (undef @ary)'); + From ab307de390c3459badcc89b3d77542b5b871b2e8 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 20 Oct 2020 18:16:38 +0100 Subject: [PATCH 019/503] pp_split: add TonyC's stack-not-refcounted-suggestion and tests --- pp.c | 5 ++++- t/op/split.t | 5 +++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/pp.c b/pp.c index ce16c56e63a4..5b5e1630110f 100644 --- a/pp.c +++ b/pp.c @@ -6034,6 +6034,9 @@ PP(pp_split) oldsave = PL_savestack_ix; } + /* Some defence against stack-not-refcounted bugs */ + (void)sv_2mortal(SvREFCNT_inc_simple_NN(ary)); + if ((mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied))) { PUSHMARK(SP); XPUSHs(SvTIED_obj(MUTABLE_SV(ary), mg)); @@ -6356,7 +6359,7 @@ PP(pp_split) } PUTBACK; - LEAVE_SCOPE(oldsave); /* may undo an earlier SWITCHSTACK */ + LEAVE_SCOPE(oldsave); SPAGAIN; if (realarray) { if (!mg) { diff --git a/t/op/split.t b/t/op/split.t index 1d78a45bde43..7a321645ac33 100644 --- a/t/op/split.t +++ b/t/op/split.t @@ -703,3 +703,8 @@ fresh_perl_is('my @ary; @ary = split(/\w(?{ @ary[1000] = 1 })/, "abc");', fresh_perl_is('my @ary; @ary = split(/\w(?{ undef @ary })/, "abc");', '',{},'(@ary = split ...) survives an (undef @ary)'); +# check the (@ary = split) optimisation survives stack-not-refcounted bugs +fresh_perl_is('our @ary; @ary = split(/\w(?{ *ary = 0 })/, "abc");', + '',{},'(@ary = split ...) survives @ary destruction via typeglob'); +fresh_perl_is('my $ary = []; @$ary = split(/\w(?{ $ary = [] })/, "abc");', + '',{},'(@ary = split ...) survives @ary destruction via reassignment'); From 16791992a0d974b4c400611f3ecf676603fe09cf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 16 Nov 2020 08:52:59 -0700 Subject: [PATCH 020/503] loc_tools.pl: Simplify an expression Suggested by Graham Knop --- t/loc_tools.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/t/loc_tools.pl b/t/loc_tools.pl index a87e7f63d330..15f5448b35d4 100644 --- a/t/loc_tools.pl +++ b/t/loc_tools.pl @@ -322,7 +322,8 @@ (;$) if ($has_LC_ALL) { push @categories_numbers, $category_number{'ALL'}; } - $_[0]->@* = @categories_numbers; + + @$categories_ref = @categories_numbers; } return 1; From c20c0658e5c4c7b3bbdfca09f4bbbbf2ca69eb09 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 16 Nov 2020 09:11:21 -0700 Subject: [PATCH 021/503] pat_advanced.t: Simplify a test I made this test to look as much as possible as the original report. Hugo van der Sanden pointed out that the encodes and decode together were essentially a no-op; so this commit removes them. --- t/re/pat_advanced.t | 3 --- 1 file changed, 3 deletions(-) diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index c469d5c59b29..8c6909569bb9 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -2565,12 +2565,9 @@ EOF { # GH $17278 assertion fails fresh_perl_is('use locale; my $A_grave = "\N{LATIN CAPITAL LETTER A WITH GRAVE}"; - utf8::encode($A_grave); my $a_grave = "\N{LATIN SMALL LETTER A WITH GRAVE}"; - utf8::encode($a_grave); my $z="q!$a_grave! =~ m!(?^i)[$A_grave]!"; - utf8::decode($z); print eval $z, "\n";', 1, {}, "GH #17278"); From c49e90e1c537fb7a87d1cab96922c29b243f0a9f Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Tue, 17 Nov 2020 09:59:22 +0000 Subject: [PATCH 022/503] I will release Perl 5.33.4 on Friday --- Porting/release_schedule.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 0fcaa29e53ac..de7bf858408e 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -43,7 +43,7 @@ you should reset the version numbers to the next blead series. 2020-08-20 5.33.1 ✓ Karen Etheridge 2020-09-20 5.33.2 ✓ Sawyer X 2020-10-20 5.33.3 ✓ Steve Hay - 2020-11-20 5.33.4 + 2020-11-20 5.33.4 Tom Hukins 2020-12-20 5.33.5 2021-01-20 5.33.6 2021-02-20 5.33.7 Renee Backer From 0827d918bc73a32c757b0627190266822a932467 Mon Sep 17 00:00:00 2001 From: Nicolas R Date: Thu, 15 Oct 2020 11:32:33 -0600 Subject: [PATCH 023/503] irc-notifications: use GITHUB_ENV GH #18329 ::set-env is deprecated use GITHUB_ENV instead --- .github/workflows/irc-notifications.yaml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/.github/workflows/irc-notifications.yaml b/.github/workflows/irc-notifications.yaml index 83e61c24f1d2..ef9a3569f8eb 100644 --- a/.github/workflows/irc-notifications.yaml +++ b/.github/workflows/irc-notifications.yaml @@ -25,8 +25,7 @@ jobs: - name: setup branch env name run: | ref="${github_ref/refs\/heads\//}" - echo "setenv ref=$ref" - echo "::set-env name=ref::$ref" + echo "ref=$ref" >> $GITHUB_ENV env: github_ref: ${{ github.event.ref }} From 75fe58babe8340677c01ff88c37427e51357ec6f Mon Sep 17 00:00:00 2001 From: Nicolas R Date: Tue, 17 Nov 2020 12:20:07 -0700 Subject: [PATCH 024/503] Limit the number of lines in IRC notification --- .github/workflows/irc-notifications.yaml | 70 ++++++++++++++++++------ 1 file changed, 53 insertions(+), 17 deletions(-) diff --git a/.github/workflows/irc-notifications.yaml b/.github/workflows/irc-notifications.yaml index ef9a3569f8eb..7cb111ee65e1 100644 --- a/.github/workflows/irc-notifications.yaml +++ b/.github/workflows/irc-notifications.yaml @@ -29,6 +29,57 @@ jobs: env: github_ref: ${{ github.event.ref }} + - name: Setup commit message SUMUP env + env: + TXT: ${{ join(github.event.commits.*.message, '\n') }} + C1: ${{ github.event.commits[0].message }} + C2: ${{ github.event.commits[1].message }} + C3: ${{ github.event.commits[2].message }} + C4: ${{ github.event.commits[3].message }} + C5: ${{ github.event.commits[4].message }} + run: | + # ------------------------------------- + echo "# original commit message" + echo "TXT=$TXT" + + # ------------------------------------- + echo "# Last 5 commits message" + echo "C1=$C1" + echo "C2=$C2" + echo "C3=$C3" + echo "C4=$C4" + echo "C5=$C5" + + # ------------------------------------- + echo "# script parse.pl" + cat <<'EOS' > parse.pl + use v5.14; use strict; use warnings; + my $txt = join "\n", map { $ENV{"C$_"} // '' } 1..5; + $txt =~ s{\\n}{\n}g; $txt =~ s{\\t}{ }g; $txt =~ s{\t}{ }g; + my @l = split( "\n", $txt ); + my $max = 5; + @l = ( @l[0..$max], "..." ) if @l > $max; + @l = grep { $_ !~ m{^EOF} } @l; + say( join( "\n", @l ) ); + EOS + + # ------------------------------------- + echo "# testing script" + perl parse.pl + + # ------------------------------------- + echo "# setup SUMUP environment variable" + echo 'SUMUP<> $GITHUB_ENV + perl parse.pl >> $GITHUB_ENV + echo 'EOF' >> $GITHUB_ENV + + # ------------------------------------- + echo "# done" + + - name: checking SUMUP variable + run: | + echo "SUMUP: $SUMUP" + - name: irc push uses: rectalogic/notify-irc@v1 if: github.event_name == 'push' && github.ref != 'refs/heads/blead' @@ -39,7 +90,7 @@ jobs: nickname: Commit message: "\x037${{ github.actor }}\x0F pushed to branch \x033${{ env.ref }}\x0F\n\ - ${{ join(github.event.commits.*.message, '\n') }}\n\ + ${{ env.SUMUP }}\n\ ${{ github.event.compare }}" - name: irc push to blead @@ -52,7 +103,7 @@ jobs: nickname: inBlead message: "\x0313[blead]\x0F \x037${{ github.actor }}\x0F pushed to blead\n\ - ${{ join(github.event.commits.*.message, '\n') }}\n\ + ${{ env.SUMUP }}\n\ ${{ github.event.compare }}" - name: irc opened pull request @@ -81,18 +132,3 @@ jobs: "\x037${{ github.actor }}\x0F updated PR #${{ github.event.pull_request.number }}\n\ ${{ github.event.pull_request.title }}\n\ ${{ github.event.pull_request.html_url }}" - - # steps: - # - name: Pull request merged - # if: github.action == 'closed' && github.pull_request.merged == 'true' - # run: echo merged - # - name: irc tag created - # uses: rectalogic/notify-irc@v1 - # if: github.event_name == 'create' && github.event.ref_type == 'tag' - # with: - # server: ssl.irc.perl.org - # port: 7062 - # channel: "#p5p-commits" - # nickname: new-Tag - # message: | - # ${{ github.actor }} tagged ${{ github.repository }} ${{ github.event.ref }} From 831124b556f4486f9582458f096ede67617cdc42 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:23:15 -0600 Subject: [PATCH 025/503] perlapi: Consolidate sv_catpvn-ish entries --- mathoms.c | 8 -------- sv.c | 39 +++++++++++++++++++++++---------------- sv.h | 4 ---- 3 files changed, 23 insertions(+), 28 deletions(-) diff --git a/mathoms.c b/mathoms.c index 7b85ae749abc..332c57e24805 100644 --- a/mathoms.c +++ b/mathoms.c @@ -263,14 +263,6 @@ Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); } -/* -=for apidoc sv_catpvn_mg - -Like C, but also handles 'set' magic. - -=cut -*/ - void Perl_sv_catpvn_mg(pTHX_ SV *dsv, const char *sstr, STRLEN len) { diff --git a/sv.c b/sv.c index 9a45392cff9b..b5e3a72b6461 100644 --- a/sv.c +++ b/sv.c @@ -5433,27 +5433,34 @@ Perl_sv_chop(pTHX_ SV *const sv, const char *const ptr) /* =for apidoc sv_catpvn +=for apidoc_item sv_catpvn_flags +=for apidoc_item sv_catpvn_mg +=for apidoc_item sv_catpvn_nomg -Concatenates the string onto the end of the string which is in the SV. -C indicates number of bytes to copy. If the SV has the UTF-8 -status set, then the bytes appended should be valid UTF-8. -Handles 'get' magic, but not 'set' magic. See C>. +These concatenate the C bytes of the string beginning at C onto the +end of the string which is in C. The caller must make sure C +contains at least C bytes. -=for apidoc sv_catpvn_flags +For all but C, the string appended is assumed to be valid +UTF-8 if the SV has the UTF-8 status set, and a string of bytes otherwise. -Concatenates the string onto the end of the string which is in the SV. The -C indicates number of bytes to copy. +They differ in that: -By default, the string appended is assumed to be valid UTF-8 if the SV has -the UTF-8 status set, and a string of bytes otherwise. One can force the -appended string to be interpreted as UTF-8 by supplying the C -flag, and as bytes by supplying the C flag; the SV or the -string appended will be upgraded to UTF-8 if necessary. +C performs both 'get' and 'set' magic on C. -If C has the C bit set, will -C> on C afterwards if appropriate. -C and C are implemented -in terms of this function. +C performs only 'get' magic. + +C skips all magic. + +C has an extra C parameter which allows you to specify +any combination of magic handling (using C and/or C) and +to also override the UTF-8 handling. By supplying the C flag, the +appended string is interpreted as plain bytes; by supplying instead the +C flag, it will be interpreted as UTF-8, and the C will be +upgraded to UTF-8 if necessary. + +C, C, and C are implemented +in terms of C. =for apidoc Amnh||SV_CATUTF8 =for apidoc Amnh||SV_CATBYTES diff --git a/sv.h b/sv.h index 2ad0a5c68618..bf4885b76c14 100644 --- a/sv.h +++ b/sv.h @@ -1717,15 +1717,11 @@ COW). Returns a boolean indicating whether the SV is Copy-On-Write shared hash key scalar. -=for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len -Like C but doesn't process magic. - =for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr Like C but doesn't process magic. =for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv Like C but doesn't process magic. - =cut */ From 2228b3d92dc6b04915a758fc6d3e4d724fb976c7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:31:27 -0600 Subject: [PATCH 026/503] perlapi: Consolidate sv_catsv-ish entries --- mathoms.c | 8 -------- sv.c | 31 ++++++++++++++++++++----------- sv.h | 2 -- 3 files changed, 20 insertions(+), 21 deletions(-) diff --git a/mathoms.c b/mathoms.c index 332c57e24805..a07b26019a07 100644 --- a/mathoms.c +++ b/mathoms.c @@ -283,14 +283,6 @@ Perl_sv_catsv(pTHX_ SV *dsv, SV *sstr) sv_catsv_flags(dsv, sstr, SV_GMAGIC); } -/* -=for apidoc sv_catsv_mg - -Like C, but also handles 'set' magic. - -=cut -*/ - void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *sstr) { diff --git a/sv.c b/sv.c index b5e3a72b6461..4e9f45a7f88d 100644 --- a/sv.c +++ b/sv.c @@ -5516,20 +5516,29 @@ Perl_sv_catpvn_flags(pTHX_ SV *const dsv, const char *sstr, const STRLEN slen, c /* =for apidoc sv_catsv +=for apidoc_item sv_catsv_flags +=for apidoc_item sv_catsv_mg +=for apidoc_item sv_catsv_nomg -Concatenates the string from SV C onto the end of the string in SV -C. If C is null, does nothing; otherwise modifies only C. -Handles 'get' magic on both SVs, but no 'set' magic. See C> -and C>. +These concatenate the string from SV C onto the end of the string in SV +C. If C is null, these are no-ops; otherwise only C is +modified. -=for apidoc sv_catsv_flags +They differ only in what magic they perform: -Concatenates the string from SV C onto the end of the string in SV -C. If C is null, does nothing; otherwise modifies only C. -If C has the C bit set, will call C> on both SVs if -appropriate. If C has the C bit set, C> will be called on -the modified SV afterward, if appropriate. C, C, -and C are implemented in terms of this function. +C performs 'get' magic on both SVs before the copy, and 'set' magic +on C afterwards. + +C performs just 'get' magic, on both SVs. + +C skips all magic. + +C has an extra C parameter which allows you to use +C and/or C to specify any combination of magic handling +(although either both or neither SV will have 'get' magic applied to it.) + +C, C, and C are implemented +in terms of C. =cut */ diff --git a/sv.h b/sv.h index bf4885b76c14..fc35f346e637 100644 --- a/sv.h +++ b/sv.h @@ -1720,8 +1720,6 @@ scalar. =for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr Like C but doesn't process magic. -=for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv -Like C but doesn't process magic. =cut */ From 3af695f3325716a03a79f2b1a27b032ed4698bfa Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 17 Nov 2020 19:15:06 -0700 Subject: [PATCH 027/503] Move regcurly to regcomp.c (from inline.h) This function is called only at compile time; experience has shown that compile-time operations are not time-critical. And future commits will lengthen it, making it not practically inlinable anyway. --- embed.fnc | 2 +- embed.h | 2 +- inline.h | 30 ------------------------------ proto.h | 4 +--- regcomp.c | 24 ++++++++++++++++++++++++ 5 files changed, 27 insertions(+), 35 deletions(-) diff --git a/embed.fnc b/embed.fnc index 48f2b8b3dac7..2d2c703c5b77 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2343,7 +2343,7 @@ EXTp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsigned int EpX |SV* |invlist_clone |NN SV* const invlist|NULLOK SV* newlist #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -EiRT |bool |regcurly |NN const char *s +EXpRT |bool |regcurly |NN const char *s #endif #if defined(PERL_IN_REGEXEC_C) ERS |bool |isFOO_utf8_lc |const U8 classnum|NN const U8* character|NN const U8* e diff --git a/embed.h b/embed.h index 2cc69349d0ea..6348d64d1746 100644 --- a/embed.h +++ b/embed.h @@ -1156,7 +1156,7 @@ #define invlist_clone(a,b) Perl_invlist_clone(aTHX_ a,b) # endif # if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -#define regcurly S_regcurly +#define regcurly Perl_regcurly # endif # if defined(PERL_IN_REGEXEC_C) #define advance_one_LB(a,b,c) S_advance_one_LB(aTHX_ a,b,c) diff --git a/inline.h b/inline.h index 96f706ed8b67..5ada1555d1a2 100644 --- a/inline.h +++ b/inline.h @@ -1994,36 +1994,6 @@ S_lossless_NV_to_IV(const NV nv, IV *ivp) #endif -/* ------------------ regcomp.c, toke.c ------------ */ - -#if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) - -/* - - regcurly - a little FSA that accepts {\d+,?\d*} - Pulled from reg.c. - */ -PERL_STATIC_INLINE bool -S_regcurly(const char *s) -{ - PERL_ARGS_ASSERT_REGCURLY; - - if (*s++ != '{') - return FALSE; - if (!isDIGIT(*s)) - return FALSE; - while (isDIGIT(*s)) - s++; - if (*s == ',') { - s++; - while (isDIGIT(*s)) - s++; - } - - return *s == '}'; -} - -#endif - /* ------------------ pp.c, regcomp.c, toke.c, universal.c ------------ */ #if defined(PERL_IN_PP_C) || defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) || defined(PERL_IN_UNIVERSAL_C) diff --git a/proto.h b/proto.h index 63618754ac7a..5e1be0214908 100644 --- a/proto.h +++ b/proto.h @@ -6127,12 +6127,10 @@ PERL_CALLCONV SV* Perl_invlist_clone(pTHX_ SV* const invlist, SV* newlist); assert(invlist) #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -#ifndef PERL_NO_INLINE_FUNCTIONS -PERL_STATIC_INLINE bool S_regcurly(const char *s) +PERL_CALLCONV bool Perl_regcurly(const char *s) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_REGCURLY \ assert(s) -#endif #endif #if defined(PERL_IN_REGEXEC_C) diff --git a/regcomp.c b/regcomp.c index 308d5def3c1c..853501c030b7 100644 --- a/regcomp.c +++ b/regcomp.c @@ -12549,6 +12549,30 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) return ret; } +/* + - regcurly - a little FSA that accepts {\d+,?\d*} + Pulled from reg.c. + */ +bool +Perl_regcurly(const char *s) +{ + PERL_ARGS_ASSERT_REGCURLY; + + if (*s++ != '{') + return FALSE; + if (!isDIGIT(*s)) + return FALSE; + while (isDIGIT(*s)) + s++; + if (*s == ',') { + s++; + while (isDIGIT(*s)) + s++; + } + + return *s == '}'; +} + /* - regpiece - something followed by possible quantifier * + ? {n,m} * From 1d210779fca4e1f38a05cc35fab98b7584f54f27 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 23 Jul 2020 09:24:06 -0600 Subject: [PATCH 028/503] Remove PERLIO_FUNCS_CONST As the comment said, this was temporary until vtables got to be all const --- perl.h | 3 --- perlio.h | 7 ------- perliol.h | 25 +++++++++---------------- 3 files changed, 9 insertions(+), 26 deletions(-) diff --git a/perl.h b/perl.h index 2358a7075b8f..70112bd81c46 100644 --- a/perl.h +++ b/perl.h @@ -135,9 +135,6 @@ Otherwise ends a section of code already begun by a C>. # endif #endif -/* this used to be off by default, now its on, see perlio.h */ -#define PERLIO_FUNCS_CONST - #ifdef PERL_IMPLICIT_CONTEXT # ifndef MULTIPLICITY # define MULTIPLICITY diff --git a/perlio.h b/perlio.h index ee16ab8774e4..836ff6f72f4b 100644 --- a/perlio.h +++ b/perlio.h @@ -63,15 +63,8 @@ typedef PerlIOl *PerlIO; #define PerlIO PerlIO #define PERLIO_LAYERS 1 -/* PERLIO_FUNCS_CONST is now on by default for efficiency, PERLIO_FUNCS_CONST - can be removed 1 day once stable & then PerlIO vtables are permanently RO */ -#ifdef PERLIO_FUNCS_CONST #define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs #define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs) -#else -#define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs -#define PERLIO_FUNCS_CAST(funcs) (funcs) -#endif PERL_CALLCONV void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab); PERL_CALLCONV PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, diff --git a/perliol.h b/perliol.h index 40b4224e508a..66100614b20e 100644 --- a/perliol.h +++ b/perliol.h @@ -106,23 +106,16 @@ struct _PerlIO { #define PerlIOValid(f) ((f) && *(f)) /*--------------------------------------------------------------------------------------*/ -/* Data exports - EXTCONST rather than extern is needed for Cygwin */ -#undef EXTPERLIO -#ifdef PERLIO_FUNCS_CONST -#define EXTPERLIO EXTCONST -#else -#define EXTPERLIO EXT -#endif -EXTPERLIO PerlIO_funcs PerlIO_unix; -EXTPERLIO PerlIO_funcs PerlIO_perlio; -EXTPERLIO PerlIO_funcs PerlIO_stdio; -EXTPERLIO PerlIO_funcs PerlIO_crlf; -EXTPERLIO PerlIO_funcs PerlIO_utf8; -EXTPERLIO PerlIO_funcs PerlIO_byte; -EXTPERLIO PerlIO_funcs PerlIO_raw; -EXTPERLIO PerlIO_funcs PerlIO_pending; +EXTCONST PerlIO_funcs PerlIO_unix; +EXTCONST PerlIO_funcs PerlIO_perlio; +EXTCONST PerlIO_funcs PerlIO_stdio; +EXTCONST PerlIO_funcs PerlIO_crlf; +EXTCONST PerlIO_funcs PerlIO_utf8; +EXTCONST PerlIO_funcs PerlIO_byte; +EXTCONST PerlIO_funcs PerlIO_raw; +EXTCONST PerlIO_funcs PerlIO_pending; #ifdef WIN32 -EXTPERLIO PerlIO_funcs PerlIO_win32; +EXTCONST PerlIO_funcs PerlIO_win32; #endif PERL_CALLCONV PerlIO *PerlIO_allocate(pTHX); PERL_CALLCONV SV *PerlIO_arg_fetch(PerlIO_list_t *av, IV n); From 897b41d9566b5d8b85e5a17526de5ca62ee40a71 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 15:45:58 -0600 Subject: [PATCH 029/503] perlapi: Document memzero --- perl.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/perl.h b/perl.h index 70112bd81c46..e8ecb1b34e83 100644 --- a/perl.h +++ b/perl.h @@ -1376,6 +1376,12 @@ Use L to declare variables of the maximum usable size on this platform. #define MALLOC_TOO_LATE_FOR(ch) TOO_LATE_FOR_(ch, " with $ENV{PERL_MALLOC_OPT}") #define MALLOC_CHECK_TAINT2(argc,argv) MALLOC_CHECK_TAINT(argc,argv,NULL) +/* +=for apidoc Am|void|memzero|void * d|Size_t l +Set the C bytes starting at C<*d> to all zeroes. + +=cut +*/ #ifndef memzero # define memzero(d,l) memset(d,0,l) #endif From 87e5fe87c2c19e28989530999e8efe60b85cdb12 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:56:01 -0600 Subject: [PATCH 030/503] embed.fnc: Mark 3 sighandler fcns as Core only These appear to be for internal use, with no cpan usage found --- embed.fnc | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/embed.fnc b/embed.fnc index 2d2c703c5b77..97d85a8c98d9 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1739,16 +1739,16 @@ Ap |HEK* |share_hek |NN const char* str|SSize_t len|U32 hash #ifdef PERL_USE_3ARG_SIGHANDLER : Used in perl.c Tp |Signal_t |sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap -ATp |Signal_t |csighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap +CTp |Signal_t |csighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap #else Tp |Signal_t |sighandler |int sig -ATp |Signal_t |csighandler |int sig +CTp |Signal_t |csighandler |int sig #endif Tp |Signal_t |sighandler1 |int sig -ATp |Signal_t |csighandler1 |int sig +CTp |Signal_t |csighandler1 |int sig Tp |Signal_t |sighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap -ATp |Signal_t |csighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap -ATp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe +CTp |Signal_t |csighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap +CTp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n Ap |I32 |start_subparse |I32 is_format|U32 flags Xp |void |init_named_cv |NN CV *cv|NN OP *nameop From bcf3564c67eb142f6b534cb04acdf34604567910 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 18 Nov 2020 15:40:23 +0000 Subject: [PATCH 031/503] Update Pod-Simple to CPAN version 3.42 --- Porting/Maintainers.pl | 2 +- cpan/Pod-Simple/lib/Pod/Simple.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm | 8 +++----- cpan/Pod-Simple/lib/Pod/Simple/Checker.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Debug.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/HTML.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Methody.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Progress.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/RTF.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Search.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Text.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm | 2 +- cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm | 2 +- 28 files changed, 30 insertions(+), 32 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index cc5732fd0e85..3b90a104bace 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -950,7 +950,7 @@ package Maintainers; }, 'Pod::Simple' => { - 'DISTRIBUTION' => 'KHW/Pod-Simple-3.41.tar.gz', + 'DISTRIBUTION' => 'KHW/Pod-Simple-3.42.tar.gz', 'FILES' => q[cpan/Pod-Simple], 'EXCLUDED' => [ qw{.ChangeLog.swp}, diff --git a/cpan/Pod-Simple/lib/Pod/Simple.pm b/cpan/Pod-Simple/lib/Pod/Simple.pm index 504baff706f0..f2544d0ef10c 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple.pm @@ -18,7 +18,7 @@ use vars qw( ); @ISA = ('Pod::Simple::BlackBox'); -$VERSION = '3.41'; +$VERSION = '3.42'; @Known_formatting_codes = qw(I B C L E F S X Z); %Known_formatting_codes = map(($_=>1), @Known_formatting_codes); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm index 17b8f6d7db1a..03dede7c34ca 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/BlackBox.pm @@ -22,7 +22,7 @@ use integer; # vroom! use strict; use Carp (); use vars qw($VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; #use constant DEBUG => 7; sub my_qr ($$) { @@ -139,10 +139,8 @@ sub parse_lines { # Usage: $parser->parse_lines(@lines) # An attempt to match the pod portions of a line. This is not fool proof, # but is good enough to serve as part of the heuristic for guessing the pod # encoding if not specified. - my $format_codes = join "", '[', grep { / ^ [A-Za-z] $/x } - keys %{$self->{accept_codes}}; - $format_codes .= ']'; - my $pod_chars_re = qr/ ^ = [A-Za-z]+ | $format_codes < /x; + my $codes = join '', grep { / ^ [A-Za-z] $/x } sort keys %{$self->{accept_codes}}; + my $pod_chars_re = qr/ ^ = [A-Za-z]+ | [\Q$codes\E] < /x; my $line; foreach my $source_line (@_) { diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm b/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm index 1f94afe8d020..65f4d54243f9 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Checker.pm @@ -9,7 +9,7 @@ use Carp (); use Pod::Simple::Methody (); use Pod::Simple (); use vars qw( @ISA $VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm index 1e089ccf1bdc..6b9aa327c01d 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Debug.pm @@ -2,7 +2,7 @@ require 5; package Pod::Simple::Debug; use strict; use vars qw($VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; sub import { my($value,$variable); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm index dad0b69cb288..a22603043bdd 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsText.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::DumpAsText; -$VERSION = '3.41'; +$VERSION = '3.42'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm index 4531f9ce7878..024e4b7b8195 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/DumpAsXML.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::DumpAsXML; -$VERSION = '3.41'; +$VERSION = '3.42'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm index 8ad7572c56c4..f930a512172c 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/HTML.pm @@ -9,7 +9,7 @@ use vars qw( $Doctype_decl $Content_decl ); @ISA = ('Pod::Simple::PullParser'); -$VERSION = '3.41'; +$VERSION = '3.42'; BEGIN { if(defined &DEBUG) { } # no-op elsif( defined &Pod::Simple::DEBUG ) { *DEBUG = \&Pod::Simple::DEBUG } diff --git a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm index 144387ebc016..6a06173f471c 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/HTMLBatch.pm @@ -5,7 +5,7 @@ use strict; use vars qw( $VERSION $HTML_RENDER_CLASS $HTML_EXTENSION $CSS $JAVASCRIPT $SLEEPY $SEARCH_CLASS @ISA ); -$VERSION = '3.41'; +$VERSION = '3.42'; @ISA = (); # Yup, we're NOT a subclass of Pod::Simple::HTML! # TODO: nocontents stylesheets. Strike some of the color variations? diff --git a/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm b/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm index ced4c3f4d26c..a6898caec438 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/LinkSection.pm @@ -6,7 +6,7 @@ package Pod::Simple::LinkSection; use strict; use Pod::Simple::BlackBox; use vars qw($VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; use overload( # So it'll stringify nice '""' => \&Pod::Simple::BlackBox::stringify_lol, diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm b/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm index d8fd3f2626e8..45e26cf46370 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Methody.pm @@ -4,7 +4,7 @@ package Pod::Simple::Methody; use strict; use Pod::Simple (); use vars qw(@ISA $VERSION); -$VERSION = '3.41'; +$VERSION = '3.42'; @ISA = ('Pod::Simple'); # Yes, we could use named variables, but I want this to be impose diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm b/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm index 5840c8cff44e..77de9ae86f43 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Progress.pm @@ -1,7 +1,7 @@ require 5; package Pod::Simple::Progress; -$VERSION = '3.41'; +$VERSION = '3.42'; use strict; # Objects of this class are used for noting progress of an diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm index 133dd2ff8471..57aad9ac085b 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParser.pm @@ -1,6 +1,6 @@ require 5; package Pod::Simple::PullParser; -$VERSION = '3.41'; +$VERSION = '3.42'; use Pod::Simple (); BEGIN {@ISA = ('Pod::Simple')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm index 8a138f548300..dbff3df249d1 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserEndToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.41'; +$VERSION = '3.42'; sub new { # Class->new(tagname); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm index c3b56d529d10..1ab33cc6e0ab 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserStartToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.41'; +$VERSION = '3.42'; sub new { # Class->new(tagname, optional_attrhash); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm index dd60a951e972..cdce959db4ba 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserTextToken.pm @@ -5,7 +5,7 @@ use Pod::Simple::PullParserToken (); use strict; use vars qw(@ISA $VERSION); @ISA = ('Pod::Simple::PullParserToken'); -$VERSION = '3.41'; +$VERSION = '3.42'; sub new { # Class->new(text); my $class = shift; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm b/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm index f4b00d2aff90..63a2dabe6f33 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/PullParserToken.pm @@ -3,7 +3,7 @@ require 5; package Pod::Simple::PullParserToken; # Base class for tokens gotten from Pod::Simple::PullParser's $parser->get_token @ISA = (); -$VERSION = '3.41'; +$VERSION = '3.42'; use strict; sub new { # Class->new('type', stuff...); ## Overridden in derived classes anyway diff --git a/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm b/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm index 9f9c2aca578f..10e05c5d0a4f 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/RTF.pm @@ -8,7 +8,7 @@ package Pod::Simple::RTF; use strict; use vars qw($VERSION @ISA %Escape $WRAP %Tagmap); -$VERSION = '3.41'; +$VERSION = '3.42'; use Pod::Simple::PullParser (); BEGIN {@ISA = ('Pod::Simple::PullParser')} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Search.pm b/cpan/Pod-Simple/lib/Pod/Simple/Search.pm index 0fbad86de6b1..ad610654c998 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Search.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Search.pm @@ -3,7 +3,7 @@ package Pod::Simple::Search; use strict; use vars qw($VERSION $MAX_VERSION_WITHIN $SLEEPY); -$VERSION = '3.41'; ## Current version of this package +$VERSION = '3.42'; ## Current version of this package BEGIN { *DEBUG = sub () {0} unless defined &DEBUG; } # set DEBUG level use Carp (); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm b/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm index 63c82cafc1c0..38a2704f8766 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/SimpleTree.pm @@ -5,7 +5,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '3.41'; +$VERSION = '3.42'; BEGIN { @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Text.pm b/cpan/Pod-Simple/lib/Pod/Simple/Text.pm index 7feb4c504b81..2f0254ec37d3 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Text.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Text.pm @@ -6,7 +6,7 @@ use Carp (); use Pod::Simple::Methody (); use Pod::Simple (); use vars qw( @ISA $VERSION $FREAKYMODE); -$VERSION = '3.41'; +$VERSION = '3.42'; @ISA = ('Pod::Simple::Methody'); BEGIN { *DEBUG = defined(&Pod::Simple::DEBUG) ? \&Pod::Simple::DEBUG diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm b/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm index affb917edc17..ccbf4242214f 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TextContent.pm @@ -6,7 +6,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( @ISA $VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; @ISA = ('Pod::Simple'); sub new { diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm b/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm index 93d9804c6ed2..cbf58b370694 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TiedOutFH.pm @@ -4,7 +4,7 @@ package Pod::Simple::TiedOutFH; use Symbol ('gensym'); use Carp (); use vars qw($VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; #~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm b/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm index 8cb71d1aebb5..bdb7181af646 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/Transcode.pm @@ -3,7 +3,7 @@ require 5; package Pod::Simple::Transcode; use strict; use vars qw($VERSION @ISA); -$VERSION = '3.41'; +$VERSION = '3.42'; BEGIN { if(defined &DEBUG) {;} # Okay diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm index 3f9d09d894de..96e6a544102e 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeDumb.pm @@ -5,7 +5,7 @@ require 5; package Pod::Simple::TranscodeDumb; use strict; use vars qw($VERSION %Supported); -$VERSION = '3.41'; +$VERSION = '3.42'; # This module basically pretends it knows how to transcode, except # only for null-transcodings! We use this when Encode isn't # available. diff --git a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm index 4d1004d8daa1..3f3224f917bf 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/TranscodeSmart.pm @@ -9,7 +9,7 @@ use strict; use Pod::Simple; require Encode; use vars qw($VERSION ); -$VERSION = '3.41'; +$VERSION = '3.42'; sub is_dumb {0} sub is_smart {1} diff --git a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm index d4f59dd1ed5d..9049ce755ff2 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/XHTML.pm @@ -45,7 +45,7 @@ declare the output character set as UTF-8 before parsing, like so: package Pod::Simple::XHTML; use strict; use vars qw( $VERSION @ISA $HAS_HTML_ENTITIES ); -$VERSION = '3.41'; +$VERSION = '3.42'; use Pod::Simple::Methody (); @ISA = ('Pod::Simple::Methody'); diff --git a/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm b/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm index a85520991ed7..a891a3341f5b 100644 --- a/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm +++ b/cpan/Pod-Simple/lib/Pod/Simple/XMLOutStream.pm @@ -5,7 +5,7 @@ use strict; use Carp (); use Pod::Simple (); use vars qw( $ATTR_PAD @ISA $VERSION $SORT_ATTRS); -$VERSION = '3.41'; +$VERSION = '3.42'; BEGIN { @ISA = ('Pod::Simple'); *DEBUG = \&Pod::Simple::DEBUG unless defined &DEBUG; From 3dcca105f68f9a3c4474da8390e439dd6bc34a74 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 12 Nov 2020 14:40:19 -0700 Subject: [PATCH 032/503] re/fold_grind.pl: Test a couple more code points These add tests for checking that the revised folding in a future commit works in some edge cases that previously weren't an issue. --- t/re/fold_grind.pl | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/t/re/fold_grind.pl b/t/re/fold_grind.pl index fb0d3620e88c..a5ae6fd0fd18 100644 --- a/t/re/fold_grind.pl +++ b/t/re/fold_grind.pl @@ -45,9 +45,23 @@ BEGIN # Special-cased characters in the .c's that we want to make sure get tested. my %be_sure_to_test = ( chr utf8::unicode_to_native(0xDF) => 1, # LATIN_SMALL_LETTER_SHARP_S - "\x{1E9E}" => 1, # LATIN_CAPITAL_LETTER_SHARP_S + + # This is included because the uppercase occupies more bytes, but the + # first two bytes of their representations differ only in one bit, + # that could lead the code looking for shortcuts astray; you can't do + # certain shortcuts if the lengths differ + "\x{29E}" => 1, # LATIN SMALL LETTER TURNED K + "\x{390}" => 1, # GREEK_SMALL_LETTER_IOTA_WITH_DIALYTIKA_AND_TONOS "\x{3B0}" => 1, # GREEK_SMALL_LETTER_UPSILON_WITH_DIALYTIKA_AND_TONOS + + # This is included because the uppercase and lowercase differ by only + # a single bit and it is in the first of the two byte representations. + # This showed that a previous way was erroneous of calculating if + # initial substrings were closely-related bit-wise. + "\x{3CC}" => 1, # GREEK SMALL LETTER OMICRON WITH TONOS + + "\x{1E9E}" => 1, # LATIN_CAPITAL_LETTER_SHARP_S "\x{1FD3}" => 1, # GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA "\x{1FE3}" => 1, # GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA "I" => 1, From 23332c7d6cee0424f6d724f503785a46156f4f87 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 12 Nov 2020 21:58:19 -0700 Subject: [PATCH 033/503] Make API some C99 typedef work-arounds I added these some releases ago, but kept them private. No untoward things have happened, so I'm now making them API. --- handy.h | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/handy.h b/handy.h index 01e4b9678bcd..7feedcb792b5 100644 --- a/handy.h +++ b/handy.h @@ -284,13 +284,19 @@ typedef U64TYPE U64; # define U32_MIN PERL_ULONG_MIN #endif -/* These C99 typedefs are useful sometimes for, say, loop variables whose - * maximum values are small, but for which speed trumps size. If we have a C99 - * compiler, use that. Otherwise, a plain 'int' should be good enough. - * - * Restrict these to core for now until we are more certain this is a good - * idea. */ -#if defined(PERL_CORE) || defined(PERL_EXT) +/* +=for apidoc_section $integer +=for apidoc Ay|| PERL_INT_FAST8_T +=for apidoc_item PERL_INT_FAST16_T +=for apidoc_item PERL_UINT_FAST8_T +=for apidoc_item PERL_UINT_FAST16_T + +These are equivalent to the correspondingly-named C99 typedefs on platforms +that have those; they evaluate to C and C on platforms that +don't, so that you can portably take advantage of this C99 feature. + +=cut +*/ # ifdef I_STDINT typedef int_fast8_t PERL_INT_FAST8_T; typedef uint_fast8_t PERL_UINT_FAST8_T; @@ -302,7 +308,6 @@ typedef U64TYPE U64; typedef int PERL_INT_FAST16_T; typedef unsigned int PERL_UINT_FAST16_T; # endif -#endif /* log(2) (i.e., log base 10 of 2) is pretty close to 0.30103, just in case * anyone is grepping for it. So BIT_DIGITS gives the number of decimal digits From a473ef8bc0d67b85bc4982944d05f235fc906aae Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 19 Nov 2020 10:50:16 +1100 Subject: [PATCH 034/503] perldelta updates --- pod/perldelta.pod | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index dfdd7825985c..55ed1f6f2f95 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -218,7 +218,10 @@ XXX Changes (i.e. rewording) of diagnostic messages go here =item * -XXX Describe change here +L<\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in mE%sE|perldiag/"\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/"> + +This error was incorrectly produced in some cases involving nested +lookarounds. This has been fixed. [GH #18123] =back @@ -330,9 +333,11 @@ L section. =over 4 -=item XXX-some-platform +=item DragonFlyBSD -XXX +Tests were updated to workaround DragonFlyBSD bugs in L and L. =back @@ -363,7 +368,13 @@ files in F and F are best summarized in L. =item * -XXX +Magic is now called correctly for stacked file test operators. [GH #18293] + +=item * + +The C<@ary = split(...)> optimization no longer switches in the target +array as the value stack. [GH #18232] Also see discussion at +L. =back From 8fef7ea7c86fc0ca0ac0dce07f513cf8b11e027e Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Thu, 19 Nov 2020 13:38:29 +0000 Subject: [PATCH 035/503] perldelta: the FAQ was updated in 09e51a95 --- pod/perldelta.pod | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 55ed1f6f2f95..2b8538624f5f 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -160,9 +160,8 @@ We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. -XXX Changes which significantly change existing files in F go here. -However, any changes to F should go in the L -section. +The Perl FAQ was updated to CPAN version 5.20200523 with minor +improvements. Additionally, the following selected changes have been made: From cff1d10ab492237aab4404aaf1118dd2f77b6b6b Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Thu, 19 Nov 2020 20:19:17 +0000 Subject: [PATCH 036/503] Update ExtUtils-MakeMaker to CPAN version 7.56 [DELTA] 7.56 Thu 19 Nov 19:57:05 GMT 2020 No changes since v7.55_01 7.55_01 Wed 18 Nov 18:23:19 GMT 2020 Bug fixes: - RT#133762 Explicitly print to STDOUT in EUMM.pm --- Porting/Maintainers.pl | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm | 10 +++++----- .../lib/ExtUtils/MakeMaker/Config.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod | 2 +- .../lib/ExtUtils/MakeMaker/Locale.pm | 2 +- .../lib/ExtUtils/MakeMaker/Tutorial.pod | 2 +- .../lib/ExtUtils/MakeMaker/version.pm | 2 +- .../lib/ExtUtils/MakeMaker/version/regex.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm | 2 +- 34 files changed, 38 insertions(+), 38 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 3b90a104bace..652d198c8ae1 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -467,7 +467,7 @@ package Maintainers; }, 'ExtUtils::MakeMaker' => { - 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.54.tar.gz', + 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.56.tar.gz', 'FILES' => q[cpan/ExtUtils-MakeMaker], 'EXCLUDED' => [ qr{^t/lib/Test/}, diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm index f38e2e71a7cb..7472b41f194b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm @@ -8,7 +8,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '7.54'; +$VERSION = '7.56'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm index 19646f6ba32e..a63845ba2dcb 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm @@ -10,7 +10,7 @@ our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist test_s cp_nonempty); -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm index 247da71d0302..afc8a0da1aad 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm @@ -3,7 +3,7 @@ package ExtUtils::Liblist; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use File::Spec; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm index 1292db500da9..6861628bc3a3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm @@ -11,7 +11,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm index 6d3057c9dd52..ce15e65df3b8 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm @@ -4,7 +4,7 @@ use strict; use warnings; use ExtUtils::MakeMaker::Config; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::Liblist; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm index 5d9a0b68a909..65b2769639f3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_AIX; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm index d5fc51d7a5a8..d705baca6067 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_Any; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use Carp; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm index 9bc31c658ccf..655bd9b95e47 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm @@ -27,7 +27,7 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm index 8f8d9b5c4833..c7bf93f17f55 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm @@ -10,7 +10,7 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm index 205e171520fe..ebf2e3682da0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_DOS; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm index b6ab73cecef3..113a2a44f99c 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm @@ -8,7 +8,7 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm index 5df5ce06a1d2..de2f870e8c7b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_MacOS; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; sub new { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm index 6b79f553ac1d..4bc87f22f3c3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm @@ -23,7 +23,7 @@ use warnings; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm index b9b7cd07c1d9..970dfb3757bc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm @@ -6,7 +6,7 @@ use warnings; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm index ba488791d457..7b910ce1aabc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_OS390; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm index 1a45a1b60cf9..6b63fc3c6802 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_QNX; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm index 50dfe1beb8ca..c186ba02de7e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_UWIN; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm index d6a9772f73fc..c9a185994bec 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '7.54'; +$VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm index e692985298a8..be8bc6790f6a 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm @@ -16,7 +16,7 @@ BEGIN { use File::Basename; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm index 586b80578554..3ddc98e9b7c6 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_VOS; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm index 5115c79a7fd6..1d320c758ce7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm @@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw(neatvalue _sprintf562); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; $ENV{EMXSHELL} = 'sh'; # to run `commands` diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm index 84ddc1bf5225..9f44c6cfaadc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_Win95; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm index f7fb833ccfa2..39f662f41469 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm @@ -3,7 +3,7 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; our @ISA = qw(ExtUtils::MM); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm index 64fce4e69731..efb2c16ee60a 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm @@ -25,7 +25,7 @@ my %Recognized_Att_Keys; our %macro_fsentity; # whether a macro is a filesystem name our %macro_dep; # whether a macro is a dependency -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; # Emulate something resembling CVS $Revision$ @@ -1032,7 +1032,7 @@ sub _parse_line { } sub check_manifest { - print "Checking if your kit is complete...\n"; + print STDOUT "Checking if your kit is complete...\n"; require ExtUtils::Manifest; # avoid warning $ExtUtils::Manifest::Quiet = $ExtUtils::Manifest::Quiet = 1; @@ -1230,15 +1230,15 @@ sub flush { my $self = shift; my $finalname = $self->{MAKEFILE}; - printf "Generating a %s %s\n", $self->make_type, $finalname if $Verbose || !$self->{PARENT}; - print "Writing $finalname for $self->{NAME}\n" if $Verbose || !$self->{PARENT}; + printf STDOUT "Generating a %s %s\n", $self->make_type, $finalname if $Verbose || !$self->{PARENT}; + print STDOUT "Writing $finalname for $self->{NAME}\n" if $Verbose || !$self->{PARENT}; unlink($finalname, "MakeMaker.tmp", $Is_VMS ? 'Descrip.MMS' : ()); write_file_via_tmp($finalname, $self->{RESULT}); # Write MYMETA.yml to communicate metadata up to the CPAN clients - print "Writing MYMETA.yml and MYMETA.json\n" + print STDOUT "Writing MYMETA.yml and MYMETA.json\n" if !$self->{NO_MYMETA} and $self->write_mymeta( $self->mymeta ); # save memory diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm index 57b75f60a87e..caa565340bb4 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm @@ -3,7 +3,7 @@ package ExtUtils::MakeMaker::Config; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use Config (); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod index f17c845441d9..4875109f7a29 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; 1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm index 1bf39f40ea1d..ccdce22dbb22 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm @@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Locale; use strict; use warnings; -our $VERSION = "7.54"; +our $VERSION = "7.56"; $VERSION =~ tr/_//d; use base 'Exporter'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod index 2ca48a1a936b..9acaba6e573e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm index 9b96f91c916d..09b4e3ae6516 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm @@ -16,7 +16,7 @@ use warnings; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = '7.54'; +$VERSION = '7.56'; $VERSION =~ tr/_//d; $CLASS = 'version'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm index d642b32767ab..5f9b17ccc0fd 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm @@ -11,7 +11,7 @@ use warnings; use vars qw($VERSION $CLASS $STRICT $LAX); -$VERSION = '7.54'; +$VERSION = '7.56'; $VERSION =~ tr/_//d; #--------------------------------------------------------------------------# diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm index 0e0764b316e5..f5ff0832340f 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; require Exporter; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm index cc57540517ea..b15eb31ef94b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm @@ -11,7 +11,7 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; sub Mksymlists { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm index 3e4f10cbdba4..1f36f4888971 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm @@ -3,7 +3,7 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = '7.54'; +our $VERSION = '7.56'; $VERSION =~ tr/_//d; use Cwd; From 99b28a5e6cf14d5754f179125bc5ffbbe79e7c27 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 19 Nov 2020 20:27:48 -0700 Subject: [PATCH 037/503] perldelta: Note ongoing perlapi work --- pod/perldelta.pod | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 2b8538624f5f..a330be600404 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -165,13 +165,14 @@ improvements. Additionally, the following selected changes have been made: -=head3 L +=head3 L =over 4 =item * -XXX Description of the change here +Efforts continue in improving the presentation of this document, and to +document more API elements. =back From a304e8c31f8061765a067ce5796b97eff65b9a84 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 11:17:53 +0000 Subject: [PATCH 038/503] Update Module::CoreList for 5.33.4 --- dist/Module-CoreList/lib/Module/CoreList.pm | 225 +++++++++++++++++--- 1 file changed, 194 insertions(+), 31 deletions(-) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index a4c1ed1387c5..b20670dee788 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -17915,10 +17915,173 @@ for my $version ( sort { $a <=> $b } keys %released ) { 5.033004 => { delta_from => 5.033003, changed => { + 'B' => '1.82', 'B::Op_private' => '5.033004', 'Config' => '5.033004', + 'Cwd' => '3.79', + 'ExtUtils::CBuilder' => '0.280235', + 'ExtUtils::CBuilder::Base'=> '0.280235', + 'ExtUtils::CBuilder::Platform::Unix'=> '0.280235', + 'ExtUtils::CBuilder::Platform::VMS'=> '0.280235', + 'ExtUtils::CBuilder::Platform::Windows'=> '0.280235', + 'ExtUtils::CBuilder::Platform::Windows::BCC'=> '0.280235', + 'ExtUtils::CBuilder::Platform::Windows::GCC'=> '0.280235', + 'ExtUtils::CBuilder::Platform::Windows::MSVC'=> '0.280235', + 'ExtUtils::CBuilder::Platform::aix'=> '0.280235', + 'ExtUtils::CBuilder::Platform::android'=> '0.280235', + 'ExtUtils::CBuilder::Platform::cygwin'=> '0.280235', + 'ExtUtils::CBuilder::Platform::darwin'=> '0.280235', + 'ExtUtils::CBuilder::Platform::dec_osf'=> '0.280235', + 'ExtUtils::CBuilder::Platform::os2'=> '0.280235', + 'ExtUtils::Command' => '7.56', + 'ExtUtils::Command::MM' => '7.56', + 'ExtUtils::Liblist' => '7.56', + 'ExtUtils::Liblist::Kid'=> '7.56', + 'ExtUtils::MM' => '7.56', + 'ExtUtils::MM_AIX' => '7.56', + 'ExtUtils::MM_Any' => '7.56', + 'ExtUtils::MM_BeOS' => '7.56', + 'ExtUtils::MM_Cygwin' => '7.56', + 'ExtUtils::MM_DOS' => '7.56', + 'ExtUtils::MM_Darwin' => '7.56', + 'ExtUtils::MM_MacOS' => '7.56', + 'ExtUtils::MM_NW5' => '7.56', + 'ExtUtils::MM_OS2' => '7.56', + 'ExtUtils::MM_OS390' => '7.56', + 'ExtUtils::MM_QNX' => '7.56', + 'ExtUtils::MM_UWIN' => '7.56', + 'ExtUtils::MM_Unix' => '7.56', + 'ExtUtils::MM_VMS' => '7.56', + 'ExtUtils::MM_VOS' => '7.56', + 'ExtUtils::MM_Win32' => '7.56', + 'ExtUtils::MM_Win95' => '7.56', + 'ExtUtils::MY' => '7.56', + 'ExtUtils::MakeMaker' => '7.56', + 'ExtUtils::MakeMaker::Config'=> '7.56', + 'ExtUtils::MakeMaker::Locale'=> '7.56', + 'ExtUtils::MakeMaker::version'=> '7.56', + 'ExtUtils::MakeMaker::version::regex'=> '7.56', + 'ExtUtils::Mkbootstrap' => '7.56', + 'ExtUtils::Mksymlists' => '7.56', + 'ExtUtils::testlib' => '7.56', + 'File::Fetch' => '1.00', + 'File::Path' => '2.18', + 'File::Spec' => '3.79', + 'File::Spec::AmigaOS' => '3.79', + 'File::Spec::Cygwin' => '3.79', + 'File::Spec::Epoc' => '3.79', + 'File::Spec::Functions' => '3.79', + 'File::Spec::Mac' => '3.79', + 'File::Spec::OS2' => '3.79', + 'File::Spec::Unix' => '3.79', + 'File::Spec::VMS' => '3.79', + 'IPC::Msg' => '2.09', + 'IPC::Semaphore' => '2.09', + 'IPC::SharedMem' => '2.09', + 'IPC::SysV' => '2.09', 'Module::CoreList' => '5.20201120', 'Module::CoreList::Utils'=> '5.20201120', + 'Net::Ping' => '2.74', + 'Pod::Html' => '1.26', + 'Pod::Simple' => '3.42', + 'Pod::Simple::BlackBox' => '3.42', + 'Pod::Simple::Checker' => '3.42', + 'Pod::Simple::Debug' => '3.42', + 'Pod::Simple::DumpAsText'=> '3.42', + 'Pod::Simple::DumpAsXML'=> '3.42', + 'Pod::Simple::HTML' => '3.42', + 'Pod::Simple::HTMLBatch'=> '3.42', + 'Pod::Simple::LinkSection'=> '3.42', + 'Pod::Simple::Methody' => '3.42', + 'Pod::Simple::Progress' => '3.42', + 'Pod::Simple::PullParser'=> '3.42', + 'Pod::Simple::PullParserEndToken'=> '3.42', + 'Pod::Simple::PullParserStartToken'=> '3.42', + 'Pod::Simple::PullParserTextToken'=> '3.42', + 'Pod::Simple::PullParserToken'=> '3.42', + 'Pod::Simple::RTF' => '3.42', + 'Pod::Simple::Search' => '3.42', + 'Pod::Simple::SimpleTree'=> '3.42', + 'Pod::Simple::Text' => '3.42', + 'Pod::Simple::TextContent'=> '3.42', + 'Pod::Simple::TiedOutFH'=> '3.42', + 'Pod::Simple::Transcode'=> '3.42', + 'Pod::Simple::TranscodeDumb'=> '3.42', + 'Pod::Simple::TranscodeSmart'=> '3.42', + 'Pod::Simple::XHTML' => '3.42', + 'Pod::Simple::XMLOutStream'=> '3.42', + 'Test2' => '1.302183', + 'Test2::API' => '1.302183', + 'Test2::API::Breakage' => '1.302183', + 'Test2::API::Context' => '1.302183', + 'Test2::API::Instance' => '1.302183', + 'Test2::API::InterceptResult'=> '1.302183', + 'Test2::API::InterceptResult::Event'=> '1.302183', + 'Test2::API::InterceptResult::Facet'=> '1.302183', + 'Test2::API::InterceptResult::Hub'=> '1.302183', + 'Test2::API::InterceptResult::Squasher'=> '1.302183', + 'Test2::API::Stack' => '1.302183', + 'Test2::Event' => '1.302183', + 'Test2::Event::Bail' => '1.302183', + 'Test2::Event::Diag' => '1.302183', + 'Test2::Event::Encoding'=> '1.302183', + 'Test2::Event::Exception'=> '1.302183', + 'Test2::Event::Fail' => '1.302183', + 'Test2::Event::Generic' => '1.302183', + 'Test2::Event::Note' => '1.302183', + 'Test2::Event::Ok' => '1.302183', + 'Test2::Event::Pass' => '1.302183', + 'Test2::Event::Plan' => '1.302183', + 'Test2::Event::Skip' => '1.302183', + 'Test2::Event::Subtest' => '1.302183', + 'Test2::Event::TAP::Version'=> '1.302183', + 'Test2::Event::V2' => '1.302183', + 'Test2::Event::Waiting' => '1.302183', + 'Test2::EventFacet' => '1.302183', + 'Test2::EventFacet::About'=> '1.302183', + 'Test2::EventFacet::Amnesty'=> '1.302183', + 'Test2::EventFacet::Assert'=> '1.302183', + 'Test2::EventFacet::Control'=> '1.302183', + 'Test2::EventFacet::Error'=> '1.302183', + 'Test2::EventFacet::Hub'=> '1.302183', + 'Test2::EventFacet::Info'=> '1.302183', + 'Test2::EventFacet::Info::Table'=> '1.302183', + 'Test2::EventFacet::Meta'=> '1.302183', + 'Test2::EventFacet::Parent'=> '1.302183', + 'Test2::EventFacet::Plan'=> '1.302183', + 'Test2::EventFacet::Render'=> '1.302183', + 'Test2::EventFacet::Trace'=> '1.302183', + 'Test2::Formatter' => '1.302183', + 'Test2::Formatter::TAP' => '1.302183', + 'Test2::Hub' => '1.302183', + 'Test2::Hub::Interceptor'=> '1.302183', + 'Test2::Hub::Interceptor::Terminator'=> '1.302183', + 'Test2::Hub::Subtest' => '1.302183', + 'Test2::IPC' => '1.302183', + 'Test2::IPC::Driver' => '1.302183', + 'Test2::IPC::Driver::Files'=> '1.302183', + 'Test2::Tools::Tiny' => '1.302183', + 'Test2::Util' => '1.302183', + 'Test2::Util::ExternalMeta'=> '1.302183', + 'Test2::Util::Facets2Legacy'=> '1.302183', + 'Test2::Util::HashBase' => '1.302183', + 'Test2::Util::Trace' => '1.302183', + 'Test::Builder' => '1.302183', + 'Test::Builder::Formatter'=> '1.302183', + 'Test::Builder::Module' => '1.302183', + 'Test::Builder::Tester' => '1.302183', + 'Test::Builder::Tester::Color'=> '1.302183', + 'Test::Builder::TodoDiag'=> '1.302183', + 'Test::More' => '1.302183', + 'Test::Simple' => '1.302183', + 'Test::Tester' => '1.302183', + 'Test::Tester::Capture' => '1.302183', + 'Test::Tester::CaptureRunner'=> '1.302183', + 'Test::Tester::Delegate'=> '1.302183', + 'Test::use::ok' => '1.302183', + 'XS::APItest' => '1.13', + 'ok' => '1.302183', + 'perlfaq' => '5.20201107', }, removed => { } @@ -19602,8 +19765,8 @@ sub is_core 'Encode::TW' => undef, 'Encode::Unicode' => undef, 'Encode::Unicode::UTF7' => undef, - 'ExtUtils::Command' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::Command::MM' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Command' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Command::MM' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', 'ExtUtils::Constant' => undef, 'ExtUtils::Constant::Base'=> undef, 'ExtUtils::Constant::ProxySubs'=> undef, @@ -19611,38 +19774,38 @@ sub is_core 'ExtUtils::Constant::XS'=> undef, 'ExtUtils::Install' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-Install', 'ExtUtils::Installed' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-Install', - 'ExtUtils::Liblist' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::Liblist::Kid'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_AIX' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Any' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_BeOS' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Cygwin' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_DOS' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Darwin' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_MacOS' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_NW5' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_OS2' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_OS390' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_QNX' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_UWIN' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Unix' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_VMS' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_VOS' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Win32' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MM_Win95' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MY' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MakeMaker' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MakeMaker::Config'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MakeMaker::Locale'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MakeMaker::version'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::MakeMaker::version::regex'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Liblist' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Liblist::Kid'=> 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_AIX' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Any' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_BeOS' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Cygwin' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_DOS' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Darwin' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_MacOS' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_NW5' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_OS2' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_OS390' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_QNX' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_UWIN' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Unix' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_VMS' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_VOS' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Win32' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MM_Win95' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MY' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MakeMaker' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MakeMaker::Config'=> 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MakeMaker::Locale'=> 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MakeMaker::version'=> 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::MakeMaker::version::regex'=> 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', 'ExtUtils::Manifest' => 'http://github.com/Perl-Toolchain-Gang/ExtUtils-Manifest/issues', - 'ExtUtils::Mkbootstrap' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', - 'ExtUtils::Mksymlists' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Mkbootstrap' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::Mksymlists' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', 'ExtUtils::PL2Bat' => 'http://rt.cpan.org/Public/Dist/Display.html?Name=ExtUtils-PL2Bat', 'ExtUtils::Packlist' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-Install', - 'ExtUtils::testlib' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', + 'ExtUtils::testlib' => 'https://rt.cpan.org/NoAuth/Bugs.html?Dist=ExtUtils-MakeMaker', 'Fatal' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', 'File::Fetch' => undef, 'File::GlobMapper' => 'https://github.com/pmqs/IO-Compress/issues', From 650a1ca528ea7f3586733d268fa34db7e34df57d Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 11:40:59 +0000 Subject: [PATCH 039/503] Finalise perldelta for 5.33.4 --- pod/perldelta.pod | 349 ++++++++-------------------------------------- 1 file changed, 59 insertions(+), 290 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a330be600404..80fa5f2c4a9a 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,9 +2,6 @@ =head1 NAME -[ this is a template for a new perldelta file. Any text flagged as XXX needs -to be processed before release. ] - perldelta - what is new for perl v5.33.4 =head1 DESCRIPTION @@ -15,155 +12,88 @@ release. If you are upgrading from an earlier release such as 5.33.2, first read L, which describes differences between 5.33.2 and 5.33.3. -=head1 Notice - -XXX Any important notices here - -=head1 Core Enhancements - -XXX New core language features go here. Summarize user-visible core language -enhancements. Particularly prominent performance optimisations could go -here, but most should go in the L section. - -[ List each enhancement as a =head2 entry ] - -=head1 Security - -XXX Any security-related notices go here. In particular, any security -vulnerabilities closed should be noted here rather than in the -L section. - -[ List each security issue as a =head2 entry ] - -=head1 Incompatible Changes - -XXX For a release on a stable branch, this section aspires to be: - - There are no changes intentionally incompatible with 5.XXX.XXX - If any exist, they are bugs, and we request that you submit a - report. See L below. - -[ List each incompatible change as a =head2 entry ] - -=head1 Deprecations - -XXX Any deprecated features, syntax, modules etc. should be listed here. - -=head2 Module removals - -XXX Remove this section if not applicable. +=head1 Modules and Pragmata -The following modules will be removed from the core distribution in a -future release, and will at that time need to be installed from CPAN. -Distributions on CPAN which require these modules will need to list them as -prerequisites. +=head2 Updated Modules and Pragmata -The core versions of these modules will now issue C<"deprecated">-category -warnings to alert you to this fact. To silence these deprecation warnings, -install the modules in question from CPAN. +=over 4 -Note that these are (with rare exceptions) fine modules that you are encouraged -to continue to use. Their disinclusion from core primarily hinges on their -necessity to bootstrapping a fully functional, CPAN-capable Perl installation, -not usually on concerns over their design. +=item * -=over +L has been upgraded from version 1.81 to 1.82. -=item XXX +=item * -XXX Note that deprecated modules should be listed here even if they are listed -as an updated module in the L section. +L has been upgraded from version 0.280234 to 0.280235. -=back +=item * -[ List each other deprecation as a =head2 entry ] +L has been upgraded from version 7.48 to 7.56. -=head1 Performance Enhancements +=item * -XXX Changes which enhance performance without changing behaviour go here. -There may well be none in a stable release. +L has been upgraded from version 0.56 to 1.00. -[ List each enhancement as an =item entry ] +=item * -=over 4 +L has been upgraded from version 2.17 to 2.18. =item * -XXX - -=back +L has been upgraded from version 3.78 to 3.79. -=head1 Modules and Pragmata +=item * -XXX All changes to installed files in F, F, F and F -go here. If Module::CoreList is updated, generate an initial draft of the -following sections using F. A paragraph summary -for important changes should then be added by hand. In an ideal world, -dual-life modules would have a F file that could be cribbed. +L has been upgraded from version 2.08 to 2.09. -The list of new and updated modules is modified automatically as part of -preparing a Perl release, so the only reason to manually add entries here is if -you're summarising the important changes in the module update. (Also, if the -manually-added details don't match the automatically-generated ones, the -release manager will have to investigate the situation carefully.) +=item * -[ Within each section, list entries as an =item entry ] +L has been upgraded from version 5.20201020 to 5.20201120. -=head2 New Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 2.73_01 to 2.74. =item * -XXX Remove this section if not applicable. - -=back +L has been upgraded from version 5.20200523 to 5.20201107. -=head2 Updated Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 1.25 to 1.26. =item * -L has been upgraded from version A.xx to B.yy. +L has been upgraded from version 3.41 to 3.42. -If there was something important to note about this change, include that here. - -=back - -=head2 Removed Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 1.302182 to 1.302183. =item * -XXX +L has been upgraded from version 1.12 to 1.13. =back =head1 Documentation -XXX Changes to files in F go here. Consider grouping entries by -file and be sure to link to the appropriate page, e.g. L. - -=head2 New Documentation - -XXX Changes which create B files in F go here. - -=head3 L - -XXX Description of the purpose of the new file here - =head2 Changes to Existing Documentation We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. +=head3 L + +=over 4 + +=item * + The Perl FAQ was updated to CPAN version 5.20200523 with minor improvements. -Additionally, the following selected changes have been made: +=back =head3 L @@ -182,38 +112,8 @@ The following additions or changes have been made to diagnostic output, including warnings and fatal error messages. For the complete list of diagnostic messages, see L. -XXX New or changed warnings emitted by the core's C code go here. Also -include any changes in L that reconcile it to the C code. - -=head2 New Diagnostics - -XXX Newly added diagnostic messages go under here, separated into New Errors -and New Warnings - -=head3 New Errors - -=over 4 - -=item * - -XXX L - -=back - -=head3 New Warnings - -=over 4 - -=item * - -XXX L - -=back - =head2 Changes to Existing Diagnostics -XXX Changes (i.e. rewording) of diagnostic messages go here - =over 4 =item * @@ -221,116 +121,14 @@ XXX Changes (i.e. rewording) of diagnostic messages go here L<\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in mE%sE|perldiag/"\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/"> This error was incorrectly produced in some cases involving nested -lookarounds. This has been fixed. [GH #18123] - -=back - -=head1 Utility Changes - -XXX Changes to installed programs such as F and F go here. -Most of these are built within the directory F. - -[ List utility changes as a =head2 entry for each utility and =item -entries for each change -Use L with program names to get proper documentation linking. ] - -=head2 L - -=over 4 - -=item * - -XXX - -=back - -=head1 Configuration and Compilation - -XXX Changes to F, F, F, and analogous tools -go here. Any other changes to the Perl build process should be listed here. -However, any platform-specific changes should be listed in the -L section, instead. - -[ List changes as an =item entry ]. - -=over 4 - -=item * - -XXX - -=back - -=head1 Testing - -XXX Any significant changes to the testing of a freshly built perl should be -listed here. Changes which create B files in F go here as do any -large changes to the testing harness (e.g. when parallel testing was added). -Changes to existing files in F aren't worth summarizing, although the bugs -that they represent may be covered elsewhere. - -XXX If there were no significant test changes, say this: - -Tests were added and changed to reflect the other additions and changes -in this release. - -XXX If instead there were significant changes, say this: - -Tests were added and changed to reflect the other additions and -changes in this release. Furthermore, these significant changes were -made: - -[ List each test improvement as an =item entry ] - -=over 4 - -=item * - -XXX +lookarounds. This has been fixed. [L] =back =head1 Platform Support -XXX Any changes to platform support should be listed in the sections below. - -[ Within the sections, list each platform as an =item entry with specific -changes as paragraphs below it. ] - -=head2 New Platforms - -XXX List any platforms that this version of perl compiles on, that previous -versions did not. These will either be enabled by new files in the F -directories, or new subdirectories and F files at the top level of the -source tree. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - -=head2 Discontinued Platforms - -XXX List any platforms that this version of perl no longer compiles on. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - =head2 Platform-Specific Notes -XXX List any changes for specific platforms. This could include configuration -and compilation changes or changes in portability/compatibility. However, -changes within modules for platforms should generally be listed in the -L section. - =over 4 =item DragonFlyBSD @@ -341,80 +139,51 @@ updates|https://bugs.dragonflybsd.org/issues/3251>. =back -=head1 Internal Changes - -XXX Changes which affect the interface available to C code go here. Other -significant internal changes for future core maintainers should be noted as -well. - -[ List each change as an =item entry ] - -=over 4 - -=item * - -XXX - -=back - =head1 Selected Bug Fixes -XXX Important bug fixes in the core language are summarized here. Bug fixes in -files in F and F are best summarized in L. - -[ List each fix as an =item entry ] - =over 4 =item * -Magic is now called correctly for stacked file test operators. [GH #18293] +Magic is now called correctly for stacked file test operators. [L] =item * The C<@ary = split(...)> optimization no longer switches in the target -array as the value stack. [GH #18232] Also see discussion at +array as the value stack. [L] Also see discussion at L. =back -=head1 Known Problems - -XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any -tests that had to be Ced for the release would be noted here. Unfixed -platform specific bugs also go here. - -[ List each fix as an =item entry ] - -=over 4 - -=item * - -XXX - -=back - -=head1 Errata From Previous Releases - -=over 4 - -=item * +=head1 Acknowledgements -XXX Add anything here that we forgot to add, or were mistaken about, in -the perldelta of a previous release. +Perl 5.33.4 represents approximately 4 weeks of development since Perl +5.33.3 and contains approximately 6,900 lines of changes across 340 files +from 16 authors. -=back +Excluding auto-generated files, documentation and release tools, there were +approximately 4,200 lines of changes to 260 .pm, .t, .c and .h files. -=head1 Obituary +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.4: -XXX If any significant core contributor or member of the CPAN community has -died, add a short obituary here. +Ben Cornett, Chris 'BinGOs' Williams, Dan Book, David Mitchell, Giovanni +Tataranni, James E Keenan, Karen Etheridge, Karl Williamson, Marcus +Holland-Moritz, Nicolas R., Richard Leach, Scott Baker, Steve Hay, TAKAI +Kousuke, Tom Hukins, Tony Cook. -=head1 Acknowledgements +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. -XXX Generate this with: +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. - perl Porting/acknowledgements.pl v5.33.3..HEAD +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. =head1 Reporting Bugs From 019e34c2029d812bfe75e990c48a751881ed7776 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 11:55:35 +0000 Subject: [PATCH 040/503] 5.33.4 today --- pod/perlhist.pod | 1 + 1 file changed, 1 insertion(+) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 8d4ce988e033..3bf660200c3e 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -699,6 +699,7 @@ the strings?). Ether 5.33.1 2020-Aug-20 Sawyer X 5.33.2 2020-Sep-20 Steve 5.33.3 2020-Oct-20 + Tom H 5.33.4 2020-Nov-20 =head2 SELECTED RELEASE SIZES From a47e9fb2f5da06ddc89e765be1fc30c4a8c9c1d5 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 15:06:12 +0000 Subject: [PATCH 041/503] Post-release tasks for 5.33.4 --- Porting/epigraphs.pod | 9 +++++++++ Porting/release_schedule.pod | 2 +- 2 files changed, 10 insertions(+), 1 deletion(-) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index ed53a8a354ba..b6bcf201e8e0 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,15 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.33.4 - George Eliot, "Adam Bede" + +L + +It was more than two o'clock in the afternoon when Adam came in sight of +the grey town on the hill-side and looked searchingly towards the green +valley below, for the first glimpse of the old thatched roof near the +ugly red mill. + =head2 v5.33.3 - Ludwig van Beethoven, "Heiligenstadt Testament"; translated and quoted in: Maynard Solomon, "Beethoven" L diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index de7bf858408e..81f6d9c10949 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -43,7 +43,7 @@ you should reset the version numbers to the next blead series. 2020-08-20 5.33.1 ✓ Karen Etheridge 2020-09-20 5.33.2 ✓ Sawyer X 2020-10-20 5.33.3 ✓ Steve Hay - 2020-11-20 5.33.4 Tom Hukins + 2020-11-20 5.33.4 ✓ Tom Hukins 2020-12-20 5.33.5 2021-01-20 5.33.6 2021-02-20 5.33.7 Renee Backer From d228bb8b1a0e9253424611b56243c555886bc9e8 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 16:44:11 +0000 Subject: [PATCH 042/503] Create new perldelta for 5.33.5 --- MANIFEST | 1 + Makefile.SH | 8 +- pod/.gitignore | 2 +- pod/perl.pod | 1 + pod/perl5334delta.pod | 223 ++++++++++++++++++++++++ pod/perldelta.pod | 368 +++++++++++++++++++++++++++++++-------- vms/descrip_mms.template | 2 +- win32/GNUmakefile | 4 +- win32/Makefile | 4 +- win32/makefile.mk | 4 +- win32/pod.mak | 4 + 11 files changed, 535 insertions(+), 86 deletions(-) create mode 100644 pod/perl5334delta.pod diff --git a/MANIFEST b/MANIFEST index 0e4790b938b7..42eca1b2c239 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5214,6 +5214,7 @@ pod/perl5330delta.pod Perl changes in version 5.33.0 pod/perl5331delta.pod Perl changes in version 5.33.1 pod/perl5332delta.pod Perl changes in version 5.33.2 pod/perl5333delta.pod Perl changes in version 5.33.3 +pod/perl5334delta.pod Perl changes in version 5.33.4 pod/perl561delta.pod Perl changes in version 5.6.1 pod/perl56delta.pod Perl changes in version 5.6 pod/perl581delta.pod Perl changes in version 5.8.1 diff --git a/Makefile.SH b/Makefile.SH index 1c40b75abad8..7356f0a8f4fe 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -589,7 +589,7 @@ esac $spitshell >>$Makefile <<'!NO!SUBS!' -perltoc_pod_prereqs = extra.pods pod/perl5334delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +perltoc_pod_prereqs = extra.pods pod/perl5335delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs) generated_headers = uudmap.h bitcount.h mg_data.h @@ -1153,9 +1153,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST $(MINIPERL) pod/perlmodlib.PL -q -pod/perl5334delta.pod: pod/perldelta.pod - $(RMS) pod/perl5334delta.pod - $(LNS) perldelta.pod pod/perl5334delta.pod +pod/perl5335delta.pod: pod/perldelta.pod + $(RMS) pod/perl5335delta.pod + $(LNS) perldelta.pod pod/perl5335delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` diff --git a/pod/.gitignore b/pod/.gitignore index 089fe5a4dcfd..4933af49fc05 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -49,7 +49,7 @@ /roffitall # generated -/perl5334delta.pod +/perl5335delta.pod /perlapi.pod /perlintern.pod /perlmodlib.pod diff --git a/pod/perl.pod b/pod/perl.pod index 557c5dbe8970..9f4f966d115e 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -182,6 +182,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhist Perl history records perldelta Perl changes since previous version + perl5334delta Perl changes in version 5.33.4 perl5333delta Perl changes in version 5.33.3 perl5332delta Perl changes in version 5.33.2 perl5331delta Perl changes in version 5.33.1 diff --git a/pod/perl5334delta.pod b/pod/perl5334delta.pod new file mode 100644 index 000000000000..4d119cc35371 --- /dev/null +++ b/pod/perl5334delta.pod @@ -0,0 +1,223 @@ +=encoding utf8 + +=head1 NAME + +perl5334delta - what is new for perl v5.33.4 + +=head1 DESCRIPTION + +This document describes differences between the 5.33.3 release and the 5.33.4 +release. + +If you are upgrading from an earlier release such as 5.33.2, first read +L, which describes differences between 5.33.2 and 5.33.3. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 1.81 to 1.82. + +=item * + +L has been upgraded from version 0.280234 to 0.280235. + +=item * + +L has been upgraded from version 7.48 to 7.56. + +=item * + +L has been upgraded from version 0.56 to 1.00. + +=item * + +L has been upgraded from version 2.17 to 2.18. + +=item * + +L has been upgraded from version 3.78 to 3.79. + +=item * + +L has been upgraded from version 2.08 to 2.09. + +=item * + +L has been upgraded from version 5.20201020 to 5.20201120. + +=item * + +L has been upgraded from version 2.73_01 to 2.74. + +=item * + +L has been upgraded from version 5.20200523 to 5.20201107. + +=item * + +L has been upgraded from version 1.25 to 1.26. + +=item * + +L has been upgraded from version 3.41 to 3.42. + +=item * + +L has been upgraded from version 1.302182 to 1.302183. + +=item * + +L has been upgraded from version 1.12 to 1.13. + +=back + +=head1 Documentation + +=head2 Changes to Existing Documentation + +We have attempted to update the documentation to reflect the changes +listed in this document. If you find any we have missed, open an issue +at L. + +=head3 L + +=over 4 + +=item * + +The Perl FAQ was updated to CPAN version 5.20200523 with minor +improvements. + +=back + +=head3 L + +=over 4 + +=item * + +Efforts continue in improving the presentation of this document, and to +document more API elements. + +=back + +=head1 Diagnostics + +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. + +=head2 Changes to Existing Diagnostics + +=over 4 + +=item * + +L<\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in mE%sE|perldiag/"\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/"> + +This error was incorrectly produced in some cases involving nested +lookarounds. This has been fixed. [L] + +=back + +=head1 Platform Support + +=head2 Platform-Specific Notes + +=over 4 + +=item DragonFlyBSD + +Tests were updated to workaround DragonFlyBSD bugs in L and L. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +Magic is now called correctly for stacked file test operators. [L] + +=item * + +The C<@ary = split(...)> optimization no longer switches in the target +array as the value stack. [L] Also see discussion at +L. + +=back + +=head1 Acknowledgements + +Perl 5.33.4 represents approximately 4 weeks of development since Perl +5.33.3 and contains approximately 6,900 lines of changes across 340 files +from 16 authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 4,200 lines of changes to 260 .pm, .t, .c and .h files. + +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.4: + +Ben Cornett, Chris 'BinGOs' Williams, Dan Book, David Mitchell, Giovanni +Tataranni, James E Keenan, Karen Etheridge, Karl Williamson, Marcus +Holland-Moritz, Nicolas R., Richard Leach, Scott Baker, Steve Hay, TAKAI +Kousuke, Tom Hukins, Tony Cook. + +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. + +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the perl bug database +at L. There may also be information at +L, the Perl Home Page. + +If you believe you have an unreported bug, please open an issue at +L. Be sure to trim your bug down to a +tiny but sufficient test case. + +If the bug you are reporting has security implications which make it +inappropriate to send to a public issue tracker, then see +L +for details of how to report the issue. + +=head1 Give Thanks + +If you wish to thank the Perl 5 Porters for the work we had done in Perl 5, +you can do so by running the C program: + + perlthanks + +This will send an email to the Perl 5 Porters list with your show of thanks. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 80fa5f2c4a9a..ee37a190f8f3 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,188 +2,408 @@ =head1 NAME -perldelta - what is new for perl v5.33.4 +[ this is a template for a new perldelta file. Any text flagged as XXX needs +to be processed before release. ] + +perldelta - what is new for perl v5.33.5 =head1 DESCRIPTION -This document describes differences between the 5.33.3 release and the 5.33.4 +This document describes differences between the 5.33.4 release and the 5.33.5 release. -If you are upgrading from an earlier release such as 5.33.2, first read -L, which describes differences between 5.33.2 and 5.33.3. +If you are upgrading from an earlier release such as 5.33.3, first read +L, which describes differences between 5.33.3 and 5.33.4. -=head1 Modules and Pragmata +=head1 Notice -=head2 Updated Modules and Pragmata +XXX Any important notices here -=over 4 +=head1 Core Enhancements -=item * +XXX New core language features go here. Summarize user-visible core language +enhancements. Particularly prominent performance optimisations could go +here, but most should go in the L section. -L has been upgraded from version 1.81 to 1.82. +[ List each enhancement as a =head2 entry ] -=item * +=head1 Security -L has been upgraded from version 0.280234 to 0.280235. +XXX Any security-related notices go here. In particular, any security +vulnerabilities closed should be noted here rather than in the +L section. -=item * +[ List each security issue as a =head2 entry ] -L has been upgraded from version 7.48 to 7.56. +=head1 Incompatible Changes -=item * +XXX For a release on a stable branch, this section aspires to be: -L has been upgraded from version 0.56 to 1.00. + There are no changes intentionally incompatible with 5.XXX.XXX + If any exist, they are bugs, and we request that you submit a + report. See L below. -=item * +[ List each incompatible change as a =head2 entry ] -L has been upgraded from version 2.17 to 2.18. +=head1 Deprecations -=item * +XXX Any deprecated features, syntax, modules etc. should be listed here. -L has been upgraded from version 3.78 to 3.79. +=head2 Module removals -=item * +XXX Remove this section if not applicable. -L has been upgraded from version 2.08 to 2.09. +The following modules will be removed from the core distribution in a +future release, and will at that time need to be installed from CPAN. +Distributions on CPAN which require these modules will need to list them as +prerequisites. -=item * +The core versions of these modules will now issue C<"deprecated">-category +warnings to alert you to this fact. To silence these deprecation warnings, +install the modules in question from CPAN. -L has been upgraded from version 5.20201020 to 5.20201120. +Note that these are (with rare exceptions) fine modules that you are encouraged +to continue to use. Their disinclusion from core primarily hinges on their +necessity to bootstrapping a fully functional, CPAN-capable Perl installation, +not usually on concerns over their design. -=item * +=over -L has been upgraded from version 2.73_01 to 2.74. +=item XXX -=item * +XXX Note that deprecated modules should be listed here even if they are listed +as an updated module in the L section. + +=back + +[ List each other deprecation as a =head2 entry ] + +=head1 Performance Enhancements + +XXX Changes which enhance performance without changing behaviour go here. +There may well be none in a stable release. -L has been upgraded from version 5.20200523 to 5.20201107. +[ List each enhancement as an =item entry ] + +=over 4 =item * -L has been upgraded from version 1.25 to 1.26. +XXX + +=back + +=head1 Modules and Pragmata + +XXX All changes to installed files in F, F, F and F +go here. If Module::CoreList is updated, generate an initial draft of the +following sections using F. A paragraph summary +for important changes should then be added by hand. In an ideal world, +dual-life modules would have a F file that could be cribbed. + +The list of new and updated modules is modified automatically as part of +preparing a Perl release, so the only reason to manually add entries here is if +you're summarising the important changes in the module update. (Also, if the +manually-added details don't match the automatically-generated ones, the +release manager will have to investigate the situation carefully.) + +[ Within each section, list entries as an =item entry ] + +=head2 New Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 3.41 to 3.42. +XXX Remove this section if not applicable. + +=back + +=head2 Updated Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 1.302182 to 1.302183. +L has been upgraded from version A.xx to B.yy. + +If there was something important to note about this change, include that here. + +=back + +=head2 Removed Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 1.12 to 1.13. +XXX =back =head1 Documentation +XXX Changes to files in F go here. Consider grouping entries by +file and be sure to link to the appropriate page, e.g. L. + +=head2 New Documentation + +XXX Changes which create B files in F go here. + +=head3 L + +XXX Description of the purpose of the new file here + =head2 Changes to Existing Documentation We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. -=head3 L +XXX Changes which significantly change existing files in F go here. +However, any changes to F should go in the L +section. + +Additionally, the following selected changes have been made: + +=head3 L =over 4 =item * -The Perl FAQ was updated to CPAN version 5.20200523 with minor -improvements. +XXX Description of the change here =back -=head3 L +=head1 Diagnostics + +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. + +XXX New or changed warnings emitted by the core's C code go here. Also +include any changes in L that reconcile it to the C code. + +=head2 New Diagnostics + +XXX Newly added diagnostic messages go under here, separated into New Errors +and New Warnings + +=head3 New Errors =over 4 =item * -Efforts continue in improving the presentation of this document, and to -document more API elements. +XXX L =back -=head1 Diagnostics +=head3 New Warnings -The following additions or changes have been made to diagnostic output, -including warnings and fatal error messages. For the complete list of -diagnostic messages, see L. +=over 4 + +=item * + +XXX L + +=back =head2 Changes to Existing Diagnostics +XXX Changes (i.e. rewording) of diagnostic messages go here + =over 4 =item * -L<\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in mE%sE|perldiag/"\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/"> +XXX Describe change here + +=back + +=head1 Utility Changes + +XXX Changes to installed programs such as F and F go here. +Most of these are built within the directory F. + +[ List utility changes as a =head2 entry for each utility and =item +entries for each change +Use L with program names to get proper documentation linking. ] -This error was incorrectly produced in some cases involving nested -lookarounds. This has been fixed. [L] +=head2 L + +=over 4 + +=item * + +XXX + +=back + +=head1 Configuration and Compilation + +XXX Changes to F, F, F, and analogous tools +go here. Any other changes to the Perl build process should be listed here. +However, any platform-specific changes should be listed in the +L section, instead. + +[ List changes as an =item entry ]. + +=over 4 + +=item * + +XXX + +=back + +=head1 Testing + +XXX Any significant changes to the testing of a freshly built perl should be +listed here. Changes which create B files in F go here as do any +large changes to the testing harness (e.g. when parallel testing was added). +Changes to existing files in F aren't worth summarizing, although the bugs +that they represent may be covered elsewhere. + +XXX If there were no significant test changes, say this: + +Tests were added and changed to reflect the other additions and changes +in this release. + +XXX If instead there were significant changes, say this: + +Tests were added and changed to reflect the other additions and +changes in this release. Furthermore, these significant changes were +made: + +[ List each test improvement as an =item entry ] + +=over 4 + +=item * + +XXX =back =head1 Platform Support +XXX Any changes to platform support should be listed in the sections below. + +[ Within the sections, list each platform as an =item entry with specific +changes as paragraphs below it. ] + +=head2 New Platforms + +XXX List any platforms that this version of perl compiles on, that previous +versions did not. These will either be enabled by new files in the F +directories, or new subdirectories and F files at the top level of the +source tree. + +=over 4 + +=item XXX-some-platform + +XXX + +=back + +=head2 Discontinued Platforms + +XXX List any platforms that this version of perl no longer compiles on. + +=over 4 + +=item XXX-some-platform + +XXX + +=back + =head2 Platform-Specific Notes +XXX List any changes for specific platforms. This could include configuration +and compilation changes or changes in portability/compatibility. However, +changes within modules for platforms should generally be listed in the +L section. + =over 4 -=item DragonFlyBSD +=item XXX-some-platform -Tests were updated to workaround DragonFlyBSD bugs in L and L. +XXX + +=back + +=head1 Internal Changes + +XXX Changes which affect the interface available to C code go here. Other +significant internal changes for future core maintainers should be noted as +well. + +[ List each change as an =item entry ] + +=over 4 + +=item * + +XXX =back =head1 Selected Bug Fixes +XXX Important bug fixes in the core language are summarized here. Bug fixes in +files in F and F are best summarized in L. + +[ List each fix as an =item entry ] + =over 4 =item * -Magic is now called correctly for stacked file test operators. [L] +XXX + +=back + +=head1 Known Problems + +XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any +tests that had to be Ced for the release would be noted here. Unfixed +platform specific bugs also go here. + +[ List each fix as an =item entry ] + +=over 4 =item * -The C<@ary = split(...)> optimization no longer switches in the target -array as the value stack. [L] Also see discussion at -L. +XXX =back -=head1 Acknowledgements +=head1 Errata From Previous Releases -Perl 5.33.4 represents approximately 4 weeks of development since Perl -5.33.3 and contains approximately 6,900 lines of changes across 340 files -from 16 authors. +=over 4 -Excluding auto-generated files, documentation and release tools, there were -approximately 4,200 lines of changes to 260 .pm, .t, .c and .h files. +=item * -Perl continues to flourish into its fourth decade thanks to a vibrant -community of users and developers. The following people are known to have -contributed the improvements that became Perl 5.33.4: +XXX Add anything here that we forgot to add, or were mistaken about, in +the perldelta of a previous release. -Ben Cornett, Chris 'BinGOs' Williams, Dan Book, David Mitchell, Giovanni -Tataranni, James E Keenan, Karen Etheridge, Karl Williamson, Marcus -Holland-Moritz, Nicolas R., Richard Leach, Scott Baker, Steve Hay, TAKAI -Kousuke, Tom Hukins, Tony Cook. +=back + +=head1 Obituary -The list above is almost certainly incomplete as it is automatically -generated from version control history. In particular, it does not include -the names of the (very much appreciated) contributors who reported issues to -the Perl bug tracker. +XXX If any significant core contributor or member of the CPAN community has +died, add a short obituary here. + +=head1 Acknowledgements -Many of the changes included in this version originated in the CPAN modules -included in Perl's core. We're grateful to the entire CPAN community for -helping Perl to flourish. +XXX Generate this with: -For a more complete list of all of Perl's historical contributors, please -see the F file in the Perl source distribution. + perl Porting/acknowledgements.pl v5.33.4..HEAD =head1 Reporting Bugs diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index dd12252a8bc3..0323f0603588 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -313,7 +313,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5) extra.pods : miniperl @ @extra_pods.com -PERLDELTA_CURRENT = [.pod]perl5334delta.pod +PERLDELTA_CURRENT = [.pod]perl5335delta.pod $(PERLDELTA_CURRENT) : [.pod]perldelta.pod Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 8dfe0cf02c96..3d111396cd98 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1743,7 +1743,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5334delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1841,7 +1841,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5334delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/Makefile b/win32/Makefile index 000462b62459..091a6b3f701d 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1264,7 +1264,7 @@ utils: $(PERLEXE) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5334delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. @@ -1363,7 +1363,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5334delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/makefile.mk b/win32/makefile.mk index a3b3bf6649ec..188fe317e47c 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1662,7 +1662,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5334delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1760,7 +1760,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5334delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/pod.mak b/win32/pod.mak index 20454fdd7aa6..f9890d631952 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -68,6 +68,7 @@ POD = perl.pod \ perl5332delta.pod \ perl5333delta.pod \ perl5334delta.pod \ + perl5335delta.pod \ perl561delta.pod \ perl56delta.pod \ perl581delta.pod \ @@ -232,6 +233,7 @@ MAN = perl.man \ perl5332delta.man \ perl5333delta.man \ perl5334delta.man \ + perl5335delta.man \ perl561delta.man \ perl56delta.man \ perl581delta.man \ @@ -396,6 +398,7 @@ HTML = perl.html \ perl5332delta.html \ perl5333delta.html \ perl5334delta.html \ + perl5335delta.html \ perl561delta.html \ perl56delta.html \ perl581delta.html \ @@ -560,6 +563,7 @@ TEX = perl.tex \ perl5332delta.tex \ perl5333delta.tex \ perl5334delta.tex \ + perl5335delta.tex \ perl561delta.tex \ perl56delta.tex \ perl581delta.tex \ From 790f2f66dd0f9e8678a5f5129f984aa0d5baf08c Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 16:59:27 +0000 Subject: [PATCH 043/503] Bump version to 5.33.5 --- Cross/config.sh-arm-linux | 40 ++++++++++++++++---------------- Cross/config.sh-arm-linux-n770 | 40 ++++++++++++++++---------------- INSTALL | 30 ++++++++++++------------ META.json | 2 +- META.yml | 2 +- NetWare/Makefile | 4 ++-- NetWare/config_H.wc | 10 ++++---- Porting/config.sh | 42 +++++++++++++++++----------------- Porting/config_H | 18 +++++++-------- Porting/perldelta_template.pod | 2 +- Porting/todo.pod | 4 ++-- README.haiku | 4 ++-- README.macosx | 8 +++---- README.os2 | 2 +- README.vms | 4 ++-- hints/catamount.sh | 4 ++-- lib/B/Op_private.pm | 2 +- patchlevel.h | 4 ++-- plan9/config_sh.sample | 38 +++++++++++++++--------------- win32/GNUmakefile | 2 +- win32/Makefile | 2 +- win32/makefile.mk | 2 +- 22 files changed, 133 insertions(+), 133 deletions(-) diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index fc03860333db..fa4d036ce837 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='4' +api_subversion='5' api_version='33' -api_versionstring='5.33.4' +api_versionstring='5.33.5' ar='ar' -archlib='/usr/lib/perl5/5.33.4/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.4/armv4l-linux' +archlib='/usr/lib/perl5/5.33.5/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.5/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -55,7 +55,7 @@ castflags='0' cat='cat' cc='cc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.4/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.5/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -824,7 +824,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.4/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.5/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -832,13 +832,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.4' +installprivlib='./install_me_here/usr/lib/perl5/5.33.5' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.4' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.5' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -972,8 +972,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.4' -privlibexp='/usr/lib/perl5/5.33.4' +privlib='/usr/lib/perl5/5.33.5' +privlibexp='/usr/lib/perl5/5.33.5' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1038,17 +1038,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.4' +sitelib='/usr/lib/perl5/site_perl/5.33.5' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.4' +sitelibexp='/usr/lib/perl5/site_perl/5.33.5' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1087,7 +1087,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='4' +subversion='5' sysman='/usr/share/man/man1' tail='' tar='' @@ -1178,8 +1178,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.4' -version_patchlevel_string='version 33 subversion 4' +version='5.33.5' +version_patchlevel_string='version 33 subversion 5' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1193,9 +1193,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=4 +PERL_SUBVERSION=5 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=4 +PERL_API_SUBVERSION=5 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index 5f18e7b4c84f..b49c2f104d18 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='4' +api_subversion='5' api_version='33' -api_versionstring='5.33.4' +api_versionstring='5.33.5' ar='ar' -archlib='/usr/lib/perl5/5.33.4/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.4/armv4l-linux' +archlib='/usr/lib/perl5/5.33.5/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.5/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -54,7 +54,7 @@ castflags='0' cat='cat' cc='arm-none-linux-gnueabi-gcc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.4/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.5/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -822,7 +822,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.4/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.5/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -830,13 +830,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.4' +installprivlib='./install_me_here/usr/lib/perl5/5.33.5' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.4' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.5' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -970,8 +970,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.4' -privlibexp='/usr/lib/perl5/5.33.4' +privlib='/usr/lib/perl5/5.33.5' +privlibexp='/usr/lib/perl5/5.33.5' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1036,17 +1036,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.4/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.4' +sitelib='/usr/lib/perl5/site_perl/5.33.5' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.4' +sitelibexp='/usr/lib/perl5/site_perl/5.33.5' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1085,7 +1085,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='4' +subversion='5' sysman='/usr/share/man/man1' tail='' tar='' @@ -1176,8 +1176,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.4' -version_patchlevel_string='version 33 subversion 4' +version='5.33.5' +version_patchlevel_string='version 33 subversion 5' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1191,9 +1191,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=4 +PERL_SUBVERSION=5 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=4 +PERL_API_SUBVERSION=5 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/INSTALL b/INSTALL index c16117f12493..6f674eb1c517 100644 --- a/INSTALL +++ b/INSTALL @@ -615,7 +615,7 @@ The directories set up by Configure fall into three broad categories. =item Directories for the perl distribution -By default, Configure will use the following directories for 5.33.4. +By default, Configure will use the following directories for 5.33.5. $version is the full perl version number, including subversion, e.g. 5.12.3, and $archname is a string like sun4-sunos, determined by Configure. The full definitions of all Configure @@ -2438,7 +2438,7 @@ L =head1 Coexistence with earlier versions of perl 5 -Perl 5.33.4 is not binary compatible with earlier versions of Perl. +Perl 5.33.5 is not binary compatible with earlier versions of Perl. In other words, you will have to recompile your XS modules. In general, you can usually safely upgrade from one stable version of Perl @@ -2513,9 +2513,9 @@ won't interfere with another version. (The defaults guarantee this for libraries after 5.6.0, but not for executables. TODO?) One convenient way to do this is by using a separate prefix for each version, such as - sh Configure -Dprefix=/opt/perl5.33.4 + sh Configure -Dprefix=/opt/perl5.33.5 -and adding /opt/perl5.33.4/bin to the shell PATH variable. Such users +and adding /opt/perl5.33.5/bin to the shell PATH variable. Such users may also wish to add a symbolic link /usr/local/bin/perl so that scripts can still start with #!/usr/local/bin/perl. @@ -2528,13 +2528,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from 5.33.3 or earlier +=head2 Upgrading from 5.33.4 or earlier -B Perl modules having binary parts (meaning that a C compiler is used) will have to be recompiled to be -used with 5.33.4. If you find you do need to rebuild an extension with -5.33.4, you may safely do so without disturbing the older +used with 5.33.5. If you find you do need to rebuild an extension with +5.33.5, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2567,15 +2567,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.33.4 is as follows (under $Config{prefix}): +in Linux with perl-5.33.5 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.33.4/strict.pm - ./lib/perl5/5.33.4/warnings.pm - ./lib/perl5/5.33.4/i686-linux/File/Glob.pm - ./lib/perl5/5.33.4/feature.pm - ./lib/perl5/5.33.4/XSLoader.pm - ./lib/perl5/5.33.4/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.33.5/strict.pm + ./lib/perl5/5.33.5/warnings.pm + ./lib/perl5/5.33.5/i686-linux/File/Glob.pm + ./lib/perl5/5.33.5/feature.pm + ./lib/perl5/5.33.5/XSLoader.pm + ./lib/perl5/5.33.5/i686-linux/auto/File/Glob/Glob.so Secondly, for perl-5.10.1, the Debian perl-base package contains 591 files, (of which 510 are for lib/unicore) totaling about 3.5MB in its diff --git a/META.json b/META.json index 96936940c538..77d5811c9853 100644 --- a/META.json +++ b/META.json @@ -130,6 +130,6 @@ "url" : "https://github.com/Perl/perl5" } }, - "version" : "5.033004", + "version" : "5.033005", "x_serialization_backend" : "JSON::PP version 4.05" } diff --git a/META.yml b/META.yml index 0f588acf59b6..09696b28eef0 100644 --- a/META.yml +++ b/META.yml @@ -117,5 +117,5 @@ resources: homepage: https://www.perl.org/ license: https://dev.perl.org/licenses/ repository: https://github.com/Perl/perl5 -version: '5.033004' +version: '5.033005' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/NetWare/Makefile b/NetWare/Makefile index 9425c0ac7ae3..c917ab7282fe 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -86,7 +86,7 @@ NLM_VERSION = 3,20,0 # Here comes the CW tools - TO BE FILLED TO BUILD WITH CW - -MODULE_DESC = "Perl 5.33.4 for NetWare" +MODULE_DESC = "Perl 5.33.5 for NetWare" CCTYPE = CodeWarrior C_COMPILER = mwccnlm -c CPP_COMPILER = mwccnlm @@ -462,7 +462,7 @@ INST_NW_TOP2 = $(INST_NW_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.33.4 +INST_VER = \5.33.5 # # Comment this out if you DON'T want your perl installation to have diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index 7d76806187df..19e6ce424081 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -887,7 +887,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.33.4\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.33.5\\lib\\NetWare-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -918,8 +918,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.33.4\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.33.4\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.33.5\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.33.5\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -2878,7 +2878,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.33.4\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.33.5\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2901,7 +2901,7 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.33.4\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.33.5\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/Porting/config.sh b/Porting/config.sh index a617f9192de7..1401eaa6155c 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -46,12 +46,12 @@ afsroot='/afs' alignbytes='16' aphostname='' api_revision='5' -api_subversion='4' +api_subversion='5' api_version='33' -api_versionstring='5.33.4' +api_versionstring='5.33.5' ar='ar' -archlib='/opt/perl/lib/5.33.4/x86_64-linux-thread-multi-ld' -archlibexp='/opt/perl/lib/5.33.4/x86_64-linux-thread-multi-ld' +archlib='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' +archlibexp='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' archname64='' archname='x86_64-linux-thread-multi-ld' archobjs='' @@ -853,7 +853,7 @@ incpath='' incpth='/usr/lib64/gcc/x86_64-suse-linux/10/include /usr/local/include /usr/lib64/gcc/x86_64-suse-linux/10/include-fixed /usr/lib64/gcc/x86_64-suse-linux/10/../../../../x86_64-suse-linux/include /usr/include' inews='' initialinstalllocation='/opt/perl/bin' -installarchlib='/opt/perl/lib/5.33.4/x86_64-linux-thread-multi-ld' +installarchlib='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' installbin='/opt/perl/bin' installhtml1dir='' installhtml3dir='' @@ -861,13 +861,13 @@ installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.33.4' +installprivlib='/opt/perl/lib/5.33.5' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.33.4/x86_64-linux-thread-multi-ld' +installsitearch='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' installsitebin='/opt/perl/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/opt/perl/lib/site_perl/5.33.4' +installsitelib='/opt/perl/lib/site_perl/5.33.5' installsiteman1dir='/opt/perl/man/man1' installsiteman3dir='/opt/perl/man/man3' installsitescript='/opt/perl/bin' @@ -992,7 +992,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='yourname@yourhost.yourplace.com' perllibs='-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc' -perlpath='/opt/perl/bin/perl5.33.4' +perlpath='/opt/perl/bin/perl5.33.5' pg='pg' phostname='' pidtype='pid_t' @@ -1001,8 +1001,8 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.33.4' -privlibexp='/opt/perl/lib/5.33.4' +privlib='/opt/perl/lib/5.33.5' +privlibexp='/opt/perl/lib/5.33.5' procselfexe='"/proc/self/exe"' ptrsize='8' quadkind='2' @@ -1067,17 +1067,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 6, 17, 29, 0' sig_size='68' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.33.4/x86_64-linux-thread-multi-ld' -sitearchexp='/opt/perl/lib/site_perl/5.33.4/x86_64-linux-thread-multi-ld' +sitearch='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' +sitearchexp='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/opt/perl/lib/site_perl/5.33.4' +sitelib='/opt/perl/lib/site_perl/5.33.5' sitelib_stem='/opt/perl/lib/site_perl' -sitelibexp='/opt/perl/lib/site_perl/5.33.4' +sitelibexp='/opt/perl/lib/site_perl/5.33.5' siteman1dir='/opt/perl/man/man1' siteman1direxp='/opt/perl/man/man1' siteman3dir='/opt/perl/man/man3' @@ -1103,7 +1103,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/opt/perl/bin/perl5.33.4' +startperl='#!/opt/perl/bin/perl5.33.5' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1115,7 +1115,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='' strerror_r_proto='REENTRANT_PROTO_B_IBW' submit='' -subversion='4' +subversion='5' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1214,8 +1214,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.4' -version_patchlevel_string='version 33 subversion 4' +version='5.33.5' +version_patchlevel_string='version 33 subversion 5' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1225,10 +1225,10 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=4 +PERL_SUBVERSION=5 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=4 +PERL_API_SUBVERSION=5 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true : Variables propagated from previous config.sh file. diff --git a/Porting/config_H b/Porting/config_H index f54e17376bc9..096611f6a6c7 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -1239,8 +1239,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.33.4/x86_64-linux" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.33.4/x86_64-linux" /**/ +#define ARCHLIB "/opt/perl/lib/5.33.5/x86_64-linux" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.33.5/x86_64-linux" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -1293,8 +1293,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.33.4" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.33.4" /**/ +#define PRIVLIB "/opt/perl/lib/5.33.5" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.33.5" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1311,8 +1311,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.33.4/x86_64-linux" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.4/x86_64-linux" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.33.5/x86_64-linux" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.5/x86_64-linux" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1334,8 +1334,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/opt/perl/lib/site_perl/5.33.4" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.4" /**/ +#define SITELIB "/opt/perl/lib/site_perl/5.33.5" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.5" /**/ #define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ /* PERL_VENDORARCH: @@ -4109,7 +4109,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/opt/perl/bin/perl5.33.4" /**/ +#define STARTPERL "#!/opt/perl/bin/perl5.33.5" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index 9eb1053c73ab..a7b78d466a6b 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -403,7 +403,7 @@ died, add a short obituary here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.33.4..HEAD + perl Porting/acknowledgements.pl v5.33.5..HEAD =head1 Reporting Bugs diff --git a/Porting/todo.pod b/Porting/todo.pod index b67e419addce..72b5f0db2a5f 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -486,7 +486,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall. On these systems, it might be the default compilation mode, and there is currently no guarantee that passing no use64bitall option to the Configure process will build a 32bit perl. Implementing -Duse32bit* -options would be nice for perl 5.33.4. +options would be nice for perl 5.33.5. =head2 Profile Perl - am I hot or not? @@ -1189,7 +1189,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.33.4" +of 5.33.5" =head2 make ithreads more robust diff --git a/README.haiku b/README.haiku index 241cba8d030c..415a4fdeeaf1 100644 --- a/README.haiku +++ b/README.haiku @@ -22,9 +22,9 @@ The build procedure is completely standard: Make perl executable and create a symlink for libperl: chmod a+x /boot/common/bin/perl - cd /boot/common/lib; ln -s perl5/5.33.4/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.33.5/BePC-haiku/CORE/libperl.so . -Replace C<5.33.4> with your respective version of Perl. +Replace C<5.33.5> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index bb66fe71a88b..e57bb1bf7557 100644 --- a/README.macosx +++ b/README.macosx @@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X This document briefly describes Perl under Mac OS X. - curl -O https://www.cpan.org/src/perl-5.33.4.tar.gz - tar -xzf perl-5.33.4.tar.gz - cd perl-5.33.4 + curl -O https://www.cpan.org/src/perl-5.33.5.tar.gz + tar -xzf perl-5.33.5.tar.gz + cd perl-5.33.5 ./Configure -des -Dprefix=/usr/local/ make make test @@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X. =head1 DESCRIPTION -The latest Perl release (5.33.4 as of this writing) builds without changes +The latest Perl release (5.33.5 as of this writing) builds without changes under all versions of Mac OS X from 10.3 "Panther" onwards. In order to build your own version of Perl you will need 'make', diff --git a/README.os2 b/README.os2 index edaf04962bdd..3bcd3a162a7e 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.4/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.5/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C), you diff --git a/README.vms b/README.vms index 137e8eec1457..79191c274ed6 100644 --- a/README.vms +++ b/README.vms @@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of choice. Once you have done so, use a command like the following to unpack the archive: - vmstar -xvf perl-5^.33^.4.tar + vmstar -xvf perl-5^.33^.5.tar Then set default to the top-level source directory like so: - set default [.perl-5^.33^.4] + set default [.perl-5^.33^.5] and proceed with configuration as described in the next section. diff --git a/hints/catamount.sh b/hints/catamount.sh index d09e448874d3..16b901a9c9de 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # mkdir -p /opt/perl-catamount # mkdir -p /opt/perl-catamount/include # mkdir -p /opt/perl-catamount/lib -# mkdir -p /opt/perl-catamount/lib/perl5/5.33.4 +# mkdir -p /opt/perl-catamount/lib/perl5/5.33.5 # mkdir -p /opt/perl-catamount/bin # cp *.h /opt/perl-catamount/include # cp libperl.a /opt/perl-catamount/lib -# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.4 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.5 # cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib # # With the headers and the libperl.a you can embed Perl to your Catamount diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index d89e3da9fa83..2961bd97e94f 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.033004"; +our $VERSION = "5.033005"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); diff --git a/patchlevel.h b/patchlevel.h index 69b9ef536490..b2c04427be75 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -39,7 +39,7 @@ Instead use one of the version comparison macros. See C>. #define PERL_REVISION 5 /* age */ #define PERL_VERSION 33 /* epoch */ -#define PERL_SUBVERSION 4 /* generation */ +#define PERL_SUBVERSION 5 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -60,7 +60,7 @@ Instead use one of the version comparison macros. See C>. */ #define PERL_API_REVISION 5 #define PERL_API_VERSION 33 -#define PERL_API_SUBVERSION 4 +#define PERL_API_SUBVERSION 5 /* XXX Note: The selection of non-default Configure options, such as -Duselonglong may invalidate these settings. Currently, Configure diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index e817912c3988..dfd7c32772c5 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/uname -n' api_revision='5' -api_subversion='4' +api_subversion='5' api_version='33' -api_versionstring='5.33.4' +api_versionstring='5.33.5' ar='ar' -archlib='/sys/lib/perl5/5.33.4/386' -archlibexp='/sys/lib/perl5/5.33.4/386' +archlib='/sys/lib/perl5/5.33.5/386' +archlibexp='/sys/lib/perl5/5.33.5/386' archname64='' archname='386' archobjs='' @@ -818,17 +818,17 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/sys/lib/perl/5.33.4/386' +installarchlib='/sys/lib/perl/5.33.5/386' installbin='/usr/bin' installman1dir='/sys/man/1pub' installman3dir='/sys/man/2pub' installprefix='/usr' installprefixexp='/usr' -installprivlib='/sys/lib/perl/5.33.4' +installprivlib='/sys/lib/perl/5.33.5' installscript='/usr/bin' -installsitearch='/sys/lib/perl/5.33.4/site_perl/386' +installsitearch='/sys/lib/perl/5.33.5/site_perl/386' installsitebin='/usr/bin' -installsitelib='/sys/lib/perl/5.33.4/site_perl' +installsitelib='/sys/lib/perl/5.33.5/site_perl' installstyle='lib/perl5' installusrbinperl='undef' installvendorarch='' @@ -953,8 +953,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/sys/lib/perl/5.33.4' -privlibexp='/sys/lib/perl/5.33.4' +privlib='/sys/lib/perl/5.33.5' +privlibexp='/sys/lib/perl/5.33.5' procselfexe='' prototype='define' ptrsize='4' @@ -1019,13 +1019,13 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0' sig_size='50' signal_t='void' -sitearch='/sys/lib/perl/5.33.4/site_perl/386' +sitearch='/sys/lib/perl/5.33.5/site_perl/386' sitearchexp='/sys/lib/perl/site_perl/386' sitebin='/usr/bin' sitebinexp='/usr/bin' -sitelib='/sys/lib/perl/5.33.4/site_perl' -sitelib_stem='/sys/lib/perl/5.33.4/site_perl' -sitelibexp='/sys/lib/perl/5.33.4/site_perl' +sitelib='/sys/lib/perl/5.33.5/site_perl' +sitelib_stem='/sys/lib/perl/5.33.5/site_perl' +sitelibexp='/sys/lib/perl/5.33.5/site_perl' siteprefix='/usr' siteprefixexp='/usr' sizesize='4' @@ -1058,7 +1058,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='4' +subversion='5' sysman='/sys/man/1pub' tail='' tar='' @@ -1139,8 +1139,8 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.33.4' -version_patchlevel_string='version 33 subversion 4' +version='5.33.5' +version_patchlevel_string='version 33 subversion 5' versiononly='undef' vi='' xlibpth='' @@ -1154,9 +1154,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=4 +PERL_SUBVERSION=5 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=4 +PERL_API_SUBVERSION=5 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 3d111396cd98..7c45d00e2528 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -64,7 +64,7 @@ INST_TOP := $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER := \5.33.4 +#INST_VER := \5.33.5 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/Makefile b/win32/Makefile index 091a6b3f701d..ecbfd7a819c9 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -38,7 +38,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER = \5.33.4 +#INST_VER = \5.33.5 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/makefile.mk b/win32/makefile.mk index 188fe317e47c..d9d90c66540c 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -45,7 +45,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER *= \5.33.4 +#INST_VER *= \5.33.5 # # Comment this out if you DON'T want your perl installation to have From 296a08c4087b4555a7fab42f30250baa1bdee0ca Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 17:20:05 +0000 Subject: [PATCH 044/503] Prepare Module::CoreList for 5.33.5 --- dist/Module-CoreList/Changes | 3 +++ dist/Module-CoreList/lib/Module/CoreList.pm | 21 ++++++++++++++++++- .../lib/Module/CoreList/Utils.pm | 9 +++++++- 3 files changed, 31 insertions(+), 2 deletions(-) diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index bca8d50630dd..768e99e7a474 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.20201220 + - Updated for v5.33.5 + 5.20201120 - Updated for v5.33.4 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index b20670dee788..4b1b7583612c 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use strict; our ( %released, %version, %families, %upstream, %bug_tracker, %deprecated, %delta ); use version; -our $VERSION = '5.20201120'; +our $VERSION = '5.20201220'; sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# } sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } } @@ -371,6 +371,7 @@ sub changes_between { 5.033002 => '2020-09-20', 5.033003 => '2020-10-20', 5.033004 => '2020-11-20', + 5.033005 => '2020-12-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -18086,6 +18087,17 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.033005 => { + delta_from => 5.033004, + changed => { + 'B::Op_private' => '5.033005', + 'Config' => '5.033005', + 'Module::CoreList' => '5.20201220', + 'Module::CoreList::Utils'=> '5.20201220', + }, + removed => { + } + }, ); sub is_core @@ -19242,6 +19254,13 @@ sub is_core removed => { } }, + 5.033005 => { + delta_from => 5.033004, + changed => { + }, + removed => { + } + }, ); %deprecated = _undelta(\%deprecated); diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 1406f1b5cbfd..036fe87823a6 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Module::CoreList; -our $VERSION = '5.20201120'; +our $VERSION = '5.20201220'; our %utilities; sub utilities { @@ -1657,6 +1657,13 @@ my %delta = ( removed => { } }, + 5.033005 => { + delta_from => 5.033004, + changed => { + }, + removed => { + } + }, ); %utilities = Module::CoreList::_undelta(\%delta); From bb8005f7c9590e1f2f0f8ff85ce187d89a3bdfef Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Fri, 20 Nov 2020 17:27:45 +0000 Subject: [PATCH 045/503] Fix documentation grammar Replace "Frees the all the" with "Frees all the". The original wording was introduced in c2217cd33590ef654 and a4395ebabc8655115. --- av.c | 2 +- hv.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/av.c b/av.c index ed67df19de99..67815fce90bc 100644 --- a/av.c +++ b/av.c @@ -451,7 +451,7 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) /* =for apidoc av_clear -Frees the all the elements of an array, leaving it empty. +Frees all the elements of an array, leaving it empty. The XS equivalent of C<@array = ()>. See also L. Note that it is possible that the actions of a destructor called directly diff --git a/hv.c b/hv.c index 43b9330260d6..32e1a7d4387e 100644 --- a/hv.c +++ b/hv.c @@ -1776,7 +1776,7 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry) /* =for apidoc hv_clear -Frees the all the elements of a hash, leaving it empty. +Frees all the elements of a hash, leaving it empty. The XS equivalent of C<%hash = ()>. See also L. See L for a note about the hash possibly being invalid on From 7897a384ae80b4b1289931c734df395c00d276d8 Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Fri, 20 Nov 2020 09:43:31 -0800 Subject: [PATCH 046/503] fix perlfaq version in perldelta --- pod/perl5334delta.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perl5334delta.pod b/pod/perl5334delta.pod index 4d119cc35371..c1fc77dba232 100644 --- a/pod/perl5334delta.pod +++ b/pod/perl5334delta.pod @@ -90,7 +90,7 @@ at L. =item * -The Perl FAQ was updated to CPAN version 5.20200523 with minor +The Perl FAQ was updated to CPAN version 5.20201107 with minor improvements. =back From d180c23405c06a18aee66c4bc92377de5f9b423b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:51:18 -0600 Subject: [PATCH 047/503] perlapi: Consolidate sv_inc-ish entries --- sv.c | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/sv.c b/sv.c index 4e9f45a7f88d..bb7aa351ba04 100644 --- a/sv.c +++ b/sv.c @@ -8878,9 +8878,13 @@ Perl_sv_gets(pTHX_ SV *const sv, PerlIO *const fp, I32 append) /* =for apidoc sv_inc +=for apidoc_item sv_inc_nomg -Auto-increment of the value in the SV, doing string to numeric conversion -if necessary. Handles 'get' magic and operator overloading. +These auto-increment the value in the SV, doing string to numeric conversion +if necessary. They both handle operator overloading. + +They differ only in that C performs 'get' magic; C skips +any magic. =cut */ @@ -8894,15 +8898,6 @@ Perl_sv_inc(pTHX_ SV *const sv) sv_inc_nomg(sv); } -/* -=for apidoc sv_inc_nomg - -Auto-increment of the value in the SV, doing string to numeric conversion -if necessary. Handles operator overloading. Skips handling 'get' magic. - -=cut -*/ - void Perl_sv_inc_nomg(pTHX_ SV *const sv) { From ad62af8ee3c74fc7b915c5468fdb05a89d709f39 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:54:15 -0600 Subject: [PATCH 048/503] perlapi: Consolidate newSVsv-ish entries --- sv.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/sv.c b/sv.c index bb7aa351ba04..026d3ccaa0c7 100644 --- a/sv.c +++ b/sv.c @@ -9743,13 +9743,13 @@ Perl_newRV(pTHX_ SV *const sv) /* =for apidoc newSVsv +=for apidoc_item newSVsv_nomg -Creates a new SV which is an exact duplicate of the original SV. +These create a new SV which is an exact duplicate of the original SV. (Uses C.) -=for apidoc newSVsv_nomg - -Like C but does not process get magic. +They differ only in that C performs 'get' magic; C skips +any magic. =cut */ From 28971e169191d1cc78d413c51b01a60e86a99458 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 22 Sep 2020 07:20:52 -0600 Subject: [PATCH 049/503] Various COPHH macros have a non-const parameter The pod says these are const, but they won't compile if actually called with one. --- cop.h | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/cop.h b/cop.h index b61bb30174b4..17df8b566389 100644 --- a/cop.h +++ b/cop.h @@ -299,7 +299,7 @@ be stored with referential integrity, but will be coerced to strings. Perl_refcounted_he_new_pvn(aTHX_ cophh, keypv, keylen, hash, value, flags) /* -=for apidoc Amx|COPHH *|cophh_store_pvs|const COPHH *cophh|"key"|SV *value|U32 flags +=for apidoc Amx|COPHH *|cophh_store_pvs|COPHH *cophh|"key"|SV *value|U32 flags Like L, but takes a literal string instead of a string/length pair, and no precomputed hash. @@ -311,7 +311,7 @@ of a string/length pair, and no precomputed hash. Perl_refcounted_he_new_pvn(aTHX_ cophh, STR_WITH_LEN(key), 0, value, flags) /* -=for apidoc Amx|COPHH *|cophh_store_pv|const COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags +=for apidoc Amx|COPHH *|cophh_store_pv|COPHH *cophh|const char *key|U32 hash|SV *value|U32 flags Like L, but takes a nul-terminated string instead of a string/length pair. @@ -323,7 +323,7 @@ a string/length pair. Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, value, flags) /* -=for apidoc Amx|COPHH *|cophh_store_sv|const COPHH *cophh|SV *key|U32 hash|SV *value|U32 flags +=for apidoc Amx|COPHH *|cophh_store_sv|COPHH *cophh|SV *key|U32 hash|SV *value|U32 flags Like L, but takes a Perl scalar instead of a string/length pair. @@ -356,7 +356,7 @@ hash of the key string, or zero if it has not been precomputed. (SV *)NULL, flags) /* -=for apidoc Amx|COPHH *|cophh_delete_pvs|const COPHH *cophh|"key"|U32 flags +=for apidoc Amx|COPHH *|cophh_delete_pvs|COPHH *cophh|"key"|U32 flags Like L, but takes a literal string instead of a string/length pair, and no precomputed hash. @@ -369,7 +369,7 @@ of a string/length pair, and no precomputed hash. (SV *)NULL, flags) /* -=for apidoc Amx|COPHH *|cophh_delete_pv|const COPHH *cophh|const char *key|U32 hash|U32 flags +=for apidoc Amx|COPHH *|cophh_delete_pv|COPHH *cophh|char *key|U32 hash|U32 flags Like L, but takes a nul-terminated string instead of a string/length pair. @@ -381,7 +381,7 @@ a string/length pair. Perl_refcounted_he_new_pv(aTHX_ cophh, key, hash, (SV *)NULL, flags) /* -=for apidoc Amx|COPHH *|cophh_delete_sv|const COPHH *cophh|SV *key|U32 hash|U32 flags +=for apidoc Amx|COPHH *|cophh_delete_sv|COPHH *cophh|SV *key|U32 hash|U32 flags Like L, but takes a Perl scalar instead of a string/length pair. From cf203d64fd185f0c9039718e9c00b3e723a3afe3 Mon Sep 17 00:00:00 2001 From: Sawyer X Date: Sat, 21 Nov 2020 14:00:58 +0200 Subject: [PATCH 050/503] Note down all future releasers for this cycle --- Porting/release_schedule.pod | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 81f6d9c10949..9390a65a7071 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -44,11 +44,11 @@ you should reset the version numbers to the next blead series. 2020-09-20 5.33.2 ✓ Sawyer X 2020-10-20 5.33.3 ✓ Steve Hay 2020-11-20 5.33.4 ✓ Tom Hukins - 2020-12-20 5.33.5 - 2021-01-20 5.33.6 + 2020-12-20 5.33.5 Max Maischein + 2021-01-20 5.33.6 Richard Leach 2021-02-20 5.33.7 Renee Backer - 2021-03-20 5.33.8 - 2021-04-20 5.33.9 + 2021-03-20 5.33.8 Atoomic + 2021-04-20 5.33.9 Todd Rinaldo =head1 VICTIMS From 73d434eae8af19f8e3477952dc0351abe0c561a7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:55:34 -0600 Subject: [PATCH 051/503] perlapi: Consolidate sv_setpviv-ish entries --- sv.c | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/sv.c b/sv.c index 026d3ccaa0c7..507df8882956 100644 --- a/sv.c +++ b/sv.c @@ -10672,9 +10672,12 @@ Perl_sv_tainted(pTHX_ SV *const sv) /* =for apidoc sv_setpviv +=for apidoc_item sv_setpviv_mg -Copies an integer into the given SV, also updating its string value. -Does not handle 'set' magic. See C>. +These copy an integer into the given SV, also updating its string value. + +They differ only in that C performs 'set' magic; C +skips any magic. =cut */ @@ -10696,14 +10699,6 @@ Perl_sv_setpviv(pTHX_ SV *const sv, const IV iv) sv_setpvn(sv, ptr, ebuf - ptr); } -/* -=for apidoc sv_setpviv_mg - -Like C, but also handles 'set' magic. - -=cut -*/ - void Perl_sv_setpviv_mg(pTHX_ SV *const sv, const IV iv) { From 52394dc7f1db99c6f7412d0671f6e83a5fe4b3c1 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:03:24 -0600 Subject: [PATCH 052/503] perlapi: Consolidate sv_setpvf-ish entries --- sv.c | 32 +++++++++++++------------------- 1 file changed, 13 insertions(+), 19 deletions(-) diff --git a/sv.c b/sv.c index 507df8882956..8d95f79ba1cc 100644 --- a/sv.c +++ b/sv.c @@ -10756,14 +10756,21 @@ Perl_sv_setpvf_mg_nocontext(SV *const sv, const char *const pat, ...) /* =for apidoc sv_setpvf +=for apidoc_item sv_setpvf_nocontext +=for apidoc_item sv_setpvf_mg +=for apidoc_item sv_setpvf_mg_nocontext -Works like C but copies the text into the SV instead of -appending it. Does not handle 'set' magic. See C>. +These work like C> but copy the text into the SV instead of +appending it. -=for apidoc sv_setpvf_nocontext -Like C> but does not take a thread context (C) parameter, -so is used in situations where the caller doesn't already have the thread -context. +The differences between these are: + +C and C do not handle 'set' magic; +C and C do. + +C and C do not take a thread +context (C) parameter, so are used in situations where the caller +doesn't already have the thread context. =cut */ @@ -10799,19 +10806,6 @@ Perl_sv_vsetpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args) sv_vsetpvfn(sv, pat, strlen(pat), args, NULL, 0, NULL); } -/* -=for apidoc sv_setpvf_mg - -Like C, but also handles 'set' magic. - -=for apidoc sv_setpvf_mg_nocontext -Like C>, but does not take a thread context (C) -parameter, so is used in situations where the caller doesn't already have the -thread context. - -=cut -*/ - void Perl_sv_setpvf_mg(pTHX_ SV *const sv, const char *const pat, ...) { From ba9cc8c250ad015c64982ad289b0d2b8a2d3d288 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:08:38 -0600 Subject: [PATCH 053/503] perlapi: Consolidate sv_catpvf-ish entries --- sv.c | 43 +++++++++++++++++++------------------------ 1 file changed, 19 insertions(+), 24 deletions(-) diff --git a/sv.c b/sv.c index 8d95f79ba1cc..8bfea3791e36 100644 --- a/sv.c +++ b/sv.c @@ -10879,23 +10879,31 @@ Perl_sv_catpvf_mg_nocontext(SV *const sv, const char *const pat, ...) /* =for apidoc sv_catpvf +=for apidoc_item sv_catpvf_nocontext +=for apidoc_item sv_catpvf_mg +=for apidoc_item sv_catpvf_mg_nocontext + +These process their arguments like C, and append the formatted +output to an SV. As with C, argument reordering is not supporte +when called with a non-null C-style variable argument list. -Processes its arguments like C, and appends the formatted -output to an SV. As with C called with a non-null C-style -variable argument list, argument reordering is not supported. If the appended data contains "wide" characters (including, but not limited to, SVs with a UTF-8 PV formatted with C<%s>, and characters >255 formatted with C<%c>), the original SV might get -upgraded to UTF-8. Handles 'get' magic, but not 'set' magic. See -C>. If the original SV was UTF-8, the pattern should be +upgraded to UTF-8. + +If the original SV was UTF-8, the pattern should be valid UTF-8; if the original SV was bytes, the pattern should be too. -=for apidoc sv_catpvf_nocontext -Like C> but does not take a thread context (C) parameter, -so is used in situations where the caller doesn't already have the thread -context. +All perform 'get' magic, but only C and C +perform 'set' magic. -=cut */ +C and C do not take a thread +context (C) parameter, so are used in situations where the caller +doesn't already have the thread context. + +=cut +*/ void Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...) @@ -10916,7 +10924,7 @@ Processes its arguments like C called with a non-null C-style variable argument list, and appends the formatted output to an SV. Does not handle 'set' magic. See C>. -Usually used via its frontend C. +Usually used via their frontends C> and C>. =cut */ @@ -10929,19 +10937,6 @@ Perl_sv_vcatpvf(pTHX_ SV *const sv, const char *const pat, va_list *const args) sv_vcatpvfn_flags(sv, pat, strlen(pat), args, NULL, 0, NULL, SV_GMAGIC|SV_SMAGIC); } -/* -=for apidoc sv_catpvf_mg - -Like C, but also handles 'set' magic. - -=for apidoc sv_catpvf_mg_nocontext -Like C> but does not take a thread context (C) parameter, -so is used in situations where the caller doesn't already have the thread -context. - -=cut -*/ - void Perl_sv_catpvf_mg(pTHX_ SV *const sv, const char *const pat, ...) { From 00956e4f376436dadce7af99e5c69b8d56cd797f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:12:01 -0600 Subject: [PATCH 054/503] perlapi: Consolidate sv_vcatpvf-ish entries --- sv.c | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/sv.c b/sv.c index 8bfea3791e36..fc1c2d604058 100644 --- a/sv.c +++ b/sv.c @@ -10919,12 +10919,18 @@ Perl_sv_catpvf(pTHX_ SV *const sv, const char *const pat, ...) /* =for apidoc sv_vcatpvf +=for apidoc_item sv_vcatpvf_mg -Processes its arguments like C called with a non-null C-style -variable argument list, and appends the formatted output -to an SV. Does not handle 'set' magic. See C>. +These process their arguments like C called with a non-null +C-style variable argument list, and append the formatted output to C. -Usually used via their frontends C> and C>. +They differ only in that C performs 'set' magic; +C skips 'set' magic. + +Both perform 'get' magic. + +They are usually accessed via their frontends C> and +C>. =cut */ @@ -10950,16 +10956,6 @@ Perl_sv_catpvf_mg(pTHX_ SV *const sv, const char *const pat, ...) va_end(args); } -/* -=for apidoc sv_vcatpvf_mg - -Like C, but also handles 'set' magic. - -Usually used via its frontend C. - -=cut -*/ - void Perl_sv_vcatpvf_mg(pTHX_ SV *const sv, const char *const pat, va_list *const args) { From 897bfe17199fdc10c4a964825f257376ff6bb9fc Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 21 Nov 2020 12:24:53 -0700 Subject: [PATCH 055/503] sv.c: Add missing pod markup The item referred to in a L<> is in perlapi, so should be marked as internal to the same pod. --- sv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sv.c b/sv.c index fc1c2d604058..2f80df914c30 100644 --- a/sv.c +++ b/sv.c @@ -10929,7 +10929,7 @@ C skips 'set' magic. Both perform 'get' magic. -They are usually accessed via their frontends C> and +They are usually accessed via their frontends C> and C>. =cut From 644499effcb245f5bd1592fe5110945fe98a3fc2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Nov 2020 13:17:05 -0700 Subject: [PATCH 056/503] Mark despatch_signals as core only --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 97d85a8c98d9..6e703b5afc7c 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1579,7 +1579,7 @@ ApdO |I32 |call_argv |NN const char* sub_name|I32 flags|NN char** argv ApdO |I32 |call_method |NN const char* methname|I32 flags ApdO |I32 |call_pv |NN const char* sub_name|I32 flags ApdO |I32 |call_sv |NN SV* sv|volatile I32 flags -Ap |void |despatch_signals +Cp |void |despatch_signals Ap |OP * |doref |NN OP *o|I32 type|bool set_op_ref ApdO |SV* |eval_pv |NN const char* p|I32 croak_on_error ApdO |I32 |eval_sv |NN SV* sv|I32 flags From e6cf6753c0a863255ba19b08b556a08c5e571b51 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 06:59:49 -0600 Subject: [PATCH 057/503] Document NUM2PTR or at least lead people to use something better --- perl.h | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/perl.h b/perl.h index e8ecb1b34e83..93d7c71fbb3b 100644 --- a/perl.h +++ b/perl.h @@ -2112,6 +2112,14 @@ typedef UVTYPE UV; # define PTR2ul(p) INT2PTR(unsigned long,p) #endif +/* +=for apidoc_section Casting +=for apidoc Cyh|type|NUM2PTR|type|int value +You probably want to be using L> instead. + +=cut +*/ + #define NUM2PTR(any,d) (any)(PTRV)(d) #define PTR2IV(p) INT2PTR(IV,p) #define PTR2UV(p) INT2PTR(UV,p) From 1d31276decae722536833b5395bb9fd32bb121d5 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 17:02:37 -0600 Subject: [PATCH 058/503] Document isGV_with_GP --- sv.h | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/sv.h b/sv.h index fc35f346e637..abe93ec05f7d 100644 --- a/sv.h +++ b/sv.h @@ -2236,6 +2236,13 @@ See also C> and C>. #define isGV(sv) (SvTYPE(sv) == SVt_PVGV) /* If I give every macro argument a different name, then there won't be bugs where nested macros get confused. Been there, done that. */ +/* +=for apidoc Am|bool|isGV_with_GP|SV * sv +Returns a boolean as to whether or not C is a GV with a pointer to a GP +(glob pointer). + +=cut +*/ #define isGV_with_GP(pwadak) \ (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP) \ && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV)) From 6ad5d069c8c5411b034be41709e7fb1197014228 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 14 Nov 2020 16:22:28 -0700 Subject: [PATCH 059/503] Document dTHXa, dTHXoa --- perl.h | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/perl.h b/perl.h index 93d7c71fbb3b..3382dad025de 100644 --- a/perl.h +++ b/perl.h @@ -135,6 +135,17 @@ Otherwise ends a section of code already begun by a C>. # endif #endif +/* +=for apidoc_section $concurrency +=for apidoc AmU|void|dTHXa|PerlInterpreter * a +On threaded perls, set C to C; on unthreaded perls, do nothing + +=for apidoc AmU|void|dTHXoa|PerlInterpreter * a +Now a synonym for C>. + +=cut +*/ + #ifdef PERL_IMPLICIT_CONTEXT # ifndef MULTIPLICITY # define MULTIPLICITY From aeef7bbf8bbd7ba72a854182ff2a8368344e28cb Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 21:50:10 -0600 Subject: [PATCH 060/503] perlapi: Consolidate sv_catpv-ish entries --- sv.c | 48 +++++++++++++++++++++++------------------------- sv.h | 3 --- 2 files changed, 23 insertions(+), 28 deletions(-) diff --git a/sv.c b/sv.c index 2f80df914c30..fcc94a2bc6ae 100644 --- a/sv.c +++ b/sv.c @@ -5561,14 +5561,32 @@ Perl_sv_catsv_flags(pTHX_ SV *const dsv, SV *const sstr, const I32 flags) /* =for apidoc sv_catpv +=for apidoc_item sv_catpv_flags +=for apidoc_item sv_catpv_mg +=for apidoc_item sv_catpv_nomg -Concatenates the C-terminated string C onto the end of the string which is -in the SV. +These concatenate the C-terminated string C onto the end of the +string which is in the SV. If the SV has the UTF-8 status set, then the bytes appended should be -valid UTF-8. Handles 'get' magic, but not 'set' magic. See -C>. +valid UTF-8. -=cut */ +They differ only in how they handle magic: + +C performs both 'get' and 'set' magic. + +C performs only 'get' magic. + +C skips all magic. + +C has an extra C parameter which allows you to specify +any combination of magic handling (using C and/or C), and +to also override the UTF-8 handling. By supplying the C flag, the +appended string is forced to be interpreted as UTF-8; by supplying instead the +C flag, it will be interpreted as just bytes. Either the SV or +the string appended will be upgraded to UTF-8 if necessary. + +=cut +*/ void Perl_sv_catpv(pTHX_ SV *const dsv, const char *sstr) @@ -5592,18 +5610,6 @@ Perl_sv_catpv(pTHX_ SV *const dsv, const char *sstr) SvTAINT(dsv); } -/* -=for apidoc sv_catpv_flags - -Concatenates the C-terminated string onto the end of the string which is -in the SV. -If the SV has the UTF-8 status set, then the bytes appended should -be valid UTF-8. If C has the C bit set, will C> -on the modified SV if appropriate. - -=cut -*/ - void Perl_sv_catpv_flags(pTHX_ SV *dsv, const char *sstr, const I32 flags) { @@ -5611,14 +5617,6 @@ Perl_sv_catpv_flags(pTHX_ SV *dsv, const char *sstr, const I32 flags) sv_catpvn_flags(dsv, sstr, strlen(sstr), flags); } -/* -=for apidoc sv_catpv_mg - -Like C, but also handles 'set' magic. - -=cut -*/ - void Perl_sv_catpv_mg(pTHX_ SV *const dsv, const char *const sstr) { diff --git a/sv.h b/sv.h index abe93ec05f7d..9019e355a85c 100644 --- a/sv.h +++ b/sv.h @@ -1717,9 +1717,6 @@ COW). Returns a boolean indicating whether the SV is Copy-On-Write shared hash key scalar. -=for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr -Like C but doesn't process magic. - =cut */ From 333238a72a681884a924eb094c6f4d337b82b540 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:04:22 -0600 Subject: [PATCH 061/503] perlapi: Consolidate sv_vsetpvf-ish entries --- sv.c | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/sv.c b/sv.c index fcc94a2bc6ae..f062cc2ad2b6 100644 --- a/sv.c +++ b/sv.c @@ -10787,11 +10787,16 @@ Perl_sv_setpvf(pTHX_ SV *const sv, const char *const pat, ...) /* =for apidoc sv_vsetpvf +=for apidoc_item sv_vsetpvf_mg -Works like C but copies the text into the SV instead of -appending it. Does not handle 'set' magic. See C>. +These work like C> but copy the text into the SV instead of +appending it. + +They differ only in that C performs 'set' magic; +C skips all magic. -Usually used via its frontend C. +They are usually used via their frontends, C> and +C>. =cut */ @@ -10816,16 +10821,6 @@ Perl_sv_setpvf_mg(pTHX_ SV *const sv, const char *const pat, ...) va_end(args); } -/* -=for apidoc sv_vsetpvf_mg - -Like C, but also handles 'set' magic. - -Usually used via its frontend C. - -=cut -*/ - void Perl_sv_vsetpvf_mg(pTHX_ SV *const sv, const char *const pat, va_list *const args) { From ef0a8475fdfef2bfeb82df0df1e8cc211790721e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 22 Nov 2020 09:36:20 -0700 Subject: [PATCH 062/503] Slience compiler warnings for NV, [IU]V compare These were occurring on FreeBSD smokes. warning: implicit conversion from 'IV' (aka 'long') to 'double' changes value from 9223372036854775807 to 9223372036854775808 [-Wimplicit-int-float-conversion] 9223372036854775807 is IV_MAX. What needed to be done here was to use the NV containing IV_MAX+1, a value that already exists in perl.h In other instances, simply casting to an NV before doing the comparison with the NV was what was needed. This fixes #18328 --- ext/POSIX/POSIX.xs | 2 +- ext/POSIX/lib/POSIX.pm | 2 +- inline.h | 2 +- pp_ctl.c | 2 +- sv.c | 4 ++-- 5 files changed, 6 insertions(+), 6 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index ad5ca6c26a79..cc67fd6fceca 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1333,7 +1333,7 @@ static NV_PAYLOAD_TYPE S_getpayload(NV nv) #ifdef NV_PAYLOAD_DEBUG Perl_warn(aTHX_ "a[%d] = %" UVxf "\n", i, a[i]); #endif - payload *= UV_MAX; + payload *= (NV) UV_MAX; payload += a[i]; } #ifdef NV_PAYLOAD_DEBUG diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index 51a51a213e60..c374af6aa077 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.95'; +our $VERSION = '1.96'; require XSLoader; diff --git a/inline.h b/inline.h index 5ada1555d1a2..3b34ad4667bd 100644 --- a/inline.h +++ b/inline.h @@ -1980,7 +1980,7 @@ S_lossless_NV_to_IV(const NV nv, IV *ivp) /* Written this way so that with an always-false NaN comparison we * return false */ - if (!(LIKELY(nv >= IV_MIN) && LIKELY(nv <= IV_MAX))) { + if (!(LIKELY(nv >= (NV) IV_MIN) && LIKELY(nv < IV_MAX_P1))) { return FALSE; } diff --git a/pp_ctl.c b/pp_ctl.c index 5cb5a10b20e1..ed451c02e855 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -1228,7 +1228,7 @@ PP(pp_flop) if ((SvOK(left) && !SvIOK(left) && SvNV_nomg(left) < IV_MIN) || (SvOK(right) && (SvIOK(right) ? SvIsUV(right) && SvUV(right) > IV_MAX - : SvNV_nomg(right) > IV_MAX))) + : SvNV_nomg(right) > (NV) IV_MAX))) DIE(aTHX_ "Range iterator outside integer range"); i = SvIV_nomg(left); j = SvIV_nomg(right); diff --git a/sv.c b/sv.c index f062cc2ad2b6..5c4c3555559d 100644 --- a/sv.c +++ b/sv.c @@ -2055,7 +2055,7 @@ S_sv_2iuv_non_preserve(pTHX_ SV *const sv (void)SvNOK_on(sv); /* Can't use strtol etc to convert this string. (See truth table in sv_2iv */ - if (SvNVX(sv) <= (UV)IV_MAX) { + if (SvNVX(sv) < IV_MAX_P1) { SvIV_set(sv, I_V(SvNVX(sv))); if ((NV)(SvIVX(sv)) == SvNVX(sv)) { SvIOK_on(sv); /* Integer is precise. NOK, IOK */ @@ -11118,7 +11118,7 @@ S_F0convert(NV nv, char *const endbuf, STRLEN *const len) assert(!Perl_isinfnan(nv)); if (neg) nv = -nv; - if (nv != 0.0 && nv < UV_MAX) { + if (nv != 0.0 && nv < (NV) UV_MAX) { char *p = endbuf; uv = (UV)nv; if (uv != nv) { From 6d2bbfb061d543d195ee99daf85841e44ece16ba Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 22 Nov 2020 15:45:05 -0700 Subject: [PATCH 063/503] regcharclass.h: Simplify some expressions The regen script was improperyly collapsing two-element ranges into two separate elements, which caused extraneous code to be generated. --- regcharclass.h | 59 ++++++++++++++++--------------------------- regen/regcharclass.pl | 17 +++++++------ 2 files changed, 31 insertions(+), 45 deletions(-) diff --git a/regcharclass.h b/regcharclass.h index d6688b22eb88..3067ea835fc0 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -112,7 +112,7 @@ /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( 0x2028 == cp || 0x2029 == cp ) +( inRANGE(cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -151,10 +151,9 @@ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ ( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( 0x2028 == cp || ( 0x2028 < cp && \ -( 0x2029 == cp || ( 0x2029 < cp && \ +( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ -( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) ) ) +( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) /* NONCHAR: Non character code points @@ -676,8 +675,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -687,8 +685,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -719,8 +716,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -730,8 +726,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -850,7 +845,7 @@ /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( 0x2028 == cp || 0x2029 == cp ) +( inRANGE(cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -889,10 +884,9 @@ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ ( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( 0x2028 == cp || ( 0x2028 < cp && \ -( 0x2029 == cp || ( 0x2029 < cp && \ +( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ -( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) ) ) +( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) /* NONCHAR: Non character code points @@ -1429,8 +1423,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -1440,8 +1433,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -1472,8 +1464,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -1483,8 +1474,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -1590,7 +1580,7 @@ /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( 0x2028 == cp || 0x2029 == cp ) +( inRANGE(cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -1629,10 +1619,9 @@ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ ( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( 0x2028 == cp || ( 0x2028 < cp && \ -( 0x2029 == cp || ( 0x2029 < cp && \ +( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ -( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) ) ) +( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) /* NONCHAR: Non character code points @@ -2177,8 +2166,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -2188,8 +2176,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -2220,8 +2207,7 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( 0x130 == cp || ( 0x130 < cp && \ -( 0x131 == cp || ( 0x131 < cp && \ +( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -2231,8 +2217,7 @@ ( 0x3BC == cp || ( 0x3BC < cp && \ ( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( 0x212A == cp || ( 0x212A < cp && \ -( 0x212B == cp || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -2304,6 +2289,6 @@ * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * 60185ff63360b1d3fc0c8df02a8493e63ea0283966612be245c30ff8f05b48db regen/regcharclass.pl + * acef4a732cb0cf63f720e29d8f25b0574a8ba18d553920197d459ad7950c3fd9 regen/regcharclass.pl * c0a5e4cb2b9ffad78691938e122c1310bbc98aca2364af243e5c6b2ec0f59dc3 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 56fa7dd34e75..d0d80d86d051 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1049,25 +1049,26 @@ sub _cond_as_str { my $is_cp_ret = $opts_ref->{ret_type} eq "cp"; return "( $test )" if !defined $cond; - # rangify the list. + # rangify the list. As we encounter a new value, it is placed in a new + # subarray by itself. If the next value is adjacent to it, the end point + # of the subarray is merely incremented; and so on. When the next value + # that isn't adjacent to the previous one is encountered, Update() is + # called to hoist any single-element subarray to be a scalar. my @ranges; my $Update= sub { # We skip this if there are optimizations that # we can apply (below) to the individual ranges if ( ($is_cp_ret || $combine) && @ranges && ref $ranges[-1]) { - if ( $ranges[-1][0] == $ranges[-1][1] ) { - $ranges[-1]= $ranges[-1][0]; - } elsif ( $ranges[-1][0] + 1 == $ranges[-1][1] ) { - $ranges[-1]= $ranges[-1][0]; - push @ranges, $ranges[-1] + 1; - } + $ranges[-1] = $ranges[-1][0] if $ranges[-1][0] == $ranges[-1][1]; } }; for my $condition ( @$cond ) { if ( !@ranges || $condition != $ranges[-1][1] + 1 ) { + # Not adjacent to the existing range. Remove that from being a + # range if only a single value; $Update->(); push @ranges, [ $condition, $condition ]; - } else { + } else { # Adjacent to the existing range; add to the range $ranges[-1][1]++; } } From f3476b0ffaa20a7d90a29b4276f139e2d4e953ea Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Sep 2020 10:08:14 -0600 Subject: [PATCH 064/503] sv.h: Add comments --- sv.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sv.h b/sv.h index 9019e355a85c..423a7375df8a 100644 --- a/sv.h +++ b/sv.h @@ -1196,7 +1196,7 @@ object type. Exposed to perl code via Internals::SvREADONLY(). # define SvMAGIC(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)) # define SvSTASH(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash)) -#else +#else /* Below is not PERL_DEBUG_COW */ # ifdef PERL_CORE # define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len) # else @@ -1277,7 +1277,7 @@ object type. Exposed to perl code via Internals::SvREADONLY(). assert(SvTYPE(_svstash) >= SVt_PVMG); \ &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash); \ })) -# else +# else /* Below is not DEBUGGING or can't use brace groups */ # define SvPVX(sv) ((sv)->sv_u.svu_pv) # define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur # define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv From cfb249103fd68e03df2d26e2dc1d64703376a7b4 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:02:15 +0100 Subject: [PATCH 065/503] add gitignore exclusions for files in git There are a number of files excluded using gitignore rules that are included in the repository. This can lead to confusion if something other than git tries to read the ignore files. Add rules to the gitignore files so that these files won't be ignored. --- cpan/Compress-Raw-Bzip2/.gitignore | 1 + cpan/Compress-Raw-Zlib/.gitignore | 5 ++++- cpan/DB_File/.gitignore | 2 ++ cpan/Digest-MD5/.gitignore | 1 + cpan/Digest-SHA/.gitignore | 2 ++ cpan/Encode/.gitignore | 1 + cpan/IO-Compress/.gitignore | 1 + cpan/IPC-SysV/.gitignore | 1 + cpan/Pod-Perldoc/.gitignore | 1 + cpan/Scalar-List-Utils/.gitignore | 1 + cpan/Socket/.gitignore | 1 + cpan/Sys-Syslog/.gitignore | 2 ++ cpan/Unicode-Collate/.gitignore | 1 + cpan/Win32/.gitignore | 1 + cpan/Win32API-File/.gitignore | 1 + cpan/libnet/.gitignore | 1 + cpan/podlators/.gitignore | 1 + dist/Carp/.gitignore | 1 + dist/Devel-PPPort/.gitignore | 3 +++ dist/ExtUtils-CBuilder/.gitignore | 1 + dist/IO/.gitignore | 1 + dist/Module-CoreList/.gitignore | 1 + dist/PathTools/.gitignore | 1 + dist/Safe/.gitignore | 1 + dist/Search-Dict/.gitignore | 1 + dist/Storable/.gitignore | 1 + dist/Time-HiRes/.gitignore | 1 + dist/Unicode-Normalize/.gitignore | 1 + dist/XSLoader/.gitignore | 1 + dist/base/.gitignore | 1 + dist/lib/.gitignore | 1 + ext/Amiga-ARexx/.gitignore | 1 + ext/Amiga-Exec/.gitignore | 1 + ext/B/.gitignore | 1 + ext/DynaLoader/.gitignore | 1 + ext/Errno/.gitignore | 1 + ext/Fcntl/.gitignore | 1 + ext/File-Glob/.gitignore | 2 ++ ext/GDBM_File/.gitignore | 1 + ext/Hash-Util/.gitignore | 1 + ext/I18N-Langinfo/.gitignore | 1 + ext/NDBM_File/.gitignore | 1 + ext/ODBM_File/.gitignore | 1 + ext/POSIX/.gitignore | 1 + ext/Pod-Functions/.gitignore | 1 + ext/SDBM_File/.gitignore | 1 + ext/VMS-DCLsym/.gitignore | 1 + ext/VMS-Stdio/.gitignore | 1 + ext/Win32CORE/.gitignore | 1 + ext/XS-APItest/.gitignore | 4 ++++ ext/XS-Typemap/.gitignore | 2 ++ ext/re/.gitignore | 1 + 52 files changed, 65 insertions(+), 1 deletion(-) create mode 100644 cpan/Digest-MD5/.gitignore create mode 100644 cpan/Digest-SHA/.gitignore create mode 100644 cpan/IO-Compress/.gitignore create mode 100644 cpan/Pod-Perldoc/.gitignore create mode 100644 cpan/Scalar-List-Utils/.gitignore create mode 100644 cpan/Win32/.gitignore create mode 100644 cpan/Win32API-File/.gitignore create mode 100644 cpan/libnet/.gitignore create mode 100644 dist/Carp/.gitignore create mode 100644 dist/ExtUtils-CBuilder/.gitignore create mode 100644 dist/Module-CoreList/.gitignore create mode 100644 dist/Safe/.gitignore create mode 100644 dist/Search-Dict/.gitignore create mode 100644 dist/Storable/.gitignore create mode 100644 dist/Time-HiRes/.gitignore create mode 100644 dist/base/.gitignore create mode 100644 ext/Amiga-ARexx/.gitignore create mode 100644 ext/Amiga-Exec/.gitignore create mode 100644 ext/Hash-Util/.gitignore create mode 100644 ext/NDBM_File/.gitignore create mode 100644 ext/ODBM_File/.gitignore create mode 100644 ext/VMS-DCLsym/.gitignore create mode 100644 ext/VMS-Stdio/.gitignore create mode 100644 ext/XS-Typemap/.gitignore create mode 100644 ext/re/.gitignore diff --git a/cpan/Compress-Raw-Bzip2/.gitignore b/cpan/Compress-Raw-Bzip2/.gitignore index 6f7f42a65e4a..5f4846c938c8 100644 --- a/cpan/Compress-Raw-Bzip2/.gitignore +++ b/cpan/Compress-Raw-Bzip2/.gitignore @@ -3,3 +3,4 @@ /constants.h /constants.xs !/bzip2-src/*.c +!/Makefile.PL diff --git a/cpan/Compress-Raw-Zlib/.gitignore b/cpan/Compress-Raw-Zlib/.gitignore index 091348d9ecb9..079481762a3f 100644 --- a/cpan/Compress-Raw-Zlib/.gitignore +++ b/cpan/Compress-Raw-Zlib/.gitignore @@ -1 +1,4 @@ -constants.* +!/zlib-src/*.c +!/Makefile.PL +/constants.h +/constants.xs diff --git a/cpan/DB_File/.gitignore b/cpan/DB_File/.gitignore index f1c4edfa6e1e..ef1c21950b3f 100644 --- a/cpan/DB_File/.gitignore +++ b/cpan/DB_File/.gitignore @@ -1,3 +1,5 @@ !/version.c /constants.* *.bak +!/Makefile.PL +!/src/*.c diff --git a/cpan/Digest-MD5/.gitignore b/cpan/Digest-MD5/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/Digest-MD5/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/Digest-SHA/.gitignore b/cpan/Digest-SHA/.gitignore new file mode 100644 index 000000000000..335fafbdca68 --- /dev/null +++ b/cpan/Digest-SHA/.gitignore @@ -0,0 +1,2 @@ +!/Makefile.PL +!/src/*.c diff --git a/cpan/Encode/.gitignore b/cpan/Encode/.gitignore index 3ac370bd5641..2e7d1d67af45 100644 --- a/cpan/Encode/.gitignore +++ b/cpan/Encode/.gitignore @@ -1,4 +1,5 @@ !/encengine.c +!Makefile.PL /Byte/Byte.xs /CN/CN.xs /EBCDIC/EBCDIC.xs diff --git a/cpan/IO-Compress/.gitignore b/cpan/IO-Compress/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/IO-Compress/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/IPC-SysV/.gitignore b/cpan/IPC-SysV/.gitignore index 2a06e93b553d..6531b6b8ed84 100644 --- a/cpan/IPC-SysV/.gitignore +++ b/cpan/IPC-SysV/.gitignore @@ -1 +1,2 @@ *.inc +!/Makefile.PL diff --git a/cpan/Pod-Perldoc/.gitignore b/cpan/Pod-Perldoc/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/Pod-Perldoc/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/Scalar-List-Utils/.gitignore b/cpan/Scalar-List-Utils/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/Scalar-List-Utils/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/Socket/.gitignore b/cpan/Socket/.gitignore index 2a06e93b553d..6531b6b8ed84 100644 --- a/cpan/Socket/.gitignore +++ b/cpan/Socket/.gitignore @@ -1 +1,2 @@ *.inc +!/Makefile.PL diff --git a/cpan/Sys-Syslog/.gitignore b/cpan/Sys-Syslog/.gitignore index d94e453f6cf8..b2bd5aa30711 100644 --- a/cpan/Sys-Syslog/.gitignore +++ b/cpan/Sys-Syslog/.gitignore @@ -10,3 +10,5 @@ Syslog.c Syslog.o blib/ pm_to_blib +!/Makefile.PL +!/fallback/*.inc diff --git a/cpan/Unicode-Collate/.gitignore b/cpan/Unicode-Collate/.gitignore index 424c745c1253..47489b4d1f9f 100644 --- a/cpan/Unicode-Collate/.gitignore +++ b/cpan/Unicode-Collate/.gitignore @@ -1 +1,2 @@ *.h +!/Makefile.PL diff --git a/cpan/Win32/.gitignore b/cpan/Win32/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/Win32/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/Win32API-File/.gitignore b/cpan/Win32API-File/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/Win32API-File/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/libnet/.gitignore b/cpan/libnet/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/cpan/libnet/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/cpan/podlators/.gitignore b/cpan/podlators/.gitignore index 146b3be431fe..8539efd423bb 100644 --- a/cpan/podlators/.gitignore +++ b/cpan/podlators/.gitignore @@ -18,3 +18,4 @@ /podlators-*.tar.gz.asc /scripts/pod2man /scripts/pod2text +!/Makefile.PL diff --git a/dist/Carp/.gitignore b/dist/Carp/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Carp/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/Devel-PPPort/.gitignore b/dist/Devel-PPPort/.gitignore index 0fa82e0976ce..857c79fe887b 100644 --- a/dist/Devel-PPPort/.gitignore +++ b/dist/Devel-PPPort/.gitignore @@ -19,3 +19,6 @@ PPPort.bs /Devel-PPPort-*.tar.gz /Devel-PPPort-*/ /t/*.t +!/Makefile.PL +!/module2.c +!/module3.c diff --git a/dist/ExtUtils-CBuilder/.gitignore b/dist/ExtUtils-CBuilder/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/ExtUtils-CBuilder/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/IO/.gitignore b/dist/IO/.gitignore index 577c72624314..7703c927477f 100644 --- a/dist/IO/.gitignore +++ b/dist/IO/.gitignore @@ -1 +1,2 @@ !/poll.c +!/Makefile.PL diff --git a/dist/Module-CoreList/.gitignore b/dist/Module-CoreList/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Module-CoreList/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/PathTools/.gitignore b/dist/PathTools/.gitignore index a87d5167ef43..3c1f39c66579 100644 --- a/dist/PathTools/.gitignore +++ b/dist/PathTools/.gitignore @@ -1,2 +1,3 @@ /Cwd.c /Cwd.bs +!/Makefile.PL diff --git a/dist/Safe/.gitignore b/dist/Safe/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Safe/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/Search-Dict/.gitignore b/dist/Search-Dict/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Search-Dict/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/Storable/.gitignore b/dist/Storable/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Storable/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/Time-HiRes/.gitignore b/dist/Time-HiRes/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/Time-HiRes/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/Unicode-Normalize/.gitignore b/dist/Unicode-Normalize/.gitignore index 424c745c1253..47489b4d1f9f 100644 --- a/dist/Unicode-Normalize/.gitignore +++ b/dist/Unicode-Normalize/.gitignore @@ -1 +1,2 @@ *.h +!/Makefile.PL diff --git a/dist/XSLoader/.gitignore b/dist/XSLoader/.gitignore index b91c997d5033..447ed53189c0 100644 --- a/dist/XSLoader/.gitignore +++ b/dist/XSLoader/.gitignore @@ -1 +1,2 @@ /XSLoader.pm +!/Makefile.PL diff --git a/dist/base/.gitignore b/dist/base/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/dist/base/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/dist/lib/.gitignore b/dist/lib/.gitignore index 8caf3063dc85..c5c4f7289333 100644 --- a/dist/lib/.gitignore +++ b/dist/lib/.gitignore @@ -1 +1,2 @@ /lib.pm +!/Makefile.PL diff --git a/ext/Amiga-ARexx/.gitignore b/ext/Amiga-ARexx/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/Amiga-ARexx/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/Amiga-Exec/.gitignore b/ext/Amiga-Exec/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/Amiga-Exec/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/B/.gitignore b/ext/B/.gitignore index f67599be1daf..7fb2000b622b 100644 --- a/ext/B/.gitignore +++ b/ext/B/.gitignore @@ -1,3 +1,4 @@ defsubs.h const-c.inc const-xs.inc +!/Makefile.PL diff --git a/ext/DynaLoader/.gitignore b/ext/DynaLoader/.gitignore index 014ac3441064..2af9bc6aea86 100644 --- a/ext/DynaLoader/.gitignore +++ b/ext/DynaLoader/.gitignore @@ -1,3 +1,4 @@ !/dlutils.c /DynaLoader.pm /DynaLoader.xs +!/Makefile.PL diff --git a/ext/Errno/.gitignore b/ext/Errno/.gitignore index fb9df2003588..5b0c2efa9d25 100644 --- a/ext/Errno/.gitignore +++ b/ext/Errno/.gitignore @@ -1,2 +1,3 @@ /Errno.pm /arch.txt +!/Makefile.PL diff --git a/ext/Fcntl/.gitignore b/ext/Fcntl/.gitignore index 2a06e93b553d..6531b6b8ed84 100644 --- a/ext/Fcntl/.gitignore +++ b/ext/Fcntl/.gitignore @@ -1 +1,2 @@ *.inc +!/Makefile.PL diff --git a/ext/File-Glob/.gitignore b/ext/File-Glob/.gitignore index 2a06e93b553d..d71ca7dde516 100644 --- a/ext/File-Glob/.gitignore +++ b/ext/File-Glob/.gitignore @@ -1 +1,3 @@ *.inc +!/Makefile.PL +!/bsd_glob.c diff --git a/ext/GDBM_File/.gitignore b/ext/GDBM_File/.gitignore index 7ba0a5a28994..67de96f981bc 100644 --- a/ext/GDBM_File/.gitignore +++ b/ext/GDBM_File/.gitignore @@ -1 +1,2 @@ const-*.inc +!/Makefile.PL diff --git a/ext/Hash-Util/.gitignore b/ext/Hash-Util/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/Hash-Util/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/I18N-Langinfo/.gitignore b/ext/I18N-Langinfo/.gitignore index 2a06e93b553d..6531b6b8ed84 100644 --- a/ext/I18N-Langinfo/.gitignore +++ b/ext/I18N-Langinfo/.gitignore @@ -1 +1,2 @@ *.inc +!/Makefile.PL diff --git a/ext/NDBM_File/.gitignore b/ext/NDBM_File/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/NDBM_File/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/ODBM_File/.gitignore b/ext/ODBM_File/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/ODBM_File/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/POSIX/.gitignore b/ext/POSIX/.gitignore index 2a06e93b553d..6531b6b8ed84 100644 --- a/ext/POSIX/.gitignore +++ b/ext/POSIX/.gitignore @@ -1 +1,2 @@ *.inc +!/Makefile.PL diff --git a/ext/Pod-Functions/.gitignore b/ext/Pod-Functions/.gitignore index 2ba87d73c541..d7514361b88f 100644 --- a/ext/Pod-Functions/.gitignore +++ b/ext/Pod-Functions/.gitignore @@ -1 +1,2 @@ /Functions.pm +!/Makefile.PL diff --git a/ext/SDBM_File/.gitignore b/ext/SDBM_File/.gitignore index acccbd016a73..18641ce7c37f 100644 --- a/ext/SDBM_File/.gitignore +++ b/ext/SDBM_File/.gitignore @@ -1,2 +1,3 @@ !*.c SDBM_File.c +!/Makefile.PL diff --git a/ext/VMS-DCLsym/.gitignore b/ext/VMS-DCLsym/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/VMS-DCLsym/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/VMS-Stdio/.gitignore b/ext/VMS-Stdio/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/VMS-Stdio/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL diff --git a/ext/Win32CORE/.gitignore b/ext/Win32CORE/.gitignore index cbe3f3d56d21..7148fe97b5d9 100644 --- a/ext/Win32CORE/.gitignore +++ b/ext/Win32CORE/.gitignore @@ -1 +1,2 @@ !/Win32CORE.c +!/Makefile.PL diff --git a/ext/XS-APItest/.gitignore b/ext/XS-APItest/.gitignore index 7ba0a5a28994..b0a005918c3a 100644 --- a/ext/XS-APItest/.gitignore +++ b/ext/XS-APItest/.gitignore @@ -1 +1,5 @@ const-*.inc +!/Makefile.PL +!/core.c +!/exception.c +!/notcore.c diff --git a/ext/XS-Typemap/.gitignore b/ext/XS-Typemap/.gitignore new file mode 100644 index 000000000000..3fb2f0ee2d7d --- /dev/null +++ b/ext/XS-Typemap/.gitignore @@ -0,0 +1,2 @@ +!/Makefile.PL +!/stdio.c diff --git a/ext/re/.gitignore b/ext/re/.gitignore new file mode 100644 index 000000000000..e54624d60d99 --- /dev/null +++ b/ext/re/.gitignore @@ -0,0 +1 @@ +!/Makefile.PL From 64a5adeb5e31240827728ce1680f85b228d0ee27 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:05:27 +0100 Subject: [PATCH 066/503] remove ignore for dl_win32.xs, since it is a real file now --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index eab6ae957a0a..dfcd423da0fe 100644 --- a/.gitignore +++ b/.gitignore @@ -83,7 +83,6 @@ perldtrace.h *.gcno dll.base -/ext/DynaLoader/dl_win32.xs splittree.pl # generated by make on cygwin From 000a819b835fa94b37312989cdb3e978fbb44dc2 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:06:20 +0100 Subject: [PATCH 067/503] remove ignore for Test-Harness directory which no longer exists --- .gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/.gitignore b/.gitignore index dfcd423da0fe..6b4e8b71ab83 100644 --- a/.gitignore +++ b/.gitignore @@ -133,7 +133,6 @@ lib/unicore/mktables.lst xlib/ # test byproducts -ext/Test-Harness/t/ext/ ext/XS-APItest/APItest.bso t/rantests t/tmp* From 3d07da93484dd2fdd5e62c1b6c6e7259de5fd2d1 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:07:50 +0100 Subject: [PATCH 068/503] move ignore for XS-APItest into dists own gitignore --- .gitignore | 1 - ext/XS-APItest/.gitignore | 1 + 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 6b4e8b71ab83..585dc653ccd0 100644 --- a/.gitignore +++ b/.gitignore @@ -133,7 +133,6 @@ lib/unicore/mktables.lst xlib/ # test byproducts -ext/XS-APItest/APItest.bso t/rantests t/tmp* t/perl diff --git a/ext/XS-APItest/.gitignore b/ext/XS-APItest/.gitignore index b0a005918c3a..9bc400b68cc1 100644 --- a/ext/XS-APItest/.gitignore +++ b/ext/XS-APItest/.gitignore @@ -1,4 +1,5 @@ const-*.inc +/APItest.bso !/Makefile.PL !/core.c !/exception.c From f9ed0ee0c7d55fba25883ca27f694246ad80f296 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:08:19 +0100 Subject: [PATCH 069/503] move ignore for re into its own dists gitignore --- .gitignore | 3 --- ext/re/.gitignore | 1 + 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/.gitignore b/.gitignore index 585dc653ccd0..fb898ba7a915 100644 --- a/.gitignore +++ b/.gitignore @@ -188,9 +188,6 @@ cscope.po.out # generated by the top level install.html target. XXX Why does it need this? /vms/README_vms.pod -# generated be ext/re/Makefile -ext/re/invlist_inline.h - # ctags tags TAGS diff --git a/ext/re/.gitignore b/ext/re/.gitignore index e54624d60d99..f63246b01f75 100644 --- a/ext/re/.gitignore +++ b/ext/re/.gitignore @@ -1 +1,2 @@ !/Makefile.PL +/invlist_inline.h From ddccb073272ae5bff8ee188205c5d51f532053c3 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:08:48 +0100 Subject: [PATCH 070/503] remove ignore for perlvms.pod, which is a real file now --- pod/.gitignore | 1 - 1 file changed, 1 deletion(-) diff --git a/pod/.gitignore b/pod/.gitignore index 4933af49fc05..def64fd7ee31 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -29,7 +29,6 @@ /perlsynology.pod /perltru64.pod /perltw.pod -/perlvms.pod /perlvos.pod /perlwin32.pod From b6ec1e74f0bf14c7c63f249ffc348c627d764b9b Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Thu, 19 Nov 2020 12:09:55 +0100 Subject: [PATCH 071/503] fix splittree.pl ignore to only apply to root There is a real splittree.pl in NetWare/, which may be copied to the root. Ignore the file in the root, but not the file in NetWare/. --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index fb898ba7a915..4fcfe623c7f9 100644 --- a/.gitignore +++ b/.gitignore @@ -83,7 +83,7 @@ perldtrace.h *.gcno dll.base -splittree.pl +/splittree.pl # generated by make on cygwin /cygwin.c From 5fcca6468acbb09c57cf703ad97b25b199d27158 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Sep 2020 10:17:42 -0600 Subject: [PATCH 072/503] perlapi: Consolidate Sv{INU]VX-ish entries --- sv.h | 63 ++++++++++++++++++++++++++---------------------------------- 1 file changed, 27 insertions(+), 36 deletions(-) diff --git a/sv.h b/sv.h index 423a7375df8a..0742b7071c18 100644 --- a/sv.h +++ b/sv.h @@ -1577,58 +1577,49 @@ Like C but doesn't set a length variable. Like C but doesn't process magic. =for apidoc Am|IV|SvIV|SV* sv -Coerces the given SV to IV and returns it. The returned value in many -circumstances will get stored in C's IV slot, but not in all cases. (Use -C> to make sure it does). - -See C> for a version which guarantees to evaluate C only once. - -=for apidoc Am|IV|SvIV_nomg|SV* sv -Like C but doesn't process magic. +=for apidoc_item SvIVx +=for apidoc_item SvIV_nomg -=for apidoc Am|IV|SvIVx|SV* sv -Coerces the given SV to IV and returns it. The returned value in many +These coerce the given SV to IV and return it. The returned value in many circumstances will get stored in C's IV slot, but not in all cases. (Use C> to make sure it does). -This form guarantees to evaluate C only once. Only use this if C is an -expression with side effects, otherwise use the more efficient C. - -=for apidoc Am|NV|SvNV|SV* sv -Coerces the given SV to NV and returns it. The returned value in many -circumstances will get stored in C's NV slot, but not in all cases. (Use -C> to make sure it does). +C is different from the others in that it is guaranteed to evaluate +C exactly once; the others may evaluate it multiple times. Only use this +form if C is an expression with side effects, otherwise use the more +efficient C. -See C> for a version which guarantees to evaluate C only once. +C is the same as C, but does not perform 'get' magic. -=for apidoc Am|NV|SvNV_nomg|SV* sv -Like C but doesn't process magic. +=for apidoc Am|NV|SvNV|SV* sv +=for apidoc_item SvNVx +=for apidoc_item SvNV_nomg -=for apidoc Am|NV|SvNVx|SV* sv -Coerces the given SV to NV and returns it. The returned value in many +These coerce the given SV to NV and return it. The returned value in many circumstances will get stored in C's NV slot, but not in all cases. (Use C> to make sure it does). -This form guarantees to evaluate C only once. Only use this if C is an -expression with side effects, otherwise use the more efficient C. +C is different from the others in that it is guaranteed to evaluate +C exactly once; the others may evaluate it multiple times. Only use this +form if C is an expression with side effects, otherwise use the more +efficient C. -=for apidoc Am|UV|SvUV|SV* sv -Coerces the given SV to UV and returns it. The returned value in many -circumstances will get stored in C's UV slot, but not in all cases. (Use -C> to make sure it does). +C is the same as C, but does not perform 'get' magic. -See C> for a version which guarantees to evaluate C only once. - -=for apidoc Am|UV|SvUV_nomg|SV* sv -Like C but doesn't process magic. +=for apidoc Am|UV|SvUV|SV* sv +=for apidoc_item SvUVx +=for apidoc_item SvUV_nomg -=for apidoc Am|UV|SvUVx|SV* sv -Coerces the given SV to UV and returns it. The returned value in many +These coerce the given SV to UV and return it. The returned value in many circumstances will get stored in C's UV slot, but not in all cases. (Use C> to make sure it does). -This form guarantees to evaluate C only once. Only use this if C is an -expression with side effects, otherwise use the more efficient C. +C is different from the others in that it is guaranteed to evaluate +C exactly once; the others may evaluate it multiple times. Only use this +form if C is an expression with side effects, otherwise use the more +efficient C. + +C is the same as C, but does not perform 'get' magic. =for apidoc Am|bool|SvTRUE|SV* sv Returns a boolean indicating whether Perl would evaluate the SV as true or From 8dff134de1f0dc51682889d5cf8c25ab7c31bf45 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 16:16:41 -0600 Subject: [PATCH 073/503] embed.fnc: Mark reginitcolors as Core only This is used for internal initialization, and there are no uses on cpan --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 6e703b5afc7c..eb14b68427d0 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2700,7 +2700,7 @@ Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm Ap |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim Ap |void |magic_dump |NULLOK const MAGIC *mg -Ap |void |reginitcolors +Cp |void |reginitcolors CpdRMb |char* |sv_2pv_nolen |NN SV* sv CpdRMb |char* |sv_2pvutf8_nolen|NN SV* sv CpdRMb |char* |sv_2pvbyte_nolen|NN SV* sv From c62fdeb784c7643c90d2ea8c2ec0f03a548da338 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 06:55:50 -0600 Subject: [PATCH 074/503] Restrict scope/Shorten some very long macro names The names were intended to force people to not use them outside their intended scopes. But by restricting those scopes in the first place, we don't need such unwieldy names --- handy.h | 17 +++++++++++------ regcomp.c | 11 ----------- regen/unicode_constants.pl | 32 ++++++++++++++++++++++++-------- regexec.c | 2 -- unicode_constants.h | 20 +++++++++++++++----- utf8.c | 6 ++---- 6 files changed, 52 insertions(+), 36 deletions(-) diff --git a/handy.h b/handy.h index 7feedcb792b5..96f84fa5d1c3 100644 --- a/handy.h +++ b/handy.h @@ -1616,16 +1616,21 @@ END_EXTERN_C # endif /* Participates in a single-character fold with a character above 255 */ -# define _HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(c) ((! cBOOL(FITS_IN_8_BITS(c))) || (PL_charclass[(U8) (c)] & _CC_mask(_CC_NONLATIN1_SIMPLE_FOLD))) +# if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_REGEXEC_C) +# define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(c) \ + (( ! cBOOL(FITS_IN_8_BITS(c))) \ + || (PL_charclass[(U8) (c)] & _CC_mask(_CC_NONLATIN1_SIMPLE_FOLD))) + +# define IS_NON_FINAL_FOLD(c) _generic_isCC(c, _CC_NON_FINAL_FOLD) +# define IS_IN_SOME_FOLD_L1(c) _generic_isCC(c, _CC_IS_IN_SOME_FOLD) +# endif /* Like the above, but also can be part of a multi-char fold */ -# define _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(c) ((! cBOOL(FITS_IN_8_BITS(c))) || (PL_charclass[(U8) (c)] & _CC_mask(_CC_NONLATIN1_FOLD))) +# define HAS_NONLATIN1_FOLD_CLOSURE(c) \ + ( (! cBOOL(FITS_IN_8_BITS(c))) \ + || (PL_charclass[(U8) (c)] & _CC_mask(_CC_NONLATIN1_FOLD))) # define _isQUOTEMETA(c) _generic_isCC(c, _CC_QUOTEMETA) -# define _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) \ - _generic_isCC(c, _CC_NON_FINAL_FOLD) -# define _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) \ - _generic_isCC(c, _CC_IS_IN_SOME_FOLD) /* is c a control character for which we have a mnemonic? */ # if defined(PERL_CORE) || defined(PERL_EXT) diff --git a/regcomp.c b/regcomp.c index 853501c030b7..0c8beb0ead85 100644 --- a/regcomp.c +++ b/regcomp.c @@ -143,13 +143,6 @@ EXTERN_C const struct regexp_engine wild_reg_engine; #include "invlist_inline.h" #include "unicode_constants.h" -#define HAS_NONLATIN1_FOLD_CLOSURE(i) \ - _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i) -#define HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE(i) \ - _HAS_NONLATIN1_SIMPLE_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i) -#define IS_NON_FINAL_FOLD(c) _IS_NON_FINAL_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) -#define IS_IN_SOME_FOLD_L1(c) _IS_IN_SOME_FOLD_ONLY_FOR_USE_BY_REGCOMP_DOT_C(c) - #ifndef STATIC #define STATIC static #endif @@ -2133,8 +2126,6 @@ S_ssc_clear_locale(regnode_ssc *ssc) ANYOF_FLAGS(ssc) &= ~ANYOF_LOCALE_FLAGS; } -#define NON_OTHER_COUNT NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C - STATIC bool S_is_ssc_worth_it(const RExC_state_t * pRExC_state, const regnode_ssc * ssc) { @@ -22237,8 +22228,6 @@ S_put_code_point(pTHX_ SV *sv, UV c) } } -#define MAX_PRINT_A MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C - STATIC void S_put_range(pTHX_ SV *sv, UV start, const UV end, const bool allow_literals) { diff --git a/regen/unicode_constants.pl b/regen/unicode_constants.pl index aba447ae6aee..44c633e71137 100644 --- a/regen/unicode_constants.pl +++ b/regen/unicode_constants.pl @@ -162,9 +162,15 @@ END for my $i (0x20 .. 0x7E) { $max_PRINT_A = $a2n[$i] if $a2n[$i] > $max_PRINT_A; } - printf $out_fh "# define MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C 0x%02X /* The max code point that isPRINT_A */\n", $max_PRINT_A; + $max_PRINT_A = sprintf "0x%02X", $max_PRINT_A; + print $out_fh <<"EOT"; - print $out_fh "\n" . get_conditional_compile_line_end(); +# ifdef PERL_IN_REGCOMP_C +# define MAX_PRINT_A $max_PRINT_A /* The max code point that isPRINT_A */ +# endif +EOT + + print $out_fh get_conditional_compile_line_end(); } @@ -178,9 +184,14 @@ END : 0x110000) - $other_invlist[$i]; } -printf $out_fh "\n/* The number of code points not matching \\pC */\n" - . "#define NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C %d\n", - 0x110000 - $count; +$count = 0x110000 - $count; +print $out_fh <<~"EOT"; + + /* The number of code points not matching \\pC */ + #ifdef PERL_IN_REGCOMP_C + # define NON_OTHER_COUNT $count + #endif + EOT # If this release has both the CWCM and CWCF properties, find the highest code # point which changes under any case change. We can use this to short-circuit @@ -192,9 +203,14 @@ END my $max = ($cwcm[-1] < $cwcf[-1]) ? $cwcf[-1] : $cwcm[-1]; - printf $out_fh "\n/* The highest code point that has any type of case change */\n" - . "#define HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C 0x%X\n", - $max - 1; + $max = sprintf "0x%X", $max - 1; + print $out_fh <<~"EOS"; + + /* The highest code point that has any type of case change */ + #ifdef PERL_IN_UTF8_C + # define HIGHEST_CASE_CHANGING_CP $max + #endif + EOS } } diff --git a/regexec.c b/regexec.c index b80c0824ebf8..f3edc3a7bbe0 100644 --- a/regexec.c +++ b/regexec.c @@ -118,8 +118,6 @@ static const char non_utf8_target_but_utf8_required[] goto target; \ } STMT_END -#define HAS_NONLATIN1_FOLD_CLOSURE(i) _HAS_NONLATIN1_FOLD_CLOSURE_ONLY_FOR_USE_BY_REGCOMP_DOT_C_AND_REGEXEC_DOT_C(i) - #ifndef STATIC #define STATIC static #endif diff --git a/unicode_constants.h b/unicode_constants.h index 232f18c464f1..eea66f6ba4f5 100644 --- a/unicode_constants.h +++ b/unicode_constants.h @@ -88,8 +88,10 @@ bytes. # define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE 0xFF /* U+00FF */ # define MICRO_SIGN_NATIVE 0xB5 /* U+00B5 */ # define MICRO_SIGN_UTF8 "\xC2\xB5" /* U+00B5 */ -# define MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C 0x7E /* The max code point that isPRINT_A */ +# ifdef PERL_IN_REGCOMP_C +# define MAX_PRINT_A 0x7E /* The max code point that isPRINT_A */ +# endif #endif /* ASCII/Latin1 */ #if 'A' == 193 /* EBCDIC 1047 */ \ @@ -133,8 +135,10 @@ bytes. # define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE 0xDF /* U+00FF */ # define MICRO_SIGN_NATIVE 0xA0 /* U+00B5 */ # define MICRO_SIGN_UTF8 "\x80\x64" /* U+00B5 */ -# define MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C 0xF9 /* The max code point that isPRINT_A */ +# ifdef PERL_IN_REGCOMP_C +# define MAX_PRINT_A 0xF9 /* The max code point that isPRINT_A */ +# endif #endif /* EBCDIC 1047 */ #if 'A' == 193 /* EBCDIC 037 */ \ @@ -178,15 +182,21 @@ bytes. # define LATIN_SMALL_LETTER_Y_WITH_DIAERESIS_NATIVE 0xDF /* U+00FF */ # define MICRO_SIGN_NATIVE 0xA0 /* U+00B5 */ # define MICRO_SIGN_UTF8 "\x78\x63" /* U+00B5 */ -# define MAX_PRINT_A_FOR_USE_ONLY_BY_REGCOMP_DOT_C 0xF9 /* The max code point that isPRINT_A */ +# ifdef PERL_IN_REGCOMP_C +# define MAX_PRINT_A 0xF9 /* The max code point that isPRINT_A */ +# endif #endif /* EBCDIC 037 */ /* The number of code points not matching \pC */ -#define NON_OTHER_COUNT_FOR_USE_ONLY_BY_REGCOMP_DOT_C 143698 +#ifdef PERL_IN_REGCOMP_C +# define NON_OTHER_COUNT 143698 +#endif /* The highest code point that has any type of case change */ -#define HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C 0x1E943 +#ifdef PERL_IN_UTF8_C +# define HIGHEST_CASE_CHANGING_CP 0x1E943 +#endif #endif /* PERL_UNICODE_CONSTANTS_H_ */ diff --git a/utf8.c b/utf8.c index aaa620c2da5e..add8c093aad1 100644 --- a/utf8.c +++ b/utf8.c @@ -3335,10 +3335,8 @@ S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, } goto cases_to_self; } -#ifdef HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C - if (UNLIKELY(uv1 - > HIGHEST_CASE_CHANGING_CP_FOR_USE_ONLY_BY_UTF8_DOT_C)) - { +#ifdef HIGHEST_CASE_CHANGING_CP + if (UNLIKELY(uv1 > HIGHEST_CASE_CHANGING_CP)) { goto cases_to_self; } From 8b3db1a0cf78a47bbd1ac74d84a37d98838f864a Mon Sep 17 00:00:00 2001 From: Tomasz Konojacki Date: Thu, 29 Oct 2020 18:58:10 +0100 Subject: [PATCH 075/503] win32: remove support for disabling USE_LARGE_FILES It was enabled by default on all compilers. I don't think it ever makes sense to disable it. --- dosish.h | 6 +----- win32/GNUmakefile | 20 -------------------- win32/Makefile | 24 ------------------------ win32/config.gc | 6 +++--- win32/config.vc | 6 +++--- win32/config_H.gc | 8 ++++---- win32/config_H.vc | 8 ++++---- win32/config_sh.PL | 10 ---------- win32/makefile.mk | 21 --------------------- win32/win32.c | 28 ---------------------------- 10 files changed, 15 insertions(+), 122 deletions(-) diff --git a/dosish.h b/dosish.h index 5b2716046d74..1860a0f0668f 100644 --- a/dosish.h +++ b/dosish.h @@ -70,11 +70,7 @@ * to include and to get any typedef'ed * information. */ -#if defined(WIN64) || defined(USE_LARGE_FILES) -# define Stat_t struct _stati64 -#else -# define Stat_t struct stat -#endif +#define Stat_t struct _stati64 /* USE_STAT_RDEV: * This symbol is defined if this system has a stat structure declaring diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 7c45d00e2528..084cb5031e56 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -115,13 +115,6 @@ USE_IMP_SYS := define # USE_PERLIO := define -# -# Comment this out if you don't want to enable large file support for -# some reason. Should normally only be changed to maintain compatibility -# with an older release of perl. -# -USE_LARGE_FILES := define - # # Uncomment this if you're building a 32-bit perl and want 64-bit integers. # (If you're building a 64-bit perl then you will have 64-bit integers whether @@ -1213,7 +1206,6 @@ CFG_VARS = \ "useperlio=$(USE_PERLIO)" \ "use64bitint=$(USE_64_BIT_INT)" \ "uselongdouble=$(USE_LONG_DOUBLE)" \ - "uselargefiles=$(USE_LARGE_FILES)" \ "usesitecustomize=$(USE_SITECUST)" \ "default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT)" \ "LINK_FLAGS=$(subst ",\",$(LINK_FLAGS))"\ @@ -1331,9 +1323,6 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) @(echo.&& \ echo #ifndef _config_h_footer_&& \ echo #define _config_h_footer_&& \ - echo #undef Off_t&& \ - echo #undef LSEEKSIZE&& \ - echo #undef Off_t_size&& \ echo #undef PTRSIZE&& \ echo #undef SSize_t&& \ echo #undef HAS_ATOLL&& \ @@ -1403,15 +1392,6 @@ else ifeq ($(CCTYPE),MSVC142) echo #define FILE_bufsiz^(fp^) ^(PERLIO_FILE_cnt^(fp^) + PERLIO_FILE_ptr^(fp^) - PERLIO_FILE_base^(fp^)^)&& \ echo #define I_STDBOOL)>> config.h endif -ifeq ($(USE_LARGE_FILES),define) - @(echo #define Off_t $(INT64)&& \ - echo #define LSEEKSIZE ^8&& \ - echo #define Off_t_size ^8)>> config.h -else - @(echo #define Off_t long&& \ - echo #define LSEEKSIZE ^4&& \ - echo #define Off_t_size ^4)>> config.h -endif ifeq ($(WIN64),define) ifeq ($(CCTYPE),GCC) @(echo #define LONG_DOUBLESIZE ^16)>> config.h diff --git a/win32/Makefile b/win32/Makefile index ecbfd7a819c9..93d55f7ca6a6 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -80,13 +80,6 @@ USE_ITHREADS = define # USE_IMP_SYS = define -# -# Comment this out if you don't want to enable large file support for -# some reason. Should normally only be changed to maintain compatibility -# with an older release of perl. -# -USE_LARGE_FILES = define - # # Uncomment this if you're building a 32-bit perl and want 64-bit integers. # (If you're building a 64-bit perl then you will have 64-bit integers whether @@ -296,10 +289,6 @@ USE_ITHREADS = undef USE_IMP_SYS = undef !ENDIF -!IF "$(USE_LARGE_FILES)" == "" -USE_LARGE_FILES = undef -!ENDIF - !IF "$(USE_64_BIT_INT)" == "" USE_64_BIT_INT = undef !ENDIF @@ -915,7 +904,6 @@ CFG_VARS = \ "usemultiplicity=$(USE_MULTI)" \ "use64bitint=$(USE_64_BIT_INT)" \ "uselongdouble=undef" \ - "uselargefiles=$(USE_LARGE_FILES)" \ "usesitecustomize=$(USE_SITECUST)" \ "default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT)" \ "LINK_FLAGS=$(LINK_FLAGS:"=\")" \ @@ -1007,9 +995,6 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) @(echo.&& \ echo #ifndef _config_h_footer_&& \ echo #define _config_h_footer_&& \ - echo #undef Off_t&& \ - echo #undef LSEEKSIZE&& \ - echo #undef Off_t_size&& \ echo #undef PTRSIZE&& \ echo #undef SSize_t&& \ echo #undef HAS_ATOLL&& \ @@ -1041,15 +1026,6 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #define FILE_bufsiz^(fp^) ^(PERLIO_FILE_cnt^(fp^) + PERLIO_FILE_ptr^(fp^) - PERLIO_FILE_base^(fp^)^)&& \ echo #define I_STDBOOL)>> config.h !ENDIF -!IF "$(USE_LARGE_FILES)"=="define" - @(echo #define Off_t $(INT64)&& \ - echo #define LSEEKSIZE ^8&& \ - echo #define Off_t_size ^8)>> config.h -!ELSE - @(echo #define Off_t long&& \ - echo #define LSEEKSIZE ^4&& \ - echo #define Off_t_size ^4)>> config.h -!ENDIF !IF "$(WIN64)"=="define" @(echo #define PTRSIZE ^8&& \ echo #define SSize_t $(INT64)&& \ diff --git a/win32/config.gc b/win32/config.gc index b0af7d42e9da..c632ba93c328 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -888,8 +888,8 @@ longsize='4' lp='' lpr='' ls='dir' -lseeksize='4' -lseektype='long' +lseeksize='8' +lseektype='long long' mad='undef' mail='' mailx='' @@ -1126,7 +1126,7 @@ usedtrace='undef' usefaststdio='undef' useithreads='undef' usekernprocpathname='undef' -uselargefiles='undef' +uselargefiles='define' uselongdouble='undef' usemallocwrap='define' usemorebits='undef' diff --git a/win32/config.vc b/win32/config.vc index 234de8da62ed..3f68e7554fa5 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -887,8 +887,8 @@ longsize='4' lp='' lpr='' ls='dir' -lseeksize='4' -lseektype='long' +lseeksize='8' +lseektype='__int64' mad='undef' mail='' mailx='' @@ -1125,7 +1125,7 @@ usedtrace='undef' usefaststdio='undef' useithreads='undef' usekernprocpathname='undef' -uselargefiles='undef' +uselargefiles='define' uselongdouble='undef' usemallocwrap='define' usemorebits='undef' diff --git a/win32/config_H.gc b/win32/config_H.gc index 72b7013d4da6..233eea3f655f 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -4149,7 +4149,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -/*#define USE_LARGE_FILES / **/ +#define USE_LARGE_FILES /**/ #endif /* USE_LONG_DOUBLE: @@ -5068,9 +5068,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long /* type */ -#define LSEEKSIZE 4 /* size */ -#define Off_t_size 4 /* size */ +#define Off_t long long /* type */ +#define LSEEKSIZE 8 /* size */ +#define Off_t_size 8 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes diff --git a/win32/config_H.vc b/win32/config_H.vc index be0d90a96468..62addd119aef 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -4140,7 +4140,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -/*#define USE_LARGE_FILES / **/ +#define USE_LARGE_FILES /**/ #endif /* USE_LONG_DOUBLE: @@ -5059,9 +5059,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long /* type */ -#define LSEEKSIZE 4 /* size */ -#define Off_t_size 4 /* size */ +#define Off_t __int64 /* type */ +#define LSEEKSIZE 8 /* size */ +#define Off_t_size 8 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes diff --git a/win32/config_sh.PL b/win32/config_sh.PL index bffd4ecf9fee..d1543889dce4 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -117,16 +117,6 @@ elsif ($opt{cc} =~ /\bgcc\b/) { $int64 = 'long long'; } -# set large files options -if ($opt{uselargefiles} eq 'define') { - $opt{lseeksize} = 8; - $opt{lseektype} = $int64; -} -else { - $opt{lseeksize} = 4; - $opt{lseektype} = 'long'; -} - # set 64-bit options if ($opt{WIN64} eq 'define') { $opt{d_atoll} = 'define'; diff --git a/win32/makefile.mk b/win32/makefile.mk index d9d90c66540c..6ddc4d0fbda3 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -87,13 +87,6 @@ USE_ITHREADS *= define # USE_IMP_SYS *= define -# -# Comment this out if you don't want to enable large file support for -# some reason. Should normally only be changed to maintain compatibility -# with an older release of perl. -# -USE_LARGE_FILES *= define - # # Uncomment this if you're building a 32-bit perl and want 64-bit integers. # (If you're building a 64-bit perl then you will have 64-bit integers whether @@ -306,7 +299,6 @@ USE_SITECUST *= undef USE_MULTI *= undef USE_ITHREADS *= undef USE_IMP_SYS *= undef -USE_LARGE_FILES *= undef USE_64_BIT_INT *= undef USE_LONG_DOUBLE *= undef DEFAULT_INC_EXCLUDES_DOT *= undef @@ -1156,7 +1148,6 @@ CFG_VARS = \ usemultiplicity=$(USE_MULTI) ~ \ use64bitint=$(USE_64_BIT_INT) ~ \ uselongdouble=$(USE_LONG_DOUBLE) ~ \ - uselargefiles=$(USE_LARGE_FILES) ~ \ usesitecustomize=$(USE_SITECUST) ~ \ default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT) ~ \ LINK_FLAGS=$(LINK_FLAGS) ~ \ @@ -1279,9 +1270,6 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) @(echo.&& \ echo #ifndef _config_h_footer_&& \ echo #define _config_h_footer_&& \ - echo #undef Off_t&& \ - echo #undef LSEEKSIZE&& \ - echo #undef Off_t_size&& \ echo #undef PTRSIZE&& \ echo #undef SSize_t&& \ echo #undef HAS_ATOLL&& \ @@ -1331,15 +1319,6 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #define FILE_bufsiz^(fp^) ^(PERLIO_FILE_cnt^(fp^) + PERLIO_FILE_ptr^(fp^) - PERLIO_FILE_base^(fp^)^)&& \ echo #define I_STDBOOL)>> config.h .ENDIF -.IF "$(USE_LARGE_FILES)"=="define" - @(echo #define Off_t $(INT64)&& \ - echo #define LSEEKSIZE ^8&& \ - echo #define Off_t_size ^8)>> config.h -.ELSE - @(echo #define Off_t long&& \ - echo #define LSEEKSIZE ^4&& \ - echo #define Off_t_size ^4)>> config.h -.ENDIF .IF "$(WIN64)"=="define" .IF "$(CCTYPE)" == "GCC" @(echo #define LONG_DOUBLESIZE ^16)>> config.h diff --git a/win32/win32.c b/win32/win32.c index 9719f14fa381..80b400886385 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1526,11 +1526,7 @@ win32_stat(const char *path, Stat_t *sbuf) } /* path will be mapped correctly above */ -#if defined(WIN64) || defined(USE_LARGE_FILES) res = _stati64(path, sbuf); -#else - res = stat(path, sbuf); -#endif sbuf->st_nlink = nlink; if (res < 0) { @@ -2853,20 +2849,15 @@ win32_fflush(FILE *pf) DllExport Off_t win32_ftell(FILE *pf) { -#if defined(WIN64) || defined(USE_LARGE_FILES) fpos_t pos; if (fgetpos(pf, &pos)) return -1; return (Off_t)pos; -#else - return ftell(pf); -#endif } DllExport int win32_fseek(FILE *pf, Off_t offset,int origin) { -#if defined(WIN64) || defined(USE_LARGE_FILES) fpos_t pos; switch (origin) { case SEEK_CUR: @@ -2886,9 +2877,6 @@ win32_fseek(FILE *pf, Off_t offset,int origin) return -1; } return fsetpos(pf, &offset); -#else - return fseek(pf, (long)offset, origin); -#endif } DllExport int @@ -2967,11 +2955,7 @@ win32_abort(void) DllExport int win32_fstat(int fd, Stat_t *sbufptr) { -#if defined(WIN64) || defined(USE_LARGE_FILES) return _fstati64(fd, sbufptr); -#else - return fstat(fd, sbufptr); -#endif } DllExport int @@ -3256,7 +3240,6 @@ win32_setmode(int fd, int mode) DllExport int win32_chsize(int fd, Off_t size) { -#if defined(WIN64) || defined(USE_LARGE_FILES) int retval = 0; Off_t cur, end, extend; @@ -3296,29 +3279,18 @@ win32_chsize(int fd, Off_t size) } win32_lseek(fd, cur, SEEK_SET); return retval; -#else - return chsize(fd, (long)size); -#endif } DllExport Off_t win32_lseek(int fd, Off_t offset, int origin) { -#if defined(WIN64) || defined(USE_LARGE_FILES) return _lseeki64(fd, offset, origin); -#else - return lseek(fd, (long)offset, origin); -#endif } DllExport Off_t win32_tell(int fd) { -#if defined(WIN64) || defined(USE_LARGE_FILES) return _telli64(fd); -#else - return tell(fd); -#endif } DllExport int From d760460651a8e8be00da9930a8788102b42db5a7 Mon Sep 17 00:00:00 2001 From: Shlomi Fish Date: Thu, 29 Oct 2020 15:40:07 +0200 Subject: [PATCH 076/503] Add a usage note about the "l" modifier. --- pod/perlfunc.pod | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index d509eee584b0..e864147fe855 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -8223,6 +8223,11 @@ as supported by the compiler used to build Perl: z interpret integer as C types "size_t" or "ssize_t" on Perl 5.14 or later +Note that, in general, using the C modifier (for example, when writing +C<"%ld"> or C<"%lu"> instead of C<"%d"> and C<"%u">) is unnecessary +when used from Perl code. Moreover, it may be harmful, for example on +Windows 64-bit where a long is 32-bits. + As of 5.14, none of these raises an exception if they are not supported on your platform. However, if warnings are enabled, a warning of the L|warnings> warning class is issued on an unsupported From d5722fbc5c03c4130f4cfaca71a28502d0c6f8d7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 07:32:18 -0600 Subject: [PATCH 077/503] Confine scope of SV_CONST to core as well as the constants it uses. This is unused in cpan --- sv.h | 85 +++++++++++++++++++++++++++++++----------------------------- 1 file changed, 44 insertions(+), 41 deletions(-) diff --git a/sv.h b/sv.h index 0742b7071c18..7589d707e266 100644 --- a/sv.h +++ b/sv.h @@ -2363,51 +2363,54 @@ Evaluates C more than once. Sets C to 0 if C is false. #define newIO() MUTABLE_IO(newSV_type(SVt_PVIO)) -#define SV_CONST(name) \ +#if defined(PERL_CORE) || defined(PERL_EXT) + +# define SV_CONST(name) \ PL_sv_consts[SV_CONST_##name] \ ? PL_sv_consts[SV_CONST_##name] \ : (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0)) -#define SV_CONST_TIESCALAR 0 -#define SV_CONST_TIEARRAY 1 -#define SV_CONST_TIEHASH 2 -#define SV_CONST_TIEHANDLE 3 - -#define SV_CONST_FETCH 4 -#define SV_CONST_FETCHSIZE 5 -#define SV_CONST_STORE 6 -#define SV_CONST_STORESIZE 7 -#define SV_CONST_EXISTS 8 - -#define SV_CONST_PUSH 9 -#define SV_CONST_POP 10 -#define SV_CONST_SHIFT 11 -#define SV_CONST_UNSHIFT 12 -#define SV_CONST_SPLICE 13 -#define SV_CONST_EXTEND 14 - -#define SV_CONST_FIRSTKEY 15 -#define SV_CONST_NEXTKEY 16 -#define SV_CONST_SCALAR 17 - -#define SV_CONST_OPEN 18 -#define SV_CONST_WRITE 19 -#define SV_CONST_PRINT 20 -#define SV_CONST_PRINTF 21 -#define SV_CONST_READ 22 -#define SV_CONST_READLINE 23 -#define SV_CONST_GETC 24 -#define SV_CONST_SEEK 25 -#define SV_CONST_TELL 26 -#define SV_CONST_EOF 27 -#define SV_CONST_BINMODE 28 -#define SV_CONST_FILENO 29 -#define SV_CONST_CLOSE 30 - -#define SV_CONST_DELETE 31 -#define SV_CONST_CLEAR 32 -#define SV_CONST_UNTIE 33 -#define SV_CONST_DESTROY 34 +# define SV_CONST_TIESCALAR 0 +# define SV_CONST_TIEARRAY 1 +# define SV_CONST_TIEHASH 2 +# define SV_CONST_TIEHANDLE 3 + +# define SV_CONST_FETCH 4 +# define SV_CONST_FETCHSIZE 5 +# define SV_CONST_STORE 6 +# define SV_CONST_STORESIZE 7 +# define SV_CONST_EXISTS 8 + +# define SV_CONST_PUSH 9 +# define SV_CONST_POP 10 +# define SV_CONST_SHIFT 11 +# define SV_CONST_UNSHIFT 12 +# define SV_CONST_SPLICE 13 +# define SV_CONST_EXTEND 14 + +# define SV_CONST_FIRSTKEY 15 +# define SV_CONST_NEXTKEY 16 +# define SV_CONST_SCALAR 17 + +# define SV_CONST_OPEN 18 +# define SV_CONST_WRITE 19 +# define SV_CONST_PRINT 20 +# define SV_CONST_PRINTF 21 +# define SV_CONST_READ 22 +# define SV_CONST_READLINE 23 +# define SV_CONST_GETC 24 +# define SV_CONST_SEEK 25 +# define SV_CONST_TELL 26 +# define SV_CONST_EOF 27 +# define SV_CONST_BINMODE 28 +# define SV_CONST_FILENO 29 +# define SV_CONST_CLOSE 30 + +# define SV_CONST_DELETE 31 +# define SV_CONST_CLEAR 32 +# define SV_CONST_UNTIE 33 +# define SV_CONST_DESTROY 34 +#endif #define SV_CONSTS_COUNT 35 From 4c29eb71ff3f0996f907fcc484a329bb673f3606 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 19 Nov 2020 16:08:05 +1100 Subject: [PATCH 078/503] add a brief introduction to the IO SV type --- pod/perlguts.pod | 57 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 57 insertions(+) diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 1575619caf5b..965ca72ffafb 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -1023,6 +1023,63 @@ as any other SV. For more information on references and blessings, consult L. +=head2 I/O Handles + +Like AVs and HVs, IO objects are another type of non-scalar SV which +may contain input and output L objects or a C +from opendir(). + +You can create a new IO object: + + IO* newIO(); + +Unlike other SVs, a new IO object is automatically blessed into the +L class. + +The IO object contains an input and output PerlIO handle: + + PerlIO *IoIFP(IO *io); + PerlIO *IoOFP(IO *io); + +Typically if the IO object has been opened on a file, the input handle +is always present, but the output handle is only present if the file +is open for output. For a file, if both are present they will be the +same PerlIO object. + +Distinct input and output PerlIO objects are created for sockets and +character devices. + +The IO object also contains other data associated with Perl I/O +handles: + + IV IoLINES(io); /* $. */ + IV IoPAGE(io); /* $% */ + IV IoPAGE_LEN(io); /* $= */ + IV IoLINES_LEFT(io); /* $- */ + char *IoTOP_NAME(io); /* $^ */ + GV *IoTOP_GV(io); /* $^ */ + char *IoFMT_NAME(io); /* $~ */ + GV *IoFMT_GV(io); /* $~ */ + char *IoBOTTOM_NAME(io); + GV *IoBOTTOM_GV(io); + char IoTYPE(io); + U8 IoFLAGS(io); + +Most of these are involved with L. + +IoFLAGs() may contain a combination of flags, the most interesting of +which are C (C<$|>) for autoflush and C, +settable with L<< IO::Handle's untaint() method|IO::Handle/"$io->untaint" >>. + +The IO object may also contains a directory handle: + + DIR *IoDIRP(io); + +suitable for use with PerlDir_read() etc. + +All of these accessors macros are lvalues, there are no distinct +C<_set()> macros to modify the members of the IO object. + =head2 Double-Typed SVs Scalar variables normally contain only one type of value, an integer, From 5c27e8a20ea252ce05ec050d1c3b2117a35067b0 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 09:24:12 -0600 Subject: [PATCH 079/503] perlapi: Note proper rplcemnt for pad_compname_type --- embed.fnc | 2 +- embed.h | 3 +++ mathoms.c | 2 ++ proto.h | 1 + 4 files changed, 7 insertions(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index eb14b68427d0..3eb6dc7a3074 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3418,7 +3418,7 @@ Apd |CV* |cv_clone |NN CV* proto p |CV* |cv_clone_into |NN CV* proto|NN CV *target pd |void |pad_fixup_inner_anons|NN PADLIST *padlist|NN CV *old_cv|NN CV *new_cv pdX |void |pad_push |NN PADLIST *padlist|int depth -ApbdRM |HV* |pad_compname_type|const PADOFFSET po +ApbdDR |HV* |pad_compname_type|const PADOFFSET po AxpdRT |PADNAME *|padnamelist_fetch|NN PADNAMELIST *pnl|SSize_t key Xop |void |padnamelist_free|NN PADNAMELIST *pnl Axpd |PADNAME **|padnamelist_store|NN PADNAMELIST *pnl|SSize_t key \ diff --git a/embed.h b/embed.h index 6348d64d1746..8d27796eec61 100644 --- a/embed.h +++ b/embed.h @@ -421,6 +421,9 @@ #define pad_add_name_pvn(a,b,c,d,e) Perl_pad_add_name_pvn(aTHX_ a,b,c,d,e) #define pad_add_name_sv(a,b,c,d) Perl_pad_add_name_sv(aTHX_ a,b,c,d) #define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b) +#ifndef NO_MATHOMS +#define pad_compname_type(a) Perl_pad_compname_type(aTHX_ a) +#endif #define pad_findmy_pv(a,b) Perl_pad_findmy_pv(aTHX_ a,b) #define pad_findmy_pvn(a,b,c) Perl_pad_findmy_pvn(aTHX_ a,b,c) #define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b) diff --git a/mathoms.c b/mathoms.c index a07b26019a07..fb21563363db 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1261,6 +1261,8 @@ Looks up the type of the lexical variable at position C in the currently-compiling pad. If the variable is typed, the stash of the class to which it is typed is returned. If not, C is returned. +Use L> instead. + =cut */ diff --git a/proto.h b/proto.h index 5e1be0214908..e886261db49c 100644 --- a/proto.h +++ b/proto.h @@ -2625,6 +2625,7 @@ PERL_CALLCONV void Perl_pad_block_start(pTHX_ int full); #define PERL_ARGS_ASSERT_PAD_BLOCK_START #ifndef NO_MATHOMS PERL_CALLCONV HV* Perl_pad_compname_type(pTHX_ const PADOFFSET po) + __attribute__deprecated__ __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_PAD_COMPNAME_TYPE #endif From 428e0112db0c53f7d112599f1faec39df3c543cf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 15:49:53 -0600 Subject: [PATCH 080/503] perlapi: Document UVf, as deprecated --- perl.h | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/perl.h b/perl.h index 3382dad025de..f837459c7d2a 100644 --- a/perl.h +++ b/perl.h @@ -3770,7 +3770,13 @@ EXTERN_C int perl_tsa_mutex_unlock(perl_mutex* mutex) #define PNfARG(pn) (int)1, (UV)PadnameLEN(pn), (void *)PadnamePV(pn) #ifdef PERL_CORE -/* not used; but needed for backward compatibility with XS code? - RMB */ +/* not used; but needed for backward compatibility with XS code? - RMB +=for apidoc AmnD|const char *|UVf + +Obsolete form of C, which you should convert to instead use + +=cut +*/ # undef UVf #elif !defined(UVf) # define UVf UVuf From 42f8d732ff160bd4f03b0fd75c8ccd1592abbf85 Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Mon, 23 Nov 2020 23:12:49 +0100 Subject: [PATCH 081/503] fix context of caller call in Carp Carp's CARP_NOT variable is meant to have package names. caller in list context returns the calling file and line in addition to the package name. Enforce scalar context on the call to caller to fix this. --- dist/Carp/lib/Carp.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm index 109b7fec7703..46aeaa5ffae1 100644 --- a/dist/Carp/lib/Carp.pm +++ b/dist/Carp/lib/Carp.pm @@ -284,7 +284,7 @@ sub shortmess { my $cgc = _cgc(); # Icky backwards compatibility wrapper. :-( - local @CARP_NOT = $cgc ? $cgc->() : caller(); + local @CARP_NOT = scalar( $cgc ? $cgc->() : caller() ); shortmess_heavy(@_); } From fccc9f3e92f31c2c2beb8c4e49977ea4bdebc6ff Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 24 Nov 2020 10:18:18 +1100 Subject: [PATCH 082/503] bump $Carp::VERSION --- dist/Carp/lib/Carp.pm | 2 +- dist/Carp/lib/Carp/Heavy.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm index 46aeaa5ffae1..941f59db4b07 100644 --- a/dist/Carp/lib/Carp.pm +++ b/dist/Carp/lib/Carp.pm @@ -211,7 +211,7 @@ BEGIN { } -our $VERSION = '1.50'; +our $VERSION = '1.51'; $VERSION =~ tr/_//d; our $MaxEvalLen = 0; diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm index a9b803c76ad6..028d2a206e99 100644 --- a/dist/Carp/lib/Carp/Heavy.pm +++ b/dist/Carp/lib/Carp/Heavy.pm @@ -2,7 +2,7 @@ package Carp::Heavy; use Carp (); -our $VERSION = '1.50'; +our $VERSION = '1.51'; $VERSION =~ tr/_//d; # Carp::Heavy was merged into Carp in version 1.12. Any mismatched versions From 4281700a59b8da499ae9f1980d60c7e958a6583d Mon Sep 17 00:00:00 2001 From: John Karr Date: Tue, 10 Nov 2020 17:14:24 -0500 Subject: [PATCH 083/503] comp/parser.t count two lines that were being tested to see if they crashed parser as tests (PASS if the test file is still running after the lines). --- t/comp/parser.t | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/t/comp/parser.t b/t/comp/parser.t index 79b930ecb831..c928db6cfca7 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -8,7 +8,7 @@ BEGIN { chdir 't' if -d 't'; } -print "1..188\n"; +print "1..190\n"; sub failed { my ($got, $expected, $name) = @_; @@ -513,16 +513,18 @@ is $@, "Illegal division by zero at maggapom line 2.\n", is +(${[{a=>214}]}[0])->{a}, 214, '($array[...])->{...}'; # This used to fail an assertion because of the OPf_SPECIAL flag on an -# OP_GV that started out as an OP_CONST. No test output is necessary, as -# successful parsing is sufficient. -sub FILE1 () { 1 } -sub dummy { tell FILE1 } +# OP_GV that started out as an OP_CONST. + + sub FILE1 () { 1 } + sub dummy { tell FILE1 } # More potential multideref assertion failures # OPf_PARENS on OP_RV2SV in subscript -$x[($_)]; + $x[($_)]; + is(1,1, "PASS: Previous line successfully parsed. OPf_PARENS on OP_RV2SV"); # OPf_SPECIAL on OP_GV in subscript -$x[FILE1->[0]]; + $x[FILE1->[0]]; + is(1,1, "PASS: Previous line successfully parsed. OPf_SPECIAL on OP_GV"); # Used to crash [perl #123542] eval 's /${<>{}) //'; From a5fba4f1467e17d87a18ed69501a89ffa05d25ce Mon Sep 17 00:00:00 2001 From: John Karr Date: Thu, 12 Nov 2020 03:30:49 -0500 Subject: [PATCH 084/503] fix typo in comp/parser.t 3 similar tests eval a sub with a list of variables, $r is repeated at the end of the list, but the errors that are being checked have nothing to do with the repeated variable. This causes a warning enabled. --- t/comp/parser.t | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/t/comp/parser.t b/t/comp/parser.t index c928db6cfca7..fbfe5398e319 100644 --- a/t/comp/parser.t +++ b/t/comp/parser.t @@ -243,7 +243,7 @@ eval q[ like($@, qr/Missing right curly/, 'nested sub syntax error' ); eval q[ - sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r); + sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s); sub { my $z ]; like($@, qr/Missing right curly/, 'nested sub syntax error 2' ); @@ -256,7 +256,7 @@ eval q[ like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup' ); eval q[ - sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r); + sub { my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s); use DieDieDie; ]; @@ -265,7 +265,7 @@ like($@, qr/Can't locate DieDieDie.pm/, 'croak cleanup 2' ); eval q[ my @a; - my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s,$r); + my ($a,$b,$c,$d,$e,$f,$g,$h,$i,$j,$k,$l,$m,$n,$o,$p,$q,$r,$s); @a =~ s/a/b/; # compile-time error use DieDieDie; ]; @@ -639,10 +639,10 @@ check($this_file, 3, "bare line"); # line 5 check($this_file, 5, "bare line with leading space"); -#line 7 +#line 7 check($this_file, 7, "trailing space still valid"); -# line 11 +# line 11 check($this_file, 11, "leading and trailing"); # line 13 @@ -666,7 +666,7 @@ check(qr/^CLINK CLOINK BZZT$/, 31, "filename with spaces in quotes"); #line 37 "THOOM THOOM" check(qr/^THOOM THOOM$/, 37, "filename with tabs in quotes"); -#line 41 "GLINK PLINK GLUNK DINK" +#line 41 "GLINK PLINK GLUNK DINK" check(qr/^GLINK PLINK GLUNK DINK$/, 41, "a space after the quotes"); #line 43 "BBFRPRAFPGHPP From c792b1731f029bf5e505f07be67ddacd44f84e38 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 24 Nov 2020 10:24:28 +1100 Subject: [PATCH 085/503] John Karr is now a perl author --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 6ce4fe7b30c6..dbdad0cadaa7 100644 --- a/AUTHORS +++ b/AUTHORS @@ -652,6 +652,7 @@ John Hawkinson John Heidemann John Holdsworth John Hughes +John Karr John Kristian John L. Allen John Lightsey From 617613e2415f6e65538efd1001089b567bdff5ad Mon Sep 17 00:00:00 2001 From: Dan Book Date: Mon, 23 Nov 2020 02:59:53 -0500 Subject: [PATCH 086/503] perl - update usage data to match perlrun --- perl.c | 56 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 28 insertions(+), 28 deletions(-) diff --git a/perl.c b/perl.c index 488cebcb5b9f..57db3ed7b35f 100644 --- a/perl.c +++ b/perl.c @@ -3308,34 +3308,34 @@ S_usage(pTHX) /* XXX move this out into a module ? */ /* Grouped as 6 lines per C string literal, to keep under the ANSI C 89 minimum of 509 character string literals. */ static const char * const usage_msg[] = { -" -0[octal] specify record separator (\\0, if no argument)\n" -" -a autosplit mode with -n or -p (splits $_ into @F)\n" -" -C[number/list] enables the listed Unicode features\n" -" -c check syntax only (runs BEGIN and CHECK blocks)\n" -" -d[:debugger] run program under debugger\n" -" -D[number/list] set debugging flags (argument is a bit mask or alphabets)\n", -" -e program one line of program (several -e's allowed, omit programfile)\n" -" -E program like -e, but enables all optional features\n" -" -f don't do $sitelib/sitecustomize.pl at startup\n" -" -F/pattern/ split() pattern for -a switch (//'s are optional)\n" -" -i[extension] edit <> files in place (makes backup if extension supplied)\n" -" -Idirectory specify @INC/#include directory (several -I's allowed)\n", -" -l[octal] enable line ending processing, specifies line terminator\n" -" -[mM][-]module execute \"use/no module...\" before executing program\n" -" -n assume \"while (<>) { ... }\" loop around program\n" -" -p assume loop like -n but print line also, like sed\n" -" -s enable rudimentary parsing for switches after programfile\n" -" -S look for programfile using PATH environment variable\n", -" -t enable tainting warnings\n" -" -T enable tainting checks\n" -" -u dump core after parsing program\n" -" -U allow unsafe operations\n" -" -v print version, patchlevel and license\n" -" -V[:variable] print configuration summary (or a single Config.pm variable)\n", -" -w enable many useful warnings\n" -" -W enable all warnings\n" -" -x[directory] ignore text before #!perl line (optionally cd to directory)\n" -" -X disable all warnings\n" +" -0[octal/hexadecimal] specify record separator (\\0, if no argument)\n" +" -a autosplit mode with -n or -p (splits $_ into @F)\n" +" -C[number/list] enables the listed Unicode features\n" +" -c check syntax only (runs BEGIN and CHECK blocks)\n" +" -d[t][:MOD] run program under debugger or module Devel::MOD\n" +" -D[number/letters] set debugging flags (argument is a bit mask or alphabets)\n", +" -e commandline one line of program (several -e's allowed, omit programfile)\n" +" -E commandline like -e, but enables all optional features\n" +" -f don't do $sitelib/sitecustomize.pl at startup\n" +" -F/pattern/ split() pattern for -a switch (//'s are optional)\n" +" -i[extension] edit <> files in place (makes backup if extension supplied)\n" +" -Idirectory specify @INC/#include directory (several -I's allowed)\n", +" -l[octnum] enable line ending processing, specifies line terminator\n" +" -[mM][-]module execute \"use/no module...\" before executing program\n" +" -n assume \"while (<>) { ... }\" loop around program\n" +" -p assume loop like -n but print line also, like sed\n" +" -s enable rudimentary parsing for switches after programfile\n" +" -S look for programfile using PATH environment variable\n", +" -t enable tainting warnings\n" +" -T enable tainting checks\n" +" -u dump core after parsing program\n" +" -U allow unsafe operations\n" +" -v print version, patchlevel and license\n" +" -V[:configvar] print configuration summary (or a single Config.pm variable)\n", +" -w enable many useful warnings\n" +" -W enable all warnings\n" +" -x[directory] ignore text before #!perl line (optionally cd to directory)\n" +" -X disable all warnings\n" " \n" "Run 'perldoc perl' for more help with Perl.\n\n", NULL From 18b3ff2673bbc5f9b37c6d9b6c912f882537ddc2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 17 Nov 2020 14:07:32 +1100 Subject: [PATCH 087/503] *ctl: ensure the ARG parameter's UTF-8 flag is reset If the SV supplied as ARG had the SVf_UTF8 flag on it would be left on, which would effectively corrupt the returned buffer. Only tested with shmctl(), since the other *ctl() functions only have more complex structures with indeterminate types that would require more effort to test. --- doio.c | 1 + t/io/sem.t | 12 ++++++++++-- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/doio.c b/doio.c index 2bffeea07958..11c9ed1a4616 100644 --- a/doio.c +++ b/doio.c @@ -3058,6 +3058,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) if (getinfo && ret >= 0) { SvCUR_set(astr, infosize); *SvEND(astr) = '\0'; + SvUTF8_off(astr); SvSETMAGIC(astr); } return ret; diff --git a/t/io/sem.t b/t/io/sem.t index 7a911fccdb0f..8d2c7bbe362c 100644 --- a/t/io/sem.t +++ b/t/io/sem.t @@ -42,7 +42,7 @@ if (not defined $id) { } } else { - plan(tests => 7); + plan(tests => 9); pass('acquired semaphore'); } @@ -51,7 +51,7 @@ else { "Initialize all $nsem semaphores to zero"); my $sem2set = 3; - my $semval = 17; + my $semval = 192; ok(semctl($id, $sem2set, SETVAL, $semval), "Set semaphore $sem2set to $semval"); @@ -68,5 +68,13 @@ else { is(semctl($id, $sem2set, GETVAL, "ignored"), $semval, "Check value via GETVAL"); + + # check utf-8 flag handling + utf8::upgrade($semvals); + ok(semctl($id, $ignored, GETALL, $semvals), + "fetch into an already UTF-8 buffer"); + @semvals = unpack("s!*", $semvals); + is($semvals[$sem2set], $semval, + "Checking value of semaphore $sem2set after fetch into originally UTF-8 buffer"); } From 7274dea4b81e86585fcc4c4377c1a9918de3f4af Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 17 Nov 2020 14:20:41 +1100 Subject: [PATCH 088/503] *ctl: test we handle the buffer as bytes Previously this had the "unicode bug", an upgraded string would be treated as the encoding of that string, rather than the raw bytes. --- doio.c | 4 ++-- t/io/sem.t | 11 +++++++++++ 2 files changed, 13 insertions(+), 2 deletions(-) diff --git a/doio.c b/doio.c index 11c9ed1a4616..29a431d8ebd2 100644 --- a/doio.c +++ b/doio.c @@ -2999,13 +2999,13 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { if (getinfo) { - SvPV_force_nolen(astr); + SvPV_force_nolen(astr); a = SvGROW(astr, infosize+1); } else { STRLEN len; - a = SvPV(astr, len); + a = SvPVbyte(astr, len); if (len != infosize) Perl_croak(aTHX_ "Bad arg length for %s, is %lu, should be %ld", PL_op_desc[optype], diff --git a/t/io/sem.t b/t/io/sem.t index 8d2c7bbe362c..ff3df5f49686 100644 --- a/t/io/sem.t +++ b/t/io/sem.t @@ -76,5 +76,16 @@ else { @semvals = unpack("s!*", $semvals); is($semvals[$sem2set], $semval, "Checking value of semaphore $sem2set after fetch into originally UTF-8 buffer"); + + # second that we treat it as bytes on input + @semvals = ( 0 ) x $nsem; + $semvals[$sem2set] = $semval + 1; + $semvals = pack "s!*", @semvals; + utf8::upgrade($semvals); + # eval{} since it would crash due to the UTF-8 form being longer + ok(eval { semctl($id, "ignored", SETALL, $semvals) }, + "set all semaphores from an upgraded string"); + is(semctl($id, $sem2set, GETVAL, $ignored), $semval+1, + "test value set from UTF-8"); } From e1902e4ac113e51aa730e03a2b1bc54ec96c371c Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 17 Nov 2020 14:25:36 +1100 Subject: [PATCH 089/503] *ctl: test that we throw on a code point above 0xff These functions expect a packed structure of some point representing bytes from the structure in memory. --- t/io/sem.t | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/t/io/sem.t b/t/io/sem.t index ff3df5f49686..07e3fab1e3cd 100644 --- a/t/io/sem.t +++ b/t/io/sem.t @@ -87,5 +87,11 @@ else { "set all semaphores from an upgraded string"); is(semctl($id, $sem2set, GETVAL, $ignored), $semval+1, "test value set from UTF-8"); + + # third, that we throw on a code point above 0xFF + substr($semvals, 0, 1) = chr(0x101); + ok(!eval { semctl($id, "ignored", SETALL, $semvals); 1 }, + "throws on code points above 0xff"); + like($@, qr/Wide character/, "with the expected error"); } From d43c116b2ae74ec1f3ed78829d4f3ca76f091390 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 17 Nov 2020 15:59:44 +1100 Subject: [PATCH 090/503] io/sem.t: eliminate warnings This eliminates some warnings that semctl() (or other *ctl()) calls might generate, and some warnings specific to io/sem.t: - for IPC_STAT and GETALL, the current value of ARG is overwritten so making an undefined value warning for it nonsensical, so don't use SvPV_force(). - for other calls, ARG is either ignored, or in a behaviour introduced in perl 3 (along with the ops), treats the supplied value as an integer which is then converted to a pointer. Rather than warning on an undef value which is most likely to be ignored we treat the undef as zero without the usual warning. - always pass a number for SEMNUM in the test code I didn't try to eliminate warning for non-numeric/undefined SEMNUM, since while we know it isn't used by SETALL, GETALL, IPC_STAT and IPC_SET, it may or may not be used by system defined *ctl() operators such as SEM_INFO and SHM_LOCK on Linux. fixes #17926 --- doio.c | 22 ++++++++++++++++++---- t/io/sem.t | 30 ++++++++++++++++++++++-------- 2 files changed, 40 insertions(+), 12 deletions(-) diff --git a/doio.c b/doio.c index 29a431d8ebd2..bc59c178df14 100644 --- a/doio.c +++ b/doio.c @@ -2999,7 +2999,11 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { if (getinfo) { - SvPV_force_nolen(astr); + /* we're not using the value here, so don't SvPVanything */ + SvUPGRADE(astr, SVt_PV); + SvGETMAGIC(astr); + if (SvTHINKFIRST(astr)) + sv_force_normal_flags(astr, 0); a = SvGROW(astr, infosize+1); } else @@ -3015,8 +3019,18 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) } else { - const IV i = SvIV(astr); - a = INT2PTR(char *,i); /* ouch */ + /* We historically treat this as a pointer if we don't otherwise recognize + the op, but for many ops the value is simply ignored anyway, so + don't warn on undef. + */ + SvGETMAGIC(astr); + if (SvOK(astr)) { + const IV i = SvIV_nomg(astr); + a = INT2PTR(char *,i); /* ouch */ + } + else { + a = NULL; + } } SETERRNO(0,0); switch (optype) @@ -3058,7 +3072,7 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) if (getinfo && ret >= 0) { SvCUR_set(astr, infosize); *SvEND(astr) = '\0'; - SvUTF8_off(astr); + SvPOK_only(astr); SvSETMAGIC(astr); } return ret; diff --git a/t/io/sem.t b/t/io/sem.t index 07e3fab1e3cd..7be1c181f134 100644 --- a/t/io/sem.t +++ b/t/io/sem.t @@ -17,13 +17,15 @@ BEGIN { } use strict; +use warnings; our $TODO; use sigtrap qw/die normal-signals error-signals/; -use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_RMID SETVAL GETVAL SETALL GETALL IPC_CREAT /; +use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_RMID SETVAL GETVAL SETALL GETALL IPC_CREAT IPC_STAT /; my $id; my $nsem = 10; +my $ignored = 0; END { semctl $id, 0, IPC_RMID, 0 if defined $id } { @@ -42,12 +44,14 @@ if (not defined $id) { } } else { - plan(tests => 9); + plan(tests => 15); pass('acquired semaphore'); } +my @warnings; +$SIG{__WARN__} = sub { push @warnings, "@_"; print STDERR @_; }; { # [perl #120635] 64 bit big-endian semctl SETVAL bug - ok(semctl($id, "ignore", SETALL, pack("s!*",(0)x$nsem)), + ok(semctl($id, $ignored, SETALL, pack("s!*",(0)x$nsem)), "Initialize all $nsem semaphores to zero"); my $sem2set = 3; @@ -56,7 +60,7 @@ else { "Set semaphore $sem2set to $semval"); my $semvals; - ok(semctl($id, "ignore", GETALL, $semvals), + ok(semctl($id, $ignored, GETALL, $semvals), 'Get current semaphore values'); my @semvals = unpack("s!*", $semvals); @@ -66,10 +70,11 @@ else { is($semvals[$sem2set], $semval, "Checking value of semaphore $sem2set"); - is(semctl($id, $sem2set, GETVAL, "ignored"), $semval, + is(semctl($id, $sem2set, GETVAL, $ignored), $semval, "Check value via GETVAL"); # check utf-8 flag handling + # first that we reset it on a fetch utf8::upgrade($semvals); ok(semctl($id, $ignored, GETALL, $semvals), "fetch into an already UTF-8 buffer"); @@ -83,15 +88,24 @@ else { $semvals = pack "s!*", @semvals; utf8::upgrade($semvals); # eval{} since it would crash due to the UTF-8 form being longer - ok(eval { semctl($id, "ignored", SETALL, $semvals) }, + ok(eval { semctl($id, $ignored, SETALL, $semvals) }, "set all semaphores from an upgraded string"); - is(semctl($id, $sem2set, GETVAL, $ignored), $semval+1, + # undef here to test it doesn't warn + is(semctl($id, $sem2set, GETVAL, undef), $semval+1, "test value set from UTF-8"); # third, that we throw on a code point above 0xFF substr($semvals, 0, 1) = chr(0x101); - ok(!eval { semctl($id, "ignored", SETALL, $semvals); 1 }, + ok(!eval { semctl($id, $ignored, SETALL, $semvals); 1 }, "throws on code points above 0xff"); like($@, qr/Wide character/, "with the expected error"); } +{ + my $stat; + # shouldn't warn + semctl($id, $ignored, IPC_STAT, $stat); + ok(defined $stat, "it statted"); +} + +is(scalar @warnings, 0, "no warnings"); From 61f058724e10981590e6ccf006ce7ed70092fe2b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 10:27:50 +1100 Subject: [PATCH 091/503] fix UTF-8 handling for semop() As with semctl(), the UTF-8 flag on the passed in opstring was ignored, which meant that the upgraded version of the same string would cause an error. Just use SvPVbyte(). --- doio.c | 2 +- t/io/sem.t | 24 +++++++++++++++++++++++- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/doio.c b/doio.c index bc59c178df14..00f71686dc3b 100644 --- a/doio.c +++ b/doio.c @@ -3162,7 +3162,7 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) STRLEN opsize; const I32 id = SvIVx(*++mark); SV * const opstr = *++mark; - const char * const opbuf = SvPV_const(opstr, opsize); + const char * const opbuf = SvPVbyte(opstr, opsize); PERL_ARGS_ASSERT_DO_SEMOP; PERL_UNUSED_ARG(sp); diff --git a/t/io/sem.t b/t/io/sem.t index 7be1c181f134..bfac1c864d55 100644 --- a/t/io/sem.t +++ b/t/io/sem.t @@ -44,7 +44,7 @@ if (not defined $id) { } } else { - plan(tests => 15); + plan(tests => 22); pass('acquired semaphore'); } @@ -99,6 +99,28 @@ $SIG{__WARN__} = sub { push @warnings, "@_"; print STDERR @_; }; ok(!eval { semctl($id, $ignored, SETALL, $semvals); 1 }, "throws on code points above 0xff"); like($@, qr/Wide character/, "with the expected error"); + + { + # semop tests + ok(semctl($id, $sem2set, SETVAL, 0), + "reset our working entry"); + # sanity check without UTF-8 + my $op = pack "s!*", $sem2set, $semval, 0; + ok(semop($id, $op), "add to entry $sem2set"); + is(semctl($id, $sem2set, GETVAL, 0), $semval, + "check it added to the entry"); + utf8::upgrade($op); + # unlike semctl this doesn't throw on a bad size, so we don't need an + # eval with the buggy code + ok(semop($id, $op), "add more to entry $sem2set (UTF-8)"); + is(semctl($id, $sem2set, GETVAL, 0), $semval*2, + "check it added to the entry"); + + substr($op, 0, 1) = chr(0x101); + ok(!eval { semop($id, $op); 1 }, + "test semop throws if the op string isn't 'bytes'"); + like($@, qr/Wide character/, "with the expected error"); + } } { From 58b73e564c400e9f1e26a50fe882f6aaea2aabf2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 11:42:24 +1100 Subject: [PATCH 092/503] perlfunc/msgsnd: the supplied MSG doesn't have a length field The length of the message is derived from the length of the MSG less the size of the type field. --- pod/perlfunc.pod | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index e864147fe855..9f0c8208a020 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4326,9 +4326,8 @@ X Calls the System V IPC function msgsnd to send the message MSG to the message queue ID. MSG must begin with the native long integer message -type, be followed by the length of the actual message, and then finally -the message itself. This kind of packing can be achieved with -C. Returns true if successful, +type, followed by the message itself. This kind of packing can be achieved +with C. Returns true if successful, false on error. See also L and the documentation for L|IPC::SysV> and L|IPC::Msg>. From aa058ea4938983be8517ca4ac1dbcdf62cd96da2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 14:20:47 +1100 Subject: [PATCH 093/503] msgsnd: handle an upgraded MSG parameter correctly --- MANIFEST | 1 + doio.c | 2 +- t/io/msg.t | 69 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 71 insertions(+), 1 deletion(-) create mode 100644 t/io/msg.t diff --git a/MANIFEST b/MANIFEST index 42eca1b2c239..f0efee76b858 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5558,6 +5558,7 @@ t/io/inplace.t See if inplace editing works t/io/iofile.t See if we can load IO::File on demand t/io/iprefix.t See if inplace editing works with prefixes t/io/layers.t See if PerlIO layers work +t/io/msg.t See if SysV message queues work t/io/nargv.t See if nested ARGV stuff works t/io/open.t See if open works t/io/openpid.t See if open works for subprocesses diff --git a/doio.c b/doio.c index 00f71686dc3b..aa6c35bd15ed 100644 --- a/doio.c +++ b/doio.c @@ -3086,7 +3086,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) const I32 id = SvIVx(*++mark); SV * const mstr = *++mark; const I32 flags = SvIVx(*++mark); - const char * const mbuf = SvPV_const(mstr, len); + const char * const mbuf = SvPVbyte(mstr, len); const I32 msize = len - sizeof(long); PERL_ARGS_ASSERT_DO_MSGSND; diff --git a/t/io/msg.t b/t/io/msg.t new file mode 100644 index 000000000000..c31a20b44ffd --- /dev/null +++ b/t/io/msg.t @@ -0,0 +1,69 @@ +#!perl + +BEGIN { + chdir 't' if -d 't'; + + require "./test.pl"; + set_up_inc( '../lib' ) if -d '../lib' && -d '../ext'; + require Config; import Config; + + if ($ENV{'PERL_CORE'} && $Config{'extensions'} !~ m[\bIPC/SysV\b]) { + skip_all('-- IPC::SysV was not built'); + } + skip_all_if_miniperl(); + if ($Config{'d_msg'} ne 'define') { + skip_all('-- $Config{d_msg} undefined'); + } +} + +use strict; +use warnings; +our $TODO; + +use sigtrap qw/die normal-signals error-signals/; +use IPC::SysV qw/ IPC_PRIVATE S_IRUSR S_IWUSR IPC_RMID IPC_CREAT IPC_STAT IPC_CREAT IPC_NOWAIT/; + +my $id; +END { msgctl $id, IPC_RMID, 0 if defined $id } + +{ + local $SIG{SYS} = sub { skip_all("SIGSYS caught") } if exists $SIG{SYS}; + $id = msgget IPC_PRIVATE, S_IRUSR | S_IWUSR | IPC_CREAT; +} + +if (not defined $id) { + my $info = "msgget failed: $!"; + if ($! == &IPC::SysV::ENOSPC || $! == &IPC::SysV::ENOSYS || + $! == &IPC::SysV::ENOMEM || $! == &IPC::SysV::EACCES) { + skip_all($info); + } + else { + die $info; + } +} +else { + pass('acquired msg queue'); +} + +{ + # basic send/receive + my $type = 0x1F0; + my $content = "AB\xFF\xC0"; + + my $msg = pack("l! a*", $type, $content); + if (ok(msgsnd($id, $msg, IPC_NOWAIT), "send a message")) { + my $rcvbuf; + ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it"); + is($rcvbuf, $msg, "received should match sent"); + } + + # try upgraded send + utf8::upgrade(my $umsg = $msg); + if (ok(msgsnd($id, $umsg, IPC_NOWAIT), "send a message (upgraded)")) { + my $rcvbuf; + ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it"); + is($rcvbuf, $msg, "received should match sent"); + } +} + +done_testing(); From 6987f4434e4dfee71506125954ee1ae41c46f1cb Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 14:26:38 +1100 Subject: [PATCH 094/503] msgrcv: properly downgrade the receive buffer If the receive buffer started with SVf_UTF8 on, the received message SV would stay flagged, corrupting the result. --- doio.c | 1 + t/io/msg.t | 7 +++++++ 2 files changed, 8 insertions(+) diff --git a/doio.c b/doio.c index aa6c35bd15ed..df6e62c0f32f 100644 --- a/doio.c +++ b/doio.c @@ -3141,6 +3141,7 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) } if (ret >= 0) { SvCUR_set(mstr, sizeof(long)+ret); + SvPOK_only(mstr); *SvEND(mstr) = '\0'; /* who knows who has been playing with this message? */ SvTAINTED_on(mstr); diff --git a/t/io/msg.t b/t/io/msg.t index c31a20b44ffd..2c3f75b70979 100644 --- a/t/io/msg.t +++ b/t/io/msg.t @@ -64,6 +64,13 @@ else { ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it"); is($rcvbuf, $msg, "received should match sent"); } + + # try a receive buffer that starts upgraded + if (ok(msgsnd($id, $msg, IPC_NOWAIT), "send a message (upgraded receiver)")) { + my $rcvbuf = "\x{101}"; + ok(msgrcv($id, $rcvbuf, 1024, 0, IPC_NOWAIT), "receive it (upgraded receiver)"); + is($rcvbuf, $msg, "received should match sent (upgraded receiver)"); + } } done_testing(); From 0bcc92493f9da3a04237ac3c3281e41581b65192 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 15:01:13 +1100 Subject: [PATCH 095/503] shmwrite: treat the string as bytes --- doio.c | 2 +- t/io/shm.t | 18 +++++++++++++++++- 2 files changed, 18 insertions(+), 2 deletions(-) diff --git a/doio.c b/doio.c index df6e62c0f32f..439f2d096a57 100644 --- a/doio.c +++ b/doio.c @@ -3251,7 +3251,7 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) else { STRLEN len; - const char *mbuf = SvPV_const(mstr, len); + const char *mbuf = SvPVbyte(mstr, len); const I32 n = ((I32)len > msize) ? msize : (I32)len; Copy(mbuf, shm + mpos, n, char); if (n < msize) diff --git a/t/io/shm.t b/t/io/shm.t index 3feb3032d9b9..ced92a61863d 100644 --- a/t/io/shm.t +++ b/t/io/shm.t @@ -53,7 +53,7 @@ if (not defined $key) { } } else { - plan(tests => 15); + plan(tests => 21); pass('acquired shared mem'); } @@ -88,3 +88,19 @@ tie $ct, 'Counted'; shmread $key, $ct, 0, 1; is($fetch, 1, "shmread FETCH once"); is($store, 1, "shmread STORE once"); + +{ + # check reading into an upgraded buffer is sane + my $text = "\xC0\F0AB"; + ok(shmwrite($key, $text, 0, 4), "setup text"); + my $rdbuf = "\x{101}"; + ok(shmread($key, $rdbuf, 0, 4), "read it back"); + is($rdbuf, $text, "check we got back the expected"); + + # check writing from an upgraded buffer + utf8::upgrade(my $utext = $text); + ok(shmwrite($key, $utext, 0, 4), "setup text (upgraded source)"); + $rdbuf = ""; + ok(shmread($key, $rdbuf, 0, 4), "read it back (upgraded source)"); + is($rdbuf, $text, "check we got back the expected (upgraded source)"); +} From d778a442f27e96241c6f7cfbf890bdf28b31b1a2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 18 Nov 2020 15:02:05 +1100 Subject: [PATCH 096/503] io/shm.t: make runnable as ./perl io/shm.t and give editors a hint --- t/io/shm.t | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/t/io/shm.t b/t/io/shm.t index ced92a61863d..8ff1b33c4a76 100644 --- a/t/io/shm.t +++ b/t/io/shm.t @@ -1,3 +1,4 @@ +#!perl ################################################################################ # # $Revision: 6 $ @@ -15,9 +16,9 @@ ################################################################################ BEGIN { - chdir 't' if -d 't' && $ENV{'PERL_CORE'}; + chdir 't' if -d 't'; require "./test.pl"; - set_up_inc('../lib') if $ENV{'PERL_CORE'} && -d '../lib' && -d '../ext'; + set_up_inc('../lib') if -d '../lib' && -d '../ext'; require Config; import Config; From 8dc9a321dd4ceb65a6f39ababf8cb6a8f0de247a Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 24 Nov 2020 14:31:08 +1100 Subject: [PATCH 097/503] perldelta updates for the SysV IPC changes --- pod/perldelta.pod | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ee37a190f8f3..ad32e302db50 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -166,13 +166,15 @@ section. Additionally, the following selected changes have been made: -=head3 L +=head3 L =over 4 =item * -XXX Description of the change here +L documented a length field included in the +packed C parameter to msgsnd(), but there was no such field. +C contains only the type and the message content. =back @@ -363,7 +365,38 @@ files in F and F are best summarized in L. =item * -XXX +L, L, and +L now properly reset the UTF-8 flag on the +C parameter if it's modified for C or C +operations. + +=item * + +semctl(), msgctl(), and shmctl() now attempt to downgrade the C +parameter if it's value is being used as input to C or +C calls. A failed downgrade will thrown an exception. + +=item * + +In cases where semctl(), msgctl() or shmctl() would treat the C +parameter as a pointer, an undefined value no longer generates a +warning. In most such calls the pointer isn't used anyway and this +allows you to supply C for a value not used by the underlying +function. + +=item * + +L now downgrades the C parameter, +L now downgrades the C parameter and +L now downgrades the C parameter +to treat them as bytes. Previously they would be left upgraded, +providing a corrupted structure to the underlying function call. + +=item * + +L now properly resets the UTF-8 flag the +C parameter when it is modified. Previusly the UTF-8 flag could +be left on, resulting in a possibly corrupt result in C. =back From 168f9cb80f0909f869a0b1ff750ea61dbf97070e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 17 Nov 2020 20:35:01 -0700 Subject: [PATCH 098/503] perlapi: Move PL_dowarn to Warnings section --- intrpvar.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/intrpvar.h b/intrpvar.h index 1ea21ca47155..10fd8e13a6b9 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -94,12 +94,17 @@ PERLVARI(I, tainted, bool, FALSE) /* using variables controlled by $< */ PERLVAR(I, delaymagic, U16) /* ($<,$>) = ... */ /* +=for apidoc_section $warning =for apidoc mn|U8|PL_dowarn The C variable that roughly corresponds to Perl's C<$^W> warning variable. However, C<$^W> is treated as a boolean, whereas C is a collection of flag bits. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -171,6 +176,7 @@ PERLVAR(I, regmatch_state, regmatch_state *) PERLVAR(I, comppad, PAD *) /* storage for lexically scoped temporaries */ /* +=for apidoc_section Per-Interpreter Variables =for apidoc Amn|SV|PL_sv_undef This is the C SV. Always refer to this as C<&PL_sv_undef>. From 36f453d19563f9476d4310b8310ce4080209b04f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 17 Nov 2020 20:35:55 -0700 Subject: [PATCH 099/503] perlapi: Remove per-thread section; move to real scns Instead of having a grab bag section of all interpreter variables, move their documentation to the section that they actually fit under. --- autodoc.pl | 2 -- intrpvar.h | 72 ++++++++++++++++++++++++++++++++++++++++++++++++++---- 2 files changed, 67 insertions(+), 7 deletions(-) diff --git a/autodoc.pl b/autodoc.pl index 64491e751710..9df6266a9eb4 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -139,7 +139,6 @@ my $pad_scn = 'Pad Data Structures'; my $password_scn = 'Password and Group access'; my $paths_scn = 'Paths to system commands'; -my $intrpvar_scn = 'Per-Interpreter Variables'; my $prototypes_scn = 'Prototype information'; my $regexp_scn = 'REGEXP Functions'; my $signals_scn = 'Signals'; @@ -301,7 +300,6 @@ $pad_scn => {}, $password_scn => {}, $paths_scn => {}, - $intrpvar_scn => {}, $prototypes_scn => {}, $regexp_scn => {}, $signals_scn => {}, diff --git a/intrpvar.h b/intrpvar.h index 10fd8e13a6b9..67ff94ce2f43 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -10,10 +10,6 @@ #include "handy.h" -/* -=for apidoc_section Per-Interpreter Variables -*/ - /* These variables are per-interpreter in threaded/multiplicity builds, * global otherwise. @@ -123,6 +119,10 @@ PERLVARI(I, utf8cache, I8, PERL___I) /* Is the utf8 caching code enabled? */ The GV representing C<*_>. Useful for access to C<$_>. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -135,6 +135,10 @@ PERLVAR(I, defgv, GV *) /* the *_ glob */ The stash for the package code will be compiled into. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -148,6 +152,10 @@ PERLVAR(I, curstash, HV *) /* symbol table for current package */ The currently active COP (control op) roughly representing the current statement in the source. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -176,7 +184,7 @@ PERLVAR(I, regmatch_state, regmatch_state *) PERLVAR(I, comppad, PAD *) /* storage for lexically scoped temporaries */ /* -=for apidoc_section Per-Interpreter Variables +=for apidoc_section $SV =for apidoc Amn|SV|PL_sv_undef This is the C SV. Always refer to this as C<&PL_sv_undef>. @@ -248,18 +256,31 @@ PERLVAR(I, statgv, GV *) PERLVARI(I, statname, SV *, NULL) /* +=for apidoc_section $io =for apidoc mn|SV*|PL_rs The input record separator - C<$/> in Perl space. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =for apidoc mn|GV*|PL_last_in_gv The GV which was last used for a filehandle input operation. (C<< >>) +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =for apidoc mn|GV*|PL_ofsgv The glob containing the output field separator - C<*,> in Perl space. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -299,6 +320,7 @@ PERLVARI(I, dumpindent, U16, 4) /* number of blanks per dump indentation level */ /* +=for apidoc_section $embedding =for apidoc Amn|U8|PL_exit_flags Contains flags controlling perl's behaviour on exit(): @@ -331,6 +353,10 @@ Set by the L operator. =for apidoc Amnh||PERL_EXIT_DESTRUCT_END =for apidoc Amnh||PERL_EXIT_WARN +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -352,6 +378,7 @@ PERLVARA(I, locale_utf8ness, 256, char) PERLVARA(I, colors,6, char *) /* values from PERL_RE_COLORS env var */ /* +=for apidoc_section $optree_construction =for apidoc Amn|peep_t|PL_peepp Pointer to the per-subroutine peephole optimiser. This is a function @@ -369,6 +396,10 @@ If the new code wishes to operate on ops throughout the subroutine's structure, rather than just at the top level, it is likely to be more convenient to wrap the L hook. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -393,6 +424,10 @@ If the new code wishes to operate only on ops at a subroutine's top level, rather than throughout the structure, it is likely to be more convenient to wrap the L hook. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -407,6 +442,10 @@ It is also assured to first fire for the parent OP and then for its kids. When you replace this variable, it is considered a good practice to store the possibly previously installed hook and that you recall it inside your own. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -481,12 +520,17 @@ PERLVAR(I, DBgv, GV *) /* *DB::DB */ PERLVAR(I, DBline, GV *) /* *DB::line */ /* +=for apidoc_section $debugging =for apidoc mn|GV *|PL_DBsub When Perl is run in debugging mode, with the B<-d> switch, this GV contains the SV which holds the name of the sub being debugged. This is the C variable which corresponds to Perl's $DB::sub variable. See C>. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =for apidoc mn|SV *|PL_DBsingle When Perl is run in debugging mode, with the B<-d> switch, this SV is a boolean which indicates whether subs are being single-stepped. @@ -494,11 +538,19 @@ Single-stepping is automatically turned on after every step. This is the C variable which corresponds to Perl's $DB::single variable. See C>. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =for apidoc mn|SV *|PL_DBtrace Trace variable used when Perl is run in debugging mode, with the B<-d> switch. This is the C variable which corresponds to Perl's $DB::trace variable. See C>. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -567,6 +619,7 @@ PERLVARI(I, exitlist, PerlExitListEntry *, NULL) /* list of exit functions */ /* +=for apidoc_section $HV =for apidoc Amn|HV*|PL_modglobal C is a general purpose, interpreter global HV for use by @@ -575,6 +628,10 @@ In a pinch, it can also be used as a symbol table for extensions to share data among each other. It is a good idea to use keys prefixed by the package name of the extension that owns the data. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ @@ -701,6 +758,7 @@ PERLVAR(I, unsafe, bool) PERLVAR(I, colorset, bool) /* PERL_RE_COLORS env var is in use */ /* +=for apidoc_section $embedding =for apidoc Amn|signed char|PL_perl_destruct_level This value may be set when embedding for full cleanup. @@ -720,6 +778,10 @@ Possible values: If C<$ENV{PERL_DESTRUCT_LEVEL}> is set to an integer greater than the value of C its value is used instead. +On threaded perls, each thread has an independent copy of this variable; +each initialized at creation time with the current value of the creating +thread's copy. + =cut */ /* mod_perl is special, and also assigns a meaning -1 */ From 24d9bd5f3ce52745f522f236cc2301e7b8b2e8a2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 25 Nov 2020 06:54:37 -0700 Subject: [PATCH 100/503] perlapi: PL_sv_yes and kin are read-only --- intrpvar.h | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/intrpvar.h b/intrpvar.h index 67ff94ce2f43..b11607bc7909 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -186,15 +186,16 @@ PERLVAR(I, comppad, PAD *) /* storage for lexically scoped temporaries */ /* =for apidoc_section $SV =for apidoc Amn|SV|PL_sv_undef -This is the C SV. Always refer to this as C<&PL_sv_undef>. +This is the C SV. It is readonly. Always refer to this as +C<&PL_sv_undef>. =for apidoc Amn|SV|PL_sv_no -This is the C SV. See C>. Always refer to this as -C<&PL_sv_no>. +This is the C SV. It is readonly. See C>. Always refer +to this as C<&PL_sv_no>. =for apidoc Amn|SV|PL_sv_yes -This is the C SV. See C>. Always refer to this as -C<&PL_sv_yes>. +This is the C SV. It is readonly. See C>. Always refer to +this as C<&PL_sv_yes>. =for apidoc Amn|SV|PL_sv_zero This readonly SV has a zero numeric value and a C<"0"> string value. It's From ab6d150ee160f09d70a0b174a4729ff9c7068515 Mon Sep 17 00:00:00 2001 From: Dan Book Date: Wed, 25 Nov 2020 21:29:22 -0500 Subject: [PATCH 101/503] perlsub - indicate version requirement for "delete local" --- pod/perlsub.pod | 2 ++ 1 file changed, 2 insertions(+) diff --git a/pod/perlsub.pod b/pod/perlsub.pod index 629a273d0cb6..2c18b09d4f17 100644 --- a/pod/perlsub.pod +++ b/pod/perlsub.pod @@ -1032,6 +1032,8 @@ also accepted. } # %hash is back to its original state +This construct is supported since Perl v5.12. + =head2 Lvalue subroutines X X From f33fd0ebdf4b707aa8a862633713f222d3edc422 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 26 Nov 2020 06:16:13 -0700 Subject: [PATCH 102/503] locale.c: Move comment to better place --- locale.c | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/locale.c b/locale.c index 4654a5beaf07..9500ab7960f9 100644 --- a/locale.c +++ b/locale.c @@ -636,11 +636,12 @@ S_emulate_setlocale(const int category, /* If this assert fails, adjust the size of curlocales in intrpvar.h */ STATIC_ASSERT_STMT(C_ARRAY_LENGTH(PL_curlocales) > LC_ALL_INDEX); -# if defined(_NL_LOCALE_NAME) \ - && defined(DEBUGGING) \ +# if defined(_NL_LOCALE_NAME) \ + && defined(DEBUGGING) \ + /* On systems that accept any locale name, the real underlying \ + * locale is often returned by this internal function, so we \ + * can't use it */ \ && ! defined(SETLOCALE_ACCEPTS_ANY_LOCALE_NAME) - /* On systems that accept any locale name, the real underlying locale - * is often returned by this internal function, so we can't use it */ { /* Internal glibc for querylocale(), but doesn't handle * empty-string ("") locale properly; who knows what other From 5640a370e8b19af74b8ca0b4694464c21a87916b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 12 Aug 2020 14:59:12 -0600 Subject: [PATCH 103/503] Add mutex locking for many-reader/1-writer The mutex macros already in perl are sufficient to allow us to emulate this type of locking, which may also be available natively, but I don't think it is worth the effort to use the native calls. --- perl.h | 9 +++++++++ thread.h | 54 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+) diff --git a/perl.h b/perl.h index f837459c7d2a..8bccfb401076 100644 --- a/perl.h +++ b/perl.h @@ -3366,6 +3366,15 @@ typedef pthread_mutex_t PERL_TSA_CAPABILITY("mutex") perl_mutex; typedef pthread_cond_t perl_cond; typedef pthread_key_t perl_key; # endif + +/* Many readers; single writer */ +typedef struct perl_RnW1_mutex { + perl_mutex lock; + perl_cond zero_readers; + Size_t readers_count; +} Perl_W1Rn_mutex_t; + + #endif /* USE_ITHREADS */ #ifdef PERL_TSA_ACTIVE diff --git a/thread.h b/thread.h index e695889bbec4..a968a4c7904d 100644 --- a/thread.h +++ b/thread.h @@ -273,6 +273,53 @@ } STMT_END #endif /* COND_INIT */ +#if defined(MUTEX_LOCK) && defined(MUTEX_UNLOCK) \ + && defined(COND_SIGNAL) && defined(COND_WAIT) + +/* These emulate native many-reader/1-writer locks. + * Basically a locking reader just locks the semaphore long enough to increment + * a counter; and similarly decrements it when when through. Any writer will + * run only when the count of readers is 0. That is because it blocks on that + * semaphore (doing a COND_WAIT) until it gets control of it, which won't + * happen unless the count becomes 0. ALL readers and other writers are then + * blocked until it releases the semaphore. The reader whose unlocking causes + * the count to become 0 signals any waiting writers, and the system guarantees + * that only one gets control at a time */ + +# define PERL_READ_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&mutex.lock); \ + mutex.readers_count++; \ + MUTEX_UNLOCK(&mutex.lock); \ + } STMT_END + +# define PERL_READ_UNLOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&mutex.lock); \ + mutex.readers_count--; \ + if (mutex.readers_count <= 0) { \ + COND_SIGNAL(&mutex.zero_readers); \ + mutex.readers_count = 0; \ + } \ + MUTEX_UNLOCK(&mutex.lock); \ + } STMT_END + +# define PERL_WRITE_LOCK(mutex) \ + STMT_START { \ + MUTEX_LOCK(&mutex.lock); \ + do { \ + if (mutex.readers_count == 0) \ + break; \ + COND_WAIT(&mutex.zero_readers, &mutex.lock); \ + } \ + while (1); \ + \ + /* Here, the mutex is locked, with no readers */ \ + } STMT_END + +# define PERL_WRITE_UNLOCK(mutex) MUTEX_UNLOCK(&mutex.lock) +#endif + /* DETACH(t) must only be called while holding t->mutex */ #ifndef DETACH # define DETACH(t) \ @@ -402,6 +449,13 @@ # define COND_DESTROY(c) NOOP #endif +#ifndef PERL_READ_LOCK +# define PERL_READ_LOCK NOOP +# define PERL_READ_UNLOCK NOOP +# define PERL_WRITE_LOCK NOOP +# define PERL_WRITE_UNLOCK NOOP +#endif + #ifndef LOCK_DOLLARZERO_MUTEX # define LOCK_DOLLARZERO_MUTEX NOOP #endif From 0cc28fe31b0d416e9c67ecd18b8f38c5833a455a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 25 Nov 2020 18:20:28 -0700 Subject: [PATCH 104/503] Avoid deadlock with PERL_MEM_LOG This fixes GH #18341 The Perl wrapper for getenv() was changed in 5.32 to allocate memory to squirrel safely away the result of the wrapped getenv() call. It does this while in a critical section so as to make sure another thread can't interrupt it and destroy it. Unfortunately, when Perl is compiled for debugging memory problems and has PERL_MEM_LOG enabled, that allocation causes a recursive call to getenv() for the purpose of checking an environment variable to see how to log that allocation. And hence it deadlocks trying to enter the critical section. There are various solutions. One is to use or emulate a general semaphore instead of a binary one. This is effectively what PL_lc_numeric_mutex_depth does for another mutex, and the code for that could be used as a template. But given that this is an extreme edge case which requires Perl to be specially compiled to enable this feature which is used only for debugging, a much simpler, if less safe if it were to ever be used in production, solution should suffice. Tony Cook suggested just avoiding the wrapper for this particular purpose. --- util.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/util.c b/util.c index 5989a582c0e9..40e6b8dc1026 100644 --- a/util.c +++ b/util.c @@ -5008,7 +5008,11 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, PERL_ARGS_ASSERT_MEM_LOG_COMMON; - pmlenv = PerlEnv_getenv("PERL_MEM_LOG"); + /* Use plain getenv() to avoid potential deadlock with PerlEnv_getenv(). + * This means that 'pmlenv' is not protected from other threads overwriting + * it on platforms where getenv() returns an internal static pointer. See + * GH #18341 */ + pmlenv = getenv("PERL_MEM_LOG"); if (!pmlenv) return; if (mlt < MLT_NEW_SV ? strchr(pmlenv,'m') : strchr(pmlenv,'s')) From 6e46265cd30bc5b18a16181a924660fb80a1c284 Mon Sep 17 00:00:00 2001 From: Dan Book Date: Thu, 26 Nov 2020 23:19:13 -0500 Subject: [PATCH 105/503] perlvar - clarify that paragraph mode also discards a single leading newline --- pod/perlvar.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlvar.pod b/pod/perlvar.pod index 33157b872213..cfe9ff2f38f9 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -1515,7 +1515,7 @@ be better for something. :-) Setting C<$/> to an empty string -- the so-called I -- merits special attention. When C<$/> is set to C<""> and the entire file is read in -with that setting, any sequence of consecutive newlines C<"\n\n"> at the +with that setting, any sequence of one or more consecutive newlines at the beginning of the file is discarded. With the exception of the final record in the file, each sequence of characters ending in two or more newlines is treated as one record and is read in to end in exactly two newlines. If the From 33786e4c73dd9562bcdee8a12fba6bb17510764f Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Fri, 20 Nov 2020 15:57:25 -0800 Subject: [PATCH 106/503] add extra language in the quotemeta() docs for embedded \ and $ One paragraph was lifted from perlop.pod, and the other from perlre.pod. --- pod/perlfunc.pod | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index 9f0c8208a020..d1c2ffaba47b 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -6149,6 +6149,18 @@ Will both leave the sentence as is. Normally, when accepting literal string input from the user, L|/quotemeta EXPR> or C<\Q> must be used. +Beware that if you put literal backslashes (those not inside +interpolated variables) between C<\Q> and C<\E>, double-quotish +backslash interpolation may lead to confusing results. If you +I to use literal backslashes within C<\Q...\E>, +consult L. + +Because the result of S \E">> has all metacharacters +quoted, there is no way to insert a literal C<$> or C<@> inside a +C<\Q\E> pair. If protected by C<\>, C<$> will be quoted to become +C<"\\\$">; if not, it is interpreted as the start of an interpolated +scalar. + In Perl v5.14, all non-ASCII characters are quoted in non-UTF-8-encoded strings, but not quoted in UTF-8 strings. From 52f0fcf7f01b33490cb4d9804cd6405b3a3187d2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:17:19 -0600 Subject: [PATCH 107/503] perlapi: Consolidate SvREFCNT_INC-ish entries --- sv.h | 55 +++++++++++++++++++++++++++---------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) diff --git a/sv.h b/sv.h index 7589d707e266..ac7d8df5ea09 100644 --- a/sv.h +++ b/sv.h @@ -281,44 +281,43 @@ Returns the value of the object's reference count. Exposed to perl code via Internals::SvREFCNT(). =for apidoc SvREFCNT_inc -Increments the reference count of the given SV, returning the SV. +=for apidoc_item SvREFCNT_inc_NN +=for apidoc_item SvREFCNT_inc_void +=for apidoc_item |void|SvREFCNT_inc_void_NN|SV* sv +=for apidoc_item |SV*|SvREFCNT_inc_simple|SV* sv +=for apidoc_item |SV*|SvREFCNT_inc_simple_NN|SV* sv +=for apidoc_item |void|SvREFCNT_inc_simple_void|SV* sv +=for apidoc_item |void|SvREFCNT_inc_simple_void_NN|SV* sv -All of the following C* are optimized versions of -C, and can be replaced with C. +These all increment the reference count of the given SV. +The ones without C in their names return the SV. -=for apidoc SvREFCNT_inc_NN -Same as C, but can only be used if you know C -is not C. Since we don't have to check the NULLness, it's faster -and smaller. +C is the base operation; the rest are optimizations if various +input constraints are known to be true; hence, all can be replaced with +C. + +C can only be used if you know C is not C. Since we +don't have to check the NULLness, it's faster and smaller. -=for apidoc SvREFCNT_inc_void -Same as C, but can only be used if you don't need the +C can only be used if you don't need the return value. The macro doesn't need to return a meaningful value. -=for apidoc Am|void|SvREFCNT_inc_void_NN|SV* sv -Same as C, but can only be used if you don't need the return -value, and you know that C is not C. The macro doesn't need -to return a meaningful value, or check for NULLness, so it's smaller -and faster. +C can only be used if you both don't need the return +value, and you know that C is not C. The macro doesn't need to +return a meaningful value, or check for NULLness, so it's smaller and faster. -=for apidoc Am|SV*|SvREFCNT_inc_simple|SV* sv -Same as C, but can only be used with expressions without side +C can only be used with expressions without side effects. Since we don't have to store a temporary value, it's faster. -=for apidoc Am|SV*|SvREFCNT_inc_simple_NN|SV* sv -Same as C, but can only be used if you know C -is not C. Since we don't have to check the NULLness, it's faster -and smaller. +C can only be used with expressions without side +effects and you know C is not C. Since we don't have to store a +temporary value, nor check for NULLness, it's faster and smaller. -=for apidoc Am|void|SvREFCNT_inc_simple_void|SV* sv -Same as C, but can only be used if you don't need the -return value. The macro doesn't need to return a meaningful value. +C can only be used with expressions without side +effects and you don't need the return value. -=for apidoc Am|void|SvREFCNT_inc_simple_void_NN|SV* sv -Same as C, but can only be used if you don't need the return -value, and you know that C is not C. The macro doesn't need -to return a meaningful value, or check for NULLness, so it's smaller -and faster. +C can only be used with expressions without side +effects, you don't need the return value, and you know C is not C. =for apidoc SvREFCNT_dec Decrements the reference count of the given SV. C may be C. From e926558e32f7c35e244a99ae9b8bf0cbd90bcf03 Mon Sep 17 00:00:00 2001 From: David Cantrell Date: Mon, 27 Jan 2020 16:02:05 +0000 Subject: [PATCH 108/503] Add -negative import args for 'use warnings' --- lib/warnings.pm | 62 +++++++++++++++++++++++++++++++++++++++------ regen/warnings.pl | 62 +++++++++++++++++++++++++++++++++++++++------ t/lib/warnings/2use | 51 +++++++++++++++++++++++++++++++++++++ 3 files changed, 159 insertions(+), 16 deletions(-) diff --git a/lib/warnings.pm b/lib/warnings.pm index 595792cd8e7e..6f3420b8dd67 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = "1.48"; +our $VERSION = "1.49"; # Verify that we're called correctly so that warnings will work. # Can't use Carp, since Carp uses us! @@ -335,16 +335,24 @@ sub bits sub import { - shift; - - my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ; + my $invocant = shift; # append 'all' when implied (empty import list or after a lone # "FATAL" or "NONFATAL") push @_, 'all' - if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL')); - - ${^WARNING_BITS} = _bits($mask, @_); + if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL')); + + my @fatal = (); + foreach my $warning (@_) { + if($warning =~ /^(NON)?FATAL$/) { + @fatal = ($warning); + } elsif(substr($warning, 0, 1) ne '-') { + my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ; + ${^WARNING_BITS} = _bits($mask, @fatal, $warning); + } else { + $invocant->unimport(substr($warning, 1)); + } + } } sub unimport @@ -571,7 +579,10 @@ warnings - Perl pragma to control optional warnings no warnings; use warnings "all"; - no warnings "all"; + no warnings "uninitialized"; + + # or equivalent to those last two ... + use warnings qw(all -uninitialized); use warnings::register; if (warnings::enabled()) { @@ -658,6 +669,41 @@ be reported for the C<$x> variable. Note that neither the B<-w> flag or the C<$^W> can be used to disable/enable default warnings. They are still mandatory in this case. +=head2 "Negative warnings" + +As a convenience, you can (as of Perl 5.34) pass arguments to the +C method both positively and negatively. Negative warnings +are those with a C<-> sign prepended to their names; positive warnings +are anything else. This lets you turn on some warnings and turn off +others in one command. So, assuming that you've already turned on a +bunch of warnings but want to tweak them a bit in some block, you can +do this: + + { + use warnings qw(uninitialized -redefine); + ... + } + +which is equivalent to: + + { + use warnings qw(uninitialized); + no warnings qw(redefine); + ... + } + +The argument list is processed in the order you specify. So, for example, if you +don't want to be warned about use of experimental features, except for C +that you really dislike, you can say this: + + use warnings qw(all -experimental experimental::somefeature); + +which is equivalent to: + + use warnings 'all'; + no warnings 'experimental'; + use warnings 'experimental::somefeature'; + =head2 What's wrong with B<-w> and C<$^W> Although very useful, the big problem with using B<-w> on the command diff --git a/regen/warnings.pl b/regen/warnings.pl index cf079746935e..498b93e2854b 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.48'; +$VERSION = '1.49'; BEGIN { require './regen/regen_lib.pl'; @@ -639,16 +639,24 @@ sub bits sub import { - shift; - - my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ; + my $invocant = shift; # append 'all' when implied (empty import list or after a lone # "FATAL" or "NONFATAL") push @_, 'all' - if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL')); - - ${^WARNING_BITS} = _bits($mask, @_); + if !@_ || (@_==1 && ($_[0] eq 'FATAL' || $_[0] eq 'NONFATAL')); + + my @fatal = (); + foreach my $warning (@_) { + if($warning =~ /^(NON)?FATAL$/) { + @fatal = ($warning); + } elsif(substr($warning, 0, 1) ne '-') { + my $mask = ${^WARNING_BITS} // ($^W ? $Bits{all} : $DEFAULT) ; + ${^WARNING_BITS} = _bits($mask, @fatal, $warning); + } else { + $invocant->unimport(substr($warning, 1)); + } + } } sub unimport @@ -875,7 +883,10 @@ =head1 SYNOPSIS no warnings; use warnings "all"; - no warnings "all"; + no warnings "uninitialized"; + + # or equivalent to those last two ... + use warnings qw(all -uninitialized); use warnings::register; if (warnings::enabled()) { @@ -962,6 +973,41 @@ =head2 Default Warnings and Optional Warnings Note that neither the B<-w> flag or the C<$^W> can be used to disable/enable default warnings. They are still mandatory in this case. +=head2 "Negative warnings" + +As a convenience, you can (as of Perl 5.34) pass arguments to the +C method both positively and negatively. Negative warnings +are those with a C<-> sign prepended to their names; positive warnings +are anything else. This lets you turn on some warnings and turn off +others in one command. So, assuming that you've already turned on a +bunch of warnings but want to tweak them a bit in some block, you can +do this: + + { + use warnings qw(uninitialized -redefine); + ... + } + +which is equivalent to: + + { + use warnings qw(uninitialized); + no warnings qw(redefine); + ... + } + +The argument list is processed in the order you specify. So, for example, if you +don't want to be warned about use of experimental features, except for C +that you really dislike, you can say this: + + use warnings qw(all -experimental experimental::somefeature); + +which is equivalent to: + + use warnings 'all'; + no warnings 'experimental'; + use warnings 'experimental::somefeature'; + =head2 What's wrong with B<-w> and C<$^W> Although very useful, the big problem with using B<-w> on the command diff --git a/t/lib/warnings/2use b/t/lib/warnings/2use index 4df98e2baa63..f66b758a5844 100644 --- a/t/lib/warnings/2use +++ b/t/lib/warnings/2use @@ -79,6 +79,57 @@ EXPECT Useless use of a constant ("foobar") in void context at - line 3. ######## +# Check -negative import with no other args +use warnings qw(-syntax); +sub foo { 'foo' } +my $a =+ 1 ; # syntax: shouldn't warn, it was never turned on +*foo = sub { 'bar' }; # redefine: shouldn't warn, it was never turned on +$a = 'foo' . undef; # uninitialized: shouldn't warn, it was never turned on +EXPECT +######## + +# Check -negative import after turning all warnings on +use warnings qw(all -syntax); +sub foo { 'foo' } +my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off +*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'all' +$a = 'foo' . undef; # uninitialized: should warn, as there was an explicit 'all' +EXPECT +Subroutine main::foo redefined at - line 6. +Use of uninitialized value in concatenation (.) or string at - line 7. +######## + +# Check -negative import with an explicit import +use warnings qw(redefine -syntax); +sub foo { 'foo' } +my $a =+ 1 ; # syntax: shouldn't warn, it was never turned on +*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'redefine' +$a = 'foo' . undef; # uninitialized: shouldn't warn, as explicit 'redefine' means no implicit 'all' +EXPECT +Subroutine main::foo redefined at - line 6. +######## + +# Check multiple -negative imports +use warnings qw(all -syntax -uninitialized); +sub foo { 'foo' } +my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off +*foo = sub { 'bar' }; # redefine: should warn, as there was an explicit 'all' +$a = 'foo' . undef; # uninitialized: shouldn't warn, we've turned it off +EXPECT +Subroutine main::foo redefined at - line 6. +######## + +# Check mixed list of +ve and -ve imports +use warnings qw(all -once -syntax parenthesis); +sub foo { 'foo' } +*foo = sub { 'bar' }; # redefined: should warn, as it was turned on by 'all' +my $a =+ 1 ; # syntax: shouldn't warn, we've turned that off +my $foo, $bar = @_; # parenthesis: should warn, as we turned that back on after disabling 'syntax' +EXPECT +Parentheses missing around "my" list at - line 7. +Subroutine main::foo redefined at - line 5. +######## + --FILE-- abc my $a =+ 1 ; 1; From c2b527b3ea8007dff526018f2f60dba8ff99b294 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:20:45 -0600 Subject: [PATCH 109/503] perlapi: Consolidate SvPVX-ish entries --- sv.h | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) diff --git a/sv.h b/sv.h index ac7d8df5ea09..d8ace323c961 100644 --- a/sv.h +++ b/sv.h @@ -781,14 +781,26 @@ Returns the raw value in the SV's NV slot, without checks or conversions. Only use when you are sure C is true. See also C>. =for apidoc Am|char*|SvPVX|SV* sv -Returns a pointer to the physical string in the SV. The SV must contain a -string. Prior to 5.9.3 it is not safe -to execute this macro unless the SV's +=for apidoc_item |char*|SvPVXx|SV* sv +=for apidoc_item |const char*|SvPVX_const|SV* sv +=for apidoc_item |char*|SvPVX_mutable|SV* sv + +These return a pointer to the physical string in the SV. The SV must contain a +string. Prior to 5.9.3 it is not safe to execute these unless the SV's type >= C. -This is also used to store the name of an autoloaded subroutine in an XS +These are also used to store the name of an autoloaded subroutine in an XS AUTOLOAD routine. See L. +C is identical to C. + +C is merely a synonym for C, but its name emphasizes that +the string is modifiable by the caller. + +C differs in that the return value has been cast so that the +compiler will complain if you were to try to modify the contents of the string, +(unless you cast away const yourself). + =for apidoc Am|STRLEN|SvCUR|SV* sv Returns the length of the string which is in the SV. See C>. From 1d6cadf136bf2c85058a5359fb48b09b3ea9fe6f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 07:04:41 -0600 Subject: [PATCH 110/503] op.h: Restrict to core certain internal symbols so that they aren't accessible to XS code and won't be picked up by autodoc --- op.h | 51 +++++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/op.h b/op.h index 975071756240..b7d762a52931 100644 --- a/op.h +++ b/op.h @@ -458,30 +458,31 @@ struct loop { #define cCOP cCOPx(PL_op) #define cLOOP cLOOPx(PL_op) -#define cUNOPo cUNOPx(o) -#define cUNOP_AUXo cUNOP_AUXx(o) -#define cBINOPo cBINOPx(o) -#define cLISTOPo cLISTOPx(o) -#define cLOGOPo cLOGOPx(o) -#define cPMOPo cPMOPx(o) -#define cSVOPo cSVOPx(o) -#define cPADOPo cPADOPx(o) -#define cPVOPo cPVOPx(o) -#define cCOPo cCOPx(o) -#define cLOOPo cLOOPx(o) - -#define kUNOP cUNOPx(kid) -#define kUNOP_AUX cUNOP_AUXx(kid) -#define kBINOP cBINOPx(kid) -#define kLISTOP cLISTOPx(kid) -#define kLOGOP cLOGOPx(kid) -#define kPMOP cPMOPx(kid) -#define kSVOP cSVOPx(kid) -#define kPADOP cPADOPx(kid) -#define kPVOP cPVOPx(kid) -#define kCOP cCOPx(kid) -#define kLOOP cLOOPx(kid) - +#if defined(PERL_CORE) || defined(PERL_EXT) +# define cUNOPo cUNOPx(o) +# define cUNOP_AUXo cUNOP_AUXx(o) +# define cBINOPo cBINOPx(o) +# define cLISTOPo cLISTOPx(o) +# define cLOGOPo cLOGOPx(o) +# define cPMOPo cPMOPx(o) +# define cSVOPo cSVOPx(o) +# define cPADOPo cPADOPx(o) +# define cPVOPo cPVOPx(o) +# define cCOPo cCOPx(o) +# define cLOOPo cLOOPx(o) + +# define kUNOP cUNOPx(kid) +# define kUNOP_AUX cUNOP_AUXx(kid) +# define kBINOP cBINOPx(kid) +# define kLISTOP cLISTOPx(kid) +# define kLOGOP cLOGOPx(kid) +# define kPMOP cPMOPx(kid) +# define kSVOP cSVOPx(kid) +# define kPADOP cPADOPx(kid) +# define kPVOP cPVOPx(kid) +# define kCOP cCOPx(kid) +# define kLOOP cLOOPx(kid) +#endif typedef enum { OPclass_NULL, /* 0 */ @@ -526,12 +527,14 @@ typedef enum { #define cMETHOPx_meth(v) cSVOPx_sv(v) +#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) #define cGVOP_gv cGVOPx_gv(PL_op) #define cGVOPo_gv cGVOPx_gv(o) #define kGVOP_gv cGVOPx_gv(kid) #define cSVOP_sv cSVOPx_sv(PL_op) #define cSVOPo_sv cSVOPx_sv(o) #define kSVOP_sv cSVOPx_sv(kid) +#endif #ifndef PERL_CORE # define Nullop ((OP*)NULL) From b0312014d6c1804920d2b687a5fa5645b445ce9f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 7 Mar 2020 12:54:19 -0700 Subject: [PATCH 111/503] DynaLoader: use PerlEnv_getenv() Doing so invokes thread-safe guards --- ext/DynaLoader/DynaLoader_pm.PL | 2 +- ext/DynaLoader/dlutils.c | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index 86a1128f2622..f68d59aa7ebe 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -88,7 +88,7 @@ package DynaLoader; # Tim.Bunce@ig.co.uk, August 1994 BEGIN { - $VERSION = '1.48'; + $VERSION = '1.49'; } EOT diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 8584f89e6bba..1a27fbdd207d 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -115,7 +115,7 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ #endif #if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) - if ( (perl_dl_nonlazy = getenv("PERL_DL_NONLAZY")) != NULL + if ( (perl_dl_nonlazy = PerlEnv_getenv("PERL_DL_NONLAZY")) != NULL && grok_atoUV(perl_dl_nonlazy, &uv, NULL) && uv <= INT_MAX ) { From b29c03aee096d5715db9fbc42b62edd094c513e9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Sep 2020 22:18:06 -0600 Subject: [PATCH 112/503] perlapi: Consolidate svREFCNT_dec-ish entries --- sv.h | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/sv.h b/sv.h index d8ace323c961..2aae6b63b89d 100644 --- a/sv.h +++ b/sv.h @@ -320,12 +320,11 @@ C can only be used with expressions without side effects, you don't need the return value, and you know C is not C. =for apidoc SvREFCNT_dec -Decrements the reference count of the given SV. C may be C. +=for apidoc_item SvREFCNT_dec_NN -=for apidoc SvREFCNT_dec_NN -Same as C, but can only be used if you know C -is not C. Since we don't have to check the NULLness, it's faster -and smaller. +These decrement the reference count of the given SV. + +C may only be used when C is known to not be C. =for apidoc Am|svtype|SvTYPE|SV* sv Returns the type of the SV. See C>. From 055663bc9d17f8e2ef5ef0a4233d89dd4a69d2a2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 7 Oct 2020 13:22:54 -0600 Subject: [PATCH 113/503] INSTALL: Fix grammar/typos --- INSTALL | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/INSTALL b/INSTALL index 6f674eb1c517..ce38af0b8a64 100644 --- a/INSTALL +++ b/INSTALL @@ -371,7 +371,7 @@ although from time to time we change which functions we support, and which function is default (currently SBOX+STADTX on 64 bit builds and SBOX+ZAPHOD32 for 32 bit builds). You can choose a different algorithm by defining one of the following symbols during configure. -Note that there security implications of which hash function you choose +Note that there are security implications regarding which hash function you choose to use. The functions are listed roughly by how secure they are believed to be, with the one believed to be most secure at release time being PERL_HASH_FUNC_SIPHASH. @@ -388,10 +388,10 @@ and which has rather expensive setup costs (relatively speaking), both in terms of performance and more importantly in terms of memory. SBOX32 requires 1k of storage per character it can hash, and it must populate that storage with 256 32-bit random values as well. In practice the RNG we use -for seeding the SBOX32 storage is very efficient and populating the table +for seeding the SBOX32 storage is very efficient, and populating the table required for hashing even fairly long keys is negligible as we only do it -during startup. By default we build with SBOX32 enabled, but you change that -by setting +during startup. By default we build with SBOX32 enabled, but you can change +that by setting PERL_HASH_USE_SBOX32_ALSO From a0412c00a8c16af0955edebcaf0d271542c97582 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 06:43:55 -0600 Subject: [PATCH 114/503] cop.h: Extend core-only portion This encloses some #defines in a PERL_CORE section, as their only use is in the macro immediately following, already confined to core. --- cop.h | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/cop.h b/cop.h index 17df8b566389..0ddcd48f8970 100644 --- a/cop.h +++ b/cop.h @@ -818,6 +818,9 @@ struct subst { void * sbu_rxres; REGEXP * sbu_rx; }; + +#ifdef PERL_CORE + #define sb_iters cx_u.cx_subst.sbu_iters #define sb_maxiters cx_u.cx_subst.sbu_maxiters #define sb_rflags cx_u.cx_subst.sbu_rflags @@ -831,7 +834,6 @@ struct subst { #define sb_rxres cx_u.cx_subst.sbu_rxres #define sb_rx cx_u.cx_subst.sbu_rx -#ifdef PERL_CORE # define CX_PUSHSUBST(cx) CXINC, cx = CX_CUR(), \ cx->blk_oldsaveix = oldsave, \ cx->sb_iters = iters, \ From b33c3c199a4d1a7f93b3afad435f77c0ff4988ba Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 24 Nov 2020 21:27:43 +0100 Subject: [PATCH 115/503] restore compatibility with old versions of ExtUtils::ParseXS ExtUtils::ParseXS used to include a function called "errors", which was documented. In was renamed to report_error_count in version 3.01 (perl 5.15.1) although the documentation wasn't fixed until 3.21 (perl 5.19.2). As a documented function, this is a backwards compatibility issue. It is possible for this to lead to errors when installing modules from CPAN. If you are using the version of ExtUtils::ParseXS that comes with core, between running the Makefile.PL and make, fulfilling prereqs can result in upgrading ExtUtils::ParseXS. When Makefile.PL is run, the generated Makefile gets the full path to xsubpp saved in it. Then when upgraded from CPAN, ExtUtils::ParseXS and xsubpp will be in a new location (site_perl or a local::lib). Running make will run the old xsubpp, but it will then try to use the new ExtUtils::ParseXS which has broken compatibility. Restore the errors function as a compatibility shim to fix this. --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 2 ++ 1 file changed, 2 insertions(+) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 18ed08f7c8a3..106883a2ac50 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -42,6 +42,7 @@ use ExtUtils::ParseXS::Utilities qw( our @EXPORT_OK = qw( process_file report_error_count + errors ); ############################## @@ -1012,6 +1013,7 @@ sub report_error_count { return $Singleton->{errors}||0; } } +*errors = \&report_error_count; # Input: ($self, $_, @{ $self->{line} }) == unparsed input. # Output: ($_, @{ $self->{line} }) == (rest of line, following lines). From 4813a67cfbaf83931da40e8d5e2fc18fd7ea9e1b Mon Sep 17 00:00:00 2001 From: Graham Knop Date: Tue, 24 Nov 2020 21:42:05 +0100 Subject: [PATCH 116/503] bump version of ExtUtils::ParseXS --- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm | 2 +- dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm index 106883a2ac50..39f9df933b66 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS.pm @@ -11,7 +11,7 @@ use Symbol; our $VERSION; BEGIN { - $VERSION = '3.41'; + $VERSION = '3.42'; require ExtUtils::ParseXS::Constants; ExtUtils::ParseXS::Constants->VERSION($VERSION); require ExtUtils::ParseXS::CountLines; ExtUtils::ParseXS::CountLines->VERSION($VERSION); require ExtUtils::ParseXS::Utilities; ExtUtils::ParseXS::Utilities->VERSION($VERSION); diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm index a972b63da7a1..869836c37f7a 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Constants.pm @@ -3,7 +3,7 @@ use strict; use warnings; use Symbol; -our $VERSION = '3.41'; +our $VERSION = '3.42'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm index bb6450e457bd..57aa90d90f7e 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/CountLines.pm @@ -1,7 +1,7 @@ package ExtUtils::ParseXS::CountLines; use strict; -our $VERSION = '3.41'; +our $VERSION = '3.42'; our $SECTION_END_MARKER; diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm index 97aea542cd98..45c4ba167295 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Eval.pm @@ -2,7 +2,7 @@ package ExtUtils::ParseXS::Eval; use strict; use warnings; -our $VERSION = '3.41'; +our $VERSION = '3.42'; =head1 NAME diff --git a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm index 37b89deed5ed..faf53cbc74f5 100644 --- a/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm +++ b/dist/ExtUtils-ParseXS/lib/ExtUtils/ParseXS/Utilities.pm @@ -5,7 +5,7 @@ use Exporter; use File::Spec; use ExtUtils::ParseXS::Constants (); -our $VERSION = '3.41'; +our $VERSION = '3.42'; our (@ISA, @EXPORT_OK); @ISA = qw(Exporter); From fb85716223db49723bdef4aa9bb48d063fde98e5 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 11:03:44 -0600 Subject: [PATCH 117/503] Document SvSHARED_HASH --- sv.h | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/sv.h b/sv.h index 2aae6b63b89d..f753a94889e7 100644 --- a/sv.h +++ b/sv.h @@ -1925,6 +1925,12 @@ scalar. #define SvSHARED_HEK_FROM_PV(pvx) \ ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key))) +/* +=for apidoc Am|struct hek*|SvSHARED_HASH|SV * sv +Returns the hash for C created by C>. + +=cut +*/ #define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash) /* flag values for sv_*_flags functions */ From c2454cf4ab65969c7412dafa4c6fc9572a5fb5f9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 07:18:16 -0600 Subject: [PATCH 118/503] opcode.h: Restrict scope of internal variables to core --- opcode.h | 5 +++++ regen/opcode.pl | 3 +++ 2 files changed, 8 insertions(+) diff --git a/opcode.h b/opcode.h index c754a6401524..7c708e402ed5 100644 --- a/opcode.h +++ b/opcode.h @@ -13,6 +13,8 @@ * Any changes made here will be lost! */ +#if defined(PERL_CORE) || defined(PERL_EXT) + #define Perl_pp_scalar Perl_pp_null #define Perl_pp_padany Perl_unimplemented_op #define Perl_pp_regcmaybe Perl_pp_null @@ -138,6 +140,9 @@ #define Perl_pp_sgrent Perl_pp_ehostent #define Perl_pp_egrent Perl_pp_ehostent #define Perl_pp_custom Perl_unimplemented_op + +#endif /* End of if defined(PERL_CORE) || defined(PERL_EXT) */ + START_EXTERN_C #ifndef DOINIT diff --git a/regen/opcode.pl b/regen/opcode.pl index cbd2979d0ced..df66201e9ec1 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -17,6 +17,7 @@ # This script is normally invoked from regen.pl. use strict; +my $restrict_to_core = "if defined(PERL_CORE) || defined(PERL_EXT)"; BEGIN { # Get function prototypes @@ -917,6 +918,7 @@ package main; #use Data::Dumper; #print Dumper \%LABELS, \%DEFINES, \%FLAGS, \%BITFIELDS; +print $oc "#$restrict_to_core\n\n"; # Emit defines. @@ -954,6 +956,7 @@ package main; # If the last op was conditional, we need to close it out: unimplemented(); } +print $oc "\n#endif /* End of $restrict_to_core */\n\n"; print $on "typedef enum opcode {\n"; From add0fa588474394597ad4b9734b2d1646a7b225e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 29 Aug 2020 10:55:02 -0600 Subject: [PATCH 119/503] Document various CopFILEfoo functions --- cop.h | 26 ++++++++++++++++++++++++++ embed.fnc | 4 ++++ proto.h | 4 ++++ 3 files changed, 34 insertions(+) diff --git a/cop.h b/cop.h index 0ddcd48f8970..96b6739b1914 100644 --- a/cop.h +++ b/cop.h @@ -423,6 +423,32 @@ struct cop { U32 cop_features; }; +/* +=for apidoc Am|const char *|CopFILE|const COP * c +Returns the name of the file associated with the C C + +=for apidoc Am|STRLEN|CopLINE|const COP * c +Returns the line number in the source code associated with the C C + +=for apidoc Am|AV *|CopFILEAV|const COP * c +Returns the AV associated with the C C + +=for apidoc Am|SV *|CopFILESV|const COP * c +Returns the SV associated with the C C + +=for apidoc Am|void|CopFILE_set|COP * c|const char * pv +Makes C the name of the file associated with the C C + +=for apidoc Am|GV *|CopFILEGV|const COP * c +Returns the GV associated with the C C + +=for apidoc CopFILEGV_set +Available only on unthreaded perls. Makes C the name of the file +associated with the C C + +=cut +*/ + #ifdef USE_ITHREADS # define CopFILE(c) ((c)->cop_file) # define CopFILEGV(c) (CopFILE(c) \ diff --git a/embed.fnc b/embed.fnc index 3eb6dc7a3074..ff98258ef831 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3660,4 +3660,8 @@ XEop |void |dtrace_probe_phase|enum perl_phase phase XEop |STRLEN*|dup_warnings |NULLOK STRLEN* warnings +#ifndef USE_ITHREADS +Amd |void |CopFILEGV_set |NN COP * c|NN GV * gv +#endif + : ex: set ts=8 sts=4 sw=4 noet: diff --git a/proto.h b/proto.h index e886261db49c..46ce0761d82e 100644 --- a/proto.h +++ b/proto.h @@ -4483,6 +4483,10 @@ STATIC void S_validate_suid(pTHX_ PerlIO *rsfp); assert(rsfp) # endif #endif +#if !defined(USE_ITHREADS) +/* PERL_CALLCONV void CopFILEGV_set(pTHX_ COP * c, GV * gv); */ +#define PERL_ARGS_ASSERT_COPFILEGV_SET +#endif #if !defined(UV_IS_QUAD) # if defined(PERL_IN_UTF8_C) STATIC int S_is_utf8_cp_above_31_bits(const U8 * const s, const U8 * const e, const bool consider_overlongs) From c1ec4bdd803f587dd2ae76548bca0ae59d0fe84b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 20:55:30 -0700 Subject: [PATCH 120/503] Account for 'less' reserving an extra column After decades of stability, the 'less' pager project decided to claim an extra column for its own use when called with certain common options. This commit changes some of the auto-generating tools to wrap one column earlier to compensate, and changes podcheck to also whine on wide verbatim text one column less. But it changes the podcheck data base to grandfather-in all the many existing places that exceed that amount. That means only changes made to pods after this commit will be held to the stricter value. Of course, what this means is those pods will wrap or truncate in these places on an 80 column window, making them harder to read, when used with 'less' and when it is called with the options that reserve those two columns. Patches welcome. I haven't seen the wrapping problem with perldoc, and haven't investigated much. --- autodoc.pl | 4 +- regen/regcomp.pl | 5 +- regnodes.h | 118 ++++++++++++----------- t/porting/known_pod_issues.dat | 167 +++++++++++++++++++++++++++------ t/porting/podcheck.t | 6 +- 5 files changed, 208 insertions(+), 92 deletions(-) diff --git a/autodoc.pl b/autodoc.pl index 9df6266a9eb4..06361b8f25dd 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -66,9 +66,9 @@ use strict; use warnings; -# 80 column terminal - 1 for pager adding a column; -7 for nroff +# 80 column terminal - 2 for pager adding 2 columns; -7 for nroff # indent; -my $max_width = 80 - 1 - 7; +my $max_width = 80 - 2 - 7; if (@ARGV) { my $workdir = shift; diff --git a/regen/regcomp.pl b/regen/regcomp.pl index 34e7ec8e39eb..4994a8bcf15b 100644 --- a/regen/regcomp.pl +++ b/regen/regcomp.pl @@ -397,9 +397,10 @@ sub print_state_def_line my $hanging = length $line; # Indent any subsequent line to this pos $line .= sprintf "0x%02x", $id; - my $columns = 79; + my $columns = 78; - # wrap() needs 80 to achieve 79. + # From the documentation: 'In fact, every resulting line will have length + # of no more than "$columns - 1"' $line = wrap($columns + 1, "", " " x $hanging, "$line $comment"); chomp $line; # wrap always adds a trailing \n $line =~ s/ \s+ $ //x; # trim, just in case. diff --git a/regnodes.h b/regnodes.h index 98de0bb73350..94b71102eb3b 100644 --- a/regnodes.h +++ b/regnodes.h @@ -102,8 +102,9 @@ #define BOUNDL_t8_pb 38 /* 0x026 */ #define BOUNDL_t8_p8 39 /* 0x027 */ -#define BOUNDU 10 /* 0x0a Match "" at any boundary of - a given type using /u rules. */ +#define BOUNDU 10 /* 0x0a Match "" at any boundary + of a given type using /u rules. + */ #define BOUNDU_tb_pb 40 /* 0x028 */ #define BOUNDU_tb_p8 41 /* 0x029 */ #define BOUNDU_t8_pb 42 /* 0x02a */ @@ -124,9 +125,9 @@ #define NBOUND_t8_pb 50 /* 0x032 */ #define NBOUND_t8_p8 51 /* 0x033 */ -#define NBOUNDL 13 /* 0x0d Like NBOUND/NBOUNDU, but \w - and \W are defined by current - locale */ +#define NBOUNDL 13 /* 0x0d Like NBOUND/NBOUNDU, but + \w and \W are defined by + current locale */ #define NBOUNDL_tb_pb 52 /* 0x034 */ #define NBOUNDL_tb_p8 53 /* 0x035 */ #define NBOUNDL_t8_pb 54 /* 0x036 */ @@ -155,7 +156,8 @@ #define REG_ANY_t8_pb 66 /* 0x042 */ #define REG_ANY_t8_p8 67 /* 0x043 */ -#define SANY 17 /* 0x11 Match any one character. */ +#define SANY 17 /* 0x11 Match any one character. + */ #define SANY_tb_pb 68 /* 0x044 */ #define SANY_tb_p8 69 /* 0x045 */ #define SANY_t8_pb 70 /* 0x046 */ @@ -192,9 +194,9 @@ #define ANYOFH 22 /* 0x16 Like ANYOF, but only has "High" matches, none in the - bitmap; the flags field contains - the lowest matchable UTF-8 start - byte */ + bitmap; the flags field + contains the lowest matchable + UTF-8 start byte */ #define ANYOFH_tb_pb 88 /* 0x058 */ #define ANYOFH_tb_p8 89 /* 0x059 */ #define ANYOFH_t8_pb 90 /* 0x05a */ @@ -210,9 +212,9 @@ #define ANYOFHb_t8_p8 95 /* 0x05f */ #define ANYOFHr 24 /* 0x18 Like ANYOFH, but the flags - field contains packed bounds for - all matchable UTF-8 start bytes. - */ + field contains packed bounds + for all matchable UTF-8 start + bytes. */ #define ANYOFHr_tb_pb 96 /* 0x060 */ #define ANYOFHr_tb_p8 97 /* 0x061 */ #define ANYOFHr_t8_pb 98 /* 0x062 */ @@ -322,8 +324,8 @@ #define NPOSIXA_t8_pb 150 /* 0x096 */ #define NPOSIXA_t8_p8 151 /* 0x097 */ -#define CLUMP 38 /* 0x26 Match any extended grapheme - cluster sequence */ +#define CLUMP 38 /* 0x26 Match any extended + grapheme cluster sequence */ #define CLUMP_tb_pb 152 /* 0x098 */ #define CLUMP_tb_p8 153 /* 0x099 */ #define CLUMP_t8_pb 154 /* 0x09a */ @@ -359,35 +361,37 @@ #define EXACTL_t8_pb 170 /* 0x0aa */ #define EXACTL_t8_p8 171 /* 0x0ab */ -#define EXACTF 43 /* 0x2b Like EXACT, but match using - /id rules; (string not UTF-8, - ASCII folded; non-ASCII not) */ +#define EXACTF 43 /* 0x2b Like EXACT, but match + using /id rules; (string not + UTF-8, ASCII folded; non-ASCII + not) */ #define EXACTF_tb_pb 172 /* 0x0ac */ #define EXACTF_tb_p8 173 /* 0x0ad */ #define EXACTF_t8_pb 174 /* 0x0ae */ #define EXACTF_t8_p8 175 /* 0x0af */ -#define EXACTFL 44 /* 0x2c Like EXACT, but match using - /il rules; (string not likely to - be folded) */ +#define EXACTFL 44 /* 0x2c Like EXACT, but match + using /il rules; (string not + likely to be folded) */ #define EXACTFL_tb_pb 176 /* 0x0b0 */ #define EXACTFL_tb_p8 177 /* 0x0b1 */ #define EXACTFL_t8_pb 178 /* 0x0b2 */ #define EXACTFL_t8_p8 179 /* 0x0b3 */ -#define EXACTFU 45 /* 0x2d Like EXACT, but match using - /iu rules; (string folded) */ +#define EXACTFU 45 /* 0x2d Like EXACT, but match + using /iu rules; (string + folded) */ #define EXACTFU_tb_pb 180 /* 0x0b4 */ #define EXACTFU_tb_p8 181 /* 0x0b5 */ #define EXACTFU_t8_pb 182 /* 0x0b6 */ #define EXACTFU_t8_p8 183 /* 0x0b7 */ -#define EXACTFAA 46 /* 0x2e Like EXACT, but match using - /iaa rules; (string folded - except MICRO in non-UTF8 +#define EXACTFAA 46 /* 0x2e Like EXACT, but match + using /iaa rules; (string + folded except MICRO in non-UTF8 patterns; doesn't contain SHARP - S unless UTF-8; folded length <= - unfolded) */ + S unless UTF-8; folded length + <= unfolded) */ #define EXACTFAA_tb_pb 184 /* 0x0b8 */ #define EXACTFAA_tb_p8 185 /* 0x0b9 */ #define EXACTFAA_t8_pb 186 /* 0x0ba */ @@ -403,10 +407,10 @@ #define EXACTFAA_NO_TRIE_t8_pb 190 /* 0x0be */ #define EXACTFAA_NO_TRIE_t8_p8 191 /* 0x0bf */ -#define EXACTFUP 48 /* 0x30 Like EXACT, but match using - /iu rules; (string not UTF-8, - folded except MICRO: hence - Problematic) */ +#define EXACTFUP 48 /* 0x30 Like EXACT, but match + using /iu rules; (string not + UTF-8, folded except MICRO: + hence Problematic) */ #define EXACTFUP_tb_pb 192 /* 0x0c0 */ #define EXACTFUP_tb_p8 193 /* 0x0c1 */ #define EXACTFUP_t8_pb 194 /* 0x0c2 */ @@ -414,7 +418,8 @@ #define EXACTFLU8 49 /* 0x31 Like EXACTFU, but use /il, UTF-8, (string is folded, and - everything in it is above 255 */ + everything in it is above 255 + */ #define EXACTFLU8_tb_pb 196 /* 0x0c4 */ #define EXACTFLU8_tb_p8 197 /* 0x0c5 */ #define EXACTFLU8_t8_pb 198 /* 0x0c6 */ @@ -427,8 +432,9 @@ #define EXACT_REQ8_t8_pb 202 /* 0x0ca */ #define EXACT_REQ8_t8_p8 203 /* 0x0cb */ -#define LEXACT_REQ8 51 /* 0x33 Like LEXACT, but only UTF-8 - encoded targets can match */ +#define LEXACT_REQ8 51 /* 0x33 Like LEXACT, but only + UTF-8 encoded targets can match + */ #define LEXACT_REQ8_tb_pb 204 /* 0x0cc */ #define LEXACT_REQ8_tb_p8 205 /* 0x0cd */ #define LEXACT_REQ8_t8_pb 206 /* 0x0ce */ @@ -445,7 +451,8 @@ #define EXACTFU_S_EDGE 53 /* 0x35 /di rules, but nothing in it precludes /ui, except begins and/or ends with [Ss]; (string - not UTF-8; compile-time only) */ + not UTF-8; compile-time only) + */ #define EXACTFU_S_EDGE_tb_pb 212 /* 0x0d4 */ #define EXACTFU_S_EDGE_tb_p8 213 /* 0x0d5 */ #define EXACTFU_S_EDGE_t8_pb 214 /* 0x0d6 */ @@ -498,15 +505,15 @@ #define TAIL_t8_pb 242 /* 0x0f2 */ #define TAIL_t8_p8 243 /* 0x0f3 */ -#define STAR 61 /* 0x3d Match this (simple) thing 0 - or more times. */ +#define STAR 61 /* 0x3d Match this (simple) thing + 0 or more times. */ #define STAR_tb_pb 244 /* 0x0f4 */ #define STAR_tb_p8 245 /* 0x0f5 */ #define STAR_t8_pb 246 /* 0x0f6 */ #define STAR_t8_p8 247 /* 0x0f7 */ -#define PLUS 62 /* 0x3e Match this (simple) thing 1 - or more times. */ +#define PLUS 62 /* 0x3e Match this (simple) thing + 1 or more times. */ #define PLUS_tb_pb 248 /* 0x0f8 */ #define PLUS_tb_p8 249 /* 0x0f9 */ #define PLUS_t8_pb 250 /* 0x0fa */ @@ -526,8 +533,9 @@ #define CURLYN_t8_pb 258 /* 0x102 */ #define CURLYN_t8_p8 259 /* 0x103 */ -#define CURLYM 65 /* 0x41 Capture this medium-complex - thing {n,m} times. */ +#define CURLYM 65 /* 0x41 Capture this + medium-complex thing {n,m} + times. */ #define CURLYM_tb_pb 260 /* 0x104 */ #define CURLYM_tb_p8 261 /* 0x105 */ #define CURLYM_t8_pb 262 /* 0x106 */ @@ -540,22 +548,22 @@ #define CURLYX_t8_pb 266 /* 0x10a */ #define CURLYX_t8_p8 267 /* 0x10b */ -#define WHILEM 67 /* 0x43 Do curly processing and see - if rest matches. */ +#define WHILEM 67 /* 0x43 Do curly processing and + see if rest matches. */ #define WHILEM_tb_pb 268 /* 0x10c */ #define WHILEM_tb_p8 269 /* 0x10d */ #define WHILEM_t8_pb 270 /* 0x10e */ #define WHILEM_t8_p8 271 /* 0x10f */ -#define OPEN 68 /* 0x44 Mark this point in input as - start of #n. */ +#define OPEN 68 /* 0x44 Mark this point in input + as start of #n. */ #define OPEN_tb_pb 272 /* 0x110 */ #define OPEN_tb_p8 273 /* 0x111 */ #define OPEN_t8_pb 274 /* 0x112 */ #define OPEN_t8_p8 275 /* 0x113 */ -#define CLOSE 69 /* 0x45 Close corresponding OPEN of - #n. */ +#define CLOSE 69 /* 0x45 Close corresponding OPEN + of #n. */ #define CLOSE_tb_pb 276 /* 0x114 */ #define CLOSE_tb_p8 277 /* 0x115 */ #define CLOSE_t8_pb 278 /* 0x116 */ @@ -650,7 +658,8 @@ #define LONGJMP_t8_pb 330 /* 0x14a */ #define LONGJMP_t8_p8 331 /* 0x14b */ -#define BRANCHJ 83 /* 0x53 BRANCH with long offset. */ +#define BRANCHJ 83 /* 0x53 BRANCH with long offset. + */ #define BRANCHJ_tb_pb 332 /* 0x14c */ #define BRANCHJ_tb_p8 333 /* 0x14d */ #define BRANCHJ_t8_pb 334 /* 0x14e */ @@ -757,15 +766,15 @@ #define ENDLIKE_t8_pb 390 /* 0x186 */ #define ENDLIKE_t8_p8 391 /* 0x187 */ -#define OPFAIL 98 /* 0x62 Same as (?!), but with verb - arg */ +#define OPFAIL 98 /* 0x62 Same as (?!), but with + verb arg */ #define OPFAIL_tb_pb 392 /* 0x188 */ #define OPFAIL_tb_p8 393 /* 0x189 */ #define OPFAIL_t8_pb 394 /* 0x18a */ #define OPFAIL_t8_p8 395 /* 0x18b */ -#define ACCEPT 99 /* 0x63 Accepts the current matched - string, with verbar */ +#define ACCEPT 99 /* 0x63 Accepts the current + matched string, with verbar */ #define ACCEPT_tb_pb 396 /* 0x18c */ #define ACCEPT_tb_p8 397 /* 0x18d */ #define ACCEPT_t8_pb 398 /* 0x18e */ @@ -793,8 +802,9 @@ #define MARKPOINT_t8_pb 410 /* 0x19a */ #define MARKPOINT_t8_p8 411 /* 0x19b */ -#define SKIP 103 /* 0x67 On failure skip forward (to - the mark) before retrying */ +#define SKIP 103 /* 0x67 On failure skip forward + (to the mark) before retrying + */ #define SKIP_tb_pb 412 /* 0x19c */ #define SKIP_tb_p8 413 /* 0x19d */ #define SKIP_t8_pb 414 /* 0x19e */ diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 8eb9fc5f5c11..89664ad769a7 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -369,52 +369,157 @@ XML::LibXML YAML YAML::Syck YAML::Tiny -dist/data-dumper/changes Verbatim line length including indents exceeds 79 by 1 +dist/attribute-handlers/lib/attribute/handlers.pm Verbatim line length including indents exceeds 78 by 2 +dist/base/lib/fields.pm Verbatim line length including indents exceeds 78 by 1 +dist/constant/lib/constant.pm Verbatim line length including indents exceeds 78 by 1 +dist/data-dumper/changes Verbatim line length including indents exceeds 78 by 2 dist/data-dumper/dumper.pm ? Should you be using L<...> instead of 1 +dist/data-dumper/dumper.pm Verbatim line length including indents exceeds 78 by 3 +dist/devel-ppport/devel/buildperl.pl Verbatim line length including indents exceeds 78 by 1 +dist/devel-ppport/hackers Verbatim line length including indents exceeds 78 by 2 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =dontwarn 1 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =implementation 1 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =provides 1 +dist/encoding-warnings/lib/encoding/warnings.pm Verbatim line length including indents exceeds 78 by 1 dist/env/lib/env.pm ? Should you be using F<...> or maybe L<...> instead of 1 -dist/exporter/lib/exporter.pm Verbatim line length including indents exceeds 79 by 2 +dist/exporter/lib/exporter.pm Verbatim line length including indents exceeds 78 by 7 +dist/extutils-parsexs/lib/perlxstut.pod Verbatim line length including indents exceeds 78 by 3 +dist/extutils-parsexs/lib/perlxstypemap.pod Verbatim line length including indents exceeds 78 by 2 +dist/i18n-langtags/lib/i18n/langtags.pm Verbatim line length including indents exceeds 78 by 1 +dist/io/io.pm Verbatim line length including indents exceeds 78 by 1 +dist/io/lib/io/socket/inet.pm Verbatim line length including indents exceeds 78 by 2 +dist/module-corelist/blib/script/corelist Verbatim line length including indents exceeds 78 by 1 +dist/module-corelist/lib/module/corelist.pod Verbatim line length including indents exceeds 78 by 2 dist/net-ping/lib/net/ping.pm Apparent broken link 2 -ext/amiga-exec/exec.pm Verbatim line length including indents exceeds 79 by 1 -ext/dynaloader/dynaloader.pm Verbatim line length including indents exceeds 79 by 1 -ext/hash-util/lib/hash/util.pm Verbatim line length including indents exceeds 79 by 2 -ext/pod-html/testdir/perlpodspec-copy.pod Verbatim line length including indents exceeds 79 by 2 +dist/pathtools/lib/file/spec/mac.pm Verbatim line length including indents exceeds 78 by 4 +dist/pathtools/lib/file/spec/vms.pm Verbatim line length including indents exceeds 78 by 1 +dist/pathtools/lib/file/spec/win32.pm Verbatim line length including indents exceeds 78 by 1 +dist/term-readline/lib/term/readline.pm Verbatim line length including indents exceeds 78 by 2 +dist/test/lib/test.pm Verbatim line length including indents exceeds 78 by 2 +dist/thread-queue/lib/thread/queue.pm Verbatim line length including indents exceeds 78 by 2 +dist/thread-semaphore/lib/thread/semaphore.pm Verbatim line length including indents exceeds 78 by 1 +dist/threads-shared/lib/threads/shared.pm Verbatim line length including indents exceeds 78 by 1 +dist/tie-file/lib/tie/file.pm Verbatim line length including indents exceeds 78 by 1 +dist/unicode-normalize/normalize.pm Verbatim line length including indents exceeds 78 by 1 +ext/amiga-exec/exec.pm Verbatim line length including indents exceeds 78 by 1 +ext/b/b.pm Verbatim line length including indents exceeds 78 by 1 +ext/b/b/concise.pm Verbatim line length including indents exceeds 78 by 1 +ext/dynaloader/dynaloader.pm Verbatim line length including indents exceeds 78 by 1 +ext/file-find/lib/file/find.pm Verbatim line length including indents exceeds 78 by 1 +ext/hash-util-fieldhash/lib/hash/util/fieldhash.pm Verbatim line length including indents exceeds 78 by 1 +ext/hash-util/lib/hash/util.pm Verbatim line length including indents exceeds 78 by 3 +ext/opcode/opcode.pm Verbatim line length including indents exceeds 78 by 1 +ext/pod-html/testdir/perlpodspec-copy.pod Verbatim line length including indents exceeds 78 by 8 ext/pod-html/testdir/perlvar-copy.pod ? Should you be using L<...> instead of 3 -ext/pod-html/testdir/perlvar-copy.pod Verbatim line length including indents exceeds 79 by 6 -ext/vms-filespec/lib/vms/filespec.pm Verbatim line length including indents exceeds 79 by 1 +ext/pod-html/testdir/perlvar-copy.pod Verbatim line length including indents exceeds 78 by 7 +ext/posix/lib/posix.pod Verbatim line length including indents exceeds 78 by 5 +ext/re/re.pm Verbatim line length including indents exceeds 78 by 1 +ext/sdbm_file/sdbm_file.pm Verbatim line length including indents exceeds 78 by 1 +ext/vms-filespec/lib/vms/filespec.pm Verbatim line length including indents exceeds 78 by 1 install ? Should you be using F<...> or maybe L<...> instead of 1 -pod/perl.pod Verbatim line length including indents exceeds 79 by 8 -pod/perlandroid.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlbook.pod Verbatim line length including indents exceeds 79 by 1 -pod/perldebguts.pod Verbatim line length including indents exceeds 79 by -1 -pod/perldebtut.pod Verbatim line length including indents exceeds 79 by 3 -pod/perldtrace.pod Verbatim line length including indents exceeds 79 by 7 +install Verbatim line length including indents exceeds 78 by 9 +installhtml Verbatim line length including indents exceeds 78 by 3 +os2/os2/os2-process/process.pm Verbatim line length including indents exceeds 78 by 8 +os2/os2/os2-rexx/dll/dll.pm Verbatim line length including indents exceeds 78 by 1 +os2/os2/os2-rexx/rexx.pm Verbatim line length including indents exceeds 78 by 1 +pod/perl.pod Verbatim line length including indents exceeds 78 by 8 +pod/perlaix.pod Verbatim line length including indents exceeds 78 by 12 +pod/perlandroid.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlapi.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlapio.pod Verbatim line length including indents exceeds 78 by 5 +pod/perlbook.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlcall.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlclib.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlcygwin.pod Verbatim line length including indents exceeds 78 by 8 +pod/perldata.pod Verbatim line length including indents exceeds 78 by 4 +pod/perldebguts.pod Verbatim line length including indents exceeds 78 by 47 +pod/perldebtut.pod Verbatim line length including indents exceeds 78 by 20 +pod/perldebug.pod Verbatim line length including indents exceeds 78 by 4 +pod/perldiag.pod Verbatim line length including indents exceeds 78 by 6 +pod/perldsc.pod Verbatim line length including indents exceeds 78 by 2 +pod/perldtrace.pod Verbatim line length including indents exceeds 78 by 25 +pod/perlebcdic.pod Verbatim line length including indents exceeds 78 by 31 +pod/perlembed.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlfork.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlfunc.pod Verbatim line length including indents exceeds 78 by 156 pod/perlgit.pod ? Should you be using F<...> or maybe L<...> instead of 1 -pod/perlgit.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlgit.pod Verbatim line length including indents exceeds 78 by 9 +pod/perlgpl.pod Verbatim line length including indents exceeds 78 by 19 pod/perlguts.pod ? Should you be using L<...> instead of 1 +pod/perlguts.pod Verbatim line length including indents exceeds 78 by 10 pod/perlhack.pod ? Should you be using L<...> instead of 1 -pod/perlhack.pod Verbatim line length including indents exceeds 79 by 2 -pod/perlhist.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlhpux.pod Verbatim line length including indents exceeds 79 by 1 +pod/perlhack.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlhacktips.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlhacktut.pod Verbatim line length including indents exceeds 78 by 5 +pod/perlhist.pod Verbatim line length including indents exceeds 78 by 3 +pod/perlhpux.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlhurd.pod Verbatim line length including indents exceeds 78 by 1 pod/perlinterp.pod ? Should you be using L<...> instead of 1 -pod/perlirix.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlmacosx.pod Verbatim line length including indents exceeds 79 by 3 +pod/perlintro.pod Verbatim line length including indents exceeds 78 by 2 +pod/perliol.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlipc.pod Verbatim line length including indents exceeds 78 by 10 +pod/perlirix.pod Verbatim line length including indents exceeds 78 by 2 +pod/perllocale.pod Verbatim line length including indents exceeds 78 by 1 +pod/perllol.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlmacosx.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlmod.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlmodlib.pod Verbatim line length including indents exceeds 78 by 1 pod/perlmroapi.pod ? Should you be using L<...> instead of 1 +pod/perlobj.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlop.pod Verbatim line length including indents exceeds 78 by 18 +pod/perlopentut.pod Verbatim line length including indents exceeds 78 by 1 pod/perlos2.pod ? Should you be using L<...> instead of 2 -pod/perlos2.pod Verbatim line length including indents exceeds 79 by 5 -pod/perlos390.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlperf.pod Verbatim line length including indents exceeds 79 by 114 +pod/perlos2.pod Verbatim line length including indents exceeds 78 by 11 +pod/perlos390.pod Verbatim line length including indents exceeds 78 by 6 +pod/perlpacktut.pod Verbatim line length including indents exceeds 78 by 3 +pod/perlperf.pod Verbatim line length including indents exceeds 78 by 139 +pod/perlpodspec.pod Verbatim line length including indents exceeds 78 by 8 pod/perlport.pod ? Should you be using L<...> instead of 1 -pod/perlrun.pod Verbatim line length including indents exceeds 79 by 3 -pod/perlsolaris.pod Verbatim line length including indents exceeds 79 by 13 -pod/perltie.pod Verbatim line length including indents exceeds 79 by 3 -pod/perltru64.pod Verbatim line length including indents exceeds 79 by 1 -pod/perlwin32.pod Verbatim line length including indents exceeds 79 by 7 -porting/epigraphs.pod Verbatim line length including indents exceeds 79 by -1 -porting/release_managers_guide.pod Verbatim line length including indents exceeds 79 by 2 +pod/perlport.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlqnx.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlre.pod Verbatim line length including indents exceeds 78 by 7 +pod/perlreapi.pod Verbatim line length including indents exceeds 78 by 3 +pod/perlrebackslash.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlrecharclass.pod Verbatim line length including indents exceeds 78 by 12 +pod/perlref.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlreftut.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlreguts.pod Verbatim line length including indents exceeds 78 by 10 +pod/perlreref.pod Verbatim line length including indents exceeds 78 by 6 +pod/perlretut.pod Verbatim line length including indents exceeds 78 by 9 +pod/perlrun.pod Verbatim line length including indents exceeds 78 by 10 +pod/perlsec.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlsolaris.pod Verbatim line length including indents exceeds 78 by 13 +pod/perlstyle.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlsub.pod Verbatim line length including indents exceeds 78 by 8 +pod/perlsynology.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlthrtut.pod Verbatim line length including indents exceeds 78 by 2 +pod/perltie.pod Verbatim line length including indents exceeds 78 by 7 +pod/perltru64.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlunicode.pod Verbatim line length including indents exceeds 78 by 4 +pod/perlunifaq.pod Verbatim line length including indents exceeds 78 by 1 +pod/perluniintro.pod Verbatim line length including indents exceeds 78 by 5 +pod/perlvar.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlwin32.pod Verbatim line length including indents exceeds 78 by 8 +porting/bench.pl Verbatim line length including indents exceeds 78 by 2 +porting/bisect-runner.pl Verbatim line length including indents exceeds 78 by 2 +porting/epigraphs.pod Verbatim line length including indents exceeds 78 by 51 +porting/pumpkin.pod Verbatim line length including indents exceeds 78 by 3 +porting/release_managers_guide.pod Verbatim line length including indents exceeds 78 by 6 porting/todo.pod ? Should you be using F<...> or maybe L<...> instead of 1 -lib/benchmark.pm Verbatim line length including indents exceeds 79 by 2 +porting/todo.pod Verbatim line length including indents exceeds 78 by 2 +lib/b/op_private.pm Verbatim line length including indents exceeds 78 by 1 +lib/benchmark.pm Verbatim line length including indents exceeds 78 by 2 +lib/charnames.pm Verbatim line length including indents exceeds 78 by 2 +lib/class/struct.pm Verbatim line length including indents exceeds 78 by 3 lib/config.pod ? Should you be using L<...> instead of -1 +lib/db.pm Verbatim line length including indents exceeds 78 by 2 +lib/overload.pm Verbatim line length including indents exceeds 78 by 1 lib/perl5db.pl ? Should you be using L<...> instead of 1 +lib/perlio.pm Verbatim line length including indents exceeds 78 by 1 +lib/strict.pm Verbatim line length including indents exceeds 78 by 1 +lib/tie/array.pm Verbatim line length including indents exceeds 78 by 1 +lib/tie/hash.pm Verbatim line length including indents exceeds 78 by 1 +lib/unicode/ucd.pm Verbatim line length including indents exceeds 78 by 17 +lib/utf8.pm Verbatim line length including indents exceeds 78 by 1 +lib/vmsish.pm Verbatim line length including indents exceeds 78 by 1 +lib/warnings.pm Verbatim line length including indents exceeds 78 by 2 diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index 0797d57930d9..94c56e8822ad 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -114,8 +114,8 @@ The pedantic checks are: It's annoying to have lines wrap when displaying pod documentation in a terminal window. This checks that all verbatim lines fit in a standard 80 -column window, even when using a pager that reserves a column for its own use. -(Thus the check is for a net of 79 columns.) +column window, even when using a pager that reserves 2 columns for its own +use. (Thus the check is for a net of 78 columns.) For those lines that don't fit, it tells you how much needs to be cut in order to fit. @@ -359,7 +359,7 @@ my $known_issues = File::Spec->catfile($data_dir, 'known_pod_issues.dat'); my $MANIFEST = File::Spec->catfile(File::Spec->updir($original_dir), 'MANIFEST'); my $copy_fh; -my $MAX_LINE_LENGTH = 79; # 79 columns +my $MAX_LINE_LENGTH = 78; # 78 columns my $INDENT = 7; # default nroff indent # Our warning messages. Better not have [('"] in them, as those are used as From 92b3a3ebc05e3ce0e84a1ccff46487ca2200b471 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 6 Oct 2020 17:07:00 +1100 Subject: [PATCH 121/503] Win32: add lstat(), fetch st_dev and st_ino and fetch st_nlink for fstat We need lstat() for various modules to work well with symlinks, and the same modules often want to check for matches on the device and inode number. The values we're using for st_ino match those that the Python and Rust libraries use, and Go uses the same volume and file index values for testing if two stat objects refer to the same file. They aren't entirely unique, given ReFS uses 128-bit file ids, but the API used to check for this (GetFileInformationByHandleEx() for FileIdInfo) is only available on server operating systems, so I can't directly test it anyway. --- MANIFEST | 1 + dosish.h | 6 +- t/op/stat.t | 11 +- t/win32/stat.t | 111 +++++++++ win32/config.gc | 2 +- win32/config.vc | 2 +- win32/config_H.gc | 567 +++++++++++++++++++++++++++++----------------- win32/config_H.vc | 558 ++++++++++++++++++++++++++++----------------- win32/perlhost.h | 2 +- win32/win32.c | 199 +++++++++++++++- win32/win32.h | 32 +++ win32/win32iop.h | 2 + 12 files changed, 1067 insertions(+), 426 deletions(-) create mode 100644 t/win32/stat.t diff --git a/MANIFEST b/MANIFEST index f0efee76b858..684be8817ad3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6164,6 +6164,7 @@ t/win32/fs.t Test Win32 link for compatibility t/win32/popen.t Test for stdout races in backticks, etc t/win32/runenv.t Test if Win* perl honors its env variables t/win32/signal.t Test Win32 signal emulation +t/win32/stat.t Test Win32 stat emulation t/win32/system.t See if system works in Win* t/win32/system_tests Test runner for system.t taint.c Tainting code diff --git a/dosish.h b/dosish.h index 1860a0f0668f..3580693c90c1 100644 --- a/dosish.h +++ b/dosish.h @@ -70,7 +70,11 @@ * to include and to get any typedef'ed * information. */ -#define Stat_t struct _stati64 +#if defined(WIN32) +# define Stat_t struct w32_stat +#else +# define Stat_t struct _stati64 +#endif /* USE_STAT_RDEV: * This symbol is defined if this system has a stat structure declaring diff --git a/t/op/stat.t b/t/op/stat.t index 663ad9d714ed..1cf6072f6e6d 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -502,14 +502,19 @@ like $@, qr/^The stat preceding lstat\(\) wasn't an lstat at /, } SKIP: { - skip "No lstat", 2 unless $Config{d_lstat}; + skip "No lstat", 2 unless $Config{d_lstat} && $Config{d_symlink}; # bug id 20020124.004 (#8334) - # If we have d_lstat, we should have symlink() my $linkname = 'stat-' . rand =~ y/.//dr; my $target = $Perl; $target =~ s/;\d+\z// if $Is_VMS; # symlinks don't like version numbers - symlink $target, $linkname or die "# Can't symlink $0: $!"; + unless (symlink $target, $linkname) { + if ($^O eq "MSWin32") { + # likely we don't have permission + skip "symlink failed: $!", 2; + } + die "# Can't symlink $0: $!"; + } lstat $linkname; -T _; eval { lstat _ }; diff --git a/t/win32/stat.t b/t/win32/stat.t new file mode 100644 index 000000000000..ad5c5b7c884f --- /dev/null +++ b/t/win32/stat.t @@ -0,0 +1,111 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require "./test.pl"; +} + +use strict; + +Win32::FsType() eq 'NTFS' + or skip_all("need NTFS"); + +my $tmpfile1 = tempfile(); + +# test some of the win32 specific stat code, since we +# don't depend on the CRT for some of it + +ok(link($0, $tmpfile1), "make a link to test nlink"); + +my @st = stat $0; +open my $fh, "<", $0 or die; +my @fst = stat $fh; +close $fh; + +# the ucrt stat() is inconsistent here, using an A=0 drive letter for stat() +# and the fd for fstat(), I assume that's something backward compatible. +# +# I don't see anything we could reasonable populate it with either. +$st[6] = $fst[6] = 0; + +is("@st", "@fst", "check named stat vs handle stat"); + +ok($st[0], "we set dev by default now"); +ok($st[1], "and ino"); + +# unlikely, but someone else might have linked to win32/stat.t +cmp_ok($st[3], '>', 1, "should be more than one link"); + +my $nlink = $st[3]; + +# check we get nlinks etc for a directory +@st = stat("win32"); +ok($st[0], "got dev for a directory"); +ok($st[1], "got ino for a directory"); +ok($st[3], "got nlink for a directory"); + +${^WIN32_SLOPPY_STAT} = 1; + +@st = stat $0; +open my $fh, "<", $0 or die; +@fst = stat $fh; +close $fh; + +$st[6] = $fst[6] = 0; + +is("@st", "@fst", "sloppy check named stat vs handle stat"); +is($st[0], 0, "sloppy no dev"); +is($st[1], 0, "sloppy no ino"); +# don't check nlink, Microsoft might fix it one day + +${^WIN32_SLOPPY_STAT} = 0; + +# symbolic links +unlink($tmpfile1); # no more hard link + +# mklink is available from Vista onwards +# this may only work in an admin shell +# MKLINK [[/D] | [/H] | [/J]] Link Target +if (system("mklink $tmpfile1 win32\\stat.t") == 0) { + ok(-l $tmpfile1, "lstat sees a symlink"); + + # check stat on file vs symlink + @st = stat $0; + my @lst = stat $tmpfile1; + + $st[6] = $lst[6] = 0; + + is("@st", "@lst", "check stat on file vs link"); + + # our hard link no longer exists, check that is reflected in nlink + is($st[3], $nlink-1, "check nlink updated"); + + unlink($tmpfile1); +} + +# similarly for a directory +if (system("mklink /d $tmpfile1 win32") == 0) { + ok(-l $tmpfile1, "lstat sees a symlink on the directory symlink"); + + # check stat on directory vs symlink + @st = stat "win32"; + my @lst = stat $tmpfile1; + + $st[6] = $lst[6] = 0; + + is("@st", "@lst", "check stat on dir vs link"); + + # for now at least, we need to rmdir symlinks to directories + rmdir( $tmpfile1 ); +} + +# check a junction doesn't look like a symlink + +if (system("mklink /j $tmpfile1 win32") == 0) { + ok(!-l $tmpfile1, "lstat doesn't see a symlink on the directory junction"); + + rmdir( $tmpfile1 ); +} + +done_testing(); diff --git a/win32/config.gc b/win32/config.gc index c632ba93c328..c7e619620b96 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -358,7 +358,7 @@ d_lrintl='define' d_lround='define' d_lroundl='define' d_lseekproto='define' -d_lstat='undef' +d_lstat='define' d_madvise='undef' d_malloc_good_size='undef' d_malloc_size='undef' diff --git a/win32/config.vc b/win32/config.vc index 3f68e7554fa5..294cdacbb2d2 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -358,7 +358,7 @@ d_lrintl='undef' d_lround='undef' d_lroundl='undef' d_lseekproto='define' -d_lstat='undef' +d_lstat='define' d_madvise='undef' d_malloc_good_size='undef' d_malloc_size='undef' diff --git a/win32/config_H.gc b/win32/config_H.gc index 233eea3f655f..a068b08bba45 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -9,8 +9,8 @@ /* Package name : perl5 * Source directory : - * Configuration time: Tue Oct 17 08:44:03 2017 - * Configured by : shay + * Configuration time: Wed Oct 7 16:27:47 2020 + * Configured by : tony * Target system : */ @@ -32,7 +32,7 @@ * This symbol, if defined, indicates that the cbrt() (cube root) * function is available. */ -#define HAS_CBRT /**/ +#define HAS_CBRT /**/ /* HAS_CHOWN: * This symbol, if defined, indicates that the chown routine is @@ -216,7 +216,7 @@ * This symbol, if defined, indicates that the lstat routine is * available to do file stats on symbolic links. */ -/*#define HAS_LSTAT / **/ +#define HAS_LSTAT /**/ /* HAS_MBLEN: * This symbol, if defined, indicates that the mblen routine is available @@ -257,6 +257,12 @@ */ #define HAS_MKTIME /**/ +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG / **/ + /* HAS_MSYNC: * This symbol, if defined, indicates that the msync system call is * available to synchronize a mapped file. @@ -366,6 +372,12 @@ */ #define HAS_SELECT /**/ +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +/*#define HAS_SEM / **/ + /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. @@ -392,12 +404,6 @@ */ /*#define HAS_SETLINEBUF / **/ -/* HAS_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -#define HAS_SETLOCALE /**/ - /* HAS_SETPGID: * This symbol, if defined, indicates that the setpgid(pid, gpid) * routine is available to set process group ID. @@ -796,14 +802,14 @@ /*#define HAS_EACCESS / **/ /* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_SYS_ACCESS / **/ /* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_SYS_SECURITY / **/ @@ -811,7 +817,7 @@ * This symbol contains the number of bytes required to align a * double, or a long double when applicable. Usual values are 2, * 4 and 8. The default is eight, for safety. For cross-compiling - * or multiarch support, Configure will set a minimum of 8. + * or multiarch support, Configure will set a minimum of 8. */ #define MEM_ALIGNBYTES 8 @@ -843,7 +849,7 @@ # endif # endif #else -#define BYTEORDER 0x1234 /* large digits for MSB */ +#define BYTEORDER 0x12345678 /* large digits for MSB */ #endif /* CHARBITS: @@ -914,7 +920,7 @@ * the GNU C library is being used. A better check is to use * the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc. */ -/*#define HAS_GNULIBC / **/ +/*#define HAS_GNULIBC / **/ #if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) # define _GNU_SOURCE #endif @@ -1066,12 +1072,12 @@ * This symbol is defined if using the FILE_ptr macro as an lvalue * to increase the pointer by n leaves File_cnt(fp) unchanged. */ -#define USE_STDIO_PTR /**/ +#define USE_STDIO_PTR /**/ #ifdef USE_STDIO_PTR #define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ +#define STDIO_PTR_LVALUE /**/ #define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ +#define STDIO_CNT_LVALUE /**/ /*#define STDIO_PTR_LVAL_SETS_CNT / **/ #define STDIO_PTR_LVAL_NOCHANGE_CNT /**/ #endif @@ -1096,7 +1102,7 @@ * structure pointed to its argument. This macro will always be defined * if USE_STDIO_BASE is defined. */ -#define USE_STDIO_BASE /**/ +#define USE_STDIO_BASE /**/ #ifdef USE_STDIO_BASE #define FILE_base(fp) ((fp)->_base) #define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) @@ -1109,8 +1115,8 @@ #define DOUBLESIZE 8 /**/ /* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol is always defined, and indicates to the C program that + * it should include . */ /* I_SYS_TIME: * This symbol, if defined, indicates to the C program that it should @@ -1167,7 +1173,7 @@ * the compiler supports (void *); otherwise it will be * sizeof(char *). */ -#define PTRSIZE 4 /**/ +#define PTRSIZE 8 /**/ /* Drand01: * This macro is to be used to generate uniformly distributed @@ -1202,13 +1208,13 @@ * to get any typedef'ed information. * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SSize_t int /* signed count of bytes */ +#define SSize_t long long /* signed count of bytes */ /* EBCDIC: * This symbol, if defined, indicates that this system uses * EBCDIC encoding. */ -/*#define EBCDIC / **/ +/*#define EBCDIC / **/ /* ARCHLIB: * This variable, if defined, holds the name of the directory in @@ -1240,7 +1246,7 @@ */ #define BIN "c:\\perl\\bin" /**/ #define BIN_EXP "c:\\perl\\bin" /**/ -#define PERL_RELOCATABLE_INC "undef" /**/ +#define PERL_RELOCATABLE_INC "undef" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1253,7 +1259,7 @@ /* INSTALL_USR_BIN_PERL: * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. + * also as /usr/bin/perl. */ /*#define INSTALL_USR_BIN_PERL / **/ @@ -1363,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "6.1" /**/ +#define OSVERS "10.0.18363.1082" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -1373,7 +1379,6 @@ */ #if 42 == 1 #define CAT2(a,b) a/**/b -#undef STRINGIFY #define STRINGIFY(a) "a" #endif #if 42 == 42 @@ -1381,7 +1386,6 @@ #define PeRl_StGiFy(a) #a #define CAT2(a,b) PeRl_CaTiFy(a,b) #define StGiFy(a) PeRl_StGiFy(a) -#undef STRINGIFY #define STRINGIFY(a) PeRl_StGiFy(a) #endif #if 42 != 1 && 42 != 42 @@ -1391,7 +1395,7 @@ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * output. Typical value of "cc -E" or "/lib/cpp", but it can also * call a wrapper. See CPPRUN. */ /* CPPMINUS: @@ -1425,11 +1429,6 @@ */ #define HAS_ACCESS /**/ - -/* The HASATTRIBUTE_* defines are left undefined here because they vary from - * one version of GCC to another. Instead, they are defined on the basis of - * the compiler version in . - */ /* HASATTRIBUTE_FORMAT: * Can we handle GCC attribute for checking printf-style formats */ @@ -1457,6 +1456,10 @@ /* HASATTRIBUTE_WARN_UNUSED_RESULT: * Can we handle GCC attribute for warning on unused results */ +/* HASATTRIBUTE_ALWAYS_INLINE: + * Can we handle GCC attribute for functions that should always be + * inlined. + */ /*#define HASATTRIBUTE_DEPRECATED / **/ /*#define HASATTRIBUTE_FORMAT / **/ /*#define PRINTF_FORMAT_NULL_OK / **/ @@ -1466,6 +1469,7 @@ /*#define HASATTRIBUTE_PURE / **/ /*#define HASATTRIBUTE_UNUSED / **/ /*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/ +/*#define HASATTRIBUTE_ALWAYS_INLINE / **/ /* HAS_BACKTRACE: * This symbol, if defined, indicates that the backtrace() routine is @@ -1728,6 +1732,8 @@ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE + * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN + * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN * LONG_DOUBLE_IS_VAX_H_FLOAT * LONG_DOUBLE_IS_UNKNOWN_FORMAT * It is only defined if the system supports long doubles. @@ -1756,10 +1762,10 @@ * This symbol, if defined, indicates that the long double is * the 128-bit VAX format H. */ -#define HAS_LDEXPL /**/ +#define HAS_LDEXPL /**/ #define HAS_LONG_DOUBLE /**/ #ifdef HAS_LONG_DOUBLE -#define LONG_DOUBLESIZE 12 /**/ +#define LONG_DOUBLESIZE 16 /**/ #define LONG_DOUBLEKIND 3 /**/ #define LONG_DOUBLE_IS_DOUBLE 0 #define LONG_DOUBLE_IS_IEEE_754_128_BIT_LITTLE_ENDIAN 1 @@ -1799,9 +1805,7 @@ * available to exclusively create and open a uniquely named * temporary file. */ -#if __MINGW64_VERSION_MAJOR >= 4 -#define HAS_MKSTEMP -#endif +/*#define HAS_MKSTEMP / **/ /* HAS_MMAP: * This symbol, if defined, indicates that the mmap system call is @@ -1815,18 +1819,6 @@ /*#define HAS_MMAP / **/ #define Mmap_t void * /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). - */ -/*#define HAS_MSG / **/ - -/* HAS_SEM: - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/*#define HAS_SEM / **/ - /* HAS_SETGRENT: * This symbol, if defined, indicates that the setgrent routine is * available for initializing sequential access of the group database. @@ -1919,6 +1911,10 @@ * This symbol, if defined, indicates the availability of * struct sockaddr_in6; */ +/* HAS_SOCKADDR_STORAGE: + * This symbol, if defined, indicates the availability of + * struct sockaddr_storage; + */ /* HAS_SIN6_SCOPE_ID: * This symbol, if defined, indicates that the struct sockaddr_in6 * structure has a member called sin6_scope_id. @@ -1943,6 +1939,7 @@ /*#define HAS_SOCKETPAIR / **/ /*#define HAS_SOCKADDR_SA_LEN / **/ /*#define HAS_SOCKADDR_IN6 / **/ +#define HAS_SOCKADDR_STORAGE /**/ #define HAS_SIN6_SCOPE_ID /**/ /*#define HAS_IP_MREQ / **/ /*#define HAS_IP_MREQ_SOURCE / **/ @@ -1954,7 +1951,7 @@ * st_blksize and st_blocks. */ #ifndef USE_STAT_BLOCKS -/*#define USE_STAT_BLOCKS / **/ +/*#define USE_STAT_BLOCKS / **/ #endif /* HAS_SYS_ERRLIST: @@ -1974,11 +1971,11 @@ * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code * probably needs to define it as: - * union semun { + * union semun { * int val; * struct semid_ds *buf; * unsigned short *array; - * } + * } */ /* USE_SEMCTL_SEMUN: * This symbol, if defined, indicates that union semun is @@ -2173,7 +2170,7 @@ /* Free_t: * This variable contains the return type of free(). It is usually - * void, but occasionally int. + * void, but occasionally int. */ /* Malloc_t: * This symbol is the type of pointer returned by malloc and realloc. @@ -2269,7 +2266,7 @@ * This symbol, if defined, indicates that the atoll routine is * available to convert strings into long longs. */ -/*#define HAS_ATOLL / **/ +#define HAS_ATOLL /**/ /* HAS__FWALK: * This symbol, if defined, indicates that the _fwalk system call is @@ -2277,6 +2274,12 @@ */ /*#define HAS__FWALK / **/ +/* HAS_ACCEPT4: + * This symbol, if defined, indicates that the accept4 routine is + * available to accept socket connections. + */ +/*#define HAS_ACCEPT4 / **/ + /* HAS_ACOSH: * This symbol, if defined, indicates that the acosh routine is * available to do the inverse hyperbolic cosine function. @@ -2311,6 +2314,22 @@ /*#define HAS_BUILTIN_EXPECT / **/ /*#define HAS_BUILTIN_CHOOSE_EXPR / **/ +/* HAS_BUILTIN_ADD_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_add_overflow for adding integers with overflow checks. + */ +/* HAS_BUILTIN_SUB_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_sub_overflow for subtracting integers with overflow checks. + */ +/* HAS_BUILTIN_MUL_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_mul_overflow for multiplying integers with overflow checks. + */ +/*#define HAS_BUILTIN_ADD_OVERFLOW / **/ +/*#define HAS_BUILTIN_SUB_OVERFLOW / **/ +/*#define HAS_BUILTIN_MUL_OVERFLOW / **/ + /* HAS_C99_VARIADIC_MACROS: * If defined, the compiler supports C99 variadic macros. */ @@ -2390,7 +2409,13 @@ * makes sense if you *have* dlsym, which we will presume is the * case if you're using dl_dlopen.xs. */ -/*#define DLSYM_NEEDS_UNDERSCORE / **/ +/*#define DLSYM_NEEDS_UNDERSCORE / **/ + +/* HAS_DUP3: + * This symbol, if defined, indicates that the dup3 routine is + * available to duplicate file descriptors. + */ +/*#define HAS_DUP3 / **/ /* HAS_ERF: * This symbol, if defined, indicates that the erf routine is @@ -2542,22 +2567,22 @@ * available to classify doubles. Available for example in HP-UX. * The returned values are defined in and are * - * FP_NORMAL Normalized - * FP_ZERO Zero - * FP_INFINITE Infinity - * FP_SUBNORMAL Denormalized - * FP_NAN NaN + * FP_NORMAL Normalized + * FP_ZERO Zero + * FP_INFINITE Infinity + * FP_SUBNORMAL Denormalized + * FP_NAN NaN * */ /* HAS_FP_CLASSIFY: * This symbol, if defined, indicates that the fp_classify routine is * available to classify doubles. The values are defined in * - * FP_NORMAL Normalized - * FP_ZERO Zero - * FP_INFINITE Infinity - * FP_SUBNORMAL Denormalized - * FP_NAN NaN + * FP_NORMAL Normalized + * FP_ZERO Zero + * FP_INFINITE Infinity + * FP_SUBNORMAL Denormalized + * FP_NAN NaN * */ /*#define HAS_FPCLASSIFY / **/ @@ -2590,7 +2615,7 @@ /* HAS_FPOS64_T: * This symbol will be defined if the C compiler supports fpos64_t. */ -/*#define HAS_FPOS64_T / **/ +/*#define HAS_FPOS64_T / **/ /* HAS_FREXPL: * This symbol, if defined, indicates that the frexpl routine is @@ -2761,8 +2786,8 @@ /*#define HAS_INETPTON / **/ /* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes + * This symbol will defined if the C compiler supports int64_t. + * Usually the needs to be included, but sometimes * is enough. */ /*#define HAS_INT64_T / **/ @@ -2832,7 +2857,7 @@ * j0l() function is available for Bessel functions of the first * kind of the order zero, for long doubles. */ -#define HAS_J0 /**/ +#define HAS_J0 /**/ /*#define HAS_J0L / **/ /* HAS_LC_MONETARY_2008: @@ -2847,7 +2872,7 @@ * of significant digits in a long double precision number. Unlike * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. */ -#define HAS_LDBL_DIG /**/ +#define HAS_LDBL_DIG /**/ /* HAS_LGAMMA: * This symbol, if defined, indicates that the lgamma routine is @@ -2963,6 +2988,9 @@ * This symbol, if defined, indicates that the memmem routine is * available to return a pointer to the start of the first occurrence * of a substring in a memory area (or NULL if not found). + * In glibc, memmem is a GNU extension. The function is visible in + * libc, but the prototype is only visible if _GNU_SOURCE is #defined. + * Thus we only define this if both the prototype and symbol are found. */ /*#define HAS_MEMMEM / **/ @@ -2979,6 +3007,13 @@ */ /*#define HAS_MKDTEMP / **/ +/* HAS_MKOSTEMP: + * This symbol, if defined, indicates that the mkostemp routine is + * available to exclusively create and open a uniquely named (with a + * suffix) temporary file. + */ +/*#define HAS_MKOSTEMP / **/ + /* HAS_MKSTEMPS: * This symbol, if defined, indicates that the mkstemps routine is * available to exclusively create and open a uniquely named @@ -2997,7 +3032,7 @@ * to the program to supply one. */ #define HAS_MODFL /**/ -/*#define HAS_MODFL_PROTO / **/ +#define HAS_MODFL_PROTO /**/ /* HAS_MPROTECT: * This symbol, if defined, indicates that the mprotect system call is @@ -3017,6 +3052,12 @@ */ #define HAS_NAN /**/ +/* HAS_NANOSLEEP: + * This symbol, if defined, indicates that the nanosleep + * system call is available to sleep with 1E-9 sec accuracy. + */ +/*#define HAS_NANOSLEEP / **/ + /* HAS_NEARBYINT: * This symbol, if defined, indicates that the nearbyint routine is * available to return the integral value closest to (according to @@ -3037,6 +3078,10 @@ * This symbol, if defined, indicates that the uselocale routine is * available to set the current locale for the calling thread. */ +/* HAS_DUPLOCALE: + * This symbol, if defined, indicates that the duplocale routine is + * available to duplicate a locale object. + */ /* HAS_QUERYLOCALE: * This symbol, if defined, indicates that the querylocale routine is * available to return the name of the locale for a category mask. @@ -3048,6 +3093,7 @@ /*#define HAS_NEWLOCALE / **/ /*#define HAS_FREELOCALE / **/ /*#define HAS_USELOCALE / **/ +/*#define HAS_DUPLOCALE / **/ /*#define HAS_QUERYLOCALE / **/ /*#define I_XLOCALE / **/ @@ -3075,7 +3121,13 @@ /* HAS_OFF64_T: * This symbol will be defined if the C compiler supports off64_t. */ -/*#define HAS_OFF64_T / **/ +/*#define HAS_OFF64_T / **/ + +/* HAS_PIPE2: + * This symbol, if defined, indicates that the pipe2 routine is + * available to create an inter-process channel. + */ +/*#define HAS_PIPE2 / **/ /* HAS_PRCTL: * This symbol, if defined, indicates that the prctl routine is @@ -3114,7 +3166,7 @@ /* HAS_PTRDIFF_T: * This symbol will be defined if the C compiler supports ptrdiff_t. */ -#define HAS_PTRDIFF_T /**/ +#define HAS_PTRDIFF_T /**/ /* HAS_READV: * This symbol, if defined, indicates that the readv routine is @@ -3188,6 +3240,17 @@ */ /*#define HAS_SETITIMER / **/ +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +/* SETLOCALE_ACCEPTS_ANY_LOCALE_NAME: + * This symbol, if defined, indicates that the setlocale routine is + * available and it accepts any input locale name as valid. + */ +#define HAS_SETLOCALE /**/ +/*#define SETLOCALE_ACCEPTS_ANY_LOCALE_NAME / **/ + /* HAS_SETPROCTITLE: * This symbol, if defined, indicates that the setproctitle routine is * available to set process title. @@ -3320,6 +3383,12 @@ */ /*#define HAS_STRLCPY / **/ +/* HAS_STRNLEN: + * This symbol, if defined, indicates that the strnlen () routine is + * available to check the length of a string up to a maximum. + */ +/*#define HAS_STRNLEN / **/ + /* HAS_STRTOLD: * This symbol, if defined, indicates that the strtold routine is * available to convert strings to long doubles. @@ -3330,7 +3399,7 @@ * This symbol, if defined, indicates that the strtoll routine is * available to convert strings to long longs. */ -/*#define HAS_STRTOLL / **/ +#define HAS_STRTOLL /**/ /* HAS_STRTOQ: * This symbol, if defined, indicates that the strtoq routine is @@ -3342,7 +3411,7 @@ * This symbol, if defined, indicates that the strtoull routine is * available to convert strings to unsigned long longs. */ -/*#define HAS_STRTOULL / **/ +#define HAS_STRTOULL /**/ /* HAS_STRTOUQ: * This symbol, if defined, indicates that the strtouq routine is @@ -3410,6 +3479,18 @@ */ /*#define HAS_TIMEGM / **/ +/* HAS_TOWLOWER: + * This symbol, if defined, indicates that the towlower () routine is + * available to do case conversion. + */ +/*#define HAS_TOWLOWER / **/ + +/* HAS_TOWUPPER: + * This symbol, if defined, indicates that the towupper () routine is + * available to do case conversion. + */ +/*#define HAS_TOWUPPER / **/ + /* HAS_TRUNC: * This symbol, if defined, indicates that the trunc routine is * available to round doubles towards zero. @@ -3487,6 +3568,12 @@ */ #define DEFAULT_INC_EXCLUDES_DOT /**/ +/* USE_STRICT_BY_DEFAULT + * This symbol, if defined, enables additional defaults. + * At this time it only enables implicit strict by default. + */ +/*#define USE_STRICT_BY_DEFAULT / * use strict by default */ + /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of * some sort is available. @@ -3506,8 +3593,8 @@ * Note that if fflushNULL is defined, fflushall will not * even be probed for and will be left undefined. */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL / **/ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL / **/ /* I_BFD: * This symbol, if defined, indicates that exists and @@ -3546,10 +3633,10 @@ * For DB version 1 this is always 0. */ #define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ -#define DB_VERSION_MAJOR_CFG 0 /**/ -#define DB_VERSION_MINOR_CFG 0 /**/ -#define DB_VERSION_PATCH_CFG 0 /**/ +#define DB_Prefix_t int /**/ +#define DB_VERSION_MAJOR_CFG 0 /**/ +#define DB_VERSION_MINOR_CFG 0 /**/ +#define DB_VERSION_PATCH_CFG 0 /**/ /* I_FENV: * This symbol, if defined, indicates to the C program that it should @@ -3576,8 +3663,8 @@ /*#define I_IEEEFP / **/ /* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_INTTYPES / **/ @@ -3606,8 +3693,8 @@ /*#define I_MNTENT / **/ /* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_NETINET_TCP / **/ @@ -3706,6 +3793,17 @@ */ /*#define I_USTAT / **/ +/* I_WCHAR: + * This symbol, if defined, indicates to the C program that + * is available for inclusion + */ +/*#define I_WCHAR / **/ + +/* I_WCTYPE: + * This symbol, if defined, indicates that exists. + */ +/*#define I_WCTYPE / **/ + /* DOUBLEINFBYTES: * This symbol, if defined, is a comma-separated list of * hexadecimal bytes for the double precision infinity. @@ -3724,8 +3822,8 @@ */ #define DOUBLEINFBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x7f /**/ #define DOUBLENANBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x7f /**/ -#define LONGDBLINFBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00 /**/ -#define LONGDBLNANBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x00, 0x00 /**/ +#define LONGDBLINFBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0x7f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 /**/ +#define LONGDBLNANBYTES 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xff, 0xff, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00 /**/ /* PERL_PRIfldbl: * This symbol, if defined, contains the string used by stdio to @@ -3946,8 +4044,8 @@ * This symbol, if defined, indicates that a variable of type NVTYPE * stores 0.0 in memory as all bits zero. */ -#define IVTYPE long /**/ -#define UVTYPE unsigned long /**/ +#define IVTYPE long long /**/ +#define UVTYPE unsigned long long /**/ #define I8TYPE char /**/ #define U8TYPE unsigned char /**/ #define I16TYPE short /**/ @@ -3959,8 +4057,8 @@ #define U64TYPE unsigned long long /**/ #endif #define NVTYPE double /**/ -#define IVSIZE 4 /**/ -#define UVSIZE 4 /**/ +#define IVSIZE 8 /**/ +#define UVSIZE 8 /**/ #define I8SIZE 1 /**/ #define U8SIZE 1 /**/ #define I16SIZE 2 /**/ @@ -3972,9 +4070,9 @@ #define U64SIZE 8 /**/ #endif #define NVSIZE 8 /**/ -#define NV_PRESERVES_UV -#define NV_PRESERVES_UV_BITS 32 -#define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0 +#undef NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 53 +#define NV_OVERFLOWS_INTEGERS_AT (256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0) #define NV_ZERO_IS_ALLBITS_ZERO #if UVSIZE == 8 # ifdef BYTEORDER @@ -4022,11 +4120,11 @@ * This symbol defines the format string used for printing a Perl NV * using %g-ish floating point format. */ -#define IVdf "ld" /**/ -#define UVuf "lu" /**/ -#define UVof "lo" /**/ -#define UVxf "lx" /**/ -#define UVXf "lX" /**/ +#define IVdf "I64d" /**/ +#define UVuf "I64u" /**/ +#define UVof "I64o" /**/ +#define UVxf "I64x" /**/ +#define UVXf "I64X" /**/ #define NVef "e" /**/ #define NVff "f" /**/ #define NVgf "g" /**/ @@ -4038,7 +4136,7 @@ * is either n or 32*ceil(n/32), especially many little-endians do * the latter. This is only useful if you have select(), naturally. */ -#define SELECT_MIN_BITS 32 /**/ +#define SELECT_MIN_BITS 32 /**/ /* ST_INO_SIZE: * This variable contains the size of struct stat's st_ino in bytes. @@ -4048,7 +4146,7 @@ * 1 for unsigned, -1 for signed. */ #define ST_INO_SIGN 1 /* st_ino sign */ -#define ST_INO_SIZE 4 /* st_ino size */ +#define ST_INO_SIZE 8 /* st_ino size */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -4110,7 +4208,7 @@ * you may need at least to reboot your OS to 64-bit mode. */ #ifndef USE_64_BIT_INT -/*#define USE_64_BIT_INT / **/ +#define USE_64_BIT_INT /**/ #endif #ifndef USE_64_BIT_ALL /*#define USE_64_BIT_ALL / **/ @@ -4140,7 +4238,7 @@ /* USE_KERN_PROC_PATHNAME: * This symbol, if defined, indicates that we can use sysctl with * KERN_PROC_PATHNAME to get a full path for the executable, and hence - * convert $^X to an absolute path. + * convert $^X to an absolute path. */ /*#define USE_KERN_PROC_PATHNAME / **/ @@ -4283,7 +4381,7 @@ * is defined, and 'int *' otherwise. This is only useful if you * have select(), of course. */ -#define Select_fd_set_t Perl_fd_set * /**/ +#define Select_fd_set_t Perl_fd_set * /**/ /* Sock_size_t: * This symbol holds the type used for the size argument of @@ -4297,7 +4395,7 @@ * where library files may be held under a private library, for * instance. */ -#define ARCHNAME "MSWin32-x86-perlio" /**/ +#define ARCHNAME "MSWin32-x64-perlio" /**/ /* HAS_ASCTIME_R: * This symbol, if defined, indicates that the asctime_r routine @@ -4309,8 +4407,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r * is defined. */ -/*#define HAS_ASCTIME_R / **/ -#define ASCTIME_R_PROTO 0 /**/ +/*#define HAS_ASCTIME_R / **/ +#define ASCTIME_R_PROTO 0 /**/ /* HAS_CRYPT_R: * This symbol, if defined, indicates that the crypt_r routine @@ -4322,8 +4420,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r * is defined. */ -/*#define HAS_CRYPT_R / **/ -#define CRYPT_R_PROTO 0 /**/ +/*#define HAS_CRYPT_R / **/ +#define CRYPT_R_PROTO 0 /**/ /* HAS_CTERMID_R: * This symbol, if defined, indicates that the ctermid_r routine @@ -4335,8 +4433,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r * is defined. */ -/*#define HAS_CTERMID_R / **/ -#define CTERMID_R_PROTO 0 /**/ +/*#define HAS_CTERMID_R / **/ +#define CTERMID_R_PROTO 0 /**/ /* HAS_CTIME_R: * This symbol, if defined, indicates that the ctime_r routine @@ -4348,8 +4446,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r * is defined. */ -/*#define HAS_CTIME_R / **/ -#define CTIME_R_PROTO 0 /**/ +/*#define HAS_CTIME_R / **/ +#define CTIME_R_PROTO 0 /**/ /* HAS_DRAND48_R: * This symbol, if defined, indicates that the drand48_r routine @@ -4361,8 +4459,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r * is defined. */ -/*#define HAS_DRAND48_R / **/ -#define DRAND48_R_PROTO 0 /**/ +/*#define HAS_DRAND48_R / **/ +#define DRAND48_R_PROTO 0 /**/ /* HAS_ENDGRENT_R: * This symbol, if defined, indicates that the endgrent_r routine @@ -4374,8 +4472,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r * is defined. */ -/*#define HAS_ENDGRENT_R / **/ -#define ENDGRENT_R_PROTO 0 /**/ +/*#define HAS_ENDGRENT_R / **/ +#define ENDGRENT_R_PROTO 0 /**/ /* HAS_ENDHOSTENT_R: * This symbol, if defined, indicates that the endhostent_r routine @@ -4387,8 +4485,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r * is defined. */ -/*#define HAS_ENDHOSTENT_R / **/ -#define ENDHOSTENT_R_PROTO 0 /**/ +/*#define HAS_ENDHOSTENT_R / **/ +#define ENDHOSTENT_R_PROTO 0 /**/ /* HAS_ENDNETENT_R: * This symbol, if defined, indicates that the endnetent_r routine @@ -4400,8 +4498,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r * is defined. */ -/*#define HAS_ENDNETENT_R / **/ -#define ENDNETENT_R_PROTO 0 /**/ +/*#define HAS_ENDNETENT_R / **/ +#define ENDNETENT_R_PROTO 0 /**/ /* HAS_ENDPROTOENT_R: * This symbol, if defined, indicates that the endprotoent_r routine @@ -4413,8 +4511,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r * is defined. */ -/*#define HAS_ENDPROTOENT_R / **/ -#define ENDPROTOENT_R_PROTO 0 /**/ +/*#define HAS_ENDPROTOENT_R / **/ +#define ENDPROTOENT_R_PROTO 0 /**/ /* HAS_ENDPWENT_R: * This symbol, if defined, indicates that the endpwent_r routine @@ -4426,8 +4524,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r * is defined. */ -/*#define HAS_ENDPWENT_R / **/ -#define ENDPWENT_R_PROTO 0 /**/ +/*#define HAS_ENDPWENT_R / **/ +#define ENDPWENT_R_PROTO 0 /**/ /* HAS_ENDSERVENT_R: * This symbol, if defined, indicates that the endservent_r routine @@ -4439,8 +4537,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r * is defined. */ -/*#define HAS_ENDSERVENT_R / **/ -#define ENDSERVENT_R_PROTO 0 /**/ +/*#define HAS_ENDSERVENT_R / **/ +#define ENDSERVENT_R_PROTO 0 /**/ /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine @@ -4452,8 +4550,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r * is defined. */ -/*#define HAS_GETGRENT_R / **/ -#define GETGRENT_R_PROTO 0 /**/ +/*#define HAS_GETGRENT_R / **/ +#define GETGRENT_R_PROTO 0 /**/ /* HAS_GETGRGID_R: * This symbol, if defined, indicates that the getgrgid_r routine @@ -4465,8 +4563,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r * is defined. */ -/*#define HAS_GETGRGID_R / **/ -#define GETGRGID_R_PROTO 0 /**/ +/*#define HAS_GETGRGID_R / **/ +#define GETGRGID_R_PROTO 0 /**/ /* HAS_GETGRNAM_R: * This symbol, if defined, indicates that the getgrnam_r routine @@ -4478,8 +4576,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r * is defined. */ -/*#define HAS_GETGRNAM_R / **/ -#define GETGRNAM_R_PROTO 0 /**/ +/*#define HAS_GETGRNAM_R / **/ +#define GETGRNAM_R_PROTO 0 /**/ /* HAS_GETHOSTBYADDR_R: * This symbol, if defined, indicates that the gethostbyaddr_r routine @@ -4491,8 +4589,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r * is defined. */ -/*#define HAS_GETHOSTBYADDR_R / **/ -#define GETHOSTBYADDR_R_PROTO 0 /**/ +/*#define HAS_GETHOSTBYADDR_R / **/ +#define GETHOSTBYADDR_R_PROTO 0 /**/ /* HAS_GETHOSTBYNAME_R: * This symbol, if defined, indicates that the gethostbyname_r routine @@ -4504,8 +4602,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r * is defined. */ -/*#define HAS_GETHOSTBYNAME_R / **/ -#define GETHOSTBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETHOSTBYNAME_R / **/ +#define GETHOSTBYNAME_R_PROTO 0 /**/ /* HAS_GETHOSTENT_R: * This symbol, if defined, indicates that the gethostent_r routine @@ -4517,8 +4615,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r * is defined. */ -/*#define HAS_GETHOSTENT_R / **/ -#define GETHOSTENT_R_PROTO 0 /**/ +/*#define HAS_GETHOSTENT_R / **/ +#define GETHOSTENT_R_PROTO 0 /**/ /* HAS_GETLOGIN_R: * This symbol, if defined, indicates that the getlogin_r routine @@ -4530,8 +4628,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r * is defined. */ -/*#define HAS_GETLOGIN_R / **/ -#define GETLOGIN_R_PROTO 0 /**/ +/*#define HAS_GETLOGIN_R / **/ +#define GETLOGIN_R_PROTO 0 /**/ /* HAS_GETNETBYADDR_R: * This symbol, if defined, indicates that the getnetbyaddr_r routine @@ -4543,8 +4641,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r * is defined. */ -/*#define HAS_GETNETBYADDR_R / **/ -#define GETNETBYADDR_R_PROTO 0 /**/ +/*#define HAS_GETNETBYADDR_R / **/ +#define GETNETBYADDR_R_PROTO 0 /**/ /* HAS_GETNETBYNAME_R: * This symbol, if defined, indicates that the getnetbyname_r routine @@ -4556,8 +4654,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r * is defined. */ -/*#define HAS_GETNETBYNAME_R / **/ -#define GETNETBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETNETBYNAME_R / **/ +#define GETNETBYNAME_R_PROTO 0 /**/ /* HAS_GETNETENT_R: * This symbol, if defined, indicates that the getnetent_r routine @@ -4569,8 +4667,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r * is defined. */ -/*#define HAS_GETNETENT_R / **/ -#define GETNETENT_R_PROTO 0 /**/ +/*#define HAS_GETNETENT_R / **/ +#define GETNETENT_R_PROTO 0 /**/ /* HAS_GETPROTOBYNAME_R: * This symbol, if defined, indicates that the getprotobyname_r routine @@ -4582,8 +4680,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r * is defined. */ -/*#define HAS_GETPROTOBYNAME_R / **/ -#define GETPROTOBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETPROTOBYNAME_R / **/ +#define GETPROTOBYNAME_R_PROTO 0 /**/ /* HAS_GETPROTOBYNUMBER_R: * This symbol, if defined, indicates that the getprotobynumber_r routine @@ -4595,8 +4693,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r * is defined. */ -/*#define HAS_GETPROTOBYNUMBER_R / **/ -#define GETPROTOBYNUMBER_R_PROTO 0 /**/ +/*#define HAS_GETPROTOBYNUMBER_R / **/ +#define GETPROTOBYNUMBER_R_PROTO 0 /**/ /* HAS_GETPROTOENT_R: * This symbol, if defined, indicates that the getprotoent_r routine @@ -4608,8 +4706,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r * is defined. */ -/*#define HAS_GETPROTOENT_R / **/ -#define GETPROTOENT_R_PROTO 0 /**/ +/*#define HAS_GETPROTOENT_R / **/ +#define GETPROTOENT_R_PROTO 0 /**/ /* HAS_GETPWENT_R: * This symbol, if defined, indicates that the getpwent_r routine @@ -4621,8 +4719,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r * is defined. */ -/*#define HAS_GETPWENT_R / **/ -#define GETPWENT_R_PROTO 0 /**/ +/*#define HAS_GETPWENT_R / **/ +#define GETPWENT_R_PROTO 0 /**/ /* HAS_GETPWNAM_R: * This symbol, if defined, indicates that the getpwnam_r routine @@ -4634,8 +4732,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r * is defined. */ -/*#define HAS_GETPWNAM_R / **/ -#define GETPWNAM_R_PROTO 0 /**/ +/*#define HAS_GETPWNAM_R / **/ +#define GETPWNAM_R_PROTO 0 /**/ /* HAS_GETPWUID_R: * This symbol, if defined, indicates that the getpwuid_r routine @@ -4647,8 +4745,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r * is defined. */ -/*#define HAS_GETPWUID_R / **/ -#define GETPWUID_R_PROTO 0 /**/ +/*#define HAS_GETPWUID_R / **/ +#define GETPWUID_R_PROTO 0 /**/ /* HAS_GETSERVBYNAME_R: * This symbol, if defined, indicates that the getservbyname_r routine @@ -4660,8 +4758,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r * is defined. */ -/*#define HAS_GETSERVBYNAME_R / **/ -#define GETSERVBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETSERVBYNAME_R / **/ +#define GETSERVBYNAME_R_PROTO 0 /**/ /* HAS_GETSERVBYPORT_R: * This symbol, if defined, indicates that the getservbyport_r routine @@ -4673,8 +4771,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r * is defined. */ -/*#define HAS_GETSERVBYPORT_R / **/ -#define GETSERVBYPORT_R_PROTO 0 /**/ +/*#define HAS_GETSERVBYPORT_R / **/ +#define GETSERVBYPORT_R_PROTO 0 /**/ /* HAS_GETSERVENT_R: * This symbol, if defined, indicates that the getservent_r routine @@ -4686,8 +4784,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r * is defined. */ -/*#define HAS_GETSERVENT_R / **/ -#define GETSERVENT_R_PROTO 0 /**/ +/*#define HAS_GETSERVENT_R / **/ +#define GETSERVENT_R_PROTO 0 /**/ /* HAS_GETSPNAM_R: * This symbol, if defined, indicates that the getspnam_r routine @@ -4699,8 +4797,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r * is defined. */ -/*#define HAS_GETSPNAM_R / **/ -#define GETSPNAM_R_PROTO 0 /**/ +/*#define HAS_GETSPNAM_R / **/ +#define GETSPNAM_R_PROTO 0 /**/ /* HAS_GMTIME_R: * This symbol, if defined, indicates that the gmtime_r routine @@ -4712,8 +4810,14 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r * is defined. */ -/*#define HAS_GMTIME_R / **/ -#define GMTIME_R_PROTO 0 /**/ +/*#define HAS_GMTIME_R / **/ +#define GMTIME_R_PROTO 0 /**/ + +/* HAS_LOCALECONV_L: + * This symbol, if defined, indicates that the localeconv_l routine is + * available to query certain information about a locale. + */ +/*#define HAS_LOCALECONV_L / **/ /* HAS_LOCALTIME_R: * This symbol, if defined, indicates that the localtime_r routine @@ -4732,14 +4836,35 @@ #define L_R_TZSET #endif +/* L_R_TZSET: + * If localtime_r() needs tzset, it is defined in this define + */ /* LOCALTIME_R_PROTO: * This symbol encodes the prototype of localtime_r. * It is zero if d_localtime_r is undef, and one of the * REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r * is defined. */ -/*#define HAS_LOCALTIME_R / **/ -#define LOCALTIME_R_PROTO 0 /**/ +/*#define HAS_LOCALTIME_R / **/ +#define LOCALTIME_R_PROTO 0 /**/ + +/* HAS_MBRLEN: + * This symbol, if defined, indicates that the mbrlen routine is + * available to get the length of multi-byte character strings. + */ +/*#define HAS_MBRLEN / **/ + +/* HAS_MBRTOWC: + * This symbol, if defined, indicates that the mbrtowc routine is + * available to convert a multi-byte character into a wide character. + */ +/*#define HAS_MBRTOWC / **/ + +/* HAS_THREAD_SAFE_NL_LANGINFO_L: + * This symbol, when defined, indicates presence of the nl_langinfo_l() + * function, and that it is thread-safe. + */ +/*#define HAS_THREAD_SAFE_NL_LANGINFO_L / **/ /* OLD_PTHREAD_CREATE_JOINABLE: * This symbol, if defined, indicates how to create pthread @@ -4786,8 +4911,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r * is defined. */ -/*#define HAS_RANDOM_R / **/ -#define RANDOM_R_PROTO 0 /**/ +/*#define HAS_RANDOM_R / **/ +#define RANDOM_R_PROTO 0 /**/ /* HAS_READDIR64_R: * This symbol, if defined, indicates that the readdir64_r routine @@ -4799,8 +4924,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r * is defined. */ -/*#define HAS_READDIR64_R / **/ -#define READDIR64_R_PROTO 0 /**/ +/*#define HAS_READDIR64_R / **/ +#define READDIR64_R_PROTO 0 /**/ /* HAS_READDIR_R: * This symbol, if defined, indicates that the readdir_r routine @@ -4812,8 +4937,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r * is defined. */ -/*#define HAS_READDIR_R / **/ -#define READDIR_R_PROTO 0 /**/ +/*#define HAS_READDIR_R / **/ +#define READDIR_R_PROTO 0 /**/ /* HAS_SETGRENT_R: * This symbol, if defined, indicates that the setgrent_r routine @@ -4825,8 +4950,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r * is defined. */ -/*#define HAS_SETGRENT_R / **/ -#define SETGRENT_R_PROTO 0 /**/ +/*#define HAS_SETGRENT_R / **/ +#define SETGRENT_R_PROTO 0 /**/ /* HAS_SETHOSTENT_R: * This symbol, if defined, indicates that the sethostent_r routine @@ -4838,8 +4963,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r * is defined. */ -/*#define HAS_SETHOSTENT_R / **/ -#define SETHOSTENT_R_PROTO 0 /**/ +/*#define HAS_SETHOSTENT_R / **/ +#define SETHOSTENT_R_PROTO 0 /**/ /* HAS_SETLOCALE_R: * This symbol, if defined, indicates that the setlocale_r routine @@ -4851,8 +4976,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r * is defined. */ -/*#define HAS_SETLOCALE_R / **/ -#define SETLOCALE_R_PROTO 0 /**/ +/*#define HAS_SETLOCALE_R / **/ +#define SETLOCALE_R_PROTO 0 /**/ /* HAS_SETNETENT_R: * This symbol, if defined, indicates that the setnetent_r routine @@ -4864,8 +4989,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r * is defined. */ -/*#define HAS_SETNETENT_R / **/ -#define SETNETENT_R_PROTO 0 /**/ +/*#define HAS_SETNETENT_R / **/ +#define SETNETENT_R_PROTO 0 /**/ /* HAS_SETPROTOENT_R: * This symbol, if defined, indicates that the setprotoent_r routine @@ -4877,8 +5002,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r * is defined. */ -/*#define HAS_SETPROTOENT_R / **/ -#define SETPROTOENT_R_PROTO 0 /**/ +/*#define HAS_SETPROTOENT_R / **/ +#define SETPROTOENT_R_PROTO 0 /**/ /* HAS_SETPWENT_R: * This symbol, if defined, indicates that the setpwent_r routine @@ -4890,8 +5015,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r * is defined. */ -/*#define HAS_SETPWENT_R / **/ -#define SETPWENT_R_PROTO 0 /**/ +/*#define HAS_SETPWENT_R / **/ +#define SETPWENT_R_PROTO 0 /**/ /* HAS_SETSERVENT_R: * This symbol, if defined, indicates that the setservent_r routine @@ -4903,8 +5028,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r * is defined. */ -/*#define HAS_SETSERVENT_R / **/ -#define SETSERVENT_R_PROTO 0 /**/ +/*#define HAS_SETSERVENT_R / **/ +#define SETSERVENT_R_PROTO 0 /**/ /* HAS_SRAND48_R: * This symbol, if defined, indicates that the srand48_r routine @@ -4916,8 +5041,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r * is defined. */ -/*#define HAS_SRAND48_R / **/ -#define SRAND48_R_PROTO 0 /**/ +/*#define HAS_SRAND48_R / **/ +#define SRAND48_R_PROTO 0 /**/ /* HAS_SRANDOM_R: * This symbol, if defined, indicates that the srandom_r routine @@ -4929,8 +5054,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r * is defined. */ -/*#define HAS_SRANDOM_R / **/ -#define SRANDOM_R_PROTO 0 /**/ +/*#define HAS_SRANDOM_R / **/ +#define SRANDOM_R_PROTO 0 /**/ /* HAS_STRERROR_R: * This symbol, if defined, indicates that the strerror_r routine @@ -4942,8 +5067,20 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r * is defined. */ -/*#define HAS_STRERROR_R / **/ -#define STRERROR_R_PROTO 0 /**/ +/*#define HAS_STRERROR_R / **/ +#define STRERROR_R_PROTO 0 /**/ + +/* HAS_STRTOD_L: + * This symbol, if defined, indicates that the strtod_l routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOD_L / **/ + +/* HAS_STRTOLD_L: + * This symbol, if defined, indicates that the strtold_l routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD_L / **/ /* HAS_TMPNAM_R: * This symbol, if defined, indicates that the tmpnam_r routine @@ -4955,8 +5092,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r * is defined. */ -/*#define HAS_TMPNAM_R / **/ -#define TMPNAM_R_PROTO 0 /**/ +/*#define HAS_TMPNAM_R / **/ +#define TMPNAM_R_PROTO 0 /**/ /* HAS_TTYNAME_R: * This symbol, if defined, indicates that the ttyname_r routine @@ -4968,18 +5105,24 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r * is defined. */ -/*#define HAS_TTYNAME_R / **/ -#define TTYNAME_R_PROTO 0 /**/ +/*#define HAS_TTYNAME_R / **/ +#define TTYNAME_R_PROTO 0 /**/ + +/* HAS_WCRTOMB: + * This symbol, if defined, indicates that the wcrtomb routine is + * available to convert a wide character into a multi-byte character. + */ +/*#define HAS_WCRTOMB / **/ /* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_MACH_CTHREADS / **/ /* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_PTHREAD / **/ @@ -5021,7 +5164,7 @@ /* HAS_TIMES: * This symbol, if defined, indicates that the times() routine exists. * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . + * use getrusage(). It may be necessary to include . */ #define HAS_TIMES /**/ @@ -5090,7 +5233,7 @@ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. */ -#define Size_t_size 4 /**/ +#define Size_t_size 8 /**/ /* Size_t: * This symbol holds the type used to declare length parameters diff --git a/win32/config_H.vc b/win32/config_H.vc index 62addd119aef..4b88f66938f1 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -9,8 +9,8 @@ /* Package name : perl5 * Source directory : - * Configuration time: Tue Oct 17 08:29:51 2017 - * Configured by : shay + * Configuration time: Wed Oct 7 16:25:12 2020 + * Configured by : tony * Target system : */ @@ -216,7 +216,7 @@ * This symbol, if defined, indicates that the lstat routine is * available to do file stats on symbolic links. */ -/*#define HAS_LSTAT / **/ +#define HAS_LSTAT /**/ /* HAS_MBLEN: * This symbol, if defined, indicates that the mblen routine is available @@ -257,6 +257,12 @@ */ #define HAS_MKTIME /**/ +/* HAS_MSG: + * This symbol, if defined, indicates that the entire msg*(2) library is + * supported (IPC mechanism based on message queues). + */ +/*#define HAS_MSG / **/ + /* HAS_MSYNC: * This symbol, if defined, indicates that the msync system call is * available to synchronize a mapped file. @@ -366,6 +372,12 @@ */ #define HAS_SELECT /**/ +/* HAS_SEM: + * This symbol, if defined, indicates that the entire sem*(2) library is + * supported. + */ +/*#define HAS_SEM / **/ + /* HAS_SETEGID: * This symbol, if defined, indicates that the setegid routine is available * to change the effective gid of the current program. @@ -392,12 +404,6 @@ */ /*#define HAS_SETLINEBUF / **/ -/* HAS_SETLOCALE: - * This symbol, if defined, indicates that the setlocale routine is - * available to handle locale-specific ctype implementations. - */ -#define HAS_SETLOCALE /**/ - /* HAS_SETPGID: * This symbol, if defined, indicates that the setpgid(pid, gpid) * routine is available to set process group ID. @@ -796,14 +802,14 @@ /*#define HAS_EACCESS / **/ /* I_SYS_ACCESS: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_SYS_ACCESS / **/ /* I_SYS_SECURITY: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_SYS_SECURITY / **/ @@ -811,7 +817,7 @@ * This symbol contains the number of bytes required to align a * double, or a long double when applicable. Usual values are 2, * 4 and 8. The default is eight, for safety. For cross-compiling - * or multiarch support, Configure will set a minimum of 8. + * or multiarch support, Configure will set a minimum of 8. */ #define MEM_ALIGNBYTES 8 @@ -843,7 +849,7 @@ # endif # endif #else -#define BYTEORDER 0x1234 /* large digits for MSB */ +#define BYTEORDER 0x12345678 /* large digits for MSB */ #endif /* CHARBITS: @@ -914,7 +920,7 @@ * the GNU C library is being used. A better check is to use * the __GLIBC__ and __GLIBC_MINOR__ symbols supplied with glibc. */ -/*#define HAS_GNULIBC / **/ +/*#define HAS_GNULIBC / **/ #if defined(HAS_GNULIBC) && !defined(_GNU_SOURCE) # define _GNU_SOURCE #endif @@ -1066,12 +1072,12 @@ * This symbol is defined if using the FILE_ptr macro as an lvalue * to increase the pointer by n leaves File_cnt(fp) unchanged. */ -#define USE_STDIO_PTR /**/ +#define USE_STDIO_PTR /**/ #ifdef USE_STDIO_PTR -#define FILE_ptr(fp) ((fp)->_ptr) -#define STDIO_PTR_LVALUE /**/ -#define FILE_cnt(fp) ((fp)->_cnt) -#define STDIO_CNT_LVALUE /**/ +#define FILE_ptr(fp) PERLIO_FILE_ptr(fp) +#define STDIO_PTR_LVALUE /**/ +#define FILE_cnt(fp) PERLIO_FILE_cnt(fp) +#define STDIO_CNT_LVALUE /**/ /*#define STDIO_PTR_LVAL_SETS_CNT / **/ #define STDIO_PTR_LVAL_NOCHANGE_CNT /**/ #endif @@ -1096,10 +1102,10 @@ * structure pointed to its argument. This macro will always be defined * if USE_STDIO_BASE is defined. */ -#define USE_STDIO_BASE /**/ +#define USE_STDIO_BASE /**/ #ifdef USE_STDIO_BASE -#define FILE_base(fp) ((fp)->_base) -#define FILE_bufsiz(fp) ((fp)->_cnt + (fp)->_ptr - (fp)->_base) +#define FILE_base(fp) PERLIO_FILE_base(fp) +#define FILE_bufsiz(fp) (PERLIO_FILE_cnt(fp) + PERLIO_FILE_ptr(fp) - PERLIO_FILE_base(fp)) #endif /* DOUBLESIZE: @@ -1109,8 +1115,8 @@ #define DOUBLESIZE 8 /**/ /* I_TIME: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol is always defined, and indicates to the C program that + * it should include . */ /* I_SYS_TIME: * This symbol, if defined, indicates to the C program that it should @@ -1167,7 +1173,7 @@ * the compiler supports (void *); otherwise it will be * sizeof(char *). */ -#define PTRSIZE 4 /**/ +#define PTRSIZE 8 /**/ /* Drand01: * This macro is to be used to generate uniformly distributed @@ -1202,13 +1208,13 @@ * to get any typedef'ed information. * We will pick a type such that sizeof(SSize_t) == sizeof(Size_t). */ -#define SSize_t int /* signed count of bytes */ +#define SSize_t __int64 /* signed count of bytes */ /* EBCDIC: * This symbol, if defined, indicates that this system uses * EBCDIC encoding. */ -/*#define EBCDIC / **/ +/*#define EBCDIC / **/ /* ARCHLIB: * This variable, if defined, holds the name of the directory in @@ -1240,7 +1246,7 @@ */ #define BIN "c:\\perl\\bin" /**/ #define BIN_EXP "c:\\perl\\bin" /**/ -#define PERL_RELOCATABLE_INC "undef" /**/ +#define PERL_RELOCATABLE_INC "undef" /**/ /* PERL_INC_VERSION_LIST: * This variable specifies the list of subdirectories in over @@ -1253,7 +1259,7 @@ /* INSTALL_USR_BIN_PERL: * This symbol, if defined, indicates that Perl is to be installed - * also as /usr/bin/perl. + * also as /usr/bin/perl. */ /*#define INSTALL_USR_BIN_PERL / **/ @@ -1363,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "6.1" /**/ +#define OSVERS "10.0.18363.1082" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -1389,7 +1395,7 @@ /* CPPSTDIN: * This symbol contains the first part of the string which will invoke * the C preprocessor on the standard input and produce to standard - * output. Typical value of "cc -E" or "/lib/cpp", but it can also + * output. Typical value of "cc -E" or "/lib/cpp", but it can also * call a wrapper. See CPPRUN. */ /* CPPMINUS: @@ -1450,6 +1456,10 @@ /* HASATTRIBUTE_WARN_UNUSED_RESULT: * Can we handle GCC attribute for warning on unused results */ +/* HASATTRIBUTE_ALWAYS_INLINE: + * Can we handle GCC attribute for functions that should always be + * inlined. + */ /*#define HASATTRIBUTE_DEPRECATED / **/ /*#define HASATTRIBUTE_FORMAT / **/ /*#define PRINTF_FORMAT_NULL_OK / **/ @@ -1459,6 +1469,7 @@ /*#define HASATTRIBUTE_PURE / **/ /*#define HASATTRIBUTE_UNUSED / **/ /*#define HASATTRIBUTE_WARN_UNUSED_RESULT / **/ +/*#define HASATTRIBUTE_ALWAYS_INLINE / **/ /* HAS_BACKTRACE: * This symbol, if defined, indicates that the backtrace() routine is @@ -1721,6 +1732,8 @@ * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_BE * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LE_BE * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BE_LE + * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_LITTLE_ENDIAN + * LONG_DOUBLE_IS_DOUBLEDOUBLE_128_BIT_BIG_ENDIAN * LONG_DOUBLE_IS_VAX_H_FLOAT * LONG_DOUBLE_IS_UNKNOWN_FORMAT * It is only defined if the system supports long doubles. @@ -1806,18 +1819,6 @@ /*#define HAS_MMAP / **/ #define Mmap_t void * /**/ -/* HAS_MSG: - * This symbol, if defined, indicates that the entire msg*(2) library is - * supported (IPC mechanism based on message queues). - */ -/*#define HAS_MSG / **/ - -/* HAS_SEM: - * This symbol, if defined, indicates that the entire sem*(2) library is - * supported. - */ -/*#define HAS_SEM / **/ - /* HAS_SETGRENT: * This symbol, if defined, indicates that the setgrent routine is * available for initializing sequential access of the group database. @@ -1910,6 +1911,10 @@ * This symbol, if defined, indicates the availability of * struct sockaddr_in6; */ +/* HAS_SOCKADDR_STORAGE: + * This symbol, if defined, indicates the availability of + * struct sockaddr_storage; + */ /* HAS_SIN6_SCOPE_ID: * This symbol, if defined, indicates that the struct sockaddr_in6 * structure has a member called sin6_scope_id. @@ -1934,6 +1939,7 @@ /*#define HAS_SOCKETPAIR / **/ /*#define HAS_SOCKADDR_SA_LEN / **/ /*#define HAS_SOCKADDR_IN6 / **/ +#define HAS_SOCKADDR_STORAGE /**/ #define HAS_SIN6_SCOPE_ID /**/ /*#define HAS_IP_MREQ / **/ /*#define HAS_IP_MREQ_SOURCE / **/ @@ -1945,7 +1951,7 @@ * st_blksize and st_blocks. */ #ifndef USE_STAT_BLOCKS -/*#define USE_STAT_BLOCKS / **/ +/*#define USE_STAT_BLOCKS / **/ #endif /* HAS_SYS_ERRLIST: @@ -1965,11 +1971,11 @@ * This symbol, if defined, indicates that the union semun is * defined by including . If not, the user code * probably needs to define it as: - * union semun { + * union semun { * int val; * struct semid_ds *buf; * unsigned short *array; - * } + * } */ /* USE_SEMCTL_SEMUN: * This symbol, if defined, indicates that union semun is @@ -2164,7 +2170,7 @@ /* Free_t: * This variable contains the return type of free(). It is usually - * void, but occasionally int. + * void, but occasionally int. */ /* Malloc_t: * This symbol is the type of pointer returned by malloc and realloc. @@ -2260,7 +2266,7 @@ * This symbol, if defined, indicates that the atoll routine is * available to convert strings into long longs. */ -/*#define HAS_ATOLL / **/ +#define HAS_ATOLL /**/ /* HAS__FWALK: * This symbol, if defined, indicates that the _fwalk system call is @@ -2268,6 +2274,12 @@ */ /*#define HAS__FWALK / **/ +/* HAS_ACCEPT4: + * This symbol, if defined, indicates that the accept4 routine is + * available to accept socket connections. + */ +/*#define HAS_ACCEPT4 / **/ + /* HAS_ACOSH: * This symbol, if defined, indicates that the acosh routine is * available to do the inverse hyperbolic cosine function. @@ -2302,6 +2314,22 @@ /*#define HAS_BUILTIN_EXPECT / **/ /*#define HAS_BUILTIN_CHOOSE_EXPR / **/ +/* HAS_BUILTIN_ADD_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_add_overflow for adding integers with overflow checks. + */ +/* HAS_BUILTIN_SUB_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_sub_overflow for subtracting integers with overflow checks. + */ +/* HAS_BUILTIN_MUL_OVERFLOW: + * This symbol, if defined, indicates that the compiler supports + * __builtin_mul_overflow for multiplying integers with overflow checks. + */ +/*#define HAS_BUILTIN_ADD_OVERFLOW / **/ +/*#define HAS_BUILTIN_SUB_OVERFLOW / **/ +/*#define HAS_BUILTIN_MUL_OVERFLOW / **/ + /* HAS_C99_VARIADIC_MACROS: * If defined, the compiler supports C99 variadic macros. */ @@ -2381,7 +2409,13 @@ * makes sense if you *have* dlsym, which we will presume is the * case if you're using dl_dlopen.xs. */ -/*#define DLSYM_NEEDS_UNDERSCORE / **/ +/*#define DLSYM_NEEDS_UNDERSCORE / **/ + +/* HAS_DUP3: + * This symbol, if defined, indicates that the dup3 routine is + * available to duplicate file descriptors. + */ +/*#define HAS_DUP3 / **/ /* HAS_ERF: * This symbol, if defined, indicates that the erf routine is @@ -2533,22 +2567,22 @@ * available to classify doubles. Available for example in HP-UX. * The returned values are defined in and are * - * FP_NORMAL Normalized - * FP_ZERO Zero - * FP_INFINITE Infinity - * FP_SUBNORMAL Denormalized - * FP_NAN NaN + * FP_NORMAL Normalized + * FP_ZERO Zero + * FP_INFINITE Infinity + * FP_SUBNORMAL Denormalized + * FP_NAN NaN * */ /* HAS_FP_CLASSIFY: * This symbol, if defined, indicates that the fp_classify routine is * available to classify doubles. The values are defined in * - * FP_NORMAL Normalized - * FP_ZERO Zero - * FP_INFINITE Infinity - * FP_SUBNORMAL Denormalized - * FP_NAN NaN + * FP_NORMAL Normalized + * FP_ZERO Zero + * FP_INFINITE Infinity + * FP_SUBNORMAL Denormalized + * FP_NAN NaN * */ /*#define HAS_FPCLASSIFY / **/ @@ -2581,7 +2615,7 @@ /* HAS_FPOS64_T: * This symbol will be defined if the C compiler supports fpos64_t. */ -/*#define HAS_FPOS64_T / **/ +/*#define HAS_FPOS64_T / **/ /* HAS_FREXPL: * This symbol, if defined, indicates that the frexpl routine is @@ -2752,8 +2786,8 @@ /*#define HAS_INETPTON / **/ /* HAS_INT64_T: - * This symbol will defined if the C compiler supports int64_t. - * Usually the needs to be included, but sometimes + * This symbol will defined if the C compiler supports int64_t. + * Usually the needs to be included, but sometimes * is enough. */ /*#define HAS_INT64_T / **/ @@ -2838,7 +2872,7 @@ * of significant digits in a long double precision number. Unlike * for DBL_DIG, there's no good guess for LDBL_DIG if it is undefined. */ -#define HAS_LDBL_DIG /**/ +#define HAS_LDBL_DIG /**/ /* HAS_LGAMMA: * This symbol, if defined, indicates that the lgamma routine is @@ -2954,6 +2988,9 @@ * This symbol, if defined, indicates that the memmem routine is * available to return a pointer to the start of the first occurrence * of a substring in a memory area (or NULL if not found). + * In glibc, memmem is a GNU extension. The function is visible in + * libc, but the prototype is only visible if _GNU_SOURCE is #defined. + * Thus we only define this if both the prototype and symbol are found. */ /*#define HAS_MEMMEM / **/ @@ -2970,6 +3007,13 @@ */ /*#define HAS_MKDTEMP / **/ +/* HAS_MKOSTEMP: + * This symbol, if defined, indicates that the mkostemp routine is + * available to exclusively create and open a uniquely named (with a + * suffix) temporary file. + */ +/*#define HAS_MKOSTEMP / **/ + /* HAS_MKSTEMPS: * This symbol, if defined, indicates that the mkstemps routine is * available to exclusively create and open a uniquely named @@ -3008,6 +3052,12 @@ */ /*#define HAS_NAN / **/ +/* HAS_NANOSLEEP: + * This symbol, if defined, indicates that the nanosleep + * system call is available to sleep with 1E-9 sec accuracy. + */ +/*#define HAS_NANOSLEEP / **/ + /* HAS_NEARBYINT: * This symbol, if defined, indicates that the nearbyint routine is * available to return the integral value closest to (according to @@ -3028,6 +3078,10 @@ * This symbol, if defined, indicates that the uselocale routine is * available to set the current locale for the calling thread. */ +/* HAS_DUPLOCALE: + * This symbol, if defined, indicates that the duplocale routine is + * available to duplicate a locale object. + */ /* HAS_QUERYLOCALE: * This symbol, if defined, indicates that the querylocale routine is * available to return the name of the locale for a category mask. @@ -3039,6 +3093,7 @@ /*#define HAS_NEWLOCALE / **/ /*#define HAS_FREELOCALE / **/ /*#define HAS_USELOCALE / **/ +/*#define HAS_DUPLOCALE / **/ /*#define HAS_QUERYLOCALE / **/ /*#define I_XLOCALE / **/ @@ -3066,7 +3121,13 @@ /* HAS_OFF64_T: * This symbol will be defined if the C compiler supports off64_t. */ -/*#define HAS_OFF64_T / **/ +/*#define HAS_OFF64_T / **/ + +/* HAS_PIPE2: + * This symbol, if defined, indicates that the pipe2 routine is + * available to create an inter-process channel. + */ +/*#define HAS_PIPE2 / **/ /* HAS_PRCTL: * This symbol, if defined, indicates that the prctl routine is @@ -3105,7 +3166,7 @@ /* HAS_PTRDIFF_T: * This symbol will be defined if the C compiler supports ptrdiff_t. */ -#define HAS_PTRDIFF_T /**/ +#define HAS_PTRDIFF_T /**/ /* HAS_READV: * This symbol, if defined, indicates that the readv routine is @@ -3179,6 +3240,17 @@ */ /*#define HAS_SETITIMER / **/ +/* HAS_SETLOCALE: + * This symbol, if defined, indicates that the setlocale routine is + * available to handle locale-specific ctype implementations. + */ +/* SETLOCALE_ACCEPTS_ANY_LOCALE_NAME: + * This symbol, if defined, indicates that the setlocale routine is + * available and it accepts any input locale name as valid. + */ +#define HAS_SETLOCALE /**/ +/*#define SETLOCALE_ACCEPTS_ANY_LOCALE_NAME / **/ + /* HAS_SETPROCTITLE: * This symbol, if defined, indicates that the setproctitle routine is * available to set process title. @@ -3311,6 +3383,12 @@ */ /*#define HAS_STRLCPY / **/ +/* HAS_STRNLEN: + * This symbol, if defined, indicates that the strnlen () routine is + * available to check the length of a string up to a maximum. + */ +/*#define HAS_STRNLEN / **/ + /* HAS_STRTOLD: * This symbol, if defined, indicates that the strtold routine is * available to convert strings to long doubles. @@ -3321,7 +3399,7 @@ * This symbol, if defined, indicates that the strtoll routine is * available to convert strings to long longs. */ -/*#define HAS_STRTOLL / **/ +#define HAS_STRTOLL /**/ /* HAS_STRTOQ: * This symbol, if defined, indicates that the strtoq routine is @@ -3333,7 +3411,7 @@ * This symbol, if defined, indicates that the strtoull routine is * available to convert strings to unsigned long longs. */ -/*#define HAS_STRTOULL / **/ +#define HAS_STRTOULL /**/ /* HAS_STRTOUQ: * This symbol, if defined, indicates that the strtouq routine is @@ -3401,6 +3479,18 @@ */ /*#define HAS_TIMEGM / **/ +/* HAS_TOWLOWER: + * This symbol, if defined, indicates that the towlower () routine is + * available to do case conversion. + */ +/*#define HAS_TOWLOWER / **/ + +/* HAS_TOWUPPER: + * This symbol, if defined, indicates that the towupper () routine is + * available to do case conversion. + */ +/*#define HAS_TOWUPPER / **/ + /* HAS_TRUNC: * This symbol, if defined, indicates that the trunc routine is * available to round doubles towards zero. @@ -3478,6 +3568,12 @@ */ #define DEFAULT_INC_EXCLUDES_DOT /**/ +/* USE_STRICT_BY_DEFAULT + * This symbol, if defined, enables additional defaults. + * At this time it only enables implicit strict by default. + */ +/*#define USE_STRICT_BY_DEFAULT / * use strict by default */ + /* USE_DYNAMIC_LOADING: * This symbol, if defined, indicates that dynamic loading of * some sort is available. @@ -3497,8 +3593,8 @@ * Note that if fflushNULL is defined, fflushall will not * even be probed for and will be left undefined. */ -#define FFLUSH_NULL /**/ -/*#define FFLUSH_ALL / **/ +#define FFLUSH_NULL /**/ +/*#define FFLUSH_ALL / **/ /* I_BFD: * This symbol, if defined, indicates that exists and @@ -3537,10 +3633,10 @@ * For DB version 1 this is always 0. */ #define DB_Hash_t int /**/ -#define DB_Prefix_t int /**/ -#define DB_VERSION_MAJOR_CFG 0 /**/ -#define DB_VERSION_MINOR_CFG 0 /**/ -#define DB_VERSION_PATCH_CFG 0 /**/ +#define DB_Prefix_t int /**/ +#define DB_VERSION_MAJOR_CFG 0 /**/ +#define DB_VERSION_MINOR_CFG 0 /**/ +#define DB_VERSION_PATCH_CFG 0 /**/ /* I_FENV: * This symbol, if defined, indicates to the C program that it should @@ -3567,8 +3663,8 @@ /*#define I_IEEEFP / **/ /* I_INTTYPES: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_INTTYPES / **/ @@ -3597,8 +3693,8 @@ /*#define I_MNTENT / **/ /* I_NETINET_TCP: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_NETINET_TCP / **/ @@ -3636,13 +3732,13 @@ * This symbol, if defined, indicates that exists and * can be included. */ -/*#define I_STDBOOL / **/ +#define I_STDBOOL /**/ /* I_STDINT: * This symbol, if defined, indicates that exists and * should be included. */ -/*#define I_STDINT / **/ +#define I_STDINT /**/ /* I_SUNMATH: * This symbol, if defined, indicates that exists and @@ -3697,6 +3793,17 @@ */ /*#define I_USTAT / **/ +/* I_WCHAR: + * This symbol, if defined, indicates to the C program that + * is available for inclusion + */ +/*#define I_WCHAR / **/ + +/* I_WCTYPE: + * This symbol, if defined, indicates that exists. + */ +/*#define I_WCTYPE / **/ + /* DOUBLEINFBYTES: * This symbol, if defined, is a comma-separated list of * hexadecimal bytes for the double precision infinity. @@ -3937,8 +4044,8 @@ * This symbol, if defined, indicates that a variable of type NVTYPE * stores 0.0 in memory as all bits zero. */ -#define IVTYPE long /**/ -#define UVTYPE unsigned long /**/ +#define IVTYPE __int64 /**/ +#define UVTYPE unsigned __int64 /**/ #define I8TYPE char /**/ #define U8TYPE unsigned char /**/ #define I16TYPE short /**/ @@ -3950,8 +4057,8 @@ #define U64TYPE unsigned __int64 /**/ #endif #define NVTYPE double /**/ -#define IVSIZE 4 /**/ -#define UVSIZE 4 /**/ +#define IVSIZE 8 /**/ +#define UVSIZE 8 /**/ #define I8SIZE 1 /**/ #define U8SIZE 1 /**/ #define I16SIZE 2 /**/ @@ -3963,9 +4070,9 @@ #define U64SIZE 8 /**/ #endif #define NVSIZE 8 /**/ -#define NV_PRESERVES_UV -#define NV_PRESERVES_UV_BITS 32 -#define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0 +#undef NV_PRESERVES_UV +#define NV_PRESERVES_UV_BITS 53 +#define NV_OVERFLOWS_INTEGERS_AT (256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0) #define NV_ZERO_IS_ALLBITS_ZERO #if UVSIZE == 8 # ifdef BYTEORDER @@ -4013,11 +4120,11 @@ * This symbol defines the format string used for printing a Perl NV * using %g-ish floating point format. */ -#define IVdf "ld" /**/ -#define UVuf "lu" /**/ -#define UVof "lo" /**/ -#define UVxf "lx" /**/ -#define UVXf "lX" /**/ +#define IVdf "I64d" /**/ +#define UVuf "I64u" /**/ +#define UVof "I64o" /**/ +#define UVxf "I64x" /**/ +#define UVXf "I64X" /**/ #define NVef "e" /**/ #define NVff "f" /**/ #define NVgf "g" /**/ @@ -4029,7 +4136,7 @@ * is either n or 32*ceil(n/32), especially many little-endians do * the latter. This is only useful if you have select(), naturally. */ -#define SELECT_MIN_BITS 32 /**/ +#define SELECT_MIN_BITS 32 /**/ /* ST_INO_SIZE: * This variable contains the size of struct stat's st_ino in bytes. @@ -4039,7 +4146,7 @@ * 1 for unsigned, -1 for signed. */ #define ST_INO_SIGN 1 /* st_ino sign */ -#define ST_INO_SIZE 4 /* st_ino size */ +#define ST_INO_SIZE 8 /* st_ino size */ /* STARTPERL: * This variable contains the string to put in front of a perl @@ -4077,9 +4184,9 @@ * This symbol contains the minimum value for the time_t offset that * the system function localtime () accepts, and defaults to 0 */ -#define GMTIME_MAX 2147483647 /**/ +#define GMTIME_MAX 32535291599 /**/ #define GMTIME_MIN 0 /**/ -#define LOCALTIME_MAX 2147483647 /**/ +#define LOCALTIME_MAX 32535244799 /**/ #define LOCALTIME_MIN 0 /**/ /* USE_64_BIT_INT: @@ -4101,7 +4208,7 @@ * you may need at least to reboot your OS to 64-bit mode. */ #ifndef USE_64_BIT_INT -/*#define USE_64_BIT_INT / **/ +#define USE_64_BIT_INT /**/ #endif #ifndef USE_64_BIT_ALL /*#define USE_64_BIT_ALL / **/ @@ -4131,7 +4238,7 @@ /* USE_KERN_PROC_PATHNAME: * This symbol, if defined, indicates that we can use sysctl with * KERN_PROC_PATHNAME to get a full path for the executable, and hence - * convert $^X to an absolute path. + * convert $^X to an absolute path. */ /*#define USE_KERN_PROC_PATHNAME / **/ @@ -4274,7 +4381,7 @@ * is defined, and 'int *' otherwise. This is only useful if you * have select(), of course. */ -#define Select_fd_set_t Perl_fd_set * /**/ +#define Select_fd_set_t Perl_fd_set * /**/ /* Sock_size_t: * This symbol holds the type used for the size argument of @@ -4288,7 +4395,7 @@ * where library files may be held under a private library, for * instance. */ -#define ARCHNAME "MSWin32-x86-perlio" /**/ +#define ARCHNAME "MSWin32-x64-perlio" /**/ /* HAS_ASCTIME_R: * This symbol, if defined, indicates that the asctime_r routine @@ -4300,8 +4407,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_asctime_r * is defined. */ -/*#define HAS_ASCTIME_R / **/ -#define ASCTIME_R_PROTO 0 /**/ +/*#define HAS_ASCTIME_R / **/ +#define ASCTIME_R_PROTO 0 /**/ /* HAS_CRYPT_R: * This symbol, if defined, indicates that the crypt_r routine @@ -4313,8 +4420,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_crypt_r * is defined. */ -/*#define HAS_CRYPT_R / **/ -#define CRYPT_R_PROTO 0 /**/ +/*#define HAS_CRYPT_R / **/ +#define CRYPT_R_PROTO 0 /**/ /* HAS_CTERMID_R: * This symbol, if defined, indicates that the ctermid_r routine @@ -4326,8 +4433,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctermid_r * is defined. */ -/*#define HAS_CTERMID_R / **/ -#define CTERMID_R_PROTO 0 /**/ +/*#define HAS_CTERMID_R / **/ +#define CTERMID_R_PROTO 0 /**/ /* HAS_CTIME_R: * This symbol, if defined, indicates that the ctime_r routine @@ -4339,8 +4446,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ctime_r * is defined. */ -/*#define HAS_CTIME_R / **/ -#define CTIME_R_PROTO 0 /**/ +/*#define HAS_CTIME_R / **/ +#define CTIME_R_PROTO 0 /**/ /* HAS_DRAND48_R: * This symbol, if defined, indicates that the drand48_r routine @@ -4352,8 +4459,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_drand48_r * is defined. */ -/*#define HAS_DRAND48_R / **/ -#define DRAND48_R_PROTO 0 /**/ +/*#define HAS_DRAND48_R / **/ +#define DRAND48_R_PROTO 0 /**/ /* HAS_ENDGRENT_R: * This symbol, if defined, indicates that the endgrent_r routine @@ -4365,8 +4472,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endgrent_r * is defined. */ -/*#define HAS_ENDGRENT_R / **/ -#define ENDGRENT_R_PROTO 0 /**/ +/*#define HAS_ENDGRENT_R / **/ +#define ENDGRENT_R_PROTO 0 /**/ /* HAS_ENDHOSTENT_R: * This symbol, if defined, indicates that the endhostent_r routine @@ -4378,8 +4485,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endhostent_r * is defined. */ -/*#define HAS_ENDHOSTENT_R / **/ -#define ENDHOSTENT_R_PROTO 0 /**/ +/*#define HAS_ENDHOSTENT_R / **/ +#define ENDHOSTENT_R_PROTO 0 /**/ /* HAS_ENDNETENT_R: * This symbol, if defined, indicates that the endnetent_r routine @@ -4391,8 +4498,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endnetent_r * is defined. */ -/*#define HAS_ENDNETENT_R / **/ -#define ENDNETENT_R_PROTO 0 /**/ +/*#define HAS_ENDNETENT_R / **/ +#define ENDNETENT_R_PROTO 0 /**/ /* HAS_ENDPROTOENT_R: * This symbol, if defined, indicates that the endprotoent_r routine @@ -4404,8 +4511,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endprotoent_r * is defined. */ -/*#define HAS_ENDPROTOENT_R / **/ -#define ENDPROTOENT_R_PROTO 0 /**/ +/*#define HAS_ENDPROTOENT_R / **/ +#define ENDPROTOENT_R_PROTO 0 /**/ /* HAS_ENDPWENT_R: * This symbol, if defined, indicates that the endpwent_r routine @@ -4417,8 +4524,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endpwent_r * is defined. */ -/*#define HAS_ENDPWENT_R / **/ -#define ENDPWENT_R_PROTO 0 /**/ +/*#define HAS_ENDPWENT_R / **/ +#define ENDPWENT_R_PROTO 0 /**/ /* HAS_ENDSERVENT_R: * This symbol, if defined, indicates that the endservent_r routine @@ -4430,8 +4537,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_endservent_r * is defined. */ -/*#define HAS_ENDSERVENT_R / **/ -#define ENDSERVENT_R_PROTO 0 /**/ +/*#define HAS_ENDSERVENT_R / **/ +#define ENDSERVENT_R_PROTO 0 /**/ /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine @@ -4443,8 +4550,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrent_r * is defined. */ -/*#define HAS_GETGRENT_R / **/ -#define GETGRENT_R_PROTO 0 /**/ +/*#define HAS_GETGRENT_R / **/ +#define GETGRENT_R_PROTO 0 /**/ /* HAS_GETGRGID_R: * This symbol, if defined, indicates that the getgrgid_r routine @@ -4456,8 +4563,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrgid_r * is defined. */ -/*#define HAS_GETGRGID_R / **/ -#define GETGRGID_R_PROTO 0 /**/ +/*#define HAS_GETGRGID_R / **/ +#define GETGRGID_R_PROTO 0 /**/ /* HAS_GETGRNAM_R: * This symbol, if defined, indicates that the getgrnam_r routine @@ -4469,8 +4576,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getgrnam_r * is defined. */ -/*#define HAS_GETGRNAM_R / **/ -#define GETGRNAM_R_PROTO 0 /**/ +/*#define HAS_GETGRNAM_R / **/ +#define GETGRNAM_R_PROTO 0 /**/ /* HAS_GETHOSTBYADDR_R: * This symbol, if defined, indicates that the gethostbyaddr_r routine @@ -4482,8 +4589,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyaddr_r * is defined. */ -/*#define HAS_GETHOSTBYADDR_R / **/ -#define GETHOSTBYADDR_R_PROTO 0 /**/ +/*#define HAS_GETHOSTBYADDR_R / **/ +#define GETHOSTBYADDR_R_PROTO 0 /**/ /* HAS_GETHOSTBYNAME_R: * This symbol, if defined, indicates that the gethostbyname_r routine @@ -4495,8 +4602,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostbyname_r * is defined. */ -/*#define HAS_GETHOSTBYNAME_R / **/ -#define GETHOSTBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETHOSTBYNAME_R / **/ +#define GETHOSTBYNAME_R_PROTO 0 /**/ /* HAS_GETHOSTENT_R: * This symbol, if defined, indicates that the gethostent_r routine @@ -4508,8 +4615,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gethostent_r * is defined. */ -/*#define HAS_GETHOSTENT_R / **/ -#define GETHOSTENT_R_PROTO 0 /**/ +/*#define HAS_GETHOSTENT_R / **/ +#define GETHOSTENT_R_PROTO 0 /**/ /* HAS_GETLOGIN_R: * This symbol, if defined, indicates that the getlogin_r routine @@ -4521,8 +4628,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getlogin_r * is defined. */ -/*#define HAS_GETLOGIN_R / **/ -#define GETLOGIN_R_PROTO 0 /**/ +/*#define HAS_GETLOGIN_R / **/ +#define GETLOGIN_R_PROTO 0 /**/ /* HAS_GETNETBYADDR_R: * This symbol, if defined, indicates that the getnetbyaddr_r routine @@ -4534,8 +4641,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyaddr_r * is defined. */ -/*#define HAS_GETNETBYADDR_R / **/ -#define GETNETBYADDR_R_PROTO 0 /**/ +/*#define HAS_GETNETBYADDR_R / **/ +#define GETNETBYADDR_R_PROTO 0 /**/ /* HAS_GETNETBYNAME_R: * This symbol, if defined, indicates that the getnetbyname_r routine @@ -4547,8 +4654,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetbyname_r * is defined. */ -/*#define HAS_GETNETBYNAME_R / **/ -#define GETNETBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETNETBYNAME_R / **/ +#define GETNETBYNAME_R_PROTO 0 /**/ /* HAS_GETNETENT_R: * This symbol, if defined, indicates that the getnetent_r routine @@ -4560,8 +4667,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getnetent_r * is defined. */ -/*#define HAS_GETNETENT_R / **/ -#define GETNETENT_R_PROTO 0 /**/ +/*#define HAS_GETNETENT_R / **/ +#define GETNETENT_R_PROTO 0 /**/ /* HAS_GETPROTOBYNAME_R: * This symbol, if defined, indicates that the getprotobyname_r routine @@ -4573,8 +4680,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobyname_r * is defined. */ -/*#define HAS_GETPROTOBYNAME_R / **/ -#define GETPROTOBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETPROTOBYNAME_R / **/ +#define GETPROTOBYNAME_R_PROTO 0 /**/ /* HAS_GETPROTOBYNUMBER_R: * This symbol, if defined, indicates that the getprotobynumber_r routine @@ -4586,8 +4693,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotobynumber_r * is defined. */ -/*#define HAS_GETPROTOBYNUMBER_R / **/ -#define GETPROTOBYNUMBER_R_PROTO 0 /**/ +/*#define HAS_GETPROTOBYNUMBER_R / **/ +#define GETPROTOBYNUMBER_R_PROTO 0 /**/ /* HAS_GETPROTOENT_R: * This symbol, if defined, indicates that the getprotoent_r routine @@ -4599,8 +4706,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getprotoent_r * is defined. */ -/*#define HAS_GETPROTOENT_R / **/ -#define GETPROTOENT_R_PROTO 0 /**/ +/*#define HAS_GETPROTOENT_R / **/ +#define GETPROTOENT_R_PROTO 0 /**/ /* HAS_GETPWENT_R: * This symbol, if defined, indicates that the getpwent_r routine @@ -4612,8 +4719,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwent_r * is defined. */ -/*#define HAS_GETPWENT_R / **/ -#define GETPWENT_R_PROTO 0 /**/ +/*#define HAS_GETPWENT_R / **/ +#define GETPWENT_R_PROTO 0 /**/ /* HAS_GETPWNAM_R: * This symbol, if defined, indicates that the getpwnam_r routine @@ -4625,8 +4732,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwnam_r * is defined. */ -/*#define HAS_GETPWNAM_R / **/ -#define GETPWNAM_R_PROTO 0 /**/ +/*#define HAS_GETPWNAM_R / **/ +#define GETPWNAM_R_PROTO 0 /**/ /* HAS_GETPWUID_R: * This symbol, if defined, indicates that the getpwuid_r routine @@ -4638,8 +4745,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getpwuid_r * is defined. */ -/*#define HAS_GETPWUID_R / **/ -#define GETPWUID_R_PROTO 0 /**/ +/*#define HAS_GETPWUID_R / **/ +#define GETPWUID_R_PROTO 0 /**/ /* HAS_GETSERVBYNAME_R: * This symbol, if defined, indicates that the getservbyname_r routine @@ -4651,8 +4758,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyname_r * is defined. */ -/*#define HAS_GETSERVBYNAME_R / **/ -#define GETSERVBYNAME_R_PROTO 0 /**/ +/*#define HAS_GETSERVBYNAME_R / **/ +#define GETSERVBYNAME_R_PROTO 0 /**/ /* HAS_GETSERVBYPORT_R: * This symbol, if defined, indicates that the getservbyport_r routine @@ -4664,8 +4771,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservbyport_r * is defined. */ -/*#define HAS_GETSERVBYPORT_R / **/ -#define GETSERVBYPORT_R_PROTO 0 /**/ +/*#define HAS_GETSERVBYPORT_R / **/ +#define GETSERVBYPORT_R_PROTO 0 /**/ /* HAS_GETSERVENT_R: * This symbol, if defined, indicates that the getservent_r routine @@ -4677,8 +4784,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getservent_r * is defined. */ -/*#define HAS_GETSERVENT_R / **/ -#define GETSERVENT_R_PROTO 0 /**/ +/*#define HAS_GETSERVENT_R / **/ +#define GETSERVENT_R_PROTO 0 /**/ /* HAS_GETSPNAM_R: * This symbol, if defined, indicates that the getspnam_r routine @@ -4690,8 +4797,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_getspnam_r * is defined. */ -/*#define HAS_GETSPNAM_R / **/ -#define GETSPNAM_R_PROTO 0 /**/ +/*#define HAS_GETSPNAM_R / **/ +#define GETSPNAM_R_PROTO 0 /**/ /* HAS_GMTIME_R: * This symbol, if defined, indicates that the gmtime_r routine @@ -4703,8 +4810,14 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_gmtime_r * is defined. */ -/*#define HAS_GMTIME_R / **/ -#define GMTIME_R_PROTO 0 /**/ +/*#define HAS_GMTIME_R / **/ +#define GMTIME_R_PROTO 0 /**/ + +/* HAS_LOCALECONV_L: + * This symbol, if defined, indicates that the localeconv_l routine is + * available to query certain information about a locale. + */ +/*#define HAS_LOCALECONV_L / **/ /* HAS_LOCALTIME_R: * This symbol, if defined, indicates that the localtime_r routine @@ -4723,14 +4836,35 @@ #define L_R_TZSET #endif +/* L_R_TZSET: + * If localtime_r() needs tzset, it is defined in this define + */ /* LOCALTIME_R_PROTO: * This symbol encodes the prototype of localtime_r. * It is zero if d_localtime_r is undef, and one of the * REENTRANT_PROTO_T_ABC macros of reentr.h if d_localtime_r * is defined. */ -/*#define HAS_LOCALTIME_R / **/ -#define LOCALTIME_R_PROTO 0 /**/ +/*#define HAS_LOCALTIME_R / **/ +#define LOCALTIME_R_PROTO 0 /**/ + +/* HAS_MBRLEN: + * This symbol, if defined, indicates that the mbrlen routine is + * available to get the length of multi-byte character strings. + */ +/*#define HAS_MBRLEN / **/ + +/* HAS_MBRTOWC: + * This symbol, if defined, indicates that the mbrtowc routine is + * available to convert a multi-byte character into a wide character. + */ +/*#define HAS_MBRTOWC / **/ + +/* HAS_THREAD_SAFE_NL_LANGINFO_L: + * This symbol, when defined, indicates presence of the nl_langinfo_l() + * function, and that it is thread-safe. + */ +/*#define HAS_THREAD_SAFE_NL_LANGINFO_L / **/ /* OLD_PTHREAD_CREATE_JOINABLE: * This symbol, if defined, indicates how to create pthread @@ -4777,8 +4911,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_random_r * is defined. */ -/*#define HAS_RANDOM_R / **/ -#define RANDOM_R_PROTO 0 /**/ +/*#define HAS_RANDOM_R / **/ +#define RANDOM_R_PROTO 0 /**/ /* HAS_READDIR64_R: * This symbol, if defined, indicates that the readdir64_r routine @@ -4790,8 +4924,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir64_r * is defined. */ -/*#define HAS_READDIR64_R / **/ -#define READDIR64_R_PROTO 0 /**/ +/*#define HAS_READDIR64_R / **/ +#define READDIR64_R_PROTO 0 /**/ /* HAS_READDIR_R: * This symbol, if defined, indicates that the readdir_r routine @@ -4803,8 +4937,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_readdir_r * is defined. */ -/*#define HAS_READDIR_R / **/ -#define READDIR_R_PROTO 0 /**/ +/*#define HAS_READDIR_R / **/ +#define READDIR_R_PROTO 0 /**/ /* HAS_SETGRENT_R: * This symbol, if defined, indicates that the setgrent_r routine @@ -4816,8 +4950,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setgrent_r * is defined. */ -/*#define HAS_SETGRENT_R / **/ -#define SETGRENT_R_PROTO 0 /**/ +/*#define HAS_SETGRENT_R / **/ +#define SETGRENT_R_PROTO 0 /**/ /* HAS_SETHOSTENT_R: * This symbol, if defined, indicates that the sethostent_r routine @@ -4829,8 +4963,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_sethostent_r * is defined. */ -/*#define HAS_SETHOSTENT_R / **/ -#define SETHOSTENT_R_PROTO 0 /**/ +/*#define HAS_SETHOSTENT_R / **/ +#define SETHOSTENT_R_PROTO 0 /**/ /* HAS_SETLOCALE_R: * This symbol, if defined, indicates that the setlocale_r routine @@ -4842,8 +4976,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setlocale_r * is defined. */ -/*#define HAS_SETLOCALE_R / **/ -#define SETLOCALE_R_PROTO 0 /**/ +/*#define HAS_SETLOCALE_R / **/ +#define SETLOCALE_R_PROTO 0 /**/ /* HAS_SETNETENT_R: * This symbol, if defined, indicates that the setnetent_r routine @@ -4855,8 +4989,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setnetent_r * is defined. */ -/*#define HAS_SETNETENT_R / **/ -#define SETNETENT_R_PROTO 0 /**/ +/*#define HAS_SETNETENT_R / **/ +#define SETNETENT_R_PROTO 0 /**/ /* HAS_SETPROTOENT_R: * This symbol, if defined, indicates that the setprotoent_r routine @@ -4868,8 +5002,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setprotoent_r * is defined. */ -/*#define HAS_SETPROTOENT_R / **/ -#define SETPROTOENT_R_PROTO 0 /**/ +/*#define HAS_SETPROTOENT_R / **/ +#define SETPROTOENT_R_PROTO 0 /**/ /* HAS_SETPWENT_R: * This symbol, if defined, indicates that the setpwent_r routine @@ -4881,8 +5015,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setpwent_r * is defined. */ -/*#define HAS_SETPWENT_R / **/ -#define SETPWENT_R_PROTO 0 /**/ +/*#define HAS_SETPWENT_R / **/ +#define SETPWENT_R_PROTO 0 /**/ /* HAS_SETSERVENT_R: * This symbol, if defined, indicates that the setservent_r routine @@ -4894,8 +5028,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_setservent_r * is defined. */ -/*#define HAS_SETSERVENT_R / **/ -#define SETSERVENT_R_PROTO 0 /**/ +/*#define HAS_SETSERVENT_R / **/ +#define SETSERVENT_R_PROTO 0 /**/ /* HAS_SRAND48_R: * This symbol, if defined, indicates that the srand48_r routine @@ -4907,8 +5041,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srand48_r * is defined. */ -/*#define HAS_SRAND48_R / **/ -#define SRAND48_R_PROTO 0 /**/ +/*#define HAS_SRAND48_R / **/ +#define SRAND48_R_PROTO 0 /**/ /* HAS_SRANDOM_R: * This symbol, if defined, indicates that the srandom_r routine @@ -4920,8 +5054,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_srandom_r * is defined. */ -/*#define HAS_SRANDOM_R / **/ -#define SRANDOM_R_PROTO 0 /**/ +/*#define HAS_SRANDOM_R / **/ +#define SRANDOM_R_PROTO 0 /**/ /* HAS_STRERROR_R: * This symbol, if defined, indicates that the strerror_r routine @@ -4933,8 +5067,20 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_strerror_r * is defined. */ -/*#define HAS_STRERROR_R / **/ -#define STRERROR_R_PROTO 0 /**/ +/*#define HAS_STRERROR_R / **/ +#define STRERROR_R_PROTO 0 /**/ + +/* HAS_STRTOD_L: + * This symbol, if defined, indicates that the strtod_l routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOD_L / **/ + +/* HAS_STRTOLD_L: + * This symbol, if defined, indicates that the strtold_l routine is + * available to convert strings to long doubles. + */ +/*#define HAS_STRTOLD_L / **/ /* HAS_TMPNAM_R: * This symbol, if defined, indicates that the tmpnam_r routine @@ -4946,8 +5092,8 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_tmpnam_r * is defined. */ -/*#define HAS_TMPNAM_R / **/ -#define TMPNAM_R_PROTO 0 /**/ +/*#define HAS_TMPNAM_R / **/ +#define TMPNAM_R_PROTO 0 /**/ /* HAS_TTYNAME_R: * This symbol, if defined, indicates that the ttyname_r routine @@ -4959,18 +5105,24 @@ * REENTRANT_PROTO_T_ABC macros of reentr.h if d_ttyname_r * is defined. */ -/*#define HAS_TTYNAME_R / **/ -#define TTYNAME_R_PROTO 0 /**/ +/*#define HAS_TTYNAME_R / **/ +#define TTYNAME_R_PROTO 0 /**/ + +/* HAS_WCRTOMB: + * This symbol, if defined, indicates that the wcrtomb routine is + * available to convert a wide character into a multi-byte character. + */ +/*#define HAS_WCRTOMB / **/ /* I_MACH_CTHREADS: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_MACH_CTHREADS / **/ /* I_PTHREAD: - * This symbol, if defined, indicates to the C program that it should - * include . + * This symbol, if defined, indicates to the C program that it should + * include . */ /*#define I_PTHREAD / **/ @@ -5012,7 +5164,7 @@ /* HAS_TIMES: * This symbol, if defined, indicates that the times() routine exists. * Note that this became obsolete on some systems (SUNOS), which now - * use getrusage(). It may be necessary to include . + * use getrusage(). It may be necessary to include . */ #define HAS_TIMES /**/ @@ -5081,7 +5233,7 @@ /* Size_t_size: * This symbol holds the size of a Size_t in bytes. */ -#define Size_t_size 4 /**/ +#define Size_t_size 8 /**/ /* Size_t: * This symbol holds the type used to declare length parameters diff --git a/win32/perlhost.h b/win32/perlhost.h index f5ffca04e4ae..d00240f26ff6 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -995,7 +995,7 @@ PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin) int PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, Stat_t *buffer) { - return win32_stat(path, buffer); + return win32_lstat(path, buffer); } char* diff --git a/win32/win32.c b/win32/win32.c index 80b400886385..b7577156478d 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -39,6 +39,7 @@ #include #include #include +#include /* #include "config.h" */ @@ -1462,7 +1463,10 @@ win32_stat(const char *path, Stat_t *sbuf) dTHX; int res; int nlink = 1; + unsigned __int64 ino = 0; + DWORD vol = 0; BOOL expect_dir = FALSE; + struct _stati64 st; if (l > 1) { switch(path[l - 1]) { @@ -1508,11 +1512,16 @@ win32_stat(const char *path, Stat_t *sbuf) /* We must open & close the file once; otherwise file attribute changes */ /* might not yet have propagated to "other" hard links of the same file. */ /* This also gives us an opportunity to determine the number of links. */ - HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, 0, NULL); + HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); if (handle != INVALID_HANDLE_VALUE) { BY_HANDLE_FILE_INFORMATION bhi; - if (GetFileInformationByHandle(handle, &bhi)) + if (GetFileInformationByHandle(handle, &bhi)) { nlink = bhi.nNumberOfLinks; + ino = bhi.nFileIndexHigh; + ino <<= 32; + ino |= bhi.nFileIndexLow; + vol = bhi.dwVolumeSerialNumber; + } CloseHandle(handle); } else { @@ -1527,7 +1536,17 @@ win32_stat(const char *path, Stat_t *sbuf) /* path will be mapped correctly above */ res = _stati64(path, sbuf); + sbuf->st_dev = vol; + sbuf->st_ino = ino; + sbuf->st_mode = st.st_mode; sbuf->st_nlink = nlink; + sbuf->st_uid = st.st_uid; + sbuf->st_gid = st.st_gid; + sbuf->st_rdev = st.st_rdev; + sbuf->st_size = st.st_size; + sbuf->st_atime = st.st_atime; + sbuf->st_mtime = st.st_mtime; + sbuf->st_ctime = st.st_ctime; if (res < 0) { /* CRT is buggy on sharenames, so make sure it really isn't. @@ -1575,6 +1594,147 @@ win32_stat(const char *path, Stat_t *sbuf) return res; } +static void +translate_to_errno(void) +{ + /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for + both permissions errors and if the source is a directory, while + POSIX wants EACCES and EPERM respectively. + + Determined by experimentation on Windows 7 x64 SP1, since MS + don't document what error codes are returned. + */ + switch (GetLastError()) { + case ERROR_BAD_NET_NAME: + case ERROR_BAD_NETPATH: + case ERROR_BAD_PATHNAME: + case ERROR_FILE_NOT_FOUND: + case ERROR_FILENAME_EXCED_RANGE: + case ERROR_INVALID_DRIVE: + case ERROR_PATH_NOT_FOUND: + errno = ENOENT; + break; + case ERROR_ALREADY_EXISTS: + errno = EEXIST; + break; + case ERROR_ACCESS_DENIED: + case ERROR_PRIVILEGE_NOT_HELD: + errno = EACCES; + break; + case ERROR_NOT_SAME_DEVICE: + errno = EXDEV; + break; + case ERROR_DISK_FULL: + errno = ENOSPC; + break; + case ERROR_NOT_ENOUGH_QUOTA: + errno = EDQUOT; + break; + default: + /* ERROR_INVALID_FUNCTION - eg. symlink on a FAT volume */ + errno = EINVAL; + break; + } +} + +/* Adapted from: + +https://docs.microsoft.com/en-us/windows-hardware/drivers/ddi/ntifs/ns-ntifs-_reparse_data_buffer + +Renamed to avoid conflicts, apparently some SDKs define this +structure. + +Hoisted the symlink data into a new type to allow us to make a pointer +to it, and to avoid C++ scoping issues. + +*/ + +typedef struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + ULONG Flags; + WCHAR PathBuffer[MAX_PATH*3]; +} MY_SYMLINK_REPARSE_BUFFER, *PMY_SYMLINK_REPARSE_BUFFER; + +typedef struct { + ULONG ReparseTag; + USHORT ReparseDataLength; + USHORT Reserved; + union { + MY_SYMLINK_REPARSE_BUFFER SymbolicLinkReparseBuffer; + struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + WCHAR PathBuffer[1]; + } MountPointReparseBuffer; + struct { + UCHAR DataBuffer[1]; + } GenericReparseBuffer; + } Data; +} MY_REPARSE_DATA_BUFFER, *PMY_REPARSE_DATA_BUFFER; + +static BOOL +is_symlink(HANDLE h) { + MY_REPARSE_DATA_BUFFER linkdata; + const MY_SYMLINK_REPARSE_BUFFER * const sd = + &linkdata.Data.SymbolicLinkReparseBuffer; + DWORD linkdata_returned; + + if (!DeviceIoControl(h, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) { + return FALSE; + } + + if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer) + || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) { + /* some other type of reparse point */ + return FALSE; + } + + return TRUE; +} + +DllExport int +win32_lstat(const char *path, Stat_t *sbuf) +{ + HANDLE f; + int fd; + int result; + DWORD attr = GetFileAttributes(path); /* doesn't follow symlinks */ + + if (attr == INVALID_FILE_ATTRIBUTES) { + translate_to_errno(); + return -1; + } + + if (!(attr & FILE_ATTRIBUTE_REPARSE_POINT)) { + return win32_stat(path, sbuf); + } + + f = CreateFileA(path, GENERIC_READ, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0); + if (f == INVALID_HANDLE_VALUE) { + translate_to_errno(); + return -1; + } + + if (!is_symlink(f)) { + CloseHandle(f); + return win32_stat(path, sbuf); + } + + fd = win32_open_osfhandle((intptr_t)f, 0); + result = win32_fstat(fd, sbuf); + if (result != -1){ + sbuf->st_mode = (sbuf->st_mode & ~_S_IFMT) | _S_IFLNK; + } + close(fd); + return result; +} + #define isSLASH(c) ((c) == '/' || (c) == '\\') #define SKIP_SLASHES(s) \ STMT_START { \ @@ -1668,7 +1828,6 @@ win32_longpath(char *path) } else { /* failed a step, just return without side effects */ - /*PerlIO_printf(Perl_debug_log, "Failed to find %s\n", path);*/ errno = EINVAL; return NULL; } @@ -2955,7 +3114,39 @@ win32_abort(void) DllExport int win32_fstat(int fd, Stat_t *sbufptr) { - return _fstati64(fd, sbufptr); + int result; + struct _stati64 st; + dTHX; + result = _fstati64(fd, &st); + if (result == 0) { + sbufptr->st_mode = st.st_mode; + sbufptr->st_uid = st.st_uid; + sbufptr->st_gid = st.st_gid; + sbufptr->st_rdev = st.st_rdev; + sbufptr->st_size = st.st_size; + sbufptr->st_atime = st.st_atime; + sbufptr->st_mtime = st.st_mtime; + sbufptr->st_ctime = st.st_ctime; + + if (w32_sloppystat) { + sbufptr->st_nlink = st.st_nlink; + sbufptr->st_dev = st.st_dev; + sbufptr->st_ino = st.st_ino; + } + else { + HANDLE handle = (HANDLE)win32_get_osfhandle(fd); + BY_HANDLE_FILE_INFORMATION bhi; + if (GetFileInformationByHandle(handle, &bhi)) { + sbufptr->st_nlink = bhi.nNumberOfLinks; + sbufptr->st_ino = bhi.nFileIndexHigh; + sbufptr->st_ino <<= 32; + sbufptr->st_ino |= bhi.nFileIndexLow; + sbufptr->st_dev = bhi.dwVolumeSerialNumber; + } + } + } + + return result; } DllExport int diff --git a/win32/win32.h b/win32/win32.h index 00d052ac9c2c..171cbfb8b87b 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -731,5 +731,37 @@ DllExport void *win32_signal_context(void); # define O_ACCMODE (O_RDWR | O_WRONLY | O_RDONLY) #endif +/* ucrt at least seems to allocate a whole bit per type, + just mask off one bit from the mask for our symlink + file type. +*/ +#define _S_IFLNK ((unsigned)(_S_IFMT ^ (_S_IFMT & -_S_IFMT))) +#undef S_ISLNK +#define S_ISLNK(mode) (((mode) & _S_IFMT) == _S_IFLNK) + +/* + +The default CRT struct stat uses unsigned short for st_dev and st_ino +which obviously isn't enough, so we define our own structure. + + */ + +typedef DWORD Dev_t; +typedef unsigned __int64 Ino_t; + +struct w32_stat { + Dev_t st_dev; + Ino_t st_ino; + unsigned short st_mode; + DWORD st_nlink; + short st_uid; + short st_gid; + Dev_t st_rdev; + Off_t st_size; + time_t st_atime; + time_t st_mtime; + time_t st_ctime; +}; + #endif /* _INC_WIN32_PERL5 */ diff --git a/win32/win32iop.h b/win32/win32iop.h index 559e1f9cd2ea..84fe1e5e5c37 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -69,6 +69,7 @@ DllExport FILE* win32_tmpfile(void); DllExport void win32_abort(void); DllExport int win32_fstat(int fd,Stat_t *sbufptr); DllExport int win32_stat(const char *name,Stat_t *sbufptr); +DllExport int win32_lstat(const char *name,Stat_t *sbufptr); DllExport int win32_pipe( int *phandles, unsigned int psize, int textmode ); DllExport PerlIO* win32_popen( const char *command, const char *mode ); DllExport PerlIO* win32_popenlist(const char *mode, IV narg, SV **args); @@ -241,6 +242,7 @@ END_EXTERN_C # undef stat #endif #define stat(pth,bufptr) win32_stat(pth,bufptr) +#define lstat(pth,bufptr) win32_lstat(pth,bufptr) #define longpath(pth) win32_longpath(pth) #define ansipath(pth) win32_ansipath(pth) #define rename(old,new) win32_rename(old,new) From 680b2c5ee3b53c627074192b3cf14416a24da6ea Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 7 Oct 2020 16:31:22 +1100 Subject: [PATCH 122/503] Win32: implement symlink() and readlink() The API used requires Windows Vista or later. The API itself requires either elevated privileges or a sufficiently recent version of Windows 10 running in "Developer Mode", so some tests require updates. --- MANIFEST | 1 + iperlsys.h | 12 +++ pod/perlport.pod | 16 +++- pp_sys.c | 6 +- t/op/stat.t | 6 +- t/win32/symlink.t | 77 +++++++++++++++++++ win32/Makefile | 4 +- win32/config.gc | 4 +- win32/config.vc | 4 +- win32/config_H.gc | 6 +- win32/config_H.vc | 6 +- win32/perlhost.h | 14 ++++ win32/win32.c | 183 +++++++++++++++++++++++++++++++++++++--------- win32/win32iop.h | 7 +- 14 files changed, 292 insertions(+), 54 deletions(-) create mode 100644 t/win32/symlink.t diff --git a/MANIFEST b/MANIFEST index 684be8817ad3..5aab31f3dc4d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6165,6 +6165,7 @@ t/win32/popen.t Test for stdout races in backticks, etc t/win32/runenv.t Test if Win* perl honors its env variables t/win32/signal.t Test Win32 signal emulation t/win32/stat.t Test Win32 stat emulation +t/win32/symlink.t Test Win32 symlink t/win32/system.t See if system works in Win* t/win32/system_tests Test runner for system.t taint.c Tainting code diff --git a/iperlsys.h b/iperlsys.h index c176ad5c559a..28091141e69d 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -654,6 +654,10 @@ typedef int (*LPLIOUnlink)(struct IPerlLIO*, const char*); typedef int (*LPLIOUtime)(struct IPerlLIO*, const char*, struct utimbuf*); typedef int (*LPLIOWrite)(struct IPerlLIO*, int, const void*, unsigned int); +typedef int (*LPLIOSymLink)(struct IPerlLIO*, const char*, + const char *); +typedef int (*LPLIOReadLink)(struct IPerlLIO*, const char*, + char *, size_t); struct IPerlLIO { @@ -683,6 +687,8 @@ struct IPerlLIO LPLIOUnlink pUnlink; LPLIOUtime pUtime; LPLIOWrite pWrite; + LPLIOSymLink pSymLink; + LPLIOReadLink pReadLink; }; struct IPerlLIOInfo @@ -715,6 +721,10 @@ struct IPerlLIOInfo (*PL_LIO->pIsatty)(PL_LIO, (fd)) #define PerlLIO_link(oldname, newname) \ (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) +#define PerlLIO_symlink(oldname, newname) \ + (*PL_LIO->pSymLink)(PL_LIO, (oldname), (newname)) +#define PerlLIO_readlink(path, buf, bufsiz) \ + (*PL_LIO->pReadLink)(PL_LIO, (path), (buf), (bufsiz)) #define PerlLIO_lseek(fd, offset, mode) \ (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) \ @@ -764,6 +774,8 @@ struct IPerlLIOInfo #define PerlLIO_ioctl(fd, u, buf) ioctl((fd), (u), (buf)) #define PerlLIO_isatty(fd) isatty((fd)) #define PerlLIO_link(oldname, newname) link((oldname), (newname)) +#define PerlLIO_symlink(oldname, newname) symlink((oldname), (newname)) +#define PerlLIO_readlink(path, buf, bufsiz) readlink((path), (buf), (bufsiz)) #define PerlLIO_lseek(fd, offset, mode) lseek((fd), (offset), (mode)) #define PerlLIO_stat(name, buf) Stat((name), (buf)) #ifdef HAS_LSTAT diff --git a/pod/perlport.pod b/pod/perlport.pod index a9809802fdb7..224d3babbda9 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1571,6 +1571,12 @@ filehandle may be closed, or pointer may be in a different position. The value returned by L|perlfunc/tell FILEHANDLE> may be affected after the call, and the filehandle may be flushed. +=item chdir + +(Win32) +The current directory reported by the system may include any symbolic +links specified to chdir(). + =item chmod (Win32) @@ -2100,9 +2106,17 @@ true value speeds up C by not performing this operation. =item symlink -(Win32, S) +(S) Not implemented. +(Win32) + +Requires either elevated permissions or developer mode and a +sufficiently recent version of Windows 10. Since Windows needs to +know whether the target is a directory or not when creating the link +the target Perl will only create the link as a directory link when the +target exists and is a directory. + (VMS) Implemented on 64 bit VMS 8.3. VMS requires the symbolic link to be in Unix syntax if it is intended to resolve to a valid path. diff --git a/pp_sys.c b/pp_sys.c index 5c9f768eaf9d..8a6445e3e3d4 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -3774,13 +3774,13 @@ PP(pp_link) # if defined(HAS_LINK) && defined(HAS_SYMLINK) /* Both present - need to choose which. */ (op_type == OP_LINK) ? - PerlLIO_link(tmps, tmps2) : symlink(tmps, tmps2); + PerlLIO_link(tmps, tmps2) : PerlLIO_symlink(tmps, tmps2); # elif defined(HAS_LINK) /* Only have link, so calls to pp_symlink will have DIE()d above. */ PerlLIO_link(tmps, tmps2); # elif defined(HAS_SYMLINK) /* Only have symlink, so calls to pp_link will have DIE()d above. */ - symlink(tmps, tmps2); + PerlLIO_symlink(tmps, tmps2); # endif } @@ -3811,7 +3811,7 @@ PP(pp_readlink) tmps = POPpconstx; /* NOTE: if the length returned by readlink() is sizeof(buf) - 1, * it is impossible to know whether the result was truncated. */ - len = readlink(tmps, buf, sizeof(buf) - 1); + len = PerlLIO_readlink(tmps, buf, sizeof(buf) - 1); if (len < 0) RETPUSHUNDEF; buf[len] = '\0'; diff --git a/t/op/stat.t b/t/op/stat.t index 1cf6072f6e6d..099a3f1e9806 100644 --- a/t/op/stat.t +++ b/t/op/stat.t @@ -27,6 +27,8 @@ if ($^O eq 'MSWin32') { ${^WIN32_SLOPPY_STAT} = 0; } +my $Errno_loaded = eval { require Errno }; + plan tests => 110; my $Perl = which_perl(); @@ -241,7 +243,10 @@ ok(! -f '.', '!-f cwd' ); SKIP: { unlink($tmpfile_link); my $symlink_rslt = eval { symlink $tmpfile, $tmpfile_link }; + my $error = 0 + $!; skip "symlink not implemented", 3 if $@ =~ /unimplemented/; + skip "symlink not available or we can't check", 3 + if $^O eq "MSWin32" && (!$Errno_loaded || $error == &Errno::ENOSYS || $error == &Errno::EPERM); is( $@, '', 'symlink() implemented' ); ok( $symlink_rslt, 'symlink() ok' ); @@ -634,7 +639,6 @@ SKIP: { skip "There is a file named '2', which invalidates this test", 2 if -e '2'; - my $Errno_loaded = eval { require Errno }; my @statarg = ($statfile, $statfile); no warnings 'syntax'; ok !stat(@statarg), diff --git a/t/win32/symlink.t b/t/win32/symlink.t new file mode 100644 index 000000000000..9716f3789c61 --- /dev/null +++ b/t/win32/symlink.t @@ -0,0 +1,77 @@ +#!./perl + +BEGIN { + chdir 't' if -d 't'; + @INC = '../lib'; + require "./test.pl"; +} + +use Errno; + +Win32::FsType() eq 'NTFS' + or skip_all("need NTFS"); + +plan skip_all => "no symlink available in this Windows" + if !symlink('', '') && $! == &Errno::ENOSYS; + +my $tmpfile1 = tempfile(); +my $tmpfile2 = tempfile(); + +my $ok = symlink($tmpfile1, $tmpfile2); +plan skip_all => "no access to symlink as this user" + if !$ok && $! == &Errno::EPERM; + +ok($ok, "create a dangling symbolic link"); +ok(-l $tmpfile2, "-l sees it as a symlink"); +ok(unlink($tmpfile2), "and remove it"); + +ok(mkdir($tmpfile1), "make a directory"); +ok(!-l $tmpfile1, "doesn't look like a symlink"); +ok(symlink($tmpfile1, $tmpfile2), "and symlink to it"); +ok(-l $tmpfile2, "which does look like a symlink"); +ok(!-d _, "-d on the lstat result is false"); +ok(-d $tmpfile2, "normal -d sees it as a directory"); +is(readlink($tmpfile2), $tmpfile1, "readlink works"); +check_stat($tmpfile1, $tmpfile2, "check directory and link stat are the same"); +ok(unlink($tmpfile2), "and we can unlink the symlink (rather than only rmdir)"); + +# to check the unlink code for symlinks isn't mis-handling non-symlink +# directories +ok(!unlink($tmpfile1), "we can't unlink the original directory"); + +ok(rmdir($tmpfile1), "we can rmdir it"); + +ok(open(my $fh, ">", $tmpfile1), "make a file"); +close $fh if $fh; +ok(symlink($tmpfile1, $tmpfile2), "link to it"); +ok(-l $tmpfile2, "-l sees a link"); +ok(!-f _, "-f on the lstat result is false"); +ok(-f $tmpfile2, "normal -d sees it as a file"); +is(readlink($tmpfile2), $tmpfile1, "readlink works"); +check_stat($tmpfile1, $tmpfile2, "check file and link stat are the same"); +ok(unlink($tmpfile2), "unlink the symlink"); +ok(unlink($tmpfile1), "and the file"); + +# test we don't treat directory junctions like symlinks +ok(mkdir($tmpfile1), "make a directory"); + +# mklink is available from Vista onwards +# this may only work in an admin shell +# MKLINK [[/D] | [/H] | [/J]] Link Target +if (system("mklink /j $tmpfile2 $tmpfile1") == 0) { + ok(!-l $tmpfile2, "junction doesn't look like a symlink"); + ok(!unlink($tmpfile2), "no unlink magic for junctions"); + rmdir($tmpfile2); +} +rmdir($tmpfile1); + +done_testing(); + +sub check_stat { + my ($file1, $file2, $name) = @_; + + my @stat1 = stat($file1); + my @stat2 = stat($file2); + + is("@stat1", "@stat2", $name); +} diff --git a/win32/Makefile b/win32/Makefile index 93d55f7ca6a6..41b9fb8bc57d 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -960,7 +960,7 @@ regen_config_h: -$(MINIPERL) -I..\lib config_h.PL rename config.h $(CFGH_TMPL) -$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL +$(CONFIGPM) : $(MINIPERL) ..\config.sh config_h.PL ..\git_version.h $(MINIPERL) -I..\lib ..\configpm --chdir=.. $(XCOPY) ..\*.h $(COREDIR)\*.* $(XCOPY) *.h $(COREDIR)\*.* @@ -1100,7 +1100,7 @@ $(WIN32_OBJ) : $(CORE_H) $(CORE_OBJ) : $(CORE_H) $(DLL_OBJ) : $(CORE_H) -perldll.def : $(MINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl create_perllibst_h.pl +perldll.def : $(MINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl create_perllibst_h.pl ..\git_version.h $(MINIPERL) -I..\lib create_perllibst_h.pl $(MINIPERL) -I..\lib -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) $(BUILDOPT) \ CCTYPE=$(CCTYPE) TARG_DIR=..\ > perldll.def diff --git a/win32/config.gc b/win32/config.gc index c7e619620b96..9ffec527bfdb 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -446,7 +446,7 @@ d_random_r='undef' d_readdir64_r='undef' d_readdir='define' d_readdir_r='undef' -d_readlink='undef' +d_readlink='define' d_readv='undef' d_recvmsg='undef' d_regcomp='undef' @@ -571,7 +571,7 @@ d_strtoull='undef' d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' -d_symlink='undef' +d_symlink='define' d_syscall='undef' d_syscallproto='undef' d_sysconf='undef' diff --git a/win32/config.vc b/win32/config.vc index 294cdacbb2d2..6d6e675c7a76 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -446,7 +446,7 @@ d_random_r='undef' d_readdir64_r='undef' d_readdir='define' d_readdir_r='undef' -d_readlink='undef' +d_readlink='define' d_readv='undef' d_recvmsg='undef' d_regcomp='undef' @@ -571,7 +571,7 @@ d_strtoull='undef' d_strtouq='undef' d_strxfrm='define' d_suidsafe='undef' -d_symlink='undef' +d_symlink='define' d_syscall='undef' d_syscallproto='undef' d_sysconf='undef' diff --git a/win32/config_H.gc b/win32/config_H.gc index a068b08bba45..7bfdf1102932 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:27:47 2020 + * Configuration time: Wed Oct 7 16:35:37 2020 * Configured by : tony * Target system : */ @@ -342,7 +342,7 @@ * This symbol, if defined, indicates that the readlink routine is * available to read the value of a symbolic link. */ -/*#define HAS_READLINK / **/ +#define HAS_READLINK /**/ /* HAS_REGCOMP: * This symbol, if defined, indicates that the regcomp() routine is @@ -500,7 +500,7 @@ * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. */ -/*#define HAS_SYMLINK / **/ +#define HAS_SYMLINK /**/ /* HAS_SYSCALL: * This symbol, if defined, indicates that the syscall routine is diff --git a/win32/config_H.vc b/win32/config_H.vc index 4b88f66938f1..49b8ea793569 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:25:12 2020 + * Configuration time: Wed Oct 7 16:33:14 2020 * Configured by : tony * Target system : */ @@ -342,7 +342,7 @@ * This symbol, if defined, indicates that the readlink routine is * available to read the value of a symbolic link. */ -/*#define HAS_READLINK / **/ +#define HAS_READLINK /**/ /* HAS_REGCOMP: * This symbol, if defined, indicates that the regcomp() routine is @@ -500,7 +500,7 @@ * This symbol, if defined, indicates that the symlink routine is available * to create symbolic links. */ -/*#define HAS_SYMLINK / **/ +#define HAS_SYMLINK /**/ /* HAS_SYSCALL: * This symbol, if defined, indicates that the syscall routine is diff --git a/win32/perlhost.h b/win32/perlhost.h index d00240f26ff6..6d12abf252e1 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -986,6 +986,18 @@ PerlLIOLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) return win32_link(oldname, newname); } +int +PerlLIOSymLink(struct IPerlLIO* piPerl, const char*oldname, const char *newname) +{ + return win32_symlink(oldname, newname); +} + +int +PerlLIOReadLink(struct IPerlLIO* piPerl, const char *path, char *buf, size_t bufsiz) +{ + return win32_readlink(path, buf, bufsiz); +} + Off_t PerlLIOLseek(struct IPerlLIO* piPerl, int handle, Off_t offset, int origin) { @@ -1098,6 +1110,8 @@ const struct IPerlLIO perlLIO = PerlLIOUnlink, PerlLIOUtime, PerlLIOWrite, + PerlLIOSymLink, + PerlLIOReadLink }; diff --git a/win32/win32.c b/win32/win32.c index b7577156478d..162ef62de012 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1697,6 +1697,81 @@ is_symlink(HANDLE h) { return TRUE; } +static BOOL +is_symlink_name(const char *name) { + HANDLE f = CreateFileA(name, GENERIC_READ, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0); + BOOL result; + + if (f == INVALID_HANDLE_VALUE) { + return FALSE; + } + result = is_symlink(f); + CloseHandle(f); + + return result; +} + +DllExport int +win32_readlink(const char *pathname, char *buf, size_t bufsiz) { + MY_REPARSE_DATA_BUFFER linkdata; + const MY_SYMLINK_REPARSE_BUFFER * const sd = + &linkdata.Data.SymbolicLinkReparseBuffer; + HANDLE hlink; + DWORD fileattr = GetFileAttributes(pathname); + DWORD linkdata_returned; + int bytes_out; + BOOL used_default; + + if (fileattr == INVALID_FILE_ATTRIBUTES) { + translate_to_errno(); + return -1; + } + + if (!(fileattr & FILE_ATTRIBUTE_REPARSE_POINT)) { + /* not a symbolic link */ + errno = EINVAL; + return -1; + } + + hlink = + CreateFileA(pathname, GENERIC_READ, 0, NULL, OPEN_EXISTING, + FILE_FLAG_OPEN_REPARSE_POINT|FILE_FLAG_BACKUP_SEMANTICS, 0); + if (hlink == INVALID_HANDLE_VALUE) { + translate_to_errno(); + return -1; + } + + if (!DeviceIoControl(hlink, FSCTL_GET_REPARSE_POINT, NULL, 0, &linkdata, sizeof(linkdata), &linkdata_returned, NULL)) { + translate_to_errno(); + CloseHandle(hlink); + return -1; + } + CloseHandle(hlink); + + if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer) + || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) { + errno = EINVAL; + return -1; + } + + bytes_out = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, + sd->PathBuffer+sd->SubstituteNameOffset/2, + sd->SubstituteNameLength/2, + buf, bufsiz, NULL, &used_default); + if (bytes_out == 0 || used_default) { + /* failed conversion from unicode to ANSI or otherwise failed */ + errno = EINVAL; + return -1; + } + if ((size_t)bytes_out > bufsiz) { + errno = EINVAL; + return -1; + } + + return bytes_out; +} + DllExport int win32_lstat(const char *path, Stat_t *sbuf) { @@ -2129,8 +2204,14 @@ win32_unlink(const char *filename) if (ret == -1) (void)SetFileAttributesA(filename, attrs); } - else + else if ((attrs & (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY)) + == (FILE_ATTRIBUTE_REPARSE_POINT | FILE_ATTRIBUTE_DIRECTORY) + && is_symlink_name(filename)) { + ret = rmdir(filename); + } + else { ret = unlink(filename); + } return ret; } @@ -3341,44 +3422,74 @@ win32_link(const char *oldname, const char *newname) { return 0; } - /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for - both permissions errors and if the source is a directory, while - POSIX wants EACCES and EPERM respectively. + translate_to_errno(); + return -1; +} - Determined by experimentation on Windows 7 x64 SP1, since MS - don't document what error codes are returned. +#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE +# define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2 +#endif + +DllExport int +win32_symlink(const char *oldfile, const char *newfile) +{ + dTHX; + const char *dest_path = oldfile; + char szTargetName[MAX_PATH+1]; + size_t oldfile_len = strlen(oldfile); + DWORD dest_attr; + DWORD create_flags = SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE; + + /* oldfile might be relative and we don't want to change that, + so don't map that. */ - switch (GetLastError()) { - case ERROR_BAD_NET_NAME: - case ERROR_BAD_NETPATH: - case ERROR_BAD_PATHNAME: - case ERROR_FILE_NOT_FOUND: - case ERROR_FILENAME_EXCED_RANGE: - case ERROR_INVALID_DRIVE: - case ERROR_PATH_NOT_FOUND: - errno = ENOENT; - break; - case ERROR_ALREADY_EXISTS: - errno = EEXIST; - break; - case ERROR_ACCESS_DENIED: - errno = EACCES; - break; - case ERROR_NOT_SAME_DEVICE: - errno = EXDEV; - break; - case ERROR_DISK_FULL: - errno = ENOSPC; - break; - case ERROR_NOT_ENOUGH_QUOTA: - errno = EDQUOT; - break; - default: - /* ERROR_INVALID_FUNCTION - eg. on a FAT volume */ - errno = EINVAL; - break; + newfile = PerlDir_mapA(newfile); + + /* are we linking to a directory? + CreateSymlinkA() needs to know if the target is a directory, + if the oldfile is relative we need to make a relative path + based on the newfile + */ + if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') { + /* relative to current directory on a drive */ + /* dest_path = oldfile; already done */ + } + else if (oldfile[0] != '\\' && oldfile[0] != '/') { + size_t newfile_len = strlen(newfile); + char *last_slash = strrchr(newfile, '/'); + char *last_bslash = strrchr(newfile, '\\'); + char *end_dir = last_slash && last_bslash + ? ( last_slash > last_bslash ? last_slash : last_bslash) + : last_slash ? last_slash : last_bslash ? last_bslash : NULL; + + if (end_dir) { + if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) { + /* too long */ + errno = EINVAL; + return -1; + } + + memcpy(szTargetName, newfile, end_dir - newfile + 1); + strcpy(szTargetName + (end_dir - newfile + 1), oldfile); + dest_path = szTargetName; + } + else { + /* newpath is just a filename */ + /* dest_path = oldfile; */ + } } - return -1; + + dest_attr = GetFileAttributes(dest_path); + if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) { + create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; + } + + if (!CreateSymbolicLinkA(newfile, oldfile, create_flags)) { + translate_to_errno(); + return -1; + } + + return 0; } DllExport int diff --git a/win32/win32iop.h b/win32/win32iop.h index 84fe1e5e5c37..80a34f81a986 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -137,6 +137,8 @@ DllExport char* win32_longpath(char *path); DllExport char* win32_ansipath(const WCHAR *path); DllExport int win32_ioctl(int i, unsigned int u, char *data); DllExport int win32_link(const char *oldname, const char *newname); +DllExport int win32_symlink(const char *oldname, const char *newname); +DllExport int win32_readlink(const char *path, char *buf, size_t bufsiz); DllExport int win32_unlink(const char *f); DllExport int win32_utime(const char *f, struct utimbuf *t); DllExport int win32_gettimeofday(struct timeval *tp, void *not_used); @@ -286,7 +288,8 @@ END_EXTERN_C #define putchar win32_putchar #define access(p,m) win32_access(p,m) #define chmod(p,m) win32_chmod(p,m) - +#define symlink(targ,realp) win32_symlink(targ,realp) +#define readlink(p,buf,bufsiz) win32_readlink(p,buf,bufsiz) #if !defined(MYMALLOC) || !defined(PERL_CORE) #undef malloc @@ -309,6 +312,8 @@ END_EXTERN_C #define times win32_times #define ioctl win32_ioctl #define link win32_link +#define symlink win32_symlink +#define readlink win32_readlink #define unlink win32_unlink #define utime win32_utime #define gettimeofday win32_gettimeofday From e935ef333b3eab54a766de93fad1369f76ddea49 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 14 Oct 2020 13:27:50 +1100 Subject: [PATCH 123/503] Win32: implement our own stat(), and hence our own utime This fixes at least two problems: - unlike UCRT, the MSVCRT used for gcc builds has a bug converting a FILETIME in an unlike current DST state, returning a time offset by an hour. Fixes GH #6080 - the MSVCRT apparently uses FindFirstFile() to fetch file information, but this doesn't follow symlinks(), so stat() ends up returning information about the symlink(), not the underlying file. This isn't an issue with the UCRT which opens the file as this implementation does. Currently this code calculates the time_t for st_*time, and the other way for utime() using a simple multiplication and offset between time_t and FILETIME values, but this may be incorrect if leap seconds are enabled. This code also requires Vista or later. Some of this is based on code by Tomasz Konojacki (xenu). --- pod/perlport.pod | 10 -- t/win32/stat.t | 91 +++++++++-- win32/win32.c | 397 ++++++++++++++++++++++------------------------- 3 files changed, 263 insertions(+), 235 deletions(-) diff --git a/pod/perlport.pod b/pod/perlport.pod index 224d3babbda9..42e178a8b634 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -2080,9 +2080,6 @@ C not supported on UFS. (Win32) C is creation time instead of inode change time. -(Win32) -C and C are not meaningful. - (VMS) C and C are not necessarily reliable. @@ -2098,19 +2095,12 @@ meaningful and will differ between stat calls on the same file. Some versions of cygwin when doing a C and not finding it may then attempt to C. -(Win32) -C needs to open the file to determine the link count -and update attributes that may have been changed through hard links. -Setting L|perlvar/${^WIN32_SLOPPY_STAT}> to a -true value speeds up C by not performing this operation. - =item symlink (S) Not implemented. (Win32) - Requires either elevated permissions or developer mode and a sufficiently recent version of Windows 10. Since Windows needs to know whether the target is a directory or not when creating the link diff --git a/t/win32/stat.t b/t/win32/stat.t index ad5c5b7c884f..6046994f612d 100644 --- a/t/win32/stat.t +++ b/t/win32/stat.t @@ -7,6 +7,7 @@ BEGIN { } use strict; +use Fcntl ":seek"; Win32::FsType() eq 'NTFS' or skip_all("need NTFS"); @@ -21,6 +22,9 @@ ok(link($0, $tmpfile1), "make a link to test nlink"); my @st = stat $0; open my $fh, "<", $0 or die; my @fst = stat $fh; + +ok(seek($fh, 0, SEEK_END), "seek to end"); +my $size = tell($fh); close $fh; # the ucrt stat() is inconsistent here, using an A=0 drive letter for stat() @@ -37,6 +41,23 @@ ok($st[1], "and ino"); # unlikely, but someone else might have linked to win32/stat.t cmp_ok($st[3], '>', 1, "should be more than one link"); +# we now populate all stat fields ourselves, so check what we can +is($st[7], $size, "we fetch size correctly"); + +cmp_ok($st[9], '<=', time(), "modification time before or on now"); +ok(-f $0, "yes, we are a file"); +ok(-d "win32", "and win32 is a directory"); +pipe(my ($p1, $p2)); +ok(-p $p1, "a pipe is a pipe"); +close $p1; close $p2; +ok(-r $0, "we are readable"); +ok(!-x $0, "but not executable"); +ok(-e $0, "we exist"); + +ok(open(my $nul, ">", "nul"), "open nul"); +ok(-c $nul, "nul is a character device"); +close $nul; + my $nlink = $st[3]; # check we get nlinks etc for a directory @@ -45,25 +66,16 @@ ok($st[0], "got dev for a directory"); ok($st[1], "got ino for a directory"); ok($st[3], "got nlink for a directory"); -${^WIN32_SLOPPY_STAT} = 1; - -@st = stat $0; -open my $fh, "<", $0 or die; -@fst = stat $fh; -close $fh; - -$st[6] = $fst[6] = 0; - -is("@st", "@fst", "sloppy check named stat vs handle stat"); -is($st[0], 0, "sloppy no dev"); -is($st[1], 0, "sloppy no ino"); -# don't check nlink, Microsoft might fix it one day - -${^WIN32_SLOPPY_STAT} = 0; - # symbolic links unlink($tmpfile1); # no more hard link +if (open my $fh, ">", "$tmpfile1.bat") { + ok(-x "$tmpfile1.bat", 'batch file is "executable"'); + ok(-x $fh, 'batch file handle is "executable"'); + close $fh; + unlink "$tmpfile1.bat"; +} + # mklink is available from Vista onwards # this may only work in an admin shell # MKLINK [[/D] | [/H] | [/J]] Link Target @@ -108,4 +120,51 @@ if (system("mklink /j $tmpfile1 win32") == 0) { rmdir( $tmpfile1 ); } +# test interaction between stat and utime +if (ok(open(my $fh, ">", $tmpfile1), "make a work file")) { + # make our test file + close $fh; + + my @st = stat $tmpfile1; + ok(@st, "stat our work file"); + + # switch to the other half of the year, to flip from/to daylight + # savings time. It won't always do so, but it's close enough and + # avoids having to deal with working out exactly when it + # starts/ends (if it does), along with the hemisphere. + # + # By basing this on the current file times and using an offset + # that's the multiple of an hour we ensure the filesystem + # resolution supports the time we set. + my $moffset = 6 * 30 * 24 * 3600; + my $aoffset = $moffset - 24 * 3600;; + my $mymt = $st[9] - $moffset; + my $myat = $st[8] - $aoffset; + ok(utime($myat, $mymt, $tmpfile1), "set access and mod times"); + my @mst = stat $tmpfile1; + ok(@mst, "fetch stat after utime"); + is($mst[9], $mymt, "check mod time"); + is($mst[8], $myat, "check access time"); + + unlink $tmpfile1; +} + +# same for a directory +if (ok(mkdir($tmpfile1), "make a work directory")) { + my @st = stat $tmpfile1; + ok(@st, "stat our work directory"); + + my $moffset = 6 * 30 * 24 * 3600; + my $aoffset = $moffset - 24 * 3600;; + my $mymt = $st[9] - $moffset; + my $myat = $st[8] - $aoffset; + ok(utime($myat, $mymt, $tmpfile1), "set access and mod times"); + my @mst = stat $tmpfile1; + ok(@mst, "fetch stat after utime"); + is($mst[9], $mymt, "check mod time"); + is($mst[8], $myat, "check access time"); + + rmdir $tmpfile1; +} + done_testing(); diff --git a/win32/win32.c b/win32/win32.c index 162ef62de012..829bdfbc6069 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -10,16 +10,14 @@ #define PERLIO_NOT_STDIO 0 #define WIN32_LEAN_AND_MEAN #define WIN32IO_IS_STDIO +/* for CreateSymbolicLinkA() etc */ +#define _WIN32_WINNT 0x0601 #include #ifdef __GNUC__ # define Win32_Winsock #endif -#ifndef _WIN32_WINNT -# define _WIN32_WINNT 0x0500 /* needed for CreateHardlink() etc. */ -#endif - #include #ifndef HWND_MESSAGE @@ -164,6 +162,8 @@ static HWND get_hwnd_delay(pTHX, long child, DWORD tries); static void win32_csighandler(int sig); #endif +static void translate_to_errno(void); + START_EXTERN_C HANDLE w32_perldll_handle = INVALID_HANDLE_VALUE; char w32_module_name[MAX_PATH+1]; @@ -180,6 +180,22 @@ static HKEY HKCU_Perl_hnd; static HKEY HKLM_Perl_hnd; #endif +/* the time_t epoch start time as a filetime expressed as a large integer */ +static ULARGE_INTEGER time_t_epoch_base_filetime; + +static const SYSTEMTIME time_t_epoch_base_systemtime = { + 1970, /* wYear */ + 1, /* wMonth */ + 0, /* wDayOfWeek */ + 1, /* wDay */ + 0, /* wHour */ + 0, /* wMinute */ + 0, /* wSecond */ + 0 /* wMilliseconds */ +}; + +#define FILETIME_CHUNKS_PER_SECOND (10000000UL) + #ifdef SET_INVALID_PARAMETER_HANDLER static BOOL silent_invalid_parameter_handler = FALSE; @@ -1455,143 +1471,136 @@ win32_kill(int pid, int sig) return -1; } +PERL_STATIC_INLINE +time_t +translate_ft_to_time_t(FILETIME ft) { + /* Based on Win32::UTCTime. + Older CRTs (including MSVCRT used for gcc builds) product + strange behaviour when the specified time and the current time + differ on whether DST was in effect, this code doesnt have that + problem. + */ + ULARGE_INTEGER u; + u.LowPart = ft.dwLowDateTime; + u.HighPart = ft.dwHighDateTime; + return (u.QuadPart - time_t_epoch_base_filetime.QuadPart) / FILETIME_CHUNKS_PER_SECOND; +} + +static int +win32_stat_low(HANDLE handle, const char *path, STRLEN len, Stat_t *sbuf) { + DWORD type = GetFileType(handle); + BY_HANDLE_FILE_INFORMATION bhi; + + Zero(sbuf, 1, Stat_t); + + type &= ~FILE_TYPE_REMOTE; + + switch (type) { + case FILE_TYPE_DISK: + if (GetFileInformationByHandle(handle, &bhi)) { + sbuf->st_dev = bhi.dwVolumeSerialNumber; + sbuf->st_ino = bhi.nFileIndexHigh; + sbuf->st_ino <<= 32; + sbuf->st_ino |= bhi.nFileIndexLow; + sbuf->st_nlink = bhi.nNumberOfLinks; + sbuf->st_uid = 0; + sbuf->st_gid = 0; + /* ucrt sets this to the drive letter for + stat(), lets not reproduce that mistake */ + sbuf->st_rdev = 0; + sbuf->st_size = bhi.nFileSizeHigh; + sbuf->st_size <<= 32; + sbuf->st_size |= bhi.nFileSizeLow; + + sbuf->st_atime = translate_ft_to_time_t(bhi.ftLastAccessTime); + sbuf->st_mtime = translate_ft_to_time_t(bhi.ftLastWriteTime); + sbuf->st_ctime = translate_ft_to_time_t(bhi.ftCreationTime); + + if (bhi.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY) { + sbuf->st_mode = _S_IFDIR | _S_IREAD | _S_IEXEC; + /* duplicate the logic from the end of the old win32_stat() */ + if (!(bhi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) { + sbuf->st_mode |= S_IWRITE; + } + } + else { + char path_buf[MAX_PATH+1]; + sbuf->st_mode = _S_IFREG; + + if (!path) { + len = GetFinalPathNameByHandleA(handle, path_buf, sizeof(path_buf), 0); + /* < to ensure there's space for the \0 */ + if (len && len < sizeof(path_buf)) { + path = path_buf; + } + } + + if (path && len > 4 && + (_stricmp(path + len - 4, ".exe") == 0 || + _stricmp(path + len - 4, ".bat") == 0 || + _stricmp(path + len - 4, ".cmd") == 0 || + _stricmp(path + len - 4, ".com") == 0)) { + sbuf->st_mode |= _S_IEXEC; + } + if (!(bhi.dwFileAttributes & FILE_ATTRIBUTE_READONLY)) { + sbuf->st_mode |= _S_IWRITE; + } + sbuf->st_mode |= _S_IREAD; + } + } + else { + translate_to_errno(); + return -1; + } + break; + + case FILE_TYPE_CHAR: + case FILE_TYPE_PIPE: + sbuf->st_mode = (type == FILE_TYPE_CHAR) ? _S_IFCHR : _S_IFIFO; + if (handle == GetStdHandle(STD_INPUT_HANDLE) || + handle == GetStdHandle(STD_OUTPUT_HANDLE) || + handle == GetStdHandle(STD_ERROR_HANDLE)) { + sbuf->st_mode |= _S_IWRITE | _S_IREAD; + } + break; + + default: + return -1; + } + + /* owner == user == group */ + sbuf->st_mode |= (sbuf->st_mode & 0700) >> 3; + sbuf->st_mode |= (sbuf->st_mode & 0700) >> 6; + + return 0; +} + DllExport int win32_stat(const char *path, Stat_t *sbuf) { - char buffer[MAX_PATH+1]; - int l = strlen(path); + size_t l = strlen(path); dTHX; - int res; - int nlink = 1; - unsigned __int64 ino = 0; - DWORD vol = 0; BOOL expect_dir = FALSE; - struct _stati64 st; - - if (l > 1) { - switch(path[l - 1]) { - /* FindFirstFile() and stat() are buggy with a trailing - * slashes, except for the root directory of a drive */ - case '\\': - case '/': - if (l > sizeof(buffer)) { - errno = ENAMETOOLONG; - return -1; - } - --l; - strncpy(buffer, path, l); - /* remove additional trailing slashes */ - while (l > 1 && (buffer[l-1] == '/' || buffer[l-1] == '\\')) - --l; - /* add back slash if we otherwise end up with just a drive letter */ - if (l == 2 && isALPHA(buffer[0]) && buffer[1] == ':') - buffer[l++] = '\\'; - buffer[l] = '\0'; - path = buffer; - expect_dir = TRUE; - break; - - /* FindFirstFile() is buggy with "x:", so add a dot :-( */ - case ':': - if (l == 2 && isALPHA(path[0])) { - buffer[0] = path[0]; - buffer[1] = ':'; - buffer[2] = '.'; - buffer[3] = '\0'; - l = 3; - path = buffer; - } - break; - } - } + int result; + HANDLE handle; path = PerlDir_mapA(path); l = strlen(path); - if (!w32_sloppystat) { - /* We must open & close the file once; otherwise file attribute changes */ - /* might not yet have propagated to "other" hard links of the same file. */ - /* This also gives us an opportunity to determine the number of links. */ - HANDLE handle = CreateFileA(path, 0, 0, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); - if (handle != INVALID_HANDLE_VALUE) { - BY_HANDLE_FILE_INFORMATION bhi; - if (GetFileInformationByHandle(handle, &bhi)) { - nlink = bhi.nNumberOfLinks; - ino = bhi.nFileIndexHigh; - ino <<= 32; - ino |= bhi.nFileIndexLow; - vol = bhi.dwVolumeSerialNumber; - } - CloseHandle(handle); - } - else { - DWORD err = GetLastError(); - /* very common case, skip CRT stat and its also failing syscalls */ - if(err == ERROR_FILE_NOT_FOUND) { - errno = ENOENT; - return -1; - } - } - } - - /* path will be mapped correctly above */ - res = _stati64(path, sbuf); - sbuf->st_dev = vol; - sbuf->st_ino = ino; - sbuf->st_mode = st.st_mode; - sbuf->st_nlink = nlink; - sbuf->st_uid = st.st_uid; - sbuf->st_gid = st.st_gid; - sbuf->st_rdev = st.st_rdev; - sbuf->st_size = st.st_size; - sbuf->st_atime = st.st_atime; - sbuf->st_mtime = st.st_mtime; - sbuf->st_ctime = st.st_ctime; - - if (res < 0) { - /* CRT is buggy on sharenames, so make sure it really isn't. - * XXX using GetFileAttributesEx() will enable us to set - * sbuf->st_*time (but note that's not available on the - * Windows of 1995) */ - DWORD r = GetFileAttributesA(path); - if (r != 0xffffffff && (r & FILE_ATTRIBUTE_DIRECTORY)) { - /* sbuf may still contain old garbage since stat() failed */ - Zero(sbuf, 1, Stat_t); - sbuf->st_mode = S_IFDIR | S_IREAD; - errno = 0; - if (!(r & FILE_ATTRIBUTE_READONLY)) - sbuf->st_mode |= S_IWRITE | S_IEXEC; - return 0; - } + handle = + CreateFileA(path, FILE_READ_ATTRIBUTES, + FILE_SHARE_DELETE | FILE_SHARE_READ | FILE_SHARE_WRITE, + NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); + if (handle != INVALID_HANDLE_VALUE) { + result = win32_stat_low(handle, path, l, sbuf); + CloseHandle(handle); } else { - if (l == 3 && isALPHA(path[0]) && path[1] == ':' - && (path[2] == '\\' || path[2] == '/')) - { - /* The drive can be inaccessible, some _stat()s are buggy */ - if (!GetVolumeInformationA(path,NULL,0,NULL,NULL,NULL,NULL,0)) { - errno = ENOENT; - return -1; - } - } - if (expect_dir && !S_ISDIR(sbuf->st_mode)) { - errno = ENOTDIR; - return -1; - } - if (S_ISDIR(sbuf->st_mode)) { - /* Ensure the "write" bit is switched off in the mode for - * directories with the read-only attribute set. Some compilers - * switch it on for directories, which is technically correct - * (directories are indeed always writable unless denied by DACLs), - * but we want stat() and -w to reflect the state of the read-only - * attribute for symmetry with chmod(). */ - DWORD r = GetFileAttributesA(path); - if (r != 0xffffffff && (r & FILE_ATTRIBUTE_READONLY)) { - sbuf->st_mode &= ~S_IWRITE; - } - } + translate_to_errno(); + result = -1; } - return res; + + return result; } static void @@ -1600,9 +1609,6 @@ translate_to_errno(void) /* This isn't perfect, eg. Win32 returns ERROR_ACCESS_DENIED for both permissions errors and if the source is a directory, while POSIX wants EACCES and EPERM respectively. - - Determined by experimentation on Windows 7 x64 SP1, since MS - don't document what error codes are returned. */ switch (GetLastError()) { case ERROR_BAD_NET_NAME: @@ -1618,9 +1624,11 @@ translate_to_errno(void) errno = EEXIST; break; case ERROR_ACCESS_DENIED: - case ERROR_PRIVILEGE_NOT_HELD: errno = EACCES; break; + case ERROR_PRIVILEGE_NOT_HELD: + errno = EPERM; + break; case ERROR_NOT_SAME_DEVICE: errno = EXDEV; break; @@ -1776,7 +1784,6 @@ DllExport int win32_lstat(const char *path, Stat_t *sbuf) { HANDLE f; - int fd; int result; DWORD attr = GetFileAttributes(path); /* doesn't follow symlinks */ @@ -1801,12 +1808,13 @@ win32_lstat(const char *path, Stat_t *sbuf) return win32_stat(path, sbuf); } - fd = win32_open_osfhandle((intptr_t)f, 0); - result = win32_fstat(fd, sbuf); + result = win32_stat_low(f, NULL, 0, sbuf); + CloseHandle(f); + if (result != -1){ sbuf->st_mode = (sbuf->st_mode & ~_S_IFMT) | _S_IFLNK; } - close(fd); + return result; } @@ -2162,27 +2170,17 @@ win32_times(struct tms *timebuf) return process_time_so_far; } -/* fix utime() so it works on directories in NT */ static BOOL filetime_from_time(PFILETIME pFileTime, time_t Time) { - struct tm *pTM = localtime(&Time); - SYSTEMTIME SystemTime; - FILETIME LocalTime; + ULARGE_INTEGER u; + u.QuadPart = Time; + u.QuadPart = u.QuadPart * FILETIME_CHUNKS_PER_SECOND + time_t_epoch_base_filetime.QuadPart; - if (pTM == NULL) - return FALSE; - - SystemTime.wYear = pTM->tm_year + 1900; - SystemTime.wMonth = pTM->tm_mon + 1; - SystemTime.wDay = pTM->tm_mday; - SystemTime.wHour = pTM->tm_hour; - SystemTime.wMinute = pTM->tm_min; - SystemTime.wSecond = pTM->tm_sec; - SystemTime.wMilliseconds = 0; + pFileTime->dwLowDateTime = u.LowPart; + pFileTime->dwHighDateTime = u.HighPart; - return SystemTimeToFileTime(&SystemTime, &LocalTime) && - LocalFileTimeToFileTime(&LocalTime, pFileTime); + return TRUE; } DllExport int @@ -2220,38 +2218,38 @@ win32_utime(const char *filename, struct utimbuf *times) { dTHX; HANDLE handle; - FILETIME ftCreate; FILETIME ftAccess; FILETIME ftWrite; struct utimbuf TimeBuffer; - int rc; + int rc = -1; filename = PerlDir_mapA(filename); - rc = utime(filename, times); - - /* EACCES: path specifies directory or readonly file */ - if (rc == 0 || errno != EACCES) - return rc; - - if (times == NULL) { - times = &TimeBuffer; - time(×->actime); - times->modtime = times->actime; - } - /* This will (and should) still fail on readonly files */ handle = CreateFileA(filename, GENERIC_READ | GENERIC_WRITE, - FILE_SHARE_READ | FILE_SHARE_DELETE, NULL, + FILE_SHARE_READ | FILE_SHARE_WRITE, NULL, OPEN_EXISTING, FILE_FLAG_BACKUP_SEMANTICS, NULL); - if (handle == INVALID_HANDLE_VALUE) - return rc; + if (handle == INVALID_HANDLE_VALUE) { + translate_to_errno(); + return -1; + } - if (GetFileTime(handle, &ftCreate, &ftAccess, &ftWrite) && - filetime_from_time(&ftAccess, times->actime) && - filetime_from_time(&ftWrite, times->modtime) && - SetFileTime(handle, &ftCreate, &ftAccess, &ftWrite)) - { - rc = 0; + if (times == NULL) { + times = &TimeBuffer; + time(×->actime); + times->modtime = times->actime; + } + + if (filetime_from_time(&ftAccess, times->actime) && + filetime_from_time(&ftWrite, times->modtime)) { + if (SetFileTime(handle, NULL, &ftAccess, &ftWrite)) { + rc = 0; + } + else { + translate_to_errno(); + } + } + else { + errno = EINVAL; /* bad time? */ } CloseHandle(handle); @@ -3195,39 +3193,9 @@ win32_abort(void) DllExport int win32_fstat(int fd, Stat_t *sbufptr) { - int result; - struct _stati64 st; - dTHX; - result = _fstati64(fd, &st); - if (result == 0) { - sbufptr->st_mode = st.st_mode; - sbufptr->st_uid = st.st_uid; - sbufptr->st_gid = st.st_gid; - sbufptr->st_rdev = st.st_rdev; - sbufptr->st_size = st.st_size; - sbufptr->st_atime = st.st_atime; - sbufptr->st_mtime = st.st_mtime; - sbufptr->st_ctime = st.st_ctime; - - if (w32_sloppystat) { - sbufptr->st_nlink = st.st_nlink; - sbufptr->st_dev = st.st_dev; - sbufptr->st_ino = st.st_ino; - } - else { - HANDLE handle = (HANDLE)win32_get_osfhandle(fd); - BY_HANDLE_FILE_INFORMATION bhi; - if (GetFileInformationByHandle(handle, &bhi)) { - sbufptr->st_nlink = bhi.nNumberOfLinks; - sbufptr->st_ino = bhi.nFileIndexHigh; - sbufptr->st_ino <<= 32; - sbufptr->st_ino |= bhi.nFileIndexLow; - sbufptr->st_dev = bhi.dwVolumeSerialNumber; - } - } - } - - return result; + HANDLE handle = (HANDLE)win32_get_osfhandle(fd); + + return win32_stat_low(handle, NULL, 0, sbufptr); } DllExport int @@ -4818,6 +4786,17 @@ Perl_win32_init(int *argcp, char ***argvp) } } #endif + + { + FILETIME ft; + if (!SystemTimeToFileTime(&time_t_epoch_base_systemtime, + &ft)) { + fprintf(stderr, "panic: cannot convert base system time to filetime\n"); /* no interp */ + exit(1); + } + time_t_epoch_base_filetime.LowPart = ft.dwLowDateTime; + time_t_epoch_base_filetime.HighPart = ft.dwHighDateTime; + } } void From 12a8085aee9a1a5ac613205b43ea06406736ac6b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 7 Oct 2020 11:50:55 +1100 Subject: [PATCH 124/503] PathTools: use PerlLIO_*() functions and chdir() on a symlink differences Use PerlLIO_lstat() and PerlLIO_readlink() instead of directly calling the POSIX names, so our Win32 overrides work. For the test, unlike POSIX, changing directory via a symlink on Win32 appears to store the symlink as part of the current directory rather so GetCurrentDirectory() fetches that rather than the hardlinked path. --- dist/PathTools/Cwd.pm | 2 +- dist/PathTools/Cwd.xs | 9 ++++++--- dist/PathTools/lib/File/Spec.pm | 2 +- dist/PathTools/lib/File/Spec/AmigaOS.pm | 2 +- dist/PathTools/lib/File/Spec/Cygwin.pm | 2 +- dist/PathTools/lib/File/Spec/Epoc.pm | 2 +- dist/PathTools/lib/File/Spec/Functions.pm | 2 +- dist/PathTools/lib/File/Spec/Mac.pm | 2 +- dist/PathTools/lib/File/Spec/OS2.pm | 2 +- dist/PathTools/lib/File/Spec/Unix.pm | 2 +- dist/PathTools/lib/File/Spec/VMS.pm | 2 +- dist/PathTools/lib/File/Spec/Win32.pm | 2 +- dist/PathTools/t/cwd.t | 4 ++++ 13 files changed, 21 insertions(+), 14 deletions(-) diff --git a/dist/PathTools/Cwd.pm b/dist/PathTools/Cwd.pm index ce0f25f72de8..6a1d2f17ee57 100644 --- a/dist/PathTools/Cwd.pm +++ b/dist/PathTools/Cwd.pm @@ -3,7 +3,7 @@ use strict; use Exporter; -our $VERSION = '3.79'; +our $VERSION = '3.80'; my $xs_version = $VERSION; $VERSION =~ tr/_//d; diff --git a/dist/PathTools/Cwd.xs b/dist/PathTools/Cwd.xs index e7ecb3c6c1b4..223e1a6b18b4 100644 --- a/dist/PathTools/Cwd.xs +++ b/dist/PathTools/Cwd.xs @@ -84,6 +84,9 @@ bsd_realpath(const char *path, char resolved[MAXPATHLEN]) unsigned symlinks; int serrno; char remaining[MAXPATHLEN], next_token[MAXPATHLEN]; +#ifdef PERL_IMPLICIT_SYS + dTHX; +#endif serrno = errno; symlinks = 0; @@ -175,8 +178,8 @@ bsd_realpath(const char *path, char resolved[MAXPATHLEN]) } #if defined(HAS_LSTAT) && defined(HAS_READLINK) && defined(HAS_SYMLINK) { - struct stat sb; - if (lstat(resolved, &sb) != 0) { + Stat_t sb; + if (PerlLIO_lstat(resolved, &sb) != 0) { if (errno == ENOENT && p == NULL) { errno = serrno; return (resolved); @@ -191,7 +194,7 @@ bsd_realpath(const char *path, char resolved[MAXPATHLEN]) errno = ELOOP; return (NULL); } - slen = readlink(resolved, symlink, sizeof(symlink) - 1); + slen = PerlLIO_readlink(resolved, symlink, sizeof(symlink) - 1); if (slen < 0) return (NULL); symlink[slen] = '\0'; diff --git a/dist/PathTools/lib/File/Spec.pm b/dist/PathTools/lib/File/Spec.pm index 732746d943a2..30d883b61b3e 100644 --- a/dist/PathTools/lib/File/Spec.pm +++ b/dist/PathTools/lib/File/Spec.pm @@ -2,7 +2,7 @@ package File::Spec; use strict; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; my %module = ( diff --git a/dist/PathTools/lib/File/Spec/AmigaOS.pm b/dist/PathTools/lib/File/Spec/AmigaOS.pm index 0d3c9a5770ca..fd9da81cdf5a 100644 --- a/dist/PathTools/lib/File/Spec/AmigaOS.pm +++ b/dist/PathTools/lib/File/Spec/AmigaOS.pm @@ -3,7 +3,7 @@ package File::Spec::AmigaOS; use strict; require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Cygwin.pm b/dist/PathTools/lib/File/Spec/Cygwin.pm index 591af63f9756..953c23361a10 100644 --- a/dist/PathTools/lib/File/Spec/Cygwin.pm +++ b/dist/PathTools/lib/File/Spec/Cygwin.pm @@ -3,7 +3,7 @@ package File::Spec::Cygwin; use strict; require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Epoc.pm b/dist/PathTools/lib/File/Spec/Epoc.pm index 4b8a17fc17cc..fcb9e894e33c 100644 --- a/dist/PathTools/lib/File/Spec/Epoc.pm +++ b/dist/PathTools/lib/File/Spec/Epoc.pm @@ -2,7 +2,7 @@ package File::Spec::Epoc; use strict; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; require File::Spec::Unix; diff --git a/dist/PathTools/lib/File/Spec/Functions.pm b/dist/PathTools/lib/File/Spec/Functions.pm index fda2e95c627c..e14ad2f74538 100644 --- a/dist/PathTools/lib/File/Spec/Functions.pm +++ b/dist/PathTools/lib/File/Spec/Functions.pm @@ -3,7 +3,7 @@ package File::Spec::Functions; use File::Spec; use strict; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; require Exporter; diff --git a/dist/PathTools/lib/File/Spec/Mac.pm b/dist/PathTools/lib/File/Spec/Mac.pm index 504d0cef7440..8026edcb1261 100644 --- a/dist/PathTools/lib/File/Spec/Mac.pm +++ b/dist/PathTools/lib/File/Spec/Mac.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/OS2.pm b/dist/PathTools/lib/File/Spec/OS2.pm index fd7bc7fd0483..3c35ba99b48a 100644 --- a/dist/PathTools/lib/File/Spec/OS2.pm +++ b/dist/PathTools/lib/File/Spec/OS2.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Unix.pm b/dist/PathTools/lib/File/Spec/Unix.pm index 222158711571..c06d18f46819 100644 --- a/dist/PathTools/lib/File/Spec/Unix.pm +++ b/dist/PathTools/lib/File/Spec/Unix.pm @@ -3,7 +3,7 @@ package File::Spec::Unix; use strict; use Cwd (); -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; =head1 NAME diff --git a/dist/PathTools/lib/File/Spec/VMS.pm b/dist/PathTools/lib/File/Spec/VMS.pm index 174dd22b2e4f..9b78c8b4bc6e 100644 --- a/dist/PathTools/lib/File/Spec/VMS.pm +++ b/dist/PathTools/lib/File/Spec/VMS.pm @@ -4,7 +4,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/lib/File/Spec/Win32.pm b/dist/PathTools/lib/File/Spec/Win32.pm index a3b89c3ff607..153744202338 100644 --- a/dist/PathTools/lib/File/Spec/Win32.pm +++ b/dist/PathTools/lib/File/Spec/Win32.pm @@ -5,7 +5,7 @@ use strict; use Cwd (); require File::Spec::Unix; -our $VERSION = '3.79'; +our $VERSION = '3.80'; $VERSION =~ tr/_//d; our @ISA = qw(File::Spec::Unix); diff --git a/dist/PathTools/t/cwd.t b/dist/PathTools/t/cwd.t index c05693880e2d..d155e33255ae 100644 --- a/dist/PathTools/t/cwd.t +++ b/dist/PathTools/t/cwd.t @@ -187,6 +187,10 @@ rmtree($test_dirs[0], 0, 0); SKIP: { skip "no symlinks on this platform", 2+$EXTRA_ABSPATH_TESTS unless $Config{d_symlink} && $^O !~ m!^(qnx|nto)!; + # on Win32 GetCurrentDirectory() includes the symlink if + # you chdir() to a path including the symlink. + skip "Win32 symlinks are unusual", 2+$EXTRA_ABSPATH_TESTS if $^O eq "MSWin32"; + my $file = "linktest"; mkpath([$Test_Dir], 0, 0777); symlink $Test_Dir, $file; From a0ced391f0a77a8d66c8cba046a923721e0dd52b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 7 Oct 2020 11:53:05 +1100 Subject: [PATCH 125/503] File::Find find.t: switch to done_testing() --- ext/File-Find/t/find.t | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t index 40d14db0c687..37ba6d51c9d9 100644 --- a/ext/File-Find/t/find.t +++ b/ext/File-Find/t/find.t @@ -24,13 +24,8 @@ BEGIN { } my $symlink_exists = eval { symlink("",""); 1 }; -my $test_count = 111; -$test_count += 127 if $symlink_exists; -$test_count += 26 if $^O eq 'MSWin32'; -$test_count += 2 if $^O eq 'MSWin32' and $symlink_exists; use Test::More; -plan tests => $test_count; use lib qw( ./t/lib ); use Testing qw( create_file_ok @@ -1104,3 +1099,5 @@ if ($^O eq 'MSWin32') { like($@, qr/invalid top directory/, "find() correctly died due to undefined top directory"); } + +done_testing(); From 0d00729c03a1f68e1b51e986d1ce9000b0e3d301 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 7 Oct 2020 12:07:31 +1100 Subject: [PATCH 126/503] File::Find: support Win32 symlinks find.t, taint.t: check that symlink() works under the current permissions/filesystem rather than assuming it will work find.t: since symlinks are now available, an earlier test block set $FileFileTests_OK, and the tests in this Win32 block don't use either of the follow options, which is required for fast file tests. taint.t: ensure we get "/" separated names to match File::Find's output --- ext/File-Find/lib/File/Find.pm | 7 +++--- ext/File-Find/t/find.t | 14 +++++++++++- ext/File-Find/t/lib/Testing.pm | 2 +- ext/File-Find/t/taint.t | 40 +++++++++++++++++++++++++++++++--- 4 files changed, 54 insertions(+), 9 deletions(-) diff --git a/ext/File-Find/lib/File/Find.pm b/ext/File-Find/lib/File/Find.pm index 4c67e882a5e0..01dbc8b82590 100644 --- a/ext/File-Find/lib/File/Find.pm +++ b/ext/File-Find/lib/File/Find.pm @@ -3,7 +3,7 @@ use 5.006; use strict; use warnings; use warnings::register; -our $VERSION = '1.37'; +our $VERSION = '1.38'; require Exporter; require Cwd; @@ -161,9 +161,8 @@ sub _find_opt { $pre_process = $wanted->{preprocess}; $post_process = $wanted->{postprocess}; $no_chdir = $wanted->{no_chdir}; - $full_check = $Is_Win32 ? 0 : $wanted->{follow}; - $follow = $Is_Win32 ? 0 : - $full_check || $wanted->{follow_fast}; + $full_check = $wanted->{follow}; + $follow = $full_check || $wanted->{follow_fast}; $follow_skip = $wanted->{follow_skip}; $untaint = $wanted->{untaint}; $untaint_pat = $wanted->{untaint_pattern}; diff --git a/ext/File-Find/t/find.t b/ext/File-Find/t/find.t index 37ba6d51c9d9..add20c268394 100644 --- a/ext/File-Find/t/find.t +++ b/ext/File-Find/t/find.t @@ -34,6 +34,7 @@ use Testing qw( dir_path file_path ); +use Errno (); my %Expect_File = (); # what we expect for $_ my %Expect_Name = (); # what we expect for $File::Find::name/fullname @@ -247,7 +248,17 @@ create_file_ok( file_path('fb', $testing_basenames[0]) ); mkdir_ok( dir_path('fb', 'fba'), 0770 ); create_file_ok( file_path('fb', 'fba', $testing_basenames[1]) ); if ($symlink_exists) { - symlink_ok('../fb','fa/fsl'); + if (symlink('../fb','fa/fsl')) { + pass("able to symlink from ../fb to fa/fsl"); + } + else { + if ($^O eq "MSWin32" && ($! == &Errno::ENOSYS || $! == &Errno::EPERM)) { + $symlink_exists = 0; + } + else { + fail("able to symlink from ../fb to fa/fsl"); + } + } } create_file_ok( file_path('fa', $testing_basenames[2]) ); @@ -880,6 +891,7 @@ if ($^O eq 'MSWin32') { dir_path('fb') => 1, dir_path('fba') => 1); + $FastFileTests_OK = 0; File::Find::find( {wanted => \&wanted_File_Dir}, topdir('fa')); is( scalar(keys %Expect_File), 0, "Got no files, as expected" ); diff --git a/ext/File-Find/t/lib/Testing.pm b/ext/File-Find/t/lib/Testing.pm index c638ce06b756..056e06cc8118 100644 --- a/ext/File-Find/t/lib/Testing.pm +++ b/ext/File-Find/t/lib/Testing.pm @@ -28,7 +28,7 @@ sub mkdir_ok($$;$) { my ($dir, $mask) = @_[0..1]; my $msg = $_[2] || "able to mkdir: $dir"; ok( mkdir($dir, $mask), $msg ) - or die("Unable to mkdir: $dir"); + or die("Unable to mkdir $!: $dir"); } sub symlink_ok($$;$) { diff --git a/ext/File-Find/t/taint.t b/ext/File-Find/t/taint.t index f56d18696c91..aed431aed47c 100644 --- a/ext/File-Find/t/taint.t +++ b/ext/File-Find/t/taint.t @@ -1,5 +1,24 @@ #!./perl -T use strict; + +BEGIN { + require File::Spec; + if ($ENV{PERL_CORE}) { + # May be doing dynamic loading while @INC is all relative + @INC = map { $_ = File::Spec->rel2abs($_); /(.*)/; $1 } @INC; + } + + if ($^O eq 'MSWin32' || $^O eq 'cygwin' || $^O eq 'VMS') { + # This is a hack - at present File::Find does not produce native names + # on Win32 or VMS, so force File::Spec to use Unix names. + # must be set *before* importing File::Find + require File::Spec::Unix; + @File::Spec::ISA = 'File::Spec::Unix'; + } + require File::Find; + import File::Find; +} + use Test::More; BEGIN { plan( @@ -16,6 +35,7 @@ use Testing qw( dir_path file_path ); +use Errno (); my %Expect_File = (); # what we expect for $_ my %Expect_Name = (); # what we expect for $File::Find::name/fullname @@ -169,8 +189,21 @@ create_file_ok( file_path('fb_taint', 'fb_ord') ); mkdir_ok( dir_path('fb_taint', 'fba'), 0770 ); create_file_ok( file_path('fb_taint', 'fba', 'fba_ord') ); SKIP: { - skip "Creating symlink", 1, unless $symlink_exists; - ok( symlink('../fb_taint','fa_taint/fsl'), 'Created symbolic link' ); + skip "Creating symlink", 1, unless $symlink_exists; + if (symlink('../fb_taint','fa_taint/fsl')) { + pass('Created symbolic link' ); + } + else { + my $error = 0 + $!; + if ($^O eq "MSWin32" && + ($error == &Errno::ENOSYS || $error == &Errno::EPERM)) { + $symlink_exists = 0; + skip "symbolic links not available", 1; + } + else { + fail('Created symbolic link'); + } + } } create_file_ok( file_path('fa_taint', 'fa_ord') ); @@ -201,7 +234,8 @@ delete @Expect_Dir{ dir_path('fb_taint'), dir_path('fba') } unless $symlink_exis File::Find::find( {wanted => \&wanted_File_Dir_prune, untaint => 1, untaint_pattern => qr|^(.+)$|}, topdir('fa_taint') ); -is(scalar keys %Expect_File, 0, 'Found all expected files'); +is(scalar keys %Expect_File, 0, 'Found all expected files') + or diag "Not found " . join(" ", sort keys %Expect_File); # don't untaint at all, should die %Expect_File = (); From 520fd6d3ecf7b0cec09bae8a26b939b7ed485bbf Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 7 Oct 2020 12:08:30 +1100 Subject: [PATCH 127/503] File::Copy: support symlinks on Win32 --- lib/File/Copy.pm | 4 ++-- lib/File/Copy.t | 5 ++++- 2 files changed, 6 insertions(+), 3 deletions(-) diff --git a/lib/File/Copy.pm b/lib/File/Copy.pm index 63609cc28e63..ac98cc2df02a 100644 --- a/lib/File/Copy.pm +++ b/lib/File/Copy.pm @@ -24,7 +24,7 @@ sub syscopy; sub cp; sub mv; -$VERSION = '2.34'; +$VERSION = '2.35'; require Exporter; @ISA = qw(Exporter); @@ -100,7 +100,7 @@ sub copy { } if ((($Config{d_symlink} && $Config{d_readlink}) || $Config{d_link}) && - !($^O eq 'MSWin32' || $^O eq 'os2')) { + !($^O eq 'os2')) { my @fs = stat($from); if (@fs) { my @ts = stat($to); diff --git a/lib/File/Copy.t b/lib/File/Copy.t index 57d9478a68b8..f21c871316b6 100644 --- a/lib/File/Copy.t +++ b/lib/File/Copy.t @@ -164,7 +164,10 @@ for my $cross_partition_test (0..1) { open(F, ">", "file-$$") or die $!; print F "dummy content\n"; close F; - symlink("file-$$", "symlink-$$") or die $!; + if (!symlink("file-$$", "symlink-$$")) { + unlink "file-$$"; + skip "Can't create symlink", 3; + } my $warnings = ''; local $SIG{__WARN__} = sub { $warnings .= join '', @_ }; From 690ab4ba4bc90fa2f43c03eb418c3dc163f57ea8 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 15 Oct 2020 10:38:05 +1100 Subject: [PATCH 128/503] Win32: re-work FILETIME <=> time_t conversions Current versions of Windows claim to support leap seconds, but the time conversion I was using ignores that possibility. Switch to using APIs (FileTimeToSystemTime() and SystemTimeToFileTime()) that are documented to support leap seconds that might be included in a FILETIME. --- win32/win32.c | 56 +++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 41 insertions(+), 15 deletions(-) diff --git a/win32/win32.c b/win32/win32.c index 829bdfbc6069..1046f6cfd573 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1474,16 +1474,24 @@ win32_kill(int pid, int sig) PERL_STATIC_INLINE time_t translate_ft_to_time_t(FILETIME ft) { - /* Based on Win32::UTCTime. - Older CRTs (including MSVCRT used for gcc builds) product - strange behaviour when the specified time and the current time - differ on whether DST was in effect, this code doesnt have that - problem. - */ - ULARGE_INTEGER u; - u.LowPart = ft.dwLowDateTime; - u.HighPart = ft.dwHighDateTime; - return (u.QuadPart - time_t_epoch_base_filetime.QuadPart) / FILETIME_CHUNKS_PER_SECOND; + SYSTEMTIME st, local_st; + struct tm pt; + + if (!FileTimeToSystemTime(&ft, &st) || + !SystemTimeToTzSpecificLocalTime(NULL, &st, &local_st)) { + return -1; + } + + Zero(&pt, 1, struct tm); + pt.tm_year = local_st.wYear - 1900; + pt.tm_mon = local_st.wMonth - 1; + pt.tm_mday = local_st.wDay; + pt.tm_hour = local_st.wHour; + pt.tm_min = local_st.wMinute; + pt.tm_sec = local_st.wSecond; + pt.tm_isdst = -1; + + return mktime(&pt); } static int @@ -2173,12 +2181,30 @@ win32_times(struct tms *timebuf) static BOOL filetime_from_time(PFILETIME pFileTime, time_t Time) { - ULARGE_INTEGER u; - u.QuadPart = Time; - u.QuadPart = u.QuadPart * FILETIME_CHUNKS_PER_SECOND + time_t_epoch_base_filetime.QuadPart; + struct tm *pt; + SYSTEMTIME st; - pFileTime->dwLowDateTime = u.LowPart; - pFileTime->dwHighDateTime = u.HighPart; + pt = gmtime(&Time); + if (!pt) { + pFileTime->dwLowDateTime = 0; + pFileTime->dwHighDateTime = 0; + fprintf(stderr, "fail bad gmtime\n"); + return FALSE; + } + + st.wYear = pt->tm_year + 1900; + st.wMonth = pt->tm_mon + 1; + st.wDay = pt->tm_mday; + st.wHour = pt->tm_hour; + st.wMinute = pt->tm_min; + st.wSecond = pt->tm_sec; + st.wMilliseconds = 0; + + if (!SystemTimeToFileTime(&st, pFileTime)) { + pFileTime->dwLowDateTime = 0; + pFileTime->dwHighDateTime = 0; + return FALSE; + } return TRUE; } From 17ab6b6399dbe07e478478e9eba9aeb345eab2ed Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 15 Oct 2020 11:21:31 +1100 Subject: [PATCH 129/503] win32 symlink: only use the unprivileged flag if windows is new enough --- win32/win32.c | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/win32/win32.c b/win32/win32.c index 1046f6cfd573..8cbe4dad925c 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -3432,7 +3432,15 @@ win32_symlink(const char *oldfile, const char *newfile) char szTargetName[MAX_PATH+1]; size_t oldfile_len = strlen(oldfile); DWORD dest_attr; - DWORD create_flags = SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE; + DWORD create_flags = 0; + + /* this flag can be used only on Windows 10 1703 or newer */ + if (g_osver.dwMajorVersion > 10 || + (g_osver.dwMajorVersion == 10 && + (g_osver.dwMinorVersion > 0 || g_osver.dwBuildNumber > 15063))) + { + create_flags |= SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE; + } /* oldfile might be relative and we don't want to change that, so don't map that. From 203831af1a745c76df85e12f4a1cf47e5bddf3ff Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 15 Oct 2020 11:46:15 +1100 Subject: [PATCH 130/503] remove ${^WIN32_SLOPPY_STAT} The new implementation, like the UCRT implementation, always opens the specified file. --- mg.c | 10 ---------- pod/perlvar.pod | 13 ++----------- win32/win32.c | 6 ------ win32/win32.h | 2 -- 4 files changed, 2 insertions(+), 29 deletions(-) diff --git a/mg.c b/mg.c index 8b90aa4e3f34..f302489fffba 100644 --- a/mg.c +++ b/mg.c @@ -1128,11 +1128,6 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) *PL_compiling.cop_warnings); } } -#ifdef WIN32 - else if (strEQ(remaining, "IN32_SLOPPY_STAT")) { - sv_setiv(sv, w32_sloppystat); - } -#endif break; case '+': if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { @@ -3044,11 +3039,6 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } } } -#ifdef WIN32 - else if (strEQ(mg->mg_ptr+1, "IN32_SLOPPY_STAT")) { - w32_sloppystat = SvTRUE(sv); - } -#endif break; case '.': if (PL_localizing) { diff --git a/pod/perlvar.pod b/pod/perlvar.pod index cfe9ff2f38f9..2c295ddbd2ff 100644 --- a/pod/perlvar.pod +++ b/pod/perlvar.pod @@ -750,18 +750,9 @@ Mnemonic: use ^V for a version object. =item ${^WIN32_SLOPPY_STAT} X<${^WIN32_SLOPPY_STAT}> X X -If this variable is set to a true value, then C on Windows will -not try to open the file. This means that the link count cannot be -determined and file attributes may be out of date if additional -hardlinks to the file exist. On the other hand, not opening the file -is considerably faster, especially for files on network drives. +This variable no longer has any function. -This variable could be set in the F file to -configure the local Perl installation to use "sloppy" C by -default. See the documentation for B<-f> in L -for more information about site customization. - -This variable was added in Perl v5.10.0. +This variable was added in Perl v5.10.0 and removed in Perl v5.34.0. =item $EXECUTABLE_NAME diff --git a/win32/win32.c b/win32/win32.c index 8cbe4dad925c..eb11e147d8a9 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -5030,11 +5030,6 @@ Perl_sys_intern_init(pTHX) w32_timerid = 0; w32_message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE); w32_poll_count = 0; -#ifdef PERL_IS_MINIPERL - w32_sloppystat = TRUE; -#else - w32_sloppystat = FALSE; -#endif for (i=0; i < SIG_SIZE; i++) { w32_sighandler[i] = SIG_DFL; } @@ -5103,7 +5098,6 @@ Perl_sys_intern_dup(pTHX_ struct interp_intern *src, struct interp_intern *dst) dst->timerid = 0; dst->message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE); dst->poll_count = 0; - dst->sloppystat = src->sloppystat; Copy(src->sigtable,dst->sigtable,SIG_SIZE,Sighandler_t); } # endif /* USE_ITHREADS */ diff --git a/win32/win32.h b/win32/win32.h index 171cbfb8b87b..40ab7e043a46 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -563,7 +563,6 @@ struct interp_intern { UINT timerid; unsigned poll_count; Sighandler_t sigtable[SIG_SIZE]; - bool sloppystat; }; #define WIN32_POLL_INTERVAL 32768 @@ -597,7 +596,6 @@ struct interp_intern { #define w32_init_socktype (PL_sys_intern.thr_intern.Winit_socktype) #define w32_use_showwindow (PL_sys_intern.thr_intern.Wuse_showwindow) #define w32_showwindow (PL_sys_intern.thr_intern.Wshowwindow) -#define w32_sloppystat (PL_sys_intern.sloppystat) #ifdef USE_ITHREADS void win32_wait_for_children(pTHX); From 2bfb75d20f6d643150258ffdbe1647239cb5f69a Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 15 Oct 2020 15:11:13 +1100 Subject: [PATCH 131/503] lstat(), readlink() and unlink() treat directory junctions as symlinks --- pod/perlport.pod | 11 ++++++-- t/win32/stat.t | 4 +-- t/win32/symlink.t | 7 +++--- win32/win32.c | 64 ++++++++++++++++++++++++++++++++++------------- 4 files changed, 61 insertions(+), 25 deletions(-) diff --git a/pod/perlport.pod b/pod/perlport.pod index 42e178a8b634..63869d53e3d2 100644 --- a/pod/perlport.pod +++ b/pod/perlport.pod @@ -1526,6 +1526,9 @@ C<-x>, C<-o>. (Win32, VMS, S) C<-g>, C<-k>, C<-l>, C<-u>, C<-A> are not particularly meaningful. +(Win32) +C<-l> returns true for both symlinks and directory junctions. + (VMS, S) C<-p> is not particularly meaningful. @@ -1952,7 +1955,7 @@ but usually by no more than an hour. Not implemented. (Win32) -Return values (especially for device and inode) may be bogus. +Treats directory junctions as symlinks. =item msgctl @@ -1982,9 +1985,13 @@ implications for your code. =item readlink -(Win32, VMS, S) +(VMS, S) Not implemented. +(Win32) +readlink() on a directory junction returns the object name, not a +simple path. + =item rename (Win32) diff --git a/t/win32/stat.t b/t/win32/stat.t index 6046994f612d..09f52ad95715 100644 --- a/t/win32/stat.t +++ b/t/win32/stat.t @@ -112,10 +112,10 @@ if (system("mklink /d $tmpfile1 win32") == 0) { rmdir( $tmpfile1 ); } -# check a junction doesn't look like a symlink +# check a junction looks like a symlink if (system("mklink /j $tmpfile1 win32") == 0) { - ok(!-l $tmpfile1, "lstat doesn't see a symlink on the directory junction"); + ok(-l $tmpfile1, "lstat sees a symlink on the directory junction"); rmdir( $tmpfile1 ); } diff --git a/t/win32/symlink.t b/t/win32/symlink.t index 9716f3789c61..e9088cd517ae 100644 --- a/t/win32/symlink.t +++ b/t/win32/symlink.t @@ -59,9 +59,10 @@ ok(mkdir($tmpfile1), "make a directory"); # this may only work in an admin shell # MKLINK [[/D] | [/H] | [/J]] Link Target if (system("mklink /j $tmpfile2 $tmpfile1") == 0) { - ok(!-l $tmpfile2, "junction doesn't look like a symlink"); - ok(!unlink($tmpfile2), "no unlink magic for junctions"); - rmdir($tmpfile2); + ok(-l $tmpfile2, "junction does look like a symlink"); + like(readlink($tmpfile2), qr/\Q$tmpfile1\E$/, + "readlink() works on a junction"); + ok(unlink($tmpfile2), "unlink magic for junctions"); } rmdir($tmpfile1); diff --git a/win32/win32.c b/win32/win32.c index eb11e147d8a9..65d154d75aae 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1660,8 +1660,8 @@ translate_to_errno(void) Renamed to avoid conflicts, apparently some SDKs define this structure. -Hoisted the symlink data into a new type to allow us to make a pointer -to it, and to avoid C++ scoping issues. +Hoisted the symlink and mount point data into a new type to allow us +to make a pointer to it, and to avoid C++ scoping issues. */ @@ -1674,19 +1674,21 @@ typedef struct { WCHAR PathBuffer[MAX_PATH*3]; } MY_SYMLINK_REPARSE_BUFFER, *PMY_SYMLINK_REPARSE_BUFFER; +typedef struct { + USHORT SubstituteNameOffset; + USHORT SubstituteNameLength; + USHORT PrintNameOffset; + USHORT PrintNameLength; + WCHAR PathBuffer[MAX_PATH*3]; +} MY_MOUNT_POINT_REPARSE_BUFFER; + typedef struct { ULONG ReparseTag; USHORT ReparseDataLength; USHORT Reserved; union { MY_SYMLINK_REPARSE_BUFFER SymbolicLinkReparseBuffer; - struct { - USHORT SubstituteNameOffset; - USHORT SubstituteNameLength; - USHORT PrintNameOffset; - USHORT PrintNameLength; - WCHAR PathBuffer[1]; - } MountPointReparseBuffer; + MY_MOUNT_POINT_REPARSE_BUFFER MountPointReparseBuffer; struct { UCHAR DataBuffer[1]; } GenericReparseBuffer; @@ -1705,7 +1707,8 @@ is_symlink(HANDLE h) { } if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer) - || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) { + || (linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK + && linkdata.ReparseTag != IO_REPARSE_TAG_MOUNT_POINT)) { /* some other type of reparse point */ return FALSE; } @@ -1731,8 +1734,6 @@ is_symlink_name(const char *name) { DllExport int win32_readlink(const char *pathname, char *buf, size_t bufsiz) { MY_REPARSE_DATA_BUFFER linkdata; - const MY_SYMLINK_REPARSE_BUFFER * const sd = - &linkdata.Data.SymbolicLinkReparseBuffer; HANDLE hlink; DWORD fileattr = GetFileAttributes(pathname); DWORD linkdata_returned; @@ -1765,16 +1766,43 @@ win32_readlink(const char *pathname, char *buf, size_t bufsiz) { } CloseHandle(hlink); - if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer) - || linkdata.ReparseTag != IO_REPARSE_TAG_SYMLINK) { + switch (linkdata.ReparseTag) { + case IO_REPARSE_TAG_SYMLINK: + { + const MY_SYMLINK_REPARSE_BUFFER * const sd = + &linkdata.Data.SymbolicLinkReparseBuffer; + if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.SymbolicLinkReparseBuffer.PathBuffer)) { + errno = EINVAL; + return -1; + } + bytes_out = + WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, + sd->PathBuffer + sd->SubstituteNameOffset/2, + sd->SubstituteNameLength/2, + buf, (int)bufsiz, NULL, &used_default); + } + break; + case IO_REPARSE_TAG_MOUNT_POINT: + { + const MY_MOUNT_POINT_REPARSE_BUFFER * const rd = + &linkdata.Data.MountPointReparseBuffer; + if (linkdata_returned < offsetof(MY_REPARSE_DATA_BUFFER, Data.MountPointReparseBuffer.PathBuffer)) { + errno = EINVAL; + return -1; + } + bytes_out = + WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, + rd->PathBuffer + rd->SubstituteNameOffset/2, + rd->SubstituteNameLength/2, + buf, (int)bufsiz, NULL, &used_default); + } + break; + + default: errno = EINVAL; return -1; } - bytes_out = WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, - sd->PathBuffer+sd->SubstituteNameOffset/2, - sd->SubstituteNameLength/2, - buf, bufsiz, NULL, &used_default); if (bytes_out == 0 || used_default) { /* failed conversion from unicode to ANSI or otherwise failed */ errno = EINVAL; From d9f9953f74a41a404d61c6ddef3ed682eec1aa1c Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 19 Oct 2020 14:26:57 +1100 Subject: [PATCH 132/503] Win32: don't include version specific config for prebuilt config_h.* This fixes the problem where doing a regen_config_h with a compiler that supports stdbool.h would generate a config_h.* that would result in a build failure on older compilers that didn't support stdbool.h. --- win32/GNUmakefile | 2 +- win32/Makefile | 2 +- win32/config_H.gc | 12 ++++++------ win32/config_H.vc | 16 ++++++++-------- win32/config_sh.PL | 10 ++++++++-- win32/makefile.mk | 2 +- 6 files changed, 25 insertions(+), 19 deletions(-) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 084cb5031e56..cb8c5cbb6bba 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1279,7 +1279,7 @@ endif # with MULTI, ITHREADS, IMP_SYS, LARGE_FILES and PERLIO off), then make # this target to regenerate config_H.gc. regen_config_h: - $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh + $(MINIPERL) -I..\lib config_sh.PL --prebuilt $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh $(MINIPERL) -I..\lib ..\configpm --chdir=.. -del /f $(CFGH_TMPL) -$(MINIPERL) -I..\lib config_h.PL "ARCHPREFIX=$(ARCHPREFIX)" diff --git a/win32/Makefile b/win32/Makefile index 41b9fb8bc57d..efd6d4bbf845 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -954,7 +954,7 @@ perlglob$(o) : perlglob.c # ITHREADS, IMP_SYS and LARGE_FILES off), then make this target # to regenerate config_H.vc. regen_config_h: - $(MINIPERL) -I..\lib config_sh.PL $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh + $(MINIPERL) -I..\lib config_sh.PL --prebuilt $(CFG_VARS) $(CFGSH_TMPL) > ..\config.sh $(MINIPERL) -I..\lib ..\configpm --chdir=.. -del /f $(CFGH_TMPL) -$(MINIPERL) -I..\lib config_h.PL diff --git a/win32/config_H.gc b/win32/config_H.gc index 7bfdf1102932..c4d393262bb4 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:35:37 2020 + * Configuration time: Mon Oct 19 14:19:25 2020 * Configured by : tony * Target system : */ @@ -1369,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "10.0.18363.1082" /**/ +#define OSVERS "10.0.18363.1139" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -4247,7 +4247,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -#define USE_LARGE_FILES /**/ +/*#define USE_LARGE_FILES / **/ #endif /* USE_LONG_DOUBLE: @@ -5211,9 +5211,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long long /* type */ -#define LSEEKSIZE 8 /* size */ -#define Off_t_size 8 /* size */ +#define Off_t long /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes diff --git a/win32/config_H.vc b/win32/config_H.vc index 49b8ea793569..2fe47d0a345b 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Wed Oct 7 16:33:14 2020 + * Configuration time: Mon Oct 19 14:24:24 2020 * Configured by : tony * Target system : */ @@ -1369,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "10.0.18363.1082" /**/ +#define OSVERS "10.0.18363.1139" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -3732,13 +3732,13 @@ * This symbol, if defined, indicates that exists and * can be included. */ -#define I_STDBOOL /**/ +/*#define I_STDBOOL / **/ /* I_STDINT: * This symbol, if defined, indicates that exists and * should be included. */ -#define I_STDINT /**/ +/*#define I_STDINT / **/ /* I_SUNMATH: * This symbol, if defined, indicates that exists and @@ -4247,7 +4247,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -#define USE_LARGE_FILES /**/ +/*#define USE_LARGE_FILES / **/ #endif /* USE_LONG_DOUBLE: @@ -5211,9 +5211,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t __int64 /* type */ -#define LSEEKSIZE 8 /* size */ -#define Off_t_size 8 /* size */ +#define Off_t long /* type */ +#define LSEEKSIZE 4 /* size */ +#define Off_t_size 4 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes diff --git a/win32/config_sh.PL b/win32/config_sh.PL index d1543889dce4..72300c5be98d 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -37,6 +37,12 @@ sub loadopts { } } +my $prebuilt; # are we making the prebuilt config used to bootstrap? +if (@ARGV && $ARGV[0] eq '--prebuilt') { + ++$prebuilt; + shift; +} + my %opt; my $optref = loadopts(); @@ -257,7 +263,7 @@ if ($opt{cc} =~ /\bcl/ and $opt{ccversion} =~ /^(\d+)/) { $opt{sGMTIME_max} = 32535291599; $opt{sLOCALTIME_max} = 32535244799; } - if ($ccversion >= 16) { # VC10+ + if ($ccversion >= 16 && !$prebuilt) { # VC10+ $opt{i_stdint} = 'define'; } if ($ccversion >= 19) { # VC14+ @@ -265,7 +271,7 @@ if ($opt{cc} =~ /\bcl/ and $opt{ccversion} =~ /^(\d+)/) { $opt{stdio_bufsiz} = '(PERLIO_FILE_cnt(fp) + PERLIO_FILE_ptr(fp) - PERLIO_FILE_base(fp))'; $opt{stdio_cnt} = 'PERLIO_FILE_cnt(fp)'; $opt{stdio_ptr} = 'PERLIO_FILE_ptr(fp)'; - $opt{i_stdbool} = 'define'; + $opt{i_stdbool} = 'define' unless $prebuilt; } } # find out which MSVC this ICC is using diff --git a/win32/makefile.mk b/win32/makefile.mk index 6ddc4d0fbda3..1e3d5e0f120d 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1227,7 +1227,7 @@ $(GLOBEXE) : perlglob.c # with MULTI, ITHREADS, IMP_SYS and LARGE_FILES off), then make # this target to regenerate config_H.gc. regen_config_h: - $(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file $(mktmp $(CFG_VARS)) \ + $(MINIPERL) -I..\lib config_sh.PL --prebuilt --cfgsh-option-file $(mktmp $(CFG_VARS)) \ $(CFGSH_TMPL) > ..\config.sh $(MINIPERL) -I..\lib ..\configpm --chdir=.. -del /f $(CFGH_TMPL) From 7c04651411221e54ce561cd41ae8fa76347bbd5a Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 9 Nov 2020 13:52:09 +1100 Subject: [PATCH 133/503] pre-vista support for win32_symlink --- win32/win32.c | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/win32/win32.c b/win32/win32.c index 65d154d75aae..f18223d2ad69 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -3448,6 +3448,12 @@ win32_link(const char *oldname, const char *newname) return -1; } +typedef BOOLEAN (__stdcall *pCreateSymbolicLinkA_t)(LPCSTR, LPCSTR, DWORD); + +#ifndef SYMBOLIC_LINK_FLAG_DIRECTORY +# define SYMBOLIC_LINK_FLAG_DIRECTORY 0x1 +#endif + #ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE # define SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE 0x2 #endif @@ -3459,6 +3465,8 @@ win32_symlink(const char *oldfile, const char *newfile) const char *dest_path = oldfile; char szTargetName[MAX_PATH+1]; size_t oldfile_len = strlen(oldfile); + pCreateSymbolicLinkA_t pCreateSymbolicLinkA = + (pCreateSymbolicLinkA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateSymbolicLinkA"); DWORD dest_attr; DWORD create_flags = 0; @@ -3470,6 +3478,11 @@ win32_symlink(const char *oldfile, const char *newfile) create_flags |= SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE; } + if (!pCreateSymbolicLinkA) { + errno = ENOSYS; + return -1; + } + /* oldfile might be relative and we don't want to change that, so don't map that. */ @@ -3514,7 +3527,7 @@ win32_symlink(const char *oldfile, const char *newfile) create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; } - if (!CreateSymbolicLinkA(newfile, oldfile, create_flags)) { + if (!pCreateSymbolicLinkA(newfile, oldfile, create_flags)) { translate_to_errno(); return -1; } From 9a1250917f0a11e197e9776a3baee0aa232ea2ed Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 20 Oct 2020 16:12:09 +1100 Subject: [PATCH 134/503] Win32: try to make the new stat pre-Vista compatible Skips the win32\stat.t execute flag test for handles pre-Vista This is intended mostly for allowing the Win2000 smoker to build and test. If we end up dropping pre-Vista support this commit can be removed (or reverted if it ends up in blead) --- t/win32/stat.t | 10 +++++++++- win32/win32.c | 16 +++++++++++++++- 2 files changed, 24 insertions(+), 2 deletions(-) diff --git a/t/win32/stat.t b/t/win32/stat.t index 09f52ad95715..b2dccb8bf2bc 100644 --- a/t/win32/stat.t +++ b/t/win32/stat.t @@ -12,6 +12,10 @@ use Fcntl ":seek"; Win32::FsType() eq 'NTFS' or skip_all("need NTFS"); +my (undef, $maj, $min) = Win32::GetOSVersion(); + +my $vista_or_later = $maj >= 6; + my $tmpfile1 = tempfile(); # test some of the win32 specific stat code, since we @@ -71,7 +75,11 @@ unlink($tmpfile1); # no more hard link if (open my $fh, ">", "$tmpfile1.bat") { ok(-x "$tmpfile1.bat", 'batch file is "executable"'); - ok(-x $fh, 'batch file handle is "executable"'); + SKIP: { + skip "executable bit for handles needs vista or later", 1 + unless $vista_or_later; + ok(-x $fh, 'batch file handle is "executable"'); + } close $fh; unlink "$tmpfile1.bat"; } diff --git a/win32/win32.c b/win32/win32.c index f18223d2ad69..7ea15e4a4246 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1494,6 +1494,8 @@ translate_ft_to_time_t(FILETIME ft) { return mktime(&pt); } +typedef DWORD (__stdcall *pGetFinalPathNameByHandleA_t)(HANDLE, LPSTR, DWORD, DWORD); + static int win32_stat_low(HANDLE handle, const char *path, STRLEN len, Stat_t *sbuf) { DWORD type = GetFileType(handle); @@ -1536,7 +1538,15 @@ win32_stat_low(HANDLE handle, const char *path, STRLEN len, Stat_t *sbuf) { sbuf->st_mode = _S_IFREG; if (!path) { - len = GetFinalPathNameByHandleA(handle, path_buf, sizeof(path_buf), 0); + pGetFinalPathNameByHandleA_t pGetFinalPathNameByHandleA = + (pGetFinalPathNameByHandleA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "GetFinalPathNameByHandleA"); + if (pGetFinalPathNameByHandleA) { + len = pGetFinalPathNameByHandleA(handle, path_buf, sizeof(path_buf), 0); + } + else { + len = 0; + } + /* < to ensure there's space for the \0 */ if (len && len < sizeof(path_buf)) { path = path_buf; @@ -1695,6 +1705,10 @@ typedef struct { } Data; } MY_REPARSE_DATA_BUFFER, *PMY_REPARSE_DATA_BUFFER; +#ifndef IO_REPARSE_TAG_SYMLINK +# define IO_REPARSE_TAG_SYMLINK (0xA000000CL) +#endif + static BOOL is_symlink(HANDLE h) { MY_REPARSE_DATA_BUFFER linkdata; From 7e6c9456ae41721f3054e84eb60242e86219542a Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 28 Oct 2020 13:46:01 +1100 Subject: [PATCH 135/503] t/op/taint.t: handle symlink requiring anything unavailable like privileges, or a filesystem without symlink support --- t/op/taint.t | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/t/op/taint.t b/t/op/taint.t index 73246a09d991..607a305202d3 100644 --- a/t/op/taint.t +++ b/t/op/taint.t @@ -1498,7 +1498,11 @@ violates_taint(sub { link $TAINT, '' }, 'link'); unlink($symlink); my $sl = "/something/naughty"; # it has to be a real path on Mac OS - symlink($sl, $symlink) or die "symlink: $!\n"; + unless (symlink($sl, $symlink)) { + skip "symlink not available or no priviliges", 1, + if $^O eq "MSWin32"; + die "symlink: $!\n"; + } my $readlink = readlink($symlink); is_tainted($readlink); unlink($symlink); From 72aac62720fdd7ad8838984e8ca7cf2dedb7a776 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 2 Nov 2020 14:28:29 +1100 Subject: [PATCH 136/503] Test-Harness: don't assume symlink succeeds https://github.com/Perl-Toolchain-Gang/Test-Harness/pull/103 upstream which has been applied but not released. --- Porting/Maintainers.pl | 5 +++++ cpan/Test-Harness/t/source.t | 3 ++- t/porting/customized.dat | 1 + 3 files changed, 8 insertions(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 652d198c8ae1..dcf1e7387c7c 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1081,6 +1081,11 @@ package Maintainers; t/lib/if.pm ), ], + 'CUSTOMIZED' => [ + # https://github.com/Perl-Toolchain-Gang/Test-Harness/pull/103 + # applied but not released + 't/source.t' + ], }, 'Test::Simple' => { diff --git a/cpan/Test-Harness/t/source.t b/cpan/Test-Harness/t/source.t index 767892c5723f..77cf44269745 100644 --- a/cpan/Test-Harness/t/source.t +++ b/cpan/Test-Harness/t/source.t @@ -242,11 +242,12 @@ SKIP: { my $symlink = File::Spec->catfile( $dir, 'source_link.T' ); my $source = TAP::Parser::Source->new; - eval { symlink( File::Spec->rel2abs($test), $symlink ) }; + my $did_symlink = eval { symlink( File::Spec->rel2abs($test), $symlink ) }; if ( my $e = $@ ) { diag($@); die "aborting test"; } + skip "symlink not successful: $!", 9 unless $did_symlink; $source->raw( \$symlink ); my $meta = $source->assemble_meta; diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 08acf8ae2c33..3bde6742c59d 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -22,6 +22,7 @@ Net::Ping dist/Net-Ping/t/450_service.t f6578680f2872d7fc9f24dd75388d55654761875 Net::Ping dist/Net-Ping/t/500_ping_icmp.t 3eeb60181c01b85f876bd6658644548fdf2e24d4 Net::Ping dist/Net-Ping/t/501_ping_icmpv6.t 54373de5858f8fb7e078e4998a4b3b8dbca91783 Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm 582be34c077c9ff44d99914724a0cc2140bcd48c +Test::Harness cpan/Test-Harness/t/source.t aaa3939591114c0c52ecd44159218336d1f762b9 Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5 experimental cpan/experimental/t/basic.t cb9da8dd05b854375809872a05dd32637508d5da From a2e9e863ec01c95edbb270bcf28d1869d7cedf5b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 11 Nov 2020 11:42:23 +1100 Subject: [PATCH 137/503] win32 symlink: treats paths that look like directories as directories --- t/win32/symlink.t | 28 ++++++++++++++++++++++++++++ win32/win32.c | 28 +++++++++++++++++++++++----- 2 files changed, 51 insertions(+), 5 deletions(-) diff --git a/t/win32/symlink.t b/t/win32/symlink.t index e9088cd517ae..96ed7a1b11eb 100644 --- a/t/win32/symlink.t +++ b/t/win32/symlink.t @@ -35,6 +35,34 @@ is(readlink($tmpfile2), $tmpfile1, "readlink works"); check_stat($tmpfile1, $tmpfile2, "check directory and link stat are the same"); ok(unlink($tmpfile2), "and we can unlink the symlink (rather than only rmdir)"); +# test our various name based directory tests +{ + use Win32API::File qw(GetFileAttributes FILE_ATTRIBUTE_DIRECTORY + INVALID_FILE_ATTRIBUTES); + # we can't use lstat() here, since the directory && symlink state + # can't be preserved in it's result, and normal stat would + # follow the link (which is broken for most of these) + # GetFileAttributes() doesn't follow the link and can present the + # directory && symlink state + my @tests = + ( + "x:", + "x:\\", + "x:/", + "unknown\\", + "unknown/", + ".", + "..", + ); + for my $path (@tests) { + ok(symlink($path, $tmpfile2), "symlink $path"); + my $attr = GetFileAttributes($tmpfile2); + ok($attr != INVALID_FILE_ATTRIBUTES && ($attr & FILE_ATTRIBUTE_DIRECTORY) != 0, + "symlink $path: treated as a directory"); + unlink($tmpfile2); + } +} + # to check the unlink code for symlinks isn't mis-handling non-symlink # directories ok(!unlink($tmpfile1), "we can't unlink the original directory"); diff --git a/win32/win32.c b/win32/win32.c index 7ea15e4a4246..2922248159b1 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -3476,12 +3476,9 @@ DllExport int win32_symlink(const char *oldfile, const char *newfile) { dTHX; - const char *dest_path = oldfile; - char szTargetName[MAX_PATH+1]; size_t oldfile_len = strlen(oldfile); pCreateSymbolicLinkA_t pCreateSymbolicLinkA = (pCreateSymbolicLinkA_t)GetProcAddress(GetModuleHandle("kernel32.dll"), "CreateSymbolicLinkA"); - DWORD dest_attr; DWORD create_flags = 0; /* this flag can be used only on Windows 10 1703 or newer */ @@ -3504,9 +3501,29 @@ win32_symlink(const char *oldfile, const char *newfile) /* are we linking to a directory? CreateSymlinkA() needs to know if the target is a directory, - if the oldfile is relative we need to make a relative path - based on the newfile + If it looks like a directory name: + - ends in slash + - is just . or .. + - ends in /. or /.. (with either slash) + - is a simple drive letter + assume it's a directory. + + Otherwise if the oldfile is relative we need to make a relative path + based on the newfile to check if the target is a directory. */ + if ((oldfile_len >= 1 && isSLASH(oldfile[oldfile_len-1])) || + strEQ(oldfile, "..") || + strEQ(oldfile, ".") || + (isSLASH(oldfile[oldfile_len-2]) && oldfile[oldfile_len-1] == '.') || + strEQ(oldfile+oldfile_len-3, "\\..") || + strEQ(oldfile+oldfile_len-3, "/..") || + (oldfile_len == 2 && oldfile[1] == ':')) { + create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; + } + else { /* indent in a second commit */ + DWORD dest_attr; + const char *dest_path = oldfile; + char szTargetName[MAX_PATH+1]; if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') { /* relative to current directory on a drive */ /* dest_path = oldfile; already done */ @@ -3540,6 +3557,7 @@ win32_symlink(const char *oldfile, const char *newfile) if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) { create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; } + } if (!pCreateSymbolicLinkA(newfile, oldfile, create_flags)) { translate_to_errno(); From 0d2c9baa1c18fc5a6d8d8a4668a207fe030f87a2 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 11 Nov 2020 11:46:15 +1100 Subject: [PATCH 138/503] win32 symlink: reindent --- win32/win32.c | 67 ++++++++++++++++++++++++++------------------------- 1 file changed, 34 insertions(+), 33 deletions(-) diff --git a/win32/win32.c b/win32/win32.c index 2922248159b1..9f0259a807f4 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -3520,43 +3520,44 @@ win32_symlink(const char *oldfile, const char *newfile) (oldfile_len == 2 && oldfile[1] == ':')) { create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; } - else { /* indent in a second commit */ - DWORD dest_attr; - const char *dest_path = oldfile; - char szTargetName[MAX_PATH+1]; - if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') { - /* relative to current directory on a drive */ - /* dest_path = oldfile; already done */ - } - else if (oldfile[0] != '\\' && oldfile[0] != '/') { - size_t newfile_len = strlen(newfile); - char *last_slash = strrchr(newfile, '/'); - char *last_bslash = strrchr(newfile, '\\'); - char *end_dir = last_slash && last_bslash - ? ( last_slash > last_bslash ? last_slash : last_bslash) - : last_slash ? last_slash : last_bslash ? last_bslash : NULL; - - if (end_dir) { - if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) { - /* too long */ - errno = EINVAL; - return -1; - } + else { + DWORD dest_attr; + const char *dest_path = oldfile; + char szTargetName[MAX_PATH+1]; - memcpy(szTargetName, newfile, end_dir - newfile + 1); - strcpy(szTargetName + (end_dir - newfile + 1), oldfile); - dest_path = szTargetName; + if (oldfile_len >= 3 && oldfile[1] == ':' && oldfile[2] != '\\' && oldfile[2] != '/') { + /* relative to current directory on a drive */ + /* dest_path = oldfile; already done */ } - else { - /* newpath is just a filename */ - /* dest_path = oldfile; */ + else if (oldfile[0] != '\\' && oldfile[0] != '/') { + size_t newfile_len = strlen(newfile); + char *last_slash = strrchr(newfile, '/'); + char *last_bslash = strrchr(newfile, '\\'); + char *end_dir = last_slash && last_bslash + ? ( last_slash > last_bslash ? last_slash : last_bslash) + : last_slash ? last_slash : last_bslash ? last_bslash : NULL; + + if (end_dir) { + if ((end_dir - newfile + 1) + oldfile_len > MAX_PATH) { + /* too long */ + errno = EINVAL; + return -1; + } + + memcpy(szTargetName, newfile, end_dir - newfile + 1); + strcpy(szTargetName + (end_dir - newfile + 1), oldfile); + dest_path = szTargetName; + } + else { + /* newpath is just a filename */ + /* dest_path = oldfile; */ + } } - } - dest_attr = GetFileAttributes(dest_path); - if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) { - create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; - } + dest_attr = GetFileAttributes(dest_path); + if (dest_attr != (DWORD)-1 && (dest_attr & FILE_ATTRIBUTE_DIRECTORY)) { + create_flags |= SYMBOLIC_LINK_FLAG_DIRECTORY; + } } if (!pCreateSymbolicLinkA(newfile, oldfile, create_flags)) { From 1380c4f3b8014de5b3d8522690cff7ac5c6162b9 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 11:07:59 +0000 Subject: [PATCH 139/503] Opcode.xs: fix compiler warning In some debugging code it was doing a SAVEDESTRUCTOR() to do a warn() on scope exit, but it should have used the nocontext version of warn(). --- ext/Opcode/Opcode.pm | 2 +- ext/Opcode/Opcode.xs | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index 9351c3ba2074..fd3fbee6188e 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -6,7 +6,7 @@ use strict; our($VERSION, @ISA, @EXPORT_OK); -$VERSION = "1.48"; +$VERSION = "1.49"; use Carp; use Exporter (); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 121b14f8e373..3fb1116f9ce2 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -237,7 +237,8 @@ opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then * is disallowed by Borland */ if (opcode_debug >= 2) - SAVEDESTRUCTOR((void(*)(void*))Perl_warn,"PL_op_mask restored"); + SAVEDESTRUCTOR((void(*)(void*))Perl_warn_nocontext, + "PL_op_mask restored"); PL_op_mask = &op_mask_buf[0]; if (orig_op_mask) Copy(orig_op_mask, PL_op_mask, PL_maxo, char); From 4e49ae2fc23076c138d32159db1884deda8905ad Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 15:12:14 +0000 Subject: [PATCH 140/503] ODBM_File.xs: silence -Wc++-compat warning Under gcc -Wc++-compat, it warns that 'delete' is a keyword. Since this is the name of the actual function in odbm, just temporarily disable the warning. --- ext/ODBM_File/ODBM_File.pm | 2 +- ext/ODBM_File/ODBM_File.xs | 8 ++++++++ 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/ext/ODBM_File/ODBM_File.pm b/ext/ODBM_File/ODBM_File.pm index 7bdbecc73ccd..1b49440f3a0a 100644 --- a/ext/ODBM_File/ODBM_File.pm +++ b/ext/ODBM_File/ODBM_File.pm @@ -7,7 +7,7 @@ require Tie::Hash; require XSLoader; our @ISA = qw(Tie::Hash); -our $VERSION = "1.16"; +our $VERSION = "1.17"; XSLoader::load(); diff --git a/ext/ODBM_File/ODBM_File.xs b/ext/ODBM_File/ODBM_File.xs index 9b708119aeee..38e6dbf446a7 100644 --- a/ext/ODBM_File/ODBM_File.xs +++ b/ext/ODBM_File/ODBM_File.xs @@ -181,6 +181,14 @@ int odbm_DELETE(db, key) ODBM_File db datum_key key + CODE: + /* don't warn about 'delete' being a C++ keyword */ + GCC_DIAG_IGNORE_STMT(-Wc++-compat); + RETVAL = odbm_DELETE(db, key); + GCC_DIAG_RESTORE_STMT; + OUTPUT: + RETVAL + datum_key odbm_FIRSTKEY(db) From e768bd98d8ad542e1bb37a1e715ad85b4b127afc Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 15:26:06 +0000 Subject: [PATCH 141/503] append colon to USE_STRICT_BY_DEFAULT description This stops autodoc.pl complaining that: USE_STRICT_BY_DEFAULT has no documentation --- config_h.SH | 2 +- uconfig.h | 4 ++-- win32/config_H.gc | 2 +- win32/config_H.vc | 2 +- 4 files changed, 5 insertions(+), 5 deletions(-) diff --git a/config_h.SH b/config_h.SH index fb3fba2cf5a3..19e182444430 100755 --- a/config_h.SH +++ b/config_h.SH @@ -3603,7 +3603,7 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un */ #$default_inc_excludes_dot DEFAULT_INC_EXCLUDES_DOT /**/ -/* USE_STRICT_BY_DEFAULT +/* USE_STRICT_BY_DEFAULT: * This symbol, if defined, enables additional defaults. * At this time it only enables implicit strict by default. */ diff --git a/uconfig.h b/uconfig.h index 21a06cafc35b..91f40df1411b 100644 --- a/uconfig.h +++ b/uconfig.h @@ -3568,7 +3568,7 @@ */ /*#define DEFAULT_INC_EXCLUDES_DOT / **/ -/* USE_STRICT_BY_DEFAULT +/* USE_STRICT_BY_DEFAULT: * This symbol, if defined, enables additional defaults. * At this time it only enables implicit strict by default. */ @@ -5269,6 +5269,6 @@ #endif /* Generated from: - * c61677bd68360e1b03a0e5fd070cc1a739c01e71988872c4e414e3c69328bc9b config_h.SH + * 404722487cbb4753192fd5c9d2e186551220f35fef1347ce39d942abaa90cbf4 config_h.SH * 4c3159a6a9875b7811c2a920d7936d5199193afdb163473c313b9531ba2c0648 uconfig.sh * ex: set ro: */ diff --git a/win32/config_H.gc b/win32/config_H.gc index c4d393262bb4..46a13c3f1cc7 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -3568,7 +3568,7 @@ */ #define DEFAULT_INC_EXCLUDES_DOT /**/ -/* USE_STRICT_BY_DEFAULT +/* USE_STRICT_BY_DEFAULT: * This symbol, if defined, enables additional defaults. * At this time it only enables implicit strict by default. */ diff --git a/win32/config_H.vc b/win32/config_H.vc index 2fe47d0a345b..d067e1d1422d 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -3568,7 +3568,7 @@ */ #define DEFAULT_INC_EXCLUDES_DOT /**/ -/* USE_STRICT_BY_DEFAULT +/* USE_STRICT_BY_DEFAULT: * This symbol, if defined, enables additional defaults. * At this time it only enables implicit strict by default. */ From 9084c33e0f9582b71e6748dd410ae1f290c74d99 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 16:02:06 +0000 Subject: [PATCH 142/503] Unicode-Normalize/Makefile.PL: avoid stderr During build, output general progress information to stdout, not stderr. --- dist/Unicode-Normalize/Makefile.PL | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist/Unicode-Normalize/Makefile.PL b/dist/Unicode-Normalize/Makefile.PL index 5c40ff1700f6..a848b0d22c68 100644 --- a/dist/Unicode-Normalize/Makefile.PL +++ b/dist/Unicode-Normalize/Makefile.PL @@ -8,7 +8,7 @@ my $clean = {}; my $mm_ver = ExtUtils::MakeMaker->VERSION; if (-f "Normalize.xs") { - print STDERR "Making header files for XS...\n"; + print "Making header files for XS...\n"; do './mkheader' or die $@ || "mkheader: $!"; From 840d003169037689159a793bb189c5991ff4bd7e Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 16:33:07 +0000 Subject: [PATCH 143/503] POSIX: t/posix.t: avoid warning Since warnings were enabled in this test file, skip one spurious warning being generated. S_ISBLK() is being called purely to test run-time loading; so it's being called without an arg, which now triggers an 'uninitialized value' warning. --- ext/POSIX/t/posix.t | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/ext/POSIX/t/posix.t b/ext/POSIX/t/posix.t index 502493737191..60ef36d15eee 100644 --- a/ext/POSIX/t/posix.t +++ b/ext/POSIX/t/posix.t @@ -351,7 +351,12 @@ is ($result, undef, "fgets should fail"); like ($@, qr/^Unimplemented: POSIX::fgets\(\): Use method IO::Handle::gets\(\) instead/, "check its redef message"); -eval { use strict; POSIX->import("S_ISBLK"); my $x = S_ISBLK }; +eval { + use strict; + no warnings 'uninitialized'; # S_ISBLK normally has an arg + POSIX->import("S_ISBLK"); + my $x = S_ISBLK +}; unlike( $@, qr/Can't use string .* as a symbol ref/, "Can import autoloaded constants" ); SKIP: { From 357b2648940492f5bef52001b39a05bc8618f4fd Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 1 Dec 2020 16:45:58 +0000 Subject: [PATCH 144/503] Storable: t/canonical.t: avoid stderr noise informational text should to stdout, not stderr --- dist/Storable/t/canonical.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist/Storable/t/canonical.t b/dist/Storable/t/canonical.t index f7791ce879fd..3b930aab1bf1 100644 --- a/dist/Storable/t/canonical.t +++ b/dist/Storable/t/canonical.t @@ -34,7 +34,7 @@ $maxarraysize = 100; eval { require Digest::MD5; }; $gotmd5 = !$@; -diag "Will use Digest::MD5" if $gotmd5; +note "Will use Digest::MD5" if $gotmd5; # Use Data::Dumper if debugging and it is available to create an ASCII dump From 4fcac7d3c75265e264116bb44379a62c0b5dcc22 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 2 Dec 2020 11:43:16 +1100 Subject: [PATCH 145/503] fix the results of my stupidity I added these definitions late in the process, thinking I hadn't already added them, but I had. --- win32/win32iop.h | 2 -- 1 file changed, 2 deletions(-) diff --git a/win32/win32iop.h b/win32/win32iop.h index 80a34f81a986..fd6b1c151b23 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -288,8 +288,6 @@ END_EXTERN_C #define putchar win32_putchar #define access(p,m) win32_access(p,m) #define chmod(p,m) win32_chmod(p,m) -#define symlink(targ,realp) win32_symlink(targ,realp) -#define readlink(p,buf,bufsiz) win32_readlink(p,buf,bufsiz) #if !defined(MYMALLOC) || !defined(PERL_CORE) #undef malloc From 0a0027ab22794b3826f35e6a97e9c42da4a9e72a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 1 Nov 2020 19:35:29 -0700 Subject: [PATCH 146/503] perlxs: Note that rpc.h is can be in different places This replaces PR #18247 --- dist/ExtUtils-ParseXS/lib/perlxs.pod | 3 +++ 1 file changed, 3 insertions(+) diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index 6a48d7e23ad6..2dfbf7df40fb 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2103,6 +2103,7 @@ File C: Interface to some ONC+ RPC bind library functions. #include "perl.h" #include "XSUB.h" + /* On some systems this should be */ #include typedef struct netconfig Netconfig; @@ -2163,6 +2164,8 @@ File C: Perl test program for the RPC extension. print "time = $a\n"; print "netconf = $netconf\n"; +In Makefile.PL add -ltirpc and -I/usr/include/tirpc. + =head1 CAVEATS XS code has full access to system calls including C library functions. From 800aab6349e0a8fc07de4c691a51468570c2cd4b Mon Sep 17 00:00:00 2001 From: Sevan Janiyan Date: Wed, 2 Dec 2020 19:50:37 +0000 Subject: [PATCH 147/503] Detect GCC as compiler to use On Illumos based distributions GCC is likely the compiler available on the system. Change tested on SmartOS --- hints/solaris_2.sh | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/hints/solaris_2.sh b/hints/solaris_2.sh index c6134060f7e0..e50d9d832378 100644 --- a/hints/solaris_2.sh +++ b/hints/solaris_2.sh @@ -90,7 +90,8 @@ END ` case "$cc" in -'') for i in `ls -r /opt/*studio*/bin/cc` /opt/SUNWspro/bin/cc +'') for i in `ls -r /opt/*studio*/bin/cc` /opt/SUNWspro/bin/cc \ + `which gcc` do if test -f "$i"; then cc=$i From affe02a96fc1fc4aa88073a4a9aedf6a1488e829 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Wed, 2 Dec 2020 21:40:42 +0100 Subject: [PATCH 148/503] Add Sevan Janiyan as author --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index dbdad0cadaa7..7fca3999256e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1157,6 +1157,7 @@ Sebastien Barre Sergey Alekseev Sergey Aleynikov Sergiy Borodych +Sevan Janiyan @sevan Shawn Shawn M Moore Sherm Pendley From 6eef26b1c82a35912e0b0e884a71a645d4e7cf20 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Wed, 2 Dec 2020 21:46:25 +0100 Subject: [PATCH 149/503] fixup! Add Sevan Janiyan as author --- AUTHORS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/AUTHORS b/AUTHORS index 7fca3999256e..991d7e903cdf 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1157,7 +1157,7 @@ Sebastien Barre Sergey Alekseev Sergey Aleynikov Sergiy Borodych -Sevan Janiyan @sevan +Sevan Janiyan Shawn Shawn M Moore Sherm Pendley From f0ba45bd255e8eb18fb9ac59aa032cc44a0b8633 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 12 Apr 2020 10:14:25 -0600 Subject: [PATCH 150/503] TAP::Harness: Move timer initialization This commit adds to blead the accepted PR https://github.com/Perl-Toolchain-Gang/Test-Harness/pull/98 but the updated module has not been released. This commit allows a many-core processor to run the Perl test suite more efficiently. Prior to this commit, the timers for counting elapsed time and CPU usage were begun when a job's first output appears. This yields inaccurate results. These results are saved in t/test_state for future runs so that they can start the longest-running tests first, which leads to using the available cores more efficiently. (If you start a long running test after everything else is nearly done, you have to wait for it to finish before the suite as a whole is; if you start the long ones first, and the shortest last, you don't have to wait very long for any stragglers to complete.) Inaccurate results here lead to this situation, which we were often seeing in the podcheck.t test. The worst case is if there is heavy computation at the beginning of the test being run. podcheck, for example, examines all the pods in the directory structure to find which links to other pods do or do not have corresponding anchors. Output doesn't happen until the analysis is complete. On my system, this takes over 30 seconds, but prior to this commit, what was noted was just the time required to do the output, about 200 milliseconds. The result was that podcheck was viewed as being one of the shortest tests run, so was started late in the process, and generally held up the completion of it. This commit by itself doesn't improve the test completion very much, because, test tests are run a whole directory at a time, and the directory podcheck is in, for example, is run last. The next commit addresses that. --- cpan/Test-Harness/lib/App/Prove.pm | 4 ++-- cpan/Test-Harness/lib/App/Prove/State.pm | 4 ++-- cpan/Test-Harness/lib/App/Prove/State/Result.pm | 4 ++-- cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Base.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/Base.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/Color.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/Console.pm | 4 ++-- .../lib/TAP/Formatter/Console/ParallelSession.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/File.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Formatter/Session.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Harness.pm | 8 ++++++-- cpan/Test-Harness/lib/TAP/Harness/Env.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Object.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser.pm | 8 ++++---- cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Grammar.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Iterator.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/Source.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm | 4 ++-- .../lib/TAP/Parser/SourceHandler/Executable.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm | 4 ++-- cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm | 4 ++-- cpan/Test-Harness/lib/Test/Harness.pm | 4 ++-- 48 files changed, 102 insertions(+), 98 deletions(-) diff --git a/cpan/Test-Harness/lib/App/Prove.pm b/cpan/Test-Harness/lib/App/Prove.pm index 9298726d24ff..a33fe971ffa2 100644 --- a/cpan/Test-Harness/lib/App/Prove.pm +++ b/cpan/Test-Harness/lib/App/Prove.pm @@ -18,11 +18,11 @@ App::Prove - Implements the C command. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/App/Prove/State.pm b/cpan/Test-Harness/lib/App/Prove/State.pm index 0b61a8245907..006d4f871237 100644 --- a/cpan/Test-Harness/lib/App/Prove/State.pm +++ b/cpan/Test-Harness/lib/App/Prove/State.pm @@ -25,11 +25,11 @@ App::Prove::State - State storage for the C command. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/App/Prove/State/Result.pm b/cpan/Test-Harness/lib/App/Prove/State/Result.pm index 8f89c775aff3..fb5e2d52d21c 100644 --- a/cpan/Test-Harness/lib/App/Prove/State/Result.pm +++ b/cpan/Test-Harness/lib/App/Prove/State/Result.pm @@ -14,11 +14,11 @@ App::Prove::State::Result - Individual test suite results. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm b/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm index b795280f307a..f4cddace3859 100644 --- a/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm +++ b/cpan/Test-Harness/lib/App/Prove/State/Result/Test.pm @@ -9,11 +9,11 @@ App::Prove::State::Result::Test - Individual test results. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Base.pm b/cpan/Test-Harness/lib/TAP/Base.pm index 78e07ab0547d..289f093bc6f5 100644 --- a/cpan/Test-Harness/lib/TAP/Base.pm +++ b/cpan/Test-Harness/lib/TAP/Base.pm @@ -12,11 +12,11 @@ and L =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; use constant GOT_TIME_HIRES => do { eval 'use Time::HiRes qw(time);'; diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Base.pm b/cpan/Test-Harness/lib/TAP/Formatter/Base.pm index bf65e12ca157..a9c0e3b04b08 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Base.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Base.pm @@ -58,11 +58,11 @@ TAP::Formatter::Base - Base class for harness output delegates =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Color.pm b/cpan/Test-Harness/lib/TAP/Formatter/Color.pm index 79807901012c..0f08edfe7878 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Color.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Color.pm @@ -39,11 +39,11 @@ TAP::Formatter::Color - Run Perl test scripts with color =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console.pm index 1c82ef43c6cd..3217099a7124 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console.pm @@ -11,11 +11,11 @@ TAP::Formatter::Console - Harness output delegate for default console output =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm index 6826b4e379f0..7f6767c70004 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console/ParallelSession.pm @@ -41,11 +41,11 @@ TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm index 492bdd7b081c..8c2f95734dc3 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Console/Session.pm @@ -26,11 +26,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/File.pm b/cpan/Test-Harness/lib/TAP/Formatter/File.pm index ced7b3f85eab..5a3a55813e10 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/File.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/File.pm @@ -13,11 +13,11 @@ TAP::Formatter::File - Harness output delegate for file output =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm index 3403540e40b7..fb7b1829bae9 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/File/Session.pm @@ -10,11 +10,11 @@ TAP::Formatter::File::Session - Harness output delegate for file output =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Formatter/Session.pm b/cpan/Test-Harness/lib/TAP/Formatter/Session.pm index 2022220aaaff..a26048d9d95c 100644 --- a/cpan/Test-Harness/lib/TAP/Formatter/Session.pm +++ b/cpan/Test-Harness/lib/TAP/Formatter/Session.pm @@ -23,11 +23,11 @@ TAP::Formatter::Session - Abstract base class for harness output delegate =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 METHODS diff --git a/cpan/Test-Harness/lib/TAP/Harness.pm b/cpan/Test-Harness/lib/TAP/Harness.pm index a2f6daf1dbde..1b8ee87a659e 100644 --- a/cpan/Test-Harness/lib/TAP/Harness.pm +++ b/cpan/Test-Harness/lib/TAP/Harness.pm @@ -16,11 +16,11 @@ TAP::Harness - Run test scripts with statistics =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; $ENV{HARNESS_ACTIVE} = 1; $ENV{HARNESS_VERSION} = $VERSION; @@ -619,6 +619,10 @@ sub _aggregate_parallel { my ( $parser, $session ) = $self->make_parser($job); $mux->add( $parser, [ $session, $job ] ); + + # The job has started: begin the timers + $parser->start_time( $parser->get_time ); + $parser->start_times( $parser->get_times ); } if ( my ( $parser, $stash, $result ) = $mux->next ) { diff --git a/cpan/Test-Harness/lib/TAP/Harness/Env.pm b/cpan/Test-Harness/lib/TAP/Harness/Env.pm index 077626df2deb..78e75fb92dab 100644 --- a/cpan/Test-Harness/lib/TAP/Harness/Env.pm +++ b/cpan/Test-Harness/lib/TAP/Harness/Env.pm @@ -7,7 +7,7 @@ use constant IS_VMS => ( $^O eq 'VMS' ); use TAP::Object; use Text::ParseWords qw/shellwords/; -our $VERSION = '3.42'; +our $VERSION = '3.43'; # Get the parts of @INC which are changed from the stock list AND # preserve reordering of stock directories. @@ -126,7 +126,7 @@ TAP::Harness::Env - Parsing harness related environmental variables where approp =head1 VERSION -Version 3.42 +Version 3.43 =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Object.pm b/cpan/Test-Harness/lib/TAP/Object.pm index e9da17f4ff1d..d3063c2b27a4 100644 --- a/cpan/Test-Harness/lib/TAP/Object.pm +++ b/cpan/Test-Harness/lib/TAP/Object.pm @@ -9,11 +9,11 @@ TAP::Object - Base class that provides common functionality to all C mod =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser.pm b/cpan/Test-Harness/lib/TAP/Parser.pm index 34f411048e38..e8d51b12c8a9 100644 --- a/cpan/Test-Harness/lib/TAP/Parser.pm +++ b/cpan/Test-Harness/lib/TAP/Parser.pm @@ -27,11 +27,11 @@ TAP::Parser - Parse L output =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; my $DEFAULT_TAP_VERSION = 12; my $MAX_TAP_VERSION = 13; @@ -1384,8 +1384,8 @@ sub _iter { my $state = 'INIT'; my $state_table = $self->_make_state_table; - $self->start_time( $self->get_time ); - $self->start_times( $self->get_times ); + $self->start_time( $self->get_time ) unless $self->{start_time}; + $self->start_times( $self->get_times ) unless $self->{start_times}; # Make next_state closure my $next_state = sub { diff --git a/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm b/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm index 65be445f308a..1f4ff5d96125 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Aggregator.pm @@ -12,11 +12,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm b/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm index ff0f2aa2ad76..0cf4d5b4c7d5 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Grammar.pm @@ -14,11 +14,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm index fab48cb2bed2..b516929b053f 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator - Base class for TAP source iterators =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm index 5a098cca7c06..3ea348d60865 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Array.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Array - Iterator for array-based TAP sources =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm index a121485aec44..8e95a44a23cb 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Process.pm @@ -16,11 +16,11 @@ TAP::Parser::Iterator::Process - Iterator for process-based TAP sources =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm index 2a21485357fa..305453124fd7 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Iterator/Stream.pm @@ -11,11 +11,11 @@ TAP::Parser::Iterator::Stream - Iterator for filehandle-based TAP sources =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm b/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm index cd677028bd86..3529c2f86c60 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/IteratorFactory.pm @@ -16,11 +16,11 @@ TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use fo =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm b/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm index 16af2d308541..164e9af47712 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Multiplexer.pm @@ -17,11 +17,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result.pm b/cpan/Test-Harness/lib/TAP/Parser/Result.pm index c8927968dbe5..698402ab83e1 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result.pm @@ -24,11 +24,11 @@ TAP::Parser::Result - Base class for TAP::Parser output objects =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm index facae6fe8e4f..38ee45853ca7 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Bailout.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Bailout - Bailout result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm index 0f99b57b08e1..a07308ea8111 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Comment.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Comment - Comment result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm index 9db060e90df7..1029694d57c9 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Plan.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Plan - Plan result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm index c7a26beeedd6..897e0da65848 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Pragma.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Pragma - TAP pragma token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm index b3bd224c16f2..e2c9781e16fb 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Test.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Test - Test result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm index d735ed165acd..cc04c8a385db 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Unknown.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Unknown - Unknown result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm index 5f4cb932bd30..8a2bd7ec442c 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/Version.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::Version - TAP syntax version token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm b/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm index a88b8da1f7ea..17de945ef062 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Result/YAML.pm @@ -11,11 +11,11 @@ TAP::Parser::Result::YAML - YAML result token. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm b/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm index 27776ea05c76..54d29a265daf 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/ResultFactory.pm @@ -29,11 +29,11 @@ TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head2 DESCRIPTION diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm index e13d68e087ba..7e3ddc2c086b 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler.pm @@ -13,11 +13,11 @@ TAP::Parser::Scheduler - Schedule tests during parallel testing =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm index b765ab27b0e1..bfcb0f76b3b9 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Job.pm @@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Job - A single testing job. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm index 47bc28fc9135..29f5c0daf16c 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Scheduler/Spinner.pm @@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Spinner - A no-op job. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/Source.pm b/cpan/Test-Harness/lib/TAP/Parser/Source.pm index 5bd85e37f71f..74c22cce8b41 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/Source.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/Source.pm @@ -14,11 +14,11 @@ TAP::Parser::Source - a TAP source & meta data about it =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm index 0156b99fd68b..f80c1ca25c16 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler.pm @@ -12,11 +12,11 @@ TAP::Parser::SourceHandler - Base class for different TAP source handlers =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm index 376e8d148d89..0ad412bc4924 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Executable.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP so =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm index 7e1843759e8f..48f98210519d 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/File.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::File - Stream TAP from a text file. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm index a0a051340f70..751e68aa307b 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Handle.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB. =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm index c2ea252ec2ab..26b408a4583d 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/Perl.pm @@ -21,11 +21,11 @@ TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm index 2ef77118bc86..9bf3b272a8ea 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/SourceHandler/RawTAP.pm @@ -16,11 +16,11 @@ TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/arra =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm index 1a8185eb6b5b..eafc37aa0c79 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Reader.pm @@ -5,7 +5,7 @@ use warnings; use base 'TAP::Object'; -our $VERSION = '3.42'; +our $VERSION = '3.43'; # TODO: # Handle blessed object syntax @@ -269,7 +269,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator =head1 VERSION -Version 3.42 +Version 3.43 =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm index 904244ae110e..9d6366c32531 100644 --- a/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm +++ b/cpan/Test-Harness/lib/TAP/Parser/YAMLish/Writer.pm @@ -5,7 +5,7 @@ use warnings; use base 'TAP::Object'; -our $VERSION = '3.42'; +our $VERSION = '3.43'; my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x; my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x; @@ -146,7 +146,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data =head1 VERSION -Version 3.42 +Version 3.43 =head1 SYNOPSIS diff --git a/cpan/Test-Harness/lib/Test/Harness.pm b/cpan/Test-Harness/lib/Test/Harness.pm index 6cce46e3b622..7084d624e1d0 100644 --- a/cpan/Test-Harness/lib/Test/Harness.pm +++ b/cpan/Test-Harness/lib/Test/Harness.pm @@ -31,11 +31,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 3.42 +Version 3.43 =cut -our $VERSION = '3.42'; +our $VERSION = '3.43'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; From 9cbb5ac7dcf644c817e4072abb4f08e1eb92ae0c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 12 Apr 2020 15:13:25 -0600 Subject: [PATCH 151/503] t/harness: Add option for faster test suite execution This commit adds an environment variable, PERL_TEST_HARNESS_ASAP, which if set to non-zero increases the parallelism in the execution of the test suite, speeding it up on systems with multiple cores. Normally, there are two main test sections, one for core and the second for non-core tests, and the testing of the non-core one doesn't begin until the core tests are complete. Within each section, there are a number of test categories, like 're' for regular expressions, and 'JSON::PP' for the pure perl implementation of JSON. Within each category, there are various single .t test files. Some categories can have those be tested in parallel; some require them to be done in a particular order, say because an earlier .t does setup for subsequent ones. We already have this capability. Completion of all the tests in a category is not needed before those of another category can be started. This is how it already works. However, the core section categories are ordered so that they begin in a logical order for someone trying to get perl to work. First to start are the basic sanity tests, then by roughly decreasing order of widespread use in perl programs in the wild, with the final two categories, porting and perf, being mainly of use to perl5 porters. These two categories aren't started until all the tests in the earlier categories are started. We have some long running tests in those two categories, and generally they delay the start of the entire second section. If those long running tests could be started sooner, shorter tests in the first section could be run in parallel with them, increasing the average CPU utilization, and the second section could begin (and hence end) earlier, shortening the total elapsed execution time of the entire suite. The second section has some very long running tests. JSON-PP is one of them. If it could run in parallel with tests from the first section, that would also speed up the completion of the suite. The environment variable added by this commit does both things. The basic sanity test categories in the first section continue to be started before anything else. But then all other tests are run in decreasing order of elapsed time they take to run, removing the boundaries between some categories, and between the two sections. The gain from this increases as the number of jobs run in parallel does; slower high core platforms have the highest increase. On the old dromedary with 24 cores, the gain is 20%, almost 2 minutes. On my more modern box with 12 cores, it is 8%. --- t/harness | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) diff --git a/t/harness b/t/harness index 58a212fad1d7..c3cf9061e462 100644 --- a/t/harness +++ b/t/harness @@ -117,11 +117,20 @@ if (@ARGV) { unless (@tests) { my @seq = ; - my @next = qw(comp run cmd io re opbasic op uni mro lib porting perf); - push @next, 'japh' if $torture; - push @next, 'win32' if $^O eq 'MSWin32'; - push @next, 'benchmark' if $ENV{PERL_BENCHMARK}; - push @next, 'bigmem' if $ENV{PERL_TEST_MEMORY}; + my @last; + my @next = qw(comp run cmd); + + # The remaining core tests are either intermixed with the non-core for + # more parallelism (if PERL_TEST_HARNESS_ASAP is set non-zero) or done + # after the above basic sanity tests, before any non-core ones. + my $which = $ENV{PERL_TEST_HARNESS_ASAP} ? \@last : \@next; + + push @$which, qw(io re opbasic op uni mro lib porting perf); + push @$which, 'japh' if $torture; + push @$which, 'win32' if $^O eq 'MSWin32'; + push @$which, 'benchmark' if $ENV{PERL_BENCHMARK}; + push @$which, 'bigmem' if $ENV{PERL_TEST_MEMORY}; + # Hopefully TAP::Parser::Scheduler will support this syntax soon. # my $next = { par => '{' . join (',', @next) . '}/*.t' }; my $next = { par => [ @@ -129,6 +138,9 @@ if (@ARGV) { ] }; @tests = _extract_tests ($next); + my $last = { par => '{' . join (',', @last) . '}/*.t' }; + @last = _extract_tests ($last); + # This is a bit of a game, because we only want to sort these tests in # speed order. base/*.t wants to run first, and ext,lib etc last and in # MANIFEST order @@ -147,7 +159,6 @@ if (@ARGV) { @tests = (@seq, @tests); push @seq, $next; - my @last; push @last, _tests_from_manifest($Config{extensions}, $Config{known_extensions}); my %times; @@ -171,7 +182,7 @@ if (@ARGV) { # Keep a list of the distinct directory names, and another list of # those which contain a file whose name begins with a 0 - if ( m! \A \.\. / + if ( m! \A (?: \.\. / )? ( .*? ) # $1 is the directory path name / ( [^/]* \.t ) # $2 is the .t name @@ -210,7 +221,7 @@ if (@ARGV) { for (@last) { # Treat every file in each non-serial directory as its own # "directory", so that it can be executed in parallel - m! \A ( \.\. / (?: $non_serials ) + m! \A ( (?: \.\. / )? (?: $non_serials ) / [^/]+ \.t \z | .* [/] ) !x or die "'$_'"; push @{$dir{$1}}, $_; From 0aee951734c79edb5ed4d81e8c932cc34e5eda55 Mon Sep 17 00:00:00 2001 From: Dan Kogai Date: Wed, 2 Dec 2020 17:13:45 -0500 Subject: [PATCH 152/503] cpan/Encode: sync with CPAN version 3.08 --- Porting/Maintainers.pl | 2 +- cpan/Encode/Encode.pm | 4 +-- cpan/Encode/Makefile.PL | 4 +-- cpan/Encode/bin/encguess | 4 +-- cpan/Encode/lib/Encode/GSM0338.pm | 11 ++++--- cpan/Encode/t/gsm0338.t | 54 ++++--------------------------- 6 files changed, 20 insertions(+), 59 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index dcf1e7387c7c..269e919af6fd 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -383,7 +383,7 @@ package Maintainers; }, 'Encode' => { - 'DISTRIBUTION' => 'DANKOGAI/Encode-3.07.tar.gz', + 'DISTRIBUTION' => 'DANKOGAI/Encode-3.08.tar.gz', 'FILES' => q[cpan/Encode], 'EXCLUDED' => [ qw( t/whatwg-aliases.json diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm index 77ca93e87bb6..d3eb3c1b1131 100644 --- a/cpan/Encode/Encode.pm +++ b/cpan/Encode/Encode.pm @@ -1,5 +1,5 @@ # -# $Id: Encode.pm,v 3.07 2020/07/25 12:59:10 dankogai Exp $ +# $Id: Encode.pm,v 3.08 2020/12/02 01:27:44 dankogai Exp $ # package Encode; use strict; @@ -7,7 +7,7 @@ use warnings; use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; our $VERSION; BEGIN { - $VERSION = sprintf "%d.%02d", q$Revision: 3.07 $ =~ /(\d+)/g; + $VERSION = sprintf "%d.%02d", q$Revision: 3.08 $ =~ /(\d+)/g; require XSLoader; XSLoader::load( __PACKAGE__, $VERSION ); } diff --git a/cpan/Encode/Makefile.PL b/cpan/Encode/Makefile.PL index 8c20d20226f0..f9c774845f4b 100644 --- a/cpan/Encode/Makefile.PL +++ b/cpan/Encode/Makefile.PL @@ -1,5 +1,5 @@ # -# $Id: Makefile.PL,v 2.22 2017/10/06 22:21:53 dankogai Exp $ +# $Id: Makefile.PL,v 2.23 2020/12/02 01:28:17 dankogai Exp dankogai $ # use 5.007003; use strict; @@ -70,7 +70,7 @@ WriteMakefile( Storable => '0', # bundled with Perl 5.7.3 }, TEST_REQUIRES => { - 'Test::More' => '0.81_01', + 'Test::More' => '0.92', }, PMLIBDIRS => \@pmlibdirs, INSTALLDIRS => ($] < 5.011 ? 'perl' : 'site'), diff --git a/cpan/Encode/bin/encguess b/cpan/Encode/bin/encguess index 0f344ea3fc03..19a0673e7607 100644 --- a/cpan/Encode/bin/encguess +++ b/cpan/Encode/bin/encguess @@ -61,7 +61,7 @@ encguess - guess character encodings of files =head1 VERSION -$Id: encguess,v 0.2 2016/08/04 03:15:58 dankogai Exp $ +$Id: encguess,v 0.3 2020/12/02 01:28:17 dankogai Exp dankogai $ =head1 SYNOPSIS @@ -78,7 +78,7 @@ show this message and exit. =item -s specify a list of "suspect encoding types" to test, -seperated by either C<:> or C<,> +separated by either C<:> or C<,> =item -S diff --git a/cpan/Encode/lib/Encode/GSM0338.pm b/cpan/Encode/lib/Encode/GSM0338.pm index 8b23a7bb6a90..644d4452851c 100644 --- a/cpan/Encode/lib/Encode/GSM0338.pm +++ b/cpan/Encode/lib/Encode/GSM0338.pm @@ -1,5 +1,5 @@ # -# $Id: GSM0338.pm,v 2.8 2020/07/25 12:59:29 dankogai Exp dankogai $ +# $Id: GSM0338.pm,v 2.9 2020/12/02 01:28:17 dankogai Exp dankogai $ # package Encode::GSM0338; @@ -8,16 +8,13 @@ use warnings; use Carp; use vars qw($VERSION); -$VERSION = do { my @r = ( q$Revision: 2.8 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; +$VERSION = do { my @r = ( q$Revision: 2.9 $ =~ /\d+/g ); sprintf "%d." . "%02d" x $#r, @r }; use Encode qw(:fallbacks); use parent qw(Encode::Encoding); __PACKAGE__->Define('gsm0338'); -sub needs_lines { 1 } -sub perlio_ok { 0 } - use utf8; # Mapping table according to 3GPP TS 23.038 version 16.0.0 Release 16 and ETSI TS 123 038 V16.0.0 (2020-07) @@ -182,6 +179,10 @@ sub decode ($$;$) { ? $chk->( unpack 'C*', $seq ) : "\x{FFFD}"; if ( not exists $GSM2UNI{$seq} and $chk and not ref $chk ) { + if ( substr($seq, 0, 1) eq $ESC and ($chk & Encode::STOP_AT_PARTIAL) ) { + $bytes .= $seq; + last; + } croak join( '', map { sprintf "\\x%02X", $_ } unpack 'C*', $seq ) . ' does not map to Unicode' if $chk & Encode::DIE_ON_ERR; carp join( '', map { sprintf "\\x%02X", $_ } unpack 'C*', $seq ) . ' does not map to Unicode' if $chk & Encode::WARN_ON_ERR; if ($chk & Encode::RETURN_ON_ERR) { diff --git a/cpan/Encode/t/gsm0338.t b/cpan/Encode/t/gsm0338.t index 21a82fad5e24..ab985838f3d0 100644 --- a/cpan/Encode/t/gsm0338.t +++ b/cpan/Encode/t/gsm0338.t @@ -13,7 +13,7 @@ BEGIN { use strict; use utf8; -use Test::More tests => 776; +use Test::More tests => 777; use Encode; use Encode::GSM0338; @@ -83,49 +83,9 @@ is encode("gsm0338", chr(0xC7)) => "\x09", 'RT75670: encode'; is decode("gsm0338", encode('gsm0338', '..@@..')), '..@@..'; is decode("gsm0338", encode('gsm0338', '..@€..')), '..@€..'; -__END__ -for my $c (map { chr } 0..127){ - my $b = "\x1b$c"; - my $u = $Encode::GSM0338::GSM2UNI{$b}; - next unless $u; - $u ||= "\xA0" . $Encode::GSM0338::GSM2UNI{$c}; - is decode("gsm0338", $b), $u, sprintf("decode ESC+\\x%02X", ord($c) ); -} - -__END__ -# old test follows -ub t { is(decode("gsm0338", my $t = $_[0]), $_[1]) } - -# t("\x00", "\x00"); # ??? - -# "Round-trip". -t("\x41", "\x41"); - -t("\x01", "\xA3"); -t("\x02", "\x24"); -t("\x03", "\xA5"); -t("\x09", "\xE7"); - -t("\x00\x00", "\x00\x00"); # Maybe? -t("\x00\x1B", "\x40\xA0"); # Maybe? -t("\x00\x41", "\x40\x41"); - -# t("\x1B", "\x1B"); # ??? - -# Escape with no special second byte is just a NBSP. -t("\x1B\x41", "\xA0\x41"); - -t("\x1B\x00", "\xA0\x40"); # Maybe? - -# Special escape characters. -t("\x1B\x0A", "\x0C"); -t("\x1B\x14", "\x5E"); -t("\x1B\x28", "\x7B"); -t("\x1B\x29", "\x7D"); -t("\x1B\x2F", "\x5C"); -t("\x1B\x3C", "\x5B"); -t("\x1B\x3D", "\x7E"); -t("\x1B\x3E", "\x5D"); -t("\x1B\x40", "\x7C"); -t("\x1B\x40", "\x7C"); -t("\x1B\x65", "\x{20AC}"); +# special GSM sequence, € is at 1024 byte buffer boundary +my $gsm = "\x41" . "\x1B\x65" x 1024; +open my $fh, '<:encoding(gsm0338)', \$gsm or die; +my $uni = <$fh>; +close $fh; +is $uni, "A" . "€" x 1024, 'PerlIO encoding(gsm0338) read works'; From 6483d46092dcc01b5b6d171b889f39b7546a4f79 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 3 Dec 2020 11:00:43 +1100 Subject: [PATCH 153/503] add more win32 stat tests These tickets were suggested as fixed by the stat updates, some were fixed, but some weren't. Add tests (TODO for the unfixed) to help track them --- t/win32/stat.t | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) diff --git a/t/win32/stat.t b/t/win32/stat.t index b2dccb8bf2bc..3ce66ed6ba7f 100644 --- a/t/win32/stat.t +++ b/t/win32/stat.t @@ -175,4 +175,64 @@ if (ok(mkdir($tmpfile1), "make a work directory")) { rmdir $tmpfile1; } +# Other stat issues possibly fixed by the stat() re-work + +# https://github.com/Perl/perl5/issues/9025 - win32 - file test operators don't work for //?/UNC/server/file filenames +# can't really make a reliable regression test for this +# reproduced original problem with a gcc build +# confirmed fixed with a gcc build + +# https://github.com/Perl/perl5/issues/8502 - filetest problem with STDIN/OUT on Windows + +{ + ok(-r *STDIN, "check stdin is readable"); + ok(-w *STDOUT, "check stdout is writable"); + + # CompareObjectHandles() could fix this, but requires Windows 10 + local our $TODO = "dupped *STDIN and *STDOUT not read/write"; + open my $dupin, "<&STDIN" or die; + open my $dupout, ">&STDOUT" or die; + ok(-r $dupin, "check duplicated stdin is readable"); + ok(-w $dupout, "check duplicated stdout is writable"); +} + +# https://github.com/Perl/perl5/issues/6080 - Last mod time from stat() can be wrong on Windows NT/2000/XP +# tested already + +# https://github.com/Perl/perl5/issues/4145 - Problem with filetest -x _ on Win2k AS Perl build 626 +# tested already + +# https://github.com/Perl/perl5/issues/14687 - Function lstat behavior case differs between Windows and Unix #14687 + +{ + local our $TODO = "... .... treated as .. by Win32 API"; + ok(!-e ".....", "non-existing many dots shouldn't returned existence"); +} + +# https://github.com/Perl/perl5/issues/7410 - -e tests not reliable under Win32 +{ + # there's to issues here: + # 1) CreateFile() successfully opens " . . " when opened with backup + # semantics/directory + # 2) opendir(" . . ") becomes FindFirstFile(" . . /*") which fails + # + # So we end up with success for the first and failure for the second, + # making them inconsistent, there may be a Vista level fix for this, + # but if we expect -e " . . " to fail we need a more complex fix. + local our $TODO = "strange space handling by Windows"; + ok(!-e " ", "filename ' ' shouldn't exist"); + ok(!-e " . . ", "filename ' . . ' shouldn't exist"); + ok(!-e " .. ", "filename ' .. ' shouldn't exist"); + ok(!-e " . ", "filename ' . ' shouldn't exist"); + + ok(!!-e " . . " == !!opendir(FOO, " . . "), + "these should be consistent"); +} + +# https://github.com/Perl/perl5/issues/12431 - Win32: -e '"' always returns true + +{ + ok(!-e '"', qq(filename '"' shouldn't exist)); +} + done_testing(); From 8b40c6980a4ae3fa364f4921879001f097000652 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 2 Dec 2020 18:56:27 -0700 Subject: [PATCH 154/503] Revert "op.h: Restrict to core certain internal symbols" This reverts commit 1d6cadf136bf2c85058a5359fb48b09b3ea9fe6f. Due to cpan breakage: GH #18374 #18375 #18376 --- op.h | 51 ++++++++++++++++++++++++--------------------------- 1 file changed, 24 insertions(+), 27 deletions(-) diff --git a/op.h b/op.h index b7d762a52931..975071756240 100644 --- a/op.h +++ b/op.h @@ -458,31 +458,30 @@ struct loop { #define cCOP cCOPx(PL_op) #define cLOOP cLOOPx(PL_op) -#if defined(PERL_CORE) || defined(PERL_EXT) -# define cUNOPo cUNOPx(o) -# define cUNOP_AUXo cUNOP_AUXx(o) -# define cBINOPo cBINOPx(o) -# define cLISTOPo cLISTOPx(o) -# define cLOGOPo cLOGOPx(o) -# define cPMOPo cPMOPx(o) -# define cSVOPo cSVOPx(o) -# define cPADOPo cPADOPx(o) -# define cPVOPo cPVOPx(o) -# define cCOPo cCOPx(o) -# define cLOOPo cLOOPx(o) - -# define kUNOP cUNOPx(kid) -# define kUNOP_AUX cUNOP_AUXx(kid) -# define kBINOP cBINOPx(kid) -# define kLISTOP cLISTOPx(kid) -# define kLOGOP cLOGOPx(kid) -# define kPMOP cPMOPx(kid) -# define kSVOP cSVOPx(kid) -# define kPADOP cPADOPx(kid) -# define kPVOP cPVOPx(kid) -# define kCOP cCOPx(kid) -# define kLOOP cLOOPx(kid) -#endif +#define cUNOPo cUNOPx(o) +#define cUNOP_AUXo cUNOP_AUXx(o) +#define cBINOPo cBINOPx(o) +#define cLISTOPo cLISTOPx(o) +#define cLOGOPo cLOGOPx(o) +#define cPMOPo cPMOPx(o) +#define cSVOPo cSVOPx(o) +#define cPADOPo cPADOPx(o) +#define cPVOPo cPVOPx(o) +#define cCOPo cCOPx(o) +#define cLOOPo cLOOPx(o) + +#define kUNOP cUNOPx(kid) +#define kUNOP_AUX cUNOP_AUXx(kid) +#define kBINOP cBINOPx(kid) +#define kLISTOP cLISTOPx(kid) +#define kLOGOP cLOGOPx(kid) +#define kPMOP cPMOPx(kid) +#define kSVOP cSVOPx(kid) +#define kPADOP cPADOPx(kid) +#define kPVOP cPVOPx(kid) +#define kCOP cCOPx(kid) +#define kLOOP cLOOPx(kid) + typedef enum { OPclass_NULL, /* 0 */ @@ -527,14 +526,12 @@ typedef enum { #define cMETHOPx_meth(v) cSVOPx_sv(v) -#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD) #define cGVOP_gv cGVOPx_gv(PL_op) #define cGVOPo_gv cGVOPx_gv(o) #define kGVOP_gv cGVOPx_gv(kid) #define cSVOP_sv cSVOPx_sv(PL_op) #define cSVOPo_sv cSVOPx_sv(o) #define kSVOP_sv cSVOPx_sv(kid) -#endif #ifndef PERL_CORE # define Nullop ((OP*)NULL) From 326fbc152f1a1e306a9c8b64763efca42f89d0bf Mon Sep 17 00:00:00 2001 From: David Cantrell Date: Mon, 30 Nov 2020 22:50:00 +0000 Subject: [PATCH 155/503] add note on how to write NEXTKEY when you can't just wrap around each() --- pod/perltie.pod | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/pod/perltie.pod b/pod/perltie.pod index 6f870597c6d3..cea7a6fe6ef4 100644 --- a/pod/perltie.pod +++ b/pod/perltie.pod @@ -811,6 +811,11 @@ thing, but we'll have to go through the LIST field indirectly. return each $self->{LIST}->%* } +If the object underlying your tied hash isn't a real hash and you don't have +C available, then you should return C or the empty list once you've +reached the end of your list of keys. See L|perlfunc/each> +for more details. + =item SCALAR this X From 730797bb276bad7f798e9f08d1c63f805e2237d7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 2 Dec 2020 20:54:07 -0700 Subject: [PATCH 156/503] Document PERL_TEST_HARNESS_ASAP which can increase the CPU occupancy when running the test suite in parallel on a many-core system, resulting in earlier completion. --- pod/perldelta.pod | 8 +++++++- pod/perlhack.pod | 27 +++++++++++++++++++++------ 2 files changed, 28 insertions(+), 7 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index ad32e302db50..f40aad4eca04 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -285,7 +285,13 @@ made: =item * -XXX +When testing in parallel on many-core platforms, you can now cause the +test suite to finish somewhat earlier, but with less logical ordering of +the tests, by setting + + PERL_TEST_HARNESS_ASAP=1 + +while running the test suite. =back diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 1f668634852d..9d5b45a57136 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -910,9 +910,10 @@ Sets PERL_SKIP_TTY_TEST to true before running normal test. =head2 Parallel tests The core distribution can now run its regression tests in parallel on -Unix-like platforms. Instead of running C, set C -in your environment to the number of tests to run in parallel, and run -C. On a Bourne-like shell, this can be done as +Unix-like and Windows platforms. On Unix, instead of running C, set C in your environment to the number of tests to +run in parallel, and run C. On a Bourne-like shell, +this can be done as TEST_JOBS=3 make test_harness # Run 3 tests in parallel @@ -921,9 +922,23 @@ because L needs to be able to schedule individual non-conflicting test scripts itself, and there is no standard interface to C utilities to interact with their job schedulers. -Note that currently some test scripts may fail when run in parallel -(most notably F). If necessary, run just the -failing scripts again sequentially and see if the failures go away. +Tests are normally run in a logical order, with the sanity tests first, +then the main tests of the Perl core functionality, then the tests for +the non-core modules. On many-core systems, this may not use the +hardware as effectively as possible. By also specifying + + TEST_JOBS=19 PERL_TEST_HARNESS_ASAP=1 make -j19 test_harness + +you signal that you want the tests to finish in wall-clock time as short +as possible. After the sanity tests are completed, this causes the +remaining ones to be packed into the available cores as tightly as +we know how. This has its greatest effect on slower, many-core systems. +Throughput was sped up by 20% on an outmoded 24-core system; less on +more recent faster ones with fewer cores. + +Note that the command line above added a C<-j> parameter to make, so as +to cause parallel compilation. This may or may not work on your +platform. =head2 Running tests by hand From 7de4500e1bc038d5be4ef2683c4bfab617a58a9b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 3 Dec 2020 15:24:44 +1100 Subject: [PATCH 157/503] perldelta for the Win32 symlink()/readlink()/stat() changes --- pod/perldelta.pod | 39 ++++++++++++++++++++++++++++++++++++--- 1 file changed, 36 insertions(+), 3 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index f40aad4eca04..8c062081c6ab 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -338,9 +338,42 @@ L section. =over 4 -=item XXX-some-platform - -XXX +=item Windows + +Windows now supports L and +L, and L is no +longer an alias for L. +L<[#18005]|https://github.com/Perl/perl5/issues/18005>. + +Unlike POSIX systems, creating a symbolic link on Windows requires +either elevated privileges or Windows 10 1703 or later with Developer +Mode enabled. + +stat(), including C, and lstat() now uses our own +implementation that populates the device C and inode numbers +C returned rather than always returning zero. The number of +links C field is now always populated. + +L<< C<${^WIN32_SLOPPY_STAT}> |perlvar/${^WIN32_SLOPPY_STAT} >> previously +controlled whether the C field was populated requiring a +separate Windows API call to fetch, since nlink and the other +information required for stat() is now retrieved in a single API call. + +The C<-r> and C<-w> operators now return true for the C, +C and C handles. Unfortunately it still won't return +true for duplicates of those handles. +L<[#8502]|https://github.com/Perl/perl5/issues/8502>. + +The times returned by stat() and lstat() are no longer incorrect +across Daylight Savings Time adjustments. +L<[#6080]|https://github.com/Perl/perl5/issues/6080>. + +C<-x> on a filehandle should now match C<-x> on the corresponding +filename on Vista or later. +L<[#4145]|https://github.com/Perl/perl5/issues/4145>. + +C<-e '"'> no longer incorrectly returns true. +L<[#12431]|https://github.com/Perl/perl5/issues/12431>. =back From 153764ac87c44440fea60466e8f718671117bac2 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Thu, 3 Dec 2020 10:36:42 +0000 Subject: [PATCH 158/503] time64.c: avoid 'uninit' compiler warning clang isn't smart enough to recognise the pattern: if (foo) { ...} { else orig_year = ... } ... if (!foo) { ... use orig_year .. } So just unconditionally initialise orig_year. --- time64.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/time64.c b/time64.c index 7fc50af13d65..52d99cda7a5a 100644 --- a/time64.c +++ b/time64.c @@ -479,7 +479,7 @@ struct TM *Perl_localtime64_r (const Time64_T *time, struct TM *local_tm) struct tm safe_date; const struct tm * result; struct TM gm_tm; - Year orig_year; + Year orig_year = 0; /* initialise to avoid spurious compiler warning */ int month_diff; const bool use_system = SHOULD_USE_SYSTEM_LOCALTIME(*time); dTHX; From b96bd7bfd7bbd0ba78cbebd0f4437bef81209655 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 3 Dec 2020 17:56:21 -0700 Subject: [PATCH 159/503] Fix and update documentation of memEQ, memNE, ... This fixes GH #18379 --- handy.h | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/handy.h b/handy.h index 96f84fa5d1c3..360c383bc428 100644 --- a/handy.h +++ b/handy.h @@ -631,22 +631,24 @@ wrapper for C). =for apidoc Am|bool|memEQ|char* s1|char* s2|STRLEN len Test two buffers (which may contain embedded C characters, to see if they are equal. The C parameter indicates the number of bytes to compare. -Returns zero if equal, or non-zero if non-equal. +Returns true or false. It is undefined behavior if either of the buffers +doesn't contain at least C bytes. =for apidoc Am|bool|memEQs|char* s1|STRLEN l1|"s2" Like L, but the second string is a literal enclosed in double quotes, C gives the number of bytes in C. -Returns zero if equal, or non-zero if non-equal. +Returns true or false. =for apidoc Am|bool|memNE|char* s1|char* s2|STRLEN len Test two buffers (which may contain embedded C characters, to see if they are not equal. The C parameter indicates the number of bytes to compare. -Returns zero if non-equal, or non-zero if equal. +Returns true or false. It is undefined behavior if either of the buffers +doesn't contain at least C bytes. =for apidoc Am|bool|memNEs|char* s1|STRLEN l1|"s2" Like L, but the second string is a literal enclosed in double quotes, C gives the number of bytes in C. -Returns zero if non-equal, or zero if non-equal. +Returns true or false. =for apidoc Am|bool|memCHRs|"list"|char c Returns the position of the first occurence of the byte C in the literal From 9289d4dc7a3d24b20c6e25045e687321ee3e8faf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 09:25:52 -0700 Subject: [PATCH 160/503] locale.c: Fix typo in #ifdef This misspelling led to the code assuming that the platform didn't have a feature that, if used, would result in faster execution. --- locale.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/locale.c b/locale.c index 9500ab7960f9..5970423404d3 100644 --- a/locale.c +++ b/locale.c @@ -2621,7 +2621,7 @@ S_my_nl_langinfo(const int item, bool toggle) #if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */ # if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ || ! defined(HAS_POSIX_2008_LOCALE) \ - || ! defined(DUPLOCALE) + || ! defined(HAS_DUPLOCALE) /* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC * for those items dependent on it. This must be copied to a buffer before From 954418fb5d968a5c176bc9482b05088cd60d299c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 09:30:52 -0700 Subject: [PATCH 161/503] POSIX.xs: Use alternative functions if avail These preprocessor directives failed to account for the existence of common alternative functions (which the implementation knows about) if the plain function is not available on the platform. I doubt that this makes any difference, but it makes these conditionals consistent with the others nearby. --- ext/POSIX/POSIX.xs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index cc67fd6fceca..86ea94587f6b 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1564,7 +1564,7 @@ END_EXTERN_C #if ! defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC) #define mbtowc(pwc, s, n) not_here("mbtowc") #endif -#ifndef HAS_WCTOMB +#if ! defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB) #define wctomb(s, wchar) not_here("wctomb") #endif #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB) @@ -1578,7 +1578,7 @@ END_EXTERN_C #endif #endif -#ifndef HAS_LOCALECONV +#if ! defined(HAS_LOCALECONV) && ! defined(HAS_LOCALECONV_L) # define localeconv() not_here("localeconv") #else struct lconv_offset { From f5ed3ba743326a410ae0e5ce1e5370dafa240650 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 09:33:42 -0700 Subject: [PATCH 162/503] POSIX.xs: White-space only Indent to standards --- ext/POSIX/POSIX.xs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 86ea94587f6b..139ee89ca7ad 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1559,13 +1559,13 @@ END_EXTERN_C #endif #if ! defined(HAS_MBLEN) && ! defined(HAS_MBRLEN) -#define mblen(a,b) not_here("mblen") +# define mblen(a,b) not_here("mblen") #endif #if ! defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC) -#define mbtowc(pwc, s, n) not_here("mbtowc") +# define mbtowc(pwc, s, n) not_here("mbtowc") #endif #if ! defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB) -#define wctomb(s, wchar) not_here("wctomb") +# define wctomb(s, wchar) not_here("wctomb") #endif #if !defined(HAS_MBLEN) && !defined(HAS_MBSTOWCS) && !defined(HAS_MBTOWC) && !defined(HAS_WCSTOMBS) && !defined(HAS_WCTOMB) /* If we don't have these functions, then we wouldn't have gotten a typedef From 407c2aaa9132bbacb18c1e1031f68cd4cebe2e0e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 09:39:34 -0700 Subject: [PATCH 163/503] perlvars.h: Fix comment --- perlvars.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perlvars.h b/perlvars.h index 760cb5c0d02d..b7ee1c69453e 100644 --- a/perlvars.h +++ b/perlvars.h @@ -106,7 +106,7 @@ PERLVARI(G, mmap_page_size, IV, 0) PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted he refcounting */ PERLVAR(G, env_mutex, perl_mutex) /* Mutex for accessing ENV */ # if ! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV) -PERLVAR(G, locale_mutex, perl_mutex) /* Mutex for setlocale() changing */ +PERLVAR(G, locale_mutex, perl_mutex) /* Mutex related to locale handling */ # endif # ifndef USE_THREAD_SAFE_LOCALE PERLVAR(G, lc_numeric_mutex, perl_mutex) /* Mutex for switching LC_NUMERIC */ From 5e638b40985e6c9728d695fe14ab7f2b038d0979 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 21:27:44 -0700 Subject: [PATCH 164/503] time64_config.h: #include reentr.h This is so it will get any reentrant versions automatically --- time64_config.h | 2 ++ 1 file changed, 2 insertions(+) diff --git a/time64_config.h b/time64_config.h index 0bebebb53c0e..8a8dbef6dd7e 100644 --- a/time64_config.h +++ b/time64_config.h @@ -1,6 +1,8 @@ #ifndef PERL_TIME64_CONFIG_H_ # define PERL_TIME64_CONFIG_H_ +#include "reentr.h" + /* Configuration ------------- Define as appropriate for your system. From 4609c3668fdfdd68a65445df942ffddb8a30a9fd Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 1 Dec 2020 07:28:13 -0700 Subject: [PATCH 165/503] perl.h: Remove ';' from 'NOOP;' These are useless here --- perl.h | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/perl.h b/perl.h index 8bccfb401076..047b4eef4930 100644 --- a/perl.h +++ b/perl.h @@ -3081,10 +3081,10 @@ typedef struct padname PADNAME; # define ENV_INIT MUTEX_INIT(&PL_env_mutex); # define ENV_TERM MUTEX_DESTROY(&PL_env_mutex); #else -# define ENV_LOCK NOOP; -# define ENV_UNLOCK NOOP; -# define ENV_INIT NOOP; -# define ENV_TERM NOOP; +# define ENV_LOCK NOOP +# define ENV_UNLOCK NOOP +# define ENV_INIT NOOP +# define ENV_TERM NOOP #endif /* Some critical sections need to lock both the locale and the environment. From 0cf25474a4e6fde7b750472677d559b7e27f3360 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 4 Dec 2020 16:39:02 -0700 Subject: [PATCH 166/503] utf8.h: Fix syntax error only found on EBCDIC builds --- utf8.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/utf8.h b/utf8.h index e254b8b05375..f52317b69b1b 100644 --- a/utf8.h +++ b/utf8.h @@ -873,7 +873,7 @@ fit in an IV on the current machine. && UNLIKELY( NATIVE_UTF8_TO_I8(*(s)) > 0xF9 \ || (NATIVE_UTF8_TO_I8(*((s) + 1)) >= 0xA2)) \ && LIKELY((s) + UTF8SKIP(s) <= (e))) \ - ? is_utf8_char_helper(s, s + UTF8SKIP(s), 0) : 0 + ? is_utf8_char_helper(s, s + UTF8SKIP(s), 0) : 0) #else # define UTF8_IS_SUPER(s, e) \ (( ((e) > (s) + 3) \ From 4b64ef5938269561fff7dc66b69ce34d1bbc8c36 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 2 Dec 2020 17:26:09 +0000 Subject: [PATCH 167/503] Test setting $0 on Dragonfly BSD Support for this began in Perl 5.26.0 with commit 38626956885060503. --- t/op/magic.t | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/t/op/magic.t b/t/op/magic.t index 6283df5ac2e8..3f23648a8600 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -797,15 +797,15 @@ SKIP: { env_is(__NoNeLoCaL => ''); SKIP: { - skip("\$0 check only on Linux and FreeBSD", 2) - unless $^O =~ /^(linux|android|freebsd)$/ + skip("\$0 check only on Linux, Dragonfly BSD and FreeBSD", 2) + unless $^O =~ /^(linux|android|dragonfly|freebsd)$/ && open CMDLINE, "/proc/$$/cmdline"; chomp(my $line = scalar ); my $me = (split /\0/, $line)[0]; is $me, $0, 'altering $0 is effective (testing with /proc/)'; close CMDLINE; - skip("\$0 check with 'ps' only on Linux (but not Android) and FreeBSD", 1) if $^O eq 'android'; + skip("No \$0 check with 'ps' on Android", 1) if $^O eq 'android'; # perlbug #22811 my $mydollarzero = sub { my($arg) = shift; @@ -830,7 +830,7 @@ SKIP: { # FreeBSD cannot get rid of both the leading "perl :" # and the trailing " (perl)": some FreeBSD versions # can get rid of the first one. - || ($^O eq 'freebsd' && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/), + || ($^O =~ /^(dragonfly|freebsd)$/ && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/), 'altering $0 is effective (testing with `ps`)'); } } From 09d8c0d279dc42afb9a0d197a78bf0a0dd51a198 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 2 Dec 2020 17:39:35 +0000 Subject: [PATCH 168/503] Avoid unnecessarily skipping a test to set $0 The absence of /proc/$$/cmdline doesn't mean running ps(1) won't work. --- t/op/magic.t | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/t/op/magic.t b/t/op/magic.t index 3f23648a8600..1fcededb6a9c 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -798,13 +798,17 @@ SKIP: { SKIP: { skip("\$0 check only on Linux, Dragonfly BSD and FreeBSD", 2) - unless $^O =~ /^(linux|android|dragonfly|freebsd)$/ - && open CMDLINE, "/proc/$$/cmdline"; + unless $^O =~ /^(linux|android|dragonfly|freebsd)$/; - chomp(my $line = scalar ); - my $me = (split /\0/, $line)[0]; - is $me, $0, 'altering $0 is effective (testing with /proc/)'; - close CMDLINE; + SKIP: { + skip("No procfs cmdline support", 1) + unless open CMDLINE, "/proc/$$/cmdline"; + + chomp(my $line = scalar ); + my $me = (split /\0/, $line)[0]; + is $me, $0, 'altering $0 is effective (testing with /proc/)'; + close CMDLINE; + } skip("No \$0 check with 'ps' on Android", 1) if $^O eq 'android'; # perlbug #22811 my $mydollarzero = sub { From 0522a9e73a5436836353184378cf48ac54774c17 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 2 Dec 2020 18:04:13 +0000 Subject: [PATCH 169/503] Use a more suitable test method like() provides better errors on failure thank ok(). This reduces the usefulness of the removed printf() diagnostic. --- t/op/magic.t | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/t/op/magic.t b/t/op/magic.t index 1fcededb6a9c..29db4c10a1af 100644 --- a/t/op/magic.t +++ b/t/op/magic.t @@ -819,23 +819,25 @@ SKIP: { my $ps = (`ps -o command= -p $$`)[-1]; return if $?; chomp $ps; - printf "# 0[%s]ps[%s]\n", $0, $ps; $ps; }; my $ps = $mydollarzero->("x"); - ok(!$ps # we allow that something goes wrong with the ps command - # In Linux 2.4 we would get an exact match ($ps eq 'x') but - # in Linux 2.2 there seems to be something funny going on: - # it seems as if the original length of the argv[] would - # be stored in the proc struct and then used by ps(1), - # no matter what characters we use to pad the argv[]. - # (And if we use \0:s, they are shown as spaces.) Sigh. - || $ps =~ /^x\s*$/ - # FreeBSD cannot get rid of both the leading "perl :" - # and the trailing " (perl)": some FreeBSD versions - # can get rid of the first one. - || ($^O =~ /^(dragonfly|freebsd)$/ && $ps =~ m/^(?:perl: )?x(?: \(perl\))?$/), - 'altering $0 is effective (testing with `ps`)'); + # we allow that something goes wrong with the ps command + !$ps && skip("The ps command failed", 1); + my $ps_re = ( $^O =~ /^(dragonfly|freebsd)$/ ) + # FreeBSD cannot get rid of both the leading "perl :" + # and the trailing " (perl)": some FreeBSD versions + # can get rid of the first one. + ? qr/^(?:perl: )?x(?: \(perl\))?$/ + # In Linux 2.4 we would get an exact match ($ps eq 'x') but + # in Linux 2.2 there seems to be something funny going on: + # it seems as if the original length of the argv[] would + # be stored in the proc struct and then used by ps(1), + # no matter what characters we use to pad the argv[]. + # (And if we use \0:s, they are shown as spaces.) Sigh. + : qr/^x\s*$/ + ; + like($ps, $ps_re, 'altering $0 is effective (testing with `ps`)'); } } From 269cb1d351d144f06b2b724d50e35e7b7e6bc4b9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 16:59:03 -0600 Subject: [PATCH 170/503] Always define dMY_CXT_SV, and to dNOOP --- perl.h | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/perl.h b/perl.h index 047b4eef4930..78f7548f17d9 100644 --- a/perl.h +++ b/perl.h @@ -643,6 +643,10 @@ code. =for apidoc AmnU||dVAR This is now a synonym for dNOOP: declare nothing +=for apidoc_section $XS +=for apidoc Amns||dMY_CXT_SV +Now a placeholder that declares nothing + =cut */ @@ -653,6 +657,7 @@ This is now a synonym for dNOOP: declare nothing /* these are only defined for compatibility; should not be used internally. * */ +# define dMY_CXT_SV dNOOP # ifndef pTHXo # define pTHXo pTHX # define pTHXo_ pTHX_ @@ -7214,9 +7219,7 @@ C. # define _aMY_CXT ,aMY_CXT #else /* PERL_IMPLICIT_CONTEXT */ - # define START_MY_CXT static my_cxt_t my_cxt; -# define dMY_CXT_SV dNOOP # define dMY_CXT dNOOP # define dMY_CXT_INTERP(my_perl) dNOOP # define MY_CXT_INIT NOOP From 4eff5eb8fa96cf12671631ada42a7f7a00d51c5b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 29 Nov 2020 08:54:43 -0700 Subject: [PATCH 171/503] Evaluate arg once in all forms of SvTRUE 5.32 did this for one form; now all do. --- embed.fnc | 4 ++++ embed.h | 4 ++++ inline.h | 51 ++++++++++++++++++++++++++++++++++++++- pod/perldelta.pod | 4 +++- proto.h | 18 ++++++++++++++ sv.c | 2 +- sv.h | 61 ++++++++++++++++++++--------------------------- 7 files changed, 106 insertions(+), 38 deletions(-) diff --git a/embed.fnc b/embed.fnc index ff98258ef831..1371a3475e7b 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2727,6 +2727,10 @@ AiMdp |void |SvREFCNT_dec |NULLOK SV *sv AiMdp |void |SvREFCNT_dec_NN|NN SV *sv AiTp |void |SvAMAGIC_on |NN SV *sv AiTp |void |SvAMAGIC_off |NN SV *sv +Aipd |bool |SvTRUE |NULLOK SV *sv +Aipd |bool |SvTRUE_nomg |NULLOK SV *sv +Aipd |bool |SvTRUE_NN |NN SV *sv +Cip |bool |SvTRUE_common |NN SV *sv|const bool sv_2bool_is_fallback : This is indirectly referenced by globals.c. This is somewhat annoying. p |int |magic_killbackrefs|NN SV *sv|NN MAGIC *mg Ap |OP* |newANONATTRSUB |I32 floor|NULLOK OP *proto|NULLOK OP *attrs|NULLOK OP *block diff --git a/embed.h b/embed.h index 8d27796eec61..fd5f3b426459 100644 --- a/embed.h +++ b/embed.h @@ -31,6 +31,10 @@ #define Gv_AMupdate(a,b) Perl_Gv_AMupdate(aTHX_ a,b) #define SvAMAGIC_off Perl_SvAMAGIC_off #define SvAMAGIC_on Perl_SvAMAGIC_on +#define SvTRUE(a) Perl_SvTRUE(aTHX_ a) +#define SvTRUE_NN(a) Perl_SvTRUE_NN(aTHX_ a) +#define SvTRUE_common(a,b) Perl_SvTRUE_common(aTHX_ a,b) +#define SvTRUE_nomg(a) Perl_SvTRUE_nomg(aTHX_ a) #define _force_out_malformed_utf8_message(a,b,c,d) Perl__force_out_malformed_utf8_message(aTHX_ a,b,c,d) #define _is_uni_FOO(a,b) Perl__is_uni_FOO(aTHX_ a,b) #define _is_uni_perl_idcont(a) Perl__is_uni_perl_idcont(aTHX_ a) diff --git a/inline.h b/inline.h index 3b34ad4667bd..c18637208ffe 100644 --- a/inline.h +++ b/inline.h @@ -212,13 +212,62 @@ Perl_ReANY(const REGEXP * const re) /* ------------------------------- sv.h ------------------------------- */ PERL_STATIC_INLINE bool -Perl_SvTRUE(pTHX_ SV *sv) { +Perl_SvTRUE(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE; + if (UNLIKELY(sv == NULL)) return FALSE; SvGETMAGIC(sv); return SvTRUE_nomg_NN(sv); } +PERL_STATIC_INLINE bool +Perl_SvTRUE_nomg(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE_NOMG; + + if (UNLIKELY(sv == NULL)) + return FALSE; + return SvTRUE_nomg_NN(sv); +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE_NN(pTHX_ SV *sv) +{ + PERL_ARGS_ASSERT_SVTRUE_NN; + + SvGETMAGIC(sv); + return SvTRUE_nomg_NN(sv); +} + +PERL_STATIC_INLINE bool +Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback) +{ + PERL_ARGS_ASSERT_SVTRUE_COMMON; + + if (UNLIKELY(SvIMMORTAL_INTERP(sv))) + return SvIMMORTAL_TRUE(sv); + + if (! SvOK(sv)) + return FALSE; + + if (SvPOK(sv)) + return SvPVXtrue(sv); + + if (SvIOK(sv)) + return SvIVX(sv) != 0; /* casts to bool */ + + if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv))))) + return TRUE; + + if (sv_2bool_is_fallback) + return sv_2bool_nomg(sv); + + return isGV_with_GP(sv); +} + + PERL_STATIC_INLINE SV * Perl_SvREFCNT_inc(SV *sv) { diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 8c062081c6ab..d0c4daa2c6db 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -389,7 +389,9 @@ well. =item * -XXX +All C-ish functions now evaluate their arguments exactly once. +In 5.32, plain L> was changed to do that; now the rest +do as well. =back diff --git a/proto.h b/proto.h index 46ce0761d82e..5015f249ef69 100644 --- a/proto.h +++ b/proto.h @@ -117,6 +117,24 @@ PERL_STATIC_INLINE void Perl_SvREFCNT_inc_void(SV *sv); #define PERL_ARGS_ASSERT_SVREFCNT_INC_VOID #endif #ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE bool Perl_SvTRUE(pTHX_ SV *sv); +#define PERL_ARGS_ASSERT_SVTRUE +#endif +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE bool Perl_SvTRUE_NN(pTHX_ SV *sv); +#define PERL_ARGS_ASSERT_SVTRUE_NN \ + assert(sv) +#endif +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE bool Perl_SvTRUE_common(pTHX_ SV *sv, const bool sv_2bool_is_fallback); +#define PERL_ARGS_ASSERT_SVTRUE_COMMON \ + assert(sv) +#endif +#ifndef PERL_NO_INLINE_FUNCTIONS +PERL_STATIC_INLINE bool Perl_SvTRUE_nomg(pTHX_ SV *sv); +#define PERL_ARGS_ASSERT_SVTRUE_NOMG +#endif +#ifndef PERL_NO_INLINE_FUNCTIONS PERL_STATIC_INLINE I32 Perl_TOPMARK(pTHX); #define PERL_ARGS_ASSERT_TOPMARK #endif diff --git a/sv.c b/sv.c index 5c4c3555559d..486f07dcd5b3 100644 --- a/sv.c +++ b/sv.c @@ -3424,7 +3424,7 @@ Perl_sv_2bool_flags(pTHX_ SV *sv, I32 flags) if (SvNOK(sv) && !SvPOK(sv)) return SvNVX(sv) != 0.0; - return SvTRUE_common(sv, isGV_with_GP(sv) ? 1 : 0); + return SvTRUE_common(sv, 0); } /* diff --git a/sv.h b/sv.h index f753a94889e7..02f1a4bc3dff 100644 --- a/sv.h +++ b/sv.h @@ -1631,24 +1631,33 @@ efficient C. C is the same as C, but does not perform 'get' magic. -=for apidoc Am|bool|SvTRUE|SV* sv -Returns a boolean indicating whether Perl would evaluate the SV as true or -false. See C> for a defined/undefined test. Handles 'get' magic -unless the scalar is already C, C or C (the public, not the -private flags). +=for apidoc SvTRUE +=for apidoc_item SvTRUEx +=for apidoc_item SvTRUE_nomg +=for apidoc_item SvTRUE_NN +=for apidoc_item SvTRUE_nomg_NN -As of Perl 5.32, this is guaranteed to evaluate C only once. Prior to that -release, use C> for single evaluation. +These return a boolean indicating whether Perl would evaluate the SV as true or +false. See C> for a defined/undefined test. -=for apidoc Am|bool|SvTRUE_nomg|SV* sv -Returns a boolean indicating whether Perl would evaluate the SV as true or -false. See C> for a defined/undefined test. Does not handle 'get' magic. +As of Perl 5.32, all are guaranteed to evaluate C only once. Prior to that +release, only C guaranteed single evaluation; now C is +identical to C. -=for apidoc Am|bool|SvTRUEx|SV* sv -Identical to C>. Prior to 5.32, they differed in that only this one -was guaranteed to evaluate C only once; in 5.32 they both evaluated it -once, but C was slightly slower on some platforms; now they are -identical. +C and C do not perform 'get' magic; the others do +unless the scalar is already C, C, or C (the public, not +the private flags). + +C is like C>, but C is assumed to be +non-null (NN). If there is a possibility that it is NULL, use plain +C. + +C is like C>, but C is assumed to be +non-null (NN). If there is a possibility that it is NULL, use plain +C. + +C is like C, but C is assumed to be non-null (NN). If +there is a possibility that it is NULL, use plain C. =for apidoc Am|char*|SvPVutf8_force|SV* sv|STRLEN len Like C, but converts C to UTF-8 first if necessary. @@ -1855,25 +1864,9 @@ scalar. #define SvPVutf8x_force(sv, len) sv_pvutf8n_force(sv, &len) #define SvPVbytex_force(sv, len) sv_pvbyten_force(sv, &len) -#define SvTRUE(sv) Perl_SvTRUE(aTHX_ sv) #define SvTRUEx(sv) SvTRUE(sv) -#define SvTRUE_nomg(sv) (LIKELY(sv) && SvTRUE_nomg_NN(sv)) -#define SvTRUE_NN(sv) (SvGETMAGIC(sv), SvTRUE_nomg_NN(sv)) -#define SvTRUE_nomg_NN(sv) (SvTRUE_common(sv, sv_2bool_nomg(sv))) - -#define SvTRUE_common(sv,fallback) ( \ - SvIMMORTAL_INTERP(sv) \ - ? SvIMMORTAL_TRUE(sv) \ - : !SvOK(sv) \ - ? 0 \ - : SvPOK(sv) \ - ? SvPVXtrue(sv) \ - : SvIOK(sv) \ - ? (SvIVX(sv) != 0 /* cast to bool */) \ - : (SvROK(sv) && !( SvOBJECT(SvRV(sv)) \ - && HvAMAGIC(SvSTASH(SvRV(sv))))) \ - ? TRUE \ - : (fallback)) +#define SvTRUEx_nomg(sv) SvTRUE_nomg(sv) +#define SvTRUE_nomg_NN(sv) SvTRUE_common(sv, TRUE) #if defined(PERL_USE_GCC_BRACE_GROUPS) @@ -1887,7 +1880,6 @@ scalar. # define SvPVutf8x(sv, len) ({SV *_sv = (sv); SvPVutf8(_sv, len); }) # define SvPVbytex(sv, len) ({SV *_sv = (sv); SvPVbyte(_sv, len); }) # define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); }) -# define SvTRUEx_nomg(sv) ({SV *_sv = (sv); SvTRUE_nomg(_sv); }) #else /* __GNUC__ */ @@ -1904,7 +1896,6 @@ scalar. # define SvPVutf8x(sv, len) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, len)) # define SvPVbytex(sv, len) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, len)) # define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv)) -# define SvTRUEx_nomg(sv) ((PL_Sv = (sv)), SvTRUE_nomg(PL_Sv)) #endif /* __GNU__ */ #define SvPVXtrue(sv) ( \ From 574e093e57e1827b81a7bf2268758cd1af293649 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Sep 2020 11:04:52 -0600 Subject: [PATCH 172/503] perlapi: Consolidate SvSET-ish entries These should also be in the SV section instead of Magic --- sv.h | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/sv.h b/sv.h index 02f1a4bc3dff..16ecc60660f4 100644 --- a/sv.h +++ b/sv.h @@ -2094,7 +2094,7 @@ incremented. /* the following macros update any magic values this C is associated with */ /* -=for apidoc_section $magic +=for apidoc_section $SV =for apidoc Am|void|SvGETMAGIC|SV* sv Invokes C> on an SV if it has 'get' magic. For example, this @@ -2108,18 +2108,21 @@ or a tied variable (it calls C). This macro evaluates its argument more than once. =for apidoc Am|void|SvSetSV|SV* dsv|SV* ssv -Calls C if C is not the same as C. May evaluate arguments -more than once. Does not handle 'set' magic on the destination SV. +=for apidoc_item SvSetMagicSV +=for apidoc_item SvSetSV_nosteal +=for apidoc_item SvSetMagicSV_nosteal + +if C is the same as C, these do nothing. Otherwise they all call +some form of C>. They may evaluate their arguments more than +once. -=for apidoc Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv -Calls a non-destructive version of C if C is not the same as -C. May evaluate arguments more than once. +The only differences are: -=for apidoc Am|void|SvSetMagicSV|SV* dsv|SV* ssv -Like C, but does any set magic required afterwards. +C and C perform any required 'set' magic +afterwards on the destination SV; C and C do not. -=for apidoc Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv -Like C, but does any set magic required afterwards. +C C call a non-destructive version of +C. =for apidoc Am|void|SvSHARE|SV* sv Arranges for C to be shared between threads if a suitable module From 8528a39b09a32d3edc0074e50a82c3ffafef7016 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 29 Aug 2020 14:07:45 -0600 Subject: [PATCH 173/503] Remove my_l?stat from public API They are not documented, and if you try to use them, you get a compile error. --- embed.fnc | 4 ++-- proto.h | 8 ++------ 2 files changed, 4 insertions(+), 8 deletions(-) diff --git a/embed.fnc b/embed.fnc index 1371a3475e7b..c66a2801b85e 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1401,7 +1401,7 @@ Ap |I32 |my_fflush_all ATp |Pid_t |my_fork ATp |void |atfork_lock ATp |void |atfork_unlock -ApMb |I32 |my_lstat +m |I32 |my_lstat pX |I32 |my_lstat_flags |NULLOK const U32 flags #if ! defined(HAS_MEMRCHR) && (defined(PERL_CORE) || defined(PERL_EXT)) EeiT |void * |my_memrchr |NN const char * s|const char c|const STRLEN len @@ -1412,7 +1412,7 @@ Ap |PerlIO*|my_popen |NN const char* cmd|NN const char* mode #endif Ap |PerlIO*|my_popen_list |NN const char* mode|int n|NN SV ** args Apd |void |my_setenv |NULLOK const char* nam|NULLOK const char* val -ApMb |I32 |my_stat +m |I32 |my_stat pX |I32 |my_stat_flags |NULLOK const U32 flags Adfp |char * |my_strftime |NN const char *fmt|int sec|int min|int hour|int mday|int mon|int year|int wday|int yday|int isdst : Used in pp_ctl.c diff --git a/proto.h b/proto.h index 5015f249ef69..46e69cc20625 100644 --- a/proto.h +++ b/proto.h @@ -2156,10 +2156,8 @@ PERL_CALLCONV I32 Perl_my_fflush_all(pTHX); #define PERL_ARGS_ASSERT_MY_FFLUSH_ALL PERL_CALLCONV Pid_t Perl_my_fork(void); #define PERL_ARGS_ASSERT_MY_FORK -#ifndef NO_MATHOMS -PERL_CALLCONV I32 Perl_my_lstat(pTHX); +/* PERL_CALLCONV I32 my_lstat(pTHX); */ #define PERL_ARGS_ASSERT_MY_LSTAT -#endif PERL_CALLCONV I32 Perl_my_lstat_flags(pTHX_ const U32 flags); #define PERL_ARGS_ASSERT_MY_LSTAT_FLAGS PERL_CALLCONV int Perl_my_mkostemp_cloexec(char *templte, int flags) @@ -2184,10 +2182,8 @@ PERL_CALLCONV int Perl_my_snprintf(char *buffer, const Size_t len, const char *f PERL_CALLCONV int Perl_my_socketpair(int family, int type, int protocol, int fd[2]); #define PERL_ARGS_ASSERT_MY_SOCKETPAIR -#ifndef NO_MATHOMS -PERL_CALLCONV I32 Perl_my_stat(pTHX); +/* PERL_CALLCONV I32 my_stat(pTHX); */ #define PERL_ARGS_ASSERT_MY_STAT -#endif PERL_CALLCONV I32 Perl_my_stat_flags(pTHX_ const U32 flags); #define PERL_ARGS_ASSERT_MY_STAT_FLAGS PERL_CALLCONV char* Perl_my_strerror(pTHX_ const int errnum); From 803e49356bee5584477e9411bafc8d8253ce5a47 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Dec 2020 16:20:41 -0700 Subject: [PATCH 174/503] handy.h: Fix typo in comment --- handy.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/handy.h b/handy.h index 360c383bc428..6e752b561005 100644 --- a/handy.h +++ b/handy.h @@ -355,7 +355,7 @@ assert(), we would get a comma with nothing before it when not DEBUGGING. =cut -We also use empty definition under Coverity since the __ASSERT__ +We also use empty definition under Coverity since the __ASSERT_ checks often check for things that Really Cannot Happen, and Coverity detects that and gets all excited. */ From 92a0bb2462f53210b5f8af1332fc91806d507595 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Dec 2020 16:21:52 -0700 Subject: [PATCH 175/503] inRANGE, withinCOUNT: Split so can avoid asserts This commit splits these macros up into components that are separately callable. The components are considered internal core only, and the purpose is to avoid duplicate assert() calls that were causing some compilers to crash from not being able to handle the size. In particular, this commit refactors inRANGE so that the asserts are done only once, shortening what it expands to. --- handy.h | 30 ++++++++++++++++++++++-------- 1 file changed, 22 insertions(+), 8 deletions(-) diff --git a/handy.h b/handy.h index 6e752b561005..05dbec300e8b 100644 --- a/handy.h +++ b/handy.h @@ -1409,18 +1409,32 @@ or casts * needed. (The NV casts stop any warnings about comparison always being true * if called with an unsigned. The cast preserves the sign, which is all we * care about.) */ -#define withinCOUNT(c, l, n) (__ASSERT_((NV) (l) >= 0) \ - __ASSERT_((NV) (n) >= 0) \ - (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0))))) +#define withinCOUNT(c, l, n) (__ASSERT_((NV) (l) >= 0) \ + __ASSERT_((NV) (n) >= 0) \ + withinCOUNT_KNOWN_VALID_((c), (l), (n))) + +/* For internal use only, this can be used in places where it is known that the + * parameters to withinCOUNT() are valid, to avoid the asserts. For example, + * inRANGE() below, calls this several times, but does all the necessary + * asserts itself, once. The reason that this is necessary is that the + * duplicate asserts were exceeding the internal limits of some compilers */ +#define withinCOUNT_KNOWN_VALID_(c, l, n) \ + (((WIDEST_UTYPE) (((c)) - ((l) | 0))) <= (((WIDEST_UTYPE) ((n) | 0)))) /* Returns true if c is in the range l..u, where 'l' is non-negative * Written this way so that after optimization, only one conditional test is * needed. */ -#define inRANGE(c, l, u) (__ASSERT_((u) >= (l)) \ - ( (sizeof(c) == sizeof(U8)) ? withinCOUNT(((U8) (c)), (l), ((u) - (l))) \ - : (sizeof(c) == sizeof(U32)) ? withinCOUNT(((U32) (c)), (l), ((u) - (l))) \ - : (__ASSERT_(sizeof(c) == sizeof(WIDEST_UTYPE)) \ - withinCOUNT(((WIDEST_UTYPE) (c)), (l), ((u) - (l)))))) +#define inRANGE(c, l, u) (__ASSERT_((NV) (l) >= 0) __ASSERT_((u) >= (l)) \ + ( (sizeof(c) == sizeof(U8)) ? inRANGE_helper_(U8, (c), (l), ((u))) \ + : (sizeof(c) == sizeof(U32)) ? inRANGE_helper_(U32,(c), (l), ((u))) \ + : (__ASSERT_(sizeof(c) == sizeof(WIDEST_UTYPE)) \ + inRANGE_helper_(WIDEST_UTYPE,(c), (l), ((u)))))) + +/* For internal use, this is used by machine-generated code which generates + * known valid calls, with a known sizeof(). This avoids the extra code and + * asserts that were exceeding internal limits of some compilers. */ +#define inRANGE_helper_(cast, c, l, u) \ + withinCOUNT_KNOWN_VALID_(((cast) (c)), (l), ((u) - (l))) #ifdef EBCDIC # ifndef _ALL_SOURCE From 88086fd8ed3eb3b690514588f5d6da7c429a5a8e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 5 Dec 2020 16:35:17 -0700 Subject: [PATCH 176/503] regen/regcharclass.pl: Use smaller inRANGE version The previous commit split inRANGE up so that code that was known to have valid inputs to it could use a component that didn't have all the compile-time checks (often duplicates) that otherwise are made. This commit changes to use that component. The reason the compile-time checks are unnecessary here, is this is machine-generated code known to meet the inRANGE input requirements. All those compile-time checks added up to being too large for some compilers to handle. --- regcharclass.h | 644 +++++++++++++++++++++--------------------- regen/regcharclass.pl | 4 +- 2 files changed, 328 insertions(+), 320 deletions(-) diff --git a/regcharclass.h b/regcharclass.h index 3067ea835fc0..f7217b4a10e0 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -28,23 +28,23 @@ /*** GENERATED CODE ***/ #define is_LNBREAK_safe(s,e,is_utf8) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\f') ) ? 1 \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\f') ) ? 1 \ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : ( is_utf8 ) ? \ ( ( 0xC2 == ((const U8*)s)[0] ) ? \ ( ( 0x85 == ((const U8*)s)[1] ) ? 2 : 0 ) \ - : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ + : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ : ( 0x85 == ((const U8*)s)[0] ) ) \ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\f') ) ? 1 \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\f') ) ? 1 \ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : ( is_utf8 ) ? \ ( ( ( 0xC2 == ((const U8*)s)[0] ) && ( 0x85 == ((const U8*)s)[1] ) ) ? 2 : 0 )\ : ( 0x85 == ((const U8*)s)[0] ) ) \ : ((e)-(s) > 0) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\r') ) ? 1 \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\r') ) ? 1 \ : ( !( is_utf8 ) ) ? \ ( 0x85 == ((const U8*)s)[0] ) \ : 0 ) \ @@ -53,30 +53,30 @@ /*** GENERATED CODE ***/ #define is_LNBREAK_utf8_safe(s,e) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\f') ) ? 1 \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\f') ) ? 1 \ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : ( 0xC2 == ((const U8*)s)[0] ) ? \ ( ( 0x85 == ((const U8*)s)[1] ) ? 2 : 0 ) \ - : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ + : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\f') ) ? 1 \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\f') ) ? 1 \ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : ( ( 0xC2 == ((const U8*)s)[0] ) && ( 0x85 == ((const U8*)s)[1] ) ) ? 2 : 0 )\ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\n', '\r') ) \ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\r') ) \ : 0 ) /*** GENERATED CODE ***/ #define is_LNBREAK_latin1_safe(s,e) \ ( ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\n', '\f') || 0x85 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\f') || 0x85 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\n', '\r') || 0x85 == ((const U8*)s)[0] ) \ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\n', '\r') || 0x85 == ((const U8*)s)[0] )\ : 0 ) /* @@ -90,14 +90,14 @@ ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ ( ( 0x80 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x8A) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_HORIZWS_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) @@ -108,11 +108,11 @@ */ /*** GENERATED CODE ***/ #define is_VERTWS_high(s) \ -( ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 ) +( ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( inRANGE(cp, 0x2028, 0x2029) ) +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -123,14 +123,14 @@ #define is_XDIGIT_high(s) \ ( ( 0xEF == ((const U8*)s)[0] ) ? \ ( ( 0xBC == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x90, 0x99) || inRANGE(((const U8*)s)[2], 0xA1, 0xA6) ) ? 3 : 0 )\ - : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x81, 0x86) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x90, 0x99) || inRANGE_helper_(U8, ((const U8*)s)[2], 0xA1, 0xA6) ) ? 3 : 0 )\ + : ( ( 0xBD == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x81, 0x86) ) ) ? 3 : 0 )\ : 0 ) /*** GENERATED CODE ***/ #define is_XDIGIT_cp_high(cp) \ -( inRANGE(cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ -( inRANGE(cp, 0xFF21, 0xFF26) || inRANGE(cp, 0xFF41, 0xFF46) ) ) ) +( inRANGE_helper_(UV, cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ +( inRANGE_helper_(UV, cp, 0xFF21, 0xFF26) || inRANGE_helper_(UV, cp, 0xFF41, 0xFF46) ) ) ) /* XPERLSPACE: \p{XPerlSpace} @@ -143,15 +143,15 @@ ( ( ( 0x9A == ((const U8*)s)[1] ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ ( ( 0x80 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8A) || inRANGE(((const U8*)s)[2], 0xA8, 0xA9) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x8A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0xA8, 0xA9) || 0xAF == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x81 == ((const U8*)s)[1] ) && ( 0x9F == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xE3 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( 0x80 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) @@ -164,13 +164,13 @@ #define is_NONCHAR_utf8_safe(s,e) \ ( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xEF == ((const U8*)s)[0] ) ?\ ( ( 0xB7 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x90, 0xAF) ) ? 3 : 0 ) \ - : ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0xBE, 0xBF) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x90, 0xAF) ) ? 3 : 0 )\ + : ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xBE, 0xBF) ) ) ? 3 : 0 )\ : ( 0xF0 == ((const U8*)s)[0] ) ? \ - ( ( ( ( ((const U8*)s)[1] == 0x9F || ( ( ((const U8*)s)[1] & 0xEF ) == 0xAF ) ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 )\ - : ( inRANGE(((const U8*)s)[0], 0xF1, 0xF3) ) ? \ - ( ( ( ( ( ((const U8*)s)[1] & 0xCF ) == 0x8F ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 )\ - : ( ( ( ( 0xF4 == ((const U8*)s)[0] ) && ( 0x8F == ((const U8*)s)[1] ) ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 ) : 0 ) + ( ( ( ( ((const U8*)s)[1] == 0x9F || ( ( ((const U8*)s)[1] & 0xEF ) == 0xAF ) ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 )\ + : ( inRANGE_helper_(U8, ((const U8*)s)[0], 0xF1, 0xF3) ) ? \ + ( ( ( ( ( ((const U8*)s)[1] & 0xCF ) == 0x8F ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 )\ + : ( ( ( ( 0xF4 == ((const U8*)s)[0] ) && ( 0x8F == ((const U8*)s)[1] ) ) && ( 0xBF == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0xBE, 0xBF) ) ) ? 4 : 0 ) : 0 ) /* SURROGATE: Surrogate code points @@ -179,7 +179,7 @@ */ /*** GENERATED CODE ***/ #define is_SURROGATE_utf8_safe(s,e) \ -( ( ( ( ( ((e) - (s)) >= 3 ) && ( 0xED == ((const U8*)s)[0] ) ) && ( inRANGE(((const U8*)s)[1], 0xA0, 0xBF) ) ) && ( inRANGE(((const U8*)s)[2], 0x80, 0xBF) ) ) ? 3 : 0 ) +( ( ( ( ( ((e) - (s)) >= 3 ) && ( 0xED == ((const U8*)s)[0] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 0xA0, 0xBF) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0xBF) ) ) ? 3 : 0 ) /* QUOTEMETA: Meta-characters that \Q should quote @@ -194,46 +194,46 @@ ( ( 0x9C == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xE1 == ((const U8*)s)[0] ) ? \ ( ( 0x85 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x9F, 0xA0) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x9F, 0xA0) ) ? 3 : 0 ) \ : ( 0x9A == ((const U8*)s)[1] ) ? \ ( ( 0x80 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( 0x9E == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0xB4, 0xB5) ) ? 3 : 0 ) \ - : ( ( 0xA0 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x8B, 0x8E) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xB4, 0xB5) ) ? 3 : 0 ) \ + : ( ( 0xA0 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x8B, 0x8E) ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ ( ( 0x80 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0xBE) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0xBE) ) ? 3 : 0 ) \ : ( 0x81 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x81, 0x93) || inRANGE(((const U8*)s)[2], 0x95, 0xAF) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x81, 0x93) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x95, 0xAF) ) ? 3 : 0 )\ : ( 0x86 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x90, 0xBF) ) ? 3 : 0 ) \ - : ( inRANGE(((const U8*)s)[1], 0x87, 0x90) || inRANGE(((const U8*)s)[1], 0x94, 0x9C) || inRANGE(((const U8*)s)[1], 0x9F, 0xAF) || inRANGE(((const U8*)s)[1], 0xB8, 0xB9) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x90, 0xBF) ) ? 3 : 0 ) \ + : ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x87, 0x90) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x94, 0x9C) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x9F, 0xAF) || inRANGE_helper_(U8, ((const U8*)s)[1], 0xB8, 0xB9) ) ?\ 3 \ : ( 0x91 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0x9F) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x9F) ) ? 3 : 0 ) \ : ( 0x9D == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0xB5) ) ? 3 : 0 ) \ - : ( ( 0x9E == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x94, 0xBF) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0xB5) ) ? 3 : 0 ) \ + : ( ( 0x9E == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x94, 0xBF) ) ) ? 3 : 0 )\ : ( 0xE3 == ((const U8*)s)[0] ) ? \ ( ( 0x80 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0x83) || inRANGE(((const U8*)s)[2], 0x88, 0xA0) || 0xB0 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x83) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x88, 0xA0) || 0xB0 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x85 == ((const U8*)s)[1] ) && ( 0xA4 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xEF == ((const U8*)s)[0] ) ? \ ( ( 0xB4 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0xBE, 0xBF) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xBE, 0xBF) ) ? 3 : 0 ) \ : ( 0xB8 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0x8F) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x8F) ) ? 3 : 0 ) \ : ( 0xB9 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x85, 0x86) ) ? 3 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x85, 0x86) ) ? 3 : 0 ) \ : ( 0xBB == ((const U8*)s)[1] ) ? \ ( ( 0xBF == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( 0xBE == ((const U8*)s)[1] ) ? \ ( ( 0xA0 == ((const U8*)s)[2] ) ? 3 : 0 ) \ - : ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0xB0, 0xB8) ) ) ? 3 : 0 )\ + : ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xB0, 0xB8) ) ) ? 3 : 0 )\ : ( 0xF0 == ((const U8*)s)[0] ) ? \ ( ( 0x9B == ((const U8*)s)[1] ) ? \ - ( ( ( 0xB2 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0xA0, 0xA3) ) ) ? 4 : 0 )\ - : ( ( ( 0x9D == ((const U8*)s)[1] ) && ( 0x85 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0xB3, 0xBA) ) ) ? 4 : 0 )\ + ( ( ( 0xB2 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0xA0, 0xA3) ) ) ? 4 : 0 )\ + : ( ( ( 0x9D == ((const U8*)s)[1] ) && ( 0x85 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0xB3, 0xBA) ) ) ? 4 : 0 )\ : ( ( 0xF3 == ((const U8*)s)[0] ) && ( 0xA0 == ((const U8*)s)[1] ) ) ? 4 : 0 ) /* @@ -257,7 +257,7 @@ : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ - ( ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ? 2\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ? 2\ : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -265,7 +265,7 @@ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xC5 == ((const U8*)s)[0] ) ? \ ( ( 0xBF == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 'S', 'T') || inRANGE(((const U8*)s)[2], 's', 't') ) ? 3\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[2], 's', 't') ) ? 3\ : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xCA == ((const U8*)s)[0] ) ? \ @@ -283,7 +283,7 @@ ( ( 0xCC == ((const U8*)s)[2] ) ? \ ( ( 0x88 == ((const U8*)s)[3] ) ? \ ( ( 0xCC == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -295,11 +295,11 @@ ( ( 0xCC == ((const U8*)s)[2] ) ? \ ( ( 0x88 == ((const U8*)s)[3] ) ? \ ( ( 0xCC == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( 0x93 == ((const U8*)s)[3] ) ? \ ( ( 0xCC == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 4 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 4 )\ : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 6 : 4 )\ : 0 ) \ : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -338,7 +338,7 @@ : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ - ( ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ? 2\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ? 2\ : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -346,7 +346,7 @@ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xC5 == ((const U8*)s)[0] ) ? \ ( ( 0xBF == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 'S', 'T') || inRANGE(((const U8*)s)[2], 's', 't') ) ? 3\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[2], 's', 't') ) ? 3\ : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xCA == ((const U8*)s)[0] ) ? \ @@ -396,19 +396,19 @@ : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ - ( ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ? 2\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ? 2\ : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'W' ) || ( ( ((const U8*)s)[0] & 0xDF ) == 'Y' ) ) ?\ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xC5 == ((const U8*)s)[0] ) ? \ - ( ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 'S', 'T') || inRANGE(((const U8*)s)[2], 's', 't') ) ) ? 3 : 0 )\ + ( ( ( 0xBF == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[2], 's', 't') ) ) ? 3 : 0 )\ : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0xBC == ((const U8*)s)[1] ) ) && ( ( ((const U8*)s)[2] & 0xDF ) == 'N' ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ ( ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ) ? 2 : 0 )\ - : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ + : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ : 0 ) @@ -432,7 +432,7 @@ : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ - ( ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ? 2\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ? 2\ : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -440,7 +440,7 @@ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xC5 == ((const U8*)s)[0] ) ? \ ( ( 0xBF == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 'S', 'T') || inRANGE(((const U8*)s)[2], 's', 't') ) ? 3\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[2], 's', 't') ) ? 3\ : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xCA == ((const U8*)s)[0] ) ? \ @@ -490,11 +490,11 @@ ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ ( ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ) ? 3 : 2 )\ : ( ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ) ? 2 : 0 )\ - : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ + : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ : ((e)-(s) > 1) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ ( ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ) ? 2 : 0 )\ - : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE(((const U8*)s)[1], 'S', 'T') || inRANGE(((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ + : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ : 0 ) /* @@ -511,12 +511,12 @@ ( ( 0xB1 == ((const U8*)s)[1] || 0xB7 == ((const U8*)s)[1] ) ? \ ( ( ( ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) && ( 0xCE == ((const U8*)s)[4] ) ) && ( 0xB9 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( ( ( 0xB9 == ((const U8*)s)[1] ) && ( 0xCC == ((const U8*)s)[2] ) ) && ( 0x88 == ((const U8*)s)[3] ) ) ? ( ( 0xCC == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( 0xCF == ((const U8*)s)[0] ) ? \ ( ( 0x85 == ((const U8*)s)[1] ) ? \ ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x88 == ((const U8*)s)[3] || 0x93 == ((const U8*)s)[3] ) ) ? ( ( 0xCC == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x80, 0x81) ) ? 6 : 0 )\ : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( ( ( ( ( 0x89 == ((const U8*)s)[1] ) && ( 0xCD == ((const U8*)s)[2] ) ) && ( 0x82 == ((const U8*)s)[3] ) ) && ( 0xCE == ((const U8*)s)[4] ) ) && ( 0xB9 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ @@ -638,13 +638,13 @@ ( ( 0x87 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xE1 == ((const U8*)s)[0] ) ? \ ( ( 0xBA == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0xBD == ((const U8*)s)[1] ) ? \ ( ( ( ((const U8*)s)[2] & 0xF9 ) == 0x90 ) ? 3 : 0 ) \ : ( 0xBE == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x80, 0xAF) || inRANGE(((const U8*)s)[2], 0xB2, 0xB4) || inRANGE(((const U8*)s)[2], 0xB6, 0xB7) || 0xBC == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0xAF) || inRANGE_helper_(U8, ((const U8*)s)[2], 0xB2, 0xB4) || inRANGE_helper_(U8, ((const U8*)s)[2], 0xB6, 0xB7) || 0xBC == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0xBF == ((const U8*)s)[1] ) && ( ( ( ((const U8*)s)[2] & 0xCA ) == 0x82 ) || ( ( ((const U8*)s)[2] & 0xF7 ) == 0x84 ) || ((const U8*)s)[2] == 0xA4 || ( ( ((const U8*)s)[2] & 0xF7 ) == 0xB4 ) ) ) ? 3 : 0 )\ -: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x80, 0x86) || inRANGE(((const U8*)s)[2], 0x93, 0x97) ) ) ? 3 : 0 ) +: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x86) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x93, 0x97) ) ) ? 3 : 0 ) /* PROBLEMATIC_LOCALE_FOLD: characters whose fold is problematic under locale @@ -654,10 +654,10 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_utf8(s) \ ( ( ((const U8*)s)[0] <= 0x7F ) ? 1 \ -: ( inRANGE(((const U8*)s)[0], 0xC2, 0xC3) ) ? \ +: ( inRANGE_helper_(U8, ((const U8*)s)[0], 0xC2, 0xC3) ) ? \ 2 \ : ( 0xC4 == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0xB0, 0xB1) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0xB0, 0xB1) ) ? 2 : 0 ) \ : ( 0xC5 == ((const U8*)s)[0] ) ? \ ( ( 0x89 == ((const U8*)s)[1] || 0xB8 == ((const U8*)s)[1] || 0xBF == ((const U8*)s)[1] ) ? 2 : 0 )\ : ( 0xC7 == ((const U8*)s)[0] ) ? \ @@ -667,15 +667,15 @@ : ( 0xCE == ((const U8*)s)[0] ) ? \ ( ( ( ((const U8*)s)[1] & 0xDF ) == 0x9C ) ? 2 : 0 ) \ : ( 0xE1 == ((const U8*)s)[0] ) ? \ - ( ( ( 0xBA == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0xBA == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ - ( ( ( 0x84 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0xAA, 0xAB) ) ) ? 3 : 0 )\ -: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x80, 0x86) ) ) ? 3 : 0 ) + ( ( ( 0x84 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xAA, 0xAB) ) ) ? 3 : 0 )\ +: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x86) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -683,9 +683,9 @@ ( 0x307 == cp || ( 0x307 < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -695,10 +695,10 @@ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8(s) \ ( ( ((const U8*)s)[0] <= 0x7F ) ? 1 \ -: ( inRANGE(((const U8*)s)[0], 0xC2, 0xC3) ) ? \ +: ( inRANGE_helper_(U8, ((const U8*)s)[0], 0xC2, 0xC3) ) ? \ 2 \ : ( 0xC4 == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0xB0, 0xB1) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0xB0, 0xB1) ) ? 2 : 0 ) \ : ( 0xC5 == ((const U8*)s)[0] ) ? \ ( ( 0x89 == ((const U8*)s)[1] || 0xB8 == ((const U8*)s)[1] || 0xBF == ((const U8*)s)[1] ) ? 2 : 0 )\ : ( 0xC7 == ((const U8*)s)[0] ) ? \ @@ -708,15 +708,15 @@ : ( 0xCE == ((const U8*)s)[0] ) ? \ ( ( ( ((const U8*)s)[1] & 0xDF ) == 0x9C ) ? 2 : 0 ) \ : ( 0xE1 == ((const U8*)s)[0] ) ? \ - ( ( ( 0xBA == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0xBA == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x96, 0x9A) || 0x9E == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xE2 == ((const U8*)s)[0] ) ? \ - ( ( ( 0x84 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0xAA, 0xAB) ) ) ? 3 : 0 )\ -: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x80, 0x86) ) ) ? 3 : 0 ) + ( ( ( 0x84 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0xAA, 0xAB) ) ) ? 3 : 0 )\ +: ( ( ( 0xEF == ((const U8*)s)[0] ) && ( 0xAC == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0x86) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -724,9 +724,9 @@ ( 0x2BC == cp || ( 0x2BC < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -736,13 +736,13 @@ /*** GENERATED CODE ***/ #define is_PATWS_safe(s,e,is_utf8) \ ( ( LIKELY((e) > (s)) ) ? \ - ( ( inRANGE(((const U8*)s)[0], '\t', '\r') || ' ' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\t', '\r') || ' ' == ((const U8*)s)[0] ) ? 1\ : (! is_utf8 ) ? \ ( 0x85 == ((const U8*)s)[0] ) \ : ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ? \ ( ( 0xC2 == ((const U8*)s)[0] ) ? \ ( ( 0x85 == ((const U8*)s)[1] ) ? 2 : 0 ) \ - : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x8E, 0x8F) || inRANGE(((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ + : ( ( ( 0xE2 == ((const U8*)s)[0] ) && ( 0x80 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x8E, 0x8F) || inRANGE_helper_(U8, ((const U8*)s)[2], 0xA8, 0xA9) ) ) ? 3 : 0 )\ : 0 ) \ : 0 ) @@ -753,7 +753,7 @@ */ /*** GENERATED CODE ***/ #define is_HANGUL_ED_utf8_safe(s,e) \ -( ( ( ( ( ((e) - (s)) >= 3 ) && ( 0xED == ((const U8*)s)[0] ) ) && ( inRANGE(((const U8*)s)[1], 0x80, 0x9F) ) ) && ( inRANGE(((const U8*)s)[2], 0x80, 0xBF) ) ) ? 3 : 0 ) +( ( ( ( ( ((e) - (s)) >= 3 ) && ( 0xED == ((const U8*)s)[0] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x80, 0x9F) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x80, 0xBF) ) ) ? 3 : 0 ) #endif /* ASCII/Latin1 */ @@ -770,44 +770,44 @@ /*** GENERATED CODE ***/ #define is_LNBREAK_safe(s,e,is_utf8) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ - : ( ( ( ( is_utf8 ) && ( 0xCA == ((const U8*)s)[0] ) ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ + : ( ( ( ( is_utf8 ) && ( 0xCA == ((const U8*)s)[0] ) ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ : 0 ) /*** GENERATED CODE ***/ #define is_LNBREAK_utf8_safe(s,e) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ - : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ + : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ : 0 ) /*** GENERATED CODE ***/ #define is_LNBREAK_latin1_safe(s,e) \ ( ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] )\ : 0 ) /* @@ -821,7 +821,7 @@ ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -830,7 +830,7 @@ /*** GENERATED CODE ***/ #define is_HORIZWS_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) @@ -841,11 +841,11 @@ */ /*** GENERATED CODE ***/ #define is_VERTWS_high(s) \ -( ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) +( ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( inRANGE(cp, 0x2028, 0x2029) ) +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -855,13 +855,13 @@ /*** GENERATED CODE ***/ #define is_XDIGIT_high(s) \ ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x73 == ((const U8*)s)[1] ) ) ? ( ( 0x67 == ((const U8*)s)[2] ) ?\ - ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || inRANGE(((const U8*)s)[3], 0x62, 0x68) ) ? 4 : 0 )\ - : ( ( inRANGE(((const U8*)s)[2], 0x68, 0x69) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47) ) ) ? 4 : 0 ) : 0 ) + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x68) ) ? 4 : 0 )\ + : ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x68, 0x69) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x42, 0x47) ) ) ? 4 : 0 ) : 0 ) /*** GENERATED CODE ***/ #define is_XDIGIT_cp_high(cp) \ -( inRANGE(cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ -( inRANGE(cp, 0xFF21, 0xFF26) || inRANGE(cp, 0xFF41, 0xFF46) ) ) ) +( inRANGE_helper_(UV, cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ +( inRANGE_helper_(UV, cp, 0xFF21, 0xFF26) || inRANGE_helper_(UV, cp, 0xFF41, 0xFF46) ) ) ) /* XPERLSPACE: \p{XPerlSpace} @@ -874,17 +874,17 @@ ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) || 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) || 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) @@ -898,16 +898,16 @@ ( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xDD == ((const U8*)s)[0] ) ?\ ( ( 0x73 == ((const U8*)s)[1] ) ? \ ( ( 0x55 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x73) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x73) ) ? 4 : 0 )\ : ( 0x56 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ - : ( ( 0x73 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x72, 0x73) ) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ + : ( ( 0x73 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x72, 0x73) ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDF == ((const U8*)s)[0] || 0xEA == ((const U8*)s)[0] || 0xEC == ((const U8*)s)[0] ) ?\ - ( ( ( ( 0x73 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x72, 0x73) ) ) ? 4 : 0 )\ + ( ( ( ( 0x73 == ((const U8*)s)[1] ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x72, 0x73) ) ) ? 4 : 0 )\ : ( 0xED == ((const U8*)s)[0] ) ? \ - ( ( ( ( ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x62 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x68 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x71 ) ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( 0x73 == ((const U8*)s)[3] ) ) && ( inRANGE(((const U8*)s)[4], 0x72, 0x73) ) ) ? 5 : 0 )\ - : ( ( ( ( ( 0xEE == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( 0x73 == ((const U8*)s)[3] ) ) && ( inRANGE(((const U8*)s)[4], 0x72, 0x73) ) ) ? 5 : 0 ) : 0 ) + ( ( ( ( ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x62 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x68 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x71 ) ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( 0x73 == ((const U8*)s)[3] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x72, 0x73) ) ) ? 5 : 0 )\ + : ( ( ( ( ( 0xEE == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( 0x73 == ((const U8*)s)[2] ) ) && ( 0x73 == ((const U8*)s)[3] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x72, 0x73) ) ) ? 5 : 0 ) : 0 ) /* SURROGATE: Surrogate code points @@ -916,7 +916,7 @@ */ /*** GENERATED CODE ***/ #define is_SURROGATE_utf8_safe(s,e) \ -( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( inRANGE(((const U8*)s)[1], 0x65, 0x66) ) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x59) || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x73) ) ) ? 4 : 0 ) +( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x65, 0x66) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x73) ) ) ? 4 : 0 ) /* QUOTEMETA: Meta-characters that \Q should quote @@ -924,66 +924,74 @@ \p{_Perl_Quotemeta} */ /*** GENERATED CODE ***/ -#define is_QUOTEMETA_high(s) \ -( ( 0xB1 == ((const U8*)s)[0] ) ? \ - ( ( 0x56 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0xB8 == ((const U8*)s)[0] ) ? \ - ( ( ( 0x57 == ((const U8*)s)[1] ) && ( 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ -: ( 0xBB == ((const U8*)s)[0] ) ? \ - ( ( 0x51 == ((const U8*)s)[1] ) ? \ - ( ( 0x73 == ((const U8*)s)[2] ) ? 3 : 0 ) \ - : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ -: ( 0xBC == ((const U8*)s)[0] ) ? \ - ( ( 0x63 == ((const U8*)s)[1] ) ? \ +#define is_QUOTEMETA_high_part0(s) \ +( ( 0x63 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? 3 : 0 ) \ - : ( ( 0x71 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x63, 0x64) ) ) ? 3 : 0 )\ -: ( 0xBE == ((const U8*)s)[0] ) ? \ - ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ + : ( ( 0x71 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x63, 0x64) ) ) ? 3 : 0 ) + + +/*** GENERATED CODE ***/ +#define is_QUOTEMETA_high_part1(s) \ +( ( 0xBE == ((const U8*)s)[0] ) ? \ + ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( 0x41 == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x54, 0x59) || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x73) ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ + ( ( 0x41 == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x54, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x73) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ : ( 0x43 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x42, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x62 == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x64, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x42, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x62 == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ : ( 0x44 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x56) ) ? 3 : 0 )\ - : ( ( 0x53 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x57, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x56) ) ? 3 : 0 )\ + : ( ( 0x53 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x57, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ : ( 0xCB == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x43) || inRANGE(((const U8*)s)[1], 0x49, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || inRANGE(((const U8*)s)[1], 0x62, 0x69) || inRANGE(((const U8*)s)[1], 0x71, 0x73) ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x43) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x49, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x69) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x71, 0x73) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ : ( 0x6A == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x64) ) ? 3 : 0 )\ - : ( ( 0x70 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x63, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x64) ) ? 3 : 0 )\ + : ( ( 0x70 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x63, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ : ( 0xCC == ((const U8*)s)[0] ) ? \ - ( ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x73) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ + ( ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x73) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ : ( 0xCD == ((const U8*)s)[0] ) ? \ - ( ( ( inRANGE(((const U8*)s)[1], 0x57, 0x59) || 0x62 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ + ( ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x59) || 0x62 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ) ? 3 : 0 )\ : ( 0xCE == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x44) || inRANGE(((const U8*)s)[2], 0x49, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x44) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] || 0x57 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x45 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xDD == ((const U8*)s)[0] ) ? \ ( ( 0x73 == ((const U8*)s)[1] ) ? \ ( ( 0x4A == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x72, 0x73) ) ? 4 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x72, 0x73) ) ? 4 : 0 )\ : ( 0x57 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ : ( 0x59 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x46, 0x47) ) ? 4 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x46, 0x47) ) ? 4 : 0 )\ : ( 0x66 == ((const U8*)s)[2] ) ? \ ( ( 0x73 == ((const U8*)s)[3] ) ? 4 : 0 ) \ : ( 0x71 == ((const U8*)s)[2] ) ? \ ( ( 0x41 == ((const U8*)s)[3] ) ? 4 : 0 ) \ - : ( ( 0x73 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || inRANGE(((const U8*)s)[3], 0x62, 0x67) ) ) ? 4 : 0 )\ + : ( ( 0x73 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x67) ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDF == ((const U8*)s)[0] ) ? \ ( ( 0x56 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x46 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x44) ) ) ? 4 : 0 )\ - : ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x52 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x62, 0x69) ) ) ? 4 : 0 )\ -: ( ( ( ( ( 0xED == ((const U8*)s)[0] ) && ( 0x70 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x44) ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x59) || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x73) ) ) && ( inRANGE(((const U8*)s)[4], 0x41, 0x4A) || inRANGE(((const U8*)s)[4], 0x51, 0x59) || inRANGE(((const U8*)s)[4], 0x62, 0x6A) || inRANGE(((const U8*)s)[4], 0x70, 0x73) ) ) ? 5 : 0 ) + ( ( ( 0x46 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x44) ) ) ? 4 : 0 )\ + : ( ( ( 0x63 == ((const U8*)s)[1] ) && ( 0x52 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x69) ) ) ? 4 : 0 )\ +: ( ( ( ( ( 0xED == ((const U8*)s)[0] ) && ( 0x70 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x44) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x73) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[4], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[4], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[4], 0x70, 0x73) ) ) ? 5 : 0 ) + + +/*** GENERATED CODE ***/ +#define is_QUOTEMETA_high(s) \ +( ( 0xB1 == ((const U8*)s)[0] ) ? \ + ( ( 0x56 == ((const U8*)s)[1] ) ? 2 : 0 ) \ +: ( 0xB8 == ((const U8*)s)[0] ) ? \ + ( ( ( 0x57 == ((const U8*)s)[1] ) && ( 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ +: ( 0xBB == ((const U8*)s)[0] ) ? \ + ( ( 0x51 == ((const U8*)s)[1] ) ? \ + ( ( 0x73 == ((const U8*)s)[2] ) ? 3 : 0 ) \ + : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ +: ( 0xBC == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0(s) : is_QUOTEMETA_high_part1(s) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -992,14 +1000,12 @@ */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ -( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 ) +( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ -( ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ - ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ - : ( 0x8F == ((const U8*)s)[0] ) ? \ +( ( 0x8F == ((const U8*)s)[0] ) ? \ ( ( 0x73 == ((const U8*)s)[1] ) ? \ ( ( 0x8F == ((const U8*)s)[2] ) ? \ ( ( 0x73 == ((const U8*)s)[3] ) ? 4 : 0 ) \ @@ -1030,7 +1036,7 @@ ( ( 0xAF == ((const U8*)s)[2] ) ? \ ( ( 0x49 == ((const U8*)s)[3] ) ? \ ( ( 0xAF == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -1042,11 +1048,11 @@ ( ( 0xAF == ((const U8*)s)[2] ) ? \ ( ( 0x49 == ((const U8*)s)[3] ) ? \ ( ( 0xAF == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( 0x62 == ((const U8*)s)[3] ) ? \ ( ( 0xAF == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 4 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 4 )\ : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 4 )\ : 0 ) \ : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -1066,9 +1072,9 @@ : ( ( ( ( 0x72 == ((const U8*)s)[2] ) && ( 0xB8 == ((const U8*)s)[3] ) ) && ( 0x52 == ((const U8*)s)[4] ) ) && ( 0x65 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x67, 0x68) ) ? \ - ( ( ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : ( ( ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x67, 0x68) ) ? \ + ( ( ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : ( ( ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : 0 ) @@ -1123,9 +1129,9 @@ : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB4 == ((const U8*)s)[2] ) ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x67, 0x68) ) ? \ - ( ( ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : ( ( ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x67, 0x68) ) ? \ + ( ( ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : ( ( ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : 0 ) @@ -1221,7 +1227,9 @@ ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ ( ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ) ? 3 : 2 )\ : ( ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ) ? 2 : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ : ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) /* @@ -1257,12 +1265,12 @@ ( ( 0x58 == ((const U8*)s)[1] || 0x66 == ((const U8*)s)[1] ) ? \ ( ( ( ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) && ( 0xB4 == ((const U8*)s)[4] ) ) && ( 0x68 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( ( ( 0x68 == ((const U8*)s)[1] ) && ( 0xAF == ((const U8*)s)[2] ) ) && ( 0x49 == ((const U8*)s)[3] ) ) ? ( ( 0xAF == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( 0xB5 == ((const U8*)s)[0] ) ? \ ( ( 0x46 == ((const U8*)s)[1] ) ? \ ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x49 == ((const U8*)s)[3] || 0x62 == ((const U8*)s)[3] ) ) ? ( ( 0xAF == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( ( ( ( ( 0x4A == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) && ( 0xB4 == ((const U8*)s)[4] ) ) && ( 0x68 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ @@ -1309,9 +1317,9 @@ : ( 0xB8 == ((const U8*)s)[0] ) ? \ ( ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x46 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x67, 0x68) ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 ) \ - : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x67, 0x68) ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 )\ + : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : ((e)-(s) > 2) ? \ ( ( ( ( ((const U8*)s)[0] & 0xAF ) == 'a' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 'h' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 's' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ) ? 1\ @@ -1328,9 +1336,9 @@ : ( 0xB8 == ((const U8*)s)[0] ) ? \ ( ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x46 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x67, 0x68) ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 ) \ - : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x67, 0x68) ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 )\ + : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : ((e)-(s) > 1) ? \ ( ( ( ( ((const U8*)s)[0] & 0xAF ) == 'a' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 'h' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 's' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ) ? 1\ @@ -1372,7 +1380,7 @@ #define is_FOLDS_TO_MULTI_utf8(s) \ ( ( 0x8A == ((const U8*)s)[0] ) ? \ ( ( 0x73 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0x8D == ((const U8*)s)[0] || 0x9C == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0xB3, 0xB4) ) ?\ +: ( 0x8D == ((const U8*)s)[0] || 0x9C == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0xB3, 0xB4) ) ?\ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ @@ -1380,17 +1388,17 @@ ( ( ( 0x53 == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x63 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x69 == ((const U8*)s)[1] ) ? \ ( ( 0x57 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x63 == ((const U8*)s)[2] || 0x65 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x70 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x73) ) ? 3 : 0 )\ : ( 0x71 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x56) || 0x59 == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x63) || inRANGE(((const U8*)s)[2], 0x65, 0x66) || 0x70 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x56) || 0x59 == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x63) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x66) || 0x70 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x72 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x43, 0x45) || inRANGE(((const U8*)s)[2], 0x47, 0x48) || 0x53 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x65, 0x66) ) ? 3 : 0 )\ - : ( ( 0x73 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x43, 0x45) || inRANGE(((const U8*)s)[2], 0x47, 0x48) || 0x59 == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x63) || inRANGE(((const U8*)s)[2], 0x65, 0x66) || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) || inRANGE(((const U8*)s)[3], 0x62, 0x66) ) ) ? 4 : 0 ) + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x43, 0x45) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x47, 0x48) || 0x53 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x66) ) ? 3 : 0 )\ + : ( ( 0x73 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x43, 0x45) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x47, 0x48) || 0x59 == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x63) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x66) || 0x70 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x66) ) ) ? 4 : 0 ) /* PROBLEMATIC_LOCALE_FOLD: characters whose fold is problematic under locale @@ -1399,11 +1407,11 @@ */ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_utf8(s) \ -( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE(((const U8*)s)[0], '.', '&') || inRANGE(((const U8*)s)[0], '!', '/') || inRANGE(((const U8*)s)[0], ',', '?') || inRANGE(((const U8*)s)[0], '`', '"') || inRANGE(((const U8*)s)[0], 'a', 'i') || inRANGE(((const U8*)s)[0], 'j', 'r') || inRANGE(((const U8*)s)[0], '~', 'z') || '[' == ((const U8*)s)[0] || ']' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '{', 'I') || inRANGE(((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 'S', 'Z') || inRANGE(((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ -: ( 0x80 == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0x8A, 0x8B) ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x73) ) ? 2 : 0 )\ +( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE_helper_(U8, ((const U8*)s)[0], '.', '&') || inRANGE_helper_(U8, ((const U8*)s)[0], '!', '/') || inRANGE_helper_(U8, ((const U8*)s)[0], ',', '?') || inRANGE_helper_(U8, ((const U8*)s)[0], '`', '"') || inRANGE_helper_(U8, ((const U8*)s)[0], 'a', 'i') || inRANGE_helper_(U8, ((const U8*)s)[0], 'j', 'r') || inRANGE_helper_(U8, ((const U8*)s)[0], '~', 'z') || '[' == ((const U8*)s)[0] || ']' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '{', 'I') || inRANGE_helper_(U8, ((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 'S', 'Z') || inRANGE_helper_(U8, ((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ +: ( 0x80 == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0x8A, 0x8B) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x73) ) ? 2 : 0 )\ : ( 0x8D == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ : ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8F == ((const U8*)s)[0] ) ? \ @@ -1412,18 +1420,18 @@ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xAF == ((const U8*)s)[0] ) ? \ ( ( 0x48 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( inRANGE(((const U8*)s)[0], 0xB3, 0xB4) ) ? \ +: ( inRANGE_helper_(U8, ((const U8*)s)[0], 0xB3, 0xB4) ) ? \ ( ( 0x70 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( ( 0x63 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0x63 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) + ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -1431,9 +1439,9 @@ ( 0x307 == cp || ( 0x307 < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -1442,29 +1450,29 @@ */ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8(s) \ -( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE(((const U8*)s)[0], '.', '&') || inRANGE(((const U8*)s)[0], '!', '/') || inRANGE(((const U8*)s)[0], ',', '?') || inRANGE(((const U8*)s)[0], '`', '"') || inRANGE(((const U8*)s)[0], 'a', 'i') || inRANGE(((const U8*)s)[0], 'j', 'r') || inRANGE(((const U8*)s)[0], '~', 'z') || '[' == ((const U8*)s)[0] || ']' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '{', 'I') || inRANGE(((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 'S', 'Z') || inRANGE(((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ -: ( 0x80 == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0x8A, 0x8B) ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x73) ) ? 2 : 0 )\ +( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE_helper_(U8, ((const U8*)s)[0], '.', '&') || inRANGE_helper_(U8, ((const U8*)s)[0], '!', '/') || inRANGE_helper_(U8, ((const U8*)s)[0], ',', '?') || inRANGE_helper_(U8, ((const U8*)s)[0], '`', '"') || inRANGE_helper_(U8, ((const U8*)s)[0], 'a', 'i') || inRANGE_helper_(U8, ((const U8*)s)[0], 'j', 'r') || inRANGE_helper_(U8, ((const U8*)s)[0], '~', 'z') || '[' == ((const U8*)s)[0] || ']' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '{', 'I') || inRANGE_helper_(U8, ((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 'S', 'Z') || inRANGE_helper_(U8, ((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ +: ( 0x80 == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0x8A, 0x8B) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x73) ) ? 2 : 0 )\ : ( 0x8D == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ : ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8F == ((const U8*)s)[0] ) ? \ ( ( 0x67 == ((const U8*)s)[1] || 0x73 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x9C == ((const U8*)s)[0] ) ? \ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0xAB == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0xB3, 0xB4) ) ? \ +: ( 0xAB == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0xB3, 0xB4) ) ?\ ( ( 0x70 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( ( 0x63 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0x63 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x65, 0x69) || 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) + ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) && ( 0x67 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -1472,9 +1480,9 @@ ( 0x2BC == cp || ( 0x2BC < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -1484,10 +1492,10 @@ /*** GENERATED CODE ***/ #define is_PATWS_safe(s,e,is_utf8) \ ( ( LIKELY((e) > (s)) ) ? \ - ( ( '\t' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] || ' ' == ((const U8*)s)[0] ) ? 1\ + ( ( '\t' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || '\n' == ((const U8*)s)[0] || 0x25 == ((const U8*)s)[0] || ' ' == ((const U8*)s)[0] ) ? 1\ : ( ( is_utf8 && LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xCA == ((const U8*)s)[0] ) ) ? ( ( 0x41 == ((const U8*)s)[1] ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x55, 0x56) ) ? 3 : 0 ) \ - : ( ( 0x42 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x55, 0x56) ) ? 3 : 0 )\ + : ( ( 0x42 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) : 0 )\ : 0 ) #endif /* EBCDIC 1047 */ @@ -1505,44 +1513,44 @@ /*** GENERATED CODE ***/ #define is_LNBREAK_safe(s,e,is_utf8) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ - : ( ( ( ( is_utf8 ) && ( 0xCA == ((const U8*)s)[0] ) ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ + : ( ( ( ( is_utf8 ) && ( 0xCA == ((const U8*)s)[0] ) ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ : 0 ) /*** GENERATED CODE ***/ #define is_LNBREAK_utf8_safe(s,e) \ ( ((e)-(s) > 2) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ - : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ + : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 )\ : ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ : 0 ) /*** GENERATED CODE ***/ #define is_LNBREAK_latin1_safe(s,e) \ ( ((e)-(s) > 1) ? \ - ( ( inRANGE(((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\f') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] ) ? 1\ : ( '\r' == ((const U8*)s)[0] ) ? \ ( ( '\n' == ((const U8*)s)[1] ) ? 2 : 1 ) \ : 0 ) \ : ((e)-(s) > 0) ? \ - ( inRANGE(((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ + ( inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] )\ : 0 ) /* @@ -1556,7 +1564,7 @@ ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x56 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -1565,7 +1573,7 @@ /*** GENERATED CODE ***/ #define is_HORIZWS_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) @@ -1576,11 +1584,11 @@ */ /*** GENERATED CODE ***/ #define is_VERTWS_high(s) \ -( ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) +( ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_VERTWS_cp_high(cp) \ -( inRANGE(cp, 0x2028, 0x2029) ) +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) ) /* XDIGIT: Hexadecimal digits @@ -1590,13 +1598,13 @@ /*** GENERATED CODE ***/ #define is_XDIGIT_high(s) \ ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x72 == ((const U8*)s)[1] ) ) ? ( ( 0x66 == ((const U8*)s)[2] ) ?\ - ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x67) ) ? 4 : 0 )\ - : ( ( inRANGE(((const U8*)s)[2], 0x67, 0x68) ) && ( inRANGE(((const U8*)s)[3], 0x42, 0x47) ) ) ? 4 : 0 ) : 0 ) + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x67) ) ? 4 : 0 )\ + : ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x67, 0x68) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x42, 0x47) ) ) ? 4 : 0 ) : 0 ) /*** GENERATED CODE ***/ #define is_XDIGIT_cp_high(cp) \ -( inRANGE(cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ -( inRANGE(cp, 0xFF21, 0xFF26) || inRANGE(cp, 0xFF41, 0xFF46) ) ) ) +( inRANGE_helper_(UV, cp, 0xFF10, 0xFF19) || ( 0xFF19 < cp && \ +( inRANGE_helper_(UV, cp, 0xFF21, 0xFF26) || inRANGE_helper_(UV, cp, 0xFF41, 0xFF46) ) ) ) /* XPERLSPACE: \p{XPerlSpace} @@ -1609,17 +1617,17 @@ ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || 0x51 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) || 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) || 0x56 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x43 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ( 0xCE == ((const U8*)s)[0] ) && ( 0x41 == ((const U8*)s)[1] ) ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_XPERLSPACE_cp_high(cp) \ ( 0x1680 == cp || ( 0x1680 < cp && \ -( inRANGE(cp, 0x2000, 0x200A) || ( 0x200A < cp && \ -( inRANGE(cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ +( inRANGE_helper_(UV, cp, 0x2000, 0x200A) || ( 0x200A < cp && \ +( inRANGE_helper_(UV, cp, 0x2028, 0x2029) || ( 0x2029 < cp && \ ( 0x202F == cp || ( 0x202F < cp && \ ( 0x205F == cp || 0x3000 == cp ) ) ) ) ) ) ) ) ) @@ -1633,16 +1641,16 @@ ( ( ( LIKELY((e) > (s)) ) && ( LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) ) ? ( ( 0xDD == ((const U8*)s)[0] ) ?\ ( ( 0x72 == ((const U8*)s)[1] ) ? \ ( ( 0x55 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x72) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x72) ) ? 4 : 0 )\ : ( 0x56 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ - : ( ( 0x72 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x71, 0x72) ) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x71, 0x72) ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDF == ((const U8*)s)[0] || 0xEA == ((const U8*)s)[0] || 0xEC == ((const U8*)s)[0] ) ?\ - ( ( ( ( 0x72 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x71, 0x72) ) ) ? 4 : 0 )\ + ( ( ( ( 0x72 == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x71, 0x72) ) ) ? 4 : 0 )\ : ( 0xED == ((const U8*)s)[0] ) ? \ - ( ( ( ( ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x5F || ((const U8*)s)[1] == 0x63 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x65 ) || ((const U8*)s)[1] == 0x69 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x70 ) ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( 0x72 == ((const U8*)s)[3] ) ) && ( inRANGE(((const U8*)s)[4], 0x71, 0x72) ) ) ? 5 : 0 )\ - : ( ( ( ( ( 0xEE == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( 0x72 == ((const U8*)s)[3] ) ) && ( inRANGE(((const U8*)s)[4], 0x71, 0x72) ) ) ? 5 : 0 ) : 0 ) + ( ( ( ( ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x5F || ((const U8*)s)[1] == 0x63 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x65 ) || ((const U8*)s)[1] == 0x69 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x70 ) ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( 0x72 == ((const U8*)s)[3] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x71, 0x72) ) ) ? 5 : 0 )\ + : ( ( ( ( ( 0xEE == ((const U8*)s)[0] ) && ( 0x42 == ((const U8*)s)[1] ) ) && ( 0x72 == ((const U8*)s)[2] ) ) && ( 0x72 == ((const U8*)s)[3] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x71, 0x72) ) ) ? 5 : 0 ) : 0 ) /* SURROGATE: Surrogate code points @@ -1651,7 +1659,7 @@ */ /*** GENERATED CODE ***/ #define is_SURROGATE_utf8_safe(s,e) \ -( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( inRANGE(((const U8*)s)[1], 0x64, 0x65) ) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x72) ) ) ? 4 : 0 ) +( ( ( ( ( ( ((e) - (s)) >= 4 ) && ( 0xDD == ((const U8*)s)[0] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x64, 0x65) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x72) ) ) ? 4 : 0 ) /* QUOTEMETA: Meta-characters that \Q should quote @@ -1660,73 +1668,73 @@ */ /*** GENERATED CODE ***/ #define is_QUOTEMETA_high_part0(s) \ -( ( ( 0x57 == ((const U8*)s)[1] ) && ( 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 ) +( ( 0x41 == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x54, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ + : ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x71) ) ? 3 : 0 )\ + : ( 0x43 == ((const U8*)s)[1] ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x42, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x63, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ + : ( 0x44 == ((const U8*)s)[1] ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x56) ) ? 3 : 0 )\ + : ( ( 0x53 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x57, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_QUOTEMETA_high_part1(s) \ -( ( 0xBC == ((const U8*)s)[0] ) ? \ - ( ( 0x51 == ((const U8*)s)[1] ) ? \ - ( ( 0x72 == ((const U8*)s)[2] ) ? 3 : 0 ) \ - : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ -: ( 0xBD == ((const U8*)s)[0] ) ? \ - ( ( 0x62 == ((const U8*)s)[1] ) ? \ - ( ( 0x41 == ((const U8*)s)[2] ) ? 3 : 0 ) \ - : ( ( 0x70 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x62, 0x63) ) ) ? 3 : 0 )\ -: ( 0xBE == ((const U8*)s)[0] ) ? \ - ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ -: ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( 0x41 == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x54, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x72) ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ - : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x71) ) ? 3 : 0 )\ - : ( 0x43 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x42, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x63, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ - : ( 0x44 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x56) ) ? 3 : 0 )\ - : ( ( 0x53 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x57, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ -: ( 0xCB == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x43) || inRANGE(((const U8*)s)[1], 0x49, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x62, 0x68) || inRANGE(((const U8*)s)[1], 0x70, 0x72) ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ +( ( 0xCB == ((const U8*)s)[0] ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x43) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x49, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x68) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ?\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ : ( 0x69 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x63) ) ? 3 : 0 )\ - : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x63) ) ? 3 : 0 )\ + : ( ( 0x6A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ : ( 0xCC == ((const U8*)s)[0] ) ? \ - ( ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x72) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ + ( ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ : ( 0xCD == ((const U8*)s)[0] ) ? \ - ( ( ( inRANGE(((const U8*)s)[1], 0x57, 0x59) || 0x5F == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ + ( ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x59) || 0x5F == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ) ? 3 : 0 )\ : ( 0xCE == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x44) || inRANGE(((const U8*)s)[2], 0x49, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x44) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] || 0x57 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x45 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xDD == ((const U8*)s)[0] ) ? \ ( ( 0x72 == ((const U8*)s)[1] ) ? \ ( ( 0x4A == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x71, 0x72) ) ? 4 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x71, 0x72) ) ? 4 : 0 )\ : ( 0x57 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x56) ) ? 4 : 0 )\ : ( 0x59 == ((const U8*)s)[2] ) ? \ - ( ( inRANGE(((const U8*)s)[3], 0x46, 0x47) ) ? 4 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x46, 0x47) ) ? 4 : 0 )\ : ( 0x65 == ((const U8*)s)[2] ) ? \ ( ( 0x72 == ((const U8*)s)[3] ) ? 4 : 0 ) \ : ( 0x70 == ((const U8*)s)[2] ) ? \ ( ( 0x41 == ((const U8*)s)[3] ) ? 4 : 0 ) \ - : ( ( 0x72 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x66) ) ) ? 4 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x57, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x66) ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDF == ((const U8*)s)[0] ) ? \ ( ( 0x56 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x46 == ((const U8*)s)[2] ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x44) ) ) ? 4 : 0 )\ - : ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x52 == ((const U8*)s)[2] ) ) && ( 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x68) ) ) ? 4 : 0 )\ -: ( ( ( ( ( 0xED == ((const U8*)s)[0] ) && ( 0x6A == ((const U8*)s)[1] ) ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x44) ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x4A) || inRANGE(((const U8*)s)[3], 0x51, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x6A) || inRANGE(((const U8*)s)[3], 0x70, 0x72) ) ) && ( inRANGE(((const U8*)s)[4], 0x41, 0x4A) || inRANGE(((const U8*)s)[4], 0x51, 0x59) || 0x5F == ((const U8*)s)[4] || inRANGE(((const U8*)s)[4], 0x62, 0x6A) || inRANGE(((const U8*)s)[4], 0x70, 0x72) ) ) ? 5 : 0 ) + ( ( ( 0x46 == ((const U8*)s)[2] ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x44) ) ) ? 4 : 0 )\ + : ( ( ( 0x62 == ((const U8*)s)[1] ) && ( 0x52 == ((const U8*)s)[2] ) ) && ( 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x68) ) ) ? 4 : 0 )\ +: ( ( ( ( ( 0xED == ((const U8*)s)[0] ) && ( 0x6A == ((const U8*)s)[1] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x44) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x51, 0x59) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[3], 0x70, 0x72) ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[4], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[4], 0x51, 0x59) || 0x5F == ((const U8*)s)[4] || inRANGE_helper_(U8, ((const U8*)s)[4], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[4], 0x70, 0x72) ) ) ? 5 : 0 ) /*** GENERATED CODE ***/ #define is_QUOTEMETA_high(s) \ ( ( 0xAF == ((const U8*)s)[0] ) ? \ ( ( 0x56 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0xB7 == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0(s) : is_QUOTEMETA_high_part1(s) ) +: ( 0xB7 == ((const U8*)s)[0] ) ? \ + ( ( ( 0x57 == ((const U8*)s)[1] ) && ( 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ +: ( 0xBC == ((const U8*)s)[0] ) ? \ + ( ( 0x51 == ((const U8*)s)[1] ) ? \ + ( ( 0x72 == ((const U8*)s)[2] ) ? 3 : 0 ) \ + : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ +: ( 0xBD == ((const U8*)s)[0] ) ? \ + ( ( 0x62 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? 3 : 0 ) \ + : ( ( 0x70 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x63) ) ) ? 3 : 0 )\ +: ( 0xBE == ((const U8*)s)[0] ) ? \ + ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ +: ( 0xCA == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0(s) : is_QUOTEMETA_high_part1(s) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -1735,14 +1743,12 @@ */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ -( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 ) +( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ -( ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ - ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ - : ( 0x8E == ((const U8*)s)[0] ) ? \ +( ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x72 == ((const U8*)s)[1] ) ? \ ( ( 0x8E == ((const U8*)s)[2] ) ? \ ( ( 0x72 == ((const U8*)s)[3] ) ? 4 : 0 ) \ @@ -1773,7 +1779,7 @@ ( ( 0xAD == ((const U8*)s)[2] ) ? \ ( ( 0x49 == ((const U8*)s)[3] ) ? \ ( ( 0xAD == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -1785,11 +1791,11 @@ ( ( 0xAD == ((const U8*)s)[2] ) ? \ ( ( 0x49 == ((const U8*)s)[3] ) ? \ ( ( 0xAD == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( 0x5F == ((const U8*)s)[3] ) ? \ ( ( 0xAD == ((const U8*)s)[4] ) ? \ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 4 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 4 )\ : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 4 )\ : 0 ) \ : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ @@ -1809,9 +1815,9 @@ : ( ( ( ( 0x71 == ((const U8*)s)[2] ) && ( 0xB7 == ((const U8*)s)[3] ) ) && ( 0x52 == ((const U8*)s)[4] ) ) && ( 0x64 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x66, 0x67) ) ? \ - ( ( ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : ( ( ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x66, 0x67) ) ? \ + ( ( ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : ( ( ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : 0 ) @@ -1866,9 +1872,9 @@ : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB3 == ((const U8*)s)[2] ) ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x66, 0x67) ) ? \ - ( ( ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : ( ( ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x66, 0x67) ) ? \ + ( ( ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : ( ( ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : 0 ) @@ -1964,7 +1970,9 @@ ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ ( ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ) ? 3 : 2 )\ : ( ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ) ? 2 : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ : ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) /* @@ -2000,12 +2008,12 @@ ( ( 0x58 == ((const U8*)s)[1] || 0x65 == ((const U8*)s)[1] ) ? \ ( ( ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) && ( 0xB3 == ((const U8*)s)[4] ) ) && ( 0x67 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : ( ( ( 0x67 == ((const U8*)s)[1] ) && ( 0xAD == ((const U8*)s)[2] ) ) && ( 0x49 == ((const U8*)s)[3] ) ) ? ( ( 0xAD == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( 0xB4 == ((const U8*)s)[0] ) ? \ ( ( 0x46 == ((const U8*)s)[1] ) ? \ ( ( ( 0xAD == ((const U8*)s)[2] ) && ( 0x49 == ((const U8*)s)[3] || 0x5F == ((const U8*)s)[3] ) ) ? ( ( 0xAD == ((const U8*)s)[4] ) ?\ - ( ( inRANGE(((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[5], 0x41, 0x42) ) ? 6 : 0 )\ : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 6 : 0 ) : 0 )\ : ( ( ( ( ( 0x4A == ((const U8*)s)[1] ) && ( 0xAF == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) && ( 0xB3 == ((const U8*)s)[4] ) ) && ( 0x67 == ((const U8*)s)[5] ) ) ? 6 : 0 )\ : 0 ) \ @@ -2052,9 +2060,9 @@ : ( 0xB7 == ((const U8*)s)[0] ) ? \ ( ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x46 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x66, 0x67) ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 ) \ - : ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x66, 0x67) ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 )\ + : ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : ((e)-(s) > 2) ? \ ( ( ( ( ((const U8*)s)[0] & 0xAF ) == 'a' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 'h' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 's' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ) ? 1\ @@ -2071,9 +2079,9 @@ : ( 0xB7 == ((const U8*)s)[0] ) ? \ ( ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x46 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x66, 0x67) ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 ) \ - : ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x66, 0x67) ) ? \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) ) ? 3 : 0 )\ + : ( ( 0x69 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x48) || 0x57 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x6A == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : 0 ) \ : ((e)-(s) > 1) ? \ ( ( ( ( ((const U8*)s)[0] & 0xAF ) == 'a' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 'h' ) || ( ( ((const U8*)s)[0] & 0xBE ) == 's' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) || ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ) ? 1\ @@ -2115,7 +2123,7 @@ #define is_FOLDS_TO_MULTI_utf8(s) \ ( ( 0x80 == ((const U8*)s)[0] ) ? \ ( ( 0x72 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0x8C == ((const U8*)s)[0] || 0x9B == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0xB2, 0xB3) ) ?\ +: ( 0x8C == ((const U8*)s)[0] || 0x9B == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0xB2, 0xB3) ) ?\ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8D == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ @@ -2123,17 +2131,17 @@ ( ( ( 0x53 == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x62 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x68 == ((const U8*)s)[1] ) ? \ ( ( 0x57 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || 0x64 == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x6A == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x62, 0x6A) || inRANGE(((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ : ( 0x70 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x41, 0x4A) || inRANGE(((const U8*)s)[2], 0x51, 0x56) || 0x59 == ((const U8*)s)[2] || 0x5F == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x64, 0x65) || 0x6A == ((const U8*)s)[2] ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x56) || 0x59 == ((const U8*)s)[2] || 0x5F == ((const U8*)s)[2] || 0x62 == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x65) || 0x6A == ((const U8*)s)[2] ) ? 3 : 0 )\ : ( 0x71 == ((const U8*)s)[1] ) ? \ - ( ( inRANGE(((const U8*)s)[2], 0x43, 0x45) || inRANGE(((const U8*)s)[2], 0x47, 0x48) || 0x53 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x5F == ((const U8*)s)[2] || inRANGE(((const U8*)s)[2], 0x64, 0x65) ) ? 3 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x43, 0x45) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x47, 0x48) || 0x53 == ((const U8*)s)[2] || 0x59 == ((const U8*)s)[2] || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x65) ) ? 3 : 0 )\ : ( ( 0x72 == ((const U8*)s)[1] ) && ( ( ( ((const U8*)s)[2] & 0xFB ) == 0x43 ) || ( ( ((const U8*)s)[2] & 0xDE ) == 0x44 ) || ((const U8*)s)[2] == 0x48 || ((const U8*)s)[2] == 0x59 || ((const U8*)s)[2] == 0x5F || ( ( ((const U8*)s)[2] & '7' ) == 0x62 ) ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) || 0x5F == ((const U8*)s)[3] || inRANGE(((const U8*)s)[3], 0x62, 0x65) ) ) ? 4 : 0 ) +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) || 0x5F == ((const U8*)s)[3] || inRANGE_helper_(U8, ((const U8*)s)[3], 0x62, 0x65) ) ) ? 4 : 0 ) /* PROBLEMATIC_LOCALE_FOLD: characters whose fold is problematic under locale @@ -2142,11 +2150,11 @@ */ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_utf8(s) \ -( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE(((const U8*)s)[0], '.', '&') || inRANGE(((const U8*)s)[0], '!', ';') || inRANGE(((const U8*)s)[0], '-', '/') || inRANGE(((const U8*)s)[0], ',', '?') || inRANGE(((const U8*)s)[0], '`', '"') || inRANGE(((const U8*)s)[0], 'a', 'i') || inRANGE(((const U8*)s)[0], 'j', 'r') || inRANGE(((const U8*)s)[0], '~', 'z') || '^' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '[', ']') || inRANGE(((const U8*)s)[0], '{', 'I') || inRANGE(((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 'S', 'Z') || inRANGE(((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ +( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE_helper_(U8, ((const U8*)s)[0], '.', '&') || inRANGE_helper_(U8, ((const U8*)s)[0], '!', ';') || inRANGE_helper_(U8, ((const U8*)s)[0], '-', '/') || inRANGE_helper_(U8, ((const U8*)s)[0], ',', '?') || inRANGE_helper_(U8, ((const U8*)s)[0], '`', '"') || inRANGE_helper_(U8, ((const U8*)s)[0], 'a', 'i') || inRANGE_helper_(U8, ((const U8*)s)[0], 'j', 'r') || inRANGE_helper_(U8, ((const U8*)s)[0], '~', 'z') || '^' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '[', ']') || inRANGE_helper_(U8, ((const U8*)s)[0], '{', 'I') || inRANGE_helper_(U8, ((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 'S', 'Z') || inRANGE_helper_(U8, ((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ : ( 0x78 == ((const U8*)s)[0] || 0x80 == ((const U8*)s)[0] || 0x8A == ((const U8*)s)[0] ) ?\ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x72) ) ? 2 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ? 2 : 0 )\ : ( 0x8C == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ : ( 0x8D == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8E == ((const U8*)s)[0] ) ? \ @@ -2155,18 +2163,18 @@ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xAD == ((const U8*)s)[0] ) ? \ ( ( 0x48 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( inRANGE(((const U8*)s)[0], 0xB2, 0xB3) ) ? \ +: ( inRANGE_helper_(U8, ((const U8*)s)[0], 0xB2, 0xB3) ) ? \ ( ( 0x6A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( ( 0x62 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0x62 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) + ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLD_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -2174,9 +2182,9 @@ ( 0x307 == cp || ( 0x307 < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PROBLEMATIC_LOCALE_FOLDEDS_START: The first folded character of folds which are problematic under locale @@ -2185,29 +2193,29 @@ */ /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8(s) \ -( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE(((const U8*)s)[0], '.', '&') || inRANGE(((const U8*)s)[0], '!', ';') || inRANGE(((const U8*)s)[0], '-', '/') || inRANGE(((const U8*)s)[0], ',', '?') || inRANGE(((const U8*)s)[0], '`', '"') || inRANGE(((const U8*)s)[0], 'a', 'i') || inRANGE(((const U8*)s)[0], 'j', 'r') || inRANGE(((const U8*)s)[0], '~', 'z') || '^' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '[', ']') || inRANGE(((const U8*)s)[0], '{', 'I') || inRANGE(((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 'S', 'Z') || inRANGE(((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ +( ( ( ((const U8*)s)[0] <= ' ' ) || inRANGE_helper_(U8, ((const U8*)s)[0], '.', '&') || inRANGE_helper_(U8, ((const U8*)s)[0], '!', ';') || inRANGE_helper_(U8, ((const U8*)s)[0], '-', '/') || inRANGE_helper_(U8, ((const U8*)s)[0], ',', '?') || inRANGE_helper_(U8, ((const U8*)s)[0], '`', '"') || inRANGE_helper_(U8, ((const U8*)s)[0], 'a', 'i') || inRANGE_helper_(U8, ((const U8*)s)[0], 'j', 'r') || inRANGE_helper_(U8, ((const U8*)s)[0], '~', 'z') || '^' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '[', ']') || inRANGE_helper_(U8, ((const U8*)s)[0], '{', 'I') || inRANGE_helper_(U8, ((const U8*)s)[0], '}', 'R') || '\\' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 'S', 'Z') || inRANGE_helper_(U8, ((const U8*)s)[0], '0', '9') || 0xFF == ((const U8*)s)[0] ) ? 1\ : ( 0x78 == ((const U8*)s)[0] || 0x80 == ((const U8*)s)[0] || 0x8A == ((const U8*)s)[0] ) ?\ - ( ( inRANGE(((const U8*)s)[1], 0x41, 0x4A) || inRANGE(((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE(((const U8*)s)[1], 0x62, 0x6A) || inRANGE(((const U8*)s)[1], 0x70, 0x72) ) ? 2 : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ? 2 : 0 )\ : ( 0x8C == ((const U8*)s)[0] ) ? \ - ( ( inRANGE(((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ + ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x57, 0x58) ) ? 2 : 0 ) \ : ( 0x8D == ((const U8*)s)[0] ) ? \ ( ( 0x4A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x66 == ((const U8*)s)[1] || 0x72 == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0x9B == ((const U8*)s)[0] ) ? \ ( ( 0x57 == ((const U8*)s)[1] ) ? 2 : 0 ) \ -: ( 0xAA == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], 0xB2, 0xB3) ) ? \ +: ( 0xAA == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], 0xB2, 0xB3) ) ?\ ( ( 0x6A == ((const U8*)s)[1] ) ? 2 : 0 ) \ : ( 0xBF == ((const U8*)s)[0] ) ? \ - ( ( ( 0x62 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ + ( ( ( 0x62 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x64, 0x68) || 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ - ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ -: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE(((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) + ( ( ( 0x4A == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x52) ) ) ? 3 : 0 )\ +: ( ( ( ( 0xDD == ((const U8*)s)[0] ) && ( 0x71 == ((const U8*)s)[1] ) ) && ( 0x66 == ((const U8*)s)[2] ) ) && ( inRANGE_helper_(U8, ((const U8*)s)[3], 0x41, 0x47) ) ) ? 4 : 0 ) /*** GENERATED CODE ***/ #define is_PROBLEMATIC_LOCALE_FOLDEDS_START_cp(cp) \ ( cp <= 0xFF || ( 0xFF < cp && \ -( inRANGE(cp, 0x130, 0x131) || ( 0x131 < cp && \ +( inRANGE_helper_(UV, cp, 0x130, 0x131) || ( 0x131 < cp && \ ( 0x149 == cp || ( 0x149 < cp && \ ( 0x178 == cp || ( 0x178 < cp && \ ( 0x17F == cp || ( 0x17F < cp && \ @@ -2215,9 +2223,9 @@ ( 0x2BC == cp || ( 0x2BC < cp && \ ( 0x39C == cp || ( 0x39C < cp && \ ( 0x3BC == cp || ( 0x3BC < cp && \ -( inRANGE(cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ +( inRANGE_helper_(UV, cp, 0x1E96, 0x1E9A) || ( 0x1E9A < cp && \ ( 0x1E9E == cp || ( 0x1E9E < cp && \ -( inRANGE(cp, 0x212A, 0x212B) || inRANGE(cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) +( inRANGE_helper_(UV, cp, 0x212A, 0x212B) || inRANGE_helper_(UV, cp, 0xFB00, 0xFB06) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) ) /* PATWS: pattern white space @@ -2227,10 +2235,10 @@ /*** GENERATED CODE ***/ #define is_PATWS_safe(s,e,is_utf8) \ ( ( LIKELY((e) > (s)) ) ? \ - ( ( '\t' == ((const U8*)s)[0] || inRANGE(((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] || ' ' == ((const U8*)s)[0] ) ? 1\ + ( ( '\t' == ((const U8*)s)[0] || inRANGE_helper_(U8, ((const U8*)s)[0], '\v', '\r') || 0x15 == ((const U8*)s)[0] || '\n' == ((const U8*)s)[0] || ' ' == ((const U8*)s)[0] ) ? 1\ : ( ( is_utf8 && LIKELY(((e) - (s)) >= UTF8SKIP(s)) ) && ( 0xCA == ((const U8*)s)[0] ) ) ? ( ( 0x41 == ((const U8*)s)[1] ) ?\ - ( ( inRANGE(((const U8*)s)[2], 0x55, 0x56) ) ? 3 : 0 ) \ - : ( ( 0x42 == ((const U8*)s)[1] ) && ( inRANGE(((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) : 0 )\ + ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x55, 0x56) ) ? 3 : 0 )\ + : ( ( 0x42 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x49, 0x4A) ) ) ? 3 : 0 ) : 0 )\ : 0 ) #endif /* EBCDIC 037 */ @@ -2289,6 +2297,6 @@ * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * acef4a732cb0cf63f720e29d8f25b0574a8ba18d553920197d459ad7950c3fd9 regen/regcharclass.pl + * 1c2b06a33a2fd4ea6a2df233f99167cb89e9e4041e1732bd49d5c2f145df38d8 regen/regcharclass.pl * c0a5e4cb2b9ffad78691938e122c1310bbc98aca2364af243e5c6b2ec0f59dc3 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index d0d80d86d051..e9944f101659 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1183,7 +1183,7 @@ sub _cond_as_str { # bounds. But inRANGE() allows us to have a single conditional, # so the only cost of making sure it's a legal UTF-8 continuation # byte is an extra subtraction instruction, a trivial expense. - $ranges[$i] = "inRANGE($test, " + $ranges[$i] = "inRANGE_helper_(U8, $test, " . $self->val_fmt($ranges[$i]->[0]) .", " . $self->val_fmt($ranges[$i]->[1]) . ")"; } @@ -1216,7 +1216,7 @@ sub _combine { $cstr= "$test <= " . $self->val_fmt($item->[1]); } else { - $cstr = "inRANGE($test, " + $cstr = "inRANGE_helper_(UV, $test, " . $self->val_fmt($item->[0]) . ", " . $self->val_fmt($item->[1]) . ")"; } From 2de541a7c621c3f3e23da3d477977c545a78bf87 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 4 Jul 2020 22:01:16 -0600 Subject: [PATCH 177/503] perl.h: Move some code around This is in preparation for future commits where things will be needed earlier/later than currently. --- perl.h | 99 ++++++++++++++++++++++++++++++---------------------------- 1 file changed, 52 insertions(+), 47 deletions(-) diff --git a/perl.h b/perl.h index 78f7548f17d9..05cc4d04eb32 100644 --- a/perl.h +++ b/perl.h @@ -3076,37 +3076,6 @@ typedef struct padname PADNAME; # define USE_ENVIRON_ARRAY #endif -#ifdef USE_ITHREADS - /* On some platforms it would be safe to use a read/write mutex with many - * readers possible at the same time. On other platforms, notably IBM ones, - * subsequent getenv calls destroy earlier ones. Those platforms would not - * be able to handle simultaneous getenv calls */ -# define ENV_LOCK MUTEX_LOCK(&PL_env_mutex) -# define ENV_UNLOCK MUTEX_UNLOCK(&PL_env_mutex) -# define ENV_INIT MUTEX_INIT(&PL_env_mutex); -# define ENV_TERM MUTEX_DESTROY(&PL_env_mutex); -#else -# define ENV_LOCK NOOP -# define ENV_UNLOCK NOOP -# define ENV_INIT NOOP -# define ENV_TERM NOOP -#endif - -/* Some critical sections need to lock both the locale and the environment. - * XXX khw intends to change this to lock both mutexes, but that brings up - * issues of potential deadlock, so should be done at the beginning of a - * development cycle. So for now, it just locks the environment. Note that - * many modern platforms are locale-thread-safe anyway, so locking the locale - * mutex is a no-op anyway */ -#define ENV_LOCALE_LOCK ENV_LOCK -#define ENV_LOCALE_UNLOCK ENV_UNLOCK - -/* And some critical sections care only that no one else is writing either the - * locale nor the environment. XXX Again this is for the future. This can be - * simulated with using COND_WAIT in thread.h */ -#define ENV_LOCALE_READ_LOCK ENV_LOCALE_LOCK -#define ENV_LOCALE_READ_UNLOCK ENV_LOCALE_UNLOCK - #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) /* having sigaction(2) means that the OS supports both 1-arg and 3-arg * signal handlers. But the perl core itself only fully supports 1-arg @@ -6269,22 +6238,6 @@ EXTCONST U8 PL_c9_utf8_dfa_tab[]; # endif #endif /* end of isn't EBCDIC */ -#ifndef PERL_NO_INLINE_FUNCTIONS -/* Static inline funcs that depend on includes and declarations above. - Some of these reference functions in the perl object files, and some - compilers aren't smart enough to eliminate unused static inline - functions, so including this file in source code can cause link errors - even if the source code uses none of the functions. Hence including these - can be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will - (obviously) result in unworkable XS code, but allows simple probing code - to continue to work, because it permits tests to include the perl headers - for definitions without creating a link dependency on the perl library - (which may not exist yet). -*/ - -# include "inline.h" -#endif - #include "overload.h" END_EXTERN_C @@ -6977,6 +6930,58 @@ cannot have changed since the precalculation. #endif /* !USE_LOCALE_NUMERIC */ +#ifdef USE_ITHREADS + /* On some platforms it would be safe to use a read/write mutex with many + * readers possible at the same time. On other platforms, notably IBM ones, + * subsequent getenv calls destroy earlier ones. Those platforms would not + * be able to handle simultaneous getenv calls */ +# define ENV_LOCK MUTEX_LOCK(&PL_env_mutex) +# define ENV_UNLOCK MUTEX_UNLOCK(&PL_env_mutex) +# define ENV_INIT MUTEX_INIT(&PL_env_mutex); +# define ENV_TERM MUTEX_DESTROY(&PL_env_mutex); +#else +# define ENV_LOCK NOOP +# define ENV_UNLOCK NOOP +# define ENV_INIT NOOP +# define ENV_TERM NOOP +#endif + +#ifndef PERL_NO_INLINE_FUNCTIONS +/* Static inline funcs that depend on includes and declarations above. + Some of these reference functions in the perl object files, and some + compilers aren't smart enough to eliminate unused static inline + functions, so including this file in source code can cause link errors + even if the source code uses none of the functions. Hence including these + can be suppressed by setting PERL_NO_INLINE_FUNCTIONS. Doing this will + (obviously) result in unworkable XS code, but allows simple probing code + to continue to work, because it permits tests to include the perl headers + for definitions without creating a link dependency on the perl library + (which may not exist yet). +*/ + +START_EXTERN_C + +# include "inline.h" + +END_EXTERN_C + +#endif + +/* Some critical sections need to lock both the locale and the environment. + * XXX khw intends to change this to lock both mutexes, but that brings up + * issues of potential deadlock, so should be done at the beginning of a + * development cycle. So for now, it just locks the environment. Note that + * many modern platforms are locale-thread-safe anyway, so locking the locale + * mutex is a no-op anyway */ +#define ENV_LOCALE_LOCK ENV_LOCK +#define ENV_LOCALE_UNLOCK ENV_UNLOCK + +/* And some critical sections care only that no one else is writing either the + * locale nor the environment. XXX Again this is for the future. This can be + * simulated with using COND_WAIT in thread.h */ +#define ENV_LOCALE_READ_LOCK ENV_LOCALE_LOCK +#define ENV_LOCALE_READ_UNLOCK ENV_LOCALE_UNLOCK + #define Atof my_atof /* From 1442da54429bca166af716cb981dc150644ad203 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 4 Dec 2020 07:40:54 -0700 Subject: [PATCH 178/503] Revert "Don't test for 16-bit inputs in inRANGE()" This effectively reverts commit 4c2aa7c802893d0276551ade1b9d5dcd1226afc4. That commit removed checking for 16 bit inputs because an assert in a macro was making compilations fail in some compilers that couldn't handle the complexity. This inadvertently broke systems which use C language shorts in certain places, such Mingw and Win32 with their use of UTF16, not typically found on other platforms. At the time, we weren't smoking Mingw so we didn't know about it there, but the Win32 failures on Win32 were "fixed" by another commit which disabled assertions of this type completely. It turns out the issue was passing too long a string to assert(). Commits 92a0bb2 and 88086fd removed a bunch of unnecessary and/or duplicate asserts, bringing the size down, so that the 16 bit checks can be added back in without breaking these compilers. The reverted commit mentioned HP compilers as having problems. The only such box we currently have available for testing is HP-31, and the reversion works fine on it, even before 92a0bb2 and 88086fd. This fixes GH #18364 --- handy.h | 1 + 1 file changed, 1 insertion(+) diff --git a/handy.h b/handy.h index 05dbec300e8b..f0a2a3cb75c2 100644 --- a/handy.h +++ b/handy.h @@ -1426,6 +1426,7 @@ or casts * needed. */ #define inRANGE(c, l, u) (__ASSERT_((NV) (l) >= 0) __ASSERT_((u) >= (l)) \ ( (sizeof(c) == sizeof(U8)) ? inRANGE_helper_(U8, (c), (l), ((u))) \ + : (sizeof(c) == sizeof(U16)) ? inRANGE_helper_(U16,(c), (l), ((u))) \ : (sizeof(c) == sizeof(U32)) ? inRANGE_helper_(U32,(c), (l), ((u))) \ : (__ASSERT_(sizeof(c) == sizeof(WIDEST_UTYPE)) \ inRANGE_helper_(WIDEST_UTYPE,(c), (l), ((u)))))) From bc113a9f23ba6ec568379797d3ba5382c941e062 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 4 Dec 2020 08:01:31 -0700 Subject: [PATCH 179/503] Not all Win32 compilers have a small macro buffer Commit e7ae132ec78 consolidated PERL_SMALL_MACRO_BUFFER usages, but it omitted the _MSC_VER number at which the buffer became large enough. Apparently it did this because Windows compilations were failing with the error "string too long", which doesn't happen if __ASSERT_ expands to nothing, which it does under PERL_SMALL_MACRO_BUFFER. However, commits 92a0bb2 and 88086fd shortened the offending strings so later Windows compilers don't have to be considered as having small macro buffers. --- perl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl.h b/perl.h index 05cc4d04eb32..e1b6b1819698 100644 --- a/perl.h +++ b/perl.h @@ -529,7 +529,7 @@ __typeof__ and nothing else. # endif #endif -#if defined(_MSC_VER) +#if defined(_MSC_VER) && _MSC_VER < 1400 /* XXX older MSVC versions have a smallish macro buffer */ #define PERL_SMALL_MACRO_BUFFER #endif From 53fde77bcf36c1613a88735f7dd16c1b42105f2d Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 1 Dec 2020 12:37:52 -0700 Subject: [PATCH 180/503] perllocale: Remove stray markup --- pod/perllocale.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perllocale.pod b/pod/perllocale.pod index f2c5206fc3a2..8354fe222a11 100644 --- a/pod/perllocale.pod +++ b/pod/perllocale.pod @@ -543,7 +543,7 @@ C<-Accflags='-DUSE_THREAD_SAFE_LOCALE'> to F. The initial program is started up using the locale specified from the environment, as currently, described in L. All newly -created threads start with C set to C<"C">>. Each thread may +created threads start with C set to C<"C">. Each thread may use C to query or switch its locale at any time, without affecting any other thread. All locale-dependent operations automatically use their thread's locale. From ceb208fc5f651eb4c4d468b0e309e77011831d38 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 11:16:16 -0700 Subject: [PATCH 181/503] HiRes.xs: Remove unused macro defns --- dist/Time-HiRes/HiRes.pm | 2 +- dist/Time-HiRes/HiRes.xs | 7 ------- 2 files changed, 1 insertion(+), 8 deletions(-) diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index 1183dc9dd789..a7600b27893d 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -50,7 +50,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval stat lstat utime ); -our $VERSION = '1.9765'; +our $VERSION = '1.9766'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index ca81e5a4a351..ec43295e8f2b 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -86,13 +86,6 @@ extern "C" { # undef ITIMER_REALPROF #endif -#ifndef ENV_LOCALE_LOCK -# define ENV_LOCALE_LOCK -#endif -#ifndef ENV_LOCALE_UNLOCK -# define ENV_LOCALE_UNLOCK -#endif - #ifndef TIME_HIRES_CLOCKID_T typedef int clockid_t; #endif From c4f0298e584ffdec51fd94828dbb94caf74446ae Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 17:09:56 -0700 Subject: [PATCH 182/503] Change many-reader mutex API for consistency The API for other mutexes passes the address of the lock, instead of the lock itself. It is less confusing to have the APIs be the same. --- thread.h | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/thread.h b/thread.h index a968a4c7904d..eafb75e6fabf 100644 --- a/thread.h +++ b/thread.h @@ -288,36 +288,37 @@ # define PERL_READ_LOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(&mutex.lock); \ - mutex.readers_count++; \ - MUTEX_UNLOCK(&mutex.lock); \ + MUTEX_LOCK(mutex.lock); \ + (mutex)->readers_count++; \ + MUTEX_UNLOCK(mutex.lock); \ } STMT_END # define PERL_READ_UNLOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(&mutex.lock); \ - mutex.readers_count--; \ - if (mutex.readers_count <= 0) { \ - COND_SIGNAL(&mutex.zero_readers); \ - mutex.readers_count = 0; \ + MUTEX_LOCK(mutex.lock); \ + (mutex)->readers_count--; \ + if ((mutex)->readers_count <= 0) { \ + COND_SIGNAL(mutex.zero_readers); \ + (mutex)->readers_count = 0; \ } \ - MUTEX_UNLOCK(&mutex.lock); \ + MUTEX_UNLOCK(mutex.lock); \ } STMT_END # define PERL_WRITE_LOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(&mutex.lock); \ + MUTEX_LOCK(mutex.lock); \ do { \ - if (mutex.readers_count == 0) \ + if ((mutex)->readers_count == 0) \ break; \ - COND_WAIT(&mutex.zero_readers, &mutex.lock); \ + COND_WAIT(mutex.zero_readers, mutex.lock); \ } \ while (1); \ \ /* Here, the mutex is locked, with no readers */ \ } STMT_END -# define PERL_WRITE_UNLOCK(mutex) MUTEX_UNLOCK(&mutex.lock) +# define PERL_WRITE_UNLOCK(mutex) MUTEX_UNLOCK(mutex.lock) + #endif /* DETACH(t) must only be called while holding t->mutex */ From 72dfa47e497a43e6eecdb2129fa447723802949e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 12:18:30 -0700 Subject: [PATCH 183/503] Add start-up/tear-down for many-reader mutexes These were missed in 5640a370e8b19af74b8ca0b4694464c21a87916b. --- thread.h | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/thread.h b/thread.h index eafb75e6fabf..96430b95e247 100644 --- a/thread.h +++ b/thread.h @@ -319,6 +319,19 @@ # define PERL_WRITE_UNLOCK(mutex) MUTEX_UNLOCK(mutex.lock) +# define PERL_RW_MUTEX_INIT(mutex) \ + STMT_START { \ + MUTEX_INIT(mutex.lock); \ + COND_INIT(mutex.zero_readers); \ + (mutex)->readers_count = 0; \ + } STMT_END + +# define PERL_RW_MUTEX_DESTROY(mutex) \ + STMT_START { \ + COND_DESTROY(mutex.zero_readers); \ + MUTEX_DESTROY(mutex.lock); \ + } STMT_END + #endif /* DETACH(t) must only be called while holding t->mutex */ From 406b185b2ee9b71b8ac74586744008d20f716b5e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Thu, 6 Aug 2020 19:42:08 +0200 Subject: [PATCH 184/503] Raise minimal supported GNU Bison version to 2.5 which added support for named references --- regen_perly.pl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/regen_perly.pl b/regen_perly.pl index 044fd28393cd..0abf93991cf7 100644 --- a/regen_perly.pl +++ b/regen_perly.pl @@ -76,10 +76,10 @@ # Don't change this to add new bison versions without testing that the generated # files actually work :-) Win32 in particular may not like them. :-( -unless ($version =~ /\b(2\.[4567]|3\.[0-7])\b/) { die < Date: Thu, 6 Aug 2020 09:18:15 +0200 Subject: [PATCH 185/503] Use GNU Bison's named references Usage of Bison's named references makes actions little bit easier to read and maintain. --- AUTHORS | 1 + perly.act | 1253 +++++++++++++++++++++++++++-------------------------- perly.h | 13 +- perly.tab | 1169 +++++++++++++++++++++++++------------------------ perly.y | 730 +++++++++++++++---------------- 5 files changed, 1582 insertions(+), 1584 deletions(-) diff --git a/AUTHORS b/AUTHORS index 991d7e903cdf..353c21de4ca8 100644 --- a/AUTHORS +++ b/AUTHORS @@ -175,6 +175,7 @@ Brad Lanam Bradley Dean Bram Brandon Black +Branislav Zahradník Brendan Byrd Brendan O'Dea Breno G. de Oliveira diff --git a/perly.act b/perly.act index bc684e7347de..1004d34e611d 100644 --- a/perly.act +++ b/perly.act @@ -5,8 +5,8 @@ */ case 2: -#line 121 "perly.y" - { +#line 122 "perly.y" + { parser->expect = XSTATE; (yyval.ival) = 0; } @@ -14,8 +14,8 @@ case 2: break; case 3: -#line 126 "perly.y" - { +#line 127 "perly.y" + { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; (yyval.ival) = 0; @@ -24,8 +24,8 @@ case 2: break; case 4: -#line 132 "perly.y" - { +#line 133 "perly.y" + { parser->expect = XTERM; (yyval.ival) = 0; } @@ -33,8 +33,8 @@ case 2: break; case 5: -#line 137 "perly.y" - { +#line 138 "perly.y" + { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; } @@ -42,8 +42,8 @@ case 2: break; case 6: -#line 142 "perly.y" - { +#line 143 "perly.y" + { parser->expect = XBLOCK; (yyval.ival) = 0; } @@ -51,8 +51,8 @@ case 2: break; case 7: -#line 147 "perly.y" - { +#line 148 "perly.y" + { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -63,8 +63,8 @@ case 2: break; case 8: -#line 155 "perly.y" - { +#line 156 "perly.y" + { parser->expect = XSTATE; (yyval.ival) = 0; } @@ -72,8 +72,8 @@ case 2: break; case 9: -#line 160 "perly.y" - { +#line 161 "perly.y" + { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -84,8 +84,8 @@ case 2: break; case 10: -#line 168 "perly.y" - { +#line 169 "perly.y" + { parser->expect = XSTATE; (yyval.ival) = 0; } @@ -93,8 +93,8 @@ case 2: break; case 11: -#line 173 "perly.y" - { +#line 174 "perly.y" + { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -105,8 +105,8 @@ case 2: break; case 12: -#line 181 "perly.y" - { +#line 182 "perly.y" + { parser->expect = XSTATE; (yyval.ival) = 0; } @@ -114,8 +114,8 @@ case 2: break; case 13: -#line 186 "perly.y" - { +#line 187 "perly.y" + { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; } @@ -123,8 +123,8 @@ case 2: break; case 14: -#line 191 "perly.y" - { +#line 192 "perly.y" + { parser->expect = XSTATE; (yyval.ival) = 0; } @@ -132,8 +132,8 @@ case 2: break; case 15: -#line 196 "perly.y" - { +#line 197 "perly.y" + { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; } @@ -141,8 +141,8 @@ case 2: break; case 16: -#line 204 "perly.y" - { if (parser->copline > (line_t)(ps[-3].val.ival)) +#line 205 "perly.y" + { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); } @@ -150,8 +150,8 @@ case 2: break; case 17: -#line 212 "perly.y" - { if (parser->copline > (line_t)(ps[-6].val.ival)) +#line 213 "perly.y" + { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); } @@ -159,15 +159,15 @@ case 2: break; case 18: -#line 219 "perly.y" - { (yyval.ival) = block_start(TRUE); +#line 220 "perly.y" + { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 224 "perly.y" - { if (parser->copline > (line_t)(ps[-3].val.ival)) +#line 225 "perly.y" + { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); } @@ -175,21 +175,21 @@ case 2: break; case 20: -#line 231 "perly.y" - { (yyval.ival) = block_start(FALSE); +#line 232 "perly.y" + { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 237 "perly.y" - { (yyval.opval) = NULL; } +#line 238 "perly.y" + { (yyval.opval) = NULL; } break; case 22: -#line 239 "perly.y" - { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); +#line 240 "perly.y" + { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) PL_hints |= HINT_BLOCK_SCOPE; @@ -198,14 +198,14 @@ case 2: break; case 23: -#line 248 "perly.y" - { (yyval.opval) = NULL; } +#line 249 "perly.y" + { (yyval.opval) = NULL; } break; case 24: -#line 250 "perly.y" - { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); +#line 251 "perly.y" + { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) PL_hints |= HINT_BLOCK_SCOPE; @@ -214,22 +214,22 @@ case 2: break; case 25: -#line 259 "perly.y" - { +#line 260 "perly.y" + { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } break; case 26: -#line 263 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 264 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 267 "perly.y" - { +#line 268 "perly.y" + { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, savepv(SvPVX_const(label)), (ps[0].val.opval)); @@ -239,8 +239,8 @@ case 2: break; case 28: -#line 274 "perly.y" - { +#line 275 "perly.y" + { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, savepv(SvPVX_const(label)), (ps[0].val.opval)); @@ -250,14 +250,14 @@ case 2: break; case 29: -#line 284 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 285 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 286 "perly.y" - { +#line 287 "perly.y" + { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); (yyval.opval) = NULL; @@ -270,8 +270,8 @@ case 2: break; case 31: -#line 298 "perly.y" - { +#line 299 "perly.y" + { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; parser->in_my_stash = NULL; @@ -280,8 +280,8 @@ case 2: break; case 32: -#line 304 "perly.y" - { +#line 305 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST ? newATTRSUB((ps[-4].val.ival), (ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)) @@ -295,8 +295,8 @@ case 2: break; case 33: -#line 319 "perly.y" - { +#line 320 "perly.y" + { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; parser->in_my_stash = NULL; @@ -305,8 +305,8 @@ case 2: break; case 34: -#line 325 "perly.y" - { +#line 326 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST ? newATTRSUB((ps[-3].val.ival), (ps[-4].val.opval), NULL, (ps[-1].val.opval), (ps[0].val.opval)) @@ -320,8 +320,8 @@ case 2: break; case 35: -#line 336 "perly.y" - { +#line 337 "perly.y" + { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) package_version((ps[-2].val.opval)); @@ -331,14 +331,14 @@ case 2: break; case 36: -#line 343 "perly.y" - { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } +#line 344 "perly.y" + { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 345 "perly.y" - { +#line 346 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); parser->parsed_sub = 1; @@ -348,8 +348,8 @@ case 2: break; case 38: -#line 352 "perly.y" - { +#line 353 "perly.y" + { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); parser->copline = (line_t)(ps[-6].val.ival); @@ -358,8 +358,8 @@ case 2: break; case 39: -#line 358 "perly.y" - { +#line 359 "perly.y" + { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); parser->copline = (line_t)(ps[-6].val.ival); @@ -368,8 +368,8 @@ case 2: break; case 40: -#line 364 "perly.y" - { +#line 365 "perly.y" + { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); } @@ -377,20 +377,20 @@ case 2: break; case 41: -#line 369 "perly.y" - { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } +#line 370 "perly.y" + { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 371 "perly.y" - { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } +#line 372 "perly.y" + { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 373 "perly.y" - { +#line 374 "perly.y" + { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, (ps[-4].val.opval), (ps[-1].val.opval), (ps[0].val.opval), (ps[-2].val.ival))); @@ -400,8 +400,8 @@ case 2: break; case 44: -#line 380 "perly.y" - { +#line 381 "perly.y" + { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, (ps[-4].val.opval), (ps[-1].val.opval), (ps[0].val.opval), (ps[-2].val.ival))); @@ -411,20 +411,20 @@ case 2: break; case 45: -#line 387 "perly.y" - { parser->expect = XTERM; } +#line 388 "perly.y" + { parser->expect = XTERM; } break; case 46: -#line 389 "perly.y" - { parser->expect = XTERM; } +#line 390 "perly.y" + { parser->expect = XTERM; } break; case 47: -#line 392 "perly.y" - { +#line 393 "perly.y" + { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, scalar((ps[-6].val.opval)), (ps[0].val.opval), (ps[-2].val.opval), (ps[-3].val.ival)); @@ -442,8 +442,8 @@ case 2: break; case 48: -#line 407 "perly.y" - { +#line 408 "perly.y" + { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); } @@ -451,8 +451,8 @@ case 2: break; case 49: -#line 412 "perly.y" - { +#line 413 "perly.y" + { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-7].val.ival); @@ -461,14 +461,14 @@ case 2: break; case 50: -#line 418 "perly.y" - { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } +#line 419 "perly.y" + { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 420 "perly.y" - { +#line 421 "perly.y" + { (yyval.opval) = block_end( (ps[-7].val.ival), newFOROP(0, @@ -484,8 +484,8 @@ case 2: break; case 52: -#line 433 "perly.y" - { +#line 434 "perly.y" + { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, (ps[-6].val.opval)), @@ -496,8 +496,8 @@ case 2: break; case 53: -#line 441 "perly.y" - { +#line 442 "perly.y" + { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-6].val.ival); @@ -506,8 +506,8 @@ case 2: break; case 54: -#line 447 "perly.y" - { +#line 448 "perly.y" + { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, NULL, (ps[-1].val.opval), (ps[0].val.opval), 0); @@ -516,8 +516,8 @@ case 2: break; case 55: -#line 453 "perly.y" - { +#line 454 "perly.y" + { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { package_version((ps[-3].val.opval)); @@ -527,8 +527,8 @@ case 2: break; case 56: -#line 460 "perly.y" - { +#line 461 "perly.y" + { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, NULL, block_end((ps[-3].val.ival), (ps[-1].val.opval)), NULL, 0); @@ -539,16 +539,16 @@ case 2: break; case 57: -#line 468 "perly.y" - { +#line 469 "perly.y" + { (yyval.opval) = (ps[-1].val.opval); } break; case 58: -#line 472 "perly.y" - { +#line 473 "perly.y" + { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); } @@ -556,8 +556,8 @@ case 2: break; case 59: -#line 477 "perly.y" - { +#line 478 "perly.y" + { (yyval.opval) = NULL; parser->copline = NOLINE; } @@ -565,8 +565,8 @@ case 2: break; case 60: -#line 485 "perly.y" - { OP *list; +#line 486 "perly.y" + { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); list = op_append_elem(OP_LIST, (ps[-1].val.opval), term); @@ -584,84 +584,84 @@ case 2: break; case 61: -#line 502 "perly.y" - { (yyval.opval) = NULL; } +#line 503 "perly.y" + { (yyval.opval) = NULL; } break; case 62: -#line 504 "perly.y" - { (yyval.opval) = op_unscope((ps[-1].val.opval)); } - - break; - - case 63: -#line 509 "perly.y" - { (yyval.opval) = NULL; } +#line 505 "perly.y" + { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 511 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 513 "perly.y" + { (yyval.opval) = NULL; } break; case 65: -#line 513 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } +#line 515 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 515 "perly.y" - { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } +#line 517 "perly.y" + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 517 "perly.y" - { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } +#line 519 "perly.y" + { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 519 "perly.y" - { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } +#line 521 "perly.y" + { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 521 "perly.y" - { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); - parser->copline = (line_t)(ps[-1].val.ival); } +#line 523 "perly.y" + { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 524 "perly.y" - { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } +#line 525 "perly.y" + { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); + parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 529 "perly.y" - { (yyval.opval) = NULL; } +#line 528 "perly.y" + { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 531 "perly.y" - { +#line 533 "perly.y" + { (yyval.opval) = NULL; } + + break; + + case 73: +#line 535 "perly.y" + { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); } break; - case 73: -#line 536 "perly.y" - { parser->copline = (line_t)(ps[-5].val.ival); + case 74: +#line 540 "perly.y" + { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), op_scope((ps[-1].val.opval)), (ps[0].val.opval)); @@ -670,154 +670,154 @@ case 2: break; - case 74: -#line 546 "perly.y" - { (yyval.opval) = NULL; } + case 75: +#line 550 "perly.y" + { (yyval.opval) = NULL; } break; - case 75: -#line 548 "perly.y" - { (yyval.opval) = op_scope((ps[0].val.opval)); } + case 76: +#line 552 "perly.y" + { (yyval.opval) = op_scope((ps[0].val.opval)); } break; - case 76: -#line 553 "perly.y" - { (yyval.ival) = (PL_min_intro_pending && + case 77: +#line 557 "perly.y" + { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } break; - case 77: -#line 559 "perly.y" - { (yyval.opval) = NULL; } + case 78: +#line 563 "perly.y" + { (yyval.opval) = NULL; } break; - case 79: -#line 565 "perly.y" - { YYSTYPE tmplval; + case 80: +#line 569 "perly.y" + { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } break; - case 81: -#line 573 "perly.y" - { (yyval.opval) = invert(scalar((ps[0].val.opval))); } - - break; - case 82: -#line 578 "perly.y" - { (yyval.opval) = (ps[0].val.opval); intro_my(); } +#line 577 "perly.y" + { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: #line 582 "perly.y" - { (yyval.opval) = (ps[0].val.opval); intro_my(); } + { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 585 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 586 "perly.y" + { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 586 "perly.y" - { (yyval.opval) = NULL; } +#line 589 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 86: #line 590 "perly.y" - { (yyval.ival) = start_subparse(FALSE, 0); - SAVEFREESV(PL_compcv); } + { (yyval.opval) = NULL; } break; case 87: -#line 596 "perly.y" - { (yyval.ival) = start_subparse(FALSE, CVf_ANON); +#line 594 "perly.y" + { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 601 "perly.y" - { (yyval.ival) = start_subparse(TRUE, 0); +#line 600 "perly.y" + { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; - case 91: -#line 612 "perly.y" - { (yyval.opval) = NULL; } + case 89: +#line 605 "perly.y" + { (yyval.ival) = start_subparse(TRUE, 0); + SAVEFREESV(PL_compcv); } break; - case 93: -#line 618 "perly.y" - { (yyval.opval) = NULL; } + case 92: +#line 616 "perly.y" + { (yyval.opval) = NULL; } break; case 94: -#line 620 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 622 "perly.y" + { (yyval.opval) = NULL; } break; case 95: -#line 622 "perly.y" - { (yyval.opval) = NULL; } +#line 624 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 627 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 626 "perly.y" + { (yyval.opval) = NULL; } break; case 97: -#line 629 "perly.y" - { (yyval.opval) = NULL; } +#line 631 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 640 "perly.y" - { parser->in_my = 0; (yyval.opval) = NULL; } +#line 633 "perly.y" + { (yyval.opval) = NULL; } break; case 99: -#line 642 "perly.y" - { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } +#line 644 "perly.y" + { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 647 "perly.y" - { (yyval.ival) = '@'; } +#line 646 "perly.y" + { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 649 "perly.y" - { (yyval.ival) = '%'; } +#line 651 "perly.y" + { (yyval.ival) = '@'; } break; case 102: #line 653 "perly.y" - { + { (yyval.ival) = '%'; } + + break; + + case 103: +#line 657 "perly.y" + { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -835,27 +835,27 @@ case 2: break; - case 103: -#line 672 "perly.y" - { (yyval.opval) = NULL; } - - break; - case 104: -#line 674 "perly.y" - { (yyval.opval) = newOP(OP_NULL, 0); } +#line 676 "perly.y" + { (yyval.opval) = NULL; } break; case 105: -#line 676 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 678 "perly.y" + { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 682 "perly.y" - { +#line 680 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } + + break; + + case 107: +#line 686 "perly.y" + { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -918,71 +918,71 @@ case 2: break; - case 107: -#line 747 "perly.y" - { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } - - break; - case 108: -#line 749 "perly.y" - { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } +#line 751 "perly.y" + { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 755 "perly.y" - { (yyval.opval) = (ps[-1].val.opval); } +#line 753 "perly.y" + { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 757 "perly.y" - { - (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); - } +#line 759 "perly.y" + { (yyval.opval) = (ps[-1].val.opval); } break; case 111: #line 761 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { + (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); + } break; case 112: -#line 766 "perly.y" - { (yyval.opval) = NULL; } +#line 765 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 768 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 770 "perly.y" + { (yyval.opval) = NULL; } break; case 114: #line 772 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 774 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 776 "perly.y" + { (yyval.opval) = NULL; } break; case 116: #line 778 "perly.y" - { (yyval.opval) = (ps[-1].val.opval); } + { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 781 "perly.y" - { +#line 782 "perly.y" + { (yyval.opval) = (ps[-1].val.opval); } + + break; + + case 118: +#line 785 "perly.y" + { ENTER; SAVEIV(parser->sig_elems); SAVEIV(parser->sig_optelems); @@ -995,9 +995,9 @@ case 2: break; - case 118: -#line 792 "perly.y" - { + case 119: +#line 796 "perly.y" + { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; OP *check; @@ -1054,21 +1054,21 @@ case 2: break; - case 119: -#line 849 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + case 120: +#line 853 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; - case 120: -#line 850 "perly.y" - { (yyval.opval) = NULL; } + case 121: +#line 854 "perly.y" + { (yyval.opval) = NULL; } break; - case 121: -#line 856 "perly.y" - { + case 122: +#line 860 "perly.y" + { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); (yyval.opval) = block_end((ps[-3].val.ival), (ps[-1].val.opval)); @@ -1076,21 +1076,21 @@ case 2: break; - case 122: -#line 866 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } - - break; - case 123: -#line 867 "perly.y" - { (yyval.opval) = NULL; } +#line 870 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 124: #line 871 "perly.y" - { + { (yyval.opval) = NULL; } + + break; + + case 125: +#line 875 "perly.y" + { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); (yyval.opval) = block_end((ps[-4].val.ival), @@ -1099,58 +1099,58 @@ case 2: break; - case 125: -#line 882 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } - - break; - case 126: -#line 884 "perly.y" - { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } +#line 886 "perly.y" + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 886 "perly.y" - { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } +#line 888 "perly.y" + { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; - case 129: -#line 892 "perly.y" - { (yyval.opval) = (ps[-1].val.opval); } + case 128: +#line 890 "perly.y" + { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 894 "perly.y" - { +#line 896 "perly.y" + { (yyval.opval) = (ps[-1].val.opval); } + + break; + + case 131: +#line 898 "perly.y" + { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); } break; - case 132: -#line 903 "perly.y" - { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, + case 133: +#line 907 "perly.y" + { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } break; - case 133: -#line 907 "perly.y" - { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, + case 134: +#line 911 "perly.y" + { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } break; - case 134: -#line 911 "perly.y" - { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, + case 135: +#line 915 "perly.y" + { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), newMETHOP(OP_METHOD, 0, (ps[-3].val.opval)))); @@ -1158,18 +1158,18 @@ case 2: break; - case 135: -#line 917 "perly.y" - { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, + case 136: +#line 921 "perly.y" + { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); } break; - case 136: -#line 922 "perly.y" - { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, + case 137: +#line 926 "perly.y" + { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), newMETHOP(OP_METHOD, 0, (ps[-2].val.opval)))); @@ -1177,9 +1177,9 @@ case 2: break; - case 137: -#line 928 "perly.y" - { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, + case 138: +#line 932 "perly.y" + { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), newMETHOP(OP_METHOD, 0, (ps[-4].val.opval)))); @@ -1187,97 +1187,97 @@ case 2: break; - case 138: -#line 934 "perly.y" - { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } - - break; - case 139: -#line 936 "perly.y" - { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } +#line 938 "perly.y" + { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 938 "perly.y" - { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } +#line 940 "perly.y" + { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 940 "perly.y" - { SvREFCNT_inc_simple_void(PL_compcv); - (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } +#line 942 "perly.y" + { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 943 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, +#line 944 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); + (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } + + break; + + case 143: +#line 947 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); } break; - case 145: -#line 958 "perly.y" - { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } + case 146: +#line 962 "perly.y" + { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; - case 146: -#line 960 "perly.y" - { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); + case 147: +#line 964 "perly.y" + { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; - case 147: -#line 963 "perly.y" - { (yyval.opval) = newBINOP(OP_AELEM, 0, + case 148: +#line 967 "perly.y" + { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); } break; - case 148: -#line 968 "perly.y" - { (yyval.opval) = newBINOP(OP_AELEM, 0, + case 149: +#line 972 "perly.y" + { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); } break; - case 149: -#line 973 "perly.y" - { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); + case 150: +#line 977 "perly.y" + { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; - case 150: -#line 976 "perly.y" - { (yyval.opval) = newBINOP(OP_HELEM, 0, + case 151: +#line 980 "perly.y" + { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } break; - case 151: -#line 980 "perly.y" - { (yyval.opval) = newBINOP(OP_HELEM, 0, + case 152: +#line 984 "perly.y" + { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } break; - case 152: -#line 984 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + case 153: +#line 988 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; @@ -1285,9 +1285,9 @@ case 2: break; - case 153: -#line 990 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + case 154: +#line 994 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); if (parser->expect == XBLOCK) @@ -1296,9 +1296,9 @@ case 2: break; - case 154: -#line 998 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + case 155: +#line 1002 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); if (parser->expect == XBLOCK) @@ -1307,9 +1307,9 @@ case 2: break; - case 155: -#line 1005 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + case 156: +#line 1009 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; @@ -1317,224 +1317,224 @@ case 2: break; - case 156: -#line 1011 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } - - break; - case 157: -#line 1013 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } +#line 1015 "perly.y" + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1015 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } +#line 1017 "perly.y" + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1020 "perly.y" - { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } +#line 1019 "perly.y" + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1022 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1024 "perly.y" + { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1024 "perly.y" - { if ((ps[-1].val.ival) != OP_REPEAT) - scalar((ps[-2].val.opval)); - (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); - } +#line 1026 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1029 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1028 "perly.y" + { if ((ps[-1].val.ival) != OP_REPEAT) + scalar((ps[-2].val.opval)); + (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); + } break; case 163: -#line 1031 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1033 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1033 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1035 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1035 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1037 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1037 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1039 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1039 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1041 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1041 "perly.y" - { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1043 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1043 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1045 "perly.y" + { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1045 "perly.y" - { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1047 "perly.y" + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1047 "perly.y" - { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1049 "perly.y" + { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1049 "perly.y" - { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1051 "perly.y" + { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: #line 1053 "perly.y" - { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } + { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1055 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1057 "perly.y" + { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1057 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1059 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1059 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1061 "perly.y" + { yyerror("syntax error"); YYERROR; } break; case 177: #line 1063 "perly.y" - { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } + { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1065 "perly.y" - { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1067 "perly.y" + { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: #line 1069 "perly.y" - { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } + { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1071 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } +#line 1073 "perly.y" + { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1073 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1075 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1075 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1077 "perly.y" + { yyerror("syntax error"); YYERROR; } break; case 183: #line 1079 "perly.y" - { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } + { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1081 "perly.y" - { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1083 "perly.y" + { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1086 "perly.y" - { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } +#line 1085 "perly.y" + { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1088 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1090 "perly.y" + { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1091 "perly.y" - { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } +#line 1092 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1093 "perly.y" - { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } +#line 1095 "perly.y" + { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1095 "perly.y" - { (yyval.opval) = newUNOP(OP_POSTINC, 0, - op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } +#line 1097 "perly.y" + { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1098 "perly.y" - { (yyval.opval) = newUNOP(OP_POSTDEC, 0, - op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} +#line 1099 "perly.y" + { (yyval.opval) = newUNOP(OP_POSTINC, 0, + op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1101 "perly.y" - { (yyval.opval) = op_convert_list(OP_JOIN, 0, +#line 1102 "perly.y" + { (yyval.opval) = newUNOP(OP_POSTDEC, 0, + op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} + + break; + + case 192: +#line 1105 "perly.y" + { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, newSVREF(scalar( @@ -1547,157 +1547,157 @@ case 2: break; - case 192: -#line 1112 "perly.y" - { (yyval.opval) = newUNOP(OP_PREINC, 0, - op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } - - break; - case 193: -#line 1115 "perly.y" - { (yyval.opval) = newUNOP(OP_PREDEC, 0, - op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } +#line 1116 "perly.y" + { (yyval.opval) = newUNOP(OP_PREINC, 0, + op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1122 "perly.y" - { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } +#line 1119 "perly.y" + { (yyval.opval) = newUNOP(OP_PREDEC, 0, + op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1124 "perly.y" - { (yyval.opval) = newANONLIST(NULL);} +#line 1126 "perly.y" + { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1126 "perly.y" - { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } +#line 1128 "perly.y" + { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1128 "perly.y" - { (yyval.opval) = newANONHASH(NULL); } +#line 1130 "perly.y" + { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1130 "perly.y" - { SvREFCNT_inc_simple_void(PL_compcv); - (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } +#line 1132 "perly.y" + { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1133 "perly.y" - { SvREFCNT_inc_simple_void(PL_compcv); - (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } +#line 1134 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); + (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1139 "perly.y" - { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} +#line 1137 "perly.y" + { SvREFCNT_inc_simple_void(PL_compcv); + (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1141 "perly.y" - { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} +#line 1143 "perly.y" + { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; - case 206: -#line 1149 "perly.y" - { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } + case 202: +#line 1145 "perly.y" + { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1151 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } +#line 1153 "perly.y" + { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1153 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } +#line 1155 "perly.y" + { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1155 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1157 "perly.y" + { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1157 "perly.y" - { (yyval.opval) = localize((ps[0].val.opval),0); } +#line 1159 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1159 "perly.y" - { (yyval.opval) = sawparens((ps[-1].val.opval)); } +#line 1161 "perly.y" + { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1161 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1163 "perly.y" + { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1163 "perly.y" - { (yyval.opval) = sawparens(newNULLLIST()); } +#line 1165 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1165 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1167 "perly.y" + { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1167 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1169 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1169 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1171 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1171 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1173 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1173 "perly.y" - { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} +#line 1175 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1175 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1177 "perly.y" + { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1177 "perly.y" - { (yyval.opval) = op_prepend_elem(OP_ASLICE, +#line 1179 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } + + break; + + case 221: +#line 1181 "perly.y" + { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, list((ps[-1].val.opval)), @@ -1709,9 +1709,9 @@ case 2: break; - case 221: -#line 1187 "perly.y" - { (yyval.opval) = op_prepend_elem(OP_KVASLICE, + case 222: +#line 1191 "perly.y" + { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, list((ps[-1].val.opval)), @@ -1723,9 +1723,9 @@ case 2: break; - case 222: -#line 1197 "perly.y" - { (yyval.opval) = op_prepend_elem(OP_HSLICE, + case 223: +#line 1201 "perly.y" + { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, list((ps[-2].val.opval)), @@ -1737,9 +1737,9 @@ case 2: break; - case 223: -#line 1207 "perly.y" - { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, + case 224: +#line 1211 "perly.y" + { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, list((ps[-2].val.opval)), @@ -1751,182 +1751,182 @@ case 2: break; - case 224: -#line 1217 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } - - break; - case 225: -#line 1219 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } +#line 1221 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1221 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); - } +#line 1223 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1224 "perly.y" - { - (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); +#line 1225 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1229 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); +#line 1228 "perly.y" + { + (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); } break; case 229: #line 1233 "perly.y" - { (yyval.opval) = newSVREF((ps[-3].val.opval)); } + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); + } break; case 230: -#line 1235 "perly.y" - { (yyval.opval) = newAVREF((ps[-3].val.opval)); } +#line 1237 "perly.y" + { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1237 "perly.y" - { (yyval.opval) = newHVREF((ps[-3].val.opval)); } +#line 1239 "perly.y" + { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1239 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, - scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } +#line 1241 "perly.y" + { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1242 "perly.y" - { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } +#line 1243 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, + scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1244 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); - PL_hints |= HINT_BLOCK_SCOPE; } +#line 1246 "perly.y" + { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1247 "perly.y" - { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } +#line 1248 "perly.y" + { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); + PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1249 "perly.y" - { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } +#line 1251 "perly.y" + { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1251 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), 0); } +#line 1253 "perly.y" + { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1253 "perly.y" - { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } +#line 1255 "perly.y" + { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1255 "perly.y" - { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } +#line 1257 "perly.y" + { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1257 "perly.y" - { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } +#line 1259 "perly.y" + { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1259 "perly.y" - { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } +#line 1261 "perly.y" + { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1261 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } +#line 1263 "perly.y" + { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1263 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } +#line 1265 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1266 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), 0); } +#line 1267 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1268 "perly.y" - { (yyval.opval) = newOP((ps[-2].val.ival), 0);} +#line 1270 "perly.y" + { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1270 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1272 "perly.y" + { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1272 "perly.y" - { (yyval.opval) = (ps[-2].val.opval); } +#line 1274 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1274 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } +#line 1276 "perly.y" + { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1276 "perly.y" - { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) - ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) - : newOP((ps[-2].val.ival), OPf_SPECIAL); } +#line 1278 "perly.y" + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: #line 1280 "perly.y" - { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } + { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) + ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) + : newOP((ps[-2].val.ival), OPf_SPECIAL); } break; case 251: -#line 1282 "perly.y" - { +#line 1284 "perly.y" + { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } + + break; + + case 252: +#line 1286 "perly.y" + { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR && (((PMOP*)(ps[0].val.opval))->op_pmflags & PMf_HAS_CV)) @@ -1939,196 +1939,197 @@ case 2: break; - case 252: -#line 1293 "perly.y" - { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } - - break; - - case 256: -#line 1301 "perly.y" - { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } + case 253: +#line 1297 "perly.y" + { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1303 "perly.y" - { (yyval.opval) = localize((ps[0].val.opval),1); } +#line 1305 "perly.y" + { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1305 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } +#line 1307 "perly.y" + { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1310 "perly.y" - { (yyval.opval) = sawparens((ps[-1].val.opval)); } +#line 1309 "perly.y" + { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1312 "perly.y" - { (yyval.opval) = sawparens(newNULLLIST()); } +#line 1314 "perly.y" + { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1315 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1316 "perly.y" + { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1317 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1319 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1319 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1321 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1324 "perly.y" - { (yyval.opval) = NULL; } +#line 1323 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1326 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1328 "perly.y" + { (yyval.opval) = NULL; } break; case 266: #line 1330 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1332 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1334 "perly.y" + { (yyval.opval) = NULL; } break; case 268: #line 1336 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1338 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1340 "perly.y" + { (yyval.opval) = NULL; } break; case 270: -#line 1344 "perly.y" - { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } +#line 1342 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; - case 278: -#line 1361 "perly.y" - { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } + case 271: +#line 1348 "perly.y" + { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: #line 1365 "perly.y" - { (yyval.opval) = newSVREF((ps[0].val.opval)); } + { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: #line 1369 "perly.y" - { (yyval.opval) = newAVREF((ps[0].val.opval)); - if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); - } + { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1375 "perly.y" - { (yyval.opval) = newHVREF((ps[0].val.opval)); +#line 1373 "perly.y" + { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } break; case 282: -#line 1381 "perly.y" - { (yyval.opval) = newAVREF((ps[0].val.opval)); } +#line 1379 "perly.y" + { (yyval.opval) = newHVREF((ps[0].val.opval)); + if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); + } break; case 283: -#line 1383 "perly.y" - { (yyval.opval) = newAVREF((ps[-3].val.opval)); } +#line 1385 "perly.y" + { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: #line 1387 "perly.y" - { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } + { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; - case 286: -#line 1392 "perly.y" - { (yyval.opval) = newAVREF((ps[-2].val.opval)); } + case 285: +#line 1391 "perly.y" + { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; - case 288: -#line 1397 "perly.y" - { (yyval.opval) = newHVREF((ps[-2].val.opval)); } + case 287: +#line 1396 "perly.y" + { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; - case 290: -#line 1402 "perly.y" - { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } + case 289: +#line 1401 "perly.y" + { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1407 "perly.y" - { (yyval.opval) = scalar((ps[0].val.opval)); } +#line 1406 "perly.y" + { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1409 "perly.y" - { (yyval.opval) = scalar((ps[0].val.opval)); } +#line 1411 "perly.y" + { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1411 "perly.y" - { (yyval.opval) = op_scope((ps[0].val.opval)); } +#line 1413 "perly.y" + { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1414 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1415 "perly.y" + { (yyval.opval) = op_scope((ps[0].val.opval)); } break; + case 295: +#line 1418 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } + + break; + + default: break; /* Generated from: - * f83d884147747f2d8f5a62eebc4ccd07d71b6b34e5ba1a8d7559526ad864dc97 perly.y - * 01ce33b49f9f04b8d3112b7f042cde113a7d29763a846e870f9766072a5bc614 regen_perly.pl + * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 0cbbf3b33618..1bc9d6332508 100644 --- a/perly.h +++ b/perly.h @@ -4,14 +4,14 @@ Any changes made here will be lost! */ -#define PERL_BISON_VERSION 30003 +#define PERL_BISON_VERSION 30005 #ifdef PERL_CORE -/* A Bison parser, made by GNU Bison 3.3.2. */ +/* A Bison parser, made by GNU Bison 3.5.1. */ /* Bison interface for Yacc-like parsers in C - Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2019 Free Software Foundation, + Copyright (C) 1984, 1989-1990, 2000-2015, 2018-2020 Free Software Foundation, Inc. This program is free software: you can redistribute it and/or modify @@ -172,7 +172,6 @@ S_is_opval_token(int type) { #endif /* PERL_IN_TOKE_C */ #endif /* PERL_CORE */ #if ! defined YYSTYPE && ! defined YYSTYPE_IS_DECLARED - union YYSTYPE { @@ -182,8 +181,8 @@ union YYSTYPE OP *opval; GV *gvval; -}; +}; typedef union YYSTYPE YYSTYPE; # define YYSTYPE_IS_TRIVIAL 1 # define YYSTYPE_IS_DECLARED 1 @@ -195,6 +194,6 @@ int yyparse (void); /* Generated from: - * f83d884147747f2d8f5a62eebc4ccd07d71b6b34e5ba1a8d7559526ad864dc97 perly.y - * 01ce33b49f9f04b8d3112b7f042cde113a7d29763a846e870f9766072a5bc614 regen_perly.pl + * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 0154f4431ac4..42ac1f6a5735 100644 --- a/perly.tab +++ b/perly.tab @@ -6,28 +6,29 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3348 +#define YYLAST 3303 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 /* YYNNTS -- Number of nonterminals. */ -#define YYNNTS 96 +#define YYNNTS 97 /* YYNRULES -- Number of rules. */ -#define YYNRULES 294 +#define YYNRULES 295 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 572 +#define YYNSTATES 573 #define YYUNDEFTOK 2 #define YYMAXUTOK 344 + /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM as returned by yylex, with out-of-bounds checking. */ #define YYTRANSLATE(YYX) \ - ((unsigned) (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) + (0 <= (YYX) && (YYX) <= YYMAXUTOK ? yytranslate[YYX] : YYUNDEFTOK) /* YYTRANSLATE[TOKEN-NUM] -- Symbol number corresponding to TOKEN-NUM as returned by yylex. */ -static const yytype_uint8 yytranslate[] = +static const yytype_int8 yytranslate[] = { 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -68,38 +69,38 @@ static const yytype_uint8 yytranslate[] = #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ -static const yytype_uint16 yyrline[] = +static const yytype_int16 yyrline[] = { - 0, 121, 121, 120, 132, 131, 142, 141, 155, 154, - 168, 167, 181, 180, 191, 190, 203, 211, 219, 223, - 231, 237, 238, 248, 249, 258, 262, 266, 273, 283, - 285, 298, 295, 319, 314, 335, 343, 342, 351, 357, - 363, 368, 370, 372, 379, 387, 389, 386, 406, 411, - 418, 417, 432, 440, 446, 453, 452, 467, 471, 476, - 484, 502, 503, 508, 510, 512, 514, 516, 518, 520, - 523, 529, 530, 535, 546, 547, 553, 559, 560, 565, - 568, 572, 577, 581, 585, 586, 590, 596, 601, 606, - 607, 612, 613, 618, 619, 621, 626, 628, 640, 641, - 646, 648, 652, 672, 673, 675, 681, 746, 748, 754, - 756, 760, 766, 767, 772, 773, 777, 781, 781, 849, - 850, 855, 866, 867, 870, 881, 883, 885, 887, 891, - 893, 898, 902, 906, 910, 916, 921, 927, 933, 935, - 937, 940, 939, 950, 951, 955, 959, 962, 967, 972, - 975, 979, 983, 989, 997, 1004, 1010, 1012, 1014, 1019, - 1021, 1023, 1028, 1030, 1032, 1034, 1036, 1038, 1040, 1042, - 1044, 1046, 1048, 1052, 1054, 1056, 1058, 1062, 1064, 1068, - 1070, 1072, 1074, 1078, 1080, 1085, 1087, 1090, 1092, 1094, - 1097, 1100, 1111, 1114, 1121, 1123, 1125, 1127, 1129, 1132, - 1138, 1140, 1144, 1145, 1146, 1147, 1148, 1150, 1152, 1154, - 1156, 1158, 1160, 1162, 1164, 1166, 1168, 1170, 1172, 1174, - 1176, 1186, 1196, 1206, 1216, 1218, 1220, 1223, 1228, 1232, - 1234, 1236, 1238, 1241, 1243, 1246, 1248, 1250, 1252, 1254, - 1256, 1258, 1260, 1262, 1265, 1267, 1269, 1271, 1273, 1275, - 1279, 1282, 1281, 1294, 1295, 1296, 1300, 1302, 1304, 1309, - 1311, 1314, 1316, 1318, 1323, 1325, 1330, 1331, 1336, 1337, - 1343, 1347, 1348, 1349, 1352, 1353, 1356, 1357, 1360, 1364, - 1368, 1374, 1380, 1382, 1386, 1390, 1391, 1395, 1396, 1400, - 1401, 1406, 1408, 1410, 1413 + 0, 122, 122, 121, 133, 132, 143, 142, 156, 155, + 169, 168, 182, 181, 192, 191, 204, 212, 220, 224, + 232, 238, 239, 249, 250, 259, 263, 267, 274, 284, + 286, 299, 296, 320, 315, 336, 344, 343, 352, 358, + 364, 369, 371, 373, 380, 388, 390, 387, 407, 412, + 419, 418, 433, 441, 447, 454, 453, 468, 472, 477, + 485, 503, 504, 508, 512, 514, 516, 518, 520, 522, + 524, 527, 533, 534, 539, 550, 551, 557, 563, 564, + 569, 572, 576, 581, 585, 589, 590, 594, 600, 605, + 610, 611, 616, 617, 622, 623, 625, 630, 632, 644, + 645, 650, 652, 656, 676, 677, 679, 685, 750, 752, + 758, 760, 764, 770, 771, 776, 777, 781, 785, 785, + 853, 854, 859, 870, 871, 874, 885, 887, 889, 891, + 895, 897, 902, 906, 910, 914, 920, 925, 931, 937, + 939, 941, 944, 943, 954, 955, 959, 963, 966, 971, + 976, 979, 983, 987, 993, 1001, 1008, 1014, 1016, 1018, + 1023, 1025, 1027, 1032, 1034, 1036, 1038, 1040, 1042, 1044, + 1046, 1048, 1050, 1052, 1056, 1058, 1060, 1062, 1066, 1068, + 1072, 1074, 1076, 1078, 1082, 1084, 1089, 1091, 1094, 1096, + 1098, 1101, 1104, 1115, 1118, 1125, 1127, 1129, 1131, 1133, + 1136, 1142, 1144, 1148, 1149, 1150, 1151, 1152, 1154, 1156, + 1158, 1160, 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, + 1178, 1180, 1190, 1200, 1210, 1220, 1222, 1224, 1227, 1232, + 1236, 1238, 1240, 1242, 1245, 1247, 1250, 1252, 1254, 1256, + 1258, 1260, 1262, 1264, 1266, 1269, 1271, 1273, 1275, 1277, + 1279, 1283, 1286, 1285, 1298, 1299, 1300, 1304, 1306, 1308, + 1313, 1315, 1318, 1320, 1322, 1327, 1329, 1334, 1335, 1340, + 1341, 1347, 1351, 1352, 1353, 1356, 1357, 1360, 1361, 1364, + 1368, 1372, 1378, 1384, 1386, 1390, 1394, 1395, 1399, 1400, + 1404, 1405, 1410, 1412, 1414, 1417 }; #endif @@ -127,10 +128,10 @@ static const char *const yytname[] = "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", - "$@12", "@13", "$@14", "formline", "formarg", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", + "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", + "formname", "startsub", "startanonsub", "startformsub", "subname", + "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", @@ -146,7 +147,7 @@ static const char *const yytname[] = # ifdef YYPRINT /* YYTOKNUM[NUM] -- (External) token number corresponding to the (internal) symbol number NUM (which must be that of a token). */ -static const yytype_uint16 yytoknum[] = +static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, 123, 125, 91, 93, 45, 43, 64, 37, 38, 61, @@ -163,173 +164,173 @@ static const yytype_uint16 yytoknum[] = }; # endif -#define YYPACT_NINF -485 +#define YYPACT_NINF (-456) -#define yypact_value_is_default(Yystate) \ - (!!((Yystate) == (-485))) +#define yypact_value_is_default(Yyn) \ + ((Yyn) == YYPACT_NINF) -#define YYTABLE_NINF -290 +#define YYTABLE_NINF (-291) -#define yytable_value_is_error(Yytable_value) \ - (!!((Yytable_value) == (-290))) +#define yytable_value_is_error(Yyn) \ + ((Yyn) == YYTABLE_NINF) /* YYPACT[STATE-NUM] -- Index in YYTABLE of the portion describing STATE-NUM. */ static const yytype_int16 yypact[] = { - 739, -485, -485, -485, -485, -485, -485, -485, 28, -485, - 2976, 32, 1582, 1481, -485, -485, -485, -485, 2085, 2976, - 2976, 6, 6, 6, -485, 6, 6, -485, -485, 50, - -31, -485, 2976, -485, -485, -485, -485, 2976, -13, 20, - -33, 1986, 1885, 6, 1986, 2184, 4, 2976, 83, 2976, - 2976, 2976, 2976, 2976, 2976, 2976, 2283, 6, 6, 41, - -7, -485, 14, -485, -34, -1, -20, 22, -485, -485, - -485, 3151, -485, -485, 29, 56, 95, 102, -485, 153, - 247, 254, 157, -485, -485, -485, -485, -485, 4, 4, - 132, -485, 79, 100, 119, 130, 174, 146, 154, 32, - 152, -485, 217, -485, 160, 1984, 1481, -485, -485, -485, - 672, -485, 30, 774, -485, 111, 142, 142, -485, -485, - -485, -485, -485, -485, -485, 2976, 172, 207, 2976, 176, - 430, 32, 261, 216, 3151, 202, 2382, 2976, 1885, -485, - 430, 572, -7, -485, 476, 2976, -485, -485, 430, 299, - 197, -485, -485, 2976, 430, 3075, 2481, 242, -485, -485, - -485, 430, -7, 142, 142, 142, 57, 57, 306, 267, - -485, -485, 2976, 2976, 2976, 2976, 2976, 2976, 2580, -485, - -485, 2976, -485, -485, 2976, 2976, 2976, 2976, 2976, 2976, - 2976, 2976, 2976, 2976, 2976, 2976, 2976, 2976, 2976, 2976, - 2976, 2976, -485, -485, -485, 75, 2679, 2976, 2976, 2976, - 2976, 2976, 2976, 2976, -485, 307, -485, -485, 311, -485, - -485, -485, -485, -485, 224, 36, -485, -485, 226, -485, - -485, -485, -485, 32, -485, -485, 2976, 2976, 2976, 2976, - 2976, 2976, -485, -485, -485, -485, -485, 320, 320, -485, - -485, -485, 273, -485, -485, -485, 2976, 2976, 118, -485, - -485, -485, 216, 330, -485, -485, -485, 331, 284, 260, - 2976, -7, -485, 348, -485, 2778, 142, 242, 33, 55, - 67, -485, 342, 344, -485, 2976, 357, 294, 294, -485, - 3151, 249, 133, -485, 433, 430, 363, 3243, 504, 329, - 3151, 3105, 1667, 1667, 1767, 1867, 538, 363, 363, 430, - 430, 301, 142, 142, 2976, 2976, 271, 272, 274, -485, - 278, 2877, 23, 279, 270, -485, -485, 470, 253, 136, - 302, 158, 364, 162, 407, 875, -485, 372, -485, -485, - 1, 375, 2976, 2976, 2976, 2976, -485, 292, -485, -485, - 305, -485, -485, -485, -485, 1683, 34, -485, 2976, 2976, - -485, 41, -485, 41, 41, 41, 41, 41, -485, 332, - 332, 30, 308, -39, -485, 2976, -485, -485, 309, -485, - -485, -485, -485, 512, -485, 5, 516, -485, -485, -485, - 178, 2976, 416, -485, -485, 2976, 418, 193, -485, -485, - -485, -485, -485, 519, -485, -485, 2976, -485, 436, -485, - 438, -485, 440, -485, 447, -485, -485, -485, 261, 216, - -485, -485, 439, 353, 41, 358, 368, 41, 369, 356, - -485, -485, -485, -485, 374, 373, 401, -485, 2976, 381, - 387, 2976, -485, -485, -485, -485, 2976, 423, -485, 489, - -485, -485, 490, -485, -485, 19, -485, 239, -485, 3197, - 492, -485, -485, 398, -485, -485, -485, -485, 397, 216, - 404, -485, 2976, -485, -485, 496, 496, 2976, 2976, 496, - -485, 406, 408, 496, 496, 3151, 41, -485, -485, 410, - -485, -485, -485, -485, 445, 414, -485, -485, -485, -485, - 420, 496, 496, -485, 37, 37, 434, 435, 217, 2976, - 2976, 496, -485, -485, 976, -485, 1077, -485, -485, -485, - -485, 1178, -485, 217, 217, -485, 496, 442, -485, -485, - 496, 496, -485, 437, 449, 217, -485, -485, -10, -485, - -485, -485, 1279, -485, 2976, 217, 217, -485, 496, -485, - 472, 531, -485, -485, 465, -485, -485, -485, 217, -485, - -485, -485, 496, 1784, -485, 1380, 37, 467, -485, -485, - 496, -485 + 842, -456, -456, -456, -456, -456, -456, -456, 57, -456, + 2977, 17, 1583, 1482, -456, -456, -456, -456, 2086, 2977, + 2977, 5, 5, 5, -456, 5, 5, -456, -456, 50, + -13, -456, 2977, -456, -456, -456, -456, 2977, -7, 32, + -24, 1987, 1886, 5, 1987, 2185, 4, 2977, 0, 2977, + 2977, 2977, 2977, 2977, 2977, 2977, 2284, 5, 5, -11, + -10, -456, -1, -456, -41, 52, -43, 64, -456, -456, + -456, 3106, -456, -456, 60, 72, 89, 230, -456, 176, + 318, 359, 216, -456, -456, -456, -456, -456, 4, 4, + 157, -456, 100, 134, 140, 150, 272, 169, 172, 17, + 148, -456, 217, -456, 175, 437, 1482, -456, -456, -456, + 673, -456, 16, 775, -456, 55, -30, -30, -456, -456, + -456, -456, -456, -456, -456, 2977, 201, 236, 2977, 209, + 431, 17, 292, 251, 3106, 237, 2383, 2977, 1886, -456, + 431, 573, -10, -456, 477, 2977, -456, -456, 431, 331, + 197, -456, -456, 2977, 431, 3076, 2482, 278, -456, -456, + -456, 431, -10, -30, -30, -30, 58, 58, 341, 313, + -456, -456, 2977, 2977, 2977, 2977, 2977, 2977, 2581, -456, + -456, 2977, -456, -456, 2977, 2977, 2977, 2977, 2977, 2977, + 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, + 2977, 2977, -456, -456, -456, 75, 2680, 2977, 2977, 2977, + 2977, 2977, 2977, 2977, -456, 340, -456, -456, 344, -456, + -456, -456, -456, -456, 270, 36, -456, -456, 267, -456, + -456, -456, -456, 17, -456, -456, 2977, 2977, 2977, 2977, + 2977, 2977, -456, -456, -456, -456, -456, 352, 352, -456, + -456, -456, 300, -456, -456, -456, 2977, 2977, 111, -456, + -456, -456, 251, 358, -456, -456, -456, 379, 309, 281, + 2977, -10, -456, 391, -456, 2779, -30, 278, 67, 105, + 256, -456, 440, 377, -456, 2977, 396, 333, 333, -456, + 3106, 204, 114, -456, 471, 431, 1929, 3198, 652, 301, + 3106, 360, 1668, 1668, 1768, 1868, 539, 1929, 1929, 431, + 431, 659, -30, -30, 2977, 2977, 303, 305, 307, -456, + 308, 2878, 2, 310, 302, -456, -456, 513, 299, 133, + 320, 136, 390, 158, 419, 876, -456, 404, -456, -456, + -3, 405, 2977, 2977, 2977, 2977, -456, 316, -456, -456, + 322, -456, -456, -456, -456, 1684, 27, -456, 2977, 2977, + -456, -456, -11, -456, -11, -456, -456, -456, -456, -456, + 349, 349, 16, 327, -35, -456, 2977, -456, -456, 328, + -456, -456, -456, -456, 517, -456, 109, 520, -456, -456, + -456, 168, 2977, 423, -456, -456, 2977, 434, 183, -456, + -456, -456, -456, -456, 530, -456, -456, 2977, -456, 426, + -456, 427, -456, 429, -456, 447, -456, -456, -456, 292, + 251, -456, -456, 439, 363, -11, 367, 369, -11, 370, + 371, -456, -456, -456, -456, 378, 386, 280, -456, 2977, + 394, 395, 2977, -456, -456, -456, -456, 2977, 449, -456, + 498, -456, -456, 519, -456, -456, 194, -456, 242, -456, + 3152, 521, -456, -456, 435, -456, -456, -456, -456, 432, + 251, 436, -456, 2977, -456, -456, 542, 542, 2977, 2977, + 542, -456, 465, 450, 542, 542, 3106, -11, -456, -456, + 468, -456, -456, -456, -456, 503, 470, -456, -456, -456, + -456, 476, 542, 542, -456, 43, 43, 481, 486, 217, + 2977, 2977, 542, -456, -456, 977, -456, 1078, -456, -456, + -456, -456, 1179, -456, 217, 217, -456, 542, 492, -456, + -456, 542, 542, -456, 494, 497, 217, -456, -456, 18, + -456, -456, -456, 1280, -456, 2977, 217, 217, -456, 542, + -456, 533, 585, -456, -456, 504, -456, -456, -456, 217, + -456, -456, -456, 542, 1785, -456, 1381, 43, 505, -456, + -456, 542, -456 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. Performed when YYTABLE does not specify something else to do. Zero means the default is an error. */ -static const yytype_uint16 yydefact[] = +static const yytype_int16 yydefact[] = { 0, 2, 4, 6, 8, 10, 12, 14, 0, 18, - 266, 0, 0, 0, 21, 117, 1, 21, 0, 0, - 0, 0, 0, 0, 253, 0, 0, 224, 251, 212, - 246, 248, 242, 87, 255, 87, 87, 234, 244, 0, - 0, 237, 264, 0, 0, 0, 0, 0, 0, 240, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 267, - 128, 254, 219, 202, 164, 173, 165, 179, 203, 204, - 205, 131, 209, 5, 225, 214, 217, 216, 218, 215, - 0, 0, 0, 18, 7, 63, 29, 88, 0, 0, - 0, 86, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 59, 74, 9, 0, 64, 0, 11, 26, 25, - 0, 15, 112, 0, 195, 0, 185, 186, 291, 294, - 293, 292, 280, 281, 278, 264, 0, 0, 0, 0, - 243, 0, 91, 93, 235, 0, 0, 266, 266, 238, - 239, 291, 265, 138, 292, 0, 282, 201, 200, 0, - 0, 89, 90, 264, 210, 0, 0, 257, 261, 263, - 262, 241, 236, 187, 188, 207, 192, 193, 213, 0, - 279, 284, 0, 0, 0, 129, 0, 0, 0, 176, - 175, 0, 182, 181, 0, 0, 0, 0, 0, 0, + 267, 0, 0, 0, 21, 118, 1, 21, 0, 0, + 0, 0, 0, 0, 254, 0, 0, 225, 252, 213, + 247, 249, 243, 88, 256, 88, 88, 235, 245, 0, + 0, 238, 265, 0, 0, 0, 0, 0, 0, 241, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 268, + 129, 255, 220, 203, 165, 174, 166, 180, 204, 205, + 206, 132, 210, 5, 226, 215, 218, 217, 219, 216, + 0, 0, 0, 18, 7, 64, 29, 89, 0, 0, + 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 59, 75, 9, 0, 65, 0, 11, 26, 25, + 0, 15, 113, 0, 196, 0, 186, 187, 292, 295, + 294, 293, 281, 282, 279, 265, 0, 0, 0, 0, + 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, + 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, + 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, + 263, 242, 237, 188, 189, 208, 193, 194, 214, 0, + 280, 285, 0, 0, 0, 130, 0, 0, 0, 177, + 176, 0, 183, 182, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 189, 190, 191, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 21, 85, 86, 86, 0, 36, + 0, 0, 190, 191, 192, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 21, 86, 87, 87, 0, 36, 18, 18, 18, 18, 18, 0, 18, 18, 0, 18, 18, 42, 58, 0, 54, 57, 0, 0, 0, 0, - 0, 0, 28, 27, 22, 100, 101, 98, 98, 108, - 107, 111, 113, 118, 194, 136, 266, 0, 0, 247, - 141, 92, 93, 95, 18, 245, 249, 0, 0, 0, - 0, 132, 197, 0, 228, 0, 208, 0, 214, 217, - 216, 260, 0, 97, 256, 0, 211, 126, 127, 125, - 130, 0, 0, 155, 0, 178, 184, 168, 161, 162, - 159, 0, 170, 171, 169, 167, 166, 183, 180, 177, - 174, 163, 172, 160, 0, 0, 286, 288, 0, 143, - 0, 0, 0, 290, 135, 144, 226, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 84, 0, 31, 33, - 0, 0, 79, 0, 0, 0, 276, 0, 277, 274, - 0, 275, 271, 272, 273, 0, 0, 18, 0, 0, - 75, 67, 68, 81, 65, 66, 69, 70, 99, 103, - 103, 109, 0, 268, 157, 264, 18, 94, 114, 199, - 250, 140, 139, 0, 196, 213, 0, 258, 259, 96, - 0, 0, 0, 148, 154, 0, 0, 0, 230, 231, - 232, 283, 152, 0, 229, 233, 266, 227, 0, 146, - 0, 220, 0, 221, 0, 16, 18, 30, 91, 93, - 18, 35, 0, 0, 80, 0, 0, 82, 0, 0, - 270, 18, 78, 83, 0, 0, 64, 50, 0, 0, - 0, 104, 106, 102, 110, 137, 0, 0, 142, 0, - 198, 117, 0, 115, 133, 211, 158, 0, 151, 206, - 0, 147, 153, 0, 149, 222, 223, 145, 0, 93, - 18, 55, 264, 76, 76, 0, 0, 0, 0, 0, - 45, 0, 0, 0, 0, 105, 269, 252, 21, 0, - 21, 156, 150, 134, 0, 18, 123, 34, 122, 21, - 0, 0, 0, 20, 71, 71, 0, 0, 74, 79, - 0, 0, 40, 41, 0, 116, 0, 23, 120, 32, - 119, 0, 37, 74, 74, 21, 0, 0, 38, 39, - 0, 0, 53, 0, 0, 74, 121, 124, 0, 56, - 43, 44, 0, 72, 0, 74, 74, 46, 0, 49, - 61, 0, 24, 19, 0, 48, 52, 76, 74, 21, - 60, 17, 0, 0, 51, 0, 71, 0, 62, 73, - 0, 47 + 0, 0, 28, 27, 22, 101, 102, 99, 99, 109, + 108, 112, 114, 119, 195, 137, 267, 0, 0, 248, + 142, 93, 94, 96, 18, 246, 250, 0, 0, 0, + 0, 133, 198, 0, 229, 0, 209, 0, 215, 218, + 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, + 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, + 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, + 175, 164, 173, 161, 0, 0, 287, 289, 0, 144, + 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, + 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, + 0, 276, 272, 273, 274, 0, 0, 18, 0, 0, + 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, + 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, + 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, + 97, 0, 0, 0, 149, 155, 0, 0, 0, 231, + 232, 233, 284, 153, 0, 230, 234, 267, 228, 0, + 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, + 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, + 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, + 0, 0, 105, 107, 103, 111, 138, 0, 0, 143, + 0, 199, 118, 0, 116, 134, 212, 159, 0, 152, + 207, 0, 148, 154, 0, 150, 223, 224, 146, 0, + 94, 18, 55, 265, 77, 77, 0, 0, 0, 0, + 0, 45, 0, 0, 0, 0, 106, 270, 253, 21, + 0, 21, 157, 151, 135, 0, 18, 124, 34, 123, + 21, 0, 0, 0, 20, 72, 72, 0, 0, 75, + 80, 0, 0, 40, 41, 0, 117, 0, 23, 121, + 32, 120, 0, 37, 75, 75, 21, 0, 0, 38, + 39, 0, 0, 53, 0, 0, 75, 122, 125, 0, + 56, 43, 44, 0, 73, 0, 75, 75, 46, 0, + 49, 61, 0, 24, 19, 0, 48, 52, 77, 75, + 21, 60, 17, 0, 0, 51, 0, 72, 0, 62, + 74, 0, 47 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -485, -485, -485, -485, -485, -485, -485, -485, -485, 298, - -485, -5, -109, -485, -17, -485, 561, 471, 0, -485, - -485, -485, -485, -485, -485, -485, -485, -485, -340, -484, - -159, -456, -485, 74, 243, -336, 39, -485, -44, 143, - -485, 161, 173, -242, 324, 362, -485, -485, 234, -485, - 240, -485, -485, -485, -485, 168, -485, -485, 110, -485, - 165, -8, -37, -485, -485, -485, -485, -485, -485, -485, - -485, -485, -485, -485, -485, 103, -485, -485, 457, -124, - -130, -485, -485, 257, -485, -485, 399, 38, -45, -42, - -485, -485, -485, -485, -485, 13 + -456, -456, -456, -456, -456, -456, -456, -456, -456, 228, + -456, -5, -139, -456, -17, -456, 596, 506, 12, -456, + -456, -456, -456, -456, -456, -456, -456, -456, 266, -341, + -448, -192, -455, -456, 104, 277, -337, 49, -456, -44, + 159, -456, 149, 202, -243, 348, 389, -456, -456, 268, + -456, 273, -456, -456, -456, -456, 188, -456, -456, 152, + -456, 181, -8, -37, -456, -456, -456, -456, -456, -456, + -456, -456, -456, -456, -456, -456, 103, -456, -456, 491, + -124, -97, -456, -456, 312, -456, -456, 444, 38, -45, + -42, -456, -456, -456, -456, -456, 13 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int16 yydefgoto[] = { -1, 8, 9, 10, 11, 12, 13, 14, 15, 102, - 417, 378, 504, 525, 110, 538, 244, 108, 109, 418, - 419, 341, 509, 557, 481, 499, 552, 560, 104, 528, - 234, 501, 433, 423, 362, 426, 435, 337, 219, 131, - 215, 153, 262, 264, 284, 369, 248, 249, 442, 250, - 251, 252, 253, 452, 453, 111, 112, 519, 450, 497, - 379, 105, 60, 61, 375, 324, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 71, 127, 72, 157, 143, - 73, 447, 429, 349, 350, 227, 74, 75, 76, 77, - 78, 79, 80, 81, 82, 170 + 418, 379, 505, 526, 110, 539, 244, 108, 109, 419, + 420, 341, 510, 558, 482, 500, 553, 561, 361, 104, + 529, 234, 502, 434, 424, 363, 427, 436, 337, 219, + 131, 215, 153, 262, 264, 284, 370, 248, 249, 443, + 250, 251, 252, 253, 453, 454, 111, 112, 520, 451, + 498, 380, 105, 60, 61, 376, 324, 62, 63, 64, + 65, 66, 67, 68, 69, 70, 71, 127, 72, 157, + 143, 73, 448, 430, 349, 350, 227, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 170 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If @@ -337,105 +338,95 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 268, 269, 428, - 115, 420, 103, 162, 550, 432, 83, 285, 502, 434, - 376, 529, 439, 440, 176, 151, 177, 118, 16, 274, - 152, 391, 119, 83, 122, 123, 124, 150, 125, 126, - 137, 175, 83, 207, 118, 208, 245, 246, 169, 119, - 21, 22, 21, 22, 23, 145, 146, 179, 180, 121, - 121, 121, 128, 121, 121, -285, 207, -285, 208, 182, - 183, 171, 446, 175, 138, -260, 129, -287, 214, -287, - 144, 121, 569, 526, 527, 314, 158, 315, 142, -259, - 181, 316, 317, 318, 135, 121, 121, 319, 551, 21, - 22, 563, 482, -261, 348, -285, 243, -285, 271, 421, - 279, 184, -287, 280, -287, 57, 142, 172, 173, 174, - 258, 178, 116, 117, 254, -263, 372, 136, 267, 59, - 59, 374, 57, 404, 228, 130, 206, -262, 320, 247, - 134, 506, 507, 57, 140, 57, 393, 148, 282, 409, - 154, 270, 161, 218, 163, 164, 165, 166, 167, -290, - -290, -290, 205, -289, 287, 288, 289, 213, 291, 292, - 294, 411, 338, 339, 534, 413, 144, 470, 132, 133, - 353, 155, 321, 354, 322, 323, 220, 172, 173, 174, - 156, 456, 57, 278, 172, 173, 174, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 461, 221, 554, 172, + 113, 255, 59, 159, 17, 142, 160, 421, 429, 176, + 115, 177, 83, 162, 433, 83, 21, 22, 435, 377, + 503, 440, 441, 118, 103, 151, 118, 83, 119, 274, + 152, 119, 245, 246, 122, 123, 124, 150, 125, 126, + 268, 269, 551, 21, 22, 175, 182, 183, 169, 137, + 179, 180, 21, 22, 23, 145, 146, 16, 530, 121, + 121, 121, 128, 121, 121, 172, 173, 174, 254, 201, + 175, 171, 202, 203, 204, 205, 447, 207, 214, 208, + 144, 121, 207, 138, 208, 314, 158, 315, 142, 527, + 528, 316, 317, 318, 129, 121, 121, 319, 155, -286, + 135, -286, 483, 564, 348, 422, 178, 156, 271, 57, + 279, 57, 405, 280, 57, -286, 142, -286, 243, 570, + 258, 285, 116, 117, 375, 247, 552, 394, 267, 59, + 59, 172, 173, 174, 228, 130, 57, -262, 320, 136, + 134, 507, 508, 181, 140, 57, 410, 148, 282, 412, + 154, 270, 161, 184, 163, 164, 165, 166, 167, 373, + -291, -291, -291, 205, 287, 288, 289, 206, 291, 292, + 294, 414, 338, 339, 535, -264, 144, 471, 218, -261, + 353, 457, 321, 354, 322, 323, -290, 172, 173, 174, + 172, 173, 174, 278, 132, 133, 462, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 392, 220, 555, 172, 173, 174, 172, 173, 174, 342, 343, 344, 345, 347, - 373, 355, 356, 432, 358, 359, 222, 495, 361, 363, - 364, 365, 366, 367, 172, 173, 174, 223, 172, 173, - 174, 201, 224, 325, 202, 203, 204, 205, 59, 216, - 217, 448, 491, 229, 172, 173, 174, 209, 276, 210, - 232, 230, 383, 352, 211, 233, 212, 386, 235, 172, - 173, 174, 225, 172, 173, 174, 463, 390, 290, 256, - 257, 226, 259, 57, 295, 261, 263, 296, 297, 298, + 374, 355, 356, 433, 358, 359, 213, 496, 362, 364, + 362, 362, 362, 362, 172, 173, 174, 216, 217, 84, + -288, 221, -288, 325, 172, 173, 174, 222, 59, 120, + 120, 120, 449, 120, 120, 492, 232, 223, 276, 172, + 173, 174, 384, 352, -260, 233, -288, 387, -288, 139, + 120, 120, 147, 172, 173, 174, 229, 391, 290, 230, + 172, 173, 174, 235, 295, 120, 120, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 273, 396, 397, 265, 84, - 272, 353, 283, 403, 354, 172, 173, 174, 285, 120, - 120, 120, 346, 120, 120, 172, 173, 174, 336, 172, - 173, 174, 340, 357, 424, 363, 427, 427, 142, 139, - 120, 120, 147, 172, 173, 174, 368, 436, 500, 532, - 427, 427, 438, 371, 377, 120, 120, 392, 381, 384, - 121, 408, 186, 187, 540, 541, 382, 505, 389, 391, - 508, 449, 174, 286, 512, 513, 549, 406, 172, 173, - 174, 398, 399, 457, 400, 430, 555, 556, 401, 405, - 186, 416, 523, 524, 352, 200, 422, 231, 59, 564, - 201, 57, 535, 202, 203, 204, 205, 172, 173, 174, - 410, 468, 431, 441, 445, 471, 451, 543, 172, 173, - 174, 545, 546, 200, 186, 187, 478, 458, 201, 260, - 427, 202, 203, 204, 205, 142, 120, 380, 486, 558, - 172, 173, 174, 236, 237, 238, 239, 464, 388, 465, - 240, 466, 241, 566, 197, 198, 199, 200, 467, 473, - 472, 571, 201, 477, 474, 202, 203, 204, 205, 427, - 427, 514, 412, 516, 475, 476, -214, 172, 173, 174, - 479, 480, 521, 172, 173, 174, 207, 483, 208, -214, - 449, 186, 187, 484, 172, 173, 174, 487, 459, 488, - 490, 424, 427, 492, 493, 494, 503, -82, 542, 172, - 173, 174, 496, 510, 511, 414, 515, 517, -214, -214, - -214, -214, 518, 199, 200, -214, 460, -214, 522, 201, - -214, 360, 202, 203, 204, 205, 427, -214, -214, 394, - 530, 531, 565, 559, 485, 547, 172, 173, 174, 544, - -214, 561, -214, -214, -214, 548, -214, -214, -214, -214, - -214, -214, -214, -214, -214, -214, -214, -214, -214, -214, - -214, 562, -253, 570, 107, -214, 407, 242, -214, -214, - -214, -214, -214, 533, -214, -253, 425, -214, 172, 173, - 174, 469, 172, 173, 174, 172, 173, 174, 200, 186, - 187, 387, 567, 201, 443, 520, 202, 203, 204, 205, - 370, 444, 277, 437, -253, -253, -253, -253, 454, 489, - 120, -253, 455, -253, 351, 462, -253, 195, 196, 197, - 198, 199, 200, -253, -253, 498, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, -253, 0, -253, -253, - -253, 0, -253, -253, -253, -253, -253, -253, -253, -253, - -253, -253, -253, -253, -253, -253, -253, 0, 0, 0, - 0, -253, -13, 85, -253, -253, -253, -253, -253, 0, - -253, 0, 83, -253, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, - 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, - 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 1, 2, 3, 4, 5, 6, 7, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, -3, 85, 0, 0, 0, 56, - 101, 57, 58, 0, 83, 0, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, - 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, - 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 101, 57, 58, 83, 415, 18, 0, 19, + 309, 310, 311, 312, 313, 273, 397, 398, 256, 257, + 464, 353, 393, 404, 354, 259, 261, 533, 172, 173, + 174, 263, 236, 237, 238, 239, -263, 231, 209, 240, + 210, 241, 541, 542, 425, 364, 428, 428, 506, 142, + 224, 509, 272, 265, 550, 513, 514, 437, 283, 501, + 428, 428, 439, 285, 556, 557, 172, 173, 174, 260, + 121, 336, 186, 524, 525, 340, 120, 565, 346, 211, + 225, 212, 450, 536, 357, 172, 173, 174, 369, 226, + 372, 57, 378, 382, 458, 431, -83, 383, 544, 172, + 173, 174, 546, 547, 352, 200, 172, 173, 174, 59, + 201, 390, 385, 202, 203, 204, 205, 409, 392, 407, + 559, 174, 469, 399, 185, 400, 472, 401, 402, 286, + 406, 186, 187, 417, 567, 57, 423, 479, 411, 432, + 442, 428, 572, 446, 459, 452, 142, 465, 466, 487, + 467, 188, 189, 396, 190, 191, 192, 193, 194, 195, + 196, 197, 198, 199, 200, 172, 173, 174, 468, 201, + 473, 360, 202, 203, 204, 205, 172, 173, 174, 474, + 428, 428, 515, 475, 517, 476, 477, -215, 478, 236, + 237, 238, 239, 522, 480, 381, 240, 207, 241, 208, + -215, 450, 186, 187, 481, 172, 173, 174, 413, 460, + 484, 485, 425, 428, 365, 366, 367, 368, 489, 543, + 172, 173, 174, 172, 173, 174, 172, 173, 174, -215, + -215, -215, -215, 488, 199, 200, -215, 415, -215, 491, + 201, -215, 493, 202, 203, 204, 205, 428, -215, -215, + 495, 494, 461, 566, 497, 486, 389, 172, 173, 174, + 120, -215, 504, -215, -215, -215, 512, -215, -215, -215, + -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, + -215, -215, 511, -254, 516, 518, -215, 395, 519, -215, + -215, -215, -215, -215, 523, -215, -254, 531, -215, 172, + 173, 174, 532, 172, 173, 174, 172, 173, 174, 545, + 186, 187, 548, 549, 560, 562, 172, 173, 174, 107, + 563, 571, 242, 568, 534, -254, -254, -254, -254, 408, + 426, 470, -254, 455, -254, 388, 456, -254, 195, 196, + 197, 198, 199, 200, -254, -254, 463, 371, 201, 444, + 490, 202, 203, 204, 205, 445, 277, -254, 521, -254, + -254, -254, 499, -254, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, 438, 351, + 0, 0, -254, -13, 85, -254, -254, -254, -254, -254, + 0, -254, 0, 83, -254, 18, 0, 19, 20, 21, + 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, + 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, + 186, 187, 96, 97, 98, 99, 37, 0, 100, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 200, 0, 0, 0, + 0, 201, 50, 200, 202, 203, 204, 205, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, + 56, 101, 57, 58, 0, 83, 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, + 6, 7, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 83, 536, 18, 0, + 0, 0, 56, 101, 57, 58, 83, 416, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, @@ -455,7 +446,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 101, 57, 58, 83, 539, + 0, 0, 0, 0, 56, 101, 57, 58, 83, 538, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, @@ -466,7 +457,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, 83, - 553, 18, 0, 19, 20, 21, 22, 23, 0, 0, + 540, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, @@ -476,13 +467,13 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 83, 0, 18, 0, 19, 20, 21, 22, 23, 0, + 83, 554, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 568, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, @@ -492,13 +483,13 @@ static const yytype_int16 yytable[] = 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, 83, 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 86, 0, 87, 88, 89, + 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, @@ -506,47 +497,67 @@ static const yytype_int16 yytable[] = 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 101, 57, 58, 0, 0, 18, 0, 19, 20, 21, + 101, 57, 58, 83, 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 186, 187, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 29, 30, 31, 32, 33, 34, 86, 0, 87, 88, + 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, + 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 0, 0, 0, 51, 52, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, -77, 57, 58, 0, 0, 18, 0, 19, 20, + 56, 101, 57, 58, 0, 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 186, 187, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 50, 0, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - -77, 56, 0, 57, 58, 83, 0, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 141, 25, 26, 27, - 28, 119, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 186, 187, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, -78, 57, 58, 0, 0, 18, 0, 19, + 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 50, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 50, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 56, 0, 57, 58, 83, 0, 18, 0, + 0, -78, 56, 0, 57, 58, 83, 0, 18, 0, + 19, 20, 21, 22, 23, 0, 0, 141, 25, 26, + 27, 28, 119, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 50, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 186, 187, 0, 56, 0, 57, 58, 83, 0, 18, + 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 197, 198, 199, 200, 0, 35, 36, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 0, 56, 0, 57, 58, 18, 114, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 236, 237, 238, 239, - 0, 0, 0, 240, 0, 241, 0, 0, 0, 37, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 172, 173, 174, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 0, 57, 58, 18, 114, 19, + 0, 0, 0, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, @@ -556,7 +567,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 56, 0, 57, 58, 18, 0, 19, 20, + 0, 0, 56, 149, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, @@ -566,7 +577,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 0, 56, 149, 57, 58, 18, 0, 19, 20, 21, + 168, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, @@ -575,7 +586,7 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 168, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 266, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, @@ -585,7 +596,7 @@ static const yytype_int16 yytable[] = 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 266, 56, + 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, @@ -595,7 +606,7 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 281, 56, 0, + 0, 54, 55, 0, 0, 0, 0, 293, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, @@ -605,7 +616,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 293, 56, 0, 57, + 54, 55, 0, 0, 0, 0, 326, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, @@ -615,7 +626,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 326, 56, 0, 57, 58, + 55, 0, 0, 0, 0, 386, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, @@ -625,7 +636,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 385, 56, 0, 57, 58, 18, + 0, 0, 0, 0, 403, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, @@ -635,7 +646,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 402, 56, 0, 57, 58, 18, 0, + 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, @@ -643,135 +654,111 @@ static const yytype_int16 yytable[] = 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 185, 0, 0, 0, 0, 0, 0, 186, 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 0, 57, 58, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 185, - 0, 0, 0, 0, 0, 0, 186, 187, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 275, 0, 57, 58, 188, 189, 395, 190, - 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, - 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, - 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 188, 189, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, + 0, 0, 0, 275, 0, 57, 58, 188, 189, 0, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, + 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, - 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, -290, 0, 202, - 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 189, 0, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, -291, 0, 202, 203, 204, 205, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 190, 191, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205 + 0, 0, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 0, 0, 201, 0, 0, + 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 137, 138, 345, - 18, 10, 12, 50, 24, 355, 10, 12, 474, 355, - 262, 505, 358, 359, 10, 21, 12, 21, 0, 153, - 26, 12, 26, 10, 21, 22, 23, 45, 25, 26, - 73, 80, 10, 10, 21, 12, 16, 17, 56, 26, - 16, 17, 16, 17, 18, 42, 43, 91, 92, 21, - 22, 23, 12, 25, 26, 10, 10, 12, 12, 89, - 90, 58, 111, 80, 107, 70, 107, 10, 83, 12, - 42, 43, 566, 46, 47, 10, 48, 12, 125, 70, - 91, 16, 17, 18, 107, 57, 58, 22, 108, 16, - 17, 557, 438, 70, 68, 10, 106, 12, 145, 108, - 155, 89, 10, 155, 12, 109, 153, 76, 77, 78, - 128, 107, 19, 20, 13, 70, 256, 107, 136, 137, - 138, 13, 109, 110, 96, 32, 107, 70, 63, 109, - 37, 477, 478, 109, 41, 109, 13, 44, 156, 13, - 47, 138, 49, 21, 51, 52, 53, 54, 55, 102, - 103, 104, 105, 10, 172, 173, 174, 10, 176, 177, - 178, 13, 216, 217, 510, 13, 138, 419, 35, 36, - 225, 98, 107, 225, 109, 110, 107, 76, 77, 78, - 107, 13, 109, 155, 76, 77, 78, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 13, 107, 544, 76, + 17, 125, 10, 48, 9, 42, 48, 10, 345, 10, + 18, 12, 10, 50, 355, 10, 16, 17, 355, 262, + 475, 358, 359, 21, 12, 21, 21, 10, 26, 153, + 26, 26, 16, 17, 21, 22, 23, 45, 25, 26, + 137, 138, 24, 16, 17, 80, 89, 90, 56, 73, + 91, 92, 16, 17, 18, 42, 43, 0, 506, 21, + 22, 23, 12, 25, 26, 76, 77, 78, 13, 99, + 80, 58, 102, 103, 104, 105, 111, 10, 83, 12, + 42, 43, 10, 107, 12, 10, 48, 12, 125, 46, + 47, 16, 17, 18, 107, 57, 58, 22, 98, 10, + 107, 12, 439, 558, 68, 108, 107, 107, 145, 109, + 155, 109, 110, 155, 109, 10, 153, 12, 106, 567, + 128, 12, 19, 20, 13, 109, 108, 13, 136, 137, + 138, 76, 77, 78, 96, 32, 109, 70, 63, 107, + 37, 478, 479, 91, 41, 109, 13, 44, 156, 13, + 47, 138, 49, 89, 51, 52, 53, 54, 55, 256, + 102, 103, 104, 105, 172, 173, 174, 107, 176, 177, + 178, 13, 216, 217, 511, 70, 138, 420, 21, 70, + 225, 13, 107, 225, 109, 110, 10, 76, 77, 78, + 76, 77, 78, 155, 35, 36, 13, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 12, 107, 545, 76, 77, 78, 76, 77, 78, 220, 221, 222, 223, 224, - 257, 226, 227, 563, 229, 230, 107, 469, 236, 237, - 238, 239, 240, 241, 76, 77, 78, 107, 76, 77, - 78, 99, 68, 205, 102, 103, 104, 105, 256, 88, - 89, 375, 13, 107, 76, 77, 78, 10, 155, 12, - 108, 107, 270, 225, 10, 48, 12, 275, 108, 76, - 77, 78, 98, 76, 77, 78, 406, 285, 175, 107, - 73, 107, 106, 109, 181, 24, 70, 184, 185, 186, + 257, 226, 227, 564, 229, 230, 10, 470, 236, 237, + 238, 239, 240, 241, 76, 77, 78, 88, 89, 11, + 10, 107, 12, 205, 76, 77, 78, 107, 256, 21, + 22, 23, 376, 25, 26, 13, 108, 107, 155, 76, + 77, 78, 270, 225, 70, 48, 10, 275, 12, 41, + 42, 43, 44, 76, 77, 78, 107, 285, 175, 107, + 76, 77, 78, 108, 181, 57, 58, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 108, 314, 315, 106, 11, - 11, 356, 70, 321, 356, 76, 77, 78, 12, 21, - 22, 23, 98, 25, 26, 76, 77, 78, 21, 76, - 77, 78, 21, 107, 342, 343, 344, 345, 375, 41, - 42, 43, 44, 76, 77, 78, 26, 355, 472, 508, - 358, 359, 357, 80, 24, 57, 58, 108, 74, 11, - 322, 108, 61, 62, 523, 524, 106, 476, 24, 12, - 479, 376, 78, 106, 483, 484, 535, 107, 76, 77, - 78, 110, 110, 391, 110, 347, 545, 546, 110, 110, - 61, 19, 501, 502, 356, 94, 21, 99, 406, 558, - 99, 109, 511, 102, 103, 104, 105, 76, 77, 78, - 108, 416, 107, 81, 106, 420, 107, 526, 76, 77, - 78, 530, 531, 94, 61, 62, 431, 11, 99, 131, - 438, 102, 103, 104, 105, 472, 138, 106, 446, 548, - 76, 77, 78, 42, 43, 44, 45, 11, 106, 11, - 49, 11, 51, 562, 91, 92, 93, 94, 11, 106, - 21, 570, 99, 107, 106, 102, 103, 104, 105, 477, - 478, 488, 108, 490, 106, 106, 0, 76, 77, 78, - 106, 108, 499, 76, 77, 78, 10, 106, 12, 13, - 495, 61, 62, 106, 76, 77, 78, 74, 395, 10, - 10, 509, 510, 11, 106, 108, 10, 106, 525, 76, - 77, 78, 108, 107, 106, 108, 106, 72, 42, 43, - 44, 45, 108, 93, 94, 49, 108, 51, 108, 99, - 54, 233, 102, 103, 104, 105, 544, 61, 62, 106, - 106, 106, 559, 71, 441, 108, 76, 77, 78, 107, - 74, 20, 76, 77, 78, 106, 80, 81, 82, 83, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 106, 0, 106, 13, 99, 106, 106, 102, 103, - 104, 105, 106, 509, 108, 13, 343, 111, 76, 77, - 78, 418, 76, 77, 78, 76, 77, 78, 94, 61, - 62, 277, 563, 99, 370, 495, 102, 103, 104, 105, - 248, 371, 155, 356, 42, 43, 44, 45, 106, 451, - 322, 49, 106, 51, 225, 106, 54, 89, 90, 91, - 92, 93, 94, 61, 62, 470, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, 74, -1, 76, 77, - 78, -1, 80, 81, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, -1, -1, -1, - -1, 99, 0, 1, 102, 103, 104, 105, 106, -1, - 108, -1, 10, 111, 12, -1, 14, 15, 16, 17, - 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, - -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, 3, 4, 5, 6, 7, 8, 9, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, 0, 1, -1, -1, -1, 107, - 108, 109, 110, -1, 10, -1, 12, -1, 14, 15, - 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, -1, 14, + 197, 198, 199, 200, 201, 108, 314, 315, 107, 73, + 407, 356, 108, 321, 356, 106, 24, 509, 76, 77, + 78, 70, 42, 43, 44, 45, 70, 99, 10, 49, + 12, 51, 524, 525, 342, 343, 344, 345, 477, 376, + 68, 480, 11, 106, 536, 484, 485, 355, 70, 473, + 358, 359, 357, 12, 546, 547, 76, 77, 78, 131, + 322, 21, 61, 502, 503, 21, 138, 559, 98, 10, + 98, 12, 377, 512, 107, 76, 77, 78, 26, 107, + 80, 109, 24, 74, 392, 347, 106, 106, 527, 76, + 77, 78, 531, 532, 356, 94, 76, 77, 78, 407, + 99, 24, 11, 102, 103, 104, 105, 108, 12, 107, + 549, 78, 417, 110, 54, 110, 421, 110, 110, 106, + 110, 61, 62, 19, 563, 109, 21, 432, 108, 107, + 81, 439, 571, 106, 11, 107, 473, 11, 11, 447, + 11, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 76, 77, 78, 11, 99, + 21, 233, 102, 103, 104, 105, 76, 77, 78, 106, + 478, 479, 489, 106, 491, 106, 106, 0, 107, 42, + 43, 44, 45, 500, 106, 106, 49, 10, 51, 12, + 13, 496, 61, 62, 108, 76, 77, 78, 108, 396, + 106, 106, 510, 511, 238, 239, 240, 241, 10, 526, + 76, 77, 78, 76, 77, 78, 76, 77, 78, 42, + 43, 44, 45, 74, 93, 94, 49, 108, 51, 10, + 99, 54, 11, 102, 103, 104, 105, 545, 61, 62, + 108, 106, 108, 560, 108, 442, 106, 76, 77, 78, + 322, 74, 10, 76, 77, 78, 106, 80, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 107, 0, 106, 72, 99, 106, 108, 102, + 103, 104, 105, 106, 108, 108, 13, 106, 111, 76, + 77, 78, 106, 76, 77, 78, 76, 77, 78, 107, + 61, 62, 108, 106, 71, 20, 76, 77, 78, 13, + 106, 106, 106, 564, 510, 42, 43, 44, 45, 106, + 343, 419, 49, 106, 51, 277, 106, 54, 89, 90, + 91, 92, 93, 94, 61, 62, 106, 248, 99, 371, + 452, 102, 103, 104, 105, 372, 155, 74, 496, 76, + 77, 78, 471, 80, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 356, 225, + -1, -1, 99, 0, 1, 102, 103, 104, 105, 106, + -1, 108, -1, 10, 111, 12, -1, 14, 15, 16, + 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, + 61, 62, 49, 50, 51, 52, 53, -1, 55, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, 94, -1, -1, -1, + -1, 99, 79, 94, 102, 103, 104, 105, 99, -1, + -1, 102, 103, 104, 105, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, 0, 1, -1, -1, -1, + 107, 108, 109, 110, -1, 10, -1, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, 3, 4, 5, 6, 7, + 8, 9, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, -1, @@ -815,13 +802,13 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - 10, -1, 12, -1, 14, 15, 16, 17, 18, -1, + 10, 11, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, - -1, -1, 72, -1, -1, -1, -1, -1, -1, 79, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, @@ -831,13 +818,13 @@ static const yytype_int16 yycheck[] = 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 69, -1, -1, 72, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, -1, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, 33, -1, 35, 36, 37, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, @@ -845,47 +832,67 @@ static const yytype_int16 yycheck[] = -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, -1, -1, 12, -1, 14, 15, 16, + 108, 109, 110, 10, -1, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, 61, 62, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 27, 28, 29, 30, 31, 32, 33, -1, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, + -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 79, -1, -1, -1, 99, -1, -1, 102, - 103, 104, 105, -1, -1, -1, -1, -1, 95, 96, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, -1, -1, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, 61, 62, - -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, + -1, -1, 38, 39, -1, -1, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, 87, 88, 89, 90, 91, 92, - 93, 94, -1, 79, -1, -1, 99, -1, -1, 102, - 103, 104, 105, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - 106, 107, -1, 109, 110, 10, -1, 12, -1, 14, + 66, 67, 68, 69, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 79, -1, -1, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, + -1, 107, 108, 109, 110, -1, -1, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, - 25, 26, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, 61, 62, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, + 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, + -1, -1, -1, 38, 39, -1, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, 88, 89, 90, 91, 92, - 93, 94, -1, -1, 79, -1, 99, -1, -1, 102, - 103, 104, 105, -1, -1, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, 87, 88, 89, 90, 91, + 92, 93, 94, -1, 79, -1, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, -1, 107, -1, 109, 110, 10, -1, 12, -1, + -1, 106, 107, -1, 109, 110, 10, -1, 12, -1, + 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, + -1, -1, -1, -1, 38, 39, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, -1, -1, 53, + -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, + 64, 65, 66, 67, 68, 69, 88, 89, 90, 91, + 92, 93, 94, -1, -1, 79, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, + -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, + 61, 62, -1, 107, -1, 109, 110, 10, -1, 12, + -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, + 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + 91, 92, 93, 94, -1, 38, 39, -1, 99, -1, + -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, + 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, + 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, + -1, -1, -1, -1, 107, -1, 109, 110, 12, 13, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, 42, 43, 44, 45, - -1, -1, -1, 49, -1, 51, -1, -1, -1, 53, + -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - 76, 77, 78, -1, -1, 79, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 12, 13, 14, + -1, -1, -1, 107, -1, 109, 110, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, @@ -895,7 +902,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, -1, 107, -1, 109, 110, 12, -1, 14, 15, + -1, -1, 107, 108, 109, 110, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, @@ -905,7 +912,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - -1, 107, 108, 109, 110, 12, -1, 14, 15, 16, + 106, 107, -1, 109, 110, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, @@ -974,7 +981,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, - -1, -1, -1, 106, 107, -1, 109, 110, 12, -1, + -1, -1, -1, -1, 107, -1, 109, 110, 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, @@ -982,35 +989,21 @@ static const yytype_int16 yycheck[] = -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 54, -1, -1, -1, -1, -1, -1, 61, 62, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 12, -1, 14, - 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, 54, - -1, -1, -1, -1, -1, -1, 61, 62, -1, -1, - 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, -1, 107, -1, 109, 110, 81, 82, 83, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - -1, -1, -1, -1, 99, 54, -1, 102, 103, 104, - 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 81, 82, -1, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, -1, -1, -1, -1, - 99, 54, -1, 102, 103, 104, 105, -1, 61, 62, + -1, -1, -1, 107, -1, 109, 110, 81, 82, -1, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, -1, -1, -1, -1, 99, 54, -1, 102, 103, + 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, - -1, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, -1, -1, -1, -1, 99, 54, -1, 102, - 103, 104, 105, -1, 61, 62, -1, -1, -1, -1, + -1, -1, -1, -1, 82, -1, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, -1, -1, -1, + -1, 99, 54, -1, 102, 103, 104, 105, -1, 61, + 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, -1, -1, - -1, -1, 99, -1, -1, 102, 103, 104, 105 + -1, -1, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, -1, -1, -1, -1, 99, -1, -1, + 102, 103, 104, 105 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1022,59 +1015,59 @@ static const yytype_uint8 yystos[] = 15, 16, 17, 18, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, - 79, 95, 96, 98, 100, 101, 107, 109, 110, 173, - 174, 175, 178, 179, 180, 181, 182, 183, 184, 185, - 186, 187, 189, 192, 198, 199, 200, 201, 202, 203, - 204, 205, 206, 10, 121, 1, 33, 35, 36, 37, + 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, + 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, + 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, + 205, 206, 207, 10, 121, 1, 33, 35, 36, 37, 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, - 55, 108, 121, 130, 140, 173, 34, 128, 129, 130, - 126, 167, 168, 126, 13, 173, 187, 187, 21, 26, - 121, 199, 207, 207, 207, 207, 207, 188, 12, 107, - 187, 151, 151, 151, 187, 107, 107, 73, 107, 121, - 187, 21, 174, 191, 199, 207, 207, 121, 187, 108, - 173, 21, 26, 153, 187, 98, 107, 190, 199, 200, - 201, 187, 174, 187, 187, 187, 187, 187, 106, 173, - 207, 207, 76, 77, 78, 80, 10, 12, 107, 91, + 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, + 126, 168, 169, 126, 13, 174, 188, 188, 21, 26, + 121, 200, 208, 208, 208, 208, 208, 189, 12, 107, + 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, + 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, + 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, + 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, + 208, 208, 76, 77, 78, 80, 10, 12, 107, 91, 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 99, 102, 103, 104, 105, 107, 10, 12, 10, - 12, 10, 12, 10, 123, 152, 153, 153, 21, 150, - 107, 107, 107, 107, 68, 98, 107, 197, 199, 107, - 107, 121, 108, 48, 142, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 16, 17, 109, 158, 159, - 161, 162, 163, 164, 13, 191, 107, 73, 173, 106, - 121, 24, 154, 70, 155, 106, 106, 173, 192, 192, - 207, 174, 11, 108, 191, 107, 187, 190, 199, 200, - 201, 106, 173, 70, 156, 12, 106, 173, 173, 173, - 187, 173, 173, 106, 173, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 10, 12, 16, 17, 18, 22, - 63, 107, 109, 110, 177, 199, 106, 173, 173, 173, - 173, 173, 173, 173, 173, 126, 21, 149, 150, 150, - 21, 133, 123, 123, 123, 123, 98, 123, 68, 195, - 196, 198, 199, 200, 201, 123, 123, 107, 123, 123, - 121, 173, 146, 173, 173, 173, 173, 173, 26, 157, - 157, 80, 192, 174, 13, 176, 155, 24, 123, 172, - 106, 74, 106, 173, 11, 106, 173, 156, 106, 24, - 173, 12, 108, 13, 106, 83, 173, 173, 110, 110, - 110, 110, 106, 173, 110, 110, 107, 106, 108, 13, - 108, 13, 108, 13, 108, 11, 19, 122, 131, 132, - 10, 108, 21, 145, 173, 146, 147, 173, 147, 194, - 199, 107, 140, 144, 147, 148, 173, 195, 123, 147, - 147, 81, 160, 160, 162, 106, 111, 193, 191, 123, - 170, 107, 165, 166, 106, 106, 13, 173, 11, 187, - 108, 13, 106, 192, 11, 11, 11, 11, 123, 154, - 155, 123, 21, 106, 106, 106, 106, 107, 123, 106, - 108, 136, 147, 106, 106, 187, 173, 74, 10, 167, - 10, 13, 11, 106, 108, 155, 108, 171, 172, 137, - 191, 143, 143, 10, 124, 124, 147, 147, 124, 134, - 107, 106, 124, 124, 126, 106, 126, 72, 108, 169, - 170, 126, 108, 124, 124, 125, 46, 47, 141, 141, - 106, 106, 142, 145, 147, 124, 11, 11, 127, 11, - 142, 142, 126, 124, 107, 124, 124, 108, 106, 142, - 24, 108, 138, 11, 147, 142, 142, 135, 124, 71, - 139, 20, 106, 143, 142, 126, 124, 148, 72, 141, - 106, 124 + 12, 10, 12, 10, 123, 153, 154, 154, 21, 151, + 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, + 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, + 49, 51, 129, 130, 128, 16, 17, 109, 159, 160, + 162, 163, 164, 165, 13, 192, 107, 73, 174, 106, + 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, + 208, 175, 11, 108, 192, 107, 188, 191, 200, 201, + 202, 106, 174, 70, 157, 12, 106, 174, 174, 174, + 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 10, 12, 16, 17, 18, 22, + 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, + 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, + 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, + 158, 158, 80, 193, 175, 13, 177, 156, 24, 123, + 173, 106, 74, 106, 174, 11, 106, 174, 157, 106, + 24, 174, 12, 108, 13, 106, 83, 174, 174, 110, + 110, 110, 110, 106, 174, 110, 110, 107, 106, 108, + 13, 108, 13, 108, 13, 108, 11, 19, 122, 131, + 132, 10, 108, 21, 146, 174, 147, 148, 174, 148, + 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, + 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, + 123, 171, 107, 166, 167, 106, 106, 13, 174, 11, + 188, 108, 13, 106, 193, 11, 11, 11, 11, 123, + 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, + 106, 108, 136, 148, 106, 106, 188, 174, 74, 10, + 168, 10, 13, 11, 106, 108, 156, 108, 172, 173, + 137, 192, 144, 144, 10, 124, 124, 148, 148, 124, + 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, + 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, + 142, 106, 106, 143, 146, 148, 124, 11, 11, 127, + 11, 143, 143, 126, 124, 107, 124, 124, 108, 106, + 143, 24, 108, 138, 11, 148, 143, 143, 135, 124, + 71, 139, 20, 106, 144, 143, 126, 124, 149, 72, + 142, 106, 124 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ @@ -1086,34 +1079,34 @@ static const yytype_uint8 yyr1[] = 130, 131, 130, 132, 130, 130, 133, 130, 130, 130, 130, 130, 130, 130, 130, 134, 135, 130, 130, 130, 136, 130, 130, 130, 130, 137, 130, 130, 130, 130, - 138, 139, 139, 140, 140, 140, 140, 140, 140, 140, - 140, 141, 141, 141, 142, 142, 143, 144, 144, 145, - 145, 146, 147, 148, 149, 149, 150, 151, 152, 153, - 153, 154, 154, 155, 155, 155, 156, 156, 157, 157, - 158, 158, 159, 160, 160, 160, 161, 162, 162, 163, - 163, 163, 164, 164, 165, 165, 166, 168, 167, 169, - 169, 170, 171, 171, 172, 173, 173, 173, 173, 174, - 174, 174, 175, 175, 175, 175, 175, 175, 175, 175, - 175, 176, 175, 177, 177, 178, 178, 178, 178, 178, - 178, 178, 178, 178, 178, 178, 178, 178, 178, 179, + 138, 139, 139, 140, 141, 141, 141, 141, 141, 141, + 141, 141, 142, 142, 142, 143, 143, 144, 145, 145, + 146, 146, 147, 148, 149, 150, 150, 151, 152, 153, + 154, 154, 155, 155, 156, 156, 156, 157, 157, 158, + 158, 159, 159, 160, 161, 161, 161, 162, 163, 163, + 164, 164, 164, 165, 165, 166, 166, 167, 169, 168, + 170, 170, 171, 172, 172, 173, 174, 174, 174, 174, + 175, 175, 175, 176, 176, 176, 176, 176, 176, 176, + 176, 176, 177, 176, 178, 178, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, - 179, 179, 179, 180, 180, 180, 180, 181, 181, 182, - 182, 182, 182, 183, 183, 184, 184, 184, 184, 184, - 184, 184, 184, 184, 185, 185, 185, 185, 185, 185, - 186, 186, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, - 187, 188, 187, 187, 187, 187, 189, 189, 189, 190, - 190, 190, 190, 190, 191, 191, 192, 192, 193, 193, - 194, 195, 195, 195, 196, 196, 197, 197, 198, 199, - 200, 201, 202, 202, 203, 204, 204, 205, 205, 206, - 206, 207, 207, 207, 207 + 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, + 180, 180, 180, 180, 181, 181, 181, 181, 182, 182, + 183, 183, 183, 183, 184, 184, 185, 185, 185, 185, + 185, 185, 185, 185, 185, 186, 186, 186, 186, 186, + 186, 187, 187, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, + 188, 188, 189, 188, 188, 188, 188, 190, 190, 190, + 191, 191, 191, 191, 191, 192, 192, 193, 193, 194, + 194, 195, 196, 196, 196, 197, 197, 198, 198, 199, + 200, 201, 202, 203, 203, 204, 205, 205, 206, 206, + 207, 207, 208, 208, 208, 208 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ -static const yytype_uint8 yyr2[] = +static const yytype_int8 yyr2[] = { 0, 2, 0, 4, 0, 3, 0, 3, 0, 3, 0, 3, 0, 3, 0, 3, 4, 7, 0, 4, @@ -1121,30 +1114,30 @@ static const yytype_uint8 yyr2[] = 4, 0, 7, 0, 6, 4, 0, 7, 7, 7, 6, 6, 2, 8, 8, 0, 0, 13, 9, 8, 0, 10, 9, 7, 2, 0, 8, 2, 2, 1, - 2, 0, 3, 1, 1, 3, 3, 3, 3, 3, - 3, 0, 2, 6, 0, 2, 0, 0, 1, 0, - 1, 1, 1, 1, 1, 0, 0, 0, 0, 1, - 1, 0, 1, 0, 2, 1, 2, 1, 0, 1, - 1, 1, 3, 0, 1, 2, 3, 1, 1, 2, - 3, 1, 0, 1, 0, 1, 3, 0, 2, 1, - 1, 4, 1, 1, 5, 3, 3, 3, 1, 2, - 3, 1, 3, 5, 6, 3, 3, 5, 2, 4, - 4, 0, 5, 1, 1, 5, 4, 5, 4, 5, - 6, 5, 4, 5, 4, 3, 6, 4, 5, 3, - 3, 3, 3, 3, 1, 1, 3, 3, 3, 3, - 3, 3, 3, 1, 3, 2, 2, 3, 3, 1, - 3, 2, 2, 3, 3, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 3, 2, 4, 3, 5, 4, - 2, 2, 1, 1, 1, 1, 5, 2, 3, 1, - 2, 3, 1, 2, 1, 1, 1, 1, 1, 1, - 4, 4, 5, 5, 1, 1, 3, 4, 3, 4, - 4, 4, 4, 4, 1, 2, 2, 1, 2, 2, - 1, 2, 1, 2, 1, 3, 1, 3, 1, 3, - 4, 0, 6, 1, 1, 1, 3, 2, 4, 3, - 2, 1, 1, 1, 0, 1, 0, 1, 0, 2, - 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, - 2, 2, 2, 4, 2, 1, 3, 1, 3, 1, - 3, 1, 1, 1, 1 + 2, 0, 3, 1, 1, 1, 3, 3, 3, 3, + 3, 3, 0, 2, 6, 0, 2, 0, 0, 1, + 0, 1, 1, 1, 1, 1, 0, 0, 0, 0, + 1, 1, 0, 1, 0, 2, 1, 2, 1, 0, + 1, 1, 1, 3, 0, 1, 2, 3, 1, 1, + 2, 3, 1, 0, 1, 0, 1, 3, 0, 2, + 1, 1, 4, 1, 1, 5, 3, 3, 3, 1, + 2, 3, 1, 3, 5, 6, 3, 3, 5, 2, + 4, 4, 0, 5, 1, 1, 5, 4, 5, 4, + 5, 6, 5, 4, 5, 4, 3, 6, 4, 5, + 3, 3, 3, 3, 3, 1, 1, 3, 3, 3, + 3, 3, 3, 3, 1, 3, 2, 2, 3, 3, + 1, 3, 2, 2, 3, 3, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 3, 2, 4, 3, 5, + 4, 2, 2, 1, 1, 1, 1, 5, 2, 3, + 1, 2, 3, 1, 2, 1, 1, 1, 1, 1, + 1, 4, 4, 5, 5, 1, 1, 3, 4, 3, + 4, 4, 4, 4, 4, 1, 2, 2, 1, 2, + 2, 1, 2, 1, 2, 1, 3, 1, 3, 1, + 3, 4, 0, 6, 1, 1, 1, 3, 2, 4, + 3, 2, 1, 1, 1, 0, 1, 0, 1, 0, + 2, 1, 1, 1, 1, 1, 1, 2, 2, 2, + 2, 2, 2, 2, 4, 2, 1, 3, 1, 3, + 1, 3, 1, 1, 1, 1 }; typedef enum { @@ -1173,10 +1166,10 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1189,6 +1182,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * f83d884147747f2d8f5a62eebc4ccd07d71b6b34e5ba1a8d7559526ad864dc97 perly.y - * 01ce33b49f9f04b8d3112b7f042cde113a7d29763a846e870f9766072a5bc614 regen_perly.pl + * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 843a3b18bb3b..433de1f48172 100644 --- a/perly.y +++ b/perly.y @@ -69,6 +69,7 @@ %type stmtseq fullstmt labfullstmt barestmt block mblock else %type expr term subscripted scalar ary hsh arylen star amper sideff +%type condition %type sliceme kvslice gelem %type listexpr nexpr texpr iexpr mexpr mnexpr %type optlistexpr optexpr optrepl indirob listop method @@ -124,7 +125,7 @@ grammar : GRAMPROG } remember stmtseq { - newPROG(block_end($3,$4)); + newPROG(block_end($remember,$stmtseq)); PL_compiling.cop_seq = 0; $$ = 0; } @@ -135,7 +136,7 @@ grammar : GRAMPROG } optexpr { - PL_eval_root = $3; + PL_eval_root = $optexpr; $$ = 0; } | GRAMBLOCK @@ -146,7 +147,7 @@ grammar : GRAMPROG block { PL_pad_reset_pending = TRUE; - PL_eval_root = $3; + PL_eval_root = $block; $$ = 0; yyunlex(); parser->yychar = yytoken = YYEOF; @@ -159,7 +160,7 @@ grammar : GRAMPROG barestmt { PL_pad_reset_pending = TRUE; - PL_eval_root = $3; + PL_eval_root = $barestmt; $$ = 0; yyunlex(); parser->yychar = yytoken = YYEOF; @@ -172,7 +173,7 @@ grammar : GRAMPROG fullstmt { PL_pad_reset_pending = TRUE; - PL_eval_root = $3; + PL_eval_root = $fullstmt; $$ = 0; yyunlex(); parser->yychar = yytoken = YYEOF; @@ -184,7 +185,7 @@ grammar : GRAMPROG } stmtseq { - PL_eval_root = $3; + PL_eval_root = $stmtseq; $$ = 0; } | GRAMSUBSIGNATURE @@ -194,7 +195,7 @@ grammar : GRAMPROG } subsigguts { - PL_eval_root = $3; + PL_eval_root = $subsigguts; $$ = 0; } ; @@ -203,7 +204,7 @@ grammar : GRAMPROG block : '{' remember stmtseq '}' { if (parser->copline > (line_t)$1) parser->copline = (line_t)$1; - $$ = block_end($2, $3); + $$ = block_end($remember, $stmtseq); } ; @@ -211,7 +212,7 @@ block : '{' remember stmtseq '}' formblock: '=' remember ';' FORMRBRACK formstmtseq ';' '.' { if (parser->copline > (line_t)$1) parser->copline = (line_t)$1; - $$ = block_end($2, $5); + $$ = block_end($remember, $formstmtseq); } ; @@ -223,7 +224,7 @@ remember: /* NULL */ /* start a full lexical scope */ mblock : '{' mremember stmtseq '}' { if (parser->copline > (line_t)$1) parser->copline = (line_t)$1; - $$ = block_end($2, $3); + $$ = block_end($mremember, $stmtseq); } ; @@ -235,10 +236,10 @@ mremember: /* NULL */ /* start a partial lexical scope */ /* A sequence of statements in the program */ stmtseq : /* NULL */ { $$ = NULL; } - | stmtseq fullstmt - { $$ = op_append_list(OP_LINESEQ, $1, $2); + | stmtseq[list] fullstmt + { $$ = op_append_list(OP_LINESEQ, $list, $fullstmt); PL_pad_reset_pending = TRUE; - if ($1 && $2) + if ($list && $fullstmt) PL_hints |= HINT_BLOCK_SCOPE; } ; @@ -246,10 +247,10 @@ stmtseq : /* NULL */ /* A sequence of format lines */ formstmtseq: /* NULL */ { $$ = NULL; } - | formstmtseq formline - { $$ = op_append_list(OP_LINESEQ, $1, $2); + | formstmtseq[list] formline + { $$ = op_append_list(OP_LINESEQ, $list, $formline); PL_pad_reset_pending = TRUE; - if ($1 && $2) + if ($list && $formline) PL_hints |= HINT_BLOCK_SCOPE; } ; @@ -257,35 +258,35 @@ formstmtseq: /* NULL */ /* A statement in the program, including optional labels */ fullstmt: barestmt { - $$ = $1 ? newSTATEOP(0, NULL, $1) : NULL; + $$ = $barestmt ? newSTATEOP(0, NULL, $barestmt) : NULL; } | labfullstmt - { $$ = $1; } + { $$ = $labfullstmt; } ; labfullstmt: LABEL barestmt { - SV *label = cSVOPx_sv($1); + SV *label = cSVOPx_sv($LABEL); $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, - savepv(SvPVX_const(label)), $2); - op_free($1); + savepv(SvPVX_const(label)), $barestmt); + op_free($LABEL); } - | LABEL labfullstmt + | LABEL labfullstmt[list] { - SV *label = cSVOPx_sv($1); + SV *label = cSVOPx_sv($LABEL); $$ = newSTATEOP(SvFLAGS(label) & SVf_UTF8, - savepv(SvPVX_const(label)), $2); - op_free($1); + savepv(SvPVX_const(label)), $list); + op_free($LABEL); } ; /* A bare statement, lacking label and other aspects of state op */ barestmt: PLUGSTMT - { $$ = $1; } + { $$ = $PLUGSTMT; } | FORMAT startformsub formname formblock { CV *fmtcv = PL_compcv; - newFORM($2, $3, $4); + newFORM($startformsub, $formname, $formblock); $$ = NULL; if (CvOUTSIDE(fmtcv) && !CvEVAL(CvOUTSIDE(fmtcv))) { pad_add_weakref(fmtcv); @@ -296,16 +297,16 @@ barestmt: PLUGSTMT /* sub declaration or definition not within scope of 'use feature "signatures"'*/ { - init_named_cv(PL_compcv, $2); + init_named_cv(PL_compcv, $subname); parser->in_my = 0; parser->in_my_stash = NULL; } proto subattrlist optsubbody { SvREFCNT_inc_simple_void(PL_compcv); - $2->op_type == OP_CONST - ? newATTRSUB($3, $2, $5, $6, $7) - : newMYSUB($3, $2, $5, $6, $7) + $subname->op_type == OP_CONST + ? newATTRSUB($startsub, $subname, $proto, $subattrlist, $optsubbody) + : newMYSUB($startsub, $subname, $proto, $subattrlist, $optsubbody) ; $$ = NULL; intro_my(); @@ -317,82 +318,82 @@ barestmt: PLUGSTMT * allowed in a declaration) */ { - init_named_cv(PL_compcv, $2); + init_named_cv(PL_compcv, $subname); parser->in_my = 0; parser->in_my_stash = NULL; } subattrlist optsigsubbody { SvREFCNT_inc_simple_void(PL_compcv); - $2->op_type == OP_CONST - ? newATTRSUB($3, $2, NULL, $5, $6) - : newMYSUB( $3, $2, NULL, $5, $6) + $subname->op_type == OP_CONST + ? newATTRSUB($startsub, $subname, NULL, $subattrlist, $optsigsubbody) + : newMYSUB( $startsub, $subname, NULL, $subattrlist, $optsigsubbody) ; $$ = NULL; intro_my(); parser->parsed_sub = 1; } - | PACKAGE BAREWORD BAREWORD ';' + | PACKAGE BAREWORD[version] BAREWORD[package] ';' { - package($3); - if ($2) - package_version($2); + package($package); + if ($version) + package_version($version); $$ = NULL; } | USE startsub { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } - BAREWORD BAREWORD optlistexpr ';' + BAREWORD[version] BAREWORD[module] optlistexpr ';' { SvREFCNT_inc_simple_void(PL_compcv); - utilize($1, $2, $4, $5, $6); + utilize($USE, $startsub, $version, $module, $optlistexpr); parser->parsed_sub = 1; $$ = NULL; } | IF '(' remember mexpr ')' mblock else { - $$ = block_end($3, - newCONDOP(0, $4, op_scope($6), $7)); - parser->copline = (line_t)$1; + $$ = block_end($remember, + newCONDOP(0, $mexpr, op_scope($mblock), $else)); + parser->copline = (line_t)$IF; } | UNLESS '(' remember mexpr ')' mblock else { - $$ = block_end($3, - newCONDOP(0, $4, $7, op_scope($6))); - parser->copline = (line_t)$1; + $$ = block_end($remember, + newCONDOP(0, $mexpr, $else, op_scope($mblock))); + parser->copline = (line_t)$UNLESS; } | GIVEN '(' remember mexpr ')' mblock { - $$ = block_end($3, newGIVENOP($4, op_scope($6), 0)); - parser->copline = (line_t)$1; + $$ = block_end($remember, newGIVENOP($mexpr, op_scope($mblock), 0)); + parser->copline = (line_t)$GIVEN; } | WHEN '(' remember mexpr ')' mblock - { $$ = block_end($3, newWHENOP($4, op_scope($6))); } + { $$ = block_end($remember, newWHENOP($mexpr, op_scope($mblock))); } | DEFAULT block - { $$ = newWHENOP(0, op_scope($2)); } + { $$ = newWHENOP(0, op_scope($block)); } | WHILE '(' remember texpr ')' mintro mblock cont { - $$ = block_end($3, + $$ = block_end($remember, newWHILEOP(0, 1, NULL, - $4, $7, $8, $6)); - parser->copline = (line_t)$1; + $texpr, $mblock, $cont, $mintro)); + parser->copline = (line_t)$WHILE; } | UNTIL '(' remember iexpr ')' mintro mblock cont { - $$ = block_end($3, + $$ = block_end($remember, newWHILEOP(0, 1, NULL, - $4, $7, $8, $6)); - parser->copline = (line_t)$1; + $iexpr, $mblock, $cont, $mintro)); + parser->copline = (line_t)$UNTIL; } - | FOR '(' remember mnexpr ';' + | FOR '(' remember mnexpr[init_mnexpr] ';' { parser->expect = XTERM; } texpr ';' { parser->expect = XTERM; } - mintro mnexpr ')' + mintro mnexpr[iterate_mnexpr] ')' mblock { - OP *initop = $4; + OP *initop = $init_mnexpr; OP *forop = newWHILEOP(0, 1, NULL, - scalar($7), $13, $11, $10); + scalar($texpr), $mblock, $iterate_mnexpr, $mintro); if (initop) { forop = op_prepend_elem(OP_LINESEQ, initop, op_append_elem(OP_LINESEQ, @@ -400,73 +401,73 @@ barestmt: PLUGSTMT forop)); } PL_hints |= HINT_BLOCK_SCOPE; - $$ = block_end($3, forop); - parser->copline = (line_t)$1; + $$ = block_end($remember, forop); + parser->copline = (line_t)$FOR; } | FOR MY remember my_scalar '(' mexpr ')' mblock cont { - $$ = block_end($3, newFOROP(0, $4, $6, $8, $9)); - parser->copline = (line_t)$1; + $$ = block_end($remember, newFOROP(0, $my_scalar, $mexpr, $mblock, $cont)); + parser->copline = (line_t)$FOR; } | FOR scalar '(' remember mexpr ')' mblock cont { - $$ = block_end($4, newFOROP(0, - op_lvalue($2, OP_ENTERLOOP), $5, $7, $8)); - parser->copline = (line_t)$1; + $$ = block_end($remember, newFOROP(0, + op_lvalue($scalar, OP_ENTERLOOP), $mexpr, $mblock, $cont)); + parser->copline = (line_t)$FOR; } | FOR my_refgen remember my_var - { parser->in_my = 0; $$ = my($4); } + { parser->in_my = 0; $$ = my($my_var); }[variable] '(' mexpr ')' mblock cont { $$ = block_end( - $3, + $remember, newFOROP(0, op_lvalue( newUNOP(OP_REFGEN, 0, - $5), + $variable), OP_ENTERLOOP), - $7, $9, $10) + $mexpr, $mblock, $cont) ); - parser->copline = (line_t)$1; + parser->copline = (line_t)$FOR; } | FOR REFGEN refgen_topic '(' remember mexpr ')' mblock cont { - $$ = block_end($5, newFOROP( + $$ = block_end($remember, newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, - $3), - OP_ENTERLOOP), $6, $8, $9)); - parser->copline = (line_t)$1; + $refgen_topic), + OP_ENTERLOOP), $mexpr, $mblock, $cont)); + parser->copline = (line_t)$FOR; } | FOR '(' remember mexpr ')' mblock cont { - $$ = block_end($3, - newFOROP(0, NULL, $4, $6, $7)); - parser->copline = (line_t)$1; + $$ = block_end($remember, + newFOROP(0, NULL, $mexpr, $mblock, $cont)); + parser->copline = (line_t)$FOR; } | block cont { /* a block is a loop that happens once */ $$ = newWHILEOP(0, 1, NULL, - NULL, $1, $2, 0); + NULL, $block, $cont, 0); } - | PACKAGE BAREWORD BAREWORD '{' remember + | PACKAGE BAREWORD[version] BAREWORD[package] '{' remember { - package($3); - if ($2) { - package_version($2); + package($package); + if ($version) { + package_version($version); } } stmtseq '}' { /* a block is a loop that happens once */ $$ = newWHILEOP(0, 1, NULL, - NULL, block_end($5, $7), NULL, 0); + NULL, block_end($remember, $stmtseq), NULL, 0); if (parser->copline > (line_t)$4) parser->copline = (line_t)$4; } | sideff ';' { - $$ = $1; + $$ = $sideff; } | YADAYADA ';' { @@ -483,12 +484,12 @@ barestmt: PLUGSTMT /* Format line */ formline: THING formarg { OP *list; - if ($2) { - OP *term = $2; - list = op_append_elem(OP_LIST, $1, term); + if ($formarg) { + OP *term = $formarg; + list = op_append_elem(OP_LIST, $THING, term); } else { - list = $1; + list = $THING; } if (parser->copline == NOLINE) parser->copline = CopLINE(PL_curcop)-1; @@ -501,27 +502,30 @@ formline: THING formarg formarg : /* NULL */ { $$ = NULL; } | FORMLBRACK stmtseq FORMRBRACK - { $$ = op_unscope($2); } + { $$ = op_unscope($stmtseq); } ; +condition: expr +; + /* An expression which may have a side-effect */ sideff : error { $$ = NULL; } - | expr - { $$ = $1; } - | expr IF expr - { $$ = newLOGOP(OP_AND, 0, $3, $1); } - | expr UNLESS expr - { $$ = newLOGOP(OP_OR, 0, $3, $1); } - | expr WHILE expr - { $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); } - | expr UNTIL iexpr - { $$ = newLOOPOP(OPf_PARENS, 1, $3, $1); } - | expr FOR expr - { $$ = newFOROP(0, NULL, $3, $1, NULL); - parser->copline = (line_t)$2; } - | expr WHEN expr - { $$ = newWHENOP($3, op_scope($1)); } + | expr[body] + { $$ = $body; } + | expr[body] IF condition + { $$ = newLOGOP(OP_AND, 0, $condition, $body); } + | expr[body] UNLESS condition + { $$ = newLOGOP(OP_OR, 0, $condition, $body); } + | expr[body] WHILE condition + { $$ = newLOOPOP(OPf_PARENS, 1, scalar($condition), $body); } + | expr[body] UNTIL iexpr + { $$ = newLOOPOP(OPf_PARENS, 1, $iexpr, $body); } + | expr[body] FOR condition + { $$ = newFOROP(0, NULL, $condition, $body, NULL); + parser->copline = (line_t)$FOR; } + | expr[body] WHEN condition + { $$ = newWHENOP($condition, op_scope($body)); } ; /* else and elsif blocks */ @@ -529,14 +533,14 @@ else : /* NULL */ { $$ = NULL; } | ELSE mblock { - ($2)->op_flags |= OPf_PARENS; - $$ = op_scope($2); + ($mblock)->op_flags |= OPf_PARENS; + $$ = op_scope($mblock); } - | ELSIF '(' mexpr ')' mblock else - { parser->copline = (line_t)$1; + | ELSIF '(' mexpr ')' mblock else[else.recurse] + { parser->copline = (line_t)$ELSIF; $$ = newCONDOP(0, - newSTATEOP(OPf_SPECIAL,NULL,$3), - op_scope($5), $6); + newSTATEOP(OPf_SPECIAL,NULL,$mexpr), + op_scope($mblock), $[else.recurse]); PL_hints |= HINT_BLOCK_SCOPE; } ; @@ -545,7 +549,7 @@ else : /* NULL */ cont : /* NULL */ { $$ = NULL; } | CONTINUE block - { $$ = op_scope($2); } + { $$ = op_scope($block); } ; /* determine whether there are any new my declarations */ @@ -570,19 +574,19 @@ texpr : /* NULL means true */ /* Inverted boolean expression */ iexpr : expr - { $$ = invert(scalar($1)); } + { $$ = invert(scalar($expr)); } ; /* Expression with its own lexical scope */ mexpr : expr - { $$ = $1; intro_my(); } + { $$ = $expr; intro_my(); } ; mnexpr : nexpr - { $$ = $1; intro_my(); } + { $$ = $nexpr; intro_my(); } ; -formname: BAREWORD { $$ = $1; } +formname: BAREWORD { $$ = $BAREWORD; } | /* NULL */ { $$ = NULL; } ; @@ -617,14 +621,14 @@ proto : /* NULL */ subattrlist: /* NULL */ { $$ = NULL; } | COLONATTR THING - { $$ = $2; } + { $$ = $THING; } | COLONATTR { $$ = NULL; } ; /* List of attributes for a "my" variable declaration */ myattrlist: COLONATTR THING - { $$ = $2; } + { $$ = $THING; } | COLONATTR { $$ = NULL; } ; @@ -639,7 +643,7 @@ myattrlist: COLONATTR THING sigvarname: /* NULL */ { parser->in_my = 0; $$ = NULL; } | PRIVATEREF - { parser->in_my = 0; $$ = $1; } + { parser->in_my = 0; $$ = $PRIVATEREF; } ; sigslurpsigil: @@ -651,9 +655,9 @@ sigslurpsigil: /* @, %, @foo, %foo */ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */ { - I32 sigil = $1; - OP *var = $2; - OP *defexpr = $3; + I32 sigil = $sigslurpsigil; + OP *var = $sigvarname; + OP *defexpr = $sigdefault; if (parser->sig_slurpy) yyerror("Multiple slurpy parameters not allowed"); @@ -673,15 +677,15 @@ sigdefault: /* NULL */ | ASSIGNOP { $$ = newOP(OP_NULL, 0); } | ASSIGNOP term - { $$ = $2; } + { $$ = $term; } /* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */ sigscalarelem: '$' sigvarname sigdefault { - OP *var = $2; - OP *defexpr = $3; + OP *var = $sigvarname; + OP *defexpr = $sigdefault; if (parser->sig_slurpy) yyerror("Slurpy parameter not last"); @@ -744,38 +748,38 @@ sigscalarelem: /* subroutine signature element: e.g. '$x = $default' or '%h' */ sigelem: sigscalarelem - { parser->in_my = KEY_sigvar; $$ = $1; } + { parser->in_my = KEY_sigvar; $$ = $sigscalarelem; } | sigslurpelem - { parser->in_my = KEY_sigvar; $$ = $1; } + { parser->in_my = KEY_sigvar; $$ = $sigslurpelem; } ; /* list of subroutine signature elements */ siglist: - siglist ',' - { $$ = $1; } - | siglist ',' sigelem + siglist[list] ',' + { $$ = $list; } + | siglist[list] ',' sigelem[element] { - $$ = op_append_list(OP_LINESEQ, $1, $3); + $$ = op_append_list(OP_LINESEQ, $list, $element); } - | sigelem %prec PREC_LOW - { $$ = $1; } + | sigelem[element] %prec PREC_LOW + { $$ = $element; } ; /* () or (....) */ siglistornull: /* NULL */ { $$ = NULL; } | siglist - { $$ = $1; } + { $$ = $siglist; } /* optional subroutine signature */ optsubsignature: /* NULL */ { $$ = NULL; } | subsignature - { $$ = $1; } + { $$ = $subsignature; } /* Subroutine signature */ subsignature: '(' subsigguts ')' - { $$ = $2; } + { $$ = $subsigguts; } subsigguts: { @@ -790,7 +794,7 @@ subsigguts: } siglistornull { - OP *sigops = $2; + OP *sigops = $siglistornull; struct op_argcheck_aux *aux; OP *check; @@ -846,7 +850,7 @@ subsigguts: ; /* Optional subroutine body (for named subroutine declaration) */ -optsubbody: subbody { $$ = $1; } +optsubbody: subbody { $$ = $subbody; } | ';' { $$ = NULL; } ; @@ -856,14 +860,14 @@ subbody: remember '{' stmtseq '}' { if (parser->copline > (line_t)$2) parser->copline = (line_t)$2; - $$ = block_end($1, $3); + $$ = block_end($remember, $stmtseq); } ; /* optional [ Subroutine body with optional signature ] (for named * subroutine declaration) */ -optsigsubbody: sigsubbody { $$ = $1; } +optsigsubbody: sigsubbody { $$ = $sigsubbody; } | ';' { $$ = NULL; } /* Subroutine body with optional signature */ @@ -871,78 +875,78 @@ sigsubbody: remember optsubsignature '{' stmtseq '}' { if (parser->copline > (line_t)$3) parser->copline = (line_t)$3; - $$ = block_end($1, - op_append_list(OP_LINESEQ, $2, $4)); + $$ = block_end($remember, + op_append_list(OP_LINESEQ, $optsubsignature, $stmtseq)); } ; /* Ordinary expressions; logical combinations */ -expr : expr ANDOP expr - { $$ = newLOGOP(OP_AND, 0, $1, $3); } - | expr OROP expr - { $$ = newLOGOP($2, 0, $1, $3); } - | expr DOROP expr - { $$ = newLOGOP(OP_DOR, 0, $1, $3); } +expr : expr[lhs] ANDOP expr[rhs] + { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } + | expr[lhs] OROP[operator] expr[rhs] + { $$ = newLOGOP($operator, 0, $lhs, $rhs); } + | expr[lhs] DOROP expr[rhs] + { $$ = newLOGOP(OP_DOR, 0, $lhs, $rhs); } | listexpr %prec PREC_LOW ; /* Expressions are a list of terms joined by commas */ -listexpr: listexpr ',' - { $$ = $1; } - | listexpr ',' term +listexpr: listexpr[list] ',' + { $$ = $list; } + | listexpr[list] ',' term { - OP* term = $3; - $$ = op_append_elem(OP_LIST, $1, term); + OP* term = $term; + $$ = op_append_elem(OP_LIST, $list, term); } | term %prec PREC_LOW ; /* List operators */ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ - { $$ = op_convert_list($1, OPf_STACKED, - op_prepend_elem(OP_LIST, newGVREF($1,$2), $3) ); + { $$ = op_convert_list($LSTOP, OPf_STACKED, + op_prepend_elem(OP_LIST, newGVREF($LSTOP,$indirob), $listexpr) ); } | FUNC '(' indirob expr ')' /* print ($fh @args */ - { $$ = op_convert_list($1, OPf_STACKED, - op_prepend_elem(OP_LIST, newGVREF($1,$3), $4) ); + { $$ = op_convert_list($FUNC, OPf_STACKED, + op_prepend_elem(OP_LIST, newGVREF($FUNC,$indirob), $expr) ); } | term ARROW method '(' optexpr ')' /* $foo->bar(list) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, - op_prepend_elem(OP_LIST, scalar($1), $5), - newMETHOP(OP_METHOD, 0, $3))); + op_prepend_elem(OP_LIST, scalar($term), $optexpr), + newMETHOP(OP_METHOD, 0, $method))); } | term ARROW method /* $foo->bar */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, scalar($1), - newMETHOP(OP_METHOD, 0, $3))); + op_append_elem(OP_LIST, scalar($term), + newMETHOP(OP_METHOD, 0, $method))); } | METHOD indirob optlistexpr /* new Class @args */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, - op_prepend_elem(OP_LIST, $2, $3), - newMETHOP(OP_METHOD, 0, $1))); + op_prepend_elem(OP_LIST, $indirob, $optlistexpr), + newMETHOP(OP_METHOD, 0, $METHOD))); } | FUNCMETH indirob '(' optexpr ')' /* method $object (@args) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, - op_prepend_elem(OP_LIST, $2, $4), - newMETHOP(OP_METHOD, 0, $1))); + op_prepend_elem(OP_LIST, $indirob, $optexpr), + newMETHOP(OP_METHOD, 0, $FUNCMETH))); } | LSTOP optlistexpr /* print @args */ - { $$ = op_convert_list($1, 0, $2); } + { $$ = op_convert_list($LSTOP, 0, $optlistexpr); } | FUNC '(' optexpr ')' /* print (@args) */ - { $$ = op_convert_list($1, 0, $3); } + { $$ = op_convert_list($FUNC, 0, $optexpr); } | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ - { $$ = op_convert_list($1, 0, $3); } + { $$ = op_convert_list($FUNC, 0, $optexpr); } | LSTOPSUB startanonsub block /* sub f(&@); f { foo } ... */ { SvREFCNT_inc_simple_void(PL_compcv); - $$ = newANONATTRSUB($2, 0, NULL, $3); } + $$ = newANONATTRSUB($startanonsub, 0, NULL, $block); }[anonattrsub] optlistexpr %prec LSTOP /* ... @bar */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, - op_prepend_elem(OP_LIST, $4, $5), $1)); + op_prepend_elem(OP_LIST, $anonattrsub, $optlistexpr), $LSTOPSUB)); } ; @@ -955,148 +959,148 @@ method : METHOD subscripted: gelem '{' expr ';' '}' /* *main::{something} */ /* In this and all the hash accessors, ';' is * provided by the tokeniser */ - { $$ = newBINOP(OP_GELEM, 0, $1, scalar($3)); } - | scalar '[' expr ']' /* $array[$element] */ - { $$ = newBINOP(OP_AELEM, 0, oopsAV($1), scalar($3)); + { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } + | scalar[array] '[' expr ']' /* $array[$element] */ + { $$ = newBINOP(OP_AELEM, 0, oopsAV($array), scalar($expr)); } - | term ARROW '[' expr ']' /* somearef->[$element] */ + | term[array_reference] ARROW '[' expr ']' /* somearef->[$element] */ { $$ = newBINOP(OP_AELEM, 0, - ref(newAVREF($1),OP_RV2AV), - scalar($4)); + ref(newAVREF($array_reference),OP_RV2AV), + scalar($expr)); } - | subscripted '[' expr ']' /* $foo->[$bar]->[$baz] */ + | subscripted[array_reference] '[' expr ']' /* $foo->[$bar]->[$baz] */ { $$ = newBINOP(OP_AELEM, 0, - ref(newAVREF($1),OP_RV2AV), - scalar($3)); + ref(newAVREF($array_reference),OP_RV2AV), + scalar($expr)); } - | scalar '{' expr ';' '}' /* $foo{bar();} */ - { $$ = newBINOP(OP_HELEM, 0, oopsHV($1), jmaybe($3)); + | scalar[hash] '{' expr ';' '}' /* $foo{bar();} */ + { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); } - | term ARROW '{' expr ';' '}' /* somehref->{bar();} */ + | term[hash_reference] ARROW '{' expr ';' '}' /* somehref->{bar();} */ { $$ = newBINOP(OP_HELEM, 0, - ref(newHVREF($1),OP_RV2HV), - jmaybe($4)); } - | subscripted '{' expr ';' '}' /* $foo->[bar]->{baz;} */ + ref(newHVREF($hash_reference),OP_RV2HV), + jmaybe($expr)); } + | subscripted[hash_reference] '{' expr ';' '}' /* $foo->[bar]->{baz;} */ { $$ = newBINOP(OP_HELEM, 0, - ref(newHVREF($1),OP_RV2HV), - jmaybe($3)); } - | term ARROW '(' ')' /* $subref->() */ + ref(newHVREF($hash_reference),OP_RV2HV), + jmaybe($expr)); } + | term[code_reference] ARROW '(' ')' /* $subref->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - newCVREF(0, scalar($1))); + newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | term ARROW '(' expr ')' /* $subref->(@args) */ + | term[code_reference] ARROW '(' expr ')' /* $subref->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, $4, - newCVREF(0, scalar($1)))); + op_append_elem(OP_LIST, $expr, + newCVREF(0, scalar($code_reference)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | subscripted '(' expr ')' /* $foo->{bar}->(@args) */ + | subscripted[code_reference] '(' expr ')' /* $foo->{bar}->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, $3, - newCVREF(0, scalar($1)))); + op_append_elem(OP_LIST, $expr, + newCVREF(0, scalar($code_reference)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | subscripted '(' ')' /* $foo->{bar}->() */ + | subscripted[code_reference] '(' ')' /* $foo->{bar}->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - newCVREF(0, scalar($1))); + newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | '(' expr ')' '[' expr ']' /* list slice */ - { $$ = newSLICEOP(0, $5, $2); } + | '(' expr[list] ')' '[' expr[slice] ']' /* list slice */ + { $$ = newSLICEOP(0, $slice, $list); } | QWLIST '[' expr ']' /* list literal slice */ - { $$ = newSLICEOP(0, $3, $1); } + { $$ = newSLICEOP(0, $expr, $QWLIST); } | '(' ')' '[' expr ']' /* empty list slice! */ - { $$ = newSLICEOP(0, $4, NULL); } + { $$ = newSLICEOP(0, $expr, NULL); } ; /* Binary operators between terms */ -termbinop: term ASSIGNOP term /* $x = $y, $x += $y */ - { $$ = newASSIGNOP(OPf_STACKED, $1, $2, $3); } - | term POWOP term /* $x ** $y */ - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | term MULOP term /* $x * $y, $x x $y */ - { if ($2 != OP_REPEAT) - scalar($1); - $$ = newBINOP($2, 0, $1, scalar($3)); - } - | term ADDOP term /* $x + $y */ - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | term SHIFTOP term /* $x >> $y, $x << $y */ - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } +termbinop: term[lhs] ASSIGNOP term[rhs] /* $x = $y, $x += $y */ + { $$ = newASSIGNOP(OPf_STACKED, $lhs, $ASSIGNOP, $rhs); } + | term[lhs] POWOP term[rhs] /* $x ** $y */ + { $$ = newBINOP($POWOP, 0, scalar($lhs), scalar($rhs)); } + | term[lhs] MULOP term[rhs] /* $x * $y, $x x $y */ + { if ($MULOP != OP_REPEAT) + scalar($lhs); + $$ = newBINOP($MULOP, 0, $lhs, scalar($rhs)); + } + | term[lhs] ADDOP term[rhs] /* $x + $y */ + { $$ = newBINOP($ADDOP, 0, scalar($lhs), scalar($rhs)); } + | term[lhs] SHIFTOP term[rhs] /* $x >> $y, $x << $y */ + { $$ = newBINOP($SHIFTOP, 0, scalar($lhs), scalar($rhs)); } | termrelop %prec PREC_LOW /* $x > $y, etc. */ - { $$ = $1; } + { $$ = $termrelop; } | termeqop %prec PREC_LOW /* $x == $y, $x cmp $y */ - { $$ = $1; } - | term BITANDOP term /* $x & $y */ - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | term BITOROP term /* $x | $y */ - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } - | term DOTDOT term /* $x..$y, $x...$y */ - { $$ = newRANGE($2, scalar($1), scalar($3)); } - | term ANDAND term /* $x && $y */ - { $$ = newLOGOP(OP_AND, 0, $1, $3); } - | term OROR term /* $x || $y */ - { $$ = newLOGOP(OP_OR, 0, $1, $3); } - | term DORDOR term /* $x // $y */ - { $$ = newLOGOP(OP_DOR, 0, $1, $3); } - | term MATCHOP term /* $x =~ /$y/ */ - { $$ = bind_match($2, $1, $3); } + { $$ = $termeqop; } + | term[lhs] BITANDOP term[rhs] /* $x & $y */ + { $$ = newBINOP($BITANDOP, 0, scalar($lhs), scalar($rhs)); } + | term[lhs] BITOROP term[rhs] /* $x | $y */ + { $$ = newBINOP($BITOROP, 0, scalar($lhs), scalar($rhs)); } + | term[lhs] DOTDOT term[rhs] /* $x..$y, $x...$y */ + { $$ = newRANGE($DOTDOT, scalar($lhs), scalar($rhs)); } + | term[lhs] ANDAND term[rhs] /* $x && $y */ + { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } + | term[lhs] OROR term[rhs] /* $x || $y */ + { $$ = newLOGOP(OP_OR, 0, $lhs, $rhs); } + | term[lhs] DORDOR term[rhs] /* $x // $y */ + { $$ = newLOGOP(OP_DOR, 0, $lhs, $rhs); } + | term[lhs] MATCHOP term[rhs] /* $x =~ /$y/ */ + { $$ = bind_match($MATCHOP, $lhs, $rhs); } ; termrelop: relopchain %prec PREC_LOW - { $$ = cmpchain_finish($1); } - | term NCRELOP term - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } + { $$ = cmpchain_finish($relopchain); } + | term[lhs] NCRELOP term[rhs] + { $$ = newBINOP($NCRELOP, 0, scalar($lhs), scalar($rhs)); } | termrelop NCRELOP { yyerror("syntax error"); YYERROR; } | termrelop CHRELOP { yyerror("syntax error"); YYERROR; } ; -relopchain: term CHRELOP term - { $$ = cmpchain_start($2, $1, $3); } - | relopchain CHRELOP term - { $$ = cmpchain_extend($2, $1, $3); } +relopchain: term[lhs] CHRELOP term[rhs] + { $$ = cmpchain_start($CHRELOP, $lhs, $rhs); } + | relopchain[lhs] CHRELOP term[rhs] + { $$ = cmpchain_extend($CHRELOP, $lhs, $rhs); } ; termeqop: eqopchain %prec PREC_LOW - { $$ = cmpchain_finish($1); } - | term NCEQOP term - { $$ = newBINOP($2, 0, scalar($1), scalar($3)); } + { $$ = cmpchain_finish($eqopchain); } + | term[lhs] NCEQOP term[rhs] + { $$ = newBINOP($NCEQOP, 0, scalar($lhs), scalar($rhs)); } | termeqop NCEQOP { yyerror("syntax error"); YYERROR; } | termeqop CHEQOP { yyerror("syntax error"); YYERROR; } ; -eqopchain: term CHEQOP term - { $$ = cmpchain_start($2, $1, $3); } - | eqopchain CHEQOP term - { $$ = cmpchain_extend($2, $1, $3); } +eqopchain: term[lhs] CHEQOP term[rhs] + { $$ = cmpchain_start($CHEQOP, $lhs, $rhs); } + | eqopchain[lhs] CHEQOP term[rhs] + { $$ = cmpchain_extend($CHEQOP, $lhs, $rhs); } ; /* Unary operators and terms */ termunop : '-' term %prec UMINUS /* -$x */ - { $$ = newUNOP(OP_NEGATE, 0, scalar($2)); } + { $$ = newUNOP(OP_NEGATE, 0, scalar($term)); } | '+' term %prec UMINUS /* +$x */ - { $$ = $2; } + { $$ = $term; } | '!' term /* !$x */ - { $$ = newUNOP(OP_NOT, 0, scalar($2)); } + { $$ = newUNOP(OP_NOT, 0, scalar($term)); } | '~' term /* ~$x */ - { $$ = newUNOP($1, 0, scalar($2)); } + { $$ = newUNOP($1, 0, scalar($term)); } | term POSTINC /* $x++ */ { $$ = newUNOP(OP_POSTINC, 0, - op_lvalue(scalar($1), OP_POSTINC)); } + op_lvalue(scalar($term), OP_POSTINC)); } | term POSTDEC /* $x-- */ { $$ = newUNOP(OP_POSTDEC, 0, - op_lvalue(scalar($1), OP_POSTDEC));} + op_lvalue(scalar($term), OP_POSTDEC));} | term POSTJOIN /* implicit join after interpolated ->@ */ { $$ = op_convert_list(OP_JOIN, 0, op_append_elem( @@ -1105,184 +1109,184 @@ termunop : '-' term %prec UMINUS /* -$x */ newSVOP(OP_CONST,0, newSVpvs("\"")) )), - $1 + $term )); } | PREINC term /* ++$x */ { $$ = newUNOP(OP_PREINC, 0, - op_lvalue(scalar($2), OP_PREINC)); } + op_lvalue(scalar($term), OP_PREINC)); } | PREDEC term /* --$x */ { $$ = newUNOP(OP_PREDEC, 0, - op_lvalue(scalar($2), OP_PREDEC)); } + op_lvalue(scalar($term), OP_PREDEC)); } ; /* Constructors for anonymous data */ anonymous: '[' expr ']' - { $$ = newANONLIST($2); } + { $$ = newANONLIST($expr); } | '[' ']' { $$ = newANONLIST(NULL);} | HASHBRACK expr ';' '}' %prec '(' /* { foo => "Bar" } */ - { $$ = newANONHASH($2); } + { $$ = newANONHASH($expr); } | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ { $$ = newANONHASH(NULL); } | ANONSUB startanonsub proto subattrlist subbody %prec '(' { SvREFCNT_inc_simple_void(PL_compcv); - $$ = newANONATTRSUB($2, $3, $4, $5); } + $$ = newANONATTRSUB($startanonsub, $proto, $subattrlist, $subbody); } | ANON_SIGSUB startanonsub subattrlist sigsubbody %prec '(' { SvREFCNT_inc_simple_void(PL_compcv); - $$ = newANONATTRSUB($2, NULL, $3, $4); } + $$ = newANONATTRSUB($startanonsub, NULL, $subattrlist, $sigsubbody); } ; /* Things called with "do" */ termdo : DO term %prec UNIOP /* do $filename */ - { $$ = dofile($2, $1);} + { $$ = dofile($term, $DO);} | DO block %prec '(' /* do { code */ - { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($2));} + { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($block));} ; -term : termbinop +term[product] : termbinop | termunop | anonymous | termdo - | term '?' term ':' term - { $$ = newCONDOP(0, $1, $3, $5); } - | REFGEN term /* \$x, \@y, \%z */ - { $$ = newUNOP(OP_REFGEN, 0, $2); } - | MY REFGEN term - { $$ = newUNOP(OP_REFGEN, 0, localize($3,1)); } + | term[condition] '?' term[then] ':' term[else] + { $$ = newCONDOP(0, $condition, $then, $else); } + | REFGEN term[operand] /* \$x, \@y, \%z */ + { $$ = newUNOP(OP_REFGEN, 0, $operand); } + | MY REFGEN term[operand] + { $$ = newUNOP(OP_REFGEN, 0, localize($operand,1)); } | myattrterm %prec UNIOP - { $$ = $1; } - | LOCAL term %prec UNIOP - { $$ = localize($2,0); } + { $$ = $myattrterm; } + | LOCAL term[operand] %prec UNIOP + { $$ = localize($operand,0); } | '(' expr ')' - { $$ = sawparens($2); } + { $$ = sawparens($expr); } | QWLIST - { $$ = $1; } + { $$ = $QWLIST; } | '(' ')' { $$ = sawparens(newNULLLIST()); } | scalar %prec '(' - { $$ = $1; } + { $$ = $scalar; } | star %prec '(' - { $$ = $1; } + { $$ = $star; } | hsh %prec '(' - { $$ = $1; } + { $$ = $hsh; } | ary %prec '(' - { $$ = $1; } + { $$ = $ary; } | arylen %prec '(' /* $#x, $#{ something } */ - { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));} + { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} | subscripted - { $$ = $1; } + { $$ = $subscripted; } | sliceme '[' expr ']' /* array slice */ { $$ = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, - list($3), - ref($1, OP_ASLICE))); - if ($$ && $1) + list($expr), + ref($sliceme, OP_ASLICE))); + if ($$ && $sliceme) $$->op_private |= - $1->op_private & OPpSLICEWARNING; + $sliceme->op_private & OPpSLICEWARNING; } | kvslice '[' expr ']' /* array key/value slice */ { $$ = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, - list($3), - ref(oopsAV($1), OP_KVASLICE))); - if ($$ && $1) + list($expr), + ref(oopsAV($kvslice), OP_KVASLICE))); + if ($$ && $kvslice) $$->op_private |= - $1->op_private & OPpSLICEWARNING; + $kvslice->op_private & OPpSLICEWARNING; } | sliceme '{' expr ';' '}' /* @hash{@keys} */ { $$ = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, - list($3), - ref(oopsHV($1), OP_HSLICE))); - if ($$ && $1) + list($expr), + ref(oopsHV($sliceme), OP_HSLICE))); + if ($$ && $sliceme) $$->op_private |= - $1->op_private & OPpSLICEWARNING; + $sliceme->op_private & OPpSLICEWARNING; } | kvslice '{' expr ';' '}' /* %hash{@keys} */ { $$ = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, - list($3), - ref($1, OP_KVHSLICE))); - if ($$ && $1) + list($expr), + ref($kvslice, OP_KVHSLICE))); + if ($$ && $kvslice) $$->op_private |= - $1->op_private & OPpSLICEWARNING; + $kvslice->op_private & OPpSLICEWARNING; } | THING %prec '(' - { $$ = $1; } + { $$ = $THING; } | amper /* &foo; */ - { $$ = newUNOP(OP_ENTERSUB, 0, scalar($1)); } + { $$ = newUNOP(OP_ENTERSUB, 0, scalar($amper)); } | amper '(' ')' /* &foo() or foo() */ - { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($amper)); } | amper '(' expr ')' /* &foo(@args) or foo(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, $3, scalar($1))); + op_append_elem(OP_LIST, $expr, scalar($amper))); } | NOAMP subname optlistexpr /* foo @args (no parens) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, $3, scalar($2))); - } - | term ARROW '$' '*' - { $$ = newSVREF($1); } - | term ARROW '@' '*' - { $$ = newAVREF($1); } - | term ARROW '%' '*' - { $$ = newHVREF($1); } - | term ARROW '&' '*' + op_append_elem(OP_LIST, $optlistexpr, scalar($subname))); + } + | term[operand] ARROW '$' '*' + { $$ = newSVREF($operand); } + | term[operand] ARROW '@' '*' + { $$ = newAVREF($operand); } + | term[operand] ARROW '%' '*' + { $$ = newHVREF($operand); } + | term[operand] ARROW '&' '*' { $$ = newUNOP(OP_ENTERSUB, 0, - scalar(newCVREF($3,$1))); } - | term ARROW '*' '*' %prec '(' - { $$ = newGVREF(0,$1); } + scalar(newCVREF($3,$operand))); } + | term[operand] ARROW '*' '*' %prec '(' + { $$ = newGVREF(0,$operand); } | LOOPEX /* loop exiting command (goto, last, dump, etc) */ - { $$ = newOP($1, OPf_SPECIAL); + { $$ = newOP($LOOPEX, OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } - | LOOPEX term - { $$ = newLOOPEX($1,$2); } + | LOOPEX term[operand] + { $$ = newLOOPEX($LOOPEX,$operand); } | NOTOP listexpr /* not $foo */ - { $$ = newUNOP(OP_NOT, 0, scalar($2)); } + { $$ = newUNOP(OP_NOT, 0, scalar($listexpr)); } | UNIOP /* Unary op, $_ implied */ - { $$ = newOP($1, 0); } + { $$ = newOP($UNIOP, 0); } | UNIOP block /* eval { foo }* */ - { $$ = newUNOP($1, 0, $2); } - | UNIOP term /* Unary op */ - { $$ = newUNOP($1, 0, $2); } + { $$ = newUNOP($UNIOP, 0, $block); } + | UNIOP term[operand] /* Unary op */ + { $$ = newUNOP($UNIOP, 0, $operand); } | REQUIRE /* require, $_ implied */ - { $$ = newOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0); } - | REQUIRE term /* require Foo */ - { $$ = newUNOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0, $2); } + { $$ = newOP(OP_REQUIRE, $REQUIRE ? OPf_SPECIAL : 0); } + | REQUIRE term[operand] /* require Foo */ + { $$ = newUNOP(OP_REQUIRE, $REQUIRE ? OPf_SPECIAL : 0, $operand); } | UNIOPSUB - { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); } - | UNIOPSUB term /* Sub treated as unop */ + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($UNIOPSUB)); } + | UNIOPSUB term[operand] /* Sub treated as unop */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, $2, scalar($1))); } + op_append_elem(OP_LIST, $operand, scalar($UNIOPSUB))); } | FUNC0 /* Nullary operator */ - { $$ = newOP($1, 0); } + { $$ = newOP($FUNC0, 0); } | FUNC0 '(' ')' - { $$ = newOP($1, 0);} + { $$ = newOP($FUNC0, 0);} | FUNC0OP /* Same as above, but op created in toke.c */ - { $$ = $1; } + { $$ = $FUNC0OP; } | FUNC0OP '(' ')' - { $$ = $1; } + { $$ = $FUNC0OP; } | FUNC0SUB /* Sub treated as nullop */ - { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($1)); } + { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($FUNC0SUB)); } | FUNC1 '(' ')' /* not () */ - { $$ = ($1 == OP_NOT) - ? newUNOP($1, 0, newSVOP(OP_CONST, 0, newSViv(0))) - : newOP($1, OPf_SPECIAL); } + { $$ = ($FUNC1 == OP_NOT) + ? newUNOP($FUNC1, 0, newSVOP(OP_CONST, 0, newSViv(0))) + : newOP($FUNC1, OPf_SPECIAL); } | FUNC1 '(' expr ')' /* not($foo) */ - { $$ = newUNOP($1, 0, $3); } + { $$ = newUNOP($FUNC1, 0, $expr); } | PMFUNC /* m//, s///, qr//, tr/// */ { - if ( $1->op_type != OP_TRANS - && $1->op_type != OP_TRANSR - && (((PMOP*)$1)->op_pmflags & PMf_HAS_CV)) + if ( $PMFUNC->op_type != OP_TRANS + && $PMFUNC->op_type != OP_TRANSR + && (((PMOP*)$PMFUNC)->op_pmflags & PMf_HAS_CV)) { $$ = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); @@ -1290,7 +1294,7 @@ term : termbinop $$ = 0; } SUBLEXSTART listexpr optrepl SUBLEXEND - { $$ = pmruntime($1, $4, $5, 1, $2); } + { $$ = pmruntime($PMFUNC, $listexpr, $optrepl, 1, $2); } | BAREWORD | listop | PLUGEXPR @@ -1298,50 +1302,50 @@ term : termbinop /* "my" declarations, with optional attributes */ myattrterm: MY myterm myattrlist - { $$ = my_attrs($2,$3); } + { $$ = my_attrs($myterm,$myattrlist); } | MY myterm - { $$ = localize($2,1); } + { $$ = localize($myterm,1); } | MY REFGEN myterm myattrlist - { $$ = newUNOP(OP_REFGEN, 0, my_attrs($3,$4)); } + { $$ = newUNOP(OP_REFGEN, 0, my_attrs($myterm,$myattrlist)); } ; /* Things that can be "my"'d */ myterm : '(' expr ')' - { $$ = sawparens($2); } + { $$ = sawparens($expr); } | '(' ')' { $$ = sawparens(newNULLLIST()); } | scalar %prec '(' - { $$ = $1; } + { $$ = $scalar; } | hsh %prec '(' - { $$ = $1; } + { $$ = $hsh; } | ary %prec '(' - { $$ = $1; } + { $$ = $ary; } ; /* Basic list expressions */ optlistexpr: /* NULL */ %prec PREC_LOW { $$ = NULL; } | listexpr %prec PREC_LOW - { $$ = $1; } + { $$ = $listexpr; } ; optexpr: /* NULL */ { $$ = NULL; } | expr - { $$ = $1; } + { $$ = $expr; } ; optrepl: /* NULL */ { $$ = NULL; } | '/' expr - { $$ = $2; } + { $$ = $expr; } ; /* A little bit of trickery to make "for my $foo (@bar)" actually be lexical */ my_scalar: scalar - { parser->in_my = 0; $$ = my($1); } + { parser->in_my = 0; $$ = my($scalar); } ; my_var : scalar @@ -1358,58 +1362,58 @@ my_refgen: MY REFGEN ; amper : '&' indirob - { $$ = newCVREF($1,$2); } + { $$ = newCVREF($1,$indirob); } ; scalar : '$' indirob - { $$ = newSVREF($2); } + { $$ = newSVREF($indirob); } ; ary : '@' indirob - { $$ = newAVREF($2); + { $$ = newAVREF($indirob); if ($$) $$->op_private |= $1; } ; hsh : '%' indirob - { $$ = newHVREF($2); + { $$ = newHVREF($indirob); if ($$) $$->op_private |= $1; } ; arylen : DOLSHARP indirob - { $$ = newAVREF($2); } + { $$ = newAVREF($indirob); } | term ARROW DOLSHARP '*' - { $$ = newAVREF($1); } + { $$ = newAVREF($term); } ; star : '*' indirob - { $$ = newGVREF(0,$2); } + { $$ = newGVREF(0,$indirob); } ; sliceme : ary | term ARROW '@' - { $$ = newAVREF($1); } + { $$ = newAVREF($term); } ; kvslice : hsh | term ARROW '%' - { $$ = newHVREF($1); } + { $$ = newHVREF($term); } ; gelem : star | term ARROW '*' - { $$ = newGVREF(0,$1); } + { $$ = newGVREF(0,$term); } ; /* Indirect objects */ indirob : BAREWORD - { $$ = scalar($1); } + { $$ = scalar($BAREWORD); } | scalar %prec PREC_LOW - { $$ = scalar($1); } + { $$ = scalar($scalar); } | block - { $$ = op_scope($1); } + { $$ = op_scope($block); } | PRIVATEREF - { $$ = $1; } + { $$ = $PRIVATEREF; } ; From b728918b483f9049ab74984ee11e359e8a769b08 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Thu, 22 Oct 2020 23:23:57 +0900 Subject: [PATCH 186/503] toke.c: Recognize "0odddd" octal literals. t/base/num.t: Add some test for "0odddd" octals. --- t/base/num.t | 13 ++++++++++++- toke.c | 12 ++++++++---- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/t/base/num.t b/t/base/num.t index 6ccc0cf92164..2e66bc940ec7 100644 --- a/t/base/num.t +++ b/t/base/num.t @@ -1,6 +1,6 @@ #!./perl -print "1..53\n"; +print "1..56\n"; # First test whether the number stringification works okay. # (Testing with == would exercise the IV/NV part, not the PV.) @@ -211,3 +211,14 @@ print $a eq "16702650" ? "ok 52\n" : "not ok 52 # $a\n"; $a = 0B1101; "$a"; print $a eq "13" ? "ok 53\n" : "not ok 53 # $a\n"; + +# 0odddd octal constants + +$a = 0o100; "$a"; +print $a eq "64" ? "ok 54\n" : "not ok 54 # $a\n"; + +$a = 0o100; "$a"; +print $a + 1 == 0o101 ? "ok 55\n" : "not ok 55 #" . $a + 1 . "\n"; + +$a = 0O1703; "$a"; +print $a eq "963" ? "ok 56\n" : "not ok 56 # $a\n"; diff --git a/toke.c b/toke.c index 9dcc7c3226f1..fd6e9a62a819 100644 --- a/toke.c +++ b/toke.c @@ -11366,7 +11366,7 @@ Perl_scan_str(pTHX_ char *start, int keep_bracketed_quoted, int keep_delims, int \d(_?\d)*(\.(\d(_?\d)*)?)?[Ee][\+\-]?(\d(_?\d)*) 12 12.34 12. \.\d(_?\d)*[Ee][\+\-]?(\d(_?\d)*) .34 0b[01](_?[01])* binary integers - 0[0-7](_?[0-7])* octal integers + 0o?[0-7](_?[0-7])* octal integers 0x[0-9A-Fa-f](_?[0-9A-Fa-f])* hexadecimal integers 0x[0-9A-Fa-f](_?[0-9A-Fa-f])*(?:\.\d*)?p[+-]?[0-9]+ hexadecimal floats @@ -11478,6 +11478,10 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) else { shift = 3; s++; + if (isALPHA_FOLD_EQ(*s, 'o')) { + s++; + just_zero = FALSE; + } } if (*s == '_') { @@ -11755,8 +11759,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) } } - if (shift != 3 && !has_digs) { - /* 0x or 0b with no digits, treat it as an error. + if (!just_zero && !has_digs) { + /* 0x, 0o or 0b with no digits, treat it as an error. Originally this backed up the parse before the b or x, but that has the potential for silent changes in behaviour, like for: "0x.3" and "0x+$foo". @@ -11766,7 +11770,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (*d) ++d; /* so the user sees the bad non-digit */ PL_bufptr = (char *)d; /* so yyerror reports the context */ yyerror(Perl_form(aTHX_ "No digits found for %s literal", - shift == 4 ? "hexadecimal" : "binary")); + base)); PL_bufptr = oldbp; } From 8ea1bb76772cbd78b5a9256d3b8507848e7bb2ec Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Thu, 22 Oct 2020 23:56:58 +0900 Subject: [PATCH 187/503] toke.c: Preserve "0o" prefix on warnings and strings passed to overload hook. --- toke.c | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/toke.c b/toke.c index fd6e9a62a819..37dcbbc939b8 100644 --- a/toke.c +++ b/toke.c @@ -11422,6 +11422,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) NV hexfp_mult = 1.0; UV high_non_zero = 0; /* highest digit */ int non_zero_integer_digits = 0; + bool new_octal = FALSE; /* octal with "0o" prefix */ PERL_ARGS_ASSERT_SCAN_NUM; @@ -11481,6 +11482,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (isALPHA_FOLD_EQ(*s, 'o')) { s++; just_zero = FALSE; + new_octal = TRUE; } } @@ -11491,7 +11493,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) base = bases[shift]; Base = Bases[shift]; - max = maxima[shift]; + max = new_octal ? "0o37777777777" : maxima[shift]; /* read the rest of the number */ for (;;) { @@ -11818,6 +11820,11 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) s = start + 2; break; case 3: + if (new_octal) { + *d++ = 'o'; + s = start + 2; + break; + } s = start + 1; break; case 1: From b15e443511c11c1f196c5a5ca57b89feed452a07 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Fri, 23 Oct 2020 01:07:16 +0900 Subject: [PATCH 188/503] toke.c: Eliminate temporary variables base, Base and max. These variables are only used on emitting diagnostic messages. Calculating them on-demand will make the code slightly faster on normal cases. Note: previously bases[], Bases[] and maxima[] may be completely optimized out by fusing array accesses into if-brances. Now they become real arrays, and will slightly increase the number of dynamic relocations on PIC build. --- toke.c | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/toke.c b/toke.c index 37dcbbc939b8..9d9495f2c894 100644 --- a/toke.c +++ b/toke.c @@ -11460,7 +11460,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) "", "037777777777", "0xffffffff" }; - const char *base, *Base, *max; /* check for hex */ if (isALPHA_FOLD_EQ(s[1], 'x')) { @@ -11491,10 +11490,6 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) lastub = s++; } - base = bases[shift]; - Base = Bases[shift]; - max = new_octal ? "0o37777777777" : maxima[shift]; - /* read the rest of the number */ for (;;) { /* x is used in the overflow test, @@ -11558,7 +11553,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) n = (NV) u; Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW), "Integer overflow in %s number", - base); + bases[shift]); } else u = x | b; /* add the digit to the end */ } @@ -11772,7 +11767,7 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (*d) ++d; /* so the user sees the bad non-digit */ PL_bufptr = (char *)d; /* so yyerror reports the context */ yyerror(Perl_form(aTHX_ "No digits found for %s literal", - base)); + bases[shift])); PL_bufptr = oldbp; } @@ -11780,7 +11775,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (n > 4294967295.0) Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "%s number > %s non-portable", - Base, max); + Bases[shift], + new_octal ? "0o37777777777" : maxima[shift]); sv = newSVnv(n); } else { @@ -11788,7 +11784,8 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp) if (u > 0xffffffff) Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), "%s number > %s non-portable", - Base, max); + Bases[shift], + new_octal ? "0o37777777777" : maxima[shift]); #endif sv = newSVuv(u); } From c279f3d0680f86f0de539f6491362e428af4fbd0 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Fri, 23 Oct 2020 02:14:57 +0900 Subject: [PATCH 189/503] pp.c: oct() now skips "0o" and "o" prefix. t/op/oct.t: Add test for oct() with 0o and o prefix. --- pp.c | 6 +++++- t/op/oct.t | 7 +++++-- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/pp.c b/pp.c index 5b5e1630110f..5e1706346da5 100644 --- a/pp.c +++ b/pp.c @@ -3099,8 +3099,12 @@ PP(pp_oct) flags |= PERL_SCAN_DISALLOW_PREFIX; result_uv = grok_bin (tmps, &len, &flags, &result_nv); } - else + else { + if (isALPHA_FOLD_EQ(*tmps, 'o')) { + tmps++, len--; + } result_uv = grok_oct (tmps, &len, &flags, &result_nv); + } if (flags & PERL_SCAN_GREATER_THAN_UV_MAX) { SETn(result_nv); diff --git a/t/op/oct.t b/t/op/oct.t index 84814b1a0918..6d16ed0ae514 100644 --- a/t/op/oct.t +++ b/t/op/oct.t @@ -1,12 +1,12 @@ #!./perl -# Tests 51 onwards are intentionally not all-warnings-clean +# Tests 53 onwards are intentionally not all-warnings-clean chdir 't' if -d 't'; require './test.pl'; use strict; -plan(tests => 77); +plan(tests => 79); foreach(['0b1_0101', 0b101_01], ['0b10_101', 0_2_5], @@ -55,6 +55,9 @@ foreach(['0b1_0101', 0b101_01], ["XCAFE", 0xCAFE], ["0B101001", 0b101001], ["B101001", 0b101001], + # Additional syntax for octals + ["0o7_654_321", 2054353], + ["O4567", 0o4_567], ) { my ($string, $value) = @$_; my $result = oct $string; From d5619dbd8347f4ba2d4abf09870735a05bafdb79 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Fri, 30 Oct 2020 21:55:03 +0900 Subject: [PATCH 190/503] perldata.pod: mention new octal integer format (0o12_345). --- pod/perldata.pod | 1 + 1 file changed, 1 insertion(+) diff --git a/pod/perldata.pod b/pod/perldata.pod index dc9dc6d034bb..7cae8b260945 100644 --- a/pod/perldata.pod +++ b/pod/perldata.pod @@ -444,6 +444,7 @@ integer formats: 0xff # hex 0xdead_beef # more hex 0377 # octal (only numbers, begins with 0) + 0o12_345 # alternative octal (introduced in Perl 5.33.5) 0b011011 # binary 0x1.999ap-4 # hexadecimal floating point (the 'p' is required) From cdaf905248c79cede67400333383fafe6db30255 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Sat, 31 Oct 2020 14:15:27 +0900 Subject: [PATCH 191/503] perlfunc.pod: add a description for octal strings for oct() These sentences are borrowed from the description for hex(). --- pod/perlfunc.pod | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index d1c2ffaba47b..de24eef27465 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -4432,7 +4432,10 @@ X X X X X X =for Pod::Functions convert a string to an octal number Interprets EXPR as an octal string and returns the corresponding -value. (If EXPR happens to start off with C<0x> or C, interprets it as a +value. An octal string consists of octal digits and, as of Perl 5.33.5, +an optional C<0o> or C prefix. Each octal digit may be preceded by +a single underscore, which will be ignored. +(If EXPR happens to start off with C<0x> or C, interprets it as a hex string. If EXPR starts off with C<0b> or C, it is interpreted as a binary string. Leading whitespace is ignored in all three cases.) The following will handle decimal, binary, octal, and hex in standard From 54e31e2485e0fb4822dfa38ac496790a2d877f3c Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Tue, 1 Dec 2020 09:50:35 +0900 Subject: [PATCH 192/503] perldelta.pod: Document new "0o" octal syntax. --- pod/perldelta.pod | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index d0c4daa2c6db..8d4cf7e9e07e 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -27,6 +27,15 @@ here, but most should go in the L section. [ List each enhancement as a =head2 entry ] +=head2 New octal syntax C<0oI> + +It is now possible to specify octal literals with C<0o> prefixes, +as in C<0o123_456>, parallel to the existing construct to specify +hexadecimal literal C<0xI> and binary literal C<0bI>. +Also, the builtin C function now accepts this new syntax. + +See L and L. + =head1 Security XXX Any security-related notices go here. In particular, any security From bc13a79e197e191d2c6cb0ec76217e27e0932575 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Tue, 8 Dec 2020 09:50:47 +0000 Subject: [PATCH 193/503] perly.y: avoid <0 test on unsigned value Coverity CID 313707 Moving to a newer version of Bison has changed how the YYTRANSLATE() macro is defined: in particular it now has a <0 test, which Coverity is complaining about, since the arg is an unsigned value. This commit just casts the arg back to a signed value. In more detail: we formerly had: yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); yychar is of type int, but NATIVE_TO_UNI returns a UV. So just cast the result back to an int: yytoken = YYTRANSLATE((int)NATIVE_TO_UNI(parser->yychar)); --- perly.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/perly.c b/perly.c index 091371937ddf..ad79c49c4998 100644 --- a/perly.c +++ b/perly.c @@ -297,7 +297,7 @@ Perl_yyparse (pTHX_ int gramtype) /* initialise state for this parse */ parser->yychar = gramtype; - yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); + yytoken = YYTRANSLATE((int)NATIVE_TO_UNI(parser->yychar)); parser->yyerrstatus = 0; parser->yylen = 0; @@ -369,11 +369,11 @@ Perl_yyparse (pTHX_ int gramtype) * characters in that range, but all tokens it returns are * either 0, or above 255. There could be a problem if NULs * weren't 0, or were ever returned as raw chars by yylex() */ - yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)); + yytoken = YYTRANSLATE((int)NATIVE_TO_UNI(parser->yychar)); } /* make sure no-one's changed yychar since the last call to yylex */ - assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar))); + assert(yytoken == YYTRANSLATE((int)NATIVE_TO_UNI(parser->yychar))); YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval); From e5dcc6f14fb84e2e304bafe65111baa5c0fef0c9 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Tue, 8 Dec 2020 11:58:44 +0000 Subject: [PATCH 194/503] Here be camels --- Porting/Maintainers.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 269e919af6fd..4f9030c09c47 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -812,7 +812,7 @@ package Maintainers; }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20201020.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20201120.tar.gz', 'FILES' => q[dist/Module-CoreList], }, From 066646363b13856748eb8e0266f99e1470e0dd43 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 2 Dec 2020 17:00:09 +0000 Subject: [PATCH 195/503] Remove empty "#ifdef"s --- hv.c | 4 ---- mg.c | 4 ---- op.c | 4 ---- pad.c | 2 -- perl.c | 2 -- perlvars.h | 3 --- regcomp.c | 4 ---- util.c | 4 ---- 8 files changed, 27 deletions(-) diff --git a/hv.c b/hv.c index 32e1a7d4387e..8f7dbdcc3b2d 100644 --- a/hv.c +++ b/hv.c @@ -3681,8 +3681,6 @@ no action occurs in this case. void Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) { -#ifdef USE_ITHREADS -#endif PERL_UNUSED_CONTEXT; while (he) { @@ -3719,8 +3717,6 @@ to this function: no action occurs and a null pointer is returned. struct refcounted_he * Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he) { -#ifdef USE_ITHREADS -#endif PERL_UNUSED_CONTEXT; if (he) { HINTS_REFCNT_LOCK; diff --git a/mg.c b/mg.c index f302489fffba..fcbefff8fa37 100644 --- a/mg.c +++ b/mg.c @@ -2764,8 +2764,6 @@ static void S_set_dollarzero(pTHX_ SV *sv) PERL_TSA_REQUIRES(PL_dollarzero_mutex) { -#ifdef USE_ITHREADS -#endif const char *s; STRLEN len; #ifdef HAS_SETPROCTITLE @@ -2842,8 +2840,6 @@ S_set_dollarzero(pTHX_ SV *sv) int Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) { -#ifdef USE_ITHREADS -#endif I32 paren; const REGEXP * rx; I32 i; diff --git a/op.c b/op.c index 421387ed107b..822ea18a5b6a 100644 --- a/op.c +++ b/op.c @@ -1406,8 +1406,6 @@ void Perl_op_refcnt_lock(pTHX) PERL_TSA_ACQUIRE(PL_op_mutex) { -#ifdef USE_ITHREADS -#endif PERL_UNUSED_CONTEXT; OP_REFCNT_LOCK; } @@ -1416,8 +1414,6 @@ void Perl_op_refcnt_unlock(pTHX) PERL_TSA_RELEASE(PL_op_mutex) { -#ifdef USE_ITHREADS -#endif PERL_UNUSED_CONTEXT; OP_REFCNT_UNLOCK; } diff --git a/pad.c b/pad.c index 9283e43867b4..2af0e1958e9f 100644 --- a/pad.c +++ b/pad.c @@ -2186,8 +2186,6 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, static CV * S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned) { -#ifdef USE_ITHREADS -#endif const bool newcv = !cv; assert(!CvUNIQUE(proto)); diff --git a/perl.c b/perl.c index 57db3ed7b35f..3c97ed5f0473 100644 --- a/perl.c +++ b/perl.c @@ -4536,8 +4536,6 @@ Perl_init_argv_symbols(pTHX_ int argc, char **argv) STATIC void S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env) { -#ifdef USE_ITHREADS -#endif GV* tmpgv; PERL_ARGS_ASSERT_INIT_POSTDUMP_SYMBOLS; diff --git a/perlvars.h b/perlvars.h index b7ee1c69453e..a479df741e94 100644 --- a/perlvars.h +++ b/perlvars.h @@ -307,6 +307,3 @@ PERLVARI(G, strategy_socket, int, 0) /* doio.c */ PERLVARI(G, strategy_accept, int, 0) /* doio.c */ PERLVARI(G, strategy_pipe, int, 0) /* doio.c */ PERLVARI(G, strategy_socketpair, int, 0) /* doio.c */ - -#ifdef PERL_IMPLICIT_CONTEXT -#endif diff --git a/regcomp.c b/regcomp.c index 0c8beb0ead85..d2433a4df190 100644 --- a/regcomp.c +++ b/regcomp.c @@ -21804,8 +21804,6 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) Used in stclass optimization only */ U32 refcount; reg_ac_data *aho=(reg_ac_data*)ri->data->data[n]; -#ifdef USE_ITHREADS -#endif OP_REFCNT_LOCK; refcount = --aho->refcount; OP_REFCNT_UNLOCK; @@ -21832,8 +21830,6 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) /* trie structure. */ U32 refcount; reg_trie_data *trie=(reg_trie_data*)ri->data->data[n]; -#ifdef USE_ITHREADS -#endif OP_REFCNT_LOCK; refcount = --trie->refcount; OP_REFCNT_UNLOCK; diff --git a/util.c b/util.c index 40e6b8dc1026..1bfa7f5764e7 100644 --- a/util.c +++ b/util.c @@ -3087,8 +3087,6 @@ Perl_rsignal_state(pTHX_ int signo) int Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save) { -#ifdef USE_ITHREADS -#endif struct sigaction act; PERL_ARGS_ASSERT_RSIGNAL_SAVE; @@ -3116,8 +3114,6 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save) int Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) { -#ifdef USE_ITHREADS -#endif PERL_UNUSED_CONTEXT; #ifdef USE_ITHREADS /* only "parent" interpreter can diddle signals */ From d80154ffa1c0f9a77bcac763de4a167b55f3cf6f Mon Sep 17 00:00:00 2001 From: Jae Bradley Date: Tue, 1 Dec 2020 15:04:51 -0500 Subject: [PATCH 196/503] Explicitly use Catalina when running the test with Xcode 11 --- .github/workflows/testsuite.yml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 6d422abc64ed..0410b267a4c9 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -200,9 +200,9 @@ jobs: # | ' \/ _` / _| (_) \__ \ # |_|_|_\__,_\__|\___/|___/ - smoke-macos-xcode11: - name: "macOS xcode 11" - runs-on: macos-latest + smoke-macos-catalina-xcode11: + name: "macOS (catalina) xcode 11" + runs-on: macos-10.0 timeout-minutes: 120 needs: sanity_check if: needs.sanity_check.outputs.run_all_jobs == 'true' From cc04fa37bfe2b41ccfd39e878b34d4b197711b07 Mon Sep 17 00:00:00 2001 From: Jae Bradley Date: Tue, 1 Dec 2020 18:40:12 -0500 Subject: [PATCH 197/503] Add Jae Bradley as an Author --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 353c21de4ca8..37bcf370bf0f 100644 --- a/AUTHORS +++ b/AUTHORS @@ -558,6 +558,7 @@ Jacques Germishuys Jacqui Caren Jake Hamby Jakub Wilk +Jae Bradley James James A. Duncan James Clarke From 279633da0f9494ca3269d6adcf6d5789880b47b5 Mon Sep 17 00:00:00 2001 From: Jae Bradley Date: Tue, 1 Dec 2020 18:48:55 -0500 Subject: [PATCH 198/503] Use macOS-10.15 explicitly --- .github/workflows/testsuite.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index 0410b267a4c9..f2902641b878 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -202,7 +202,7 @@ jobs: smoke-macos-catalina-xcode11: name: "macOS (catalina) xcode 11" - runs-on: macos-10.0 + runs-on: macos-10.15 timeout-minutes: 120 needs: sanity_check if: needs.sanity_check.outputs.run_all_jobs == 'true' From 916fa2c0cf05c47daa5c94e8b08867ccbf48350d Mon Sep 17 00:00:00 2001 From: Jae Bradley Date: Tue, 1 Dec 2020 19:35:30 -0500 Subject: [PATCH 199/503] Update the Xcode version in the testsuite.yml workflow Xcode v12 is now the default Xcode version: https://github.com/actions/virtual-environments/issues/2056 --- .github/workflows/testsuite.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/testsuite.yml b/.github/workflows/testsuite.yml index f2902641b878..ad3b097a2606 100644 --- a/.github/workflows/testsuite.yml +++ b/.github/workflows/testsuite.yml @@ -200,8 +200,8 @@ jobs: # | ' \/ _` / _| (_) \__ \ # |_|_|_\__,_\__|\___/|___/ - smoke-macos-catalina-xcode11: - name: "macOS (catalina) xcode 11" + smoke-macos-catalina-xcode12: + name: "macOS (catalina) xcode 12" runs-on: macos-10.15 timeout-minutes: 120 needs: sanity_check From 41b27f0d99d7965e0089e23753f23f7ed9525f13 Mon Sep 17 00:00:00 2001 From: Jae Bradley Date: Sat, 5 Dec 2020 15:57:16 -0500 Subject: [PATCH 200/503] Add author name in alphabetically correct place --- AUTHORS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/AUTHORS b/AUTHORS index 37bcf370bf0f..4ed86714cfe6 100644 --- a/AUTHORS +++ b/AUTHORS @@ -556,9 +556,9 @@ Jacinta Richardson Jack Shirazi Jacques Germishuys Jacqui Caren +Jae Bradley Jake Hamby Jakub Wilk -Jae Bradley James James A. Duncan James Clarke From 0d601f070cc1266b97443bae69f7f8eb34fa93ab Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Dec 2020 15:16:41 -0700 Subject: [PATCH 201/503] Fix up many-reader mutex typedef This previously worked on some compilers, but not others. --- perl.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/perl.h b/perl.h index e1b6b1819698..fa0eb07b2088 100644 --- a/perl.h +++ b/perl.h @@ -3342,11 +3342,11 @@ typedef pthread_key_t perl_key; # endif /* Many readers; single writer */ -typedef struct perl_RnW1_mutex { +typedef struct { perl_mutex lock; perl_cond zero_readers; Size_t readers_count; -} Perl_W1Rn_mutex_t; +} perl_RnW1_mutex_t; #endif /* USE_ITHREADS */ From 8fdf38a3a7e83738cbf9bba10ba3fe687963fe2f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Dec 2020 15:43:45 -0700 Subject: [PATCH 202/503] duplocale() is part of Posix 2008 locales Thus if we know we have the Posix versions, we have duplocale(), and hence don't need to test separately for it. --- locale.c | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/locale.c b/locale.c index 5970423404d3..d3ab14aab21b 100644 --- a/locale.c +++ b/locale.c @@ -2620,8 +2620,7 @@ S_my_nl_langinfo(const int item, bool toggle) #if defined(HAS_NL_LANGINFO) /* nl_langinfo() is available. */ # if ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ - || ! defined(HAS_POSIX_2008_LOCALE) \ - || ! defined(HAS_DUPLOCALE) + || ! defined(HAS_POSIX_2008_LOCALE) /* Here, use plain nl_langinfo(), switching to the underlying LC_NUMERIC * for those items dependent on it. This must be copied to a buffer before @@ -5303,8 +5302,7 @@ Perl_my_strerror(pTHX_ const int errnum) } # elif defined(USE_POSIX_2008_LOCALE) \ - && defined(HAS_STRERROR_L) \ - && defined(HAS_DUPLOCALE) + && defined(HAS_STRERROR_L) /* This function is also trivial if we don't have to worry about thread * safety and have strerror_l(), as it handles the switch of locales so we From cfaae47f842a064f1d08fc0cd008d997947d057a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Dec 2020 15:45:20 -0700 Subject: [PATCH 203/503] locale.c: Add debugging info to panic message --- locale.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/locale.c b/locale.c index d3ab14aab21b..d399d9c40d7d 100644 --- a/locale.c +++ b/locale.c @@ -5394,8 +5394,8 @@ Perl_my_strerror(pTHX_ const int errnum) if (save_locale && ! locale_is_C) { if (! do_setlocale_c(LC_MESSAGES, save_locale)) { Perl_croak(aTHX_ - "panic: %s: %d: setlocale restore failed, errno=%d\n", - __FILE__, __LINE__, errno); + "panic: %s: %d: setlocale restore to '%s' failed, errno=%d\n", + __FILE__, __LINE__, save_locale, errno); } Safefree(save_locale); } From 8609fe004ed37605b00f517feb6e9c8eb127952c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 29 Nov 2020 17:05:13 -0700 Subject: [PATCH 204/503] Change name of mutex macro. This macro is for localeconv(); the new name is clearer as to the meaning, and this preps for further changes. --- ext/POSIX/POSIX.xs | 6 +++--- locale.c | 14 +++++++------- perl.h | 12 ++++++------ 3 files changed, 16 insertions(+), 16 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 139ee89ca7ad..0f750c0dc6f7 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -2185,8 +2185,8 @@ localeconv() lcbuf = localeconv_l(cur); # else - LOCALE_LOCK_V; /* Prevent interference with other threads using - localeconv() */ + LOCALECONV_LOCK; /* Prevent interference with other threads using + localeconv() */ # ifdef TS_W32_BROKEN_LOCALECONV /* This is a workaround for a Windows bug prior to VS 15, in which * localeconv only looks at the global locale. We toggle to the global @@ -2271,7 +2271,7 @@ localeconv() Safefree(save_global); Safefree(save_thread); # endif - LOCALE_UNLOCK_V; + LOCALECONV_UNLOCK; # endif RESTORE_LC_NUMERIC(); #endif /* HAS_LOCALECONV */ diff --git a/locale.c b/locale.c index d399d9c40d7d..5dea47fcc1e1 100644 --- a/locale.c +++ b/locale.c @@ -2819,8 +2819,8 @@ S_my_nl_langinfo(const int item, bool toggle) /* We don't bother with localeconv_l() because any system that * has it is likely to also have nl_langinfo() */ - LOCALE_LOCK_V; /* Prevent interference with other threads - using localeconv() */ + LOCALECONV_LOCK; /* Prevent interference with other threads + using localeconv() */ # ifdef TS_W32_BROKEN_LOCALECONV @@ -2847,7 +2847,7 @@ S_my_nl_langinfo(const int item, bool toggle) || ! lc->currency_symbol || strEQ("", lc->currency_symbol)) { - LOCALE_UNLOCK_V; + LOCALECONV_UNLOCK; return ""; } @@ -2877,7 +2877,7 @@ S_my_nl_langinfo(const int item, bool toggle) # endif - LOCALE_UNLOCK_V; + LOCALECONV_UNLOCK; break; # ifdef TS_W32_BROKEN_LOCALECONV @@ -2950,8 +2950,8 @@ S_my_nl_langinfo(const int item, bool toggle) STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); } - LOCALE_LOCK_V; /* Prevent interference with other threads - using localeconv() */ + LOCALECONV_LOCK; /* Prevent interference with other threads + using localeconv() */ # ifdef TS_W32_BROKEN_LOCALECONV @@ -3003,7 +3003,7 @@ S_my_nl_langinfo(const int item, bool toggle) # endif - LOCALE_UNLOCK_V; + LOCALECONV_UNLOCK; if (toggle) { RESTORE_LC_NUMERIC(); diff --git a/perl.h b/perl.h index fa0eb07b2088..9d4f11be279a 100644 --- a/perl.h +++ b/perl.h @@ -6522,13 +6522,13 @@ the plain locale pragma without a parameter (S>) is in effect. * a few places where there is a broken localeconv(), but otherwise things are * thread safe, and hence don't need locking. Just below LOCALE_LOCK and * LOCALE_UNLOCK are defined in terms of these for use everywhere else */ -# define LOCALE_LOCK_V \ +# define LOCALECONV_LOCK \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: locking locale\n", __FILE__, __LINE__)); \ MUTEX_LOCK(&PL_locale_mutex); \ } STMT_END -# define LOCALE_UNLOCK_V \ +# define LOCALECONV_UNLOCK \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \ @@ -6544,8 +6544,8 @@ the plain locale pragma without a parameter (S>) is in effect. # define LC_NUMERIC_LOCK(cond) # define LC_NUMERIC_UNLOCK # else -# define LOCALE_LOCK LOCALE_LOCK_V -# define LOCALE_UNLOCK LOCALE_UNLOCK_V +# define LOCALE_LOCK LOCALECONV_LOCK +# define LOCALE_UNLOCK LOCALECONV_UNLOCK /* We also need to lock LC_NUMERIC for non-windows (hence Posix 2008) * systems */ @@ -6625,9 +6625,9 @@ the plain locale pragma without a parameter (S>) is in effect. #else /* Below is no locale sync needed */ # define LOCALE_INIT # define LOCALE_LOCK -# define LOCALE_LOCK_V +# define LOCALECONV_LOCK # define LOCALE_UNLOCK -# define LOCALE_UNLOCK_V +# define LOCALECONV_UNLOCK # define LC_NUMERIC_LOCK(cond) # define LC_NUMERIC_UNLOCK # define LOCALE_TERM From d9e22c6a8a05aab7fffdbf810f74ddfcb4efd752 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 09:46:34 -0700 Subject: [PATCH 205/503] Refactor locale mutex setup This was prompted by my realization that even on a locale thread-safe platform, there are functions we call that may not be thread-safe in that they return their results in an internal static buffer, which may be process-wide instead of per-thread. Tomasz Konojacki++ briefly looked at Windows source code for localeconv() and this indeed did appear to be the case. If we thought a platform was thread-safe, no locale mutexes were set up, and instead the calls in the code to lock were no-oops. This would lead to potential races, the most likely candidate being localeconv(). None have been reported, at least as far as we know. Likely that function isn't called frequently. This would be true on both Posix 2008 and Windows platforms, except possibly for FreeBSD, which may be the only platform that we support that has a localeconv_l() function, which is supposed to be immune from this issue.. The solution adopted here is to test for all the possible functions that the Perl core uses that may be susceptible to this, and to set up the mutex if any are found. Thus there won't be no-ops where there should be a lock. --- makedef.pl | 3 - perl.h | 188 ++++++++++++++++++++++++++++++----------------------- perlvars.h | 2 - 3 files changed, 108 insertions(+), 85 deletions(-) diff --git a/makedef.pl b/makedef.pl index 9af199d9a285..1d1941f5893b 100644 --- a/makedef.pl +++ b/makedef.pl @@ -455,9 +455,6 @@ sub readvar { if ($define{USE_THREAD_SAFE_LOCALE}) { ++$skip{PL_lc_numeric_mutex}; ++$skip{PL_lc_numeric_mutex_depth}; - if (! $define{TS_W32_BROKEN_LOCALECONV}) { - ++$skip{PL_locale_mutex}; - } } unless ($define{'USE_DTRACE'}) { diff --git a/perl.h b/perl.h index 9d4f11be279a..959ddfe407be 100644 --- a/perl.h +++ b/perl.h @@ -6483,89 +6483,91 @@ the plain locale pragma without a parameter (S>) is in effect. #endif -/* Locale/thread synchronization macros. These aren't needed if using - * thread-safe locale operations, except if something is broken */ -#if defined(USE_LOCALE) \ - && defined(USE_ITHREADS) \ - && (! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV)) - -/* We have a locale object holding the 'C' locale for Posix 2008 */ -# ifndef USE_POSIX_2008_LOCALE -# define _LOCALE_TERM_POSIX_2008 NOOP -# else -# define _LOCALE_TERM_POSIX_2008 \ - STMT_START { \ - if (PL_C_locale_obj) { \ - /* Make sure we aren't using the locale \ - * space we are about to free */ \ - uselocale(LC_GLOBAL_LOCALE); \ - freelocale(PL_C_locale_obj); \ - PL_C_locale_obj = (locale_t) NULL; \ - } \ - } STMT_END -# endif +/* Locale/thread synchronization macros. */ +#if ! ( defined(USE_LOCALE) \ + && defined(USE_ITHREADS) \ + && ( ! defined(USE_THREAD_SAFE_LOCALE) \ + || ( defined(HAS_LOCALECONV) \ + && ( ! defined(HAS_LOCALECONV_L) \ + || defined(TS_W32_BROKEN_LOCALECONV))) \ + || ( defined(HAS_NL_LANGINFO) \ + && ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L)) \ + || (defined(HAS_MBLEN) && ! defined(HAS_MBRLEN)) \ + || (defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC)) \ + || (defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB)))) + +/* The whole expression just above was complemented, so here we have no need + * for thread synchronization, most likely it would be that this isn't a + * threaded build. */ +# define LOCALE_INIT +# define LOCALE_TERM +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP +# define LOCALECONV_LOCK NOOP +# define LOCALECONV_UNLOCK NOOP +#else -/* This is used as a generic lock for locale operations. For example this is - * used when calling nl_langinfo() so that another thread won't zap the - * contents of its buffer before it gets saved; and it's called when changing - * the locale of LC_MESSAGES. On some systems the latter can cause the - * nl_langinfo buffer to be zapped under a race condition. - * - * If combined with LC_NUMERIC_LOCK, calls to this and its corresponding unlock - * should be contained entirely within the locked portion of LC_NUMERIC. This - * mutex should be used only in very short sections of code, while - * LC_NUMERIC_LOCK may span more operations. By always following this - * convention, deadlock should be impossible. But if necessary, the two - * mutexes could be combined. - * - * Actually, the two macros just below with the '_V' suffixes are used in just - * a few places where there is a broken localeconv(), but otherwise things are - * thread safe, and hence don't need locking. Just below LOCALE_LOCK and - * LOCALE_UNLOCK are defined in terms of these for use everywhere else */ -# define LOCALECONV_LOCK \ + /* Here, we will need critical sections in locale handling, because one or + * more of the above conditions are true. This could be because the + * platform doesn't have thread-safe locales, or that at least one of the + * locale-dependent functions in the core isn't thread-safe. The latter + * case is generally because they return a pointer to a static buffer, which + * may be per-process instead of per-thread. There are supposedly + * re-entrant, safe versions for all of them Perl currently uses (which the + * #if above checks for), but most platforms don't have all the needed ones + * available, and the Posix standard doesn't require nl_langinfo_l() to be + * fully thread-safe, so a Configure probe was written. localeconv_l() is + * uncommon, and judging by bug reports on the web, some earlier library + * localeconv_l versions were broken, so perhaps a probe is in order for + * that, but it would be a pain to write. + * + * On non-thread-safe systems, some of the above functions are vulnerable to + * races should another thread get control and change the locale in the + * middle of their execution. + * + * We currently use a single mutex for all these cases. This solves both + * the problem of another thread changing the locale, and the buffer being + * overwritten (the code copies the results to a safe place before releasing + * the mutex). Ideally, for locale thread-safe platforms where the only + * issue is another thread clobbering the function's static buffer, there + * would be a separate mutex for each such buffer. Otherwise, things get + * locked that don't need to. But, it is not expected that any of these + * will be called frequently, and the locked interval should be short, and + * modern platforms will have reentrant versions (which don't lock) for + * almost all of them, so khw thinks a single mutex should suffice. */ +# define LOCALE_LOCK \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: locking locale\n", __FILE__, __LINE__)); \ MUTEX_LOCK(&PL_locale_mutex); \ } STMT_END -# define LOCALECONV_UNLOCK \ +# define LOCALE_UNLOCK \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \ MUTEX_UNLOCK(&PL_locale_mutex); \ } STMT_END -/* On windows, we just need the mutex for LOCALE_LOCK */ -# ifdef TS_W32_BROKEN_LOCALECONV -# define LOCALE_LOCK NOOP -# define LOCALE_UNLOCK NOOP -# define LOCALE_INIT MUTEX_INIT(&PL_locale_mutex); -# define LOCALE_TERM MUTEX_DESTROY(&PL_locale_mutex) -# define LC_NUMERIC_LOCK(cond) -# define LC_NUMERIC_UNLOCK +# define LOCALECONV_LOCK LOCALE_LOCK +# define LOCALECONV_UNLOCK LOCALE_UNLOCK +# if defined(USE_THREAD_SAFE_LOCALE) + /* On locale thread-safe systems, we don't need these workarounds */ +# define LOCALE_TERM_LC_NUMERIC_ NOOP +# define LOCALE_INIT_LC_NUMERIC_ NOOP +# define LC_NUMERIC_LOCK(cond) NOOP +# define LC_NUMERIC_UNLOCK NOOP +# define LOCALE_INIT_LC_NUMERIC_ NOOP +# define LOCALE_TERM_LC_NUMERIC_ NOOP # else -# define LOCALE_LOCK LOCALECONV_LOCK -# define LOCALE_UNLOCK LOCALECONV_UNLOCK - /* We also need to lock LC_NUMERIC for non-windows (hence Posix 2008) - * systems */ -# define LOCALE_INIT STMT_START { \ - MUTEX_INIT(&PL_locale_mutex); \ - MUTEX_INIT(&PL_lc_numeric_mutex); \ - } STMT_END - -# define LOCALE_TERM STMT_START { \ - MUTEX_DESTROY(&PL_locale_mutex); \ - MUTEX_DESTROY(&PL_lc_numeric_mutex); \ - _LOCALE_TERM_POSIX_2008; \ - } STMT_END - - /* This mutex is used to create critical sections where we want the - * LC_NUMERIC locale to be locked into either the C (standard) locale, or - * the underlying locale, so that other threads interrupting this one don't - * change it to the wrong state before we've had a chance to complete our - * operation. It can stay locked over an entire printf operation, for - * example. And so is made distinct from the LOCALE_LOCK mutex. + /* On platforms without per-thread locales, when another thread can switch + * our locale, we need another mutex to create critical sections where we + * want the LC_NUMERIC locale to be locked into either the C (standard) + * locale, or the underlying locale, so that other threads interrupting + * this one don't change it to the wrong state before we've had a chance to + * complete our operation. It can stay locked over an entire printf + * operation, for example. And so is made distinct from the LOCALE_LOCK + * mutex. * * This simulates kind of a general semaphore. The current thread will * lock the mutex if the per-thread variable is zero, and then increments @@ -6579,7 +6581,13 @@ the plain locale pragma without a parameter (S>) is in effect. * * Clang improperly gives warnings for this, if not silenced: * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks - * */ + * + * If LC_NUMERIC_LOCK is combined with LOCALE_LOCK, calls to + * that and its corresponding unlock should be contained entirely within + * the locked portion of LC_NUMERIC. Those mutexes should be used only in + * very short sections of code, while LC_NUMERIC_LOCK may span more + * operations. By always following this convention, deadlock should be + * impossible. But if necessary, the two mutexes could be combined. */ # define LC_NUMERIC_LOCK(cond_to_panic_if_already_locked) \ CLANG_DIAG_IGNORE(-Wthread-safety) \ STMT_START { \ @@ -6621,16 +6629,36 @@ the plain locale pragma without a parameter (S>) is in effect. } STMT_END \ CLANG_DIAG_RESTORE -# endif /* End of needs locking LC_NUMERIC */ -#else /* Below is no locale sync needed */ -# define LOCALE_INIT -# define LOCALE_LOCK -# define LOCALECONV_LOCK -# define LOCALE_UNLOCK -# define LOCALECONV_UNLOCK -# define LC_NUMERIC_LOCK(cond) -# define LC_NUMERIC_UNLOCK -# define LOCALE_TERM +# define LOCALE_INIT_LC_NUMERIC_ MUTEX_INIT(&PL_lc_numeric_mutex) +# define LOCALE_TERM_LC_NUMERIC_ MUTEX_DESTROY(&PL_lc_numeric_mutex) +# endif + +# ifdef USE_POSIX_2008_LOCALE + /* We have a locale object holding the 'C' locale for Posix 2008 */ +# define LOCALE_TERM_POSIX_2008_ \ + STMT_START { \ + if (PL_C_locale_obj) { \ + /* Make sure we aren't using the locale \ + * space we are about to free */ \ + uselocale(LC_GLOBAL_LOCALE); \ + freelocale(PL_C_locale_obj); \ + PL_C_locale_obj = (locale_t) NULL; \ + } \ + } STMT_END +# else +# define LOCALE_TERM_POSIX_2008_ NOOP +# endif + +# define LOCALE_INIT STMT_START { \ + MUTEX_INIT(&PL_locale_mutex); \ + LOCALE_INIT_LC_NUMERIC_; \ + } STMT_END + +# define LOCALE_TERM STMT_START { \ + MUTEX_DESTROY(&PL_locale_mutex); \ + LOCALE_TERM_LC_NUMERIC_; \ + LOCALE_TERM_POSIX_2008_; \ + } STMT_END #endif #ifdef USE_LOCALE_NUMERIC diff --git a/perlvars.h b/perlvars.h index a479df741e94..1bbe5e3ed379 100644 --- a/perlvars.h +++ b/perlvars.h @@ -105,9 +105,7 @@ PERLVARI(G, mmap_page_size, IV, 0) #if defined(USE_ITHREADS) PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted he refcounting */ PERLVAR(G, env_mutex, perl_mutex) /* Mutex for accessing ENV */ -# if ! defined(USE_THREAD_SAFE_LOCALE) || defined(TS_W32_BROKEN_LOCALECONV) PERLVAR(G, locale_mutex, perl_mutex) /* Mutex related to locale handling */ -# endif # ifndef USE_THREAD_SAFE_LOCALE PERLVAR(G, lc_numeric_mutex, perl_mutex) /* Mutex for switching LC_NUMERIC */ # endif From 7953f73fd803e53f20bdf0801f194691543b0f87 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 30 Nov 2020 10:11:01 -0700 Subject: [PATCH 206/503] Name individual locale locks These locks for different functions all use the same underlying mutex; but that may not always be the case. By creating separate names used only when we think they will be necessary, the compiler will complain if the conditions in the code that actually use them are the same. Doing this showed a misspelling in an #ifdef, fixed in 9289d4dc7a3d24b20c6e25045e687321ee3e8faf --- ext/POSIX/POSIX.xs | 24 ++++++++++----------- locale.c | 32 +++++++++++++--------------- perl.h | 53 +++++++++++++++++++++++++++++++++++++++++----- 3 files changed, 75 insertions(+), 34 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 0f750c0dc6f7..6bd30e847419 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -3376,9 +3376,9 @@ mblen(s, n = ~0) memzero(&PL_mbrlen_ps, sizeof(PL_mbrlen_ps)); RETVAL = 0; #else - LOCALE_LOCK; + MBLEN_LOCK; RETVAL = mblen(NULL, 0); - LOCALE_UNLOCK; + MBLEN_UNLOCK; #endif } else { /* Not resetting state */ @@ -3398,9 +3398,9 @@ mblen(s, n = ~0) #else /* Locking prevents races, but locales can be switched out * without locking, so this isn't a cure all */ - LOCALE_LOCK; + MBLEN_LOCK; RETVAL = mblen(string, len); - LOCALE_UNLOCK; + MBLEN_UNLOCK; #endif } } @@ -3427,9 +3427,9 @@ mbtowc(pwc, s, n = ~0) memzero(&PL_mbrtowc_ps, sizeof(PL_mbrtowc_ps)); RETVAL = 0; #else - LOCALE_LOCK; + MBTOWC_LOCK; RETVAL = mbtowc(NULL, NULL, 0); - LOCALE_UNLOCK; + MBTOWC_UNLOCK; #endif } else { /* Not resetting state */ @@ -3448,9 +3448,9 @@ mbtowc(pwc, s, n = ~0) #else /* Locking prevents races, but locales can be switched out * without locking, so this isn't a cure all */ - LOCALE_LOCK; + MBTOWC_LOCK; RETVAL = mbtowc(&wc, string, len); - LOCALE_UNLOCK; + MBTOWC_UNLOCK; #endif if (RETVAL >= 0) { sv_setiv_mg(pwc, wc); @@ -3482,9 +3482,9 @@ wctomb(s, wchar) * But probably memzero would too */ RETVAL = wcrtomb(NULL, L'\0', &PL_wcrtomb_ps); #else - LOCALE_LOCK; + WCTOMB_LOCK; RETVAL = wctomb(NULL, L'\0'); - LOCALE_UNLOCK; + WCTOMB_UNLOCK; #endif } else { /* Not resetting state */ @@ -3494,9 +3494,9 @@ wctomb(s, wchar) #else /* Locking prevents races, but locales can be switched out without * locking, so this isn't a cure all */ - LOCALE_LOCK; + WCTOMB_LOCK; RETVAL = wctomb(buffer, wchar); - LOCALE_UNLOCK; + WCTOMB_UNLOCK; #endif if (RETVAL >= 0) { sv_setpvn_mg(s, buffer, RETVAL); diff --git a/locale.c b/locale.c index 5dea47fcc1e1..e43de9f22680 100644 --- a/locale.c +++ b/locale.c @@ -1227,10 +1227,10 @@ S_emulate_setlocale(const int category, * correct locale for that thread. Any operation that was locale-sensitive * would have to be changed so that it would look like this: * - * LOCALE_LOCK; + * SETLOCALE_LOCK; * setlocale to the correct locale for this operation * do operation - * LOCALE_UNLOCK + * SETLOCALE_UNLOCK * * This leaves the global locale in the most recently used operation's, but it * was locked long enough to get the result. If that result is static, it @@ -1323,7 +1323,7 @@ S_locking_setlocale(pTHX_ /* It might be that this is called from an already-locked section of code. * We would have to detect and skip the LOCK/UNLOCK if so */ - LOCALE_LOCK; + SETLOCALE_LOCK; curlocales[index] = savepv(my_setlocale(category, new_locale)); @@ -1345,7 +1345,7 @@ S_locking_setlocale(pTHX_ #endif - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; return curlocales[index]; } @@ -2634,18 +2634,16 @@ S_my_nl_langinfo(const int item, bool toggle) STORE_LC_NUMERIC_FORCE_TO_UNDERLYING(); } - LOCALE_LOCK; /* Prevent interference from another thread executing - this code section (the only call to nl_langinfo in - the core) */ - + /* Prevent interference from another thread executing this code + * section. */ + NL_LANGINFO_LOCK; /* Copy to a per-thread buffer, which is also one that won't be * destroyed by a subsequent setlocale(), such as the * RESTORE_LC_NUMERIC may do just below. */ retval = save_to_buffer(nl_langinfo(item), &PL_langinfo_buf, &PL_langinfo_bufsize, 0); - - LOCALE_UNLOCK; + NL_LANGINFO_UNLOCK; if (toggle) { RESTORE_LC_NUMERIC(); @@ -3041,7 +3039,7 @@ S_my_nl_langinfo(const int item, bool toggle) case MON_5: case MON_6: case MON_7: case MON_8: case MON_9: case MON_10: case MON_11: case MON_12: - LOCALE_LOCK; + LOCALE_LOCK_; init_tm(&tm); /* Precaution against core dumps */ tm.tm_sec = 30; @@ -3052,7 +3050,7 @@ S_my_nl_langinfo(const int item, bool toggle) tm.tm_mon = 0; switch (item) { default: - LOCALE_UNLOCK; + LOCALE_UNLOCK_; Perl_croak(aTHX_ "panic: %s: %d: switch case: %d problem", __FILE__, __LINE__, item); @@ -3228,7 +3226,7 @@ S_my_nl_langinfo(const int item, bool toggle) * wday was chosen because its range is all a single digit. * Things like tm_sec have two digits as the minimum: '00' */ - LOCALE_UNLOCK; + LOCALE_UNLOCK_; retval = PL_langinfo_buf; @@ -4844,12 +4842,12 @@ Perl__is_cur_LC_category_utf8(pTHX_ int category) # else - LOCALE_LOCK; + MBTOWC_LOCK; PERL_UNUSED_RESULT(mbtowc(&wc, NULL, 0));/* Reset any shift state */ SETERRNO(0, 0); len = mbtowc(&wc, STR_WITH_LEN(REPLACEMENT_CHARACTER_UTF8)); SAVE_ERRNO; - LOCALE_UNLOCK; + MBTOWC_UNLOCK; # endif @@ -5357,7 +5355,7 @@ Perl_my_strerror(pTHX_ const int errnum) * same code at the same time. (On thread-safe perls, the LOCK is a * no-op.) Since this is the only place in core that changes LC_MESSAGES * (unless the user has called setlocale(), this works to prevent races. */ - LOCALE_LOCK; + SETLOCALE_LOCK; DEBUG_Lv(PerlIO_printf(Perl_debug_log, "my_strerror called with errnum %d\n", errnum)); @@ -5401,7 +5399,7 @@ Perl_my_strerror(pTHX_ const int errnum) } } - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; # endif /* End of doesn't have strerror_l */ # ifdef DEBUGGING diff --git a/perl.h b/perl.h index 959ddfe407be..12419837c0ac 100644 --- a/perl.h +++ b/perl.h @@ -6505,6 +6505,18 @@ the plain locale pragma without a parameter (S>) is in effect. # define LC_NUMERIC_UNLOCK NOOP # define LOCALECONV_LOCK NOOP # define LOCALECONV_UNLOCK NOOP +# define LOCALE_READ_LOCK NOOP +# define LOCALE_READ_UNLOCK NOOP +# define MBLEN_LOCK NOOP +# define MBLEN_UNLOCK NOOP +# define MBTOWC_LOCK NOOP +# define MBTOWC_UNLOCK NOOP +# define NL_LANGINFO_LOCK NOOP +# define NL_LANGINFO_UNLOCK NOOP +# define SETLOCALE_LOCK NOOP +# define SETLOCALE_UNLOCK NOOP +# define WCTOMB_LOCK NOOP +# define WCTOMB_UNLOCK NOOP #else /* Here, we will need critical sections in locale handling, because one or @@ -6535,21 +6547,45 @@ the plain locale pragma without a parameter (S>) is in effect. * will be called frequently, and the locked interval should be short, and * modern platforms will have reentrant versions (which don't lock) for * almost all of them, so khw thinks a single mutex should suffice. */ -# define LOCALE_LOCK \ +# define LOCALE_LOCK_ \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: locking locale\n", __FILE__, __LINE__)); \ MUTEX_LOCK(&PL_locale_mutex); \ } STMT_END -# define LOCALE_UNLOCK \ +# define LOCALE_UNLOCK_ \ STMT_START { \ DEBUG_Lv(PerlIO_printf(Perl_debug_log, \ "%s: %d: unlocking locale\n", __FILE__, __LINE__)); \ MUTEX_UNLOCK(&PL_locale_mutex); \ } STMT_END -# define LOCALECONV_LOCK LOCALE_LOCK -# define LOCALECONV_UNLOCK LOCALE_UNLOCK + /* We do define a different macro for each case; then if we want to have + * separate mutexes for some of them, the only changes needed are here. + * Define just the necessary macros. The compiler should then croak if the + * #ifdef's in the code are incorrect */ +# if defined(HAS_LOCALECONV) && ( ! defined(HAS_LOCALECONV_L) \ + || defined(TS_W32_BROKEN_LOCALECONV)) +# define LOCALECONV_LOCK LOCALE_LOCK_ +# define LOCALECONV_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_NL_LANGINFO) && ( ! defined(HAS_THREAD_SAFE_NL_LANGINFO_L) \ + || ! defined(HAS_POSIX_2008_LOCALE)) +# define NL_LANGINFO_LOCK LOCALE_LOCK_ +# define NL_LANGINFO_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_MBLEN) && ! defined(HAS_MBRLEN) +# define MBLEN_LOCK LOCALE_LOCK_ +# define MBLEN_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_MBTOWC) && ! defined(HAS_MBRTOWC) +# define MBTOWC_LOCK LOCALE_LOCK_ +# define MBTOWC_UNLOCK LOCALE_UNLOCK_ +# endif +# if defined(HAS_WCTOMB) && ! defined(HAS_WCRTOMB) +# define WCTOMB_LOCK LOCALE_LOCK_ +# define WCTOMB_UNLOCK LOCALE_UNLOCK_ +# endif # if defined(USE_THREAD_SAFE_LOCALE) /* On locale thread-safe systems, we don't need these workarounds */ # define LOCALE_TERM_LC_NUMERIC_ NOOP @@ -6558,7 +6594,14 @@ the plain locale pragma without a parameter (S>) is in effect. # define LC_NUMERIC_UNLOCK NOOP # define LOCALE_INIT_LC_NUMERIC_ NOOP # define LOCALE_TERM_LC_NUMERIC_ NOOP + + /* There may be instance core where we this is invoked yet should do + * nothing. Rather than have #ifdef's around them, define it here */ +# define SETLOCALE_LOCK NOOP +# define SETLOCALE_UNLOCK NOOP # else +# define SETLOCALE_LOCK LOCALE_LOCK_ +# define SETLOCALE_UNLOCK LOCALE_UNLOCK_ /* On platforms without per-thread locales, when another thread can switch * our locale, we need another mutex to create critical sections where we @@ -6582,7 +6625,7 @@ the plain locale pragma without a parameter (S>) is in effect. * Clang improperly gives warnings for this, if not silenced: * https://clang.llvm.org/docs/ThreadSafetyAnalysis.html#conditional-locks * - * If LC_NUMERIC_LOCK is combined with LOCALE_LOCK, calls to + * If LC_NUMERIC_LOCK is combined with one of the LOCKs above, calls to * that and its corresponding unlock should be contained entirely within * the locked portion of LC_NUMERIC. Those mutexes should be used only in * very short sections of code, while LC_NUMERIC_LOCK may span more From d523eeeb193a631f11e38eb49b4af1b27534853b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Dec 2020 16:29:11 -0700 Subject: [PATCH 207/503] locale.c: Unlock mutex before croaking These cases aren't supposed to happen, but unlock the mutex first; we could get into deadlock in trying to output the death message. --- locale.c | 2 ++ 1 file changed, 2 insertions(+) diff --git a/locale.c b/locale.c index e43de9f22680..9eb49be4a8bc 100644 --- a/locale.c +++ b/locale.c @@ -5362,6 +5362,7 @@ Perl_my_strerror(pTHX_ const int errnum) if (! within_locale_scope) { save_locale = do_setlocale_c(LC_MESSAGES, NULL); if (! save_locale) { + SETLOCALE_UNLOCK; Perl_croak(aTHX_ "panic: %s: %d: Could not find current LC_MESSAGES locale," " errno=%d\n", __FILE__, __LINE__, errno); @@ -5391,6 +5392,7 @@ Perl_my_strerror(pTHX_ const int errnum) if (! within_locale_scope) { if (save_locale && ! locale_is_C) { if (! do_setlocale_c(LC_MESSAGES, save_locale)) { + SETLOCALE_UNLOCK; Perl_croak(aTHX_ "panic: %s: %d: setlocale restore to '%s' failed, errno=%d\n", __FILE__, __LINE__, save_locale, errno); From f4ed6d050b26d63e5dae73878c2b2f13757b8afe Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 8 Dec 2020 13:25:36 -0700 Subject: [PATCH 208/503] locale.c: Remove some unnecessary mutex locks These aren't necessary as the called function has its own lock until done copying into the local structure. And these were breaking blead on Windows, as they are no longer defined. The smoke I ran included more commits beyond the breaking one, so I didn't catch it. --- locale.c | 5 ----- 1 file changed, 5 deletions(-) diff --git a/locale.c b/locale.c index 9eb49be4a8bc..bee9c2e3f7df 100644 --- a/locale.c +++ b/locale.c @@ -3039,8 +3039,6 @@ S_my_nl_langinfo(const int item, bool toggle) case MON_5: case MON_6: case MON_7: case MON_8: case MON_9: case MON_10: case MON_11: case MON_12: - LOCALE_LOCK_; - init_tm(&tm); /* Precaution against core dumps */ tm.tm_sec = 30; tm.tm_min = 30; @@ -3050,7 +3048,6 @@ S_my_nl_langinfo(const int item, bool toggle) tm.tm_mon = 0; switch (item) { default: - LOCALE_UNLOCK_; Perl_croak(aTHX_ "panic: %s: %d: switch case: %d problem", __FILE__, __LINE__, item); @@ -3226,8 +3223,6 @@ S_my_nl_langinfo(const int item, bool toggle) * wday was chosen because its range is all a single digit. * Things like tm_sec have two digits as the minimum: '00' */ - LOCALE_UNLOCK_; - retval = PL_langinfo_buf; /* If to return the format, not the value, overwrite the buffer From 0e91c879f0c0c46aea851b8857cf5a4ad21a6c22 Mon Sep 17 00:00:00 2001 From: jkahrman Date: Thu, 16 Apr 2020 02:00:04 -0400 Subject: [PATCH 209/503] Allow debugger aliases that start with '-' and '.' Since the '.' and '-' commands don't take any arguments and don't run if any are provided, don't treat commands starting with these characters as the single commands '.' and '-'. Restores behavior that existed prior to https://github.com/Perl/perl5/commit/7fdd4f080863703d44282c6988834455d129040 (v5.27) at least back to v5.8.8 https://github.com/Perl/perl5/commit/7fdd4f080863703d44282c6988834455d129040 --- lib/perl5db.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 69890ef4ae29..365649e1d121 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -1878,7 +1878,7 @@ sub _DB__trim_command_and_return_first_component { # A single-character debugger command can be immediately followed by its # argument if they aren't both alphanumeric; otherwise require space # between commands and arguments: - my ($verb, $args) = $cmd =~ m{\A(.\b|\S*)\s*(.*)}s; + my ($verb, $args) = $cmd =~ m{\A([^\.-]\b|\S*)\s*(.*)}s; $obj->cmd_verb($verb); $obj->cmd_args($args); From 43a1c913bb191429198d582581bdfe54180057b5 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Dec 2020 10:19:26 +1100 Subject: [PATCH 210/503] test - and . at beginning of debugger alias name --- lib/perl5db.t | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/lib/perl5db.t b/lib/perl5db.t index d68eeb7f1f02..f6740f5cdcea 100644 --- a/lib/perl5db.t +++ b/lib/perl5db.t @@ -2144,7 +2144,11 @@ DebugWrap->new({ [ '= quit q', '= foobar l', + '= .hello print "hellox\n"', + '= -goodbye print "goodbyex\n"', 'foobar', + '.hello', + '-goodbye', 'quit', ], prog => '../lib/perl5db/t/test-l-statement-1', @@ -2160,7 +2164,9 @@ DebugWrap->new({ 5:\s+print\ "2\\n";\n /msx, 'Test the = (command alias) command.', - ); + ); + $wrapper->output_like(qr/hellox.*goodbyex/xs, + "check . and - can start alias name"); } # Test the m statement. From e6d730c5597da89e954260aa466126cbda555cfe Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Dec 2020 10:42:59 +1100 Subject: [PATCH 211/503] jkahrman is now a perl author --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 4ed86714cfe6..405c70f59e53 100644 --- a/AUTHORS +++ b/AUTHORS @@ -624,6 +624,7 @@ Jim Miner Jim Richardson Jim Schneider Jirka Hruška +jkahrman Joachim Huober Joaquin Ferrero Jochen Wiedmann From 18ac9f3dde437027fccc1637594e2ef2c70b6fba Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 9 Dec 2020 10:43:12 +1100 Subject: [PATCH 212/503] bump perl5db.pl's $VERSION --- lib/perl5db.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lib/perl5db.pl b/lib/perl5db.pl index 365649e1d121..3ab6e577a2f6 100644 --- a/lib/perl5db.pl +++ b/lib/perl5db.pl @@ -531,7 +531,7 @@ BEGIN use vars qw($VERSION $header); # bump to X.XX in blead, only use X.XX_XX in maint -$VERSION = '1.59'; +$VERSION = '1.60'; $header = "perl5db.pl version $VERSION"; From 31667aca63c681e1f19afe2f493cc98e62188acc Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 8 Dec 2020 17:07:17 -0700 Subject: [PATCH 213/503] Fix cygwin build A macro name changed, and I didn't see it in the grep --- cygwin/cygwin.c | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index 3bb5818e5858..bbb3e1a8298d 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -167,7 +167,7 @@ wide_to_utf8(const wchar_t *wbuf) /* Here and elsewhere in this file, we have a critical section to prevent * another thread from changing the locale out from under us. XXX But why * not just use uvchr_to_utf8? */ - LOCALE_LOCK; + SETLOCALE_LOCK; oldlocale = setlocale(LC_CTYPE, NULL); setlocale(LC_CTYPE, "utf-8"); @@ -180,7 +180,7 @@ wide_to_utf8(const wchar_t *wbuf) if (oldlocale) setlocale(LC_CTYPE, oldlocale); else setlocale(LC_CTYPE, "C"); - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; return buf; } @@ -193,7 +193,7 @@ utf8_to_wide(const char *buf) char *oldlocale; int wlen = sizeof(wchar_t)*strlen(buf); - LOCALE_LOCK; + SETLOCALE_LOCK; oldlocale = setlocale(LC_CTYPE, NULL); @@ -205,7 +205,7 @@ utf8_to_wide(const char *buf) if (oldlocale) setlocale(LC_CTYPE, oldlocale); else setlocale(LC_CTYPE, "C"); - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; return wbuf; } @@ -307,7 +307,7 @@ XS(XS_Cygwin_win_to_posix_path) mbstate_t mbs; char *oldlocale; - LOCALE_LOCK; + SETLOCALE_LOCK; oldlocale = setlocale(LC_CTYPE, NULL); setlocale(LC_CTYPE, "utf-8"); @@ -318,7 +318,7 @@ XS(XS_Cygwin_win_to_posix_path) if (oldlocale) setlocale(LC_CTYPE, oldlocale); else setlocale(LC_CTYPE, "C"); - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; } else { /* use bytes; assume already ucs-2 encoded bytestream */ err = cygwin_conv_path(what, src_path, wbuf, wlen); } @@ -398,7 +398,7 @@ XS(XS_Cygwin_posix_to_win_path) wchar_t *wbuf = (wchar_t *) safemalloc(wlen); char *oldlocale; - LOCALE_LOCK; + SETLOCALE_LOCK; oldlocale = setlocale(LC_CTYPE, NULL); setlocale(LC_CTYPE, "utf-8"); @@ -424,7 +424,7 @@ XS(XS_Cygwin_posix_to_win_path) if (oldlocale) setlocale(LC_CTYPE, oldlocale); else setlocale(LC_CTYPE, "C"); - LOCALE_UNLOCK; + SETLOCALE_UNLOCK; } else { int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE; win_path = (char *) safemalloc(len + 260 + 1001); From c07463d862e4832cc6a94200a77a3170ef2dca18 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 8 Dec 2020 17:09:04 -0700 Subject: [PATCH 214/503] Fix freebsd/netbsd builds These have an inconsistent configuration in which several functions exist for thread-safe locales, but the crucial one doesn't show up in our Configure probe. The code this commit fixes assumed that all or nothing would be present. --- perl.h | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/perl.h b/perl.h index 12419837c0ac..a839ef967aae 100644 --- a/perl.h +++ b/perl.h @@ -6564,8 +6564,9 @@ the plain locale pragma without a parameter (S>) is in effect. * separate mutexes for some of them, the only changes needed are here. * Define just the necessary macros. The compiler should then croak if the * #ifdef's in the code are incorrect */ -# if defined(HAS_LOCALECONV) && ( ! defined(HAS_LOCALECONV_L) \ - || defined(TS_W32_BROKEN_LOCALECONV)) +# if defined(HAS_LOCALECONV) && ( ! defined(HAS_POSIX_2008_LOCALE) \ + || ! defined(HAS_LOCALECONV_L) \ + || defined(TS_W32_BROKEN_LOCALECONV)) # define LOCALECONV_LOCK LOCALE_LOCK_ # define LOCALECONV_UNLOCK LOCALE_UNLOCK_ # endif From 8462890b4373d480bea3ff2c274614e9a78cbdc4 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Sat, 27 Jun 2020 18:10:47 +0100 Subject: [PATCH 215/503] Implement SAVEt_STRLEN_SMALL Most uses of SAVEt_STRLEN actually store small values; often zero. Rather than using an entire U64-sized element for these values, it saves space to use the same "SMALL" mechanism as other numerical values, like SAVEt_INT_SMALL. --- scope.c | 20 +++++++++++++++--- scope.h | 65 +++++++++++++++++++++++++++++---------------------------- sv.c | 1 + 3 files changed, 51 insertions(+), 35 deletions(-) diff --git a/scope.c b/scope.c index cea1500e6a62..19281d12a70c 100644 --- a/scope.c +++ b/scope.c @@ -512,14 +512,22 @@ Perl_save_I32(pTHX_ I32 *intp) void Perl_save_strlen(pTHX_ STRLEN *ptr) { + const IV i = *ptr; + UV type = ((I32)((U32)i << SAVE_TIGHT_SHIFT) | SAVEt_STRLEN_SMALL); + int size = 2; dSS_ADD; PERL_ARGS_ASSERT_SAVE_STRLEN; - SS_ADD_IV(*ptr); + if (UNLIKELY((I32)(type >> SAVE_TIGHT_SHIFT) != i)) { + SS_ADD_IV(*ptr); + type = SAVEt_STRLEN; + size++; + } + SS_ADD_PTR(ptr); - SS_ADD_UV(SAVEt_STRLEN); - SS_ADD_END(3); + SS_ADD_UV(type); + SS_ADD_END(size); } void @@ -840,6 +848,7 @@ static const U8 arg_counts[] = { 1, /* SAVEt_STACK_POS */ 1, /* SAVEt_READONLY_OFF */ 1, /* SAVEt_FREEPADNAME */ + 1, /* SAVEt_STRLEN_SMALL */ 2, /* SAVEt_AV */ 2, /* SAVEt_DESTRUCTOR */ 2, /* SAVEt_DESTRUCTOR_X */ @@ -1045,6 +1054,11 @@ Perl_leave_scope(pTHX_ I32 base) *(int*)a1.any_ptr = (int)a0.any_i32; break; + case SAVEt_STRLEN_SMALL: + a0 = ap[0]; + *(STRLEN*)a0.any_ptr = (STRLEN)(uv >> SAVE_TIGHT_SHIFT); + break; + case SAVEt_STRLEN: /* STRLEN/size_t ref */ a0 = ap[0]; a1 = ap[1]; *(STRLEN*)a1.any_ptr = (STRLEN)a0.any_iv; diff --git a/scope.h b/scope.h index 5b611c2cad95..a7dee134f8f4 100644 --- a/scope.h +++ b/scope.h @@ -38,44 +38,45 @@ #define SAVEt_STACK_POS 20 #define SAVEt_READONLY_OFF 21 #define SAVEt_FREEPADNAME 22 +#define SAVEt_STRLEN_SMALL 23 /* two args */ -#define SAVEt_AV 23 -#define SAVEt_DESTRUCTOR 24 -#define SAVEt_DESTRUCTOR_X 25 -#define SAVEt_GENERIC_PVREF 26 -#define SAVEt_GENERIC_SVREF 27 -#define SAVEt_GP 28 -#define SAVEt_GVSV 29 -#define SAVEt_HINTS 30 -#define SAVEt_HPTR 31 -#define SAVEt_HV 32 -#define SAVEt_I32 33 -#define SAVEt_INT 34 -#define SAVEt_ITEM 35 -#define SAVEt_IV 36 -#define SAVEt_LONG 37 -#define SAVEt_PPTR 38 -#define SAVEt_SAVESWITCHSTACK 39 -#define SAVEt_SHARED_PVREF 40 -#define SAVEt_SPTR 41 -#define SAVEt_STRLEN 42 -#define SAVEt_SV 43 -#define SAVEt_SVREF 44 -#define SAVEt_VPTR 45 -#define SAVEt_ADELETE 46 -#define SAVEt_APTR 47 +#define SAVEt_AV 24 +#define SAVEt_DESTRUCTOR 25 +#define SAVEt_DESTRUCTOR_X 26 +#define SAVEt_GENERIC_PVREF 27 +#define SAVEt_GENERIC_SVREF 28 +#define SAVEt_GP 29 +#define SAVEt_GVSV 30 +#define SAVEt_HINTS 31 +#define SAVEt_HPTR 32 +#define SAVEt_HV 33 +#define SAVEt_I32 34 +#define SAVEt_INT 35 +#define SAVEt_ITEM 36 +#define SAVEt_IV 37 +#define SAVEt_LONG 38 +#define SAVEt_PPTR 39 +#define SAVEt_SAVESWITCHSTACK 40 +#define SAVEt_SHARED_PVREF 41 +#define SAVEt_SPTR 42 +#define SAVEt_STRLEN 43 +#define SAVEt_SV 44 +#define SAVEt_SVREF 45 +#define SAVEt_VPTR 46 +#define SAVEt_ADELETE 47 +#define SAVEt_APTR 48 /* three args */ -#define SAVEt_HELEM 48 -#define SAVEt_PADSV_AND_MORTALIZE 49 -#define SAVEt_SET_SVFLAGS 50 -#define SAVEt_GVSLOT 51 -#define SAVEt_AELEM 52 -#define SAVEt_DELETE 53 -#define SAVEt_HINTS_HH 54 +#define SAVEt_HELEM 49 +#define SAVEt_PADSV_AND_MORTALIZE 50 +#define SAVEt_SET_SVFLAGS 51 +#define SAVEt_GVSLOT 52 +#define SAVEt_AELEM 53 +#define SAVEt_DELETE 54 +#define SAVEt_HINTS_HH 55 #define SAVEf_SETMAGIC 1 diff --git a/sv.c b/sv.c index 486f07dcd5b3..4d89ce0aa923 100644 --- a/sv.c +++ b/sv.c @@ -14850,6 +14850,7 @@ Perl_ss_dup(pTHX_ PerlInterpreter *proto_perl, CLONE_PARAMS* param) ptr = POPPTR(ss,ix); TOPPTR(nss,ix) = any_dup(ptr, proto_perl); /* FALLTHROUGH */ + case SAVEt_STRLEN_SMALL: case SAVEt_INT_SMALL: case SAVEt_I32_SMALL: case SAVEt_I16: /* I16 reference */ From 5c5e39febd38425fd9d6f8b59a43835d43928530 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Thu, 10 Dec 2020 09:01:03 -0500 Subject: [PATCH 216/503] Correct POD formatting error --- Porting/sync-with-cpan | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/sync-with-cpan b/Porting/sync-with-cpan index b2cdd5ffeec2..660b3f3d43eb 100755 --- a/Porting/sync-with-cpan +++ b/Porting/sync-with-cpan @@ -9,7 +9,7 @@ Porting/sync-with-cpan - Synchronize with CPAN distributions sh ./Configure perl Porting/sync-with-cpan -where is the name it appears in the C<%Modules> hash +where C is the name it appears in the C<%Modules> hash of F =head1 DESCRIPTION From 27b896ab16fc64a09f58afd0fe103a277bd526fd Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Thu, 10 Dec 2020 09:15:51 -0500 Subject: [PATCH 217/503] Synch with CPAN distribution libnet-3.12 --- MANIFEST | 1 - Porting/Maintainers.pl | 2 +- cpan/libnet/Makefile.PL | 6 +- cpan/libnet/lib/Net/Cmd.pm | 145 ++++++++---- cpan/libnet/lib/Net/Config.pm | 56 ++++- cpan/libnet/lib/Net/Domain.pm | 67 +++++- cpan/libnet/lib/Net/FTP.pm | 336 ++++++++++++++-------------- cpan/libnet/lib/Net/FTP/A.pm | 2 +- cpan/libnet/lib/Net/FTP/E.pm | 2 +- cpan/libnet/lib/Net/FTP/I.pm | 2 +- cpan/libnet/lib/Net/FTP/L.pm | 2 +- cpan/libnet/lib/Net/FTP/dataconn.pm | 75 ++++++- cpan/libnet/lib/Net/NNTP.pm | 307 +++++++++++++------------ cpan/libnet/lib/Net/Netrc.pm | 59 +++-- cpan/libnet/lib/Net/POP3.pm | 141 +++++++----- cpan/libnet/lib/Net/SMTP.pm | 195 ++++++++-------- cpan/libnet/lib/Net/Time.pm | 63 +++++- cpan/libnet/lib/Net/libnetFAQ.pod | 16 +- cpan/libnet/t/config.t | 21 +- cpan/libnet/t/datasend.t | 16 +- cpan/libnet/t/ftp.t | 2 +- cpan/libnet/t/hostname.t | 6 +- cpan/libnet/t/libnet_t.pl | 41 ---- cpan/libnet/t/netrc.t | 15 +- cpan/libnet/t/nntp.t | 13 +- cpan/libnet/t/nntp_ipv6.t | 12 +- cpan/libnet/t/nntp_ssl.t | 12 +- cpan/libnet/t/pop3_ipv6.t | 12 +- cpan/libnet/t/pop3_ssl.t | 12 +- cpan/libnet/t/require.t | 4 +- cpan/libnet/t/smtp.t | 15 +- cpan/libnet/t/smtp_ipv6.t | 12 +- cpan/libnet/t/smtp_ssl.t | 12 +- cpan/libnet/t/time.t | 16 +- 34 files changed, 1022 insertions(+), 676 deletions(-) delete mode 100644 cpan/libnet/t/libnet_t.pl diff --git a/MANIFEST b/MANIFEST index 5aab31f3dc4d..6ac7ad47eee2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1275,7 +1275,6 @@ cpan/libnet/t/config.t libnet cpan/libnet/t/datasend.t libnet cpan/libnet/t/ftp.t libnet cpan/libnet/t/hostname.t libnet -cpan/libnet/t/libnet_t.pl libnet cpan/libnet/t/netrc.t libnet cpan/libnet/t/nntp.t libnet cpan/libnet/t/nntp_ipv6.t diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 4f9030c09c47..74b930b8ea3b 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -693,7 +693,7 @@ package Maintainers; }, 'libnet' => { - 'DISTRIBUTION' => 'SHAY/libnet-3.11.tar.gz', + 'DISTRIBUTION' => 'SHAY/libnet-3.12.tar.gz', 'FILES' => q[cpan/libnet], 'EXCLUDED' => [ qw( Configure diff --git a/cpan/libnet/Makefile.PL b/cpan/libnet/Makefile.PL index 73be0a165449..477739068d28 100644 --- a/cpan/libnet/Makefile.PL +++ b/cpan/libnet/Makefile.PL @@ -7,7 +7,7 @@ # Makefile creation script. # # COPYRIGHT -# Copyright (C) 2014, 2015 Steve Hay. All rights reserved. +# Copyright (C) 2014-2015, 2020 Steve Hay. All rights reserved. # # LICENCE # This script is free software; you can redistribute it and/or modify it under @@ -66,7 +66,7 @@ MAIN: { ABSTRACT => 'Collection of network protocol modules', AUTHOR => 'Graham Barr , Steve Hay ', LICENSE => 'perl_5', - VERSION => '3.11', + VERSION => '3.12', META_MERGE => { 'meta-spec' => { @@ -76,7 +76,7 @@ MAIN: { resources => { repository => { type => 'git', - url => 'https://github.com/steve-m-hay/perl-libnet.git' + web => 'https://github.com/steve-m-hay/perl-libnet' } }, diff --git a/cpan/libnet/lib/Net/Cmd.pm b/cpan/libnet/lib/Net/Cmd.pm index b695f64dd056..650f23be96f9 100644 --- a/cpan/libnet/lib/Net/Cmd.pm +++ b/cpan/libnet/lib/Net/Cmd.pm @@ -1,7 +1,7 @@ # Net::Cmd.pm # # Copyright (C) 1995-2006 Graham Barr. All rights reserved. -# Copyright (C) 2013-2016 Steve Hay. All rights reserved. +# Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -26,7 +26,7 @@ BEGIN { } } -our $VERSION = "3.11"; +our $VERSION = "3.12"; our @ISA = qw(Exporter); our @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -100,7 +100,7 @@ sub _print_isa { sub debug { - @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([LEVEL])'; + @_ == 1 or @_ == 2 or croak 'usage: $obj->debug([$level])'; my ($cmd, $level) = @_; my $pkg = ref($cmd) || $cmd; @@ -175,7 +175,7 @@ sub status { sub set_status { - @_ == 3 or croak 'usage: $obj->set_status(CODE, MESSAGE)'; + @_ == 3 or croak 'usage: $obj->set_status($code, $resp)'; my $cmd = shift; my ($code, $resp) = @_; @@ -335,15 +335,19 @@ sub getline { my $rin = ""; vec($rin, $fd, 1) = 1; + my $timeout = $cmd->timeout || undef; + my $initial = time; + my $pending = $timeout; + my $buf; until (scalar(@{${*$cmd}{'net_cmd_lines'}})) { - my $timeout = $cmd->timeout || undef; my $rout; - my $select_ret = select($rout = $rin, undef, undef, $timeout); - if ($select_ret > 0) { - unless (sysread($cmd, $buf = "", 1024)) { + my $select_ret = select($rout = $rin, undef, undef, $pending); + if (defined $select_ret and $select_ret > 0) { + my $r = sysread($cmd, $buf = "", 1024); + if (! defined($r) ) { my $err = $!; $cmd->close; $cmd->_set_status_closed($err); @@ -359,6 +363,20 @@ sub getline { push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf); } + elsif (defined $select_ret && $select_ret == -1) { + if ( $! == EINTR ) { + if ( defined($timeout) ) { + redo if ($pending = $timeout - ( time - $initial ) ) > 0; + $cmd->_set_status_timeout; + return; + } + redo; + } + my $err = $!; + $cmd->close; + $cmd->_set_status_closed($err); + return; + } else { $cmd->_set_status_timeout; return; @@ -661,59 +679,59 @@ C, C or C) then you must provide the following methods by other means yourself: C and C. -=head1 USER METHODS +=head2 Public Methods These methods provide a user interface to the C object. =over 4 -=item debug ( VALUE ) +=item C -Set the level of debug information for this object. If C is not given +Set the level of debug information for this object. If C<$level> is not given then the current state is returned. Otherwise the state is changed to -C and the previous state returned. +C<$level> and the previous state returned. Different packages may implement different levels of debug but a non-zero value results in copies of all commands and responses also being sent to STDERR. -If C is C then the debug level will be set to the default +If C<$level> is C then the debug level will be set to the default debug level for the class. This method can also be called as a I method to set/get the default debug level for a given class. -=item message () +=item C Returns the text message returned from the last command. In a scalar context it returns a single string, in a list context it will return each line as a separate element. (See L below.) -=item code () +=item C Returns the 3-digit code from the last command. If a command is pending then the value 0 is returned. (See L below.) -=item ok () +=item C Returns non-zero if the last code value was greater than zero and less than 400. This holds true for most command servers. Servers where this does not hold may override this method. -=item status () +=item C Returns the most significant digit of the current status code. If a command is pending then C is returned. -=item datasend ( DATA ) +=item C Send data to the remote server, converting LF to CRLF. Any line starting with a '.' will be prefixed with another '.'. -C may be an array or a reference to an array. -The C passed in must be encoded by the caller to octets of whatever +C<$data> may be an array or a reference to an array. +The C<$data> passed in must be encoded by the caller to octets of whatever encoding is required, e.g. by using the Encode module's C function. -=item dataend () +=item C End the sending of data to the remote server. This is done by ensuring that the data already sent ends with CRLF then sending '.CRLF' to end the @@ -722,28 +740,28 @@ returns true if C returns CMD_OK. =back -=head1 CLASS METHODS +=head2 Protected Methods These methods are not intended to be called by the user, but used or over-ridden by a sub-class of C =over 4 -=item debug_print ( DIR, TEXT ) +=item C -Print debugging information. C denotes the direction I being +Print debugging information. C<$dir> denotes the direction I being data being sent to the server. Calls C before printing to STDERR. -=item debug_text ( DIR, TEXT ) +=item C -This method is called to print debugging information. TEXT is +This method is called to print debugging information. C<$text> is the text being sent. The method should return the text to be printed. This is primarily meant for the use of modules such as FTP where passwords are sent, but we do not want to display them in the debugging information. -=item command ( CMD [, ARGS, ... ]) +=item C Send a command to the command server. All arguments are first joined with a space character and CRLF is appended, this string is then sent to the @@ -751,24 +769,24 @@ command server. Returns undef upon failure. -=item unsupported () +=item C Sets the status code to 580 and the response text to 'Unsupported command'. Returns zero. -=item response () +=item C Obtain a response from the server. Upon success the most significant digit of the status code is returned. Upon failure, timeout etc., I is returned. -=item parse_response ( TEXT ) +=item C This method is called by C as a method with one argument. It should return an array of 2 values, the 3-digit status code and a flag which is true when this is part of a multi-line response and this line is not the last. -=item getline () +=item C Retrieve one line, delimited by CRLF, from the remote server. Returns I upon failure. @@ -776,26 +794,26 @@ upon failure. B: If you do use this method for any reason, please remember to add some C calls into your method. -=item ungetline ( TEXT ) +=item C Unget a line of text from the server. -=item rawdatasend ( DATA ) +=item C -Send data to the remote server without performing any conversions. C +Send data to the remote server without performing any conversions. C<$data> is a scalar. -As with C, the C passed in must be encoded by the caller +As with C, the C<$data> passed in must be encoded by the caller to octets of whatever encoding is required, e.g. by using the Encode module's C function. -=item read_until_dot () +=item C Read data from the remote server until a line consisting of a single '.'. Any lines starting with '..' will have one of the '.'s removed. Returns a reference to a list containing the lines, or I upon failure. -=item tied_fh () +=item C Returns a filehandle tied to the Net::Cmd object. After issuing a command, you may read from this filehandle using read() or <>. The @@ -807,7 +825,7 @@ See the Net::POP3 and Net::SMTP modules for examples of this. =back -=head1 PSEUDO RESPONSES +=head2 Pseudo Responses Normally the values returned by C and C are obtained from the remote server, but in a few circumstances, as @@ -847,22 +865,47 @@ or otherwise trap this error. =head1 EXPORTS -C exports six subroutines, five of these, C, C, -C, C and C, correspond to possible results -of C and C. The sixth is C. +The following symbols are, or can be, exported by this module: + +=over 4 + +=item Default Exports + +C, +C, +C, +C, +C, +C. + +(These correspond to possible results of C and C.) + +=item Optional Exports + +I. + +=item Export Tags + +I. + +=back + +=head1 KNOWN BUGS + +See L. =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-2006 Graham Barr. All rights reserved. -Copyright (C) 2013-2016 Steve Hay. All rights reserved. +Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -870,4 +913,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/Config.pm b/cpan/libnet/lib/Net/Config.pm index 4f822a40a45e..365cb49b16c9 100644 --- a/cpan/libnet/lib/Net/Config.pm +++ b/cpan/libnet/lib/Net/Config.pm @@ -1,7 +1,7 @@ # Net::Config.pm # # Copyright (C) 2000 Graham Barr. All rights reserved. -# Copyright (C) 2013-2014, 2016 Steve Hay. All rights reserved. +# Copyright (C) 2013-2014, 2016, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -18,7 +18,7 @@ use Socket qw(inet_aton inet_ntoa); our @EXPORT = qw(%NetConfig); our @ISA = qw(Net::LocalCfg Exporter); -our $VERSION = "3.11"; +our $VERSION = "3.12"; our($CONFIGURE, $LIBNET_CFG); @@ -159,7 +159,7 @@ For example } __END__ -=head1 METHODS +=head2 Class Methods C defines the following methods. They are methods as they are invoked as class methods. This is because C inherits from @@ -167,7 +167,7 @@ C so you can override these methods if you want. =over 4 -=item requires_firewall ( HOST ) +=item C Attempts to determine if a given host is outside your firewall. Possible return values are. @@ -181,7 +181,7 @@ the configuration data. =back -=head1 NetConfig VALUES +=head2 NetConfig Values =over 4 @@ -323,18 +323,42 @@ If true then C will check each hostname given that it exists =back +=head1 EXPORTS + +The following symbols are, or can be, exported by this module: + +=over 4 + +=item Default Exports + +C<%NetConfig>. + +=item Optional Exports + +I. + +=item Export Tags + +I. + +=back + +=head1 KNOWN BUGS + +I. + =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT -Copyright (C) 1998-2011 Graham Barr. All rights reserved. +Copyright (C) 2000 Graham Barr. All rights reserved. -Copyright (C) 2013-2014, 2016 Steve Hay. All rights reserved. +Copyright (C) 2013-2014, 2016, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -342,4 +366,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/Domain.pm b/cpan/libnet/lib/Net/Domain.pm index 556cc1598075..f4c93eafdbb1 100644 --- a/cpan/libnet/lib/Net/Domain.pm +++ b/cpan/libnet/lib/Net/Domain.pm @@ -1,7 +1,7 @@ # Net::Domain.pm # # Copyright (C) 1995-1998 Graham Barr. All rights reserved. -# Copyright (C) 2013-2014 Steve Hay. All rights reserved. +# Copyright (C) 2013-2014, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -19,7 +19,7 @@ use Net::Config; our @ISA = qw(Exporter); our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); -our $VERSION = "3.11"; +our $VERSION = "3.12"; my ($host, $domain, $fqdn) = (undef, undef, undef); @@ -321,40 +321,71 @@ of the current host. From this determine the host-name and the host-domain. Each of the functions will return I if the FQDN cannot be determined. +=head2 Functions + =over 4 -=item hostfqdn () +=item C Identify and return the FQDN of the current host. -=item domainname () +=item C -An alias for hostfqdn (). +An alias for hostfqdn(). -=item hostname () +=item C Returns the smallest part of the FQDN which can be used to identify the host. -=item hostdomain () +=item C Returns the remainder of the FQDN after the I has been removed. =back +=head1 EXPORTS + +The following symbols are, or can be, exported by this module: + +=over 4 + +=item Default Exports + +I. + +=item Optional Exports + +C, +C, +C, +C. + +=item Export Tags + +I. + +=back + + +=head1 KNOWN BUGS + +See L. + =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Adapted from Sys::Hostname by David Sundstrom EFE. +Adapted from Sys::Hostname by David Sundstrom +ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-1998 Graham Barr. All rights reserved. -Copyright (C) 2013-2014 Steve Hay. All rights reserved. +Copyright (C) 2013-2014, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -362,4 +393,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/FTP.pm b/cpan/libnet/lib/Net/FTP.pm index 14153be0d0c0..b195c9c92cfa 100644 --- a/cpan/libnet/lib/Net/FTP.pm +++ b/cpan/libnet/lib/Net/FTP.pm @@ -1,7 +1,7 @@ # Net::FTP.pm # # Copyright (C) 1995-2004 Graham Barr. All rights reserved. -# Copyright (C) 2013-2017 Steve Hay. All rights reserved. +# Copyright (C) 2013-2017, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -23,7 +23,7 @@ use Net::Config; use Socket; use Time::Local; -our $VERSION = '3.11'; +our $VERSION = '3.12'; our $IOCLASS; my $family_key; @@ -110,10 +110,13 @@ sub new { # use SNI if supported by IO::Socket::SSL $pkg->can_client_sni ? (SSL_hostname => $hostname):(), # reuse SSL session of control connection in data connections - SSL_session_cache => Net::FTP::_SSL_SingleSessionCache->new, + SSL_session_cache_size => 10, + SSL_session_key => $hostname, ); # user defined SSL arg $tlsargs{$_} = $arg{$_} for(grep { m{^SSL_} } keys %arg); + $tlsargs{SSL_reuse_ctx} = IO::Socket::SSL::SSL_Context->new(%tlsargs) + or return; } elsif ($arg{SSL}) { croak("IO::Socket::SSL >= 2.007 needed for SSL support"); @@ -262,7 +265,7 @@ sub mdtm { $ftp->_MDTM($file) && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ - ? timegm($8, $7, $6, $5, $4 - 1, $2 eq '19' ? $3 : ($1 - 1900)) + ? timegm($8, $7, $6, $5, $4 - 1, $2 eq '19' ? ($3 + 1900) : $1) : undef; } @@ -426,7 +429,7 @@ sub login { sub account { - @_ == 2 or croak 'usage: $ftp->account( ACCT )'; + @_ == 2 or croak 'usage: $ftp->account($acct)'; my $ftp = shift; my $acct = shift; $ftp->_ACCT($acct) == CMD_OK; @@ -452,7 +455,7 @@ sub _auth_id { sub authorize { - @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])'; + @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize([$auth[, $resp]])'; my ($ftp, $auth, $resp) = &_auth_id; @@ -466,12 +469,12 @@ sub authorize { sub rename { - @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)'; + @_ == 3 or croak 'usage: $ftp->rename($oldname, $newname)'; - my ($ftp, $from, $to) = @_; + my ($ftp, $oldname, $newname) = @_; - $ftp->_RNFR($from) - && $ftp->_RNTO($to); + $ftp->_RNFR($oldname) + && $ftp->_RNTO($newname); } @@ -619,7 +622,7 @@ sub get { sub cwd { - @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd([$dir])'; my ($ftp, $dir) = @_; @@ -656,7 +659,7 @@ sub pwd { # Initial version contributed by Dinkum Software # sub rmdir { - @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )'); + @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir($dir[, $recurse])'); # Pick off the args my ($ftp, $dir, $recurse) = @_; @@ -702,7 +705,7 @@ sub rmdir { sub restart { - @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )'; + @_ == 2 || croak 'usage: $ftp->restart($where)'; my ($ftp, $where) = @_; @@ -713,7 +716,7 @@ sub restart { sub mkdir { - @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )'; + @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir($dir[, $recurse])'; my ($ftp, $dir, $recurse) = @_; @@ -758,7 +761,7 @@ sub mkdir { sub delete { - @_ == 2 || croak 'usage: $ftp->delete( FILENAME )'; + @_ == 2 || croak 'usage: $ftp->delete($filename)'; $_[0]->_DELE($_[1]); } @@ -881,12 +884,12 @@ sub _store_cmd { sub port { - @_ == 1 || @_ == 2 or croak 'usage: $self->port([PORT])'; + @_ == 1 || @_ == 2 or croak 'usage: $self->port([$port])'; return _eprt('PORT',@_); } sub eprt { - @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([PORT])'; + @_ == 1 || @_ == 2 or croak 'usage: $self->eprt([$port])'; return _eprt('EPRT',@_); } @@ -959,7 +962,7 @@ sub unique_name { sub supported { - @_ == 2 or croak 'usage: $ftp->supported( CMD )'; + @_ == 2 or croak 'usage: $ftp->supported($cmd)'; my $ftp = shift; my $cmd = uc shift; my $hash = ${*$ftp}{'net_ftp_supported'} ||= {}; @@ -1282,36 +1285,36 @@ sub pasv_xfer { sub pasv_wait { - @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)'; + @_ == 2 or croak 'usage: $ftp->pasv_wait($non_pasv_server)'; - my ($ftp, $non_pasv) = @_; + my ($ftp, $non_pasv_server) = @_; my ($file, $rin, $rout); vec($rin = '', fileno($ftp), 1) = 1; select($rout = $rin, undef, undef, undef); my $dres = $ftp->response(); - my $sres = $non_pasv->response(); + my $sres = $non_pasv_server->response(); return unless $dres == CMD_OK && $sres == CMD_OK; return - unless $ftp->ok() && $non_pasv->ok(); + unless $ftp->ok() && $non_pasv_server->ok(); return $1 if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/; return $1 - if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/; + if $non_pasv_server->message =~ /unique file name:\s*(\S*)\s*\)/; return 1; } sub feature { - @_ == 2 or croak 'usage: $ftp->feature( NAME )'; - my ($ftp, $feat) = @_; + @_ == 2 or croak 'usage: $ftp->feature($name)'; + my ($ftp, $name) = @_; my $feature = ${*$ftp}{net_ftp_feature} ||= do { my @feat; @@ -1329,7 +1332,7 @@ sub feature { \@feat; }; - return grep { /^\Q$feat\E\b/i } @$feature; + return grep { /^\Q$name\E\b/i } @$feature; } @@ -1397,25 +1400,6 @@ sub _SYST { shift->unsupported(@_) } sub _STRU { shift->unsupported(@_) } sub _REIN { shift->unsupported(@_) } -{ - # Session Cache with single entry - # used to make sure that we reuse same session for control and data channels - package Net::FTP::_SSL_SingleSessionCache; - sub new { my $x; return bless \$x,shift } - sub add_session { - my ($cache,$key,$session) = @_; - Net::SSLeay::SESSION_free($$cache) if $$cache; - $$cache = $session; - } - sub get_session { - my $cache = shift; - return $$cache - } - sub DESTROY { - my $cache = shift; - Net::SSLeay::SESSION_free($$cache) if $$cache; - } -} 1; @@ -1456,7 +1440,7 @@ and explicit FTPS as defined in RFC4217. The Net::FTP class is a subclass of Net::Cmd and (depending on avaibility) of IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET. -=head1 OVERVIEW +=head2 Overview FTP stands for File Transfer Protocol. It is a way of transferring files between networked machines. The protocol defines a client @@ -1487,19 +1471,19 @@ this if you really know what you're doing). This class does not support the EBCDIC or byte formats, and will default to binary instead if they are attempted. -=head1 CONSTRUCTOR +=head2 Class Methods =over 4 -=item new ([ HOST ] [, OPTIONS ]) +=item C -This is the constructor for a new Net::FTP object. C is the +This is the constructor for a new Net::FTP object. C<$host> is the name of the remote host to which an FTP connection is required. -C is optional. If C is not given then it may instead be +C<$host> is optional. If C<$host> is not given then it may instead be passed as the C option described below. -C are passed in a hash like fashion, using key and value pairs. +C<%options> are passed in a hash like fashion, using key and value pairs. Possible options are: B - FTP host to connect to. It may be a single scalar, as defined for @@ -1570,7 +1554,7 @@ be in $@ =back -=head1 METHODS +=head2 Object Methods Unless otherwise stated all methods return either a I or I value, with I meaning that the operation was a success. When a method @@ -1583,7 +1567,7 @@ documented here. =over 4 -=item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ]) +=item C Log into the remote FTP server with the given login information. If no arguments are given then the C uses the C @@ -1595,114 +1579,114 @@ will be used for password. If the connection is via a firewall then the C method will be called with no arguments. -=item starttls () +=item C Upgrade existing plain connection to SSL. The SSL arguments have to be given in C already because they are needed for data connections too. -=item stoptls () +=item C Downgrade existing SSL connection back to plain. This is needed to work with some FTP helpers at firewalls, which need to see the PORT and PASV commands and responses to dynamically open the necessary ports. In this case C is usually only done to protect the authorization. -=item prot ( LEVEL ) +=item C Set what type of data channel protection the client and server will be using. -Only Cs "C" (clear) and "P" (private) are supported. +Only C<$level>s "C" (clear) and "P" (private) are supported. -=item host () +=item C Returns the value used by the constructor, and passed to the IO::Socket super class to connect to the host. -=item account( ACCT ) +=item C Set a string identifying the user's account. -=item authorize ( [AUTH [, RESP]]) +=item C This is a protocol used by some firewall ftp proxies. It is used to authorise the user to send data out. If both arguments are not specified then C uses C to do a lookup. -=item site (ARGS) +=item C Send a SITE command to the remote server and wait for a response. Returns most significant digit of the response code. -=item ascii () +=item C Transfer file in ASCII. CRLF translation will be done if required -=item binary () +=item C Transfer file in binary mode. No transformation will be done. B: If both server and client machines use the same line ending for text files, then it will be faster to transfer all files in binary mode. -=item type ( [ TYPE ] ) +=item C Set or get if files will be transferred in ASCII or binary mode. -=item rename ( OLDNAME, NEWNAME ) +=item C -Rename a file on the remote FTP server from C to C. This +Rename a file on the remote FTP server from C<$oldname> to C<$newname>. This is done by sending the RNFR and RNTO commands. -=item delete ( FILENAME ) +=item C -Send a request to the server to delete C. +Send a request to the server to delete C<$filename>. -=item cwd ( [ DIR ] ) +=item C Attempt to change directory to the directory given in C<$dir>. If C<$dir> is C<"..">, the FTP C command is used to attempt to move up one directory. If no directory is given then an attempt is made to change the directory to the root directory. -=item cdup () +=item C Change directory to the parent of the current directory. -=item passive ( [ PASSIVE ] ) +=item C Set or get if data connections will be initiated in passive mode. -=item pwd () +=item C Returns the full pathname of the current directory. -=item restart ( WHERE ) +=item C Set the byte offset at which to begin the next data transfer. Net::FTP simply records this value and uses it when during the next data transfer. For this reason this method will not return an error, but setting it may cause a subsequent data transfer to fail. -=item rmdir ( DIR [, RECURSE ]) +=item C -Remove the directory with the name C. If C is I then +Remove the directory with the name C<$dir>. If C<$recurse> is I then C will attempt to delete everything inside the directory. -=item mkdir ( DIR [, RECURSE ]) +=item C -Create a new directory with the name C. If C is I then +Create a new directory with the name C<$dir>. If C<$recurse> is I then C will attempt to create all the directories in the given path. Returns the full pathname to the new directory. -=item alloc ( SIZE [, RECORD_SIZE] ) +=item C The alloc command allows you to give the ftp server a hint about the size of the file about to be transferred using the ALLO ftp command. Some storage systems use this to make intelligent decisions about how to store the file. -The C argument represents the size of the file in bytes. The -C argument indicates a maximum record or page size for files +The C<$size> argument represents the size of the file in bytes. The +C<$record_size> argument indicates a maximum record or page size for files sent with a record or page structure. The size of the file will be determined, and sent to the server @@ -1710,70 +1694,70 @@ automatically for normal files so that this method need only be called if you are transferring data from a socket, named pipe, or other stream not associated with a normal file. -=item ls ( [ DIR ] ) +=item C -Get a directory listing of C, or the current directory. +Get a directory listing of C<$dir>, or the current directory. In an array context, returns a list of lines returned from the server. In a scalar context, returns a reference to a list. -=item dir ( [ DIR ] ) +=item C -Get a directory listing of C, or the current directory in long format. +Get a directory listing of C<$dir>, or the current directory in long format. In an array context, returns a list of lines returned from the server. In a scalar context, returns a reference to a list. -=item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] ) +=item C -Get C from the server and store locally. C may be +Get C<$remote_file> from the server and store locally. C<$local_file> may be a filename or a filehandle. If not specified, the file will be stored in the current directory with the same leafname as the remote file. -If C is given then the first C bytes of the file will +If C<$where> is given then the first C<$where> bytes of the file will not be transferred, and the remaining bytes will be appended to the local file if it already exists. -Returns C, or the generated local file name if C +Returns C<$local_file>, or the generated local file name if C<$local_file> is not given. If an error was encountered undef is returned. -=item put ( LOCAL_FILE [, REMOTE_FILE ] ) +=item C -Put a file on the remote server. C may be a name or a filehandle. -If C is a filehandle then C must be specified. If -C is not specified then the file will be stored in the current -directory with the same leafname as C. +Put a file on the remote server. C<$local_file> may be a name or a filehandle. +If C<$local_file> is a filehandle then C<$remote_file> must be specified. If +C<$remote_file> is not specified then the file will be stored in the current +directory with the same leafname as C<$local_file>. -Returns C, or the generated remote filename if C +Returns C<$remote_file>, or the generated remote filename if C<$remote_file> is not given. B: If for some reason the transfer does not complete and an error is returned then the contents that had been transferred will not be remove automatically. -=item put_unique ( LOCAL_FILE [, REMOTE_FILE ] ) +=item C Same as put but uses the C command. Returns the name of the file on the server. -=item append ( LOCAL_FILE [, REMOTE_FILE ] ) +=item C Same as put but appends to the file on the remote server. -Returns C, or the generated remote filename if C +Returns C<$remote_file>, or the generated remote filename if C<$remote_file> is not given. -=item unique_name () +=item C Returns the name of the last file stored on the server using the C command. -=item mdtm ( FILE ) +=item C Returns the I of the given file -=item size ( FILE ) +=item C Returns the size in bytes for the given file as stored on the remote server. @@ -1783,11 +1767,11 @@ and the remote server and local machine have different ideas about "End Of Line" then the size of file on the local machine after transfer may be different. -=item supported ( CMD ) +=item C Returns TRUE if the remote server supports the given command. -=item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] ) +=item C Called without parameters, or with the first argument false, hash marks are suppressed. If the first argument is true but not a reference to a @@ -1796,7 +1780,7 @@ of bytes per hash mark printed, and defaults to 1024. In all cases the return value is a reference to an array of two: the filehandle glob reference and the bytes per hash mark. -=item feature ( NAME ) +=item C Determine if the server supports the specified feature. The return value is a list of lines the server responded with to describe the @@ -1822,33 +1806,33 @@ reference to a C based object. =over 4 -=item nlst ( [ DIR ] ) +=item C Send an C command to the server, with an optional parameter. -=item list ( [ DIR ] ) +=item C Same as C but using the C command -=item retr ( FILE ) +=item C -Begin the retrieval of a file called C from the remote server. +Begin the retrieval of a file called C<$file> from the remote server. -=item stor ( FILE ) +=item C -Tell the server that you wish to store a file. C is the +Tell the server that you wish to store a file. C<$file> is the name of the new file that should be created. -=item stou ( FILE ) +=item C Same as C but using the C command. The name of the unique file which was created on the server will be available via the C method after the data connection has been closed. -=item appe ( FILE ) +=item C Tell the server that we want to append some data to the end of a file -called C. If this file does not exist then create it. +called C<$file>. If this file does not exist then create it. =back @@ -1862,17 +1846,17 @@ C and those that do not require data connections. =over 4 -=item port ( [ PORT ] ) +=item C -=item eprt ( [ PORT ] ) +=item C -Send a C (IPv4) or C (IPv6) command to the server. If C is +Send a C (IPv4) or C (IPv6) command to the server. If C<$port> is specified then it is sent to the server. If not, then a listen socket is created and the correct information sent to the server. -=item pasv () +=item C -=item epsv () +=item C Tell the server to go into passive mode (C for IPv4, C for IPv6). Returns the text that represents the port on which the server is listening, this @@ -1886,38 +1870,38 @@ servers, providing that these two servers can connect directly to each other. =over 4 -=item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) +=item C This method will do a file transfer between two remote ftp servers. If -C is omitted then the leaf name of C will be used. +C<$dest_file> is omitted then the leaf name of C<$src_file> will be used. -=item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] ) +=item C Like C but the file is stored on the remote server using the STOU command. -=item pasv_wait ( NON_PASV_SERVER ) +=item C This method can be used to wait for a transfer to complete between a passive server and a non-passive server. The method should be called on the passive server with the C object for the non-passive server passed as an argument. -=item abort () +=item C Abort the current data transfer. -=item quit () +=item C Send the QUIT command to the remote FTP server and close the socket connection. =back -=head2 Methods for the adventurous +=head2 Methods for the Adventurous =over 4 -=item quot (CMD [,ARGS]) +=item C Send a command, that Net::FTP does not directly support, to the remote server and wait for a response. @@ -1927,62 +1911,83 @@ Returns most significant digit of the response code. B This call should only be used on commands that do not require data connections. Misuse of this method can hang the connection. -=item can_inet6 () +=item C Returns whether we can use IPv6. -=item can_ssl () +=item C Returns whether we can use SSL. =back -=head1 THE dataconn CLASS +=head2 The dataconn Class Some of the methods defined in C return an object which will be derived from the C class. See L for more details. -=head1 UNIMPLEMENTED +=head2 Unimplemented The following RFC959 commands have not been implemented: =over 4 -=item B +=item C Mount a different file system structure without changing login or accounting information. -=item B +=item C Ask the server for "helpful information" (that's what the RFC says) on the commands it accepts. -=item B +=item C Specifies transfer mode (stream, block or compressed) for file to be transferred. -=item B +=item C Request remote server system identification. -=item B +=item C Request remote server status. -=item B +=item C Specifies file structure for file to be transferred. -=item B +=item C Reinitialize the connection, flushing all I/O and account information. =back -=head1 REPORTING BUGS +=head1 EXAMPLES + +For an example of the use of Net::FTP see + +=over 4 + +=item L + +C is a program that can retrieve, send, or list files via +the FTP protocol in a non-interactive manner. + +=back + +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +See L. + +=head2 Reporting Bugs When reporting bugs/problems please include as much information as possible. It may be difficult for me to reproduce the problem as almost every setup @@ -1994,51 +1999,42 @@ passed to the constructor, and the output sent with the bug report. If you cannot include a small script then please include a Debug trace from a run of your program which does yield the problem. -=head1 AUTHOR - -Graham Barr EFE. - -Steve Hay EFE is now maintaining libnet as of version -1.22_02. - =head1 SEE ALSO L, L, -L +L; -ftp(1), ftpd(8), RFC 959, RFC 2428, RFC 4217 -http://www.ietf.org/rfc/rfc959.txt -http://www.ietf.org/rfc/rfc2428.txt -http://www.ietf.org/rfc/rfc4217.txt +L, +L; -=head1 USE EXAMPLES +L, +L, +L. -For an example of the use of Net::FTP see +=head1 ACKNOWLEDGEMENTS -=over 4 +Henry Gabryjelski ELE - for the +suggestion of creating directories recursively. -=item http://www.csh.rit.edu/~adam/Progs/ +Nathan Torkington ELE - for some +input on the documentation. -C is a program that can retrieve, send, or list files via -the FTP protocol in a non-interactive manner. +Roderick Schertler ELE - for +various inputs -=back - -=head1 CREDITS - -Henry Gabryjelski - for the suggestion of creating directories -recursively. +=head1 AUTHOR -Nathan Torkington - for some input on the documentation. +Graham Barr ELE. -Roderick Schertler - for various inputs +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-2004 Graham Barr. All rights reserved. -Copyright (C) 2013-2017 Steve Hay. All rights reserved. +Copyright (C) 2013-2017, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -2046,4 +2042,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/FTP/A.pm b/cpan/libnet/lib/Net/FTP/A.pm index 0ea1ba2fbd23..f22c974ba9c1 100644 --- a/cpan/libnet/lib/Net/FTP/A.pm +++ b/cpan/libnet/lib/Net/FTP/A.pm @@ -13,7 +13,7 @@ use Carp; use Net::FTP::dataconn; our @ISA = qw(Net::FTP::dataconn); -our $VERSION = "3.11"; +our $VERSION = "3.12"; our $buf; diff --git a/cpan/libnet/lib/Net/FTP/E.pm b/cpan/libnet/lib/Net/FTP/E.pm index 30b371a58b14..df281c05b9e6 100644 --- a/cpan/libnet/lib/Net/FTP/E.pm +++ b/cpan/libnet/lib/Net/FTP/E.pm @@ -8,6 +8,6 @@ use warnings; use Net::FTP::I; our @ISA = qw(Net::FTP::I); -our $VERSION = "3.11"; +our $VERSION = "3.12"; 1; diff --git a/cpan/libnet/lib/Net/FTP/I.pm b/cpan/libnet/lib/Net/FTP/I.pm index ec46ab0fdabd..8f85e0e1cf3d 100644 --- a/cpan/libnet/lib/Net/FTP/I.pm +++ b/cpan/libnet/lib/Net/FTP/I.pm @@ -13,7 +13,7 @@ use Carp; use Net::FTP::dataconn; our @ISA = qw(Net::FTP::dataconn); -our $VERSION = "3.11"; +our $VERSION = "3.12"; our $buf; diff --git a/cpan/libnet/lib/Net/FTP/L.pm b/cpan/libnet/lib/Net/FTP/L.pm index d9a88576d991..9eda6107d1d2 100644 --- a/cpan/libnet/lib/Net/FTP/L.pm +++ b/cpan/libnet/lib/Net/FTP/L.pm @@ -8,6 +8,6 @@ use warnings; use Net::FTP::I; our @ISA = qw(Net::FTP::I); -our $VERSION = "3.11"; +our $VERSION = "3.12"; 1; diff --git a/cpan/libnet/lib/Net/FTP/dataconn.pm b/cpan/libnet/lib/Net/FTP/dataconn.pm index 337b0e999bc5..51e9c2f2d295 100644 --- a/cpan/libnet/lib/Net/FTP/dataconn.pm +++ b/cpan/libnet/lib/Net/FTP/dataconn.pm @@ -13,7 +13,7 @@ use Carp; use Errno; use Net::Cmd; -our $VERSION = '3.11'; +our $VERSION = '3.12'; $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn"; our @ISA = $Net::FTP::IOCLASS; @@ -137,6 +137,22 @@ __END__ Net::FTP::dataconn - FTP Client data connection class +=head1 SYNOPSIS + + # Perform IO operations on an FTP client data connection object: + + $num_bytes_read = $obj->read($buffer, $size); + $num_bytes_read = $obj->read($buffer, $size, $timeout); + + $num_bytes_written = $obj->write($buffer, $size); + $num_bytes_written = $obj->write($buffer, $size, $timeout); + + $num_bytes_read_so_far = $obj->bytes_read(); + + $obj->abort(); + + $closed_successfully = $obj->close(); + =head1 DESCRIPTION Some of the methods defined in C return an object which will @@ -147,31 +163,31 @@ be performed using these. =over 4 -=item read ( BUFFER, SIZE [, TIMEOUT ] ) +=item C -Read C bytes of data from the server and place it into C, also -performing any translation necessary. C is optional, if not +Read C<$size> bytes of data from the server and place it into C<$buffer>, also +performing any translation necessary. C<$timeout> is optional, if not given, the timeout value from the command connection will be used. Returns the number of bytes read before any translation. -=item write ( BUFFER, SIZE [, TIMEOUT ] ) +=item C -Write C bytes of data from C to the server, also -performing any translation necessary. C is optional, if not +Write C<$size> bytes of data from C<$buffer> to the server, also +performing any translation necessary. C<$timeout> is optional, if not given, the timeout value from the command connection will be used. Returns the number of bytes written before any translation. -=item bytes_read () +=item C Returns the number of bytes read so far. -=item abort () +=item C Abort the current data transfer. -=item close () +=item C Close the data connection and get a response from the FTP server. Returns I if the connection was closed successfully and the first digit of @@ -179,4 +195,43 @@ the response from the server was a '2'. =back +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +I. + +=head1 AUTHOR + +Graham Barr ELE. + +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. + +=head1 COPYRIGHT + +Copyright (C) 1997-2010 Graham Barr. All rights reserved. + +Copyright (C) 2013-2014, 2020 Steve Hay. All rights reserved. + +=head1 LICENCE + +This module is free software; you can redistribute it and/or modify it under the +same terms as Perl itself, i.e. under the terms of either the GNU General Public +License or the Artistic License, as specified in the F file. + +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/NNTP.pm b/cpan/libnet/lib/Net/NNTP.pm index 0c22930148a5..9289b59432cc 100644 --- a/cpan/libnet/lib/Net/NNTP.pm +++ b/cpan/libnet/lib/Net/NNTP.pm @@ -1,7 +1,7 @@ # Net::NNTP.pm # # Copyright (C) 1995-1997 Graham Barr. All rights reserved. -# Copyright (C) 2013-2016 Steve Hay. All rights reserved. +# Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -19,7 +19,7 @@ use Net::Cmd; use Net::Config; use Time::Local; -our $VERSION = "3.11"; +our $VERSION = "3.12"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -96,7 +96,6 @@ sub new { if ($arg{SSL}) { Net::NNTP::_SSL->start_SSL($obj,%arg) or next; } - last: } return @@ -176,7 +175,7 @@ sub starttls { sub article { - @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article( [ MSGID ], [ FH ] )'; + @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->article([{$msgid|$msgnum}[, $fh]])'; my $nntp = shift; my @fh; @@ -189,7 +188,7 @@ sub article { sub articlefh { - @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh( [ MSGID ] )'; + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->articlefh([{$msgid|$msgnum}])'; my $nntp = shift; return unless $nntp->_ARTICLE(@_); @@ -198,7 +197,7 @@ sub articlefh { sub authinfo { - @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )'; + @_ == 3 or croak 'usage: $nntp->authinfo($user, $pass)'; my ($nntp, $user, $pass) = @_; $nntp->_AUTHINFO("USER", $user) == CMD_MORE @@ -207,7 +206,7 @@ sub authinfo { sub authinfo_simple { - @_ == 3 or croak 'usage: $nntp->authinfo( USER, PASS )'; + @_ == 3 or croak 'usage: $nntp->authinfo_simple($user, $pass)'; my ($nntp, $user, $pass) = @_; $nntp->_AUTHINFO('SIMPLE') == CMD_MORE @@ -216,7 +215,7 @@ sub authinfo_simple { sub body { - @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body( [ MSGID ], [ FH ] )'; + @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->body([{$msgid|$msgnum}[, $fh]])'; my $nntp = shift; my @fh; @@ -229,7 +228,7 @@ sub body { sub bodyfh { - @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh( [ MSGID ] )'; + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->bodyfh([{$msgid|$msgnum}])'; my $nntp = shift; return unless $nntp->_BODY(@_); return $nntp->tied_fh; @@ -237,7 +236,7 @@ sub bodyfh { sub head { - @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head( [ MSGID ], [ FH ] )'; + @_ >= 1 && @_ <= 3 or croak 'usage: $nntp->head([{$msgid|$msgnum}[, $fh]])'; my $nntp = shift; my @fh; @@ -250,7 +249,7 @@ sub head { sub headfh { - @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh( [ MSGID ] )'; + @_ >= 1 && @_ <= 2 or croak 'usage: $nntp->headfh([{$msgid|$msgnum}])'; my $nntp = shift; return unless $nntp->_HEAD(@_); return $nntp->tied_fh; @@ -258,7 +257,7 @@ sub headfh { sub nntpstat { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat( [ MSGID ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->nntpstat([{$msgid|$msgnum}])'; my $nntp = shift; $nntp->_STAT(@_) && $nntp->message =~ /(<[^>]+>)/o @@ -268,7 +267,7 @@ sub nntpstat { sub group { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->group( [ GROUP ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->group([$group])'; my $nntp = shift; my $grp = ${*$nntp}{'net_nntp_group'}; @@ -308,11 +307,11 @@ sub help { sub ihave { - @_ >= 2 or croak 'usage: $nntp->ihave( MESSAGE-ID [, MESSAGE ])'; - my $nntp = shift; - my $mid = shift; + @_ >= 2 or croak 'usage: $nntp->ihave($msgid[, $message])'; + my $nntp = shift; + my $msgid = shift; - $nntp->_IHAVE($mid) && $nntp->datasend(@_) + $nntp->_IHAVE($msgid) && $nntp->datasend(@_) ? @_ == 0 || $nntp->dataend : undef; } @@ -339,15 +338,15 @@ sub list { sub newgroups { - @_ >= 2 or croak 'usage: $nntp->newgroups( SINCE [, DISTRIBUTIONS ])'; + @_ >= 2 or croak 'usage: $nntp->newgroups($since[, $distributions])'; my $nntp = shift; - my $time = _timestr(shift); - my $dist = shift || ""; + my $since = _timestr(shift); + my $distributions = shift || ""; - $dist = join(",", @{$dist}) - if ref($dist); + $distributions = join(",", @{$distributions}) + if ref($distributions); - $nntp->_NEWGROUPS($time, $dist) + $nntp->_NEWGROUPS($since, $distributions) ? $nntp->_grouplist : undef; } @@ -355,20 +354,20 @@ sub newgroups { sub newnews { @_ >= 2 && @_ <= 4 - or croak 'usage: $nntp->newnews( SINCE [, GROUPS [, DISTRIBUTIONS ]])'; + or croak 'usage: $nntp->newnews($since[, $groups[, $distributions]])'; my $nntp = shift; - my $time = _timestr(shift); - my $grp = @_ ? shift: $nntp->group; - my $dist = shift || ""; + my $since = _timestr(shift); + my $groups = @_ ? shift : $nntp->group; + my $distributions = shift || ""; - $grp ||= "*"; - $grp = join(",", @{$grp}) - if ref($grp); + $groups ||= "*"; + $groups = join(",", @{$groups}) + if ref($groups); - $dist = join(",", @{$dist}) - if ref($dist); + $distributions = join(",", @{$distributions}) + if ref($distributions); - $nntp->_NEWNEWS($grp, $time, $dist) + $nntp->_NEWNEWS($groups, $since, $distributions) ? $nntp->_articlelist : undef; } @@ -385,7 +384,7 @@ sub next { sub post { - @_ >= 1 or croak 'usage: $nntp->post( [ MESSAGE ] )'; + @_ >= 1 or croak 'usage: $nntp->post([$message])'; my $nntp = shift; $nntp->_POST() && $nntp->datasend(@_) @@ -423,7 +422,7 @@ sub slave { sub active { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->active( [ PATTERN ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->active([$pattern])'; my $nntp = shift; $nntp->_LIST('ACTIVE', @_) @@ -453,7 +452,7 @@ sub distributions { sub distribution_patterns { - @_ == 1 or croak 'usage: $nntp->distributions()'; + @_ == 1 or croak 'usage: $nntp->distribution_patterns()'; my $nntp = shift; my $arr; @@ -468,7 +467,7 @@ sub distribution_patterns { sub newsgroups { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups( [ PATTERN ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->newsgroups([$pattern])'; my $nntp = shift; $nntp->_LIST('NEWSGROUPS', @_) @@ -498,7 +497,7 @@ sub subscriptions { sub listgroup { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup( [ GROUP ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->listgroup([$group])'; my $nntp = shift; $nntp->_LISTGROUP(@_) @@ -516,7 +515,7 @@ sub reader { sub xgtitle { - @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle( [ PATTERN ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $nntp->xgtitle([$pattern])'; my $nntp = shift; $nntp->_XGTITLE(@_) @@ -526,19 +525,19 @@ sub xgtitle { sub xhdr { - @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr( HEADER, [ MESSAGE-SPEC ] )'; + @_ >= 2 && @_ <= 4 or croak 'usage: $nntp->xhdr($header[, $message_spec])'; my $nntp = shift; - my $hdr = shift; - my $arg = _msg_arg(@_); + my $header = shift; + my $arg = _msg_arg(@_); - $nntp->_XHDR($hdr, $arg) + $nntp->_XHDR($header, $arg) ? $nntp->_description : undef; } sub xover { - @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover( MESSAGE-SPEC )'; + @_ == 2 || @_ == 3 or croak 'usage: $nntp->xover($message_spec)'; my $nntp = shift; my $arg = _msg_arg(@_); @@ -549,27 +548,27 @@ sub xover { sub xpat { - @_ == 4 || @_ == 5 or croak '$nntp->xpat( HEADER, PATTERN, MESSAGE-SPEC )'; + @_ == 4 || @_ == 5 or croak 'usage: $nntp->xpat($header, $pattern, $message_spec )'; my $nntp = shift; - my $hdr = shift; - my $pat = shift; - my $arg = _msg_arg(@_); + my $header = shift; + my $pattern = shift; + my $arg = _msg_arg(@_); - $pat = join(" ", @$pat) - if ref($pat); + $pattern = join(" ", @$pattern) + if ref($pattern); - $nntp->_XPAT($hdr, $arg, $pat) + $nntp->_XPAT($header, $arg, $pattern) ? $nntp->_description : undef; } sub xpath { - @_ == 2 or croak 'usage: $nntp->xpath( MESSAGE-ID )'; - my ($nntp, $mid) = @_; + @_ == 2 or croak 'usage: $nntp->xpath($message_id)'; + my ($nntp, $message_id) = @_; return - unless $nntp->_XPATH($mid); + unless $nntp->_XPATH($message_id); my $m; ($m = $nntp->message) =~ s/^\d+\s+//o; @@ -580,7 +579,7 @@ sub xpath { sub xrover { - @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover( MESSAGE-SPEC )'; + @_ == 2 || @_ == 3 or croak 'usage: $nntp->xrover($message_spec)'; my $nntp = shift; my $arg = _msg_arg(@_); @@ -596,7 +595,7 @@ sub date { $nntp->_DATE && $nntp->message =~ /(\d{4})(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/ - ? timegm($6, $5, $4, $3, $2 - 1, $1 - 1900) + ? timegm($6, $5, $4, $3, $2 - 1, $1) : undef; } @@ -807,20 +806,20 @@ explicit TLS encryption, i.e. NNTPS or NNTP+STARTTLS. The Net::NNTP class is a subclass of Net::Cmd and (depending on avaibility) of IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET. -=head1 CONSTRUCTOR +=head2 Class Methods =over 4 -=item new ( [ HOST ] [, OPTIONS ]) +=item C -This is the constructor for a new Net::NNTP object. C is the +This is the constructor for a new Net::NNTP object. C<$host> is the name of the remote host to which a NNTP connection is required. If not given then it may be passed as the C option described below. If no host is passed then two environment variables are checked, first C then C, then C is checked, and if a host is not found then C is used. -C are passed in a hash like fashion, using key and value pairs. +C<%options> are passed in a hash like fashion, using key and value pairs. Possible options are: B - NNTP host to connect to. It may be a single scalar, as defined for @@ -857,7 +856,7 @@ class. Alternatively B can be used. =back -=head1 METHODS +=head2 Object Methods Unless otherwise stated all methods return either a I or I value, with I meaning that the operation was a success. When a method @@ -870,58 +869,58 @@ documented here. =over 4 -=item host () +=item C Returns the value used by the constructor, and passed to IO::Socket::INET, to connect to the host. -=item starttls () +=item C Upgrade existing plain connection to SSL. Any arguments necessary for SSL must be given in C already. -=item article ( [ MSGID|MSGNUM ], [FH] ) +=item C Retrieve the header, a blank line, then the body (text) of the specified article. -If C is specified then it is expected to be a valid filehandle +If C<$fh> is specified then it is expected to be a valid filehandle and the result will be printed to it, on success a true value will be -returned. If C is not specified then the return value, on success, +returned. If C<$fh> is not specified then the return value, on success, will be a reference to an array containing the article requested, each entry in the array will contain one line of the article. If no arguments are passed then the current article in the currently selected newsgroup is fetched. -C is a numeric id of an article in the current newsgroup, and -will change the current article pointer. C is the message id of +C<$msgnum> is a numeric id of an article in the current newsgroup, and +will change the current article pointer. C<$msgid> is the message id of an article as shown in that article's header. It is anticipated that the -client will obtain the C from a list provided by the C +client will obtain the C<$msgid> from a list provided by the C command, from references contained within another article, or from the message-id provided in the response to some other commands. If there is an error then C will be returned. -=item body ( [ MSGID|MSGNUM ], [FH] ) +=item C Like C
but only fetches the body of the article. -=item head ( [ MSGID|MSGNUM ], [FH] ) +=item C Like C
but only fetches the headers for the article. -=item articlefh ( [ MSGID|MSGNUM ] ) +=item C -=item bodyfh ( [ MSGID|MSGNUM ] ) +=item C -=item headfh ( [ MSGID|MSGNUM ] ) +=item C These are similar to article(), body() and head(), but rather than returning the requested data directly, they return a tied filehandle from which to read the article. -=item nntpstat ( [ MSGID|MSGNUM ] ) +=item C The C command is similar to the C
command except that no text is returned. When selecting by message number within a group, @@ -934,9 +933,9 @@ selection by message-id does B alter the "current article pointer". Returns the message-id of the "current article". -=item group ( [ GROUP ] ) +=item C -Set and/or get the current group. If C is not given then information +Set and/or get the current group. If C<$group> is not given then information is returned on the current group. In a scalar context it returns the group name. @@ -945,45 +944,45 @@ In an array context the return value is a list containing, the number of articles in the group, the number of the first article, the number of the last article and the group name. -=item help ( ) +=item C Request help text (a short summary of commands that are understood by this implementation) from the server. Returns the text or undef upon failure. -=item ihave ( MSGID [, MESSAGE ]) +=item C The C command informs the server that the client has an article -whose id is C. If the server desires a copy of that -article and C has been given then it will be sent. +whose id is C<$msgid>. If the server desires a copy of that +article and C<$message> has been given then it will be sent. -Returns I if the server desires the article and C was +Returns I if the server desires the article and C<$message> was successfully sent, if specified. -If C is not specified then the message must be sent using the +If C<$message> is not specified then the message must be sent using the C and C methods from L -C can be either an array of lines or a reference to an array +C<$message> can be either an array of lines or a reference to an array and must be encoded by the caller to octets of whatever encoding is required, e.g. by using the Encode module's C function. -=item last () +=item C Set the "current article pointer" to the previous article in the current newsgroup. Returns the message-id of the article. -=item date () +=item C Returns the date on the remote server. This date will be in a UNIX time format (seconds since 1970) -=item postok () +=item C C will return I if the servers initial response indicated that it will allow posting. -=item authinfo ( USER, PASS ) +=item C Authenticates to the server (using the original AUTHINFO USER / AUTHINFO PASS form, defined in RFC2980) using the supplied username and password. Please @@ -991,61 +990,61 @@ note that the password is sent in clear text to the server. This command should not be used with valuable passwords unless the connection to the server is somehow protected. -=item authinfo_simple ( USER, PASS ) +=item C Authenticates to the server (using the proposed NNTP V2 AUTHINFO SIMPLE form, defined and deprecated in RFC2980) using the supplied username and password. As with L the password is sent in clear text. -=item list () +=item C Obtain information about all the active newsgroups. The results is a reference to a hash where the key is a group name and each value is a reference to an array. The elements in this array are:- the last article number in the group, the first article number in the group and any information flags about the group. -=item newgroups ( SINCE [, DISTRIBUTIONS ]) +=item C -C is a time value and C is either a distribution +C<$since> is a time value and C<$distributions> is either a distribution pattern or a reference to a list of distribution patterns. The result is the same as C, but the -groups return will be limited to those created after C and, if -specified, in one of the distribution areas in C. +groups return will be limited to those created after C<$since> and, if +specified, in one of the distribution areas in C<$distributions>. -=item newnews ( SINCE [, GROUPS [, DISTRIBUTIONS ]]) +=item C -C is a time value. C is either a group pattern or a reference -to a list of group patterns. C is either a distribution +C<$since> is a time value. C<$groups> is either a group pattern or a reference +to a list of group patterns. C<$distributions> is either a distribution pattern or a reference to a list of distribution patterns. Returns a reference to a list which contains the message-ids of all news posted -after C, that are in a groups which matched C and a -distribution which matches C. +after C<$since>, that are in a groups which matched C<$groups> and a +distribution which matches C<$distributions>. -=item next () +=item C Set the "current article pointer" to the next article in the current newsgroup. Returns the message-id of the article. -=item post ( [ MESSAGE ] ) +=item C -Post a new article to the news server. If C is specified and posting +Post a new article to the news server. If C<$message> is specified and posting is allowed then the message will be sent. -If C is not specified then the message must be sent using the +If C<$message> is not specified then the message must be sent using the C and C methods from L -C can be either an array of lines or a reference to an array +C<$message> can be either an array of lines or a reference to an array and must be encoded by the caller to octets of whatever encoding is required, e.g. by using the Encode module's C function. -The message, either sent via C or as the C +The message, either sent via C or as the C<$message> parameter, must be in the format as described by RFC822 and must contain From:, Newsgroups: and Subject: headers. -=item postfh () +=item C Post a new article to the news server using a tied filehandle. If posting is allowed, this method will return a tied filehandle that you @@ -1054,85 +1053,85 @@ explicitly close() the filehandle when you are finished posting the article, and the return value from the close() call will indicate whether the message was successfully posted. -=item slave () +=item C Tell the remote server that I am not a user client, but probably another news server. -=item quit () +=item C Quit the remote server and close the socket connection. -=item can_inet6 () +=item C Returns whether we can use IPv6. -=item can_ssl () +=item C Returns whether we can use SSL. =back -=head2 Extension methods +=head2 Extension Methods These methods use commands that are not part of the RFC977 documentation. Some servers may not support all of them. =over 4 -=item newsgroups ( [ PATTERN ] ) +=item C Returns a reference to a hash where the keys are all the group names which -match C, or all of the groups if no pattern is specified, and +match C<$pattern>, or all of the groups if no pattern is specified, and each value contains the description text for the group. -=item distributions () +=item C Returns a reference to a hash where the keys are all the possible distribution names and the values are the distribution descriptions. -=item distribution_patterns () +=item C Returns a reference to an array where each element, itself an array reference, consists of the three fields of a line of the distrib.pats list maintained by some NNTP servers, namely: a weight, a wildmat and a value which the client may use to construct a Distribution header. -=item subscriptions () +=item C Returns a reference to a list which contains a list of groups which are recommended for a new user to subscribe to. -=item overview_fmt () +=item C Returns a reference to an array which contain the names of the fields returned by C. -=item active_times () +=item C Returns a reference to a hash where the keys are the group names and each value is a reference to an array containing the time the groups was created and an identifier, possibly an Email address, of the creator. -=item active ( [ PATTERN ] ) +=item C Similar to C but only active groups that match the pattern are returned. -C can be a group pattern. +C<$pattern> can be a group pattern. -=item xgtitle ( PATTERN ) +=item C Returns a reference to a hash where the keys are all the group names which -match C and each value is the description text for the group. +match C<$pattern> and each value is the description text for the group. -=item xhdr ( HEADER, MESSAGE-SPEC ) +=item C -Obtain the header field C
for all the messages specified. +Obtain the header field C<$header> for all the messages specified. The return value will be a reference to a hash where the keys are the message numbers and each value contains the text of the requested header for that message. -=item xover ( MESSAGE-SPEC ) +=item C The return value will be a reference to a hash where the keys are the message numbers and each value contains @@ -1141,17 +1140,17 @@ message. The names of the fields can be obtained by calling C. -=item xpath ( MESSAGE-ID ) +=item C Returns the path name to the file on the server which contains the specified message. -=item xpat ( HEADER, PATTERN, MESSAGE-SPEC) +=item C The result is the same as C except the is will be restricted to -headers where the text of the header matches C +headers where the text of the header matches C<$pattern> -=item xrover () +=item C The XROVER command returns reference information for the article(s) specified. @@ -1159,12 +1158,12 @@ specified. Returns a reference to a HASH where the keys are the message numbers and the values are the References: lines from the articles -=item listgroup ( [ GROUP ] ) +=item C -Returns a reference to a list of all the active messages in C, or -the current group if C is not specified. +Returns a reference to a list of all the active messages in C<$group>, or +the current group if C<$group> is not specified. -=item reader () +=item C Tell the server that you are a reader and not another server. @@ -1179,7 +1178,7 @@ the response is harmless. =back -=head1 UNSUPPORTED +=head2 Unsupported The following NNTP command are unsupported by the package, and there are no plans to do so. @@ -1189,16 +1188,16 @@ no plans to do so. XSEARCH XINDEX -=head1 DEFINITIONS +=head2 Definitions =over 4 -=item MESSAGE-SPEC +=item $message_spec -C is either a single message-id, a single message number, or +C<$message_spec> is either a single message-id, a single message number, or a reference to a list of two message numbers. -If C is a reference to a list of two message numbers and the +If C<$message_spec> is a reference to a list of two message numbers and the second number in a range is less than or equal to the first then the range represents all messages in the group after the first message number. @@ -1206,7 +1205,7 @@ B For compatibility reasons only with earlier versions of Net::NNTP a message spec can be passed as a list of two numbers, this is deprecated and a reference to the list should now be passed -=item PATTERN +=item $pattern The C protocol uses the C format for patterns. The WILDMAT format was first developed by Rich Salz based on @@ -1275,23 +1274,31 @@ with a and ends with d. =back +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +See L. + =head1 SEE ALSO L, -L +L. =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-1997 Graham Barr. All rights reserved. -Copyright (C) 2013-2016 Steve Hay. All rights reserved. +Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -1299,4 +1306,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/Netrc.pm b/cpan/libnet/lib/Net/Netrc.pm index 46fba2787c36..b66eb82d8b7f 100644 --- a/cpan/libnet/lib/Net/Netrc.pm +++ b/cpan/libnet/lib/Net/Netrc.pm @@ -1,7 +1,7 @@ # Net::Netrc.pm # # Copyright (C) 1995-1998 Graham Barr. All rights reserved. -# Copyright (C) 2013-2014 Steve Hay. All rights reserved. +# Copyright (C) 2013-2014, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -16,7 +16,7 @@ use warnings; use Carp; use FileHandle; -our $VERSION = "3.11"; +our $VERSION = "3.12"; our $TESTING; @@ -224,7 +224,7 @@ second the ownership permissions should be such that only the owner has read and write access. If these conditions are not met then a warning is output and the .netrc file is not read. -=head1 THE .netrc FILE +=head2 The F<.netrc> File The .netrc file contains login and initialization information used by the auto-login process. It resides in the user's home directory. The following @@ -276,7 +276,7 @@ with I. =back -=head1 CONSTRUCTOR +=head2 Class Methods The constructor for a C object is not called new as it does not really create a new object. But instead is called C as this is @@ -284,11 +284,11 @@ essentially what it does. =over 4 -=item lookup ( MACHINE [, LOGIN ]) +=item C -Lookup and return a reference to the entry for C. If C is given -then the entry returned will have the given login. If C is not given then -the first entry in the .netrc file for C will be returned. +Lookup and return a reference to the entry for C<$machine>. If C<$login> is given +then the entry returned will have the given login. If C<$login> is not given then +the first entry in the .netrc file for C<$machine> will be returned. If a matching entry cannot be found, and a default entry exists, then a reference to the default entry is returned. @@ -298,45 +298,52 @@ no .netrc file is found, then C is returned. =back -=head1 METHODS +=head2 Object Methods =over 4 -=item login () +=item C Return the login id for the netrc entry -=item password () +=item C Return the password for the netrc entry -=item account () +=item C Return the account information for the netrc entry -=item lpa () +=item C Return a list of login, password and account information for the netrc entry =back -=head1 AUTHOR +=head1 EXPORTS + +I. -Graham Barr EFE. +=head1 KNOWN BUGS -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +See L. =head1 SEE ALSO -L, -L +L. + +=head1 AUTHOR + +Graham Barr ELE. + +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-1998 Graham Barr. All rights reserved. -Copyright (C) 2013-2014 Steve Hay. All rights reserved. +Copyright (C) 2013-2014, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -344,4 +351,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/POP3.pm b/cpan/libnet/lib/Net/POP3.pm index 0811025b0a26..fb442ad3c1cc 100644 --- a/cpan/libnet/lib/Net/POP3.pm +++ b/cpan/libnet/lib/Net/POP3.pm @@ -1,7 +1,7 @@ # Net::POP3.pm # # Copyright (C) 1995-2004 Graham Barr. All rights reserved. -# Copyright (C) 2013-2016 Steve Hay. All rights reserved. +# Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -18,7 +18,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -our $VERSION = "3.11"; +our $VERSION = "3.12"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -124,7 +124,7 @@ sub debug_text { $_[2] =~ /^(pass|rpop)/i ? "$1 ....\n" : $_[2]; } sub login { - @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login( USER, PASS )'; + @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->login([$user[, $pass]])'; my ($me, $user, $pass) = @_; if (@_ <= 2) { @@ -147,7 +147,7 @@ sub starttls { } sub apop { - @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop( USER, PASS )'; + @_ >= 1 && @_ <= 3 or croak 'usage: $pop3->apop([$user[, $pass]])'; my ($me, $user, $pass) = @_; my $banner; my $md; @@ -180,13 +180,13 @@ sub apop { sub user { - @_ == 2 or croak 'usage: $pop3->user( USER )'; + @_ == 2 or croak 'usage: $pop3->user($user)'; $_[0]->_USER($_[1]) ? 1 : undef; } sub pass { - @_ == 2 or croak 'usage: $pop3->pass( PASS )'; + @_ == 2 or croak 'usage: $pop3->pass($pass)'; my ($me, $pass) = @_; @@ -225,7 +225,7 @@ sub last { sub top { - @_ == 2 || @_ == 3 or croak 'usage: $pop3->top( MSGNUM [, NUMLINES ])'; + @_ == 2 || @_ == 3 or croak 'usage: $pop3->top($msgnum[, $numlines])'; my $me = shift; return @@ -247,7 +247,7 @@ sub popstat { sub list { - @_ == 1 || @_ == 2 or croak 'usage: $pop3->list( [ MSGNUM ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $pop3->list([$msgnum])'; my $me = shift; return @@ -268,7 +268,7 @@ sub list { sub get { - @_ == 2 or @_ == 3 or croak 'usage: $pop3->get( MSGNUM [, FH ])'; + @_ == 2 or @_ == 3 or croak 'usage: $pop3->get($msgnum[, $fh])'; my $me = shift; return @@ -279,7 +279,7 @@ sub get { sub getfh { - @_ == 2 or croak 'usage: $pop3->getfh( MSGNUM )'; + @_ == 2 or croak 'usage: $pop3->getfh($msgnum)'; my $me = shift; return unless $me->_RETR(shift); @@ -288,7 +288,7 @@ sub getfh { sub delete { - @_ == 2 or croak 'usage: $pop3->delete( MSGNUM )'; + @_ == 2 or croak 'usage: $pop3->delete($msgnum)'; my $me = shift; return 0 unless $me->_DELE(@_); ${*$me}{'net_pop3_deleted'} = 1; @@ -296,7 +296,7 @@ sub delete { sub uidl { - @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl( [ MSGNUM ] )'; + @_ == 1 || @_ == 2 or croak 'usage: $pop3->uidl([$msgnum])'; my $me = shift; my $uidl; @@ -319,7 +319,7 @@ sub uidl { sub ping { - @_ == 2 or croak 'usage: $pop3->ping( USER )'; + @_ == 2 or croak 'usage: $pop3->ping($user)'; my $me = shift; return () unless $me->_PING(@_) && $me->message =~ /(\d+)\D+(\d+)/; @@ -635,21 +635,20 @@ on the object. The Net::POP3 class is a subclass of Net::Cmd and (depending on avaibility) of IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET. - -=head1 CONSTRUCTOR +=head2 Class Methods =over 4 -=item new ( [ HOST ] [, OPTIONS ] ) +=item C -This is the constructor for a new Net::POP3 object. C is the +This is the constructor for a new Net::POP3 object. C<$host> is the name of the remote host to which an POP3 connection is required. -C is optional. If C is not given then it may instead be +C<$host> is optional. If C<$host> is not given then it may instead be passed as the C option described below. If neither is given then the C specified in C will be used. -C are passed in a hash like fashion, using key and value pairs. +C<%options> are passed in a hash like fashion, using key and value pairs. Possible options are: B - POP3 host to connect to. It may be a single scalar, as defined for @@ -681,7 +680,7 @@ B - Enable debugging information =back -=head1 METHODS +=head2 Object Methods Unless otherwise stated all methods return either a I or I value, with I meaning that the operation was a success. When a method @@ -694,26 +693,26 @@ documented here. =over 4 -=item host () +=item C Returns the value used by the constructor, and passed to IO::Socket::INET, to connect to the host. -=item auth ( USERNAME, PASSWORD ) +=item C Attempt SASL authentication. -=item user ( USER ) +=item C Send the USER command. -=item pass ( PASS ) +=item C Send the PASS command. Returns the number of messages in the mailbox. -=item login ( [ USER [, PASS ]] ) +=item C -Send both the USER and PASS commands. If C is not given the +Send both the USER and PASS commands. If C<$pass> is not given the C uses C to lookup the password using the host and username. If the username is not specified then the current user name will be used. @@ -724,25 +723,25 @@ will give a true value in a boolean context, but zero in a numeric context. If there was an error authenticating the user then I will be returned. -=item starttls ( SSLARGS ) +=item C Upgrade existing plain connection to SSL. You can use SSL arguments as documented in L, but it will usually use the right arguments already. -=item apop ( [ USER [, PASS ]] ) +=item C -Authenticate with the server identifying as C with password C. +Authenticate with the server identifying as C<$user> with password C<$pass>. Similar to L, but the password is not sent in clear text. To use this method you must have the Digest::MD5 or the MD5 module installed, otherwise this method will return I. -=item banner () +=item C Return the sever's connection banner -=item capa () +=item C Return a reference to a hash of the capabilities of the server. APOP is added as a pseudo capability. Note that I've been unable to @@ -750,109 +749,117 @@ find a list of the standard capability values, and some appear to be multi-word and some are not. We make an attempt at intelligently parsing them, but it may not be correct. -=item capabilities () +=item C Just like capa, but only uses a cache from the last time we asked the server, so as to avoid asking more than once. -=item top ( MSGNUM [, NUMLINES ] ) +=item C -Get the header and the first C of the body for the message -C. Returns a reference to an array which contains the lines of text +Get the header and the first C<$numlines> of the body for the message +C<$msgnum>. Returns a reference to an array which contains the lines of text read from the server. -=item list ( [ MSGNUM ] ) +=item C If called with an argument the C returns the size of the message in octets. If called without arguments a reference to a hash is returned. The -keys will be the C's of all undeleted messages and the values will +keys will be the C<$msgnum>'s of all undeleted messages and the values will be their size in octets. -=item get ( MSGNUM [, FH ] ) +=item C -Get the message C from the remote mailbox. If C is not given +Get the message C<$msgnum> from the remote mailbox. If C<$fh> is not given then get returns a reference to an array which contains the lines of -text read from the server. If C is given then the lines returned -from the server are printed to the filehandle C. +text read from the server. If C<$fh> is given then the lines returned +from the server are printed to the filehandle C<$fh>. -=item getfh ( MSGNUM ) +=item C As per get(), but returns a tied filehandle. Reading from this filehandle returns the requested message. The filehandle will return EOF at the end of the message and should not be reused. -=item last () +=item C -Returns the highest C of all the messages accessed. +Returns the highest C<$msgnum> of all the messages accessed. -=item popstat () +=item C Returns a list of two elements. These are the number of undeleted elements and the size of the mbox in octets. -=item ping ( USER ) +=item C Returns a list of two elements. These are the number of new messages -and the total number of messages for C. +and the total number of messages for C<$user>. -=item uidl ( [ MSGNUM ] ) +=item C -Returns a unique identifier for C if given. If C is not +Returns a unique identifier for C<$msgnum> if given. If C<$msgnum> is not given C returns a reference to a hash where the keys are the message numbers and the values are the unique identifiers. -=item delete ( MSGNUM ) +=item C -Mark message C to be deleted from the remote mailbox. All messages +Mark message C<$msgnum> to be deleted from the remote mailbox. All messages that are marked to be deleted will be removed from the remote mailbox when the server connection closed. -=item reset () +=item C Reset the status of the remote POP3 server. This includes resetting the status of all messages to not be deleted. -=item quit () +=item C Quit and close the connection to the remote POP3 server. Any messages marked as deleted will be deleted from the remote mailbox. -=item can_inet6 () +=item C Returns whether we can use IPv6. -=item can_ssl () +=item C Returns whether we can use SSL. =back -=head1 NOTES +=head2 Notes If a C object goes out of scope before C method is called then the C method will called before the connection is closed. This means that any messages marked to be deleted will not be. +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +See L. + =head1 SEE ALSO L, L, -L +L. =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-2004 Graham Barr. All rights reserved. -Copyright (C) 2013-2016 Steve Hay. All rights reserved. +Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -860,4 +867,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/SMTP.pm b/cpan/libnet/lib/Net/SMTP.pm index 5eaf4220b62b..fd81d0be9757 100644 --- a/cpan/libnet/lib/Net/SMTP.pm +++ b/cpan/libnet/lib/Net/SMTP.pm @@ -1,7 +1,7 @@ # Net::SMTP.pm # # Copyright (C) 1995-2004 Graham Barr. All rights reserved. -# Copyright (C) 2013-2016 Steve Hay. All rights reserved. +# Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -19,7 +19,7 @@ use Net::Cmd; use Net::Config; use Socket; -our $VERSION = "3.11"; +our $VERSION = "3.12"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -663,57 +663,23 @@ explicit TLS encryption, i.e. SMTPS or SMTP+STARTTLS. The Net::SMTP class is a subclass of Net::Cmd and (depending on avaibility) of IO::Socket::IP, IO::Socket::INET6 or IO::Socket::INET. -=head1 EXAMPLES - -This example prints the mail domain name of the SMTP server known as mailhost: - - #!/usr/local/bin/perl -w - - use Net::SMTP; - - $smtp = Net::SMTP->new('mailhost'); - print $smtp->domain,"\n"; - $smtp->quit; - -This example sends a small message to the postmaster at the SMTP server -known as mailhost: - - #!/usr/local/bin/perl -w - - use Net::SMTP; - - my $smtp = Net::SMTP->new('mailhost'); - - $smtp->mail($ENV{USER}); - if ($smtp->to('postmaster')) { - $smtp->data(); - $smtp->datasend("To: postmaster\n"); - $smtp->datasend("\n"); - $smtp->datasend("A simple test message\n"); - $smtp->dataend(); - } else { - print "Error: ", $smtp->message(); - } - - $smtp->quit; - -=head1 CONSTRUCTOR +=head2 Class Methods =over 4 -=item new ( [ HOST ] [, OPTIONS ] ) +=item C -This is the constructor for a new Net::SMTP object. C is the +This is the constructor for a new Net::SMTP object. C<$host> is the name of the remote host to which an SMTP connection is required. On failure C will be returned and C<$@> will contain the reason for the failure. -C is optional. If C is not given then it may instead be +C<$host> is optional. If C<$host> is not given then it may instead be passed as the C option described below. If neither is given then the C specified in C will be used. -C are passed in a hash like fashion, using key and value pairs. +C<%options> are passed in a hash like fashion, using key and value pairs. Possible options are: B - SMTP requires that you identify yourself. This option @@ -748,16 +714,14 @@ class. Alternatively B can be used. B - Maximum time, in seconds, to wait for a response from the SMTP server (default: 120) -B - If true the all ADDRESS arguments must be as +B - If true then all C<$address> arguments must be as defined by C in RFC2822. If not given, or false, then Net::SMTP will attempt to extract the address from the value passed. B - Enable debugging information - Example: - $smtp = Net::SMTP->new('mailhost', Hello => 'my.mail.domain', Timeout => 30, @@ -788,7 +752,7 @@ Example: =back -=head1 METHODS +=head1 Object Methods Unless otherwise stated all methods return either a I or I value, with I meaning that the operation was a success. When a method @@ -801,60 +765,60 @@ documented here. =over 4 -=item banner () +=item C Returns the banner message which the server replied with when the initial connection was made. -=item domain () +=item C Returns the domain that the remote SMTP server identified itself as during connection. -=item hello ( DOMAIN ) +=item C Tell the remote server the mail domain which you are in using the EHLO command (or HELO if EHLO fails). Since this method is invoked automatically when the Net::SMTP object is constructed the user should normally not have to call it manually. -=item host () +=item C Returns the value used by the constructor, and passed to IO::Socket::INET, to connect to the host. -=item etrn ( DOMAIN ) +=item C -Request a queue run for the DOMAIN given. +Request a queue run for the C<$domain> given. -=item starttls ( SSLARGS ) +=item C Upgrade existing plain connection to SSL. You can use SSL arguments as documented in L, but it will usually use the right arguments already. -=item auth ( USERNAME, PASSWORD ) +=item C -=item auth ( SASL ) +=item C Attempt SASL authentication. Requires Authen::SASL module. The first form constructs a new Authen::SASL object using the given username and password; the second form uses the given Authen::SASL object. -=item mail ( ADDRESS [, OPTIONS] ) +=item C -=item send ( ADDRESS ) +=item C -=item send_or_mail ( ADDRESS ) +=item C -=item send_and_mail ( ADDRESS ) +=item C -Send the appropriate command to the server MAIL, SEND, SOML or SAML. C
+Send the appropriate command to the server MAIL, SEND, SOML or SAML. C<$address> is the address of the sender. This initiates the sending of a message. The method C should be called for each address that the message is to be sent to. -The C method can some additional ESMTP OPTIONS which is passed +The C method can take some additional ESMTP C<%options> which is passed in hash like fashion, using key and value pairs. Possible options are: Size => @@ -872,13 +836,13 @@ Status Notification). The submitter address in C option is expected to be in a format as required by RFC 2554, in an RFC2821-quoted form and xtext-encoded, or <> . -=item reset () +=item C Reset the status of the server. This may be called after a message has been initiated, but before any data has been sent, to cancel the sending of the message. -=item recipient ( ADDRESS [, ADDRESS, [...]] [, OPTIONS ] ) +=item C Notify the server that the current message should be sent to all of the addresses given. Each address is sent as a separate command to the server. @@ -886,7 +850,7 @@ Should the sending of any address result in a failure then the process is aborted and a I value is returned. It is up to the user to call C if they so desire. -The C method can also pass additional case-sensitive OPTIONS as an +The C method can also pass additional case-sensitive C<%options> as an anonymous hash using key and value pairs. Possible options are: Notify => ['NEVER'] or ['SUCCESS','FAILURE','DELAY'] (see below) @@ -919,8 +883,9 @@ that a DSN not be returned to the sender under any conditions." $smtp->recipient(@recipients, { Notify => ['NEVER'], SkipBad => 1 }); # Good You may use any combination of these three values 'SUCCESS','FAILURE','DELAY' in -the anonymous array reference as defined by RFC3461 (see http://www.ietf.org/rfc/rfc3461.txt -for more information. Note: quotations in this topic from same.). +the anonymous array reference as defined by RFC3461 (see +L for more information. Note: quotations +in this topic from same.). A Notify parameter of 'SUCCESS' or 'FAILURE' "requests that a DSN be issued on successful delivery or delivery failure, respectively." @@ -943,67 +908,67 @@ sent to. The machine that generates a DSN will use this address to inform the sender, because he can't know if recipients get rewritten by mail servers. It is expected to be in a format as required by RFC3461, xtext-encoded. -=item to ( ADDRESS [, ADDRESS [...]] ) +=item C -=item cc ( ADDRESS [, ADDRESS [...]] ) +=item C -=item bcc ( ADDRESS [, ADDRESS [...]] ) +=item C Synonyms for C. -=item data ( [ DATA ] ) +=item C Initiate the sending of the data from the current message. -C may be a reference to a list or a list and must be encoded by the +C<$data> may be a reference to a list or a list and must be encoded by the caller to octets of whatever encoding is required, e.g. by using the Encode module's C function. -If specified the contents of C and a termination string C<".\r\n"> is +If specified the contents of C<$data> and a termination string C<".\r\n"> is sent to the server. The result will be true if the data was accepted. -If C is not specified then the result will indicate that the server +If C<$data> is not specified then the result will indicate that the server wishes the data to be sent. The data must then be sent using the C and C methods described in L. -=item bdat ( DATA ) +=item C -=item bdatlast ( DATA ) +=item C -Use the alternate DATA command "BDAT" of the data chunking service extension +Use the alternate C<$data> command "BDAT" of the data chunking service extension defined in RFC1830 for efficiently sending large MIME messages. -=item expand ( ADDRESS ) +=item C Request the server to expand the given address Returns an array which contains the text read from the server. -=item verify ( ADDRESS ) +=item C -Verify that C
is a legitimate mailing address. +Verify that C<$address> is a legitimate mailing address. Most sites usually disable this feature in their SMTP service configuration. Use "Debug => 1" option under new() to see if disabled. -=item help ( [ $subject ] ) +=item C Request help text from the server. Returns the text or undef upon failure -=item quit () +=item C Send the QUIT command to the remote SMTP server and close the socket connection. -=item can_inet6 () +=item C Returns whether we can use IPv6. -=item can_ssl () +=item C Returns whether we can use SSL. =back -=head1 ADDRESSES +=head2 Addresses Net::SMTP attempts to DWIM with addresses that are passed. For example an application might extract The From: line from an email @@ -1019,23 +984,65 @@ accept the address surrounded by angle brackets. "funny user"@domain RIGHT, recommended <"funny user"@domain> OK +=head1 EXAMPLES + +This example prints the mail domain name of the SMTP server known as mailhost: + + #!/usr/local/bin/perl -w + + use Net::SMTP; + + $smtp = Net::SMTP->new('mailhost'); + print $smtp->domain,"\n"; + $smtp->quit; + +This example sends a small message to the postmaster at the SMTP server +known as mailhost: + + #!/usr/local/bin/perl -w + + use Net::SMTP; + + my $smtp = Net::SMTP->new('mailhost'); + + $smtp->mail($ENV{USER}); + if ($smtp->to('postmaster')) { + $smtp->data(); + $smtp->datasend("To: postmaster\n"); + $smtp->datasend("\n"); + $smtp->datasend("A simple test message\n"); + $smtp->dataend(); + } else { + print "Error: ", $smtp->message(); + } + + $smtp->quit; + +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +See L. + =head1 SEE ALSO L, -L +L. =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-2004 Graham Barr. All rights reserved. -Copyright (C) 2013-2016 Steve Hay. All rights reserved. +Copyright (C) 2013-2016, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -1043,4 +1050,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/Time.pm b/cpan/libnet/lib/Net/Time.pm index d049408538fd..4ce1daf120a2 100644 --- a/cpan/libnet/lib/Net/Time.pm +++ b/cpan/libnet/lib/Net/Time.pm @@ -1,7 +1,7 @@ # Net::Time.pm # # Copyright (C) 1995-2004 Graham Barr. All rights reserved. -# Copyright (C) 2014 Steve Hay. All rights reserved. +# Copyright (C) 2014, 2020 Steve Hay. All rights reserved. # This module is free software; you can redistribute it and/or modify it under # the same terms as Perl itself, i.e. under the terms of either the GNU General # Public License or the Artistic License, as specified in the F file. @@ -22,7 +22,7 @@ use Net::Config; our @ISA = qw(Exporter); our @EXPORT_OK = qw(inet_time inet_daytime); -our $VERSION = "3.11"; +our $VERSION = "3.12"; our $TIMEOUT = 120; @@ -123,37 +123,64 @@ Net::Time - time and daytime network client interface C provides subroutines that obtain the time on a remote machine. +=head2 Functions + =over 4 -=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]]) +=item C -Obtain the time on C, or some default host if C is not given +Obtain the time on C<$host>, or some default host if C<$host> is not given or not defined, using the protocol as defined in RFC868. The optional -argument C should define the protocol to use, either C or +argument C<$protocol> should define the protocol to use, either C or C. The result will be a time value in the same units as returned by time() or I upon failure. -=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]]) +=item C -Obtain the time on C, or some default host if C is not given +Obtain the time on C<$host>, or some default host if C<$host> is not given or not defined, using the protocol as defined in RFC867. The optional -argument C should define the protocol to use, either C or +argument C<$protocol> should define the protocol to use, either C or C. The result will be an ASCII string or I upon failure. =back +=head1 EXPORTS + +The following symbols are, or can be, exported by this module: + +=over 4 + +=item Default Exports + +I. + +=item Optional Exports + +C, +C. + +=item Export Tags + +I. + +=back + +=head1 KNOWN BUGS + +I. + =head1 AUTHOR -Graham Barr EFE. +Graham Barr ELE. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head1 COPYRIGHT Copyright (C) 1995-2004 Graham Barr. All rights reserved. -Copyright (C) 2014 Steve Hay. All rights reserved. +Copyright (C) 2014, 2020 Steve Hay. All rights reserved. =head1 LICENCE @@ -161,4 +188,16 @@ This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself, i.e. under the terms of either the GNU General Public License or the Artistic License, as specified in the F file. +=head1 VERSION + +Version 3.12 + +=head1 DATE + +09 Dec 2020 + +=head1 HISTORY + +See the F file. + =cut diff --git a/cpan/libnet/lib/Net/libnetFAQ.pod b/cpan/libnet/lib/Net/libnetFAQ.pod index bcc53479ba9b..4a3b183cd126 100644 --- a/cpan/libnet/lib/Net/libnetFAQ.pod +++ b/cpan/libnet/lib/Net/libnetFAQ.pod @@ -9,23 +9,25 @@ libnetFAQ - libnet Frequently Asked Questions This document is distributed with the libnet distribution, and is also available on the libnet web page at - http://search.cpan.org/dist/libnet/ +L =head2 How to contribute to this document You may report corrections, additions, and suggestions on the CPAN Request Tracker at - http://rt.cpan.org/Public/Bug/Report.html?Queue=libnet +L =head1 Author and Copyright Information Copyright (C) 1997-1998 Graham Barr. All rights reserved. -This document is free; you can redistribute it and/or modify it -under the terms of the Artistic License. +This document is free; you can redistribute it and/or modify it under +the same terms as Perl itself, i.e. under the terms of either the GNU +General Public License or the Artistic License, as specified in the +F file. -Steve Hay EFE is now maintaining libnet as of version -1.22_02. +Steve Hay ELE is now maintaining +libnet as of version 1.22_02. =head2 Disclaimer @@ -70,7 +72,7 @@ on any machine that perl runs on. The latest libnet release is always on CPAN, you will find it in - http://search.cpan.org/dist/libnet/ +L =head1 Using Net::FTP diff --git a/cpan/libnet/t/config.t b/cpan/libnet/t/config.t index 3c29a03d0ddd..897ca211c0c6 100644 --- a/cpan/libnet/t/config.t +++ b/cpan/libnet/t/config.t @@ -5,15 +5,21 @@ use 5.008001; use strict; use warnings; +use Test::More; + BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } + else { + plan tests => 10; } + undef *{Socket::inet_aton}; undef *{Socket::inet_ntoa}; - if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; - } $INC{'Socket.pm'} = 1; } @@ -45,13 +51,8 @@ sub inet_ntoa { return $names{$_[0]}; } -package main; - -(my $libnet_t = __FILE__) =~ s/config.t/libnet_t.pl/; -require $libnet_t; - -print "1..10\n"; +package main; use Net::Config; ok( exists $INC{'Net/Config.pm'}, 'Net::Config should have been used' ); diff --git a/cpan/libnet/t/datasend.t b/cpan/libnet/t/datasend.t index 0aea9d4a39d8..7902c17d47e2 100644 --- a/cpan/libnet/t/datasend.t +++ b/cpan/libnet/t/datasend.t @@ -5,12 +5,17 @@ use 5.008001; use strict; use warnings; +use Test::More; + BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; } - if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + else { + plan tests => 54; } } @@ -41,11 +46,6 @@ BEGIN { } } -(my $libnet_t = __FILE__) =~ s/datasend.t/libnet_t.pl/; -require $libnet_t or die; - -print "1..54\n"; - sub check { my $expect = pop; my $cmd = Foo->new; diff --git a/cpan/libnet/t/ftp.t b/cpan/libnet/t/ftp.t index 16cb868460b2..69af504a5271 100644 --- a/cpan/libnet/t/ftp.t +++ b/cpan/libnet/t/ftp.t @@ -7,7 +7,7 @@ use warnings; BEGIN { if (!eval { require Socket }) { - print "1..0 # Skip: no Socket module\n"; exit 0; + print "1..0 # Skip: no Socket\n"; exit 0; } if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { print "1..0 # Skip: EBCDIC but no Convert::EBCDIC\n"; exit 0; diff --git a/cpan/libnet/t/hostname.t b/cpan/libnet/t/hostname.t index 55031bf34509..5e20b819a9a1 100644 --- a/cpan/libnet/t/hostname.t +++ b/cpan/libnet/t/hostname.t @@ -7,10 +7,10 @@ use warnings; BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + print "1..0 # Skip: no Socket\n"; exit 0; } if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + print "1..0 # Skip: EBCDIC but no Convert::EBCDIC\n"; exit 0; } } @@ -18,7 +18,7 @@ use Net::Domain qw(hostname domainname hostdomain hostfqdn); use Net::Config; unless($NetConfig{test_hosts}) { - print "1..0\n"; + print "1..0 # Skip: test_hosts not enabled in config\n"; exit 0; } diff --git a/cpan/libnet/t/libnet_t.pl b/cpan/libnet/t/libnet_t.pl deleted file mode 100644 index cc512ca592c8..000000000000 --- a/cpan/libnet/t/libnet_t.pl +++ /dev/null @@ -1,41 +0,0 @@ -use 5.008001; - -use strict; -use warnings; - -my $number = 0; -sub ok { - my ($condition, $name) = @_; - - my $message = $condition ? "ok " : "not ok "; - $message .= ++$number; - $message .= " # $name" if defined $name; - print $message, "\n"; - return $condition; -} - -sub is { - my ($got, $expected, $name) = @_; - - for ($got, $expected) { - $_ = 'undef' unless defined $_; - } - - unless (ok($got eq $expected, $name)) { - warn "Got: '$got'\nExpected: '$expected'\n" . join(' ', caller) . "\n"; - } -} - -sub skip { - my ($reason, $num) = @_; - $reason ||= ''; - $number ||= 1; - - for (1 .. $num) { - $number++; - print "ok $number # skip $reason\n"; - } -} - -1; - diff --git a/cpan/libnet/t/netrc.t b/cpan/libnet/t/netrc.t index e270b368bc24..ba0183c1a5cc 100644 --- a/cpan/libnet/t/netrc.t +++ b/cpan/libnet/t/netrc.t @@ -5,17 +5,21 @@ use 5.008001; use strict; use warnings; +use Test::More; + BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; } - if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + else { + plan tests => 20; } } use Cwd; -print "1..20\n"; # for testing _readrc $ENV{HOME} = Cwd::cwd(); @@ -36,9 +40,6 @@ my @stat; # for testing _readrc $INC{'FileHandle.pm'} = 1; -(my $libnet_t = __FILE__) =~ s/\w+.t$/libnet_t.pl/; -require $libnet_t; - # now that the tricks are out of the way... eval { require Net::Netrc; }; ok( !$@, 'should be able to require() Net::Netrc safely' ); diff --git a/cpan/libnet/t/nntp.t b/cpan/libnet/t/nntp.t index 559f3985548f..b346caaf5330 100644 --- a/cpan/libnet/t/nntp.t +++ b/cpan/libnet/t/nntp.t @@ -7,10 +7,10 @@ use warnings; BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + print "1..0 # Skip: no Socket\n"; exit 0; } if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + print "1..0 # Skip: EBCDIC but no Convert::EBCDIC\n"; exit 0; } } @@ -18,8 +18,13 @@ use Net::Config; use Net::NNTP; use Net::Cmd qw(CMD_REJECT); -unless(@{$NetConfig{nntp_hosts}} && $NetConfig{test_hosts}) { - print "1..0\n"; +unless(@{$NetConfig{nntp_hosts}}) { + print "1..0 # Skip: no nntp_hosts defined in config\n"; + exit; +} + +unless($NetConfig{test_hosts}) { + print "1..0 # Skip: test_hosts not enabled in config\n"; exit; } diff --git a/cpan/libnet/t/nntp_ipv6.t b/cpan/libnet/t/nntp_ipv6.t index 768489a1afdd..af1ba1631ef6 100644 --- a/cpan/libnet/t/nntp_ipv6.t +++ b/cpan/libnet/t/nntp_ipv6.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::NNTP; -use Test::More; my $debug = 0; # Net::NNTP->new( Debug => .. ) diff --git a/cpan/libnet/t/nntp_ssl.t b/cpan/libnet/t/nntp_ssl.t index e6a4fe5f23b2..5120e9210eb9 100644 --- a/cpan/libnet/t/nntp_ssl.t +++ b/cpan/libnet/t/nntp_ssl.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::NNTP; -use Test::More; my $debug = 0; # Net::NNTP Debug => .. diff --git a/cpan/libnet/t/pop3_ipv6.t b/cpan/libnet/t/pop3_ipv6.t index db311283e06f..e68412279ce2 100644 --- a/cpan/libnet/t/pop3_ipv6.t +++ b/cpan/libnet/t/pop3_ipv6.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::POP3; -use Test::More; my $debug = 0; # Net::POP3->new( Debug => .. ) diff --git a/cpan/libnet/t/pop3_ssl.t b/cpan/libnet/t/pop3_ssl.t index 356de40acb35..12d31ecc58b0 100644 --- a/cpan/libnet/t/pop3_ssl.t +++ b/cpan/libnet/t/pop3_ssl.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::POP3; -use Test::More; my $debug = 0; # Net::POP3 Debug => .. diff --git a/cpan/libnet/t/require.t b/cpan/libnet/t/require.t index 70ec1f67f09c..cc14b4bc0d63 100644 --- a/cpan/libnet/t/require.t +++ b/cpan/libnet/t/require.t @@ -7,10 +7,10 @@ use warnings; BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + print "1..0 # Skip: no Socket\n"; exit 0; } if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + print "1..0 # Skip: EBCDIC but no Convert::EBCDIC\n"; exit 0; } } diff --git a/cpan/libnet/t/smtp.t b/cpan/libnet/t/smtp.t index 9d6f65a484dd..e2cd6eb83efb 100644 --- a/cpan/libnet/t/smtp.t +++ b/cpan/libnet/t/smtp.t @@ -7,18 +7,23 @@ use warnings; BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + print "1..0 # Skip: no Socket\n"; exit 0; } - if (ord('A') == 193 && eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + print "1..0 # Skip: EBCDIC but no Convert::EBCDIC\n"; exit 0; } } use Net::Config; use Net::SMTP; -unless(@{$NetConfig{smtp_hosts}} && $NetConfig{test_hosts}) { - print "1..0\n"; +unless(@{$NetConfig{smtp_hosts}}) { + print "1..0 # Skip: no smtp_hosts defined in config\n"; + exit 0; +} + +unless($NetConfig{test_hosts}) { + print "1..0 # Skip: test_hosts not enabled in config\n"; exit 0; } diff --git a/cpan/libnet/t/smtp_ipv6.t b/cpan/libnet/t/smtp_ipv6.t index f430721dcc21..d0bdb906bbaa 100644 --- a/cpan/libnet/t/smtp_ipv6.t +++ b/cpan/libnet/t/smtp_ipv6.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::SMTP; -use Test::More; my $debug = 0; # Net::SMTP->new( Debug => .. ) diff --git a/cpan/libnet/t/smtp_ssl.t b/cpan/libnet/t/smtp_ssl.t index 7290176b23f8..314dcb708a8e 100644 --- a/cpan/libnet/t/smtp_ssl.t +++ b/cpan/libnet/t/smtp_ssl.t @@ -5,10 +5,20 @@ use 5.008001; use strict; use warnings; +use Test::More; + +BEGIN { + if (!eval { require Socket }) { + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; + } +} + use Config; use File::Temp 'tempfile'; use Net::SMTP; -use Test::More; my $debug = 0; # Net::SMTP Debug => .. diff --git a/cpan/libnet/t/time.t b/cpan/libnet/t/time.t index 6dcba3a3e052..1b02d606cf63 100644 --- a/cpan/libnet/t/time.t +++ b/cpan/libnet/t/time.t @@ -5,22 +5,24 @@ use 5.008001; use strict; use warnings; +use Test::More; + BEGIN { if (!eval { require Socket }) { - print "1..0 # no Socket\n"; exit 0; + plan skip_all => "no Socket"; + } + elsif (ord('A') == 193 && !eval { require Convert::EBCDIC }) { + plan skip_all => "EBCDIC but no Convert::EBCDIC"; } - if (ord('A') == 193 && !eval { require Convert::EBCDIC }) { - print "1..0 # EBCDIC but no Convert::EBCDIC\n"; exit 0; + else { + plan tests => 12; } + $INC{'IO/Socket.pm'} = 1; $INC{'IO/Select.pm'} = 1; $INC{'IO/Socket/INET.pm'} = 1; } -(my $libnet_t = __FILE__) =~ s/time.t/libnet_t.pl/; -require $libnet_t; - -print "1..12\n"; # cannot use(), otherwise it will use IO::Socket and IO::Select eval{ require Net::Time; }; ok( !$@, 'should be able to require() Net::Time safely' ); From f13aff0b00dfd502e029ebad1504081f69c59952 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Tue, 17 Nov 2020 13:58:40 +0000 Subject: [PATCH 218/503] dromedary no longer has a public_html directory The old users.perl5.git.perl.org machine has been offline for some time. A replacement exists at dromedary.p5h.org, but this does not provide per-user public_html directories for sharing files. --- Porting/release_managers_guide.pod | 9 --------- 1 file changed, 9 deletions(-) diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index ecc6055a9931..b4ed57602c70 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -166,10 +166,6 @@ pre-release testing, and you may wish to upload to PAUSE via URL. Make sure you have a way of sharing files, such as a web server or file-sharing service. -Porters have access to the "dromedary" server (users.perl5.git.perl.org), -which has a F directory to share files with. -(L) - If you use Dropbox, you can append "raw=1" as a parameter to their usual sharing link to allow direct download (albeit with redirects). @@ -1176,11 +1172,6 @@ eliminate anxious gnashing of teeth while you wait to see if your 15 megabyte HTTP upload successfully completes across your slow, twitchy cable modem. -You can make use of your home directory on dromedary for -this purpose: F maps to -F, where F is your login account -on dromedary. - I: if your upload is partially successful, you may need to contact a PAUSE administrator or even bump the version of perl. From ea207adc168e11e6382e913b19daa8cdebad4acb Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Tue, 17 Nov 2020 16:43:29 +0000 Subject: [PATCH 219/503] Simplify the release management instructions Getting access to GitHub issues and commit privileges takes one action, not two, so merge the separate sections. --- Porting/release_managers_guide.pod | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index b4ed57602c70..5c71a65a2664 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -141,23 +141,17 @@ Andreas' email address at: https://pause.perl.org/pause/query?ACTION=pause_04imprint -=head3 GitHub issue management access - -Make sure you have permission to close tickets on L -so you can respond to bug reports as necessary during your stint. If you -don't, make a GitHub account (if you don't have one) and contact the pumpking -with your username to get ticket-closing permission. - -=head3 git checkout and commit bit +=head3 GitHub access You will need a working C installation, checkout of the perl git repository and perl commit bit. For information about working with perl and git, see F. If you are not yet a perl committer, you won't be able to make a -release. Have a chat with whichever evil perl porter tried to talk -you into the idea in the first place to figure out the best way to -resolve the issue. +release. You will need to have a GitHub account (if you don't have one) +and contact the pumpking with your username to get membership of the L<< +Perl-Release-Managers|https://github.com/orgs/Perl/teams/perl-release-managers +>> team. =head3 web-based file share From 1ed58cc998a11cf41deb35675b6434ec027aa5cf Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Wed, 2 Dec 2020 20:01:58 +0000 Subject: [PATCH 220/503] Combine the two separate smoke test sections --- Porting/release_managers_guide.pod | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/Porting/release_managers_guide.pod b/Porting/release_managers_guide.pod index 5c71a65a2664..c9f729f4eb76 100644 --- a/Porting/release_managers_guide.pod +++ b/Porting/release_managers_guide.pod @@ -364,6 +364,10 @@ the raw reports. Similarly, monitor the smoking of perl for compiler warnings, and try to fix. +Additionally both L and +L smokers run +automatically. + =for checklist skip BLEAD-POINT =head3 monitor CPAN testers for failures @@ -378,14 +382,6 @@ colon-delimited versions to use for comparison. For example: L -=head3 Monitor Continuous Integration smokers - -Currently both "Travis CI" and "GitHub Actions" smokers are setup. -Their current status is available at: - -L -L - =head3 update perldelta Get perldelta in a mostly finished state. From d0f6d176ac4a00ba4b5f98ed79b4163f302a9a1e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 10 Dec 2020 16:09:31 -0700 Subject: [PATCH 221/503] perlapi: Add markup --- numeric.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/numeric.c b/numeric.c index 52c454711f48..349048cdcbe8 100644 --- a/numeric.c +++ b/numeric.c @@ -994,7 +994,7 @@ C is non-C, but no actual assignment (or SEGV) will occur. C will be set with C if trailing decimals were seen (in which case C<*valuep> gives the true value truncated to an integer), and C if the number is negative (in which case C<*valuep> holds the -absolute value). C is not set if e notation was used or the +absolute value). C is not set if C notation was used or the number is larger than a UV. C allows only C, which allows for trailing From a83cff23716a9cfd29d7aa4f1bee292d6c3eec48 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 11 Dec 2020 14:59:28 -0700 Subject: [PATCH 222/503] locale.c: Work around a z/OS limitation/feature Without per-thread locales, a multi-thread application is inherently unsafe. IBM solves that by allowing you to set up the locale any way you want, but after you've created a thread, all future locale changes are ignored, and return failure. But Perl itself changes the locale in a couple of cases. Recent changes have surfaced this issue in one case, leading to a panic. And this commit works around it, so that messages will be displayed in the locale in effect before the threads were created. The remaining case requires further investigation. Nothing in our suite is failing. --- locale.c | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/locale.c b/locale.c index bee9c2e3f7df..ed3cb66767d0 100644 --- a/locale.c +++ b/locale.c @@ -5371,7 +5371,19 @@ Perl_my_strerror(pTHX_ const int errnum) /* The setlocale() just below likely will zap 'save_locale', so * create a copy. */ save_locale = savepv(save_locale); - do_setlocale_c(LC_MESSAGES, "C"); + if (! do_setlocale_c(LC_MESSAGES, "C")) { + + /* If, for some reason, the locale change failed, we + * soldier on as best as possible under the circumstances, + * using the current locale, and clear save_locale, so we + * don't try to change back. On z/0S, all setlocale() + * calls fail after you've created a thread. This is their + * way of making sure the entire process is always a single + * locale. This means that 'use locale' is always in place + * for messages under these circumstances. */ + Safefree(save_locale); + save_locale = NULL; + } } } } /* end of ! within_locale_scope */ From f976811211b19d3e1f072386ee414913ba94287f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 10 Dec 2020 08:58:53 -0700 Subject: [PATCH 223/503] dist/threads/t/libc.t: Add timer to avoid deadlock This test file can deadlock if there are bugs. Add a timeout to keep the test from hanging indefinitely. --- dist/threads/t/libc.t | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/dist/threads/t/libc.t b/dist/threads/t/libc.t index 4f6f6ed3ae19..65958949f6cf 100644 --- a/dist/threads/t/libc.t +++ b/dist/threads/t/libc.t @@ -9,6 +9,12 @@ BEGIN { skip_all(q/Perl not compiled with 'useithreads'/); } + my $time_out_factor = $ENV{PERL_TEST_TIME_OUT_FACTOR} || 1; + $time_out_factor = 1 if $time_out_factor < 1; + + # Guard against bugs that result in deadlock + watchdog(1 * 60 * $time_out_factor); + plan(11); } From 2cca577c06f55cb5263727c6fd6b02fe37c36c96 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 10 Dec 2020 11:07:15 -0700 Subject: [PATCH 224/503] PERL_WRITE_UNLOCK: add missing condition signal The mutex is locked, and any contenders are awaiting a signal, which until this commit was missing. --- thread.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/thread.h b/thread.h index 96430b95e247..b34af6570734 100644 --- a/thread.h +++ b/thread.h @@ -317,7 +317,11 @@ /* Here, the mutex is locked, with no readers */ \ } STMT_END -# define PERL_WRITE_UNLOCK(mutex) MUTEX_UNLOCK(mutex.lock) +# define PERL_WRITE_UNLOCK(mutex) \ + STMT_START { \ + COND_SIGNAL(mutex.readers_now_zero); \ + MUTEX_UNLOCK(mutex.lock); \ + } STMT_END # define PERL_RW_MUTEX_INIT(mutex) \ STMT_START { \ From 0b83dfe6dd9b0bda197566adec923f16b9a693cd Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 10 Dec 2020 10:11:34 -0700 Subject: [PATCH 225/503] many-reader mutexes: Change structure element name The old name did not encompass all the possible reasons for the mutex signal condition to be invoked --- perl.h | 2 +- thread.h | 10 +++++----- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/perl.h b/perl.h index a839ef967aae..d5cbf48dd5f9 100644 --- a/perl.h +++ b/perl.h @@ -3344,7 +3344,7 @@ typedef pthread_key_t perl_key; /* Many readers; single writer */ typedef struct { perl_mutex lock; - perl_cond zero_readers; + perl_cond wakeup; Size_t readers_count; } perl_RnW1_mutex_t; diff --git a/thread.h b/thread.h index b34af6570734..14fc1c5ac2af 100644 --- a/thread.h +++ b/thread.h @@ -298,7 +298,7 @@ MUTEX_LOCK(mutex.lock); \ (mutex)->readers_count--; \ if ((mutex)->readers_count <= 0) { \ - COND_SIGNAL(mutex.zero_readers); \ + COND_SIGNAL(mutex.wakeup); \ (mutex)->readers_count = 0; \ } \ MUTEX_UNLOCK(mutex.lock); \ @@ -310,7 +310,7 @@ do { \ if ((mutex)->readers_count == 0) \ break; \ - COND_WAIT(mutex.zero_readers, mutex.lock); \ + COND_WAIT(mutex.wakeup, mutex.lock); \ } \ while (1); \ \ @@ -319,20 +319,20 @@ # define PERL_WRITE_UNLOCK(mutex) \ STMT_START { \ - COND_SIGNAL(mutex.readers_now_zero); \ + COND_SIGNAL(mutex.wakeup); \ MUTEX_UNLOCK(mutex.lock); \ } STMT_END # define PERL_RW_MUTEX_INIT(mutex) \ STMT_START { \ MUTEX_INIT(mutex.lock); \ - COND_INIT(mutex.zero_readers); \ + COND_INIT(mutex.wakeup); \ (mutex)->readers_count = 0; \ } STMT_END # define PERL_RW_MUTEX_DESTROY(mutex) \ STMT_START { \ - COND_DESTROY(mutex.zero_readers); \ + COND_DESTROY(mutex.wakeup); \ MUTEX_DESTROY(mutex.lock); \ } STMT_END From c69669e6b6b6b3465e3305f37e45064632c82fac Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 16:47:53 -0600 Subject: [PATCH 226/503] Consolidate and document all get_cvFOO() variants --- perl.c | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/perl.c b/perl.c index 3c97ed5f0473..6c3ed0d55575 100644 --- a/perl.c +++ b/perl.c @@ -2831,17 +2831,24 @@ Perl_get_hv(pTHX_ const char *name, I32 flags) /* =for apidoc_section $CV -=for apidoc get_cvn_flags +=for apidoc get_cv +=for apidoc_item |CV *|get_cvs|"string"|I32 flags +=for apidoc_item get_cvn_flags -Returns the CV of the specified Perl subroutine. C are passed to +These return the CV of the specified Perl subroutine. C are passed to C. If C is set and the Perl subroutine does not exist then it will be declared (which has the same effect as saying -C). If C is not set and the subroutine does not exist +C). If C is not set and the subroutine does not exist, then NULL is returned. -=for apidoc get_cv +The forms differ only in how the subroutine is specified.. With C, +the name is a literal C string, enclosed in double quotes. With C, the +name is given by the C parameter, which must be a NUL-terminated C +string. With C, the name is also given by the C +parameter, but it is a Perl string (possibly containing embedded NUL bytes), +and its length in bytes is contained in the C parameter. -Uses C to get the length of C, then calls C. +=for apidoc Amnh||GV_ADD =cut */ From 26d1d7c7534e64e87310befc9919ef4779943bd6 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Sep 2020 10:21:49 -0600 Subject: [PATCH 227/503] Document and consolidate SvPV..force functions --- sv.h | 59 +++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 45 insertions(+), 14 deletions(-) diff --git a/sv.h b/sv.h index 16ecc60660f4..26e156e66767 100644 --- a/sv.h +++ b/sv.h @@ -1542,9 +1542,23 @@ attention to precisely which outputs are influenced by which inputs. /* =for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len -Like C but will force the SV into containing a string (C), and -only a string (C), by hook or by crook. You need force if you are -going to update the C directly. Processes get magic. +=for apidoc_item ||SvPV_force_nolen|SV* sv +=for apidoc_item ||SvPVx_force|SV* sv|STRLEN len +=for apidoc_item ||SvPV_force_nomg|SV* sv|STRLEN len +=for apidoc_item ||SvPV_force_nomg_nolen|SV * sv +=for apidoc_item ||SvPV_force_mutable|SV * sv|STRLEN len +=for apidoc_item ||SvPV_force_flags|SV * sv|STRLEN len|U32 flags +=for apidoc_item ||SvPV_force_flags_nolen|SV * sv|U32 flags +=for apidoc_item ||SvPV_force_flags_mutable|SV * sv|STRLEN len|U32 flags +=for apidoc_item ||SvPVbyte_force +=for apidoc_item ||SvPVbytex_force +=for apidoc_item ||SvPVutf8_force +=for apidoc_item ||SvPVutf8x_force + +These are like C> but will force the SV into containing a string +(C>), and only a string (C>), by hook or by crook. +You need to use one of these C routines if you are going to update the +C> directly. Note that coercing an arbitrary scalar into a plain PV will potentially strip useful data from it. For example if the SV was C, then the @@ -1552,8 +1566,34 @@ referent will have its reference count decremented, and the SV itself may be converted to an C scalar with a string buffer containing a value such as C<"ARRAY(0x1234)">. -=for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len -Like C, but doesn't process get magic. +The differences between the forms are: + +The forms with C in their names allow you to use the C parameter +to specify to perform 'get' magic (by setting the C flag) or to skip +'get' magic (by clearing it). The other forms do perform 'get' magic, except +for the ones with C in their names, which skip 'get' magic. + +The forms with C in their names do not return the length of the string. +They should be used only when it is known that the PV is a C string, terminated by +a NUL byte, and without intermediate NUL characters; or when you don't care +about its length. + +The forms with C in their names are effectively the same as those without, +but the name emphasizes that the string is modifiable by the caller, which it is +in all the forms. + +C is like C, but converts C to UTF-8 first if +not already UTF-8. + +C is like C, but guarantees to evaluate C +only once; use the more efficient C otherwise. + +C is like C, but converts C to byte +representation first if currently encoded as UTF-8. If the SV cannot be +downgraded from UTF-8, this croaks. + +C is like C, but guarantees to evaluate C +only once; use the more efficient C otherwise. =for apidoc Am|char*|SvPV|SV* sv|STRLEN len Returns a pointer to the string in the SV, or a stringified form of @@ -1698,21 +1738,12 @@ Like C, but does not process get magic. Like C, but converts C to byte representation first if necessary. If the SV cannot be downgraded from UTF-8, this croaks. -=for apidoc Am|char*|SvPVutf8x_force|SV* sv|STRLEN len -Like C, but converts C to UTF-8 first if necessary. -Guarantees to evaluate C only once; use the more efficient C -otherwise. =for apidoc Am|char*|SvPVutf8x|SV* sv|STRLEN len Like C, but converts C to UTF-8 first if necessary. Guarantees to evaluate C only once; use the more efficient C otherwise. -=for apidoc Am|char*|SvPVbytex_force|SV* sv|STRLEN len -Like C, but converts C to byte representation first if necessary. -Guarantees to evaluate C only once; use the more efficient C -otherwise. If the SV cannot be downgraded from UTF-8, this croaks. - =for apidoc Am|char*|SvPVbytex|SV* sv|STRLEN len Like C, but converts C to byte representation first if necessary. Guarantees to evaluate C only once; use the more efficient C From 6d4aa2db71082fa30ad6f269b608524d426dd731 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Sep 2020 10:55:28 -0600 Subject: [PATCH 228/503] perlapi: Remove duplicate text This came about in a rebasing error --- sv.h | 3 --- 1 file changed, 3 deletions(-) diff --git a/sv.h b/sv.h index 26e156e66767..246f6121fb7b 100644 --- a/sv.h +++ b/sv.h @@ -1696,9 +1696,6 @@ C is like C>, but C is assumed to be non-null (NN). If there is a possibility that it is NULL, use plain C. -C is like C, but C is assumed to be non-null (NN). If -there is a possibility that it is NULL, use plain C. - =for apidoc Am|char*|SvPVutf8_force|SV* sv|STRLEN len Like C, but converts C to UTF-8 first if necessary. From eb6cdcc1bc6ec3836d18f0a4f068a835934eb6e4 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 07:47:02 -0600 Subject: [PATCH 229/503] perl.h: White-space only Properly indent some nested #defines --- perl.h | 100 ++++++++++++++++++++++++++++----------------------------- 1 file changed, 50 insertions(+), 50 deletions(-) diff --git a/perl.h b/perl.h index d5cbf48dd5f9..76b6e72e19b5 100644 --- a/perl.h +++ b/perl.h @@ -31,11 +31,11 @@ /* this is used for functions which take a depth trailing * argument under debugging */ #ifdef DEBUGGING -#define _pDEPTH ,U32 depth -#define _aDEPTH ,depth +# define _pDEPTH ,U32 depth +# define _aDEPTH ,depth #else -#define _pDEPTH -#define _aDEPTH +# define _pDEPTH +# define _aDEPTH #endif /* NOTE 1: that with gcc -std=c89 the __STDC_VERSION__ is *not* defined @@ -197,15 +197,15 @@ Now a no-op. =cut */ -#define CPERLscope(x) x -#define CPERLarg void -#define CPERLarg_ -#define _CPERLarg -#define PERL_OBJECT_THIS -#define _PERL_OBJECT_THIS -#define PERL_OBJECT_THIS_ -#define CALL_FPTR(fptr) (*fptr) -#define MEMBER_TO_FPTR(name) name +# define CPERLscope(x) x +# define CPERLarg void +# define CPERLarg_ +# define _CPERLarg +# define PERL_OBJECT_THIS +# define _PERL_OBJECT_THIS +# define PERL_OBJECT_THIS_ +# define CALL_FPTR(fptr) (*fptr) +# define MEMBER_TO_FPTR(name) name #endif /* !PERL_CORE */ #define CALLRUNOPS PL_runops @@ -271,10 +271,10 @@ Now a no-op. RX_ENGINE(rx)->qr_package(aTHX_ (rx)) #if defined(USE_ITHREADS) -#define CALLREGDUPE(prog,param) \ +# define CALLREGDUPE(prog,param) \ Perl_re_dup(aTHX_ (prog),(param)) -#define CALLREGDUPE_PVT(prog,param) \ +# define CALLREGDUPE_PVT(prog,param) \ (prog ? RX_ENGINE(prog)->dupe(aTHX_ (prog),(param)) \ : (REGEXP *)NULL) #endif @@ -299,42 +299,42 @@ Now a no-op. */ #ifndef PERL_MICRO -#if defined __GNUC__ && !defined(__INTEL_COMPILER) -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ -# define HASATTRIBUTE_DEPRECATED -# endif -# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ -# define HASATTRIBUTE_FORMAT -# if defined __MINGW32__ -# define PRINTF_FORMAT_NULL_OK +# if defined __GNUC__ && !defined(__INTEL_COMPILER) +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 1 || __GNUC__ > 3 /* 3.1 -> */ +# define HASATTRIBUTE_DEPRECATED +# endif +# if __GNUC__ >= 3 /* 3.0 -> */ /* XXX Verify this version */ +# define HASATTRIBUTE_FORMAT +# if defined __MINGW32__ +# define PRINTF_FORMAT_NULL_OK +# endif +# endif +# if __GNUC__ >= 3 /* 3.0 -> */ +# define HASATTRIBUTE_MALLOC +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ +# define HASATTRIBUTE_NONNULL +# endif +# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ +# define HASATTRIBUTE_NORETURN +# endif +# if __GNUC__ >= 3 /* gcc 3.0 -> */ +# define HASATTRIBUTE_PURE +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ +# define HASATTRIBUTE_UNUSED +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) +# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ +# endif +# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ +# define HASATTRIBUTE_WARN_UNUSED_RESULT +# endif + /* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ +# if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */ +# define HASATTRIBUTE_ALWAYS_INLINE # endif # endif -# if __GNUC__ >= 3 /* 3.0 -> */ -# define HASATTRIBUTE_MALLOC -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 3 || __GNUC__ > 3 /* 3.3 -> */ -# define HASATTRIBUTE_NONNULL -# endif -# if __GNUC__ == 2 && __GNUC_MINOR__ >= 5 || __GNUC__ > 2 /* 2.5 -> */ -# define HASATTRIBUTE_NORETURN -# endif -# if __GNUC__ >= 3 /* gcc 3.0 -> */ -# define HASATTRIBUTE_PURE -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ -# define HASATTRIBUTE_UNUSED -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ == 3 && !defined(__cplusplus) -# define HASATTRIBUTE_UNUSED /* gcc-3.3, but not g++-3.3. */ -# endif -# if __GNUC__ == 3 && __GNUC_MINOR__ >= 4 || __GNUC__ > 3 /* 3.4 -> */ -# define HASATTRIBUTE_WARN_UNUSED_RESULT -# endif -/* always_inline is buggy in gcc <= 4.6 and causes compilation errors */ -# if __GNUC__ == 4 && __GNUC_MINOR__ >= 7 || __GNUC__ > 4 /* 4.7 -> */ -# define HASATTRIBUTE_ALWAYS_INLINE -# endif -#endif #endif /* #ifndef PERL_MICRO */ #ifdef HASATTRIBUTE_DEPRECATED @@ -531,7 +531,7 @@ __typeof__ and nothing else. #if defined(_MSC_VER) && _MSC_VER < 1400 /* XXX older MSVC versions have a smallish macro buffer */ -#define PERL_SMALL_MACRO_BUFFER +# define PERL_SMALL_MACRO_BUFFER #endif /* on gcc (and clang), specify that a warning should be temporarily From 13d2ab8bbbcb68824b0e53e403df7b9dd3ec55d5 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 14 Dec 2020 15:20:17 +1100 Subject: [PATCH 230/503] build test for the read/write mutex macros This fails to compile --- ext/XS-APItest/APItest.xs | 25 +++++++++++++++++++++++++ thread.h | 2 ++ 2 files changed, 27 insertions(+) diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index 549bf54afd08..acfbe22a5ce9 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -6936,6 +6936,31 @@ Comctl32Version() #endif +MODULE = XS::APItest PACKAGE = XS::APItest::RWMacro + +#if defined(USE_ITHREADS) + +void +compile_macros() + PREINIT: + perl_RnW1_mutex_t m; + perl_RnW1_mutex_t *pm = &m; + CODE: + PERL_RW_MUTEX_INIT(&m); + PERL_WRITE_LOCK(&m); + PERL_WRITE_UNLOCK(&m); + PERL_READ_LOCK(&m); + PERL_READ_UNLOCK(&m); + PERL_RW_MUTEX_DESTROY(&m); + PERL_RW_MUTEX_INIT(pm); + PERL_WRITE_LOCK(pm); + PERL_WRITE_UNLOCK(pm); + PERL_READ_LOCK(pm); + PERL_READ_UNLOCK(pm); + PERL_RW_MUTEX_DESTROY(pm); + +#endif + MODULE = XS::APItest PACKAGE = XS::APItest::HvMacro diff --git a/thread.h b/thread.h index 14fc1c5ac2af..38020715eeb2 100644 --- a/thread.h +++ b/thread.h @@ -472,6 +472,8 @@ # define PERL_READ_UNLOCK NOOP # define PERL_WRITE_LOCK NOOP # define PERL_WRITE_UNLOCK NOOP +# define PERL_RW_MUTEX_INIT NOOP +# define PERL_RW_MUTEX_DESTROY NOOP #endif #ifndef LOCK_DOLLARZERO_MUTEX From 385ff59891f97046e99af32c3718c9d5cea167e6 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 14 Dec 2020 15:54:25 +1100 Subject: [PATCH 231/503] consistently parenthesise the RW lock macro arguments and fix the mixed up pointer vs non-pointer use of the mutex argument. Without the parentheses (or without the new tests in the previous commit) for code like; PERL_WRITE_LOCK(&PL_some_mutex); the MUTEX_LOCK(mutex.lock) in that code would expand to: MUTEX_LOCK(&PL_some_mutex.lock); and happen to work, even though the next line has: if ((mutex)->readers_count) treating the mutex parameter as a pointer. With the parentheses the MUTEX_LOCK(mutex.lock) becomes: MUTEX_LOCK((&PL_some_mutex).lock); which as expected fails to compile in a similar way to the pointer test code in the previous commit. --- thread.h | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/thread.h b/thread.h index 38020715eeb2..4c4966f79df8 100644 --- a/thread.h +++ b/thread.h @@ -288,29 +288,29 @@ # define PERL_READ_LOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(mutex.lock); \ + MUTEX_LOCK(&(mutex)->lock); \ (mutex)->readers_count++; \ - MUTEX_UNLOCK(mutex.lock); \ + MUTEX_UNLOCK(&(mutex)->lock); \ } STMT_END # define PERL_READ_UNLOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(mutex.lock); \ + MUTEX_LOCK(&(mutex)->lock); \ (mutex)->readers_count--; \ if ((mutex)->readers_count <= 0) { \ - COND_SIGNAL(mutex.wakeup); \ + COND_SIGNAL(&(mutex)->wakeup); \ (mutex)->readers_count = 0; \ } \ - MUTEX_UNLOCK(mutex.lock); \ + MUTEX_UNLOCK(&(mutex)->lock); \ } STMT_END # define PERL_WRITE_LOCK(mutex) \ STMT_START { \ - MUTEX_LOCK(mutex.lock); \ + MUTEX_LOCK(&(mutex)->lock); \ do { \ if ((mutex)->readers_count == 0) \ break; \ - COND_WAIT(mutex.wakeup, mutex.lock); \ + COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ } \ while (1); \ \ @@ -319,21 +319,21 @@ # define PERL_WRITE_UNLOCK(mutex) \ STMT_START { \ - COND_SIGNAL(mutex.wakeup); \ - MUTEX_UNLOCK(mutex.lock); \ + COND_SIGNAL(&(mutex)->wakeup); \ + MUTEX_UNLOCK(&(mutex)->lock); \ } STMT_END # define PERL_RW_MUTEX_INIT(mutex) \ STMT_START { \ - MUTEX_INIT(mutex.lock); \ - COND_INIT(mutex.wakeup); \ + MUTEX_INIT(&(mutex)->lock); \ + COND_INIT(&(mutex)->wakeup); \ (mutex)->readers_count = 0; \ } STMT_END # define PERL_RW_MUTEX_DESTROY(mutex) \ STMT_START { \ - COND_DESTROY(mutex.wakeup); \ - MUTEX_DESTROY(mutex.lock); \ + COND_DESTROY(&(mutex)->wakeup); \ + MUTEX_DESTROY(&(mutex)->lock); \ } STMT_END #endif From 7d3dc46a32cd59eedc4b0f4aa00147ad35a398ef Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 14 Dec 2020 16:00:33 +1100 Subject: [PATCH 232/503] bump $XS::APItest::VERSION --- ext/XS-APItest/APItest.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index fc4745044597..eda042ec0e8f 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '1.13'; +our $VERSION = '1.14'; require XSLoader; From 85065dd94bd5057e997fdff30a5d56f7d6debbd2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Dec 2020 13:41:07 -0700 Subject: [PATCH 233/503] perlapi: 'ie' should be 'i.e.', and italicized --- sv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sv.c b/sv.c index 4d89ce0aa923..18d9e0436b8c 100644 --- a/sv.c +++ b/sv.c @@ -181,7 +181,7 @@ perl_destruct() to physically free all the arenas allocated since the start of the interpreter. The internal function visit() scans the SV arenas list, and calls a specified -function for each SV it finds which is still live - ie which has an SvTYPE +function for each SV it finds which is still live, I which has an SvTYPE other than all 1's, and a non-zero SvREFCNT. visit() is used by the following functions (specified as [function that calls visit()] / [function called by visit() for each SV]): From 63e6c959cbcdff0d21149b7cae1671836367cc00 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Dec 2020 13:29:19 -0700 Subject: [PATCH 234/503] podcheck.t: perldoc standard indent is 4. Before, it was using an expected nroff indent of 7. But current perldoc places the =head1 lines at the left margin, and the text within them indented by 4. --- t/porting/known_pod_issues.dat | 151 +++++---------------------------- t/porting/podcheck.t | 3 +- 2 files changed, 24 insertions(+), 130 deletions(-) diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 89664ad769a7..5783359268c3 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -369,157 +369,50 @@ XML::LibXML YAML YAML::Syck YAML::Tiny -dist/attribute-handlers/lib/attribute/handlers.pm Verbatim line length including indents exceeds 78 by 2 -dist/base/lib/fields.pm Verbatim line length including indents exceeds 78 by 1 -dist/constant/lib/constant.pm Verbatim line length including indents exceeds 78 by 1 -dist/data-dumper/changes Verbatim line length including indents exceeds 78 by 2 +dist/data-dumper/changes Verbatim line length including indents exceeds 78 by 1 dist/data-dumper/dumper.pm ? Should you be using L<...> instead of 1 -dist/data-dumper/dumper.pm Verbatim line length including indents exceeds 78 by 3 -dist/devel-ppport/devel/buildperl.pl Verbatim line length including indents exceeds 78 by 1 -dist/devel-ppport/hackers Verbatim line length including indents exceeds 78 by 2 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =dontwarn 1 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =implementation 1 dist/devel-ppport/parts/inc/ppphdoc Unknown directive: =provides 1 -dist/encoding-warnings/lib/encoding/warnings.pm Verbatim line length including indents exceeds 78 by 1 dist/env/lib/env.pm ? Should you be using F<...> or maybe L<...> instead of 1 -dist/exporter/lib/exporter.pm Verbatim line length including indents exceeds 78 by 7 -dist/extutils-parsexs/lib/perlxstut.pod Verbatim line length including indents exceeds 78 by 3 -dist/extutils-parsexs/lib/perlxstypemap.pod Verbatim line length including indents exceeds 78 by 2 -dist/i18n-langtags/lib/i18n/langtags.pm Verbatim line length including indents exceeds 78 by 1 -dist/io/io.pm Verbatim line length including indents exceeds 78 by 1 -dist/io/lib/io/socket/inet.pm Verbatim line length including indents exceeds 78 by 2 -dist/module-corelist/blib/script/corelist Verbatim line length including indents exceeds 78 by 1 -dist/module-corelist/lib/module/corelist.pod Verbatim line length including indents exceeds 78 by 2 +dist/exporter/lib/exporter.pm Verbatim line length including indents exceeds 78 by 1 dist/net-ping/lib/net/ping.pm Apparent broken link 2 -dist/pathtools/lib/file/spec/mac.pm Verbatim line length including indents exceeds 78 by 4 -dist/pathtools/lib/file/spec/vms.pm Verbatim line length including indents exceeds 78 by 1 -dist/pathtools/lib/file/spec/win32.pm Verbatim line length including indents exceeds 78 by 1 -dist/term-readline/lib/term/readline.pm Verbatim line length including indents exceeds 78 by 2 -dist/test/lib/test.pm Verbatim line length including indents exceeds 78 by 2 -dist/thread-queue/lib/thread/queue.pm Verbatim line length including indents exceeds 78 by 2 -dist/thread-semaphore/lib/thread/semaphore.pm Verbatim line length including indents exceeds 78 by 1 -dist/threads-shared/lib/threads/shared.pm Verbatim line length including indents exceeds 78 by 1 -dist/tie-file/lib/tie/file.pm Verbatim line length including indents exceeds 78 by 1 -dist/unicode-normalize/normalize.pm Verbatim line length including indents exceeds 78 by 1 ext/amiga-exec/exec.pm Verbatim line length including indents exceeds 78 by 1 -ext/b/b.pm Verbatim line length including indents exceeds 78 by 1 -ext/b/b/concise.pm Verbatim line length including indents exceeds 78 by 1 ext/dynaloader/dynaloader.pm Verbatim line length including indents exceeds 78 by 1 -ext/file-find/lib/file/find.pm Verbatim line length including indents exceeds 78 by 1 -ext/hash-util-fieldhash/lib/hash/util/fieldhash.pm Verbatim line length including indents exceeds 78 by 1 -ext/hash-util/lib/hash/util.pm Verbatim line length including indents exceeds 78 by 3 -ext/opcode/opcode.pm Verbatim line length including indents exceeds 78 by 1 -ext/pod-html/testdir/perlpodspec-copy.pod Verbatim line length including indents exceeds 78 by 8 +ext/hash-util/lib/hash/util.pm Verbatim line length including indents exceeds 78 by 2 ext/pod-html/testdir/perlvar-copy.pod ? Should you be using L<...> instead of 3 -ext/pod-html/testdir/perlvar-copy.pod Verbatim line length including indents exceeds 78 by 7 -ext/posix/lib/posix.pod Verbatim line length including indents exceeds 78 by 5 -ext/re/re.pm Verbatim line length including indents exceeds 78 by 1 -ext/sdbm_file/sdbm_file.pm Verbatim line length including indents exceeds 78 by 1 +ext/pod-html/testdir/perlvar-copy.pod Verbatim line length including indents exceeds 78 by 5 ext/vms-filespec/lib/vms/filespec.pm Verbatim line length including indents exceeds 78 by 1 install ? Should you be using F<...> or maybe L<...> instead of 1 -install Verbatim line length including indents exceeds 78 by 9 -installhtml Verbatim line length including indents exceeds 78 by 3 -os2/os2/os2-process/process.pm Verbatim line length including indents exceeds 78 by 8 -os2/os2/os2-rexx/dll/dll.pm Verbatim line length including indents exceeds 78 by 1 -os2/os2/os2-rexx/rexx.pm Verbatim line length including indents exceeds 78 by 1 -pod/perl.pod Verbatim line length including indents exceeds 78 by 8 -pod/perlaix.pod Verbatim line length including indents exceeds 78 by 12 -pod/perlandroid.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlapi.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlapio.pod Verbatim line length including indents exceeds 78 by 5 +pod/perl.pod Verbatim line length including indents exceeds 78 by 5 +pod/perlandroid.pod Verbatim line length including indents exceeds 78 by 3 pod/perlbook.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlcall.pod Verbatim line length including indents exceeds 78 by 2 -pod/perlclib.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlcygwin.pod Verbatim line length including indents exceeds 78 by 8 -pod/perldata.pod Verbatim line length including indents exceeds 78 by 4 -pod/perldebguts.pod Verbatim line length including indents exceeds 78 by 47 -pod/perldebtut.pod Verbatim line length including indents exceeds 78 by 20 -pod/perldebug.pod Verbatim line length including indents exceeds 78 by 4 -pod/perldiag.pod Verbatim line length including indents exceeds 78 by 6 -pod/perldsc.pod Verbatim line length including indents exceeds 78 by 2 -pod/perldtrace.pod Verbatim line length including indents exceeds 78 by 25 -pod/perlebcdic.pod Verbatim line length including indents exceeds 78 by 31 -pod/perlembed.pod Verbatim line length including indents exceeds 78 by 2 -pod/perlfork.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlfunc.pod Verbatim line length including indents exceeds 78 by 156 +pod/perldebguts.pod Verbatim line length including indents exceeds 78 by 24 +pod/perldebtut.pod Verbatim line length including indents exceeds 78 by 2 +pod/perldtrace.pod Verbatim line length including indents exceeds 78 by 7 pod/perlgit.pod ? Should you be using F<...> or maybe L<...> instead of 1 -pod/perlgit.pod Verbatim line length including indents exceeds 78 by 9 -pod/perlgpl.pod Verbatim line length including indents exceeds 78 by 19 +pod/perlgit.pod Verbatim line length including indents exceeds 78 by 1 pod/perlguts.pod ? Should you be using L<...> instead of 1 -pod/perlguts.pod Verbatim line length including indents exceeds 78 by 10 pod/perlhack.pod ? Should you be using L<...> instead of 1 -pod/perlhack.pod Verbatim line length including indents exceeds 78 by 2 -pod/perlhacktips.pod Verbatim line length including indents exceeds 78 by 2 -pod/perlhacktut.pod Verbatim line length including indents exceeds 78 by 5 -pod/perlhist.pod Verbatim line length including indents exceeds 78 by 3 -pod/perlhpux.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlhurd.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlhack.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlhist.pod Verbatim line length including indents exceeds 78 by 1 pod/perlinterp.pod ? Should you be using L<...> instead of 1 -pod/perlintro.pod Verbatim line length including indents exceeds 78 by 2 -pod/perliol.pod Verbatim line length including indents exceeds 78 by 2 -pod/perlipc.pod Verbatim line length including indents exceeds 78 by 10 -pod/perlirix.pod Verbatim line length including indents exceeds 78 by 2 -pod/perllocale.pod Verbatim line length including indents exceeds 78 by 1 -pod/perllol.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlmacosx.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlmod.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlmodlib.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlirix.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlmacosx.pod Verbatim line length including indents exceeds 78 by 3 pod/perlmroapi.pod ? Should you be using L<...> instead of 1 -pod/perlobj.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlop.pod Verbatim line length including indents exceeds 78 by 18 -pod/perlopentut.pod Verbatim line length including indents exceeds 78 by 1 pod/perlos2.pod ? Should you be using L<...> instead of 2 -pod/perlos2.pod Verbatim line length including indents exceeds 78 by 11 -pod/perlos390.pod Verbatim line length including indents exceeds 78 by 6 -pod/perlpacktut.pod Verbatim line length including indents exceeds 78 by 3 -pod/perlperf.pod Verbatim line length including indents exceeds 78 by 139 -pod/perlpodspec.pod Verbatim line length including indents exceeds 78 by 8 +pod/perlos2.pod Verbatim line length including indents exceeds 78 by 5 +pod/perlos390.pod Verbatim line length including indents exceeds 78 by 2 +pod/perlperf.pod Verbatim line length including indents exceeds 78 by 113 pod/perlport.pod ? Should you be using L<...> instead of 1 -pod/perlport.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlqnx.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlre.pod Verbatim line length including indents exceeds 78 by 7 -pod/perlreapi.pod Verbatim line length including indents exceeds 78 by 3 -pod/perlrebackslash.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlrecharclass.pod Verbatim line length including indents exceeds 78 by 12 -pod/perlref.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlreftut.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlreguts.pod Verbatim line length including indents exceeds 78 by 10 -pod/perlreref.pod Verbatim line length including indents exceeds 78 by 6 -pod/perlretut.pod Verbatim line length including indents exceeds 78 by 9 -pod/perlrun.pod Verbatim line length including indents exceeds 78 by 10 -pod/perlsec.pod Verbatim line length including indents exceeds 78 by 1 +pod/perlrun.pod Verbatim line length including indents exceeds 78 by 3 pod/perlsolaris.pod Verbatim line length including indents exceeds 78 by 13 -pod/perlstyle.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlsub.pod Verbatim line length including indents exceeds 78 by 8 -pod/perlsynology.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlthrtut.pod Verbatim line length including indents exceeds 78 by 2 -pod/perltie.pod Verbatim line length including indents exceeds 78 by 7 +pod/perltie.pod Verbatim line length including indents exceeds 78 by 3 pod/perltru64.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlunicode.pod Verbatim line length including indents exceeds 78 by 4 -pod/perlunifaq.pod Verbatim line length including indents exceeds 78 by 1 -pod/perluniintro.pod Verbatim line length including indents exceeds 78 by 5 -pod/perlvar.pod Verbatim line length including indents exceeds 78 by 1 -pod/perlwin32.pod Verbatim line length including indents exceeds 78 by 8 -porting/bench.pl Verbatim line length including indents exceeds 78 by 2 -porting/bisect-runner.pl Verbatim line length including indents exceeds 78 by 2 -porting/epigraphs.pod Verbatim line length including indents exceeds 78 by 51 -porting/pumpkin.pod Verbatim line length including indents exceeds 78 by 3 -porting/release_managers_guide.pod Verbatim line length including indents exceeds 78 by 6 +pod/perlwin32.pod Verbatim line length including indents exceeds 78 by 7 +porting/epigraphs.pod Verbatim line length including indents exceeds 78 by 28 +porting/release_managers_guide.pod Verbatim line length including indents exceeds 78 by 2 porting/todo.pod ? Should you be using F<...> or maybe L<...> instead of 1 -porting/todo.pod Verbatim line length including indents exceeds 78 by 2 -lib/b/op_private.pm Verbatim line length including indents exceeds 78 by 1 lib/benchmark.pm Verbatim line length including indents exceeds 78 by 2 -lib/charnames.pm Verbatim line length including indents exceeds 78 by 2 -lib/class/struct.pm Verbatim line length including indents exceeds 78 by 3 lib/config.pod ? Should you be using L<...> instead of -1 -lib/db.pm Verbatim line length including indents exceeds 78 by 2 -lib/overload.pm Verbatim line length including indents exceeds 78 by 1 lib/perl5db.pl ? Should you be using L<...> instead of 1 -lib/perlio.pm Verbatim line length including indents exceeds 78 by 1 -lib/strict.pm Verbatim line length including indents exceeds 78 by 1 -lib/tie/array.pm Verbatim line length including indents exceeds 78 by 1 -lib/tie/hash.pm Verbatim line length including indents exceeds 78 by 1 -lib/unicode/ucd.pm Verbatim line length including indents exceeds 78 by 17 -lib/utf8.pm Verbatim line length including indents exceeds 78 by 1 -lib/vmsish.pm Verbatim line length including indents exceeds 78 by 1 -lib/warnings.pm Verbatim line length including indents exceeds 78 by 2 diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index 94c56e8822ad..c7fa9f1db88b 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -360,7 +360,8 @@ my $MANIFEST = File::Spec->catfile(File::Spec->updir($original_dir), 'MANIFEST') my $copy_fh; my $MAX_LINE_LENGTH = 78; # 78 columns -my $INDENT = 7; # default nroff indent +my $INDENT = 4; # Things besides =head lines are indented at this + #least much # Our warning messages. Better not have [('"] in them, as those are used as # delimiters for variable parts of the messages by poderror. From 61246ce353b8779923b2b5a5597bb153c85d32c9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Dec 2020 13:33:37 -0700 Subject: [PATCH 235/503] podcheck.t: Combine duplicated code into a sub --- t/porting/podcheck.t | 23 ++++++++++------------- 1 file changed, 10 insertions(+), 13 deletions(-) diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index c7fa9f1db88b..ca19def72a65 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -896,7 +896,7 @@ package My::Pod::Checker { # Extend Pod::Checker return $self->SUPER::start_Para(@_); } - sub start_item_text { + sub start_item { my $self = shift; check_see_but_not_link($self); @@ -905,6 +905,13 @@ package My::Pod::Checker { # Extend Pod::Checker $running_CFL_text{$addr} = ""; $running_simple_text{$addr} = ""; + } + + sub start_item_text { + my $self = shift; + start_item($self); + my $addr = Scalar::Util::refaddr $self; + # This is the only =item that is linkable $linkable_item{$addr} = 1; @@ -913,24 +920,14 @@ package My::Pod::Checker { # Extend Pod::Checker sub start_item_number { my $self = shift; - check_see_but_not_link($self); - - my $addr = Scalar::Util::refaddr $self; - $start_line{$addr} = $_[0]->{start_line}; - $running_CFL_text{$addr} = ""; - $running_simple_text{$addr} = ""; + start_item($self); return $self->SUPER::start_item_number(@_); } sub start_item_bullet { my $self = shift; - check_see_but_not_link($self); - - my $addr = Scalar::Util::refaddr $self; - $start_line{$addr} = $_[0]->{start_line}; - $running_CFL_text{$addr} = ""; - $running_simple_text{$addr} = ""; + start_item($self); return $self->SUPER::start_item_bullet(@_); } From 3dc8ec40daa70758f9b0792b114a252232931588 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Dec 2020 13:38:47 -0700 Subject: [PATCH 236/503] autodoc.pl: Adjust max permissible line length perldoc takes up 4 column indent, not 7. --- autodoc.pl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/autodoc.pl b/autodoc.pl index 06361b8f25dd..a9f6f6bf67d4 100644 --- a/autodoc.pl +++ b/autodoc.pl @@ -66,9 +66,9 @@ use strict; use warnings; -# 80 column terminal - 2 for pager adding 2 columns; -7 for nroff -# indent; -my $max_width = 80 - 2 - 7; +# 80 column terminal - 2 for pager adding 2 columns; -4 for indent for +# non-heading lines; +my $max_width = 80 - 2 - 4; if (@ARGV) { my $workdir = shift; From 319bede27572e6eaea4d41a9896fe0d554a98a06 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Tue, 15 Dec 2020 11:38:30 -0500 Subject: [PATCH 237/503] t/lib/croak/toke: Correct test label The RT ticket number cited in the test's label is wrong. The body of the commit message for commit 7259f4194f3131957240f6b3dba47b74f53ac660 shows the correct RT number. Provide GH number as well. --- t/lib/croak/toke | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/lib/croak/toke b/t/lib/croak/toke index 0d20acbd590f..2a660b6f9dc5 100644 --- a/t/lib/croak/toke +++ b/t/lib/croak/toke @@ -503,7 +503,7 @@ EXPECT syntax error at - line 4, next token ??? Execution of - aborted due to compilation errors. ######## -# NAME [perl #134045] incomplete hex number +# NAME [perl #134125] [gh #17010] incomplete hex number 0x x 2; 0xx 2; 0x_; From 1cd5f0d5fa70621757c327e1f6ff04bcb220e0a1 Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Thu, 17 Dec 2020 21:02:46 +0100 Subject: [PATCH 238/503] Correctly set LC_CTYPE back in POSIX/t/time.t --- ext/POSIX/t/time.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ext/POSIX/t/time.t b/ext/POSIX/t/time.t index b19ed70ad3cf..5e71d27f66b9 100644 --- a/ext/POSIX/t/time.t +++ b/ext/POSIX/t/time.t @@ -86,7 +86,7 @@ if (locales_enabled('LC_TIME')) { setlocale(LC_TIME, $orig_time_loc) || die "Cannot setlocale(LC_TIME) back to orig: $!"; } if (locales_enabled('LC_CTYPE')) { - setlocale(LC_TIME, $orig_ctype_loc) || die "Cannot setlocale(LC_CTYPE) back to orig: $!"; + setlocale(LC_CTYPE, $orig_ctype_loc) || die "Cannot setlocale(LC_CTYPE) back to orig: $!"; } # clock() seems to have different definitions of what it does between POSIX From 50c2de5ac1a90ceff3b7f893a822818dd20dd63e Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Fri, 18 Dec 2020 10:12:49 +0100 Subject: [PATCH 239/503] Update Text::Balanced from 2.03 to 2.04 No entry in Perldelta because that will be generated automatically --- MANIFEST | 5 + Porting/Maintainers.pl | 2 +- cpan/Text-Balanced/lib/Text/Balanced.pm | 2196 ++++++++++++----------- cpan/Text-Balanced/t/01_compile.t | 7 +- cpan/Text-Balanced/t/02_extbrk.t | 64 +- cpan/Text-Balanced/t/03_extcbk.t | 66 +- cpan/Text-Balanced/t/04_extdel.t | 60 +- cpan/Text-Balanced/t/05_extmul.t | 198 +- cpan/Text-Balanced/t/06_extqlk.t | 102 +- cpan/Text-Balanced/t/07_exttag.t | 118 +- cpan/Text-Balanced/t/08_extvar.t | 62 +- cpan/Text-Balanced/t/09_gentag.t | 119 +- cpan/Text-Balanced/t/94_changes.t | 48 + cpan/Text-Balanced/t/95_critic.t | 48 + cpan/Text-Balanced/t/96_pmv.t | 32 + cpan/Text-Balanced/t/97_pod.t | 32 + cpan/Text-Balanced/t/98_pod_coverage.t | 51 + 17 files changed, 1797 insertions(+), 1413 deletions(-) create mode 100644 cpan/Text-Balanced/t/94_changes.t create mode 100644 cpan/Text-Balanced/t/95_critic.t create mode 100644 cpan/Text-Balanced/t/96_pmv.t create mode 100644 cpan/Text-Balanced/t/97_pod.t create mode 100644 cpan/Text-Balanced/t/98_pod_coverage.t diff --git a/MANIFEST b/MANIFEST index 6ac7ad47eee2..c79545e01019 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2581,6 +2581,11 @@ cpan/Text-Balanced/t/06_extqlk.t See if Text::Balanced works cpan/Text-Balanced/t/07_exttag.t See if Text::Balanced works cpan/Text-Balanced/t/08_extvar.t See if Text::Balanced works cpan/Text-Balanced/t/09_gentag.t See if Text::Balanced works +cpan/Text-Balanced/t/94_changes.t +cpan/Text-Balanced/t/95_critic.t +cpan/Text-Balanced/t/96_pmv.t +cpan/Text-Balanced/t/97_pod.t +cpan/Text-Balanced/t/98_pod_coverage.t cpan/Text-ParseWords/lib/Text/ParseWords.pm Perl module to split words on arbitrary delimiter cpan/Text-ParseWords/t/ParseWords.t See if Text::ParseWords works cpan/Text-ParseWords/t/taint.t See if Text::ParseWords works with tainting diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 74b930b8ea3b..dc608efb5db3 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1109,7 +1109,7 @@ package Maintainers; }, 'Text::Balanced' => { - 'DISTRIBUTION' => 'SHAY/Text-Balanced-2.03.tar.gz', + 'DISTRIBUTION' => 'SHAY/Text-Balanced-2.04.tar.gz', 'FILES' => q[cpan/Text-Balanced], 'EXCLUDED' => [ qw( t/97_meta.t diff --git a/cpan/Text-Balanced/lib/Text/Balanced.pm b/cpan/Text-Balanced/lib/Text/Balanced.pm index f1a5780a0b9e..324a023f3855 100644 --- a/cpan/Text-Balanced/lib/Text/Balanced.pm +++ b/cpan/Text-Balanced/lib/Text/Balanced.pm @@ -1,35 +1,44 @@ +# Copyright (C) 1997-2001 Damian Conway. All rights reserved. +# Copyright (C) 2009 Adam Kennedy. +# Copyright (C) 2015 Steve Hay. All rights reserved. + +# This module is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU General +# Public License or the Artistic License, as specified in the F file. + package Text::Balanced; # EXTRACT VARIOUSLY DELIMITED TEXT SEQUENCES FROM STRINGS. # FOR FULL DOCUMENTATION SEE Balanced.pod -use 5.005; +use 5.008001; use strict; use Exporter (); -use SelfLoader; use vars qw { $VERSION @ISA %EXPORT_TAGS }; BEGIN { - $VERSION = '2.03'; - @ISA = 'Exporter'; - %EXPORT_TAGS = ( - ALL => [ qw{ - &extract_delimited - &extract_bracketed - &extract_quotelike - &extract_codeblock - &extract_variable - &extract_tagged - &extract_multiple - &gen_delimited_pat - &gen_extract_tagged - &delimited_pat - } ], - ); + $VERSION = '2.04'; + @ISA = 'Exporter'; + %EXPORT_TAGS = ( + ALL => [ qw{ + &extract_delimited + &extract_bracketed + &extract_quotelike + &extract_codeblock + &extract_variable + &extract_tagged + &extract_multiple + &gen_delimited_pat + &gen_extract_tagged + &delimited_pat + } ], + ); } Exporter::export_ok_tags('ALL'); +## no critic (Subroutines::ProhibitSubroutinePrototypes) + # PROTOTYPES sub _match_bracketed($$$$$$); @@ -40,80 +49,80 @@ sub _match_quotelike($$$$); # HANDLE RETURN VALUES IN VARIOUS CONTEXTS sub _failmsg { - my ($message, $pos) = @_; - $@ = bless { - error => $message, - pos => $pos, - }, 'Text::Balanced::ErrorMsg'; + my ($message, $pos) = @_; + $@ = bless { + error => $message, + pos => $pos, + }, 'Text::Balanced::ErrorMsg'; } sub _fail { - my ($wantarray, $textref, $message, $pos) = @_; - _failmsg $message, $pos if $message; - return (undef, $$textref, undef) if $wantarray; - return undef; + my ($wantarray, $textref, $message, $pos) = @_; + _failmsg $message, $pos if $message; + return (undef, $$textref, undef) if $wantarray; + return; } sub _succeed { - $@ = undef; - my ($wantarray,$textref) = splice @_, 0, 2; - my ($extrapos, $extralen) = @_ > 18 - ? splice(@_, -2, 2) - : (0, 0); - my ($startlen, $oppos) = @_[5,6]; - my $remainderpos = $_[2]; - if ( $wantarray ) { - my @res; - while (my ($from, $len) = splice @_, 0, 2) { - push @res, substr($$textref, $from, $len); - } - if ( $extralen ) { # CORRECT FILLET - my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n"); - $res[1] = "$extra$res[1]"; - eval { substr($$textref,$remainderpos,0) = $extra; - substr($$textref,$extrapos,$extralen,"\n")} ; - #REARRANGE HERE DOC AND FILLET IF POSSIBLE - pos($$textref) = $remainderpos-$extralen+1; # RESET \G - } else { - pos($$textref) = $remainderpos; # RESET \G - } - return @res; - } else { - my $match = substr($$textref,$_[0],$_[1]); - substr($match,$extrapos-$_[0]-$startlen,$extralen,"") if $extralen; - my $extra = $extralen - ? substr($$textref, $extrapos, $extralen)."\n" : ""; - eval {substr($$textref,$_[4],$_[1]+$_[5])=$extra} ; #CHOP OUT PREFIX & MATCH, IF POSSIBLE - pos($$textref) = $_[4]; # RESET \G - return $match; - } + $@ = undef; + my ($wantarray,$textref) = splice @_, 0, 2; + my ($extrapos, $extralen) = @_ > 18 + ? splice(@_, -2, 2) + : (0, 0); + my ($startlen, $oppos) = @_[5,6]; + my $remainderpos = $_[2]; + if ( $wantarray ) { + my @res; + while (my ($from, $len) = splice @_, 0, 2) { + push @res, substr($$textref, $from, $len); + } + if ( $extralen ) { # CORRECT FILLET + my $extra = substr($res[0], $extrapos-$oppos, $extralen, "\n"); + $res[1] = "$extra$res[1]"; + eval { substr($$textref,$remainderpos,0) = $extra; + substr($$textref,$extrapos,$extralen,"\n")} ; + #REARRANGE HERE DOC AND FILLET IF POSSIBLE + pos($$textref) = $remainderpos-$extralen+1; # RESET \G + } else { + pos($$textref) = $remainderpos; # RESET \G + } + return @res; + } else { + my $match = substr($$textref,$_[0],$_[1]); + substr($match,$extrapos-$_[0]-$startlen,$extralen,"") if $extralen; + my $extra = $extralen + ? substr($$textref, $extrapos, $extralen)."\n" : ""; + eval {substr($$textref,$_[4],$_[1]+$_[5])=$extra} ; #CHOP OUT PREFIX & MATCH, IF POSSIBLE + pos($$textref) = $_[4]; # RESET \G + return $match; + } } # BUILD A PATTERN MATCHING A SIMPLE DELIMITED STRING sub gen_delimited_pat($;$) # ($delimiters;$escapes) { - my ($dels, $escs) = @_; - return "" unless $dels =~ /\S/; - $escs = '\\' unless $escs; - $escs .= substr($escs,-1) x (length($dels)-length($escs)); - my @pat = (); - my $i; - for ($i=0; $i\0-\377/[[(({{</) - { - return _fail $wantarray, $textref, - "Did not find a suitable bracket in delimiter: \"$_[1]\"", - 0; - } - my $posbug = pos; - $ldel = join('|', map { quotemeta $_ } split('', $ldel)); - $rdel = join('|', map { quotemeta $_ } split('', $rdel)); - pos = $posbug; - - my $startpos = pos $$textref || 0; - my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel); - - return _fail ($wantarray, $textref) unless @match; - - return _succeed ( $wantarray, $textref, - $match[2], $match[5]+2, # MATCH - @match[8,9], # REMAINDER - @match[0,1], # PREFIX - ); + my $textref = defined $_[0] ? \$_[0] : \$_; + my $ldel = defined $_[1] ? $_[1] : '{([<'; + my $pre = defined $_[2] ? $_[2] : '\s*'; + my $wantarray = wantarray; + my $qdel = ""; + my $quotelike; + $ldel =~ s/'//g and $qdel .= q{'}; + $ldel =~ s/"//g and $qdel .= q{"}; + $ldel =~ s/`//g and $qdel .= q{`}; + $ldel =~ s/q//g and $quotelike = 1; + $ldel =~ tr/[](){}<>\0-\377/[[(({{</) + { + return _fail $wantarray, $textref, + "Did not find a suitable bracket in delimiter: \"$_[1]\"", + 0; + } + my $posbug = pos; + $ldel = join('|', map { quotemeta $_ } split('', $ldel)); + $rdel = join('|', map { quotemeta $_ } split('', $rdel)); + pos = $posbug; + + my $startpos = pos $$textref || 0; + my @match = _match_bracketed($textref,$pre, $ldel, $qdel, $quotelike, $rdel); + + return _fail ($wantarray, $textref) unless @match; + + return _succeed ( $wantarray, $textref, + $match[2], $match[5]+2, # MATCH + @match[8,9], # REMAINDER + @match[0,1], # PREFIX + ); } -sub _match_bracketed($$$$$$) # $textref, $pre, $ldel, $qdel, $quotelike, $rdel +sub _match_bracketed($$$$$$) # $textref, $pre, $ldel, $qdel, $quotelike, $rdel { - my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_; - my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0); - unless ($$textref =~ m/\G$pre/gc) - { - _failmsg "Did not find prefix: /$pre/", $startpos; - return; - } - - $ldelpos = pos $$textref; - - unless ($$textref =~ m/\G($ldel)/gc) - { - _failmsg "Did not find opening bracket after prefix: \"$pre\"", - pos $$textref; - pos $$textref = $startpos; - return; - } - - my @nesting = ( $1 ); - my $textlen = length $$textref; - while (pos $$textref < $textlen) - { - next if $$textref =~ m/\G\\./gcs; - - if ($$textref =~ m/\G($ldel)/gc) - { - push @nesting, $1; - } - elsif ($$textref =~ m/\G($rdel)/gc) - { - my ($found, $brackettype) = ($1, $1); - if ($#nesting < 0) - { - _failmsg "Unmatched closing bracket: \"$found\"", - pos $$textref; - pos $$textref = $startpos; - return; - } - my $expected = pop(@nesting); - $expected =~ tr/({[/; - if ($expected ne $brackettype) - { - _failmsg qq{Mismatched closing bracket: expected "$expected" but found "$found"}, - pos $$textref; - pos $$textref = $startpos; - return; - } - last if $#nesting < 0; - } - elsif ($qdel && $$textref =~ m/\G([$qdel])/gc) - { - $$textref =~ m/\G[^\\$1]*(?:\\.[^\\$1]*)*(\Q$1\E)/gsc and next; - _failmsg "Unmatched embedded quote ($1)", - pos $$textref; - pos $$textref = $startpos; - return; - } - elsif ($quotelike && _match_quotelike($textref,"",1,0)) - { - next; - } - - else { $$textref =~ m/\G(?:[a-zA-Z0-9]+|.)/gcs } - } - if ($#nesting>=0) - { - _failmsg "Unmatched opening bracket(s): " - . join("..",@nesting)."..", - pos $$textref; - pos $$textref = $startpos; - return; - } - - $endpos = pos $$textref; - - return ( - $startpos, $ldelpos-$startpos, # PREFIX - $ldelpos, 1, # OPENING BRACKET - $ldelpos+1, $endpos-$ldelpos-2, # CONTENTS - $endpos-1, 1, # CLOSING BRACKET - $endpos, length($$textref)-$endpos, # REMAINDER - ); + my ($textref, $pre, $ldel, $qdel, $quotelike, $rdel) = @_; + my ($startpos, $ldelpos, $endpos) = (pos $$textref = pos $$textref||0); + unless ($$textref =~ m/\G$pre/gc) + { + _failmsg "Did not find prefix: /$pre/", $startpos; + return; + } + + $ldelpos = pos $$textref; + + unless ($$textref =~ m/\G($ldel)/gc) + { + _failmsg "Did not find opening bracket after prefix: \"$pre\"", + pos $$textref; + pos $$textref = $startpos; + return; + } + + my @nesting = ( $1 ); + my $textlen = length $$textref; + while (pos $$textref < $textlen) + { + next if $$textref =~ m/\G\\./gcs; + + if ($$textref =~ m/\G($ldel)/gc) + { + push @nesting, $1; + } + elsif ($$textref =~ m/\G($rdel)/gc) + { + my ($found, $brackettype) = ($1, $1); + if ($#nesting < 0) + { + _failmsg "Unmatched closing bracket: \"$found\"", + pos $$textref; + pos $$textref = $startpos; + return; + } + my $expected = pop(@nesting); + $expected =~ tr/({[/; + if ($expected ne $brackettype) + { + _failmsg qq{Mismatched closing bracket: expected "$expected" but found "$found"}, + pos $$textref; + pos $$textref = $startpos; + return; + } + last if $#nesting < 0; + } + elsif ($qdel && $$textref =~ m/\G([$qdel])/gc) + { + $$textref =~ m/\G[^\\$1]*(?:\\.[^\\$1]*)*(\Q$1\E)/gsc and next; + _failmsg "Unmatched embedded quote ($1)", + pos $$textref; + pos $$textref = $startpos; + return; + } + elsif ($quotelike && _match_quotelike($textref,"",1,0)) + { + next; + } + + else { $$textref =~ m/\G(?:[a-zA-Z0-9]+|.)/gcs } + } + if ($#nesting>=0) + { + _failmsg "Unmatched opening bracket(s): " + . join("..",@nesting)."..", + pos $$textref; + pos $$textref = $startpos; + return; + } + + $endpos = pos $$textref; + + return ( + $startpos, $ldelpos-$startpos, # PREFIX + $ldelpos, 1, # OPENING BRACKET + $ldelpos+1, $endpos-$ldelpos-2, # CONTENTS + $endpos-1, 1, # CLOSING BRACKET + $endpos, length($$textref)-$endpos, # REMAINDER + ); } sub _revbracket($) { - my $brack = reverse $_[0]; - $brack =~ tr/[({/; - return $brack; + my $brack = reverse $_[0]; + $brack =~ tr/[({/; + return $brack; } my $XMLNAME = q{[a-zA-Z_:][a-zA-Z0-9_:.-]*}; sub extract_tagged (;$$$$$) # ($text, $opentag, $closetag, $pre, \%options) { - my $textref = defined $_[0] ? \$_[0] : \$_; - my $ldel = $_[1]; - my $rdel = $_[2]; - my $pre = defined $_[3] ? $_[3] : '\s*'; - my %options = defined $_[4] ? %{$_[4]} : (); - my $omode = defined $options{fail} ? $options{fail} : ''; - my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) - : defined($options{reject}) ? $options{reject} - : '' - ; - my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) - : defined($options{ignore}) ? $options{ignore} - : '' - ; - - if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } - $@ = undef; - - my @match = _match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); - - return _fail(wantarray, $textref) unless @match; - return _succeed wantarray, $textref, - $match[2], $match[3]+$match[5]+$match[7], # MATCH - @match[8..9,0..1,2..7]; # REM, PRE, BITS + my $textref = defined $_[0] ? \$_[0] : \$_; + my $ldel = $_[1]; + my $rdel = $_[2]; + my $pre = defined $_[3] ? $_[3] : '\s*'; + my %options = defined $_[4] ? %{$_[4]} : (); + my $omode = defined $options{fail} ? $options{fail} : ''; + my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) + : defined($options{reject}) ? $options{reject} + : '' + ; + my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) + : defined($options{ignore}) ? $options{ignore} + : '' + ; + + if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } + $@ = undef; + + my @match = _match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); + + return _fail(wantarray, $textref) unless @match; + return _succeed wantarray, $textref, + $match[2], $match[3]+$match[5]+$match[7], # MATCH + @match[8..9,0..1,2..7]; # REM, PRE, BITS } -sub _match_tagged # ($$$$$$$) +sub _match_tagged # ($$$$$$$) { - my ($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore) = @_; - my $rdelspec; - - my ($startpos, $opentagpos, $textpos, $parapos, $closetagpos, $endpos) = ( pos($$textref) = pos($$textref)||0 ); - - unless ($$textref =~ m/\G($pre)/gc) - { - _failmsg "Did not find prefix: /$pre/", pos $$textref; - goto failed; - } - - $opentagpos = pos($$textref); - - unless ($$textref =~ m/\G$ldel/gc) - { - _failmsg "Did not find opening tag: /$ldel/", pos $$textref; - goto failed; - } - - $textpos = pos($$textref); - - if (!defined $rdel) - { - $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]); - unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes) - { - _failmsg "Unable to construct closing tag to match: $rdel", - pos $$textref; - goto failed; - } - } - else - { - $rdelspec = eval "qq{$rdel}" || do { - my $del; - for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',) - { next if $rdel =~ /\Q$_/; $del = $_; last } - unless ($del) { - use Carp; - croak "Can't interpolate right delimiter $rdel" - } - eval "qq$del$rdel$del"; - }; - } - - while (pos($$textref) < length($$textref)) - { - next if $$textref =~ m/\G\\./gc; - - if ($$textref =~ m/\G(\n[ \t]*\n)/gc ) - { - $parapos = pos($$textref) - length($1) - unless defined $parapos; - } - elsif ($$textref =~ m/\G($rdelspec)/gc ) - { - $closetagpos = pos($$textref)-length($1); - goto matched; - } - elsif ($ignore && $$textref =~ m/\G(?:$ignore)/gc) - { - next; - } - elsif ($bad && $$textref =~ m/\G($bad)/gcs) - { - pos($$textref) -= length($1); # CUT OFF WHATEVER CAUSED THE SHORTNESS - goto short if ($omode eq 'PARA' || $omode eq 'MAX'); - _failmsg "Found invalid nested tag: $1", pos $$textref; - goto failed; - } - elsif ($$textref =~ m/\G($ldel)/gc) - { - my $tag = $1; - pos($$textref) -= length($tag); # REWIND TO NESTED TAG - unless (_match_tagged(@_)) # MATCH NESTED TAG - { - goto short if $omode eq 'PARA' || $omode eq 'MAX'; - _failmsg "Found unbalanced nested tag: $tag", - pos $$textref; - goto failed; - } - } - else { $$textref =~ m/./gcs } - } + my ($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore) = @_; + my $rdelspec; + + my ($startpos, $opentagpos, $textpos, $parapos, $closetagpos, $endpos) = ( pos($$textref) = pos($$textref)||0 ); + + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg "Did not find prefix: /$pre/", pos $$textref; + goto failed; + } + + $opentagpos = pos($$textref); + + unless ($$textref =~ m/\G$ldel/gc) + { + _failmsg "Did not find opening tag: /$ldel/", pos $$textref; + goto failed; + } + + $textpos = pos($$textref); + + if (!defined $rdel) + { + $rdelspec = substr($$textref, $-[0], $+[0] - $-[0]); + unless ($rdelspec =~ s/\A([[(<{]+)($XMLNAME).*/ quotemeta "$1\/$2". _revbracket($1) /oes) + { + _failmsg "Unable to construct closing tag to match: $rdel", + pos $$textref; + goto failed; + } + } + else + { + ## no critic (BuiltinFunctions::ProhibitStringyEval) + $rdelspec = eval "qq{$rdel}" || do { + my $del; + for (qw,~ ! ^ & * ) _ + - = } ] : " ; ' > . ? / | ',) + { next if $rdel =~ /\Q$_/; $del = $_; last } + unless ($del) { + use Carp; + croak "Can't interpolate right delimiter $rdel" + } + eval "qq$del$rdel$del"; + }; + } + + while (pos($$textref) < length($$textref)) + { + next if $$textref =~ m/\G\\./gc; + + if ($$textref =~ m/\G(\n[ \t]*\n)/gc ) + { + $parapos = pos($$textref) - length($1) + unless defined $parapos; + } + elsif ($$textref =~ m/\G($rdelspec)/gc ) + { + $closetagpos = pos($$textref)-length($1); + goto matched; + } + elsif ($ignore && $$textref =~ m/\G(?:$ignore)/gc) + { + next; + } + elsif ($bad && $$textref =~ m/\G($bad)/gcs) + { + pos($$textref) -= length($1); # CUT OFF WHATEVER CAUSED THE SHORTNESS + goto short if ($omode eq 'PARA' || $omode eq 'MAX'); + _failmsg "Found invalid nested tag: $1", pos $$textref; + goto failed; + } + elsif ($$textref =~ m/\G($ldel)/gc) + { + my $tag = $1; + pos($$textref) -= length($tag); # REWIND TO NESTED TAG + unless (_match_tagged(@_)) # MATCH NESTED TAG + { + goto short if $omode eq 'PARA' || $omode eq 'MAX'; + _failmsg "Found unbalanced nested tag: $tag", + pos $$textref; + goto failed; + } + } + else { $$textref =~ m/./gcs } + } short: - $closetagpos = pos($$textref); - goto matched if $omode eq 'MAX'; - goto failed unless $omode eq 'PARA'; - - if (defined $parapos) { pos($$textref) = $parapos } - else { $parapos = pos($$textref) } - - return ( - $startpos, $opentagpos-$startpos, # PREFIX - $opentagpos, $textpos-$opentagpos, # OPENING TAG - $textpos, $parapos-$textpos, # TEXT - $parapos, 0, # NO CLOSING TAG - $parapos, length($$textref)-$parapos, # REMAINDER - ); - + $closetagpos = pos($$textref); + goto matched if $omode eq 'MAX'; + goto failed unless $omode eq 'PARA'; + + if (defined $parapos) { pos($$textref) = $parapos } + else { $parapos = pos($$textref) } + + return ( + $startpos, $opentagpos-$startpos, # PREFIX + $opentagpos, $textpos-$opentagpos, # OPENING TAG + $textpos, $parapos-$textpos, # TEXT + $parapos, 0, # NO CLOSING TAG + $parapos, length($$textref)-$parapos, # REMAINDER + ); + matched: - $endpos = pos($$textref); - return ( - $startpos, $opentagpos-$startpos, # PREFIX - $opentagpos, $textpos-$opentagpos, # OPENING TAG - $textpos, $closetagpos-$textpos, # TEXT - $closetagpos, $endpos-$closetagpos, # CLOSING TAG - $endpos, length($$textref)-$endpos, # REMAINDER - ); + $endpos = pos($$textref); + return ( + $startpos, $opentagpos-$startpos, # PREFIX + $opentagpos, $textpos-$opentagpos, # OPENING TAG + $textpos, $closetagpos-$textpos, # TEXT + $closetagpos, $endpos-$closetagpos, # CLOSING TAG + $endpos, length($$textref)-$endpos, # REMAINDER + ); failed: - _failmsg "Did not find closing tag", pos $$textref unless $@; - pos($$textref) = $startpos; - return; + _failmsg "Did not find closing tag", pos $$textref unless $@; + pos($$textref) = $startpos; + return; } sub extract_variable (;$$) { - my $textref = defined $_[0] ? \$_[0] : \$_; - return ("","","") unless defined $$textref; - my $pre = defined $_[1] ? $_[1] : '\s*'; + my $textref = defined $_[0] ? \$_[0] : \$_; + return ("","","") unless defined $$textref; + my $pre = defined $_[1] ? $_[1] : '\s*'; - my @match = _match_variable($textref,$pre); + my @match = _match_variable($textref,$pre); - return _fail wantarray, $textref unless @match; + return _fail wantarray, $textref unless @match; - return _succeed wantarray, $textref, - @match[2..3,4..5,0..1]; # MATCH, REMAINDER, PREFIX + return _succeed wantarray, $textref, + @match[2..3,4..5,0..1]; # MATCH, REMAINDER, PREFIX } sub _match_variable($$) @@ -438,582 +448,581 @@ sub _match_variable($$) # $# # $^ # $$ - my ($textref, $pre) = @_; - my $startpos = pos($$textref) = pos($$textref)||0; - unless ($$textref =~ m/\G($pre)/gc) - { - _failmsg "Did not find prefix: /$pre/", pos $$textref; - return; - } - my $varpos = pos($$textref); - unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci) - { - unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc) - { - _failmsg "Did not find leading dereferencer", pos $$textref; - pos $$textref = $startpos; - return; - } - my $deref = $1; - - unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci - or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0) - or $deref eq '$#' or $deref eq '$$' ) - { - _failmsg "Bad identifier after dereferencer", pos $$textref; - pos $$textref = $startpos; - return; - } - } - - while (1) - { - next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc; - next if _match_codeblock($textref, - qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/, - qr/[({[]/, qr/[)}\]]/, - qr/[({[]/, qr/[)}\]]/, 0); - next if _match_codeblock($textref, - qr/\s*/, qr/[{[]/, qr/[}\]]/, - qr/[{[]/, qr/[}\]]/, 0); - next if _match_variable($textref,'\s*->\s*'); - next if $$textref =~ m/\G\s*->\s*\w+(?![{([])/gc; - last; - } - - my $endpos = pos($$textref); - return ($startpos, $varpos-$startpos, - $varpos, $endpos-$varpos, - $endpos, length($$textref)-$endpos - ); + my ($textref, $pre) = @_; + my $startpos = pos($$textref) = pos($$textref)||0; + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg "Did not find prefix: /$pre/", pos $$textref; + return; + } + my $varpos = pos($$textref); + unless ($$textref =~ m{\G\$\s*(?!::)(\d+|[][&`'+*./|,";%=~:?!\@<>()-]|\^[a-z]?)}gci) + { + unless ($$textref =~ m/\G((\$#?|[*\@\%]|\\&)+)/gc) + { + _failmsg "Did not find leading dereferencer", pos $$textref; + pos $$textref = $startpos; + return; + } + my $deref = $1; + + unless ($$textref =~ m/\G\s*(?:::|')?(?:[_a-z]\w*(?:::|'))*[_a-z]\w*/gci + or _match_codeblock($textref, "", '\{', '\}', '\{', '\}', 0) + or $deref eq '$#' or $deref eq '$$' ) + { + _failmsg "Bad identifier after dereferencer", pos $$textref; + pos $$textref = $startpos; + return; + } + } + + while (1) + { + next if $$textref =~ m/\G\s*(?:->)?\s*[{]\w+[}]/gc; + next if _match_codeblock($textref, + qr/\s*->\s*(?:[_a-zA-Z]\w+\s*)?/, + qr/[({[]/, qr/[)}\]]/, + qr/[({[]/, qr/[)}\]]/, 0); + next if _match_codeblock($textref, + qr/\s*/, qr/[{[]/, qr/[}\]]/, + qr/[{[]/, qr/[}\]]/, 0); + next if _match_variable($textref,'\s*->\s*'); + next if $$textref =~ m/\G\s*->\s*\w+(?![{([])/gc; + last; + } + + my $endpos = pos($$textref); + return ($startpos, $varpos-$startpos, + $varpos, $endpos-$varpos, + $endpos, length($$textref)-$endpos + ); } sub extract_codeblock (;$$$$$) { - my $textref = defined $_[0] ? \$_[0] : \$_; - my $wantarray = wantarray; - my $ldel_inner = defined $_[1] ? $_[1] : '{'; - my $pre = defined $_[2] ? $_[2] : '\s*'; - my $ldel_outer = defined $_[3] ? $_[3] : $ldel_inner; - my $rd = $_[4]; - my $rdel_inner = $ldel_inner; - my $rdel_outer = $ldel_outer; - my $posbug = pos; - for ($ldel_inner, $ldel_outer) { tr/[]()<>{}\0-\377/[[((<<{{/ds } - for ($rdel_inner, $rdel_outer) { tr/[]()<>{}\0-\377/]]))>>}}/ds } - for ($ldel_inner, $ldel_outer, $rdel_inner, $rdel_outer) - { - $_ = '('.join('|',map { quotemeta $_ } split('',$_)).')' - } - pos = $posbug; - - my @match = _match_codeblock($textref, $pre, - $ldel_outer, $rdel_outer, - $ldel_inner, $rdel_inner, - $rd); - return _fail($wantarray, $textref) unless @match; - return _succeed($wantarray, $textref, - @match[2..3,4..5,0..1] # MATCH, REMAINDER, PREFIX - ); + my $textref = defined $_[0] ? \$_[0] : \$_; + my $wantarray = wantarray; + my $ldel_inner = defined $_[1] ? $_[1] : '{'; + my $pre = defined $_[2] ? $_[2] : '\s*'; + my $ldel_outer = defined $_[3] ? $_[3] : $ldel_inner; + my $rd = $_[4]; + my $rdel_inner = $ldel_inner; + my $rdel_outer = $ldel_outer; + my $posbug = pos; + for ($ldel_inner, $ldel_outer) { tr/[]()<>{}\0-\377/[[((<<{{/ds } + for ($rdel_inner, $rdel_outer) { tr/[]()<>{}\0-\377/]]))>>}}/ds } + for ($ldel_inner, $ldel_outer, $rdel_inner, $rdel_outer) + { + $_ = '('.join('|',map { quotemeta $_ } split('',$_)).')' + } + pos = $posbug; + + my @match = _match_codeblock($textref, $pre, + $ldel_outer, $rdel_outer, + $ldel_inner, $rdel_inner, + $rd); + return _fail($wantarray, $textref) unless @match; + return _succeed($wantarray, $textref, + @match[2..3,4..5,0..1] # MATCH, REMAINDER, PREFIX + ); } sub _match_codeblock($$$$$$$) { - my ($textref, $pre, $ldel_outer, $rdel_outer, $ldel_inner, $rdel_inner, $rd) = @_; - my $startpos = pos($$textref) = pos($$textref) || 0; - unless ($$textref =~ m/\G($pre)/gc) - { - _failmsg qq{Did not match prefix /$pre/ at"} . - substr($$textref,pos($$textref),20) . - q{..."}, - pos $$textref; - return; - } - my $codepos = pos($$textref); - unless ($$textref =~ m/\G($ldel_outer)/gc) # OUTERMOST DELIMITER - { - _failmsg qq{Did not find expected opening bracket at "} . - substr($$textref,pos($$textref),20) . - q{..."}, - pos $$textref; - pos $$textref = $startpos; - return; - } - my $closing = $1; - $closing =~ tr/([<{/)]>}/; - my $matched; - my $patvalid = 1; - while (pos($$textref) < length($$textref)) - { - $matched = ''; - if ($rd && $$textref =~ m#\G(\Q(?)\E|\Q(s?)\E|\Q(s)\E)#gc) - { - $patvalid = 0; - next; - } - - if ($$textref =~ m/\G\s*#.*/gc) - { - next; - } - - if ($$textref =~ m/\G\s*($rdel_outer)/gc) - { - unless ($matched = ($closing && $1 eq $closing) ) - { - next if $1 eq '>'; # MIGHT BE A "LESS THAN" - _failmsg q{Mismatched closing bracket at "} . - substr($$textref,pos($$textref),20) . - qq{...". Expected '$closing'}, - pos $$textref; - } - last; - } - - if (_match_variable($textref,'\s*') || - _match_quotelike($textref,'\s*',$patvalid,$patvalid) ) - { - $patvalid = 0; - next; - } - - - # NEED TO COVER MANY MORE CASES HERE!!! - if ($$textref =~ m#\G\s*(?!$ldel_inner) - ( [-+*x/%^&|.]=? - | [!=]~ - | =(?!>) - | (\*\*|&&|\|\||<<|>>)=? - | split|grep|map|return - | [([] - )#gcx) - { - $patvalid = 1; - next; - } - - if ( _match_codeblock($textref, '\s*', $ldel_inner, $rdel_inner, $ldel_inner, $rdel_inner, $rd) ) - { - $patvalid = 1; - next; - } - - if ($$textref =~ m/\G\s*$ldel_outer/gc) - { - _failmsg q{Improperly nested codeblock at "} . - substr($$textref,pos($$textref),20) . - q{..."}, - pos $$textref; - last; - } - - $patvalid = 0; - $$textref =~ m/\G\s*(\w+|[-=>]>|.|\Z)/gc; - } - continue { $@ = undef } - - unless ($matched) - { - _failmsg 'No match found for opening bracket', pos $$textref - unless $@; - return; - } - - my $endpos = pos($$textref); - return ( $startpos, $codepos-$startpos, - $codepos, $endpos-$codepos, - $endpos, length($$textref)-$endpos, - ); + my ($textref, $pre, $ldel_outer, $rdel_outer, $ldel_inner, $rdel_inner, $rd) = @_; + my $startpos = pos($$textref) = pos($$textref) || 0; + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg qq{Did not match prefix /$pre/ at"} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + return; + } + my $codepos = pos($$textref); + unless ($$textref =~ m/\G($ldel_outer)/gc) # OUTERMOST DELIMITER + { + _failmsg qq{Did not find expected opening bracket at "} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + my $closing = $1; + $closing =~ tr/([<{/)]>}/; + my $matched; + my $patvalid = 1; + while (pos($$textref) < length($$textref)) + { + $matched = ''; + if ($rd && $$textref =~ m#\G(\Q(?)\E|\Q(s?)\E|\Q(s)\E)#gc) + { + $patvalid = 0; + next; + } + + if ($$textref =~ m/\G\s*#.*/gc) + { + next; + } + + if ($$textref =~ m/\G\s*($rdel_outer)/gc) + { + unless ($matched = ($closing && $1 eq $closing) ) + { + next if $1 eq '>'; # MIGHT BE A "LESS THAN" + _failmsg q{Mismatched closing bracket at "} . + substr($$textref,pos($$textref),20) . + qq{...". Expected '$closing'}, + pos $$textref; + } + last; + } + + if (_match_variable($textref,'\s*') || + _match_quotelike($textref,'\s*',$patvalid,$patvalid) ) + { + $patvalid = 0; + next; + } + + + # NEED TO COVER MANY MORE CASES HERE!!! + if ($$textref =~ m#\G\s*(?!$ldel_inner) + ( [-+*x/%^&|.]=? + | [!=]~ + | =(?!>) + | (\*\*|&&|\|\||<<|>>)=? + | split|grep|map|return + | [([] + )#gcx) + { + $patvalid = 1; + next; + } + + if ( _match_codeblock($textref, '\s*', $ldel_inner, $rdel_inner, $ldel_inner, $rdel_inner, $rd) ) + { + $patvalid = 1; + next; + } + + if ($$textref =~ m/\G\s*$ldel_outer/gc) + { + _failmsg q{Improperly nested codeblock at "} . + substr($$textref,pos($$textref),20) . + q{..."}, + pos $$textref; + last; + } + + $patvalid = 0; + $$textref =~ m/\G\s*(\w+|[-=>]>|.|\Z)/gc; + } + continue { $@ = undef } + + unless ($matched) + { + _failmsg 'No match found for opening bracket', pos $$textref + unless $@; + return; + } + + my $endpos = pos($$textref); + return ( $startpos, $codepos-$startpos, + $codepos, $endpos-$codepos, + $endpos, length($$textref)-$endpos, + ); } my %mods = ( - 'none' => '[cgimsox]*', - 'm' => '[cgimsox]*', - 's' => '[cegimsox]*', - 'tr' => '[cds]*', - 'y' => '[cds]*', - 'qq' => '', - 'qx' => '', - 'qw' => '', - 'qr' => '[imsx]*', - 'q' => '', - ); + 'none' => '[cgimsox]*', + 'm' => '[cgimsox]*', + 's' => '[cegimsox]*', + 'tr' => '[cds]*', + 'y' => '[cds]*', + 'qq' => '', + 'qx' => '', + 'qw' => '', + 'qr' => '[imsx]*', + 'q' => '', +); sub extract_quotelike (;$$) { - my $textref = $_[0] ? \$_[0] : \$_; - my $wantarray = wantarray; - my $pre = defined $_[1] ? $_[1] : '\s*'; - - my @match = _match_quotelike($textref,$pre,1,0); - return _fail($wantarray, $textref) unless @match; - return _succeed($wantarray, $textref, - $match[2], $match[18]-$match[2], # MATCH - @match[18,19], # REMAINDER - @match[0,1], # PREFIX - @match[2..17], # THE BITS - @match[20,21], # ANY FILLET? - ); + my $textref = $_[0] ? \$_[0] : \$_; + my $wantarray = wantarray; + my $pre = defined $_[1] ? $_[1] : '\s*'; + + my @match = _match_quotelike($textref,$pre,1,0); + return _fail($wantarray, $textref) unless @match; + return _succeed($wantarray, $textref, + $match[2], $match[18]-$match[2], # MATCH + @match[18,19], # REMAINDER + @match[0,1], # PREFIX + @match[2..17], # THE BITS + @match[20,21], # ANY FILLET? + ); }; -sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) +sub _match_quotelike($$$$) # ($textref, $prepat, $allow_raw_match) { - my ($textref, $pre, $rawmatch, $qmark) = @_; - - my ($textlen,$startpos, - $oppos, - $preld1pos,$ld1pos,$str1pos,$rd1pos, - $preld2pos,$ld2pos,$str2pos,$rd2pos, - $modpos) = ( length($$textref), pos($$textref) = pos($$textref) || 0 ); - - unless ($$textref =~ m/\G($pre)/gc) - { - _failmsg qq{Did not find prefix /$pre/ at "} . - substr($$textref, pos($$textref), 20) . - q{..."}, - pos $$textref; - return; - } - $oppos = pos($$textref); - - my $initial = substr($$textref,$oppos,1); - - if ($initial && $initial =~ m|^[\"\'\`]| - || $rawmatch && $initial =~ m|^/| - || $qmark && $initial =~ m|^\?|) - { - unless ($$textref =~ m/ \Q$initial\E [^\\$initial]* (\\.[^\\$initial]*)* \Q$initial\E /gcsx) - { - _failmsg qq{Did not find closing delimiter to match '$initial' at "} . - substr($$textref, $oppos, 20) . - q{..."}, - pos $$textref; - pos $$textref = $startpos; - return; - } - $modpos= pos($$textref); - $rd1pos = $modpos-1; - - if ($initial eq '/' || $initial eq '?') - { - $$textref =~ m/\G$mods{none}/gc - } - - my $endpos = pos($$textref); - return ( - $startpos, $oppos-$startpos, # PREFIX - $oppos, 0, # NO OPERATOR - $oppos, 1, # LEFT DEL - $oppos+1, $rd1pos-$oppos-1, # STR/PAT - $rd1pos, 1, # RIGHT DEL - $modpos, 0, # NO 2ND LDEL - $modpos, 0, # NO 2ND STR - $modpos, 0, # NO 2ND RDEL - $modpos, $endpos-$modpos, # MODIFIERS - $endpos, $textlen-$endpos, # REMAINDER - ); - } - - unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc) - { - _failmsg q{No quotelike operator found after prefix at "} . - substr($$textref, pos($$textref), 20) . - q{..."}, - pos $$textref; - pos $$textref = $startpos; - return; - } - - my $op = $1; - $preld1pos = pos($$textref); - if ($op eq '<<') { - $ld1pos = pos($$textref); - my $label; - if ($$textref =~ m{\G([A-Za-z_]\w*)}gc) { - $label = $1; - } - elsif ($$textref =~ m{ \G ' ([^'\\]* (?:\\.[^'\\]*)*) ' - | \G " ([^"\\]* (?:\\.[^"\\]*)*) " - | \G ` ([^`\\]* (?:\\.[^`\\]*)*) ` - }gcsx) { - $label = $+; - } - else { - $label = ""; - } - my $extrapos = pos($$textref); - $$textref =~ m{.*\n}gc; - $str1pos = pos($$textref)--; - unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) { - _failmsg qq{Missing here doc terminator ('$label') after "} . - substr($$textref, $startpos, 20) . - q{..."}, - pos $$textref; - pos $$textref = $startpos; - return; - } - $rd1pos = pos($$textref); + my ($textref, $pre, $rawmatch, $qmark) = @_; + + my ($textlen,$startpos, + $oppos, + $preld1pos,$ld1pos,$str1pos,$rd1pos, + $preld2pos,$ld2pos,$str2pos,$rd2pos, + $modpos) = ( length($$textref), pos($$textref) = pos($$textref) || 0 ); + + unless ($$textref =~ m/\G($pre)/gc) + { + _failmsg qq{Did not find prefix /$pre/ at "} . + substr($$textref, pos($$textref), 20) . + q{..."}, + pos $$textref; + return; + } + $oppos = pos($$textref); + + my $initial = substr($$textref,$oppos,1); + + if ($initial && $initial =~ m|^[\"\'\`]| + || $rawmatch && $initial =~ m|^/| + || $qmark && $initial =~ m|^\?|) + { + unless ($$textref =~ m/ \Q$initial\E [^\\$initial]* (\\.[^\\$initial]*)* \Q$initial\E /gcsx) + { + _failmsg qq{Did not find closing delimiter to match '$initial' at "} . + substr($$textref, $oppos, 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + $modpos= pos($$textref); + $rd1pos = $modpos-1; + + if ($initial eq '/' || $initial eq '?') + { + $$textref =~ m/\G$mods{none}/gc + } + + my $endpos = pos($$textref); + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, 0, # NO OPERATOR + $oppos, 1, # LEFT DEL + $oppos+1, $rd1pos-$oppos-1, # STR/PAT + $rd1pos, 1, # RIGHT DEL + $modpos, 0, # NO 2ND LDEL + $modpos, 0, # NO 2ND STR + $modpos, 0, # NO 2ND RDEL + $modpos, $endpos-$modpos, # MODIFIERS + $endpos, $textlen-$endpos, # REMAINDER + ); + } + + unless ($$textref =~ m{\G(\b(?:m|s|qq|qx|qw|q|qr|tr|y)\b(?=\s*\S)|<<)}gc) + { + _failmsg q{No quotelike operator found after prefix at "} . + substr($$textref, pos($$textref), 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + + my $op = $1; + $preld1pos = pos($$textref); + if ($op eq '<<') { + $ld1pos = pos($$textref); + my $label; + if ($$textref =~ m{\G([A-Za-z_]\w*)}gc) { + $label = $1; + } + elsif ($$textref =~ m{ \G ' ([^'\\]* (?:\\.[^'\\]*)*) ' + | \G " ([^"\\]* (?:\\.[^"\\]*)*) " + | \G ` ([^`\\]* (?:\\.[^`\\]*)*) ` + }gcsx) { + $label = $+; + } + else { + $label = ""; + } + my $extrapos = pos($$textref); + $$textref =~ m{.*\n}gc; + $str1pos = pos($$textref)--; + unless ($$textref =~ m{.*?\n(?=\Q$label\E\n)}gc) { + _failmsg qq{Missing here doc terminator ('$label') after "} . + substr($$textref, $startpos, 20) . + q{..."}, + pos $$textref; + pos $$textref = $startpos; + return; + } + $rd1pos = pos($$textref); $$textref =~ m{\Q$label\E\n}gc; - $ld2pos = pos($$textref); - return ( - $startpos, $oppos-$startpos, # PREFIX - $oppos, length($op), # OPERATOR - $ld1pos, $extrapos-$ld1pos, # LEFT DEL - $str1pos, $rd1pos-$str1pos, # STR/PAT - $rd1pos, $ld2pos-$rd1pos, # RIGHT DEL - $ld2pos, 0, # NO 2ND LDEL - $ld2pos, 0, # NO 2ND STR - $ld2pos, 0, # NO 2ND RDEL - $ld2pos, 0, # NO MODIFIERS - $ld2pos, $textlen-$ld2pos, # REMAINDER - $extrapos, $str1pos-$extrapos, # FILLETED BIT - ); - } - - $$textref =~ m/\G\s*/gc; - $ld1pos = pos($$textref); - $str1pos = $ld1pos+1; - - unless ($$textref =~ m/\G(\S)/gc) # SHOULD USE LOOKAHEAD - { - _failmsg "No block delimiter found after quotelike $op", - pos $$textref; - pos $$textref = $startpos; - return; - } - pos($$textref) = $ld1pos; # HAVE TO DO THIS BECAUSE LOOKAHEAD BROKEN - my ($ldel1, $rdel1) = ("\Q$1","\Q$1"); - if ($ldel1 =~ /[[(<{]/) - { - $rdel1 =~ tr/[({/; - defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1)) - || do { pos $$textref = $startpos; return }; + $ld2pos = pos($$textref); + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, length($op), # OPERATOR + $ld1pos, $extrapos-$ld1pos, # LEFT DEL + $str1pos, $rd1pos-$str1pos, # STR/PAT + $rd1pos, $ld2pos-$rd1pos, # RIGHT DEL + $ld2pos, 0, # NO 2ND LDEL + $ld2pos, 0, # NO 2ND STR + $ld2pos, 0, # NO 2ND RDEL + $ld2pos, 0, # NO MODIFIERS + $ld2pos, $textlen-$ld2pos, # REMAINDER + $extrapos, $str1pos-$extrapos, # FILLETED BIT + ); + } + + $$textref =~ m/\G\s*/gc; + $ld1pos = pos($$textref); + $str1pos = $ld1pos+1; + + unless ($$textref =~ m/\G(\S)/gc) # SHOULD USE LOOKAHEAD + { + _failmsg "No block delimiter found after quotelike $op", + pos $$textref; + pos $$textref = $startpos; + return; + } + pos($$textref) = $ld1pos; # HAVE TO DO THIS BECAUSE LOOKAHEAD BROKEN + my ($ldel1, $rdel1) = ("\Q$1","\Q$1"); + if ($ldel1 =~ /[[(<{]/) + { + $rdel1 =~ tr/[({/; + defined(_match_bracketed($textref,"",$ldel1,"","",$rdel1)) + || do { pos $$textref = $startpos; return }; $ld2pos = pos($$textref); $rd1pos = $ld2pos-1; - } - else - { - $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs - || do { pos $$textref = $startpos; return }; + } + else + { + $$textref =~ /\G$ldel1[^\\$ldel1]*(\\.[^\\$ldel1]*)*$ldel1/gcs + || do { pos $$textref = $startpos; return }; $ld2pos = $rd1pos = pos($$textref)-1; - } - - my $second_arg = $op =~ /s|tr|y/ ? 1 : 0; - if ($second_arg) - { - my ($ldel2, $rdel2); - if ($ldel1 =~ /[[(<{]/) - { - unless ($$textref =~ /\G\s*(\S)/gc) # SHOULD USE LOOKAHEAD - { - _failmsg "Missing second block for quotelike $op", - pos $$textref; - pos $$textref = $startpos; - return; - } - $ldel2 = $rdel2 = "\Q$1"; - $rdel2 =~ tr/[({/; - } - else - { - $ldel2 = $rdel2 = $ldel1; - } - $str2pos = $ld2pos+1; - - if ($ldel2 =~ /[[(<{]/) - { - pos($$textref)--; # OVERCOME BROKEN LOOKAHEAD - defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2)) - || do { pos $$textref = $startpos; return }; - } - else - { - $$textref =~ /[^\\$ldel2]*(\\.[^\\$ldel2]*)*$ldel2/gcs - || do { pos $$textref = $startpos; return }; - } - $rd2pos = pos($$textref)-1; - } - else - { - $ld2pos = $str2pos = $rd2pos = $rd1pos; - } - - $modpos = pos $$textref; - - $$textref =~ m/\G($mods{$op})/gc; - my $endpos = pos $$textref; - - return ( - $startpos, $oppos-$startpos, # PREFIX - $oppos, length($op), # OPERATOR - $ld1pos, 1, # LEFT DEL - $str1pos, $rd1pos-$str1pos, # STR/PAT - $rd1pos, 1, # RIGHT DEL - $ld2pos, $second_arg, # 2ND LDEL (MAYBE) - $str2pos, $rd2pos-$str2pos, # 2ND STR (MAYBE) - $rd2pos, $second_arg, # 2ND RDEL (MAYBE) - $modpos, $endpos-$modpos, # MODIFIERS - $endpos, $textlen-$endpos, # REMAINDER - ); + } + + my $second_arg = $op =~ /s|tr|y/ ? 1 : 0; + if ($second_arg) + { + my ($ldel2, $rdel2); + if ($ldel1 =~ /[[(<{]/) + { + unless ($$textref =~ /\G\s*(\S)/gc) # SHOULD USE LOOKAHEAD + { + _failmsg "Missing second block for quotelike $op", + pos $$textref; + pos $$textref = $startpos; + return; + } + $ldel2 = $rdel2 = "\Q$1"; + $rdel2 =~ tr/[({/; + } + else + { + $ldel2 = $rdel2 = $ldel1; + } + $str2pos = $ld2pos+1; + + if ($ldel2 =~ /[[(<{]/) + { + pos($$textref)--; # OVERCOME BROKEN LOOKAHEAD + defined(_match_bracketed($textref,"",$ldel2,"","",$rdel2)) + || do { pos $$textref = $startpos; return }; + } + else + { + $$textref =~ /[^\\$ldel2]*(\\.[^\\$ldel2]*)*$ldel2/gcs + || do { pos $$textref = $startpos; return }; + } + $rd2pos = pos($$textref)-1; + } + else + { + $ld2pos = $str2pos = $rd2pos = $rd1pos; + } + + $modpos = pos $$textref; + + $$textref =~ m/\G($mods{$op})/gc; + my $endpos = pos $$textref; + + return ( + $startpos, $oppos-$startpos, # PREFIX + $oppos, length($op), # OPERATOR + $ld1pos, 1, # LEFT DEL + $str1pos, $rd1pos-$str1pos, # STR/PAT + $rd1pos, 1, # RIGHT DEL + $ld2pos, $second_arg, # 2ND LDEL (MAYBE) + $str2pos, $rd2pos-$str2pos, # 2ND STR (MAYBE) + $rd2pos, $second_arg, # 2ND RDEL (MAYBE) + $modpos, $endpos-$modpos, # MODIFIERS + $endpos, $textlen-$endpos, # REMAINDER + ); } my $def_func = [ - sub { extract_variable($_[0], '') }, - sub { extract_quotelike($_[0],'') }, - sub { extract_codeblock($_[0],'{}','') }, + sub { extract_variable($_[0], '') }, + sub { extract_quotelike($_[0],'') }, + sub { extract_codeblock($_[0],'{}','') }, ]; -sub extract_multiple (;$$$$) # ($text, $functions_ref, $max_fields, $ignoreunknown) +sub extract_multiple (;$$$$) # ($text, $functions_ref, $max_fields, $ignoreunknown) { - my $textref = defined($_[0]) ? \$_[0] : \$_; - my $posbug = pos; - my ($lastpos, $firstpos); - my @fields = (); - - #for ($$textref) - { - my @func = defined $_[1] ? @{$_[1]} : @{$def_func}; - my $max = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000; - my $igunk = $_[3]; - - pos $$textref ||= 0; - - unless (wantarray) - { - use Carp; - carp "extract_multiple reset maximal count to 1 in scalar context" - if $^W && defined($_[2]) && $max > 1; - $max = 1 - } - - my $unkpos; - my $func; - my $class; - - my @class; - foreach $func ( @func ) - { - if (ref($func) eq 'HASH') - { - push @class, (keys %$func)[0]; - $func = (values %$func)[0]; - } - else - { - push @class, undef; - } - } - - FIELD: while (pos($$textref) < length($$textref)) - { - my ($field, $rem); - my @bits; - foreach my $i ( 0..$#func ) - { - my $pref; - $func = $func[$i]; - $class = $class[$i]; - $lastpos = pos $$textref; - if (ref($func) eq 'CODE') - { ($field,$rem,$pref) = @bits = $func->($$textref) } - elsif (ref($func) eq 'Text::Balanced::Extractor') - { @bits = $field = $func->extract($$textref) } - elsif( $$textref =~ m/\G$func/gc ) - { @bits = $field = defined($1) - ? $1 - : substr($$textref, $-[0], $+[0] - $-[0]) + my $textref = defined($_[0]) ? \$_[0] : \$_; + my $posbug = pos; + my ($lastpos, $firstpos); + my @fields = (); + + #for ($$textref) + { + my @func = defined $_[1] ? @{$_[1]} : @{$def_func}; + my $max = defined $_[2] && $_[2]>0 ? $_[2] : 1_000_000_000; + my $igunk = $_[3]; + + pos $$textref ||= 0; + + unless (wantarray) + { + use Carp; + carp "extract_multiple reset maximal count to 1 in scalar context" + if $^W && defined($_[2]) && $max > 1; + $max = 1 + } + + my $unkpos; + my $class; + + my @class; + foreach my $func ( @func ) + { + if (ref($func) eq 'HASH') + { + push @class, (keys %$func)[0]; + $func = (values %$func)[0]; + } + else + { + push @class, undef; + } + } + + FIELD: while (pos($$textref) < length($$textref)) + { + my ($field, $rem); + my @bits; + foreach my $i ( 0..$#func ) + { + my $pref; + my $func = $func[$i]; + $class = $class[$i]; + $lastpos = pos $$textref; + if (ref($func) eq 'CODE') + { ($field,$rem,$pref) = @bits = $func->($$textref) } + elsif (ref($func) eq 'Text::Balanced::Extractor') + { @bits = $field = $func->extract($$textref) } + elsif( $$textref =~ m/\G$func/gc ) + { @bits = $field = defined($1) + ? $1 + : substr($$textref, $-[0], $+[0] - $-[0]) + } + $pref ||= ""; + if (defined($field) && length($field)) + { + if (!$igunk) { + $unkpos = $lastpos + if length($pref) && !defined($unkpos); + if (defined $unkpos) + { + push @fields, substr($$textref, $unkpos, $lastpos-$unkpos).$pref; + $firstpos = $unkpos unless defined $firstpos; + undef $unkpos; + last FIELD if @fields == $max; + } } - $pref ||= ""; - if (defined($field) && length($field)) - { - if (!$igunk) { - $unkpos = $lastpos - if length($pref) && !defined($unkpos); - if (defined $unkpos) - { - push @fields, substr($$textref, $unkpos, $lastpos-$unkpos).$pref; - $firstpos = $unkpos unless defined $firstpos; - undef $unkpos; - last FIELD if @fields == $max; - } - } - push @fields, $class - ? bless (\$field, $class) - : $field; - $firstpos = $lastpos unless defined $firstpos; - $lastpos = pos $$textref; - last FIELD if @fields == $max; - next FIELD; - } - } - if ($$textref =~ /\G(.)/gcs) - { - $unkpos = pos($$textref)-1 - unless $igunk || defined $unkpos; - } - } - - if (defined $unkpos) - { - push @fields, substr($$textref, $unkpos); - $firstpos = $unkpos unless defined $firstpos; - $lastpos = length $$textref; - } - last; - } - - pos $$textref = $lastpos; - return @fields if wantarray; - - $firstpos ||= 0; - eval { substr($$textref,$firstpos,$lastpos-$firstpos)=""; - pos $$textref = $firstpos }; - return $fields[0]; + push @fields, $class + ? bless (\$field, $class) + : $field; + $firstpos = $lastpos unless defined $firstpos; + $lastpos = pos $$textref; + last FIELD if @fields == $max; + next FIELD; + } + } + if ($$textref =~ /\G(.)/gcs) + { + $unkpos = pos($$textref)-1 + unless $igunk || defined $unkpos; + } + } + + if (defined $unkpos) + { + push @fields, substr($$textref, $unkpos); + $firstpos = $unkpos unless defined $firstpos; + $lastpos = length $$textref; + } + last; + } + + pos $$textref = $lastpos; + return @fields if wantarray; + + $firstpos ||= 0; + eval { substr($$textref,$firstpos,$lastpos-$firstpos)=""; + pos $$textref = $firstpos }; + return $fields[0]; } sub gen_extract_tagged # ($opentag, $closetag, $pre, \%options) { - my $ldel = $_[0]; - my $rdel = $_[1]; - my $pre = defined $_[2] ? $_[2] : '\s*'; - my %options = defined $_[3] ? %{$_[3]} : (); - my $omode = defined $options{fail} ? $options{fail} : ''; - my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) - : defined($options{reject}) ? $options{reject} - : '' - ; - my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) - : defined($options{ignore}) ? $options{ignore} - : '' - ; - - if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } - - my $posbug = pos; - for ($ldel, $pre, $bad, $ignore) { $_ = qr/$_/ if $_ } - pos = $posbug; - - my $closure = sub - { - my $textref = defined $_[0] ? \$_[0] : \$_; - my @match = Text::Balanced::_match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); - - return _fail(wantarray, $textref) unless @match; - return _succeed wantarray, $textref, - $match[2], $match[3]+$match[5]+$match[7], # MATCH - @match[8..9,0..1,2..7]; # REM, PRE, BITS - }; - - bless $closure, 'Text::Balanced::Extractor'; + my $ldel = $_[0]; + my $rdel = $_[1]; + my $pre = defined $_[2] ? $_[2] : '\s*'; + my %options = defined $_[3] ? %{$_[3]} : (); + my $omode = defined $options{fail} ? $options{fail} : ''; + my $bad = ref($options{reject}) eq 'ARRAY' ? join('|', @{$options{reject}}) + : defined($options{reject}) ? $options{reject} + : '' + ; + my $ignore = ref($options{ignore}) eq 'ARRAY' ? join('|', @{$options{ignore}}) + : defined($options{ignore}) ? $options{ignore} + : '' + ; + + if (!defined $ldel) { $ldel = '<\w+(?:' . gen_delimited_pat(q{'"}) . '|[^>])*>'; } + + my $posbug = pos; + for ($ldel, $pre, $bad, $ignore) { $_ = qr/$_/ if $_ } + pos = $posbug; + + my $closure = sub + { + my $textref = defined $_[0] ? \$_[0] : \$_; + my @match = Text::Balanced::_match_tagged($textref, $pre, $ldel, $rdel, $omode, $bad, $ignore); + + return _fail(wantarray, $textref) unless @match; + return _succeed wantarray, $textref, + $match[2], $match[3]+$match[5]+$match[7], # MATCH + @match[8..9,0..1,2..7]; # REM, PRE, BITS + }; + + bless $closure, 'Text::Balanced::Extractor'; } package Text::Balanced::Extractor; -sub extract($$) # ($self, $text) +sub extract($$) # ($self, $text) { - &{$_[0]}($_[1]); + &{$_[0]}($_[1]); } package Text::Balanced::ErrorMsg; @@ -1032,83 +1041,76 @@ Text::Balanced - Extract delimited text sequences from strings. =head1 SYNOPSIS - use Text::Balanced qw ( - extract_delimited - extract_bracketed - extract_quotelike - extract_codeblock - extract_variable - extract_tagged - extract_multiple - gen_delimited_pat - gen_extract_tagged - ); + use Text::Balanced qw ( + extract_delimited + extract_bracketed + extract_quotelike + extract_codeblock + extract_variable + extract_tagged + extract_multiple + gen_delimited_pat + gen_extract_tagged + ); - # Extract the initial substring of $text that is delimited by - # two (unescaped) instances of the first character in $delim. + # Extract the initial substring of $text that is delimited by + # two (unescaped) instances of the first character in $delim. - ($extracted, $remainder) = extract_delimited($text,$delim); + ($extracted, $remainder) = extract_delimited($text,$delim); + # Extract the initial substring of $text that is bracketed + # with a delimiter(s) specified by $delim (where the string + # in $delim contains one or more of '(){}[]<>'). - # Extract the initial substring of $text that is bracketed - # with a delimiter(s) specified by $delim (where the string - # in $delim contains one or more of '(){}[]<>'). + ($extracted, $remainder) = extract_bracketed($text,$delim); - ($extracted, $remainder) = extract_bracketed($text,$delim); + # Extract the initial substring of $text that is bounded by + # an XML tag. + ($extracted, $remainder) = extract_tagged($text); - # Extract the initial substring of $text that is bounded by - # an XML tag. + # Extract the initial substring of $text that is bounded by + # a C...C pair. Don't allow nested C tags - ($extracted, $remainder) = extract_tagged($text); + ($extracted, $remainder) = + extract_tagged($text,"BEGIN","END",undef,{bad=>["BEGIN"]}); + # Extract the initial substring of $text that represents a + # Perl "quote or quote-like operation" - # Extract the initial substring of $text that is bounded by - # a C...C pair. Don't allow nested C tags + ($extracted, $remainder) = extract_quotelike($text); - ($extracted, $remainder) = - extract_tagged($text,"BEGIN","END",undef,{bad=>["BEGIN"]}); + # Extract the initial substring of $text that represents a block + # of Perl code, bracketed by any of character(s) specified by $delim + # (where the string $delim contains one or more of '(){}[]<>'). + ($extracted, $remainder) = extract_codeblock($text,$delim); - # Extract the initial substring of $text that represents a - # Perl "quote or quote-like operation" + # Extract the initial substrings of $text that would be extracted by + # one or more sequential applications of the specified functions + # or regular expressions - ($extracted, $remainder) = extract_quotelike($text); + @extracted = extract_multiple($text, + [ \&extract_bracketed, + \&extract_quotelike, + \&some_other_extractor_sub, + qr/[xyz]*/, + 'literal', + ]); + # Create a string representing an optimized pattern (a la Friedl) + # that matches a substring delimited by any of the specified characters + # (in this case: any type of quote or a slash) - # Extract the initial substring of $text that represents a block - # of Perl code, bracketed by any of character(s) specified by $delim - # (where the string $delim contains one or more of '(){}[]<>'). + $patstring = gen_delimited_pat(q{'"`/}); - ($extracted, $remainder) = extract_codeblock($text,$delim); + # Generate a reference to an anonymous sub that is just like extract_tagged + # but pre-compiled and optimized for a specific pair of tags, and + # consequently much faster (i.e. 3 times faster). It uses qr// for better + # performance on repeated calls. - - # Extract the initial substrings of $text that would be extracted by - # one or more sequential applications of the specified functions - # or regular expressions - - @extracted = extract_multiple($text, - [ \&extract_bracketed, - \&extract_quotelike, - \&some_other_extractor_sub, - qr/[xyz]*/, - 'literal', - ]); - -# Create a string representing an optimized pattern (a la Friedl) -# that matches a substring delimited by any of the specified characters -# (in this case: any type of quote or a slash) - - $patstring = gen_delimited_pat(q{'"`/}); - -# Generate a reference to an anonymous sub that is just like extract_tagged -# but pre-compiled and optimized for a specific pair of tags, and consequently -# much faster (i.e. 3 times faster). It uses qr// for better performance on -# repeated calls, so it only works under Perl 5.005 or later. - - $extract_head = gen_extract_tagged('',''); - - ($extracted, $remainder) = $extract_head->($text); + $extract_head = gen_extract_tagged('',''); + ($extracted, $remainder) = $extract_head->($text); =head1 DESCRIPTION @@ -1128,7 +1130,7 @@ they extract an occurrence of the substring appearing immediately at the current matching position in the string (like a C<\G>-anchored regex would). -=head2 General behaviour in list contexts +=head2 General Behaviour in List Contexts In a list context, all the subroutines return a list, the first three elements of which are always: @@ -1150,31 +1152,31 @@ extracted string). On failure, the entire string is returned. The skipped prefix (i.e. the characters before the extracted string). On failure, C is returned. -=back +=back Note that in a list context, the contents of the original input text (the first -argument) are not modified in any way. +argument) are not modified in any way. However, if the input text was passed in a variable, that variable's C value is updated to point at the first character after the extracted text. That means that in a list context the various subroutines can be used much like regular expressions. For example: - while ( $next = (extract_quotelike($text))[0] ) - { - # process next quote-like (in $next) - } + while ( $next = (extract_quotelike($text))[0] ) + { + # process next quote-like (in $next) + } -=head2 General behaviour in scalar and void contexts +=head2 General Behaviour in Scalar and Void Contexts In a scalar context, the extracted string is returned, having first been removed from the input text. Thus, the following code also processes each quote-like operation, but actually removes them from $text: - while ( $next = extract_quotelike($text) ) - { - # process next quote-like (in $next) - } + while ( $next = extract_quotelike($text) ) + { + # process next quote-like (in $next) + } Note that if the input text is a read-only string (i.e. a literal), no attempt is made to remove the extracted text. @@ -1183,7 +1185,7 @@ In a void context the behaviour of the extraction subroutines is exactly the same as in a scalar context, except (of course) that the extracted substring is not returned. -=head2 A note about prefixes +=head2 A Note About Prefixes Prefix patterns are matched without any trailing modifiers (C etc.) This can bite you if you're expecting a prefix specification like @@ -1194,19 +1196,23 @@ pattern will only succeed if the

tag is on the current line, since To overcome this limitation, you need to turn on /s matching within the prefix pattern, using the C<(?s)> directive: '(?s).*?(?=

)' -=head2 C +=head2 Functions + +=over 4 + +=item C The C function formalizes the common idiom of extracting a single-character-delimited substring from the start of a string. For example, to extract a single-quote delimited string, the following code is typically used: - ($remainder = $text) =~ s/\A('(\\.|[^'])*')//s; - $extracted = $1; + ($remainder = $text) =~ s/\A('(\\.|[^'])*')//s; + $extracted = $1; but with C it can be simplified to: - ($extracted,$remainder) = extract_delimited($text, "'"); + ($extracted,$remainder) = extract_delimited($text, "'"); C takes up to four scalars (the input text, the delimiters, a prefix pattern to be skipped, and any escape characters) @@ -1240,42 +1246,42 @@ removed from the beginning of the first argument. Examples: - # Remove a single-quoted substring from the very beginning of $text: + # Remove a single-quoted substring from the very beginning of $text: - $substring = extract_delimited($text, "'", ''); + $substring = extract_delimited($text, "'", ''); - # Remove a single-quoted Pascalish substring (i.e. one in which - # doubling the quote character escapes it) from the very - # beginning of $text: + # Remove a single-quoted Pascalish substring (i.e. one in which + # doubling the quote character escapes it) from the very + # beginning of $text: - $substring = extract_delimited($text, "'", '', "'"); + $substring = extract_delimited($text, "'", '', "'"); - # Extract a single- or double- quoted substring from the - # beginning of $text, optionally after some whitespace - # (note the list context to protect $text from modification): + # Extract a single- or double- quoted substring from the + # beginning of $text, optionally after some whitespace + # (note the list context to protect $text from modification): - ($substring) = extract_delimited $text, q{"'}; + ($substring) = extract_delimited $text, q{"'}; - # Delete the substring delimited by the first '/' in $text: + # Delete the substring delimited by the first '/' in $text: - $text = join '', (extract_delimited($text,'/','[^/]*')[2,1]; + $text = join '', (extract_delimited($text,'/','[^/]*')[2,1]; Note that this last example is I the same as deleting the first quote-like pattern. For instance, if C<$text> contained the string: - "if ('./cmd' =~ m/$UNIXCMD/s) { $cmd = $1; }" - + "if ('./cmd' =~ m/$UNIXCMD/s) { $cmd = $1; }" + then after the deletion it would contain: - "if ('.$UNIXCMD/s) { $cmd = $1; }" + "if ('.$UNIXCMD/s) { $cmd = $1; }" not: - "if ('./cmd' =~ ms) { $cmd = $1; }" - + "if ('./cmd' =~ ms) { $cmd = $1; }" + See L<"extract_quotelike"> for a (partial) solution to this problem. -=head2 C +=item C Like C<"extract_delimited">, the C function takes up to three optional scalar arguments: a string to extract from, a delimiter @@ -1307,15 +1313,15 @@ balanced and correctly nested within the substring, and any other kind of For example, given the string: - $text = "{ an '[irregularly :-(] {} parenthesized >:-)' string }"; + $text = "{ an '[irregularly :-(] {} parenthesized >:-)' string }"; then a call to C in a list context: - @result = extract_bracketed( $text, '{}' ); + @result = extract_bracketed( $text, '{}' ); would return: - ( "{ an '[irregularly :-(] {} parenthesized >:-)' string }" , "" , "" ) + ( "{ an '[irregularly :-(] {} parenthesized >:-)' string }" , "" , "" ) since both sets of C<'{..}'> brackets are properly nested and evenly balanced. (In a scalar context just the first element of the array would be returned. In @@ -1323,18 +1329,18 @@ a void context, C<$text> would be replaced by an empty string.) Likewise the call in: - @result = extract_bracketed( $text, '{[' ); + @result = extract_bracketed( $text, '{[' ); would return the same result, since all sets of both types of specified delimiter brackets are correctly nested and balanced. However, the call in: - @result = extract_bracketed( $text, '{([<' ); + @result = extract_bracketed( $text, '{([<' ); would fail, returning: - ( undef , "{ an '[irregularly :-(] {} parenthesized >:-)' string }" ); + ( undef , "{ an '[irregularly :-(] {} parenthesized >:-)' string }" ); because the embedded pairs of C<'(..)'>s and C<'[..]'>s are "cross-nested" and the embedded C<'E'> is unbalanced. (In a scalar context, this call would @@ -1348,37 +1354,37 @@ However, if a particular species of quote character is included in the delimiter specification, then that type of quote will be correctly handled. for example, if C<$text> is: - $text = 'link'; + $text = 'link'; then - @result = extract_bracketed( $text, '<">' ); + @result = extract_bracketed( $text, '<">' ); returns: - ( '', 'link', "" ) + ( '', 'link', "" ) as expected. Without the specification of C<"> as an embedded quoter: - @result = extract_bracketed( $text, '<>' ); + @result = extract_bracketed( $text, '<>' ); the result would be: - ( 'link', "" ) + ( 'link', "" ) In addition to the quote delimiters C<'>, C<">, and C<`>, full Perl quote-like quoting (i.e. q{string}, qq{string}, etc) can be specified by including the letter 'q' as a delimiter. Hence: - @result = extract_bracketed( $text, '' ); + @result = extract_bracketed( $text, '' ); would correctly match something like this: - $text = ''; + $text = ''; See also: C<"extract_quotelike"> and C<"extract_codeblock">. -=head2 C +=item C C extracts any valid Perl variable or variable-involved expression, including scalars, arrays, hashes, array @@ -1429,11 +1435,10 @@ failure. In addition, the original input text has the returned substring In a void context, the input text just has the matched substring (and any specified prefix) removed. - -=head2 C +=item C C extracts and segments text between (balanced) -specified tags. +specified tags. The subroutine takes up to five optional arguments: @@ -1451,12 +1456,12 @@ that matches any standard XML tag is used. =item 3. -A string specifying a pattern to be matched at the closing tag. +A string specifying a pattern to be matched at the closing tag. If the pattern string is omitted (or C) then the closing tag is constructed by inserting a C after any leading bracket characters in the actual opening tag that was matched (I the pattern that matched the tag). For example, if the opening tag pattern -is specified as C<'{{\w+}}'> and actually matched the opening tag +is specified as C<'{{\w+}}'> and actually matched the opening tag C<"{{DATA}}">, then the constructed closing tag would be C<"{{/DATA}}">. =item 4. @@ -1487,7 +1492,7 @@ an HTML link (which should not contain nested links) use: =item C $listref> The list reference contains one or more strings specifying patterns -that are I be be treated as nested tags within the tagged text +that are I to be treated as nested tags within the tagged text (even if they would match the start tag pattern). For example, to extract an arbitrary XML tag, but ignore "empty" elements: @@ -1508,7 +1513,7 @@ C returns the complete text up to the point of failure. If the string is "PARA", C returns only the first paragraph after the tag (up to the first line that is either empty or contains only whitespace characters). -If the string is "", the the default behaviour (i.e. failure) is reinstated. +If the string is "", the default behaviour (i.e. failure) is reinstated. For example, suppose the start tag "/para" introduces a paragraph, which then continues until the next "/endpara" tag or until another "/para" tag is @@ -1575,9 +1580,7 @@ text has the returned substring (and any prefix) removed from it. In a void context, the input text just has the matched substring (and any specified prefix) removed. -=head2 C - -(Note: This subroutine is only available under Perl5.005) +=item C C generates a new anonymous subroutine which extracts text between (balanced) specified tags. In other words, @@ -1589,7 +1592,7 @@ C, is that those generated subroutines: =over 4 -=item * +=item * do not have to reparse tag specification or parsing options every time they are called (whereas C has to effectively rebuild @@ -1598,7 +1601,7 @@ its tag parser on every call); =item * make use of the new qr// construct to pre-compile the regexes they use -(whereas C uses standard string variable interpolation +(whereas C uses standard string variable interpolation to create tag-matching patterns). =back @@ -1618,16 +1621,14 @@ equivalent to: return $extractor->($text); } -(although C is not currently implemented that way, in order -to preserve pre-5.005 compatibility). +(although C is not currently implemented that way). -Using C to create extraction functions for specific tags +Using C to create extraction functions for specific tags is a good idea if those functions are going to be called more than once, since their performance is typically twice as good as the more general-purpose C. - -=head2 C +=item C C attempts to recognize, extract, and segment any one of the various Perl quotes and quotelike operators (see @@ -1636,7 +1637,7 @@ delimiters (for the quotelike operators), and trailing modifiers are all caught. For example, in: extract_quotelike 'q # an octothorpe: \# (not the end of the q!) #' - + extract_quotelike ' "You said, \"Use sed\"." ' extract_quotelike ' s{([A-Z]{1,8}\.[A-Z]{3})} /\L$1\E/; ' @@ -1664,7 +1665,7 @@ will be extracted as if it were: This behaviour is identical to that of the actual compiler. C takes two arguments: the text to be processed and -a prefix to be matched at the very beginning of the text. If no prefix +a prefix to be matched at the very beginning of the text. If no prefix is specified, optional whitespace is the default. If no text is given, C<$_> is used. @@ -1710,7 +1711,7 @@ the left delimiter of the second block of the operation =item [8] -the text of the second block of the operation +the text of the second block of the operation (that is, the replacement of a substitution or the translation list of a translation), @@ -1757,7 +1758,7 @@ Examples: print "$op is not a pattern matching operation\n"; } -=head2 C and "here documents" +=item C C can successfully extract "here documents" from an input string, but with an important caveat in list contexts. @@ -1842,7 +1843,7 @@ you can pass the input variable as an interpolated literal: $quotelike = extract_quotelike("$var"); -=head2 C +=item C C attempts to recognize and extract a balanced bracket delimited substring that may contain unbalanced brackets @@ -1861,7 +1862,7 @@ Omitting the third argument (prefix argument) implies optional whitespace at the Omitting the fourth argument (outermost delimiter brackets) indicates that the value of the second argument is to be used for the outermost delimiters. -Once the prefix an dthe outermost opening delimiter bracket have been +Once the prefix and the outermost opening delimiter bracket have been recognized, code blocks are extracted by stepping through the input text and trying the following alternatives in sequence: @@ -1933,9 +1934,9 @@ SE')>> the '>' character is only treated as a delimited at the outermost level of the code block, so the directive is parsed correctly. -=head2 C +=item C -The C subroutine takes a string to be processed and a +The C subroutine takes a string to be processed and a list of extractors (subroutines or regular expressions) to apply to that string. In an array context C returns an array of substrings @@ -1947,7 +1948,7 @@ extracted substring removed from it. In all contexts C starts at the current C of the string, and sets that C appropriately after it matches. -Hence, the aim of of a call to C in a list context +Hence, the aim of a call to C in a list context is to split the processed string into as many non-overlapping fields as possible, by repeatedly applying each of the specified extractors to the remainder of the string. Thus C is @@ -1982,11 +1983,11 @@ An number specifying the maximum number of fields to return. If this argument is omitted (or C), split continues as long as possible. If the third argument is I, then extraction continues until I fields -have been successfully extracted, or until the string has been completely +have been successfully extracted, or until the string has been completely processed. -Note that in scalar and void contexts the value of this argument is -automatically reset to 1 (under C<-w>, a warning is issued if the argument +Note that in scalar and void contexts the value of this argument is +automatically reset to 1 (under C<-w>, a warning is issued if the argument has to be reset). =item 4. @@ -2026,7 +2027,7 @@ return value of the extractor will be blessed. If an extractor returns a defined value, that value is immediately treated as the next extracted field and pushed onto the list of fields. If the extractor was specified in a hash reference, the field is also -blessed into the appropriate class, +blessed into the appropriate class, If the extractor fails to match (in the case of a regex extractor), or returns an empty list or an undefined value (in the case of a subroutine extractor), it is assumed to have failed to extract. @@ -2080,7 +2081,7 @@ If you wanted the commas preserved as separate fields (i.e. like split does if your split pattern has capturing parentheses), you would just make the last parameter undefined (or remove it). -=head2 C +=item C The C subroutine takes a single (string) argument and > builds a Friedl-style optimized regex that matches a string delimited @@ -2119,11 +2120,12 @@ If more delimiters than escape chars are specified, the last escape char is used for the remaining delimiters. If no escape char is specified for a given specified delimiter, '\' is used. -=head2 C +=item C Note that C was previously called C. That name may still be used, but is now deprecated. - + +=back =head1 DIAGNOSTICS @@ -2170,7 +2172,7 @@ a closing bracket where none was expected. =item C -C, C or C ran +C, C or C ran out of characters in the text before closing one or more levels of nested brackets. @@ -2257,25 +2259,125 @@ to match the original opening tag (and the failure mode was not =back -=head1 AUTHOR +=head1 EXPORTS -Damian Conway (damian@conway.org) +The following symbols are, or can be, exported by this module: -=head1 BUGS AND IRRITATIONS +=over 4 + +=item Default Exports + +I. + +=item Optional Exports + +C, +C, +C, +C, +C, +C, +C, +C, +C, +C. + +=item Export Tags + +=over 4 + +=item C<:ALL> + +C, +C, +C, +C, +C, +C, +C, +C, +C, +C. + +=back + +=back + +=head1 KNOWN BUGS + +See L. + +=head1 FEEDBACK + +Patches, bug reports, suggestions or any other feedback is welcome. + +Patches can be sent as GitHub pull requests at +L. + +Bug reports and suggestions can be made on the CPAN Request Tracker at +L. + +Currently active requests on the CPAN Request Tracker can be viewed at +L. -There are undoubtedly serious bugs lurking somewhere in this code, if -only because parts of it give the impression of understanding a great deal -more about Perl than they really do. +Please test this distribution. See CPAN Testers Reports at +L for details of how to get involved. -Bug reports and other feedback are most welcome. +Previous test results on CPAN Testers Reports can be viewed at +L. + +Please rate this distribution on CPAN Ratings at +L. + +=head1 AVAILABILITY + +The latest version of this module is available from CPAN (see +L for details) at + +L or + +L or + +L. + +The latest source code is available from GitHub at +L. + +=head1 INSTALLATION + +See the F file. + +=head1 AUTHOR + +Damian Conway ELE. + +Steve Hay ELE is now maintaining +Text::Balanced as of version 2.03. =head1 COPYRIGHT -Copyright 1997 - 2001 Damian Conway. All Rights Reserved. +Copyright (C) 1997-2001 Damian Conway. All rights reserved. + +Copyright (C) 2009 Adam Kennedy. + +Copyright (C) 2015, 2020 Steve Hay. All rights reserved. + +=head1 LICENCE + +This module is free software; you can redistribute it and/or modify it under the +same terms as Perl itself, i.e. under the terms of either the GNU General Public +License or the Artistic License, as specified in the F file. + +=head1 VERSION + +Version 2.04 + +=head1 DATE + +11 Dec 2020 -Some (minor) parts copyright 2009 Adam Kennedy. +=head1 HISTORY -This module is free software. It may be used, redistributed -and/or modified under the same terms as Perl itself. +See the F file. =cut diff --git a/cpan/Text-Balanced/t/01_compile.t b/cpan/Text-Balanced/t/01_compile.t index 77c109999553..a6e91911c72e 100644 --- a/cpan/Text-Balanced/t/01_compile.t +++ b/cpan/Text-Balanced/t/01_compile.t @@ -1,10 +1,9 @@ #!/usr/bin/perl +use 5.008001; + use strict; -BEGIN { - $| = 1; - $^W = 1; -} +use warnings; use Test::More tests => 1; diff --git a/cpan/Text-Balanced/t/02_extbrk.t b/cpan/Text-Balanced/t/02_extbrk.t index a36025ddb02c..5da792f1f041 100644 --- a/cpan/Text-Balanced/t/02_extbrk.t +++ b/cpan/Text-Balanced/t/02_extbrk.t @@ -1,52 +1,60 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..19\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( extract_bracketed ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; - - $var = eval "() = $cmd"; - debug "\t list got: [$var]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str),1) eq ';')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; - - pos $str = 0; - $var = eval $cmd; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my $var = eval "() = $cmd"; + debug "\t list got: [$var]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str),1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ diff --git a/cpan/Text-Balanced/t/03_extcbk.t b/cpan/Text-Balanced/t/03_extcbk.t index 83081ae28d42..398d2771bac0 100644 --- a/cpan/Text-Balanced/t/03_extcbk.t +++ b/cpan/Text-Balanced/t/03_extcbk.t @@ -1,53 +1,61 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..41\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( extract_codeblock ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; - - my @res; - $var = eval "\@res = $cmd"; - debug "\t Failed: $@ at " . $@+0 .")" if $@; - debug "\t list got: [" . join("|", map {defined $_ ? $_ : ''} @res) . "]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; - print "ok ", $count++; - print "\n"; - - pos $str = 0; - $var = eval $cmd; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + my $var = eval "\@res = $cmd"; + debug "\t Failed: $@ at " . $@+0 .")" if $@; + debug "\t list got: [" . join("|", map {defined $_ ? $_ : ''} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ diff --git a/cpan/Text-Balanced/t/04_extdel.t b/cpan/Text-Balanced/t/04_extdel.t index c5ca88eebfde..b2f94cf51cfa 100644 --- a/cpan/Text-Balanced/t/04_extdel.t +++ b/cpan/Text-Balanced/t/04_extdel.t @@ -1,52 +1,60 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..45\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( extract_delimited ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; - $var = eval "() = $cmd"; - debug "\t list got: [$var]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + my $var = eval "() = $cmd"; + debug "\t list got: [$var]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; - pos $str = 0; - $var = eval $cmd; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + pos $str = 0; + $var = eval $cmd; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ diff --git a/cpan/Text-Balanced/t/05_extmul.t b/cpan/Text-Balanced/t/05_extmul.t index 2ac1b19ffd02..9a9711b4f600 100644 --- a/cpan/Text-Balanced/t/05_extmul.t +++ b/cpan/Text-Balanced/t/05_extmul.t @@ -1,17 +1,23 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..86\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( :ALL ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } @@ -19,62 +25,62 @@ sub debug { print "\t>>>",@_ if $DEBUG } sub expect { - local $^W; - my ($l1, $l2) = @_; - - if (@$l1 != @$l2) - { - print "\@l1: ", join(", ", @$l1), "\n"; - print "\@l2: ", join(", ", @$l2), "\n"; - print "not "; - } - else - { - for (my $i = 0; $i < @$l1; $i++) - { - if ($l1->[$i] ne $l2->[$i]) - { - print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n"; - print "not "; - last; - } - } - } - - print "ok $count\n"; - $count++; + local $^W; + my ($l1, $l2) = @_; + + if (@$l1 != @$l2) + { + print "\@l1: ", join(", ", @$l1), "\n"; + print "\@l2: ", join(", ", @$l2), "\n"; + print "not "; + } + else + { + for (my $i = 0; $i < @$l1; $i++) + { + if ($l1->[$i] ne $l2->[$i]) + { + print "field $i: '$l1->[$i]' ne '$l2->[$i]'\n"; + print "not "; + last; + } + } + } + + print "ok $count\n"; + $count++; } sub divide { - my ($text, @index) = @_; - my @bits = (); - unshift @index, 0; - push @index, length($text); - for ( my $i= 0; $i < $#index; $i++) - { - push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]); - } - pop @bits; - return @bits; + my ($text, @index) = @_; + my @bits = (); + unshift @index, 0; + push @index, length($text); + for ( my $i= 0; $i < $#index; $i++) + { + push @bits, substr($text, $index[$i], $index[$i+1]-$index[$i]); + } + pop @bits; + return @bits; } -$stdtext1 = q{$var = do {"val" && $val;};}; +my $stdtext1 = q{$var = do {"val" && $val;};}; # TESTS 2-4 -$text = $stdtext1; -expect [ extract_multiple($text,undef,1) ], - [ divide $stdtext1 => 4 ]; +my $text = $stdtext1; +expect [ extract_multiple($text,undef,1) ], + [ divide $stdtext1 => 4 ]; expect [ pos $text], [ 4 ]; expect [ $text ], [ $stdtext1 ]; # TESTS 5-7 $text = $stdtext1; -expect [ scalar extract_multiple($text,undef,1) ], - [ divide $stdtext1 => 4 ]; +expect [ scalar extract_multiple($text,undef,1) ], + [ divide $stdtext1 => 4 ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext1,4) ]; @@ -82,16 +88,16 @@ expect [ $text ], [ substr($stdtext1,4) ]; # TESTS 8-10 $text = $stdtext1; -expect [ extract_multiple($text,undef,2) ], - [ divide($stdtext1 => 4, 10) ]; +expect [ extract_multiple($text,undef,2) ], + [ divide($stdtext1 => 4, 10) ]; expect [ pos $text], [ 10 ]; expect [ $text ], [ $stdtext1 ]; # TESTS 11-13 $text = $stdtext1; -expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ], - [ substr($stdtext1,0,4) ]; +expect [ eval{local$^W;scalar extract_multiple($text,undef,2)} ], + [ substr($stdtext1,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext1,4) ]; @@ -99,16 +105,16 @@ expect [ $text ], [ substr($stdtext1,4) ]; # TESTS 14-16 $text = $stdtext1; -expect [ extract_multiple($text,undef,3) ], - [ divide($stdtext1 => 4, 10, 26) ]; +expect [ extract_multiple($text,undef,3) ], + [ divide($stdtext1 => 4, 10, 26) ]; expect [ pos $text], [ 26 ]; expect [ $text ], [ $stdtext1 ]; # TESTS 17-19 $text = $stdtext1; -expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ], - [ substr($stdtext1,0,4) ]; +expect [ eval{local$^W;scalar extract_multiple($text,undef,3)} ], + [ substr($stdtext1,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext1,4) ]; @@ -116,16 +122,16 @@ expect [ $text ], [ substr($stdtext1,4) ]; # TESTS 20-22 $text = $stdtext1; -expect [ extract_multiple($text,undef,4) ], - [ divide($stdtext1 => 4, 10, 26, 27) ]; +expect [ extract_multiple($text,undef,4) ], + [ divide($stdtext1 => 4, 10, 26, 27) ]; expect [ pos $text], [ 27 ]; expect [ $text ], [ $stdtext1 ]; # TESTS 23-25 $text = $stdtext1; -expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ], - [ substr($stdtext1,0,4) ]; +expect [ eval{local$^W;scalar extract_multiple($text,undef,4)} ], + [ substr($stdtext1,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext1,4) ]; @@ -133,8 +139,8 @@ expect [ $text ], [ substr($stdtext1,4) ]; # TESTS 26-28 $text = $stdtext1; -expect [ extract_multiple($text,undef,5) ], - [ divide($stdtext1 => 4, 10, 26, 27) ]; +expect [ extract_multiple($text,undef,5) ], + [ divide($stdtext1 => 4, 10, 26, 27) ]; expect [ pos $text], [ 27 ]; expect [ $text ], [ $stdtext1 ]; @@ -142,8 +148,8 @@ expect [ $text ], [ $stdtext1 ]; # TESTS 29-31 $text = $stdtext1; -expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ], - [ substr($stdtext1,0,4) ]; +expect [ eval{local$^W;scalar extract_multiple($text,undef,5)} ], + [ substr($stdtext1,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext1,4) ]; @@ -151,19 +157,19 @@ expect [ $text ], [ substr($stdtext1,4) ]; # TESTS 32-34 -$stdtext2 = q{$var = "val" && (1,2,3);}; +my $stdtext2 = q{$var = "val" && (1,2,3);}; $text = $stdtext2; -expect [ extract_multiple($text) ], - [ divide($stdtext2 => 4, 7, 12, 24) ]; +expect [ extract_multiple($text) ], + [ divide($stdtext2 => 4, 7, 12, 24) ]; expect [ pos $text], [ 24 ]; expect [ $text ], [ $stdtext2 ]; # TESTS 35-37 $text = $stdtext2; -expect [ scalar extract_multiple($text) ], - [ substr($stdtext2,0,4) ]; +expect [ scalar extract_multiple($text) ], + [ substr($stdtext2,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext2,4) ]; @@ -171,16 +177,16 @@ expect [ $text ], [ substr($stdtext2,4) ]; # TESTS 38-40 $text = $stdtext2; -expect [ extract_multiple($text,[\&extract_bracketed]) ], - [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ]; +expect [ extract_multiple($text,[\&extract_bracketed]) ], + [ substr($stdtext2,0,16), substr($stdtext2,16,7), substr($stdtext2,23) ]; expect [ pos $text], [ 24 ]; expect [ $text ], [ $stdtext2 ]; # TESTS 41-43 $text = $stdtext2; -expect [ scalar extract_multiple($text,[\&extract_bracketed]) ], - [ substr($stdtext2,0,16) ]; +expect [ scalar extract_multiple($text,[\&extract_bracketed]) ], + [ substr($stdtext2,0,16) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext2,15) ]; @@ -188,16 +194,16 @@ expect [ $text ], [ substr($stdtext2,15) ]; # TESTS 44-46 $text = $stdtext2; -expect [ extract_multiple($text,[\&extract_variable]) ], - [ substr($stdtext2,0,4), substr($stdtext2,4) ]; +expect [ extract_multiple($text,[\&extract_variable]) ], + [ substr($stdtext2,0,4), substr($stdtext2,4) ]; expect [ pos $text], [ length($text) ]; expect [ $text ], [ $stdtext2 ]; # TESTS 47-49 $text = $stdtext2; -expect [ scalar extract_multiple($text,[\&extract_variable]) ], - [ substr($stdtext2,0,4) ]; +expect [ scalar extract_multiple($text,[\&extract_variable]) ], + [ substr($stdtext2,0,4) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext2,4) ]; @@ -205,16 +211,16 @@ expect [ $text ], [ substr($stdtext2,4) ]; # TESTS 50-52 $text = $stdtext2; -expect [ extract_multiple($text,[\&extract_quotelike]) ], - [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ]; +expect [ extract_multiple($text,[\&extract_quotelike]) ], + [ substr($stdtext2,0,7), substr($stdtext2,7,5), substr($stdtext2,12) ]; expect [ pos $text], [ length($text) ]; expect [ $text ], [ $stdtext2 ]; # TESTS 53-55 $text = $stdtext2; -expect [ scalar extract_multiple($text,[\&extract_quotelike]) ], - [ substr($stdtext2,0,7) ]; +expect [ scalar extract_multiple($text,[\&extract_quotelike]) ], + [ substr($stdtext2,0,7) ]; expect [ pos $text], [ 0 ]; expect [ $text ], [ substr($stdtext2,6) ]; @@ -222,16 +228,16 @@ expect [ $text ], [ substr($stdtext2,6) ]; # TESTS 56-58 $text = $stdtext2; -expect [ extract_multiple($text,[\&extract_quotelike],2,1) ], - [ substr($stdtext2,7,5) ]; +expect [ extract_multiple($text,[\&extract_quotelike],2,1) ], + [ substr($stdtext2,7,5) ]; expect [ pos $text], [ 23 ]; expect [ $text ], [ $stdtext2 ]; # TESTS 59-61 $text = $stdtext2; -expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ], - [ substr($stdtext2,7,5) ]; +expect [ eval{local$^W;scalar extract_multiple($text,[\&extract_quotelike],2,1)} ], + [ substr($stdtext2,7,5) ]; expect [ pos $text], [ 6 ]; expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; @@ -239,16 +245,16 @@ expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; # TESTS 62-64 $text = $stdtext2; -expect [ extract_multiple($text,[\&extract_quotelike],1,1) ], - [ substr($stdtext2,7,5) ]; +expect [ extract_multiple($text,[\&extract_quotelike],1,1) ], + [ substr($stdtext2,7,5) ]; expect [ pos $text], [ 12 ]; expect [ $text ], [ $stdtext2 ]; # TESTS 65-67 $text = $stdtext2; -expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ], - [ substr($stdtext2,7,5) ]; +expect [ scalar extract_multiple($text,[\&extract_quotelike],1,1) ], + [ substr($stdtext2,7,5) ]; expect [ pos $text], [ 6 ]; expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; @@ -257,8 +263,8 @@ expect [ $text ], [ substr($stdtext2,0,6). substr($stdtext2,12) ]; my $stdtext3 = "a,b,c"; $_ = $stdtext3; -expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], - [ divide($stdtext3 => 1,2,3,4,5) ]; +expect [ extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], + [ divide($stdtext3 => 1,2,3,4,5) ]; expect [ pos ], [ 5 ]; expect [ $_ ], [ $stdtext3 ]; @@ -266,8 +272,8 @@ expect [ $_ ], [ $stdtext3 ]; # TESTS 71-73 $_ = $stdtext3; -expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], - [ divide($stdtext3 => 1) ]; +expect [ scalar extract_multiple(undef, [ sub { /\G[a-z]/gc && $& } ]) ], + [ divide($stdtext3 => 1) ]; expect [ pos ], [ 0 ]; expect [ $_ ], [ substr($stdtext3,1) ]; @@ -276,8 +282,8 @@ expect [ $_ ], [ substr($stdtext3,1) ]; # TESTS 74-76 $_ = $stdtext3; -expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ], - [ divide($stdtext3 => 1,2,3,4,5) ]; +expect [ extract_multiple(undef, [ qr/\G[a-z]/ ]) ], + [ divide($stdtext3 => 1,2,3,4,5) ]; expect [ pos ], [ 5 ]; expect [ $_ ], [ $stdtext3 ]; @@ -285,8 +291,8 @@ expect [ $_ ], [ $stdtext3 ]; # TESTS 77-79 $_ = $stdtext3; -expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ], - [ divide($stdtext3 => 1) ]; +expect [ scalar extract_multiple(undef, [ qr/\G[a-z]/ ]) ], + [ divide($stdtext3 => 1) ]; expect [ pos ], [ 0 ]; expect [ $_ ], [ substr($stdtext3,1) ]; @@ -295,8 +301,8 @@ expect [ $_ ], [ substr($stdtext3,1) ]; # TESTS 80-82 $_ = $stdtext3; -expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ], - [ qw(a b c) ]; +expect [ extract_multiple(undef, [ q/([a-z]),?/ ]) ], + [ qw(a b c) ]; expect [ pos ], [ 5 ]; expect [ $_ ], [ $stdtext3 ]; @@ -304,8 +310,8 @@ expect [ $_ ], [ $stdtext3 ]; # TESTS 83-85 $_ = $stdtext3; -expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ], - [ divide($stdtext3 => 1) ]; +expect [ scalar extract_multiple(undef, [ q/([a-z]),?/ ]) ], + [ divide($stdtext3 => 1) ]; expect [ pos ], [ 0 ]; expect [ $_ ], [ substr($stdtext3,2) ]; @@ -315,5 +321,5 @@ expect [ $_ ], [ substr($stdtext3,2) ]; # Fails in Text-Balanced-1.95 with result ['1 ', '""', '1234'] $_ = q{ ""1234}; -expect [ extract_multiple(undef, [\&extract_quotelike]) ], - [ ' ', '""', '1234' ]; +expect [ extract_multiple(undef, [\&extract_quotelike]) ], + [ ' ', '""', '1234' ]; diff --git a/cpan/Text-Balanced/t/06_extqlk.t b/cpan/Text-Balanced/t/06_extqlk.t index 6badc0ee18d5..e32ca7d13034 100644 --- a/cpan/Text-Balanced/t/06_extqlk.t +++ b/cpan/Text-Balanced/t/06_extqlk.t @@ -2,17 +2,23 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..95\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( extract_quotelike ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); #$DEBUG=1; sub debug { print "\t>>>",@_ if $ENV{DEBUG} } @@ -20,48 +26,50 @@ sub esc { my $x = shift||''; $x =~ s/\n/\\n/gs; $x } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : ''; - my $tests = 'sl'; - $str =~ s/\\n/\n/g; - my $orig = $str; - - eval $setup_cmd if $setup_cmd ne ''; - if($tests =~ /l/) { - debug "\tUsing: $cmd\n"; - debug "\t on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n"; - my @res; - eval qq{\@res = $cmd; }; - debug "\t got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res); - debug "\t left: [" . esc($str) . "]\n"; - debug "\t pos: [" . esc(substr($str,pos($str))) . "...]\n"; - print "not " if (substr($str,pos($str),1) eq ';')==$neg; - print "ok ", $count++; - print "\n"; - } - - eval $setup_cmd if $setup_cmd ne ''; - if($tests =~ /s/) { - $str = $orig; - debug "\tUsing: scalar $cmd\n"; - debug "\t on: [" . esc($str) . "]\n"; - $var = eval $cmd; - print " ($@)" if $@ && $DEBUG; - $var = "" unless defined $var; - debug "\t scalar got: [" . esc($var) . "]\n"; - debug "\t scalar left: [" . esc($str) . "]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print "\n"; - } + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + my $setup_cmd = ($str =~ s/\A\{(.*)\}//) ? $1 : ''; + my $tests = 'sl'; + $str =~ s/\\n/\n/g; + my $orig = $str; + + eval $setup_cmd if $setup_cmd ne ''; + if($tests =~ /l/) { + debug "\tUsing: $cmd\n"; + debug "\t on: [" . esc($setup_cmd) . "][" . esc($str) . "]\n"; + my @res; + eval qq{\@res = $cmd; }; + debug "\t got:\n" . join "", map { "\t\t\t$_: [" . esc($res[$_]) . "]\n"} (0..$#res); + debug "\t left: [" . esc($str) . "]\n"; + debug "\t pos: [" . esc(substr($str,pos($str))) . "...]\n"; + print "not " if (substr($str,pos($str),1) eq ';')==$neg; + print "ok ", $count++; + print "\n"; + } + + eval $setup_cmd if $setup_cmd ne ''; + if($tests =~ /s/) { + $str = $orig; + debug "\tUsing: scalar $cmd\n"; + debug "\t on: [" . esc($str) . "]\n"; + my $var = eval $cmd; + print " ($@)" if $@ && $DEBUG; + $var = "" unless defined $var; + debug "\t scalar got: [" . esc($var) . "]\n"; + debug "\t scalar left: [" . esc($str) . "]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print "\n"; + } } # fails in Text::Balanced 1.95 @@ -71,7 +79,7 @@ print "not " if $z[0] eq ''; print "ok ", $count++; print "\n"; - + __DATA__ # USING: extract_quotelike($str); @@ -92,9 +100,9 @@ __DATA__ <<""; done()\nline1\nline2\n\n and next <<; done()\nline1\nline2\n\n and next # fails in Text::Balanced 1.95 -<{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->' -s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->' -<{pat}>{$self->{sub}}; # CAN'T HANDLE '>' in '->' +s-$self->{pap}-$self->{sub}-; # CAN'T HANDLE '-' in '->' +<>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; - - my @res; - $var = eval "\@res = $cmd"; - debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; - - pos $str = 0; - $var = eval $cmd; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + my $var = eval "\@res = $cmd"; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval $cmd; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ # USING: gen_extract_tagged("BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)")->($str); - ignore\n this and then BEGINHERE at the ENDHERE; - ignore\n this and then BEGINTHIS at the ENDTHIS; + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; # USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); - ignore\n this and then BEGINHERE at the ENDHERE; - ignore\n this and then BEGINTHIS at the ENDTHIS; + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; # USING: extract_tagged($str,"BEGIN([A-Z]+)",'END$1',"(?s).*?(?=BEGIN)"); - ignore\n this and then BEGINHERE at the ENDHERE; - ignore\n this and then BEGINTHIS at the ENDTHIS; + ignore\n this and then BEGINHERE at the ENDHERE; + ignore\n this and then BEGINTHIS at the ENDTHIS; # THIS SHOULD FAIL - ignore\n this and then BEGINTHIS at the ENDTHAT; + ignore\n this and then BEGINTHIS at the ENDTHAT; # USING: extract_tagged($str,"BEGIN","END","(?s).*?(?=BEGIN)"); - ignore\n this and then BEGIN at the END; + ignore\n this and then BEGIN at the END; # USING: extract_tagged($str); - some text; + some text; # USING: extract_tagged($str,qr/<[A-Z]+>/,undef, undef, {ignore=>["
"]}); - aaabbb
cccddd; + aaabbb
cccddd; # USING: extract_tagged($str,"BEGIN","END"); - BEGIN at the BEGIN keyword and END at the END; - BEGIN at the beginning and end at the END; + BEGIN at the BEGIN keyword and END at the END; + BEGIN at the beginning and end at the END; # USING: extract_tagged($str,undef,undef,undef,{ignore=>["<[^>]*/>"]}); - aaabbb
cccddd; + aaabbb
cccddd; # USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"MAX"}); - ; at the ;-) keyword + ; at the ;-) keyword # USING: extract_tagged($str,"<[A-Z]+>",undef, undef, {ignore=>["
"]}); - aaabbb
cccddd; + aaabbb
cccddd; # THESE SHOULD FAIL - BEGIN at the beginning and end at the end; - BEGIN at the BEGIN keyword and END at the end; + BEGIN at the beginning and end at the end; + BEGIN at the BEGIN keyword and END at the end; # TEST EXTRACTION OF TAGGED STRINGS # USING: extract_tagged($str,"BEGIN","END",undef,{reject=>["BEGIN","END"]}); # THESE SHOULD FAIL - BEGIN at the BEGIN keyword and END at the end; + BEGIN at the BEGIN keyword and END at the end; # USING: extract_tagged($str,";","-",undef,{reject=>[";"],fail=>"PARA"}); - ; at the ;-) keyword + ; at the ;-) keyword # USING: extract_tagged($str); - some text; - some textother text; - some textother text; - some text; + some text; + some textother text; + some textother text; + some text; # THESE SHOULD FAIL - some text - some textother text; - some textother text; + some text + some textother text; + some textother text; diff --git a/cpan/Text-Balanced/t/08_extvar.t b/cpan/Text-Balanced/t/08_extvar.t index a33ac919ecab..f527b843e0c4 100644 --- a/cpan/Text-Balanced/t/08_extvar.t +++ b/cpan/Text-Balanced/t/08_extvar.t @@ -1,53 +1,61 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..183\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( extract_variable ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; + chomp $str; + if ($str =~ s/\A# USING://) { $neg = 0; $cmd = $str; next; } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; - my @res; - $var = eval "\@res = $cmd"; - debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + my @res; + my $var = eval "\@res = $cmd"; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; - pos $str = 0; - $var = eval $cmd; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + pos $str = 0; + $var = eval $cmd; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ diff --git a/cpan/Text-Balanced/t/09_gentag.t b/cpan/Text-Balanced/t/09_gentag.t index 0dd55a5f3fa9..1a82ae1e211e 100644 --- a/cpan/Text-Balanced/t/09_gentag.t +++ b/cpan/Text-Balanced/t/09_gentag.t @@ -1,102 +1,115 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' +use 5.008001; + +use strict; +use warnings; + ######################### We start with some black magic to print on failure. # Change 1..1 below to 1..last_test_to_print . # (It may become useful if the test is moved to ./t subdirectory.) +my $loaded = 0; BEGIN { $| = 1; print "1..37\n"; } END {print "not ok 1\n" unless $loaded;} use Text::Balanced qw ( gen_extract_tagged ); $loaded = 1; print "ok 1\n"; -$count=2; +my $count=2; use vars qw( $DEBUG ); sub debug { print "\t>>>",@_ if $DEBUG } ######################### End of black magic. +## no critic (BuiltinFunctions::ProhibitStringyEval) -$cmd = "print"; -$neg = 0; +my $cmd = "print"; +my $neg = 0; +my $str; while (defined($str = )) { - chomp $str; - $str =~ s/\\n/\n/g; - if ($str =~ s/\A# USING://) - { - $neg = 0; - eval{local$^W;*f = eval $str || die}; - next; - } - elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } - elsif (!$str || $str =~ /\A#/) { $neg = 0; next } - $str =~ s/\\n/\n/g; - debug "\tUsing: $cmd\n"; - debug "\t on: [$str]\n"; - - my @res; - $var = eval { @res = f($str) }; - debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; - debug "\t list left: [$str]\n"; - print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; - - pos $str = 0; - $var = eval { scalar f($str) }; - $var = "" unless defined $var; - debug "\t scalar got: [$var]\n"; - debug "\t scalar left: [$str]\n"; - print "not " if ($str =~ '\A;')==$neg; - print "ok ", $count++; - print " ($@)" if $@ && $DEBUG; - print "\n"; + chomp $str; + $str =~ s/\\n/\n/g; + if ($str =~ s/\A# USING://) + { + $neg = 0; + eval { + # Capture "Subroutine main::f redefined" warning + my @warnings; + local $SIG{__WARN__} = sub { push @warnings, shift; }; + *f = eval $str || die; + }; + next; + } + elsif ($str =~ /\A# TH[EI]SE? SHOULD FAIL/) { $neg = 1; next; } + elsif (!$str || $str =~ /\A#/) { $neg = 0; next } + $str =~ s/\\n/\n/g; + debug "\tUsing: $cmd\n"; + debug "\t on: [$str]\n"; + + my @res; + my $var = eval { @res = f($str) }; + debug "\t list got: [" . join("|",map {defined $_ ? $_ : ''} @res) . "]\n"; + debug "\t list left: [$str]\n"; + print "not " if (substr($str,pos($str)||0,1) eq ';')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; + + pos $str = 0; + $var = eval { scalar f($str) }; + $var = "" unless defined $var; + debug "\t scalar got: [$var]\n"; + debug "\t scalar left: [$str]\n"; + print "not " if ($str =~ '\A;')==$neg; + print "ok ", $count++; + print " ($@)" if $@ && $DEBUG; + print "\n"; } __DATA__ # USING: gen_extract_tagged('{','}'); - { a test }; + { a test }; # USING: gen_extract_tagged(qr/<[A-Z]+>/,undef, undef, {ignore=>["
"]}); - aaabbb
cccddd; + aaabbb
cccddd; # USING: gen_extract_tagged("BEGIN","END"); - BEGIN at the BEGIN keyword and END at the END; - BEGIN at the beginning and end at the END; + BEGIN at the BEGIN keyword and END at the END; + BEGIN at the beginning and end at the END; # USING: gen_extract_tagged(undef,undef,undef,{ignore=>["<[^>]*/>"]}); - aaabbb
cccddd; + aaabbb
cccddd; # USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"MAX"}); - ; at the ;-) keyword + ; at the ;-) keyword # USING: gen_extract_tagged("<[A-Z]+>",undef, undef, {ignore=>["
"]}); - aaabbb
cccddd; + aaabbb
cccddd; # THESE SHOULD FAIL - BEGIN at the beginning and end at the end; - BEGIN at the BEGIN keyword and END at the end; + BEGIN at the beginning and end at the end; + BEGIN at the BEGIN keyword and END at the end; # TEST EXTRACTION OF TAGGED STRINGS # USING: gen_extract_tagged("BEGIN","END",undef,{reject=>["BEGIN","END"]}); # THESE SHOULD FAIL - BEGIN at the BEGIN keyword and END at the end; + BEGIN at the BEGIN keyword and END at the end; # USING: gen_extract_tagged(";","-",undef,{reject=>[";"],fail=>"PARA"}); - ; at the ;-) keyword + ; at the ;-) keyword # USING: gen_extract_tagged(); - some text; - some textother text; - some textother text; - some text; + some text; + some textother text; + some textother text; + some text; # THESE SHOULD FAIL - some text - some textother text; - some textother text; + some text + some textother text; + some textother text; diff --git a/cpan/Text-Balanced/t/94_changes.t b/cpan/Text-Balanced/t/94_changes.t new file mode 100644 index 000000000000..400ec890938a --- /dev/null +++ b/cpan/Text-Balanced/t/94_changes.t @@ -0,0 +1,48 @@ +#!perl +#=============================================================================== +# +# t/94_changes.t +# +# DESCRIPTION +# Test script to check CPAN::Changes conformance. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::CPAN::Changes; + Test::CPAN::Changes->import(); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::CPAN::Changes required to test Changes'; + } + else { + changes_ok(); + } +} + +#=============================================================================== diff --git a/cpan/Text-Balanced/t/95_critic.t b/cpan/Text-Balanced/t/95_critic.t new file mode 100644 index 000000000000..1e575423eb78 --- /dev/null +++ b/cpan/Text-Balanced/t/95_critic.t @@ -0,0 +1,48 @@ +#!perl +#=============================================================================== +# +# t/95_critic.t +# +# DESCRIPTION +# Test script to check Perl::Critic conformance. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::Perl::Critic; + Test::Perl::Critic->import(-profile => ''); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::Perl::Critic required to test with Perl::Critic'; + } + else { + all_critic_ok('.'); + } +} + +#=============================================================================== diff --git a/cpan/Text-Balanced/t/96_pmv.t b/cpan/Text-Balanced/t/96_pmv.t new file mode 100644 index 000000000000..e1197da5de5a --- /dev/null +++ b/cpan/Text-Balanced/t/96_pmv.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +# Test that our declared minimum Perl version matches our syntax + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +my @MODULES = ( + 'Perl::MinimumVersion 1.20', + 'Test::MinimumVersion 0.101082', +); + +# Don't run tests for installs +use Test::More; +unless ( $ENV{AUTHOR_TESTING} ) { + plan( skip_all => "Author testing only" ); +} + +# Load the testing modules +foreach my $MODULE ( @MODULES ) { + ## no critic (BuiltinFunctions::ProhibitStringyEval) + eval "use $MODULE"; + if ( $@ ) { + plan( skip_all => "$MODULE not available for testing" ); + } +} + +all_minimum_version_from_mymetayml_ok(); diff --git a/cpan/Text-Balanced/t/97_pod.t b/cpan/Text-Balanced/t/97_pod.t new file mode 100644 index 000000000000..d0f4caec64a1 --- /dev/null +++ b/cpan/Text-Balanced/t/97_pod.t @@ -0,0 +1,32 @@ +#!/usr/bin/perl + +# Test that the syntax of our POD documentation is valid + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +my @MODULES = ( + 'Pod::Simple 3.07', + 'Test::Pod 1.26', +); + +# Don't run tests for installs +use Test::More; +unless ( $ENV{AUTHOR_TESTING} ) { + plan( skip_all => "Author testing only" ); +} + +# Load the testing modules +foreach my $MODULE ( @MODULES ) { + ## no critic (BuiltinFunctions::ProhibitStringyEval) + eval "use $MODULE"; + if ( $@ ) { + plan( skip_all => "$MODULE not available for testing" ); + } +} + +all_pod_files_ok(); diff --git a/cpan/Text-Balanced/t/98_pod_coverage.t b/cpan/Text-Balanced/t/98_pod_coverage.t new file mode 100644 index 000000000000..cce4f94c6088 --- /dev/null +++ b/cpan/Text-Balanced/t/98_pod_coverage.t @@ -0,0 +1,51 @@ +#!perl +#=============================================================================== +# +# t/99_pod_coverage.t +# +# DESCRIPTION +# Test script to check POD coverage. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::Pod::Coverage; + Test::Pod::Coverage->import(); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::Pod::Coverage required to test POD coverage'; + } + elsif ($Test::Pod::Coverage::VERSION < 0.08) { + plan skip_all => 'Test::Pod::Coverage 0.08 or higher required to test POD coverage'; + } + else { + all_pod_coverage_ok(); + } +} + +#=============================================================================== From de5823659490d611bba33d52de7637d3abadde9d Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Fri, 18 Dec 2020 10:40:09 +0100 Subject: [PATCH 240/503] Update PerlIO::via::QuotedPrint from 0.08 to 0.09 This should be picked up by the auto-generated perldelta --- MANIFEST | 4 + .../lib/PerlIO/via/QuotedPrint.pm | 112 +++++++++++++++--- cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t | 25 ++-- cpan/PerlIO-via-QuotedPrint/t/changes.t | 48 ++++++++ cpan/PerlIO-via-QuotedPrint/t/critic.t | 48 ++++++++ cpan/PerlIO-via-QuotedPrint/t/pod.t | 51 ++++++++ cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t | 54 +++++++++ 7 files changed, 312 insertions(+), 30 deletions(-) create mode 100644 cpan/PerlIO-via-QuotedPrint/t/changes.t create mode 100644 cpan/PerlIO-via-QuotedPrint/t/critic.t create mode 100644 cpan/PerlIO-via-QuotedPrint/t/pod.t create mode 100644 cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t diff --git a/MANIFEST b/MANIFEST index c79545e01019..c3adc8d1c0c3 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1540,6 +1540,10 @@ cpan/perlfaq/lib/perlfaq8.pod System Interaction cpan/perlfaq/lib/perlfaq9.pod Networking cpan/perlfaq/lib/perlglossary.pod Perl Glossary cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm PerlIO::via::QuotedPrint +cpan/PerlIO-via-QuotedPrint/t/changes.t +cpan/PerlIO-via-QuotedPrint/t/critic.t +cpan/PerlIO-via-QuotedPrint/t/pod.t +cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t PerlIO::via::QuotedPrint cpan/Pod-Checker/lib/Pod/Checker.pm cpan/Pod-Checker/scripts/podchecker.PL diff --git a/cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm b/cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm index 8135e176403b..d02ec682ae56 100644 --- a/cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm +++ b/cpan/PerlIO-via-QuotedPrint/lib/PerlIO/via/QuotedPrint.pm @@ -1,10 +1,19 @@ +# Copyright (C) 2002-2004, 2012 Elizabeth Mattijsen. All rights reserved. +# Copyright (C) 2015 Steve Hay. All rights reserved. + +# This module is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU General +# Public License or the Artistic License, as specified in the F file. + package PerlIO::via::QuotedPrint; -$VERSION= '0.08'; +use 5.008001; # be as strict as possible use strict; +our $VERSION = '0.09'; + # modules that we need use MIME::QuotedPrint (); # no need to pollute this namespace @@ -61,17 +70,13 @@ PerlIO::via::QuotedPrint - PerlIO layer for quoted-printable strings =head1 SYNOPSIS - use PerlIO::via::QuotedPrint; + use PerlIO::via::QuotedPrint; - open( my $in, '<:via(QuotedPrint)', 'file.qp' ) - or die "Can't open file.qp for reading: $!\n"; - - open( my $out, '>:via(QuotedPrint)', 'file.qp' ) - or die "Can't open file.qp for writing: $!\n"; - -=head1 VERSION + open(my $in, '<:via(QuotedPrint)', 'file.qp') or + die "Can't open file.qp for reading: $!\n"; -This documentation describes version 0.08. + open(my $out, '>:via(QuotedPrint)', 'file.qp') or + die "Can't open file.qp for writing: $!\n"; =head1 DESCRIPTION @@ -79,24 +84,93 @@ This module implements a PerlIO layer that works on files encoded in the quoted-printable format. It will decode from quoted-printable while reading from a handle, and it will encode as quoted-printable while writing to a handle. -=head1 REQUIRED MODULES +=head1 EXPORTS + +I. + +=head1 KNOWN BUGS + +I. + +=head1 FEEDBACK - MIME::QuotedPrint (any) +Patches, bug reports, suggestions or any other feedback is welcome. + +Patches can be sent as GitHub pull requests at +L. + +Bug reports and suggestions can be made on the CPAN Request Tracker at +L. + +Currently active requests on the CPAN Request Tracker can be viewed at +L. + +Please test this distribution. See CPAN Testers Reports at +L for details of how to get involved. + +Previous test results on CPAN Testers Reports can be viewed at +L. + +Please rate this distribution on CPAN Ratings at +L. =head1 SEE ALSO -L, L, L, -L, L, L. +L, +L. =head1 ACKNOWLEDGEMENTS -Based on example that was initially added to MIME::QuotedPrint.pm for the -5.8.0 distribution of Perl. +Based on an example in the standard library module MIME::QuotedPrint in Perl +(version 5.8.0). + +=head1 AVAILABILITY + +The latest version of this module is available from CPAN (see +L for details) at + +L or + +L or + +L. + +The latest source code is available from GitHub at +L. + +=head1 INSTALLATION + +See the F file. + +=head1 AUTHOR + +Elizabeth Mattijsen ELE. + +Steve Hay ELE is now maintaining +PerlIO::via::QuotedPrint as of version 0.08. =head1 COPYRIGHT -Copyright (c) 2002, 2003, 2004, 2012 Elizabeth Mattijsen. All rights reserved. -This library is free software; you can redistribute it and/or modify it under -the same terms as Perl itself. +Copyright (C) 2002-2004, 2012 Elizabeth Mattijsen. All rights reserved. + +Copyright (C) 2015, 2020 Steve Hay. All rights reserved. + +=head1 LICENCE + +This module is free software; you can redistribute it and/or modify it under +the same terms as Perl itself, i.e. under the terms of either the GNU General +Public License or the Artistic License, as specified in the F file. + +=head1 VERSION + +Version 0.09 + +=head1 DATE + +08 Dec 2020 + +=head1 HISTORY + +See the F file. =cut diff --git a/cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t b/cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t index 33366bd5657e..5270fb4691ba 100644 --- a/cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t +++ b/cpan/PerlIO-via-QuotedPrint/t/QuotedPrint.t @@ -1,4 +1,9 @@ -BEGIN { # Magic Perl CORE pragma +use 5.008001; + +use strict; +use warnings; + +BEGIN { # Magic Perl CORE pragma unless (find PerlIO::Layer 'perlio') { print "1..0 # Skip: PerlIO not used\n"; exit 0; @@ -8,8 +13,6 @@ BEGIN { # Magic Perl CORE pragma } } -use strict; -use warnings; use Test::More tests => 11; BEGIN { use_ok('PerlIO::via::QuotedPrint') } @@ -34,16 +37,16 @@ ok( "opening '$file' for writing" ); -ok( (print $out $decoded), 'print to file' ); -ok( close( $out ), 'closing encoding handle' ); +ok( (print $out $decoded), 'print to file' ); +ok( close( $out ), 'closing encoding handle' ); # Check encoding without layers { local $/ = undef; -ok( open( my $test,$file ), 'opening without layer' ); -is( $encoded,readline( $test ), 'check encoded content' ); -ok( close( $test ), 'close test handle' ); +ok( open( my $test, '<', $file ), 'opening without layer' ); +is( $encoded,readline( $test ), 'check encoded content' ); +ok( close( $test ), 'close test handle' ); } # Check decoding _with_ layers @@ -52,10 +55,10 @@ ok( open( my $in,'<:via(QuotedPrint)', $file ), "opening '$file' for reading" ); -is( $decoded,join( '',<$in> ), 'check decoding' ); -ok( close( $in ), 'close decoding handle' ); +is( $decoded,join( '',<$in> ), 'check decoding' ); +ok( close( $in ), 'close decoding handle' ); # Remove whatever we created now -ok( unlink( $file ), "remove test file '$file'" ); +ok( unlink( $file ), "remove test file '$file'" ); 1 while unlink $file; # multiversioned filesystems diff --git a/cpan/PerlIO-via-QuotedPrint/t/changes.t b/cpan/PerlIO-via-QuotedPrint/t/changes.t new file mode 100644 index 000000000000..bd743ad1e6e0 --- /dev/null +++ b/cpan/PerlIO-via-QuotedPrint/t/changes.t @@ -0,0 +1,48 @@ +#!perl +#=============================================================================== +# +# t/changes.t +# +# DESCRIPTION +# Test script to check CPAN::Changes conformance. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::CPAN::Changes; + Test::CPAN::Changes->import(); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::CPAN::Changes required to test Changes'; + } + else { + changes_ok(); + } +} + +#=============================================================================== diff --git a/cpan/PerlIO-via-QuotedPrint/t/critic.t b/cpan/PerlIO-via-QuotedPrint/t/critic.t new file mode 100644 index 000000000000..882853a85e99 --- /dev/null +++ b/cpan/PerlIO-via-QuotedPrint/t/critic.t @@ -0,0 +1,48 @@ +#!perl +#=============================================================================== +# +# t/critic.t +# +# DESCRIPTION +# Test script to check Perl::Critic conformance. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::Perl::Critic; + Test::Perl::Critic->import(-profile => ''); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::Perl::Critic required to test with Perl::Critic'; + } + else { + all_critic_ok('.'); + } +} + +#=============================================================================== diff --git a/cpan/PerlIO-via-QuotedPrint/t/pod.t b/cpan/PerlIO-via-QuotedPrint/t/pod.t new file mode 100644 index 000000000000..0e269bc087c4 --- /dev/null +++ b/cpan/PerlIO-via-QuotedPrint/t/pod.t @@ -0,0 +1,51 @@ +#!perl +#=============================================================================== +# +# t/pod.t +# +# DESCRIPTION +# Test script to check POD. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::Pod; + Test::Pod->import(); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::Pod required to test POD'; + } + elsif ($Test::Pod::VERSION < 1.00) { + plan skip_all => 'Test::Pod 1.00 or higher required to test POD'; + } + else { + all_pod_files_ok(); + } +} + +#=============================================================================== diff --git a/cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t b/cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t new file mode 100644 index 000000000000..d733da90100c --- /dev/null +++ b/cpan/PerlIO-via-QuotedPrint/t/pod_coverage.t @@ -0,0 +1,54 @@ +#!perl +#=============================================================================== +# +# t/pod_coverage.t +# +# DESCRIPTION +# Test script to check POD coverage. +# +# COPYRIGHT +# Copyright (C) 2015 Steve Hay. All rights reserved. +# +# LICENCE +# This script is free software; you can redistribute it and/or modify it under +# the same terms as Perl itself, i.e. under the terms of either the GNU +# General Public License or the Artistic License, as specified in the LICENCE +# file. +# +#=============================================================================== + +use 5.008001; + +use strict; +use warnings; + +use Test::More; + +#=============================================================================== +# MAIN PROGRAM +#=============================================================================== + +MAIN: { + plan skip_all => 'Author testing only' unless $ENV{AUTHOR_TESTING}; + + my $ok = eval { + require Test::Pod::Coverage; + Test::Pod::Coverage->import(); + 1; + }; + + if (not $ok) { + plan skip_all => 'Test::Pod::Coverage required to test POD coverage'; + } + elsif ($Test::Pod::Coverage::VERSION < 0.08) { + plan skip_all => 'Test::Pod::Coverage 0.08 or higher required to test POD coverage'; + } + else { + plan tests => 1; + pod_coverage_ok('PerlIO::via::QuotedPrint', { + also_private => [qw(FILL PUSHED WRITE)] + }); + } +} + +#=============================================================================== From 62a91342d3bec4a85be710dbb1aa3efe856daf1e Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Fri, 18 Dec 2020 10:44:02 +0100 Subject: [PATCH 241/503] Also update Maintainers.pl with the updated PerlIO::via::QuotedPrint version --- Porting/Maintainers.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index dc608efb5db3..d8d2294d6d29 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -911,7 +911,7 @@ package Maintainers; }, 'PerlIO::via::QuotedPrint' => { - 'DISTRIBUTION' => 'SHAY/PerlIO-via-QuotedPrint-0.08.tar.gz', + 'DISTRIBUTION' => 'SHAY/PerlIO-via-QuotedPrint-0.09.tar.gz', 'FILES' => q[cpan/PerlIO-via-QuotedPrint], }, From 5c46354e9b4d0d5f89c19b4480f2bce1f662b39c Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Fri, 18 Dec 2020 12:54:10 +0000 Subject: [PATCH 242/503] Update ExtUtils-Install to CPAN version 2.20 [DELTA] 2.20 - Exercise _is_prefix() method more in tests - Optimisations for file comparisons - Optimisations for directory creation - Typo fix in POD - Optimisations for tree traversal --- Porting/Maintainers.pl | 2 +- cpan/ExtUtils-Install/lib/ExtUtils/Install.pm | 150 +++++++----------- .../lib/ExtUtils/Installed.pm | 2 +- .../ExtUtils-Install/lib/ExtUtils/Packlist.pm | 2 +- cpan/ExtUtils-Install/t/Installed.t | 6 +- 5 files changed, 63 insertions(+), 99 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index d8d2294d6d29..32b4c238da48 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -453,7 +453,7 @@ package Maintainers; }, 'ExtUtils::Install' => { - 'DISTRIBUTION' => 'BINGOS/ExtUtils-Install-2.18.tar.gz', + 'DISTRIBUTION' => 'BINGOS/ExtUtils-Install-2.20.tar.gz', 'FILES' => q[cpan/ExtUtils-Install], 'EXCLUDED' => [ qw( t/lib/Test/Builder.pm diff --git a/cpan/ExtUtils-Install/lib/ExtUtils/Install.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Install.pm index 2fb43bc8d4f6..96081806f78f 100644 --- a/cpan/ExtUtils-Install/lib/ExtUtils/Install.pm +++ b/cpan/ExtUtils-Install/lib/ExtUtils/Install.pm @@ -32,11 +32,11 @@ ExtUtils::Install - install files from here to there =head1 VERSION -2.18 +2.20 =cut -our $VERSION = '2.18'; # <-- do not forget to update the POD section just above this line! +our $VERSION = '2.20'; # <-- do not forget to update the POD section just above this line! $VERSION = eval $VERSION; =pod @@ -65,26 +65,22 @@ anything depending on this module cannot proceed until a reboot has occurred. If this value is defined but false then such an operation has -ocurred, but should not impact later operations. - -=over +occurred, but should not impact later operations. =begin _private -=item _chmod($$;$) +=head2 _chmod($$;$) Wrapper to chmod() for debugging and error trapping. -=item _warnonce(@) +=head2 _warnonce(@) Warns about something only once. -=item _choke(@) +=head2 _choke(@) Dies with a special message. -=back - =end _private =cut @@ -137,8 +133,12 @@ sub _confess { } sub _compare { - require File::Compare; - File::Compare::compare(@_); + # avoid loading File::Compare in the common case + if (-f $_[1] && -s _ == -s $_[0]) { + require File::Compare; + return File::Compare::compare(@_); + } + return 1; } @@ -157,9 +157,7 @@ sub _chmod($$;$) { =begin _private -=over - -=item _move_file_at_boot( $file, $target, $moan ) +=head2 _move_file_at_boot( $file, $target, $moan ) OS-Specific, Win32/Cygwin @@ -231,8 +229,7 @@ If $moan is true then returns 0 on error and warns instead of dies. =begin _private - -=item _unlink_or_rename( $file, $tryhard, $installing ) +=head2 _unlink_or_rename( $file, $tryhard, $installing ) OS-Specific, Win32/Cygwin @@ -263,8 +260,6 @@ On failure throws a fatal error. =cut - - sub _unlink_or_rename { #XXX OS-SPECIFIC my ( $file, $tryhard, $installing )= @_; @@ -310,25 +305,16 @@ sub _unlink_or_rename { #XXX OS-SPECIFIC } - -=pod - -=back - -=head2 Functions +=head1 Functions =begin _private -=over - -=item _get_install_skip +=head2 _get_install_skip Handles loading the INSTALL.SKIP file. Returns an array of patterns to use. =cut - - sub _get_install_skip { my ( $skip, $verbose )= @_; if ($ENV{EU_INSTALL_IGNORE_SKIP}) { @@ -378,9 +364,7 @@ sub _get_install_skip { return $skip } -=pod - -=item _have_write_access +=head2 _have_write_access Abstract a -w check that tries to use POSIX::access() if possible. @@ -402,9 +386,7 @@ Abstract a -w check that tries to use POSIX::access() if possible. } } -=pod - -=item _can_write_dir(C<$dir>) +=head2 _can_write_dir(C<$dir>) Checks whether a given directory is writable, taking account the possibility that the directory might not exist and would have to @@ -423,7 +405,6 @@ relative paths with C<..> in them. But for our purposes it should work ok =cut - sub _can_write_dir { my $dir=shift; return @@ -461,9 +442,7 @@ sub _can_write_dir { return 0; } -=pod - -=item _mkpath($dir,$show,$mode,$verbose,$dry_run) +=head2 _mkpath($dir,$show,$mode,$verbose,$dry_run) Wrapper around File::Path::mkpath() to handle errors. @@ -486,10 +465,16 @@ sub _mkpath { printf "mkpath(%s,%d,%#o)\n", $dir, $show, $mode; } if (!$dry_run) { - if ( ! eval { File::Path::mkpath($dir,$show,$mode); 1 } ) { - _choke("Can't create '$dir'","$@"); + my @created; + eval { + @created = File::Path::mkpath($dir,$show,$mode); + 1; + } or _choke("Can't create '$dir'","$@"); + # if we created any directories, we were able to write and don't need + # extra checks + if (@created) { + return; } - } my ($can,$root,@make)=_can_write_dir($dir); if (!$can) { @@ -509,9 +494,7 @@ sub _mkpath { } -=pod - -=item _copy($from,$to,$verbose,$dry_run) +=head2 _copy($from,$to,$verbose,$dry_run) Wrapper around File::Copy::copy to handle errors. @@ -523,7 +506,6 @@ Dies if the copy fails. =cut - sub _copy { my ( $from, $to, $verbose, $dry_run)=@_; if ($verbose && $verbose>1) { @@ -537,7 +519,7 @@ sub _copy { =pod -=item _chdir($from) +=head2 _chdir($from) Wrapper around chdir to catch errors. @@ -558,15 +540,9 @@ sub _chdir { return $ret; } -=pod - -=back - =end _private -=over - -=item B +=head2 install # deprecated forms install(\%from_to); @@ -774,15 +750,9 @@ sub install { #XXX OS-SPECIFIC } # we have to do this for back compat with old File::Finds # and because the target is relative - my $save_cwd = _chdir($cwd); - my $diff = 0; - # XXX: I wonder how useful this logic is actually -- demerphq - if ( $always_copy or !-f $targetfile or -s $targetfile != $size) { - $diff++; - } else { - # we might not need to copy this file - $diff = _compare($sourcefile, $targetfile); - } + my $save_cwd = File::Spec->catfile($cwd, $sourcedir); + _chdir($cwd); + my $diff = $always_copy || _compare($sourcefile, $targetfile); $check_dirs{$targetdir}++ unless -w $targetfile; @@ -864,7 +834,7 @@ sub install { #XXX OS-SPECIFIC =begin _private -=item _do_cleanup +=head2 _do_cleanup Standardize finish event for after another instruction has occurred. Handles converting $MUST_REBOOT to a die for instance. @@ -887,12 +857,12 @@ sub _do_cleanup { =begin _undocumented -=item install_rooted_file( $file ) +=head2 install_rooted_file( $file ) Returns $file, or catfile($INSTALL_ROOT,$file) if $INSTALL_ROOT is defined. -=item install_rooted_dir( $dir ) +=head2 install_rooted_dir( $dir ) Returns $dir, or catdir($INSTALL_ROOT,$dir) if $INSTALL_ROOT is defined. @@ -901,7 +871,6 @@ is defined. =cut - sub install_rooted_file { if (defined $INSTALL_ROOT) { File::Spec->catfile($INSTALL_ROOT, $_[0]); @@ -921,7 +890,7 @@ sub install_rooted_dir { =begin _undocumented -=item forceunlink( $file, $tryhard ) +=head2 forceunlink( $file, $tryhard ) Tries to delete a file. If $tryhard is true then we will use whatever devious tricks we can to delete the file. Currently this only applies to @@ -932,7 +901,6 @@ reboot. A wrapper for _unlink_or_rename(). =cut - sub forceunlink { my ( $file, $tryhard )= @_; #XXX OS-SPECIFIC _unlink_or_rename( $file, $tryhard, not("installing") ); @@ -940,7 +908,7 @@ sub forceunlink { =begin _undocumented -=item directory_not_empty( $dir ) +=head2 directory_not_empty( $dir ) Returns 1 if there is an .exists file somewhere in a directory tree. Returns 0 if there is not. @@ -963,9 +931,9 @@ sub directory_not_empty ($) { return $files; } -=pod +=head2 install_default -=item B I +I install_default(); install_default($fullext); @@ -1019,7 +987,7 @@ sub install_default { } -=item B +=head2 uninstall uninstall($packlist_file); uninstall($packlist_file, $verbose, $dont_execute); @@ -1057,7 +1025,7 @@ sub uninstall { =begin _undocumented -=item inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results) +=head2 inc_uninstall($filepath,$libdir,$verbose,$dry_run,$ignore,$results) Remove shadowed files. If $ignore is true then it is assumed to hold a filename to ignore. This is used to prevent spurious warnings from @@ -1103,13 +1071,8 @@ sub inc_uninstall { # The reason why we compare file's contents is, that we cannot # know, which is the file we just installed (AFS). So we leave # an identical file in place - my $diff = 0; - if ( -f $targetfile && -s _ == -s $filepath) { - # We have a good chance, we can skip this one - $diff = _compare($filepath,$targetfile); - } else { - $diff++; - } + my $diff = _compare($filepath,$targetfile); + print "#$file and $targetfile differ\n" if $diff && $verbose > 1; if (!$diff or $targetfile eq $ignore) { @@ -1150,7 +1113,7 @@ sub inc_uninstall { =begin _undocumented -=item run_filter($cmd,$src,$dest) +=head2 run_filter($cmd,$src,$dest) Filter $src using $cmd into $dest. @@ -1172,9 +1135,7 @@ sub run_filter { close CMD or die "Filter command '$cmd' failed for $src"; } -=pod - -=item B +=head2 pm_to_blib pm_to_blib(\%from_to); pm_to_blib(\%from_to, $autosplit_dir); @@ -1199,6 +1160,7 @@ environment variable will silence this output. sub pm_to_blib { my($fromto,$autodir,$pm_filter) = @_; + my %dirs; _mkpath($autodir,0,0755) if defined $autodir; while(my($from, $to) = each %$fromto) { if( -f $to && -s $from == -s $to && -M $to < -M $from ) { @@ -1214,7 +1176,7 @@ sub pm_to_blib { my $need_filtering = defined $pm_filter && length $pm_filter && $from =~ /\.pm$/; - if (!$need_filtering && 0 == _compare($from,$to)) { + if (!$need_filtering && !_compare($from,$to)) { print "Skip $to (unchanged)\n" unless $INSTALL_QUIET; next; } @@ -1222,7 +1184,10 @@ sub pm_to_blib { # we wont try hard here. its too likely to mess things up. forceunlink($to); } else { - _mkpath(dirname($to),0,0755); + my $dirname = dirname($to); + if (!$dirs{$dirname}++) { + _mkpath($dirname,0,0755); + } } if ($need_filtering) { run_filter($pm_filter, $from, $to); @@ -1239,10 +1204,9 @@ sub pm_to_blib { } } - =begin _private -=item _autosplit +=head2 _autosplit From 1.0307 back, AutoSplit will sometimes leave an open filehandle to the file being split. This causes problems on systems with mandatory @@ -1293,7 +1257,7 @@ sub DESTROY { =begin _private -=item _invokant +=head2 _invokant Does a heuristic on the stack to see who called us for more intelligent error messages. Currently assumes we will be called only by Module::Build @@ -1320,10 +1284,6 @@ sub _invokant { return $builder; } -=pod - -=back - =head1 ENVIRONMENT =over 4 diff --git a/cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm index f12ea23f19bf..0cfd96b507d4 100644 --- a/cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm +++ b/cpan/ExtUtils-Install/lib/ExtUtils/Installed.pm @@ -15,7 +15,7 @@ my $DOSISH = ($^O =~ /^(MSWin\d\d|os2|dos|mint)$/); require VMS::Filespec if $Is_VMS; -our $VERSION = '2.18'; +our $VERSION = '2.20'; $VERSION = eval $VERSION; sub _is_prefix { diff --git a/cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm b/cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm index f975b41b042a..98d09e3d8208 100644 --- a/cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm +++ b/cpan/ExtUtils-Install/lib/ExtUtils/Packlist.pm @@ -4,7 +4,7 @@ use strict; use Carp qw(); use Config; our $Relocations; -our $VERSION = '2.18'; +our $VERSION = '2.20'; $VERSION = eval $VERSION; # Used for generating filehandle globs. IO::File might not be available! diff --git a/cpan/ExtUtils-Install/t/Installed.t b/cpan/ExtUtils-Install/t/Installed.t index 5cf7b80cafdd..7d7bf243d366 100644 --- a/cpan/ExtUtils-Install/t/Installed.t +++ b/cpan/ExtUtils-Install/t/Installed.t @@ -18,7 +18,7 @@ use File::Basename; use File::Spec; use File::Temp qw[tempdir]; -use Test::More tests => 74; +use Test::More tests => 76; BEGIN { use_ok( 'ExtUtils::Installed' ) } @@ -36,6 +36,10 @@ ok( $ei->_is_prefix('foo/bar', 'foo'), '_is_prefix() should match valid path prefix' ); ok( !$ei->_is_prefix('\foo\bar', '\bar'), '... should not match wrong prefix' ); +ok( ! defined $ei->_is_prefix( undef, 'foo' ), + '_is_prefix() needs two defined arguments' ); +ok( ! defined $ei->_is_prefix( 'foo/bar', undef ), + '_is_prefix() needs two defined arguments' ); # _is_type ok( $ei->_is_type(0, 'all'), '_is_type() should be true for type of "all"' ); From 61e2e049965cfb5d8e708b7bf8fba901f6622961 Mon Sep 17 00:00:00 2001 From: Thibault DUPONCHELLE Date: Fri, 18 Dec 2020 14:27:53 +0100 Subject: [PATCH 243/503] Fix RT number in perl5260delta.pod --- pod/perl5260delta.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perl5260delta.pod b/pod/perl5260delta.pod index 69c62ee6994c..a1a4bbd03cfc 100644 --- a/pod/perl5260delta.pod +++ b/pod/perl5260delta.pod @@ -2630,7 +2630,7 @@ L<[perl #126697]|https://rt.perl.org/Public/Bug/Display.html?id=126697> Using C to modify a magic variable could access freed memory in some cases. -L<[perl #129340]|https://rt.perl.org/Public/Bug/Display.html?id=129340> +L<[perl #130766]|https://rt.perl.org/Public/Bug/Display.html?id=130766> =item * From edd16cfcff2bae43fa676aa4880e03c16fda3133 Mon Sep 17 00:00:00 2001 From: "H.Merijn Brand" Date: Fri, 18 Dec 2020 16:41:30 +0100 Subject: [PATCH 244/503] Update Config::Perl::V to 0.33 --- MANIFEST | 4 + Porting/Maintainers.pl | 3 +- cpan/Config-Perl-V/V.pm | 165 +++++++++++------------ cpan/Config-Perl-V/t/35_plv52910g.t | 188 +++++++++++++++++++++++++++ cpan/Config-Perl-V/t/36_plv5300.t | 182 ++++++++++++++++++++++++++ cpan/Config-Perl-V/t/37_plv53111qm.t | 186 ++++++++++++++++++++++++++ cpan/Config-Perl-V/t/38_plv5320tld.t | 182 ++++++++++++++++++++++++++ t/porting/customized.dat | 1 - 8 files changed, 826 insertions(+), 85 deletions(-) create mode 100644 cpan/Config-Perl-V/t/35_plv52910g.t create mode 100644 cpan/Config-Perl-V/t/36_plv5300.t create mode 100644 cpan/Config-Perl-V/t/37_plv53111qm.t create mode 100644 cpan/Config-Perl-V/t/38_plv5320tld.t diff --git a/MANIFEST b/MANIFEST index c3adc8d1c0c3..2bf07c959c81 100644 --- a/MANIFEST +++ b/MANIFEST @@ -248,6 +248,10 @@ cpan/Config-Perl-V/t/31_plv52511.t Config::Perl::V cpan/Config-Perl-V/t/32_plv5261rc1.t Config::Perl::V cpan/Config-Perl-V/t/33_plv52711r.t Config::Perl::V cpan/Config-Perl-V/t/34_plv5280.t Config::Perl::V +cpan/Config-Perl-V/t/35_plv52910g.t Config::Perl::V +cpan/Config-Perl-V/t/36_plv5300.t Config::Perl::V +cpan/Config-Perl-V/t/37_plv53111qm.t Config::Perl::V +cpan/Config-Perl-V/t/38_plv5320tld.t Config::Perl::V cpan/Config-Perl-V/V.pm Config::Perl::V cpan/CPAN/lib/App/Cpan.pm helper package for CPAN.pm cpan/CPAN/lib/CPAN.pm Interface to Comprehensive Perl Archive Network diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 32b4c238da48..42abcd564366 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -224,12 +224,11 @@ package Maintainers; }, 'Config::Perl::V' => { - 'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.31.tgz', + 'DISTRIBUTION' => 'HMBRAND/Config-Perl-V-0.33.tgz', 'FILES' => q[cpan/Config-Perl-V], 'EXCLUDED' => [qw( examples/show-v.pl )], - 'CUSTOMIZED' => [ qw(V.pm) ], }, 'constant' => { diff --git a/cpan/Config-Perl-V/V.pm b/cpan/Config-Perl-V/V.pm index dbb0f88ec157..774446a83f66 100644 --- a/cpan/Config-Perl-V/V.pm +++ b/cpan/Config-Perl-V/V.pm @@ -6,12 +6,12 @@ use warnings; use Config; use Exporter; use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS); -$VERSION = "0.32"; +$VERSION = "0.33"; @ISA = qw( Exporter ); @EXPORT_OK = qw( plv2hash summary myconfig signature ); %EXPORT_TAGS = ( - all => [ @EXPORT_OK ], - sig => [ "signature" ], + 'all' => [ @EXPORT_OK ], + 'sig' => [ "signature" ], ); # Characteristics of this binary (from libperl): @@ -24,7 +24,7 @@ $VERSION = "0.32"; # perl -ne'(/^S_Internals_V/../^}/)&&s/^\s+"( .*)"/$1/ and print' perl.c # perl.h line 4566 PL_bincompat_options # perl -ne'(/^\w.*PL_bincompat/../^\w}/)&&s/^\s+"( .*)"/$1/ and print' perl.h -my %BTD = map { $_ => 0 } qw( +my %BTD = map {( $_ => 0 )} qw( DEBUGGING NO_HASH_SEED @@ -183,52 +183,52 @@ my @config_vars = qw( ); my %empty_build = ( - osname => "", - stamp => 0, - options => { %BTD }, - patches => [], + 'osname' => "", + 'stamp' => 0, + 'options' => { %BTD }, + 'patches' => [], ); sub _make_derived { my $conf = shift; - for ( [ lseektype => "Off_t" ], - [ myuname => "uname" ], - [ perl_patchlevel => "patch" ], + for ( [ 'lseektype' => "Off_t" ], + [ 'myuname' => "uname" ], + [ 'perl_patchlevel' => "patch" ], ) { - my ($official, $derived) = @$_; - $conf->{config}{$derived} ||= $conf->{config}{$official}; - $conf->{config}{$official} ||= $conf->{config}{$derived}; - $conf->{derived}{$derived} = delete $conf->{config}{$derived}; + my ($official, $derived) = @{$_}; + $conf->{'config'}{$derived} ||= $conf->{'config'}{$official}; + $conf->{'config'}{$official} ||= $conf->{'config'}{$derived}; + $conf->{'derived'}{$derived} = delete $conf->{'config'}{$derived}; } - if (exists $conf->{config}{version_patchlevel_string} && - !exists $conf->{config}{api_version}) { - my $vps = $conf->{config}{version_patchlevel_string}; + if (exists $conf->{'config'}{'version_patchlevel_string'} && + !exists $conf->{'config'}{'api_version'}) { + my $vps = $conf->{'config'}{'version_patchlevel_string'}; $vps =~ s{\b revision \s+ (\S+) }{}x and - $conf->{config}{revision} ||= $1; + $conf->{'config'}{'revision'} ||= $1; $vps =~ s{\b version \s+ (\S+) }{}x and - $conf->{config}{api_version} ||= $1; + $conf->{'config'}{'api_version'} ||= $1; $vps =~ s{\b subversion \s+ (\S+) }{}x and - $conf->{config}{subversion} ||= $1; + $conf->{'config'}{'subversion'} ||= $1; $vps =~ s{\b patch \s+ (\S+) }{}x and - $conf->{config}{perl_patchlevel} ||= $1; + $conf->{'config'}{'perl_patchlevel'} ||= $1; } - ($conf->{config}{version_patchlevel_string} ||= join " ", - map { ($_, $conf->{config}{$_} ) } - grep { $conf->{config}{$_} } + ($conf->{'config'}{'version_patchlevel_string'} ||= join " ", + map { ($_, $conf->{'config'}{$_} ) } + grep { $conf->{'config'}{$_} } qw( api_version subversion perl_patchlevel )) =~ s/\bperl_//; - $conf->{config}{perl_patchlevel} ||= ""; # 0 is not a valid patchlevel + $conf->{'config'}{'perl_patchlevel'} ||= ""; # 0 is not a valid patchlevel - if ($conf->{config}{perl_patchlevel} =~ m{^git\w*-([^-]+)}i) { - $conf->{config}{git_branch} ||= $1; - $conf->{config}{git_describe} ||= $conf->{config}{perl_patchlevel}; + if ($conf->{'config'}{'perl_patchlevel'} =~ m{^git\w*-([^-]+)}i) { + $conf->{'config'}{'git_branch'} ||= $1; + $conf->{'config'}{'git_describe'} ||= $conf->{'config'}{'perl_patchlevel'}; } - $conf->{config}{$_} ||= "undef" for grep m/^(?:use|def)/ => @config_vars; + $conf->{'config'}{$_} ||= "undef" for grep m{^(?:use|def)} => @config_vars; $conf; } # _make_derived @@ -238,20 +238,20 @@ sub plv2hash { my $pv = join "\n" => @_; - if ($pv =~ m/^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)/m) { - $config{"package"} = $1; + if ($pv =~ m{^Summary of my\s+(\S+)\s+\(\s*(.*?)\s*\)}m) { + $config{'package'} = $1; my $rev = $2; - $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{revision} = $1; - $rev and $config{version_patchlevel_string} = $rev; - my ($rel) = $config{"package"} =~ m{perl(\d)}; + $rev =~ s/^ revision \s+ (\S+) \s*//x and $config{'revision'} = $1; + $rev and $config{'version_patchlevel_string'} = $rev; + my ($rel) = $config{'package'} =~ m{perl(\d)}; my ($vers, $subvers) = $rev =~ m{version\s+(\d+)\s+subversion\s+(\d+)}; defined $vers && defined $subvers && defined $rel and - $config{version} = "$rel.$vers.$subvers"; + $config{'version'} = "$rel.$vers.$subvers"; } - if ($pv =~ m/^\s+(Snapshot of:)\s+(\S+)/) { - $config{git_commit_id_title} = $1; - $config{git_commit_id} = $2; + if ($pv =~ m{^\s+(Snapshot of:)\s+(\S+)}) { + $config{'git_commit_id_title'} = $1; + $config{'git_commit_id'} = $2; } # these are always last on line and can have multiple quotation styles @@ -275,11 +275,11 @@ sub plv2hash { }gx)) { # between every kv pair while (my ($k, $v) = each %kv) { - $k =~ s/\s+$//; - $v =~ s/\s*\n\z//; - $v =~ s/,$//; - $v =~ m/^'(.*)'$/ and $v = $1; - $v =~ s/\s+$//; + $k =~ s{\s+$} {}; + $v =~ s{\s*\n\z} {}; + $v =~ s{,$} {}; + $v =~ m{^'(.*)'$} and $v = $1; + $v =~ s{\s+$} {}; $config{$k} = $v; } } @@ -287,36 +287,36 @@ sub plv2hash { my $build = { %empty_build }; $pv =~ m{^\s+Compiled at\s+(.*)}m - and $build->{stamp} = $1; + and $build->{'stamp'} = $1; $pv =~ m{^\s+Locally applied patches:(?:\s+|\n)(.*?)(?:[\s\n]+Buil[td] under)}ms - and $build->{patches} = [ split m/\n+\s*/, $1 ]; + and $build->{'patches'} = [ split m{\n+\s*}, $1 ]; $pv =~ m{^\s+Compile-time options:(?:\s+|\n)(.*?)(?:[\s\n]+(?:Locally applied|Buil[td] under))}ms - and map { $build->{options}{$_} = 1 } split m/\s+|\n/ => $1; + and map { $build->{'options'}{$_} = 1 } split m{\s+|\n} => $1; - $build->{osname} = $config{osname}; + $build->{'osname'} = $config{'osname'}; $pv =~ m{^\s+Built under\s+(.*)}m - and $build->{osname} = $1; - $config{osname} ||= $build->{osname}; + and $build->{'osname'} = $1; + $config{'osname'} ||= $build->{'osname'}; return _make_derived ({ - build => $build, - environment => {}, - config => \%config, - derived => {}, - inc => [], + 'build' => $build, + 'environment' => {}, + 'config' => \%config, + 'derived' => {}, + 'inc' => [], }); } # plv2hash sub summary { my $conf = shift || myconfig (); ref $conf eq "HASH" - && exists $conf->{config} - && exists $conf->{build} - && ref $conf->{config} eq "HASH" - && ref $conf->{build} eq "HASH" or return; + && exists $conf->{'config'} + && exists $conf->{'build'} + && ref $conf->{'config'} eq "HASH" + && ref $conf->{'build'} eq "HASH" or return; my %info = map { - exists $conf->{config}{$_} ? ( $_ => $conf->{config}{$_} ) : () } + exists $conf->{'config'}{$_} ? ( $_ => $conf->{'config'}{$_} ) : () } qw( archname osname osvers revision patchlevel subversion version cc ccversion gccversion config_args inc_version_list d_longdbl d_longlong use64bitall use64bitint useithreads @@ -324,7 +324,7 @@ sub summary { doublesize intsize ivsize nvsize longdblsize longlongsize lseeksize default_inc_excludes_dot ); - $info{$_}++ for grep { $conf->{build}{options}{$_} } keys %{$conf->{build}{options}}; + $info{$_}++ for grep { $conf->{'build'}{'options'}{$_} } keys %{$conf->{'build'}{'options'}}; return \%info; } # summary @@ -336,19 +336,19 @@ sub signature { eval { require Digest::MD5 }; $@ and return $no_md5; - $conf->{cc} =~ s{.*\bccache\s+}{}; - $conf->{cc} =~ s{.*[/\\]}{}; + $conf->{'cc'} =~ s{.*\bccache\s+}{}; + $conf->{'cc'} =~ s{.*[/\\]}{}; - delete $conf->{config_args}; + delete $conf->{'config_args'}; return Digest::MD5::md5_hex (join "\xFF" => map { "$_=".(defined $conf->{$_} ? $conf->{$_} : "\xFE"); - } sort keys %$conf); + } sort keys %{$conf}); } # signature sub myconfig { my $args = shift; - my %args = ref $args eq "HASH" ? %$args : - ref $args eq "ARRAY" ? @$args : (); + my %args = ref $args eq "HASH" ? %{$args} : + ref $args eq "ARRAY" ? @{$args} : (); my $build = { %empty_build }; @@ -356,33 +356,34 @@ sub myconfig { my $stamp = eval { Config::compile_date () }; if (defined $stamp) { $stamp =~ s/^Compiled at //; - $build->{osname} = $^O; - $build->{stamp} = $stamp; - $build->{patches} = [ Config::local_patches () ]; - $build->{options}{$_} = 1 for Config::bincompat_options (), - Config::non_bincompat_options (); + $build->{'osname'} = $^O; + $build->{'stamp'} = $stamp; + $build->{'patches'} = [ Config::local_patches () ]; + $build->{'options'}{$_} = 1 for Config::bincompat_options (), + Config::non_bincompat_options (); } else { #y $pv = qx[$^X -e"sub Config::myconfig{};" -V]; my $cnf = plv2hash (qx[$^X -V]); - $build->{$_} = $cnf->{build}{$_} for qw( osname stamp patches options ); + $build->{$_} = $cnf->{'build'}{$_} for qw( osname stamp patches options ); } my @KEYS = keys %ENV; my %env = - map { $_ => $ENV{$_} } grep m/^PERL/ => @KEYS; - $args{env} and - map { $env{$_} = $ENV{$_} } grep m{$args{env}} => @KEYS; + map {( $_ => $ENV{$_} )} grep m{^PERL} => @KEYS; + if ($args{'env'}) { + $env{$_} = $ENV{$_} for grep m{$args{'env'}} => @KEYS; + } my %config = map { $_ => $Config{$_} } @config_vars; return _make_derived ({ - build => $build, - environment => \%env, - config => \%config, - derived => {}, - inc => \@INC, + 'build' => $build, + 'environment' => \%env, + 'config' => \%config, + 'derived' => {}, + 'inc' => \@INC, }); } # myconfig @@ -553,7 +554,7 @@ H.Merijn Brand =head1 COPYRIGHT AND LICENSE -Copyright (C) 2009-2018 H.Merijn Brand +Copyright (C) 2009-2020 H.Merijn Brand This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/Config-Perl-V/t/35_plv52910g.t b/cpan/Config-Perl-V/t/35_plv52910g.t new file mode 100644 index 000000000000..6d822d1cb280 --- /dev/null +++ b/cpan/Config-Perl-V/t/35_plv52910g.t @@ -0,0 +1,188 @@ +#!/pro/bin/perl + +use strict; +use warnings; + +BEGIN { + use Test::More; + my $tests = 128; + unless ($ENV{PERL_CORE}) { + require Test::NoWarnings; + Test::NoWarnings->import (); + $tests++; + } + + plan tests => $tests; + } + +use Config::Perl::V qw( summary ); + +ok (my $conf = Config::Perl::V::plv2hash (), "Read perl -v block"); +ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); + +is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); +is ($conf->{build}{stamp}, "Apr 13 2019 00:06:38", "Build time"); +is ($conf->{config}{version}, "5.29.10", "reconstructed \$Config{version}"); + +my $opt = Config::Perl::V::plv2hash ("")->{build}{options}; +foreach my $o (sort qw( + DEBUGGING HAS_TIMES MULTIPLICITY PERL_COPY_ON_WRITE PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT PERLIO_LAYERS PERL_MALLOC_WRAP PERL_OP_PARENT + PERL_PRESERVE_IVUV PERL_TRACK_MEMPOOL PERL_USE_DEVEL USE_64_BIT_ALL + USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE + USE_LOCALE_CTYPE USE_LOCALE_NUMERIC USE_LOCALE_TIME USE_LONG_DOUBLE + USE_PERL_ATOF USE_PERLIO USE_REENTRANT_API USE_THREAD_SAFE_LOCALE + )) { + is ($conf->{build}{options}{$o}, 1, "Runtime option $o set"); + delete $opt->{$o}; + } +foreach my $o (sort keys %$opt) { + is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset"); + } + +eval { require Digest::MD5; }; +my $md5 = $@ ? "0" x 32 : "8404b533829bd9752df7f662a710f993"; +ok (my $sig = Config::Perl::V::signature ($conf), "Get signature"); +is ($sig, $md5, "MD5"); + +is_deeply ($conf->{build}{patches}, [ + "SMOKEdfba4714a9dc4c35123b4df0a5e1721ccb081d97" ], "No local patches"); + +my %check = ( + alignbytes => 16, + api_version => 29, + bincompat5005 => "undef", + byteorder => 12345678, + cc => "g++", + cccdlflags => "-fPIC", + ccdlflags => "-Wl,-E", + config_args => "-des -Dcc=g++ -Dusedevel -Duseithreads -Duse64bitall -Duselongdouble -DDEBUGGING", + gccversion => "8.3.1 20190226 [gcc-8-branch revision 269204]", + gnulibc_version => "2.29", + ivsize => 8, + ivtype => "long", + ld => "g++", + lddlflags => "-shared -O2 -g -L/pro/local/lib -fstack-protector-strong", + ldflags => "-L/pro/local/lib -fstack-protector-strong", + libc => "libc-2.29.so", + lseektype => "off_t", + osvers => "5.0.7-1-default", + use64bitall => "define", + use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "define", + ); +is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; + +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "define", "This build has . NOT in INC"); + +__END__ +Summary of my perl5 (revision 5 version 29 subversion 10) configuration: + Snapshot of: dfba4714a9dc4c35123b4df0a5e1721ccb081d97 + Platform: + osname=linux + osvers=5.0.7-1-default + archname=x86_64-linux-thread-multi-ld + uname='linux lx09 5.0.7-1-default #1 smp sat apr 6 14:47:49 utc 2019 (8f18342) x86_64 x86_64 x86_64 gnulinux ' + config_args='-des -Dcc=g++ -Dusedevel -Duseithreads -Duse64bitall -Duselongdouble -DDEBUGGING' + hint=recommended + useposix=true + d_sigaction=define + useithreads=define + usemultiplicity=define + use64bitint=define + use64bitall=define + uselongdouble=define + usemymalloc=n + default_inc_excludes_dot=define + bincompat5005=undef + Compiler: + cc='g++' + ccflags ='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2' + optimize='-O2 -g' + cppflags='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -DDEBUGGING -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include' + ccversion='' + gccversion='8.3.1 20190226 [gcc-8-branch revision 269204]' + gccosandvers='' + intsize=4 + longsize=8 + ptrsize=8 + doublesize=8 + byteorder=12345678 + doublekind=3 + d_longlong=define + longlongsize=8 + d_longdbl=define + longdblsize=16 + longdblkind=3 + ivtype='long' + ivsize=8 + nvtype='long double' + nvsize=16 + Off_t='off_t' + lseeksize=8 + alignbytes=16 + prototype=define + Linker and Libraries: + ld='g++' + ldflags ='-L/pro/local/lib -fstack-protector-strong' + libpth=/usr/include/c++/8 /usr/include/c++/8/x86_64-suse-linux /usr/include/c++/8/backward /usr/local/lib /usr/lib64/gcc/x86_64-suse-linux/8/include-fixed /usr/lib64/gcc/x86_64-suse-linux/8/../../../../x86_64-suse-linux/lib /usr/lib /pro/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /lib64 /usr/lib64 /usr/local/lib64 + libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat + perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc + libc=libc-2.29.so + so=so + useshrplib=false + libperl=libperl.a + gnulibc_version='2.29' + Dynamic Linking: + dlsrc=dl_dlopen.xs + dlext=so + d_dlsymun=undef + ccdlflags='-Wl,-E' + cccdlflags='-fPIC' + lddlflags='-shared -O2 -g -L/pro/local/lib -fstack-protector-strong' + + +Characteristics of this binary (from libperl): + Compile-time options: + DEBUGGING + HAS_TIMES + MULTIPLICITY + PERLIO_LAYERS + PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP + PERL_OP_PARENT + PERL_PRESERVE_IVUV + PERL_TRACK_MEMPOOL + PERL_USE_DEVEL + USE_64_BIT_ALL + USE_64_BIT_INT + USE_ITHREADS + USE_LARGE_FILES + USE_LOCALE + USE_LOCALE_COLLATE + USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC + USE_LOCALE_TIME + USE_LONG_DOUBLE + USE_PERLIO + USE_PERL_ATOF + USE_REENTRANT_API + USE_THREAD_SAFE_LOCALE + Locally applied patches: + SMOKEdfba4714a9dc4c35123b4df0a5e1721ccb081d97 + Built under linux + Compiled at Apr 13 2019 00:06:38 + %ENV: + PERL6LIB="inst#/pro/3gl/CPAN/rakudo/install" + @INC: + lib + /opt/perl/lib/site_perl/5.29.10/x86_64-linux-thread-multi-ld + /opt/perl/lib/site_perl/5.29.10 + /opt/perl/lib/5.29.10/x86_64-linux-thread-multi-ld + /opt/perl/lib/5.29.10 diff --git a/cpan/Config-Perl-V/t/36_plv5300.t b/cpan/Config-Perl-V/t/36_plv5300.t new file mode 100644 index 000000000000..6db751245f3c --- /dev/null +++ b/cpan/Config-Perl-V/t/36_plv5300.t @@ -0,0 +1,182 @@ +#!/pro/bin/perl + +use strict; +use warnings; + +BEGIN { + use Test::More; + my $tests = 128; + unless ($ENV{PERL_CORE}) { + require Test::NoWarnings; + Test::NoWarnings->import (); + $tests++; + } + + plan tests => $tests; + } + +use Config::Perl::V qw( summary ); + +ok (my $conf = Config::Perl::V::plv2hash (), "Read perl -v block"); +ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); + +is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); +is ($conf->{build}{stamp}, "May 23 2019 14:05:36", "Build time"); +is ($conf->{config}{version}, "5.30.0", "reconstructed \$Config{version}"); + +my $opt = Config::Perl::V::plv2hash ("")->{build}{options}; +foreach my $o (sort qw( + HAS_TIMES MULTIPLICITY PERLIO_LAYERS PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP + PERL_OP_PARENT PERL_PRESERVE_IVUV USE_THREAD_SAFE_LOCALE + USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES + USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE USE_LOCALE_NUMERIC + USE_LOCALE_TIME USE_LONG_DOUBLE USE_PERLIO USE_PERL_ATOF + USE_REENTRANT_API + )) { + is ($conf->{build}{options}{$o}, 1, "Runtime option $o set"); + delete $opt->{$o}; + } +foreach my $o (sort keys %$opt) { + is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset"); + } + +eval { require Digest::MD5; }; +my $md5 = $@ ? "0" x 32 : "b1138522685da4fff74f7b1118128d02"; +ok (my $sig = Config::Perl::V::signature ($conf), "Get signature"); +is ($sig, $md5, "MD5"); + +is_deeply ($conf->{build}{patches}, [ ], "No patches"); + +my %check = ( + alignbytes => 16, + api_version => 30, + bincompat5005 => "undef", + byteorder => 12345678, + cc => "cc", + cccdlflags => "-fPIC", + ccdlflags => "-Wl,-E -Wl,-rpath,/pro/lib/perl5/5.30.0/x86_64-linux-thread-multi-ld/CORE", + config_args => "-Dusethreads -Duseithreads -Duse64bitall -Duselongdouble -Duseshrplib -des", + gccversion => "8.3.1 20190226 [gcc-8-branch revision 269204]", + gnulibc_version => "2.29", + ivsize => 8, + ivtype => "long", + ld => "cc", + lddlflags => "-shared -O2 -L/pro/local/lib -fstack-protector-strong", + ldflags => "-L/pro/local/lib -fstack-protector-strong", + libc => "libc-2.29.so", + lseektype => "off_t", + osvers => "5.1.3-1-default", + use64bitall => "define", + use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "define", + ); +is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; + +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "define", "This build has . NOT in INC"); + +__END__ +Summary of my perl5 (revision 5 version 30 subversion 0) configuration: + + Platform: + osname=linux + osvers=5.1.3-1-default + archname=x86_64-linux-thread-multi-ld + uname='linux lx09 5.1.3-1-default #1 smp fri may 17 04:54:29 utc 2019 (07d2e25) x86_64 x86_64 x86_64 gnulinux ' + config_args='-Dusethreads -Duseithreads -Duse64bitall -Duselongdouble -Duseshrplib -des' + hint=recommended + useposix=true + d_sigaction=define + useithreads=define + usemultiplicity=define + use64bitint=define + use64bitall=define + uselongdouble=define + usemymalloc=n + default_inc_excludes_dot=define + bincompat5005=undef + Compiler: + cc='cc' + ccflags ='-D_REENTRANT -D_GNU_SOURCE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2' + optimize='-O2' + cppflags='-D_REENTRANT -D_GNU_SOURCE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include' + ccversion='' + gccversion='8.3.1 20190226 [gcc-8-branch revision 269204]' + gccosandvers='' + intsize=4 + longsize=8 + ptrsize=8 + doublesize=8 + byteorder=12345678 + doublekind=3 + d_longlong=define + longlongsize=8 + d_longdbl=define + longdblsize=16 + longdblkind=3 + ivtype='long' + ivsize=8 + nvtype='long double' + nvsize=16 + Off_t='off_t' + lseeksize=8 + alignbytes=16 + prototype=define + Linker and Libraries: + ld='cc' + ldflags ='-L/pro/local/lib -fstack-protector-strong' + libpth=/usr/local/lib /usr/lib64/gcc/x86_64-suse-linux/8/include-fixed /usr/lib64/gcc/x86_64-suse-linux/8/../../../../x86_64-suse-linux/lib /usr/lib /pro/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /lib64 /usr/lib64 /usr/local/lib64 + libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat + perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc + libc=libc-2.29.so + so=so + useshrplib=true + libperl=libperl.so + gnulibc_version='2.29' + Dynamic Linking: + dlsrc=dl_dlopen.xs + dlext=so + d_dlsymun=undef + ccdlflags='-Wl,-E -Wl,-rpath,/pro/lib/perl5/5.30.0/x86_64-linux-thread-multi-ld/CORE' + cccdlflags='-fPIC' + lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector-strong' + + +Characteristics of this binary (from libperl): + Compile-time options: + HAS_TIMES + MULTIPLICITY + PERLIO_LAYERS + PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP + PERL_OP_PARENT + PERL_PRESERVE_IVUV + USE_64_BIT_ALL + USE_64_BIT_INT + USE_ITHREADS + USE_LARGE_FILES + USE_LOCALE + USE_LOCALE_COLLATE + USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC + USE_LOCALE_TIME + USE_LONG_DOUBLE + USE_PERLIO + USE_PERL_ATOF + USE_REENTRANT_API + USE_THREAD_SAFE_LOCALE + Built under linux + Compiled at May 23 2019 14:05:36 + %ENV: + PERL6LIB="inst#/pro/3gl/CPAN/rakudo/install" + @INC: + /pro/lib/perl5/site_perl/5.30.0/x86_64-linux-thread-multi-ld + /pro/lib/perl5/site_perl/5.30.0 + /pro/lib/perl5/5.30.0/x86_64-linux-thread-multi-ld + /pro/lib/perl5/5.30.0 diff --git a/cpan/Config-Perl-V/t/37_plv53111qm.t b/cpan/Config-Perl-V/t/37_plv53111qm.t new file mode 100644 index 000000000000..f566f7607b27 --- /dev/null +++ b/cpan/Config-Perl-V/t/37_plv53111qm.t @@ -0,0 +1,186 @@ +#!/pro/bin/perl + +use strict; +use warnings; + +BEGIN { + use Test::More; + my $tests = 128; + unless ($ENV{PERL_CORE}) { + require Test::NoWarnings; + Test::NoWarnings->import (); + $tests++; + } + + plan tests => $tests; + } + +use Config::Perl::V qw( summary ); + +ok (my $conf = Config::Perl::V::plv2hash (), "Read perl -v block"); +ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); + +is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); +is ($conf->{build}{stamp}, "Apr 9 2020 17:12:07", "Build time"); +is ($conf->{config}{version}, "5.31.11", "reconstructed \$Config{version}"); + +my $opt = Config::Perl::V::plv2hash ("")->{build}{options}; +foreach my $o (sort qw( + DEBUGGING HAS_TIMES MULTIPLICITY PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERLIO_LAYERS + PERL_MALLOC_WRAP PERL_OP_PARENT PERL_PRESERVE_IVUV PERL_TRACK_MEMPOOL + PERL_USE_DEVEL USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS + USE_LARGE_FILES USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC USE_LOCALE_TIME USE_PERL_ATOF USE_PERLIO + USE_QUADMATH USE_REENTRANT_API USE_THREAD_SAFE_LOCALE + )) { + is ($conf->{build}{options}{$o}, 1, "Runtime option $o set"); + delete $opt->{$o}; + } +foreach my $o (sort keys %$opt) { + is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset"); + } + +eval { require Digest::MD5; }; +my $md5 = $@ ? "0" x 32 : "146e648c6239f623b8a8242fc8b5759f"; +ok (my $sig = Config::Perl::V::signature ($conf), "Get signature"); +is ($sig, $md5, "MD5"); + +is_deeply ($conf->{build}{patches}, [ ], "No patches"); + +my %check = ( + alignbytes => 16, + api_version => 31, + bincompat5005 => "undef", + byteorder => 12345678, + cc => "cc", + cccdlflags => "-fPIC", + ccdlflags => "-Wl,-E", + config_args => "-Dusedevel -Duse64bitall -Dusethreads -Duseithreads -Dusequadmath -des", + gccversion => "10.0.1 20200302 (experimental) [revision 778a77357cad11e8dd4c810544330af0fbe843b1]", + gnulibc_version => "2.31", + ivsize => 8, + ivtype => "long", + ld => "cc", + lddlflags => "-shared -O2 -L/pro/local/lib -fstack-protector-strong", + ldflags => "-L/pro/local/lib -fstack-protector-strong", + libc => "libc-2.31.so", + lseektype => "off_t", + osvers => "5.6.2-1-default", + use64bitall => "define", + use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "define", + ); +is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; + +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "define", "This build has . NOT in INC"); + +__END__ +Summary of my perl5 (revision 5 version 31 subversion 11) configuration: + Snapshot of: +0300 + Platform: + osname=linux + osvers=5.6.2-1-default + archname=x86_64-linux-thread-multi-quadmath + uname='linux lx09 5.6.2-1-default #1 smp thu apr 2 06:31:32 utc 2020 (c8170d6) x86_64 x86_64 x86_64 gnulinux ' + config_args='-Dusedevel -Duse64bitall -Dusethreads -Duseithreads -Dusequadmath -des' + hint=recommended + useposix=true + d_sigaction=define + useithreads=define + usemultiplicity=define + use64bitint=define + use64bitall=define + uselongdouble=undef + usemymalloc=n + default_inc_excludes_dot=define + bincompat5005=undef + Compiler: + cc='cc' + ccflags ='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2' + optimize='-O2' + cppflags='-D_REENTRANT -D_GNU_SOURCE -fPIC -DDEBUGGING -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include' + ccversion='' + gccversion='10.0.1 20200302 (experimental) [revision 778a77357cad11e8dd4c810544330af0fbe843b1]' + gccosandvers='' + intsize=4 + longsize=8 + ptrsize=8 + doublesize=8 + byteorder=12345678 + doublekind=3 + d_longlong=define + longlongsize=8 + d_longdbl=define + longdblsize=16 + longdblkind=3 + ivtype='long' + ivsize=8 + nvtype='__float128' + nvsize=16 + Off_t='off_t' + lseeksize=8 + alignbytes=16 + prototype=define + Linker and Libraries: + ld='cc' + ldflags ='-L/pro/local/lib -fstack-protector-strong' + libpth=/usr/local/lib /usr/lib64/gcc/x86_64-suse-linux/10/include-fixed /usr/lib64/gcc/x86_64-suse-linux/10/../../../../x86_64-suse-linux/lib /usr/lib /pro/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /lib64 /usr/lib64 /usr/local/lib64 + libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat -lquadmath + perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc -lquadmath + libc=libc-2.31.so + so=so + useshrplib=false + libperl=libperl.a + gnulibc_version='2.31' + Dynamic Linking: + dlsrc=dl_dlopen.xs + dlext=so + d_dlsymun=undef + ccdlflags='-Wl,-E' + cccdlflags='-fPIC' + lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector-strong' + + +Characteristics of this binary (from libperl): + Compile-time options: + DEBUGGING + HAS_TIMES + MULTIPLICITY + PERLIO_LAYERS + PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP + PERL_OP_PARENT + PERL_PRESERVE_IVUV + PERL_TRACK_MEMPOOL + PERL_USE_DEVEL + USE_64_BIT_ALL + USE_64_BIT_INT + USE_ITHREADS + USE_LARGE_FILES + USE_LOCALE + USE_LOCALE_COLLATE + USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC + USE_LOCALE_TIME + USE_PERLIO + USE_PERL_ATOF + USE_QUADMATH + USE_REENTRANT_API + USE_THREAD_SAFE_LOCALE + Built under linux + Compiled at Apr 9 2020 17:12:07 + %ENV: + PERL6LIB="inst#/pro/3gl/CPAN/rakudo/install" + @INC: + lib + /pro/lib/perl5/site_perl/5.31.11/x86_64-linux-thread-multi-quadmath + /pro/lib/perl5/site_perl/5.31.11 + /pro/lib/perl5/5.31.11/x86_64-linux-thread-multi-quadmath + /pro/lib/perl5/5.31.11 diff --git a/cpan/Config-Perl-V/t/38_plv5320tld.t b/cpan/Config-Perl-V/t/38_plv5320tld.t new file mode 100644 index 000000000000..a8f0d736dc43 --- /dev/null +++ b/cpan/Config-Perl-V/t/38_plv5320tld.t @@ -0,0 +1,182 @@ +#!/pro/bin/perl + +use strict; +use warnings; + +BEGIN { + use Test::More; + my $tests = 128; + unless ($ENV{PERL_CORE}) { + require Test::NoWarnings; + Test::NoWarnings->import (); + $tests++; + } + + plan tests => $tests; + } + +use Config::Perl::V qw( summary ); + +ok (my $conf = Config::Perl::V::plv2hash (), "Read perl -v block"); +ok (exists $conf->{$_}, "Has $_ entry") for qw( build environment config inc ); + +is ($conf->{build}{osname}, $conf->{config}{osname}, "osname"); +is ($conf->{build}{stamp}, "Jun 21 2020 10:17:00", "Build time"); +is ($conf->{config}{version}, "5.32.0", "reconstructed \$Config{version}"); + +my $opt = Config::Perl::V::plv2hash ("")->{build}{options}; +foreach my $o (sort qw( + HAS_TIMES MULTIPLICITY PERLIO_LAYERS PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV PERL_IMPLICIT_CONTEXT PERL_MALLOC_WRAP + PERL_OP_PARENT PERL_PRESERVE_IVUV USE_THREAD_SAFE_LOCALE + USE_64_BIT_ALL USE_64_BIT_INT USE_ITHREADS USE_LARGE_FILES + USE_LOCALE USE_LOCALE_COLLATE USE_LOCALE_CTYPE USE_LOCALE_NUMERIC + USE_LOCALE_TIME USE_LONG_DOUBLE USE_PERLIO USE_PERL_ATOF + USE_REENTRANT_API + )) { + is ($conf->{build}{options}{$o}, 1, "Runtime option $o set"); + delete $opt->{$o}; + } +foreach my $o (sort keys %$opt) { + is ($conf->{build}{options}{$o}, 0, "Runtime option $o unset"); + } + +eval { require Digest::MD5; }; +my $md5 = $@ ? "0" x 32 : "901df8463a7bda6075bd75539214e75e"; +ok (my $sig = Config::Perl::V::signature ($conf), "Get signature"); +is ($sig, $md5, "MD5"); + +is_deeply ($conf->{build}{patches}, [ ], "No patches"); + +my %check = ( + alignbytes => 16, + api_version => 32, + bincompat5005 => "undef", + byteorder => 12345678, + cc => "cc", + cccdlflags => "-fPIC", + ccdlflags => "-Wl,-E -Wl,-rpath,/pro/lib/perl5/5.32.0/x86_64-linux-thread-multi-ld/CORE", + config_args => "-Dusethreads -Duseithreads -Duse64bitall -Duselongdouble -Duseshrplib -des", + gccversion => "10.1.1 20200507 [revision dd38686d9c810cecbaa80bb82ed91caaa58ad635]", + gnulibc_version => "2.31", + ivsize => 8, + ivtype => "long", + ld => "cc", + lddlflags => "-shared -O2 -L/pro/local/lib -fstack-protector-strong", + ldflags => "-L/pro/local/lib -fstack-protector-strong", + libc => "libc-2.31.so", + lseektype => "off_t", + osvers => "5.7.1-1-default", + use64bitall => "define", + use64bitint => "define", + usemymalloc => "n", + default_inc_excludes_dot + => "define", + ); +is ($conf->{config}{$_}, $check{$_}, "reconstructed \$Config{$_}") for sort keys %check; + +ok (my $info = summary ($conf), "A summary"); +ok (exists $info->{$_}, "Summary has $_") for qw( cc config_args usemymalloc default_inc_excludes_dot ); +is ($info->{default_inc_excludes_dot}, "define", "This build has . NOT in INC"); + +__END__ +Summary of my perl5 (revision 5 version 32 subversion 0) configuration: + + Platform: + osname=linux + osvers=5.7.1-1-default + archname=x86_64-linux-thread-multi-ld + uname='linux lx09 5.7.1-1-default #1 smp wed jun 10 11:53:46 utc 2020 (6a549f6) x86_64 x86_64 x86_64 gnulinux ' + config_args='-Dusethreads -Duseithreads -Duse64bitall -Duselongdouble -Duseshrplib -des' + hint=recommended + useposix=true + d_sigaction=define + useithreads=define + usemultiplicity=define + use64bitint=define + use64bitall=define + uselongdouble=define + usemymalloc=n + default_inc_excludes_dot=define + bincompat5005=undef + Compiler: + cc='cc' + ccflags ='-D_REENTRANT -D_GNU_SOURCE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 -D_FORTIFY_SOURCE=2' + optimize='-O2' + cppflags='-D_REENTRANT -D_GNU_SOURCE -fPIC -fwrapv -fno-strict-aliasing -pipe -fstack-protector-strong -I/pro/local/include' + ccversion='' + gccversion='10.1.1 20200507 [revision dd38686d9c810cecbaa80bb82ed91caaa58ad635]' + gccosandvers='' + intsize=4 + longsize=8 + ptrsize=8 + doublesize=8 + byteorder=12345678 + doublekind=3 + d_longlong=define + longlongsize=8 + d_longdbl=define + longdblsize=16 + longdblkind=3 + ivtype='long' + ivsize=8 + nvtype='long double' + nvsize=16 + Off_t='off_t' + lseeksize=8 + alignbytes=16 + prototype=define + Linker and Libraries: + ld='cc' + ldflags ='-L/pro/local/lib -fstack-protector-strong' + libpth=/usr/local/lib /usr/lib64/gcc/x86_64-suse-linux/10/include-fixed /usr/lib64/gcc/x86_64-suse-linux/10/../../../../x86_64-suse-linux/lib /usr/lib /pro/local/lib /lib/../lib64 /usr/lib/../lib64 /lib /lib64 /usr/lib64 /usr/local/lib64 + libs=-lpthread -lnsl -lgdbm -ldb -ldl -lm -lcrypt -lutil -lc -lgdbm_compat + perllibs=-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc + libc=libc-2.31.so + so=so + useshrplib=true + libperl=libperl.so + gnulibc_version='2.31' + Dynamic Linking: + dlsrc=dl_dlopen.xs + dlext=so + d_dlsymun=undef + ccdlflags='-Wl,-E -Wl,-rpath,/pro/lib/perl5/5.32.0/x86_64-linux-thread-multi-ld/CORE' + cccdlflags='-fPIC' + lddlflags='-shared -O2 -L/pro/local/lib -fstack-protector-strong' + + +Characteristics of this binary (from libperl): + Compile-time options: + HAS_TIMES + MULTIPLICITY + PERLIO_LAYERS + PERL_COPY_ON_WRITE + PERL_DONT_CREATE_GVSV + PERL_IMPLICIT_CONTEXT + PERL_MALLOC_WRAP + PERL_OP_PARENT + PERL_PRESERVE_IVUV + USE_64_BIT_ALL + USE_64_BIT_INT + USE_ITHREADS + USE_LARGE_FILES + USE_LOCALE + USE_LOCALE_COLLATE + USE_LOCALE_CTYPE + USE_LOCALE_NUMERIC + USE_LOCALE_TIME + USE_LONG_DOUBLE + USE_PERLIO + USE_PERL_ATOF + USE_REENTRANT_API + USE_THREAD_SAFE_LOCALE + Built under linux + Compiled at Jun 21 2020 10:17:00 + %ENV: + PERL6LIB="inst#/pro/3gl/CPAN/rakudo/install" + @INC: + /pro/lib/perl5/site_perl/5.32.0/x86_64-linux-thread-multi-ld + /pro/lib/perl5/site_perl/5.32.0 + /pro/lib/perl5/5.32.0/x86_64-linux-thread-multi-ld + /pro/lib/perl5/5.32.0 diff --git a/t/porting/customized.dat b/t/porting/customized.dat index 3bde6742c59d..bf97579afee5 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -1,7 +1,6 @@ # Regenerate this file using: # cd t # ./perl -I../lib porting/customized.t --regen -Config::Perl::V cpan/Config-Perl-V/V.pm 0a0f7207e6505b78ee345a933acb0246a13579f5 ExtUtils::Constant cpan/ExtUtils-Constant/t/Constant.t d5c75c41d6736a0c5897130f534af0896a7d6f4d ExtUtils::PL2Bat cpan/ExtUtils-PL2Bat/t/make_executable.t 2f58339b567d943712488812f06d99f907af46ab Filter::Util::Call pod/perlfilter.pod 2d98239c4f4a930ad165444c3879629bb91f4cef From 4fb67a9778bdd1bae111bb2b1028c36d74287bb4 Mon Sep 17 00:00:00 2001 From: Jason McIntosh Date: Sat, 19 Dec 2020 14:37:40 +0000 Subject: [PATCH 245/503] Add pod/perldocstyle.pod Satisfies https://news.perlfoundation.org/post/grant_proposal_documentation_standards_perl7 Committer: Adding a new file underneath pod/ entails adding (i) an entry for that file in pod/perl.pod and (ii) entries in win32/pod.mak. (i) In turn requires, figuring out an appropriate category within perl.pod in which to place the new file. The entry should match that in MANIFEST and be consistent with the style of entries in MANIFEST. (ii) Requires running Porting/pod_rules.pl so that entries in win32/pod.mak are also generated for the corresponding *.man, *.html and *.tex files. Supersedes https://github.com/Perl/perl5/pull/18275. --- MANIFEST | 1 + pod/perl.pod | 1 + pod/perldocstyle.pod | 1118 ++++++++++++++++++++++++++++++++++++++++++ win32/pod.mak | 4 + 4 files changed, 1124 insertions(+) create mode 100644 pod/perldocstyle.pod diff --git a/MANIFEST b/MANIFEST index 2bf07c959c81..6e9f6c64a2ab 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5256,6 +5256,7 @@ pod/perldebug.pod Perl debugging pod/perldelta.pod Perl changes since previous version pod/perldeprecation.pod Perl deprecations pod/perldiag.pod Perl diagnostic messages +pod/perldocstyle.pod Perl style guide for core docs pod/perldsc.pod Perl data structures intro pod/perldtrace.pod Perl's support for DTrace pod/perlebcdic.pod Considerations for running Perl on EBCDIC platforms diff --git a/pod/perl.pod b/pod/perl.pod index 9f4f966d115e..eaccc2e51c75 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -96,6 +96,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlpacktut Perl pack() and unpack() tutorial perlpod Perl plain old documentation perlpodspec Perl plain old documentation format specification + perldocstyle Perl style guide for core docs perlpodstyle Perl POD style guide perldiag Perl diagnostic messages perldeprecation Perl deprecations diff --git a/pod/perldocstyle.pod b/pod/perldocstyle.pod new file mode 100644 index 000000000000..f239ba166ea9 --- /dev/null +++ b/pod/perldocstyle.pod @@ -0,0 +1,1118 @@ +=encoding utf8 + +=head1 NAME + +perldocstyle - A style guide for writing Perl's documentation + +=head1 DESCRIPTION + +This document is a guide for the authorship and maintenance of the +documentation that ships with Perl. This includes the following: + +=over + +=item * + +The several dozen manual sections whose filenames begin with "C", +such as C, C, and C. (And, yes, C.) + +=item * + +The documentation for all the modules included with Perl (as listed by +L|perlmodlib>). + +=item * + +The hundreds of individually presented reference sections derived from +the L|perlfunc> file. + +=back + +This guide will hereafter refer to user-manual section files as I, per Unix convention. + +=head2 Purpose of this guide + +This style guide aims to establish standards, procedures, and philosophies +applicable to Perl's core documentation. + +Adherence to these standards will help ensure that any one part of +Perl's manual has a tone and style consistent with that of any other. As +with the rest of the Perl project, the language's documentation +collection is an open-source project authored over a long period of time +by many people. Maintaining consistency across such a wide swath of work +presents a challenge; this guide provides a foundation to help mitigate +this difficulty. + +This will help its readers--especially those new to Perl--to feel +more welcome and engaged with Perl's documentation, and this in turn +will help the Perl project itself grow stronger through having a larger, +more diverse, and more confident population of knowledgeable users. + +=head2 Intended audience + +Anyone interested in contributing to Perl's core documentation should +familiarize themselves with the standards outlined by this guide. + +Programmers documenting their own work apart from the Perl project +itself may also find this guide worthwhile, especially if they wish +their work to extend the tone and style of Perl's own manual. + +=head2 Status of this document + +This guide was initially drafted in late 2020, drawing from the +documentation style guides of several open-source technologies +contemporary with Perl. This has included Python, Raku, Rust, and the +Linux kernel. + +The author intends to see this guide used as starting place from +which to launch a review of Perl's reams of extant documentation, with +the expectation that those conducting this review should grow and modify +this guide as needed to account for the requirements and quirks +particular to Perl's programming manual. + +=head1 FUNDAMENTALS + +=head2 Choice of markup: Pod + +All of Perl's core documentation uses Pod ("Plain Old Documentation"), a +simple markup language, to format its source text. Pod is similar in +spirit to other contemporary lightweight markup technologies, such as +Markdown and reStructuredText, and has a decades-long shared history +with Perl itself. + +For a comprehensive reference to Pod syntax, see L|perlpod>. +For the sake of reading this guide, familiarity with the Pod syntax for +section headers (C<=head2>, et cetera) and for inline text formatting +(Clike thisE>) should suffice. + +Perl programmers also use Pod to document their own scripts, libraries, +and modules. This use of Pod has its own style guide, outlined by +L|perlpodstyle>. + +=head2 Choice of language: American English + +Perl's core documentation is written in English, with a preference for +American spelling of words and expression of phrases. That means "color" +over "colour", "math" versus "maths", "the team has decided" and not +"the team have decided", and so on. + +We name one style of English for the sake of consistency across Perl's +documentation, much as a software project might declare a four-space +indentation standard--even when that doesn't affect how well the code +compiles. Both efforts result in an easier read by avoiding jarring, +mid-document changes in format or style. + +Contributors to Perl's documentation should note that this rule +describes the ultimate, published output of the project, and does not +prescribe the dialect used within community contributions. The +documentation team enthusiastically welcomes any English-language +contributions, and will actively assist in Americanizing spelling and +style when warranted. + +=head3 Other languages and translations + +Community-authored translations of Perl's documentation do exist, +covering a variety of languages. While the Perl project appreciates +these translation efforts and promotes them when applicable, it does not +officially support or maintain any of them. + +That said, keeping Perl's documentation clear, simple, and short has a +welcome side effect of aiding any such translation project. + +(Note that the Chinese, Japanese, and Korean-language README files +included with Perl's source distributions provide an exception to this +choice of language--but these documents fall outside the scope of this +guide.) + +=head2 Choice of encoding: UTF-8 + +Perl's core documentation files are encoded in UTF-8, and can make use +of the full range of characters this encoding allows. + +As such, every core doc file (or the Pod section of every core module) +should commence with an C<=encoding utf8> declaration. + +=head2 Choice of underlying style guide: CMOS + +Perl's documentation uses the L (CMOS), 17th Edition, as +its baseline guide for style and grammar. While the document you are +currently reading endeavors to serve as an adequate stand-alone style guide +for the purposes of documenting Perl, authors should consider CMOS the +fallback authority for any pertinent topics not covered here. + +Because CMOS is not a free resource, access to it is not a prerequisite +for contributing to Perl's documentation; the doc team will help +contributors learn about and apply its guidelines as needed. However, we +do encourage anyone interested in significant doc contributions to +obtain or at least read through CMOS. (Copies are likely available +through most public libraries, and CMOS-derived fundamentals can be +found online as well.) + +=head2 Contributing to Perl's documentation + +Perl, like any programming language, is only as good as its +documentation. Perl depends upon clear, friendly, and thorough +documentation in order to welcome brand-new users, teach and explain the +language's various concepts and components, and serve as a lifelong +reference for experienced Perl programmers. As such, the Perl project +welcomes and values all community efforts to improve the language's +documentation. + +Perl accepts documentation contributions through the same open-source +project pipeline as code contributions. See L|perlhack> for +more information. + +=head1 FORMATTING AND STRUCTURE + +This section details specific Pod syntax and style that all core Perl +documentation should adhere to, in the interest of consistency and +readability. + +=head2 Document structure + +Each individual work of core Perl documentation, whether contained +within a C<.pod> file or in the Pod section of a standard code module, +patterns its structure after a number of long-time Unix man page +conventions. (Hence this guide's use of "man page" to refer to any one +self-contained part of Perl's documentation.) + +Adhering to these conventions helps Pod formatters present a Perl man +page's content in different contexts--whether a terminal, the web, or +even print. Many of the following requirements originate with +L|perlpodstyle>, which derives its recommendations in +turn from these well-established practices. + +=head3 Name + +After its L declaration|/Choice of encoding: UTF-8>, a +Perl man page I present a level-one header named "NAME" (literally), +followed by a paragraph containing the page's name and a very brief +description. + +The first few lines of a notional page named C: + + =encoding utf8 + + =head1 NAME + + perlpodexample - An example of formatting a manual page's title line + +=head3 Description and synopsis + +Most Perl man pages also contain a DESCRIPTION section featuring a +summary of, or introduction to, the document's content and purpose. + +This section should also, one way or another, clearly identify the +audience that the page addresses, especially if it has expectations +about the reader's prior knowledge. For example, a man page that dives +deep into the inner workings of Perl's regular expression engine should +state its assumptions up front--and quickly redirect readers who are +instead looking for a more basic reference or tutorial. + +Reference pages, when appropriate, can precede the DESCRIPTION with a +SYNOPSIS section that lists, within one or more code blocks, some very +brief examples of the referenced feature's use. This section should show +a handful of common-case and best-practice examples, rather than an +exhaustive list of every obscure method or alternate syntax available. + +=head3 Other sections and subsections + +Pages should conclude, when appropriate, with a SEE ALSO section +containing hyperlinks to relevant sections of Perl's manual, other Unix +man pages, or appropriate web pages. Hyperlink each such cross-reference via +C...E>. + +What other sections to include depends entirely upon the topic at hand. +Authors should feel free to include further C<=head1>-level sections, +whether other standard ones listed by C, or ones specific +to the page's topic; in either case, render these top-level headings in +all-capital letters. + +You may then include as many subsections beneath them as needed to meet +the standards of clarity, accessibility, and cross-reference affinity +L. + +=head3 Author and copyright + +In most circumstances, Perl's stand-alone man pages--those contained +within C<.pod> files--do not need to include any copyright or license +information about themselves. Their source Pod files are part of Perl's +own core software repository, and that already covers them under the +same copyright and license terms as Perl itself. You do not need to +include additional "LICENSE" or "COPYRIGHT" sections of your own. + +These man pages may optionally credit their primary author, or include a +list of significant contributors, under "AUTHOR" or "CONTRIBUTORS" +headings. Note that the presence of authors' names does not preclude a +given page from L. + +Note that these guidelines do not apply to the core software modules +that ship with Perl. These have their own standards for authorship and +copyright statements, as found in C. + +=head2 Formatting rules + +=head3 Line length and line wrap + +Each line within a Perl man page's Pod source file should measure 72 +characters or fewer in length. + +Please break paragraphs up into blocks of short lines, rather than +"soft wrapping" paragraphs across hundreds of characters with no line +breaks. + +=head3 Code blocks + +Just like the text around them, all code examples should be as short and +readable as possible, displaying no more complexity than absolutely +necessary to illustrate the concept at hand. + +For the sake of consistency within and across Perl's man pages, all +examples must adhere to the code-layout principles set out by +L|perlstyle>. + +Sample code should deviate from these standards only when necessary: +during a demonstration of how Perl disregards whitespace, for example, +or to temporarily switch to two-column indentation for an unavoidably +verbose illustration. + +You may include comments within example code to further clarify or label +the code's behavior in-line. You may also use comments as placeholder +for code normally present but not relevant to the current topic, like +so: + + while (my $line = <$fh>) { + # + # (Do something interesting with $line here.) + # + } + +Even the simplest code blocks often require the use of example +variables and subroutines, L. + +=head3 Inline code and literals + +Within a paragraph of text, use C...E> when quoting or +referring to any bit of Perl code--even if it is only one character +long. + +For instance, when referring within an explanatory paragraph to Perl's +operator for adding two numbers together, you'd write "C+E>". + +=head3 Function names + +Use C...E> to render all Perl function names in monospace, +whenever they appear in text. + +Unless you need to specifically quote a function call with a list of +arguments, do not follow a function's name in text with a pair of empty +parentheses. That is, when referring in general to Perl's C +function, write it as "C", not "C". + +=head3 Function arguments + +Represent functions' expected arguments in all-caps, with no sigils, and +using C...E> to render them in monospace. These arguments +should have short names making their nature and purpose clear. +Convention specifies a few ones commonly seen throughout Perl's +documentation: + +=over + +=item * + +EXPR + +The "generic" argument: any scalar value, or a Perl expression that +evaluates to one. + +=item * + +ARRAY + +An array, stored in a named variable. + +=item * + +HASH + +A hash, stored in a named variable. + +=item * + +BLOCK + +A curly-braced code block, or a subroutine reference. + +=item * + +LIST + +Any number of values, stored across any number of variables or +expressions, which the function will "flatten" and treat as a single +list. (And because it can contain any number of variables, it must be +the I argument, when present.) + +=back + +When possible, give scalar arguments names that suggest their purpose +among the arguments. See, for example, L's +documentation|perlfunc/substr>, whose +listed arguments include C, C, C, and C. + +=head3 Apostrophes, quotes, and dashes + +In Pod source, use straight quotes, and not "curly quotes": "Like + this", not “like this”. The same goes for apostrophes: Here's a + positive example, and here’s a negative one. + +Render em dashes as two hyphens--like this: + + Render em dashes as two hyphens--like this. + +Leave it up to formatters to reformat and reshape these punctuation +marks as best fits their respective target media. + +=head3 Unix programs and C functions + +When referring to a Unix program or C function with its own man page +(outside of Perl's documentation), include its manual section number in +parentheses. For example: C, or C. + +If mentioning this program for the first time within a man page or +section, make it a cross reference, e.g. Cmalloc(3)E>. + +Do not otherwise style this text. + +=head3 Cross-references and hyperlinks + +Make generous use of Pod's C...E> syntax to create hyperlinks +to other parts of the current man page, or to other documents entirely +-- whether elsewhere on the reader's computer, or somewhere on the +internet, via URL. + +Use C...E> to link to another section of the current man page +when mentioning it, and make use of its page-and-section syntax to link to +the most specific section of a separate page within Perl's +documentation. Generally, the first time you refer to a specific +function, program, or concept within a certain page or section, consider +linking to its full documentation. + +Hyperlinks do not supersede other formatting required by this guide; Pod +allows nested text formats, and you should use this feature as needed. + +Here is an example sentence that mentions Perl's C function, with a +link to its documentation section within the C man page: + + In version 5.10, Perl added support for the + L|perlfunc/say FILEHANDLE LIST> function. + +Note the use of the vertical pipe ("C<|>") to separate how the link will +appear to readers ("CsayE>") from the full page-and-section specifier +that the formatter links to. + +=head3 Tables and diagrams + +Pod does not officially support tables. To best present tabular data, +include the table as both HTML and plain-text representations--the +latter as an indented code block. Use C<=begin> / C<=end> directives to +target these tables at C and C Pod formatters, respectively. +For example: + + =head2 Table of fruits + + =begin text + + Name Shape Color + ===================================== + Apple Round Red + Banana Long Yellow + Pear Pear-shaped Green + + =end text + + =begin html + + + + + + +
NameShapeColor
AppleRoundRed
BananaLongYellow
PearPear-shapedGreen
+ + =end html + +The same holds true for figures and graphical illustrations. Pod does +not natively support inline graphics, but you can mix HTML C<<< >>> tags +with monospaced text-art representations of those images' content. + +Due in part to these limitations, most Perl man pages use neither tables +nor diagrams. Like any other tool in your documentation toolkit, +however, you may consider their inclusion when they would improve an +explanation's clarity without adding to its complexity. + +=head2 Adding comments + +Like any other kind of source code, Pod lets you insert comments visible +only to other people reading the source directly, and ignored by the +formatting programs that transform Pod into various human-friendly +output formats (such as HTML or PDF). + +To comment Pod text, use the C<=for> and C<=begin> / C<=end> Pod +directives, aiming them at a (notional) formatter called "C". A +couple of examples: + + =for comment Using "=for comment" like this is good for short, + single-paragraph comments. + + =begin comment + + If you need to comment out more than one paragraph, use a + =begin/=end block, like this. + + None of the text or markup in this whole example would be visible to + someone reading the documentation through normal means, so it's + great for leaving notes, explanations, or suggestions for your + fellow documentation writers. + + =end comment + +In the tradition of any good open-source project, you should make free +but judicious use of comments to leave in-line "meta-documentation" as +needed for other Perl documentation writers (including your future +self). + +=head2 Perlfunc has special rules + +The L man page|perlfunc>, an exhaustive reference of every +Perl built-in function, has a handful of formatting rules not seen +elsewhere in Perl's documentation. + +Software used during Perl's build process +(L) parses this page according to certain +rules, in order to build separate man pages for each of Perl's +functions, as well as achieve other indexing effects. As such, +contributors to perlfunc must know about and adhere to its particular +rules. + +Most of the perfunc man page comprises a single list, found under the +header L<"Alphabetical Listing of Perl Functions"|perlfunc/Alphabetical +Listing of Perl Functions>. Each function reference is an entry on that +list, made of three parts, in order: + +=over + +=item 1. + +A list of C<=item> lines which each demonstrate, in template format, a +way to call this function. One line should exist for every combination +of arguments that the function accepts (including no arguments at all, +if applicable). + +If modern best practices prefer certain ways to invoke the function +over others, then those ways should lead the list. + +The first item of the list should be immediately followed by one or +more C...E> terms listing index-worthy topics; if nothing +else, then the name of the function, with no arguments. + +=item 2. + +A C<=for> line, directed at C, containing a one-line +description of what the function does. This is written as a phrase, led +with an imperative verb, with neither leading capitalization nor ending +punctuation. Examples include "quote a list of words" and "change a +filename". + +=item 3. + +The function's definition and reference material, including all +explanatory text and code examples. + +=back + +Complex functions that need their text divided into subsections (under +the principles of L<"Apply section-breaks and examples +generously"|/Apply section-breaks and examples generously>) may do so by +using sublists, with C<=item> elements as header text. + +A fictional function "C", which takes a list as an optional +argument, might have an entry in perlfunc shaped like this: + + =item myfunc LIST + X + + =item myfunc + + =for Pod::Functions demonstrate a function's perlfunc section + + [ Main part of function definition goes here, with examples ] + + =over + + =item Legacy uses + + [ Examples of deprecated syntax still worth documenting ] + + =item Security considerations + + [ And so on... ] + + =back + +=head1 TONE AND STYLE + +=head2 Apply one of the four documentation modes + +Aside from "meta" documentation such as C or C, +each of Perl's man pages should conform to one of the four documentation +"modes" suggested by L by Daniele +Procida|https://documentation.divio.com>. These include tutorials, +cookbooks, explainers, and references--terms that we define in further +detail below. + +Each mode of documentation speaks to a different audience--not just +people of different backgrounds and skill levels, but individual readers +whose needs from language documentation can shift depending upon +context. For example, a programmer with plenty of time to learn a new +concept about Perl can ease into a tutorial about it, and later expand +their knowledge further by studying an explainer. Later, that same +programmer, wading knee-deep in live code and needing only to look up +some function's exact syntax, will want to reach for a reference page +instead. + +Perl's documentation must strive to meet these different situational +expectations by limiting each man page to a single mode. This helps +writers ensure they provide readers with the documentation needed or +expected, despite ever-evolving situations. + +=head3 Tutorial + +A tutorial man page focuses on B, ideally by I. It +presents the reader with small, interesting examples that allow them to +follow along themselves using their own Perl interpreter. The tutorial +inspires comprehension by letting its readers immediately experience +(and experiment on) the concept in question. Examples include +C, C, and +C. + +Tutorial man pages must strive for a welcoming and reassuring tone from +their outset; they may very well be the first things that a newcomer to +Perl reads, playing a significant role in whether they choose +to stick around. Even an experienced programmer can benefit from the +sense of courage imparted by a strong tutorial about a more advanced +topic. After completing a tutorial, a reader should feel like they've +been led from zero knowledge of its topic to having an invigorating +spark of basic understanding, excited to learn more and experiment +further. + +Tutorials can certainly use real-world examples when that helps make for +clear, relatable demonstrations, so long as they keep the focus on +teaching--more practical problem-solving should be left to the realm +of cookbooks (as described below). Tutorials also needn't concern +themselves with explanations into why or how things work beneath the +surface, or explorations of alternate syntaxes and solutions; these are +better handled by explainers and reference pages. + +=head3 Cookbook + +A cookbook man page focuses on B. Just like its name suggests, +it presents succinct, step-by-step solutions to a variety of real-world +problems around some topic. A cookbook's code examples serve less to +enlighten and more to provide quick, paste-ready solutions that the +reader can apply immediately to the situation facing them. + +A Perl cookbook demonstrates ways that all the tools and techniques +explained elsewhere can work together in order to achieve practical +results. Any explanation deeper than that belongs in explainers and +reference pages, instead. (Certainly, a cookbook can cross-reference +other man pages in order to satisfy the curiosity of readers who, with +their immediate problems solved, wish to learn more.) + +The most prominent cookbook pages that ship with Perl itself are its +many FAQ pages, in particular C and up, which provide short +solutions to practical questions in question-and-answer style. +C shows another example, containing a bevy of practical code +snippets for a variety of internationally minded text manipulations. + +(An aside: I calls this mode "how-to", but +Perl's history of creative cuisine prefers the more kitchen-ready term +that we employ here.) + +=head3 Reference + +A reference page focuses on B. Austere, uniform, and +succinct, reference pages--often arranged into a whole section of +mutually similar subpages--lend themselves well to "random access" by +a reader who knows precisely what knowledge they need, requiring only +the minimum amount of information before returning to the task at hand. + +Perl's own best example of a reference work is C, the +sprawling man page that details the operation of every function built +into Perl, with each function's documentation presenting the same kinds +of information in the same order as every other. For an example of a +shorter reference on a single topic, look at C. + +Module documentation--including that of all the modules listed in +L|perlmodlib>--also counts as reference. They follow +precepts similar to those laid down by the C man page, such +as opening with an example-laden "SYNOPSIS" section, or featuring a +"METHODS" section that succinctly lists and defines an object-oriented +module's public interface. + +=head3 Explainer + +Explainer pages focus on B. Each explainer dives as deep as +needed into some Perl-relevant topic, taking all the time and space +needed to give the reader a thorough understanding of it. Explainers +mean to impart knowledge through study. They don't assume that the +student has a Perl interpreter fired up and hungry for immediate examples +(as with a tutorial), or specific Perl problems that they need quick +answers for (which cookbooks and reference pages can help with). + +Outside of its reference pages, most of Perl's manual belongs to this +mode. This includes the majority of the man pages whose names start with +"C". A fine example is C, the Perl Syntax page, which +explores the whys and wherefores of Perl's unique syntax in a +wide-ranging discussion laden with many references to the language's +history, culture, and driving philosophies. + +Perl's explainer pages give authors a chance to explore Perl's penchant +for L, illustrating alternate and even +obscure ways to use the language feature under discussion. However, as +the remainder of this guide discusses, the ideal Perl documentation +manages to deliver its message clearly and concisely, and not confuse +mere wordiness for completeness. + +=head3 Further notes on documentation modes + +Keep in mind that the purpose of this categorization is not to dictate +content--a very thorough explainer might contain short reference +sections of its own, for example, or a reference page about a very +complex function might resemble an explainer in places (e.g. +L|perlfunc/open FILEHANDLE,MODE,EXPR>). Rather, it makes sure +that the authors and contributors of any given man page agree on what +sort of audience that page addresses. + +If a new or otherwise uncategorized man page presents itself as +resistant to fitting into only one of the four modes, consider breaking +it up into separate pages. That may mean creating a new "C" +man page, or (in the case of module documentation) making new packages +underneath that module's namespace that serve only to hold additional +documentation. For instance, C's reference documentation +might include a see-also link to C. + +Perl's several man pages about Unicode--comprising a short tutorial, a +thorough explainer, a cookbook, and a FAQ--provide a fine example of +spreading a complicated topic across several man pages with different +and clearly indicated purposes. + +=head2 Assume readers' intelligence, but not their knowledge + +Perl has grown a great deal from its humble beginnings as a tool for +people already well versed in C programming and various Unix utilities. +Today, a person learning Perl might come from any social or +technological background, with a range of possible motivations +stretching far beyond system administration. + +Perl's core documentation must recognize this by making as few +assumptions as possible about the reader's prior knowledge. While you +should assume that readers of Perl's documentation are smart, curious, +and eager to learn, you should not confuse this for pre-existing +knowledge about any other technology, or even programming in +general--especially in tutorial or introductory material. + +=head3 Keep Perl's documentation about Perl + +Outside of pages tasked specifically with exploring Perl's relationship +with other programming languages, the documentation should keep the +focus on Perl. Avoid drawing analogies to other technologies that the +reader may not have familiarity with. + +For example, when documenting one of Perl's built-in functions, write as +if the reader is now learning about that function for the first time, in +any programming language. + +Choosing to instead compare it to an equivalent or underlying C function +will probably not illuminate much understanding in a contemporary +reader. Worse, this can risk leaving readers unfamiliar with C feeling +locked out from fully understanding of the topic--to say nothing of +readers new to computer programming altogether. + +If, however, that function's ties to its C roots can lead to deeper +understanding with practical applications for a Perl programmer, you may +mention that link after its more immediately useful documentation. +Otherwise, omit this information entirely, leaving it for other +documentation or external articles more concerned with examining Perl's +underlying implementation details. + +=head3 Deploy jargon when needed, but define it as well + +Domain-specific jargon has its place, especially within documentation. +However, if a man page makes use of jargon that a typical reader might +not already know, then that page should make an effort to define the +term in question early-on--either explicitly, or via cross reference. + +For example, Perl loves working with filehandles, and as such that word +appears throughout its documentation. A new Perl programmer arriving at +a man page for the first time is quite likely to have no idea what a +"filehandle" is, though. Any Perl man page mentioning filehandles +should, at the very least, hyperlink that term to an explanation +elsewhere in Perl's documentation. If appropriate--for example, in the +lead-in to L function's detailed reference|perlfunc/open +FILEHANDLE,MODE,EXPR>--it can also include a very short in-place +definition of the concept for the reader's convenience. + +=head2 Use meaningful variable and symbol names in examples + +When quickly sketching out examples, English-speaking programmers have a +long tradition of using short nonsense words as placeholders for +variables and other symbols--such as the venerable C, C, and +C. Example code found in a programming language's official, +permanent documentation, however, can and should make an effort to +provide a little more clarity through specificity. + +Whenever possible, code examples should give variables, classes, and +other programmer-defined symbols names that clearly demonstrate their +function and their relationship to one another. For example, if an +example requires that one class show an "is-a" relationship with +another, consider naming them something like C and C, rather +than C and C. Similarly, sample code creating an instance of +that class would do better to name it C<$apple>, rather than C<$baz>. + +Even the simplest examples benefit from clear language using concrete +words. Prefer a construct like C over +C. + +=head2 Write in English, but not just for English-speakers + +While this style guide does specify American English as the +documentation's language for the sake of internal consistency, authors +should avoid cultural or idiomatic references available only to +English-speaking Americans (or any other specific culture or society). +As much as possible, the language employed by Perl's core documentation +should strive towards cultural universality, if not neutrality. Regional +turns of phrase, examples drawing on popular-culture knowledge, and +other rhetorical techniques of that nature should appear sparingly, if +at all. + +Authors should feel free to let more freewheeling language flourish in +"second-order" documentation about Perl, like books, blog entries, and +magazine articles, published elsewhere and with a narrower readership in +mind. But Perl's own docs should use language as accessible and +welcoming to as wide an audience as possible. + +=head2 Omit placeholder text or commentary + +Placeholder text does not belong in the documentation that ships with +Perl. No section header should be followed by text reading only "Watch +this space", "To be included later", or the like. While Perl's source +files may shift and alter as much as any other actively maintained +technology, each released iteration of its technology should feel +complete and self-contained, with no such future promises or other loose +ends visible. + +Take advantage of Perl's regular release cycle. Instead of cluttering +the docs with flags promising more information later--the presence of +which do not help readers at all today--the documentation's +maintenance team should treat any known documentation absences as an +issue to address like any other in the Perl project. Let Perl's +contributors, testers, and release engineers address that need, and +resist the temptation to insert apologies, which have all the utility in +documentation as undeleted debug messages do in production code. + +=head2 Apply section-breaks and examples generously + +No matter how accessible their tone, the sight of monolithic blocks of +text in technical documentation can present a will-weakening challenge +for the reader. Authors can improve this situation through breaking long +passages up into subsections with short, meaningful headers. + +Since every section-header in Pod also acts as a potential end-point for +a cross-reference (made via Pod's C...E> syntax), putting +plenty of subsections in your documentation lets other man pages more +precisely link to a particular topic. This creates hyperlinks directly +to the most appropriate section rather than to the whole page in +general, and helps create a more cohesive sense of a rich, consistent, +and interrelated manual for readers. + +Among the four documentation modes, sections belong more naturally in +tutorials and explainers. The step-by-step instructions of cookbooks, or +the austere definitions of reference pages, usually have no room for +them. But authors can always make exceptions for unusually complex +concepts that require further breakdown for clarity's sake. + +Example code, on the other hand, can be a welcome addition to any mode +of documentation. Code blocks help break up a man page visually, +reassuring the reader that no matter how deep the textual explanation +gets, they are never far from another practical example showing how it +all comes together using a small, easy-to-read snippet of tested Perl +code. + +=head2 Lead with common cases and best practices + +Perl famously gives programmers more than one way to do things. Like any +other long-lived programming language, Perl has also built up a large, +community-held notion of best practices, blessing some ways to do things +as better than others, usually for the sake of more maintainable code. + +=head3 Show the better ways first + +Whenever it needs to show the rules for a technique which Perl provides +many avenues for, the documentation should always lead with best +practices. And when discussing some part of the Perl toolkit with many +applications, the docs should begin with a demonstration of its +application to the most common cases. + +The C function, for example, has myriad potential uses within Perl +programs, but I programmers--and especially those new +to Perl--turn to this reference because they simply wish to open a +file for reading or writing. For this reason, C's documentation +begins there, and only descends into the function's more obscure uses +after thoroughly documenting and demonstrating how it works in the +common case. Furthermore, while engaging in this demonstration, the +C documentation does not burden the reader right away with detailed +explanations about calling C via any route other than the +best-practice, three-argument style. + +=head3 Show the lesser ways when needed + +Sometimes, thoroughness demands documentation of deprecated techniques. +For example, a certain Perl function might have an alternate syntax now +considered outmoded and no longer best-practice, but which a maintainer +of a legacy project might quite reasonably encounter when exploring old +code. In this case, these features deserve documentation, but couched in +clarity that modern Perl avoids such structures, and does not recommend +their use in new projects. + +Another way to look at this philosophy (and one L on +Python's documentation team) involves writing while sympathizing with a +programmer new to Perl, who may feel uncertain about learning a complex +concept. By leading that concept's main documentation with clear, +positive examples, we can immediately give these readers a simple and +true picture of how it works in Perl, and boost their own confidence to +start making use of this new knowledge. Certainly we should include +alternate routes and admonitions as reasonably required, but we needn't +emphasize them. Trust the reader to understand the basics quickly, and +to keep reading for a deeper understanding if they feel so driven. + +=head2 Document Perl's present + +Perl's documentation should stay focused on Perl's present behavior, +with a nod to future directions. + +=head3 Recount the past only when necessary + +=for comment +The principles of this section caused a lot of lively discussion and +debate among p5p when first proposed in October 2020. I am keeping the +recommendations nonspecific, and expect this section to receive a lot of +further refinement as we start to apply it to core docs. + +When some Perl feature changes its behavior, documentation about +that feature should change too, and just as definitively. The docs have +no obligation to keep descriptions of past behavior hanging around, even if +attaching clauses like "Prior to version 5.10, [...]". + +Since Perl's core documentation is part of Perl's source distribution, +it enjoys the same benefits of versioning and version-control as the +source code of Perl itself. Take advantage of this, and update the text +boldly when needed. Perl's history remains safe, even when you delete or +replace outdated information from the current version's docs. + +Perl's docs can acknowledge or discuss former behavior when warranted, +including notes that some feature appeared in the language as of some +specific version number. Authors should consider applying principles +similar to those for deprecated techniques, L: make the information present, but not +prominent. + +Otherwise, keep the past in the past. A manual uncluttered with +outdated instruction stays more succinct and relevant. + +=head3 Describe the uncertain future with care + +Perl features marked as "experimental"--those that generate warnings +when used in code not invoking the L|experimental> +pragma--deserve documentation, but only in certain contexts, and even +then with caveats. These features represent possible new directions for +Perl, but they have unstable interfaces and uncertain future presence. + +The documentation should take both implications of "experimental" +literally. It should not discourage these features' use by programmers +who wish to try out new features in projects that can risk their +inherent instability; this experimentation can help Perl grow and +improve. By the same token, the docs should downplay these features' use +in just about every other context. + +Introductory or overview material should omit coverage of experimental +features altogether. + +More thorough reference materials or explanatory articles can include +experimental features, but needs to clearly mark them as such, and not +treat them with the same prominence as Perl's stable features. Using +unstable features seldom coincides with best practices, and +documentation that L should reflect this. + +=head2 The documentation speaks with one voice + +Even though it comes from many hands and minds, criss-crossing through +the many years of Perl's lifetime, the language's documentation should +speak with a single, consistent voice. With few exceptions, the docs +should avoid explicit first-person-singular statements, or similar +self-reference to any individual's contributor's philosophies or +experiences. + +Perl did begin life as a deeply personal expression by a single +individual, and this famously carried through the first revisions of its +documentation as well. Today, Perl's community understands that the +language's continued development and support comes from many people +working in concert, rather than any one person's vision or effort. Its +documentation should not pretend otherwise. + +The documentation should, however, carry forward the best tradition that +Larry Wall set forth in the language's earliest days: Write both +economically and with a humble, subtle wit, resulting in a technical +manual that mixes concision with a friendly approachability. It avoids +the dryness that one might expect from technical documentation, while +not leaning so hard into overt comedy as to distract and confuse from +the nonetheless-technical topics at hand. + +Like the best written works, Perl's documentation has a soul. Get +familiar with it as a reader to internalize its voice, and then find +your own way to express it in your own contributions. Writing clearly, +succinctly, and with knowledge of your audience's expectations will get +you most of the way there, in the meantime. + +Every line in the docs--whether English sentence or Perl +statement--should serve the purpose of bringing understanding to the +reader. Should a sentence exist mainly to make a wry joke that doesn't +further the reader's knowledge of Perl, set it aside, and consider +recasting it into a personal blog post or other article instead. + +Write with a light heart, and a miserly hand. + +=head1 INDEX OF PREFERRED TERMS + +L, this guide +"inherits" all the preferred terms listed in the Chicago Manual of +Style, 17th edition, and adds the following terms of particular interest +to Perl documentation. + +=over + +=item built-in function + +Not "builtin". + +=item Darwin + +See L. + +=item macOS + +Use this term for Apple's operating system instead of "Mac OS X" or +variants thereof. + +This term is also preferable to "Darwin", unless one needs to refer +to macOS's Unix layer specifically. + +=item man page + +One unit of Unix-style documentation. Not "manpage". Preferable to "manual page". + +=item Perl; perl + +The name of the programming language is Perl, with a leading capital +"P", and the remainder in lowercase. (Never "PERL".) + +The interpreter program that reads and executes Perl code is named +"C", in lowercase and in monospace (as with any other command +name). + +Generally, unless you are specifically writing about the +command-line C progam (as, for example, L|perlrun> +does), use "Perl" instead. + +=item Perl 5 + +Documentation need not follow Perl's name with a "5", or any other +number, except during discussions of Perl's history, future plans, +or explicit comparisons between major Perl versions. + +Before 2019, specifying "Perl 5" was sometimes needed to distinguish +the language from Perl 6. With the latter's renaming to "Raku", this +practice became unnecessary. + +=item Perl 6 + +See L. + +=item Perl 5 Porters, the; porters, the; p5p + +The full name of the team responsible for Perl's ongoing maintenance +and development is "the Perl 5 Porters", and this sobriquet should +be spelled out in the first mention within any one document. It may +thereafter call the team "the porters" or "p5p". + +Not "Perl5 Porters". + +=item program + +The most general descriptor for a stand-alone work made out of +executable Perl code. Synonymous with, and preferable to, "script". + +=item Raku + +Perl's "sister language", whose homepage is L. + +Previously known as "Perl 6". In 2019, its design team renamed the +language to better reflect its identity as a project independent from +Perl. As such, Perl's documentation should always refer to this language +as "Raku" and not "Perl 6". + +=item script + +See L. + +=item semicolon + +Perl code's frequently overlooked punctuation mark. Not "semi-colon". + +=item Unix + +Not "UNIX", "*nix", or "Un*x". Applicable to both the original operating +system from the 1970s as well as all its conceptual descendants. You may +simply write "Unix" and not "a Unix-like operating system" when +referring to a Unix-like operating system. + +=back + +=head1 SEE ALSO + +=over + +=item * + +L + +=item * + +L + +=back + +=head1 AUTHOR + +This guide was initially drafted by Jason McIntosh +(jmac@jmac.org), under a grant from The Perl Foundation. + +=for comment Additional contributors can get listed here (and this +comment deleted), when there are some. diff --git a/win32/pod.mak b/win32/pod.mak index f9890d631952..9261aff3cda0 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -99,6 +99,7 @@ POD = perl.pod \ perldelta.pod \ perldeprecation.pod \ perldiag.pod \ + perldocstyle.pod \ perldsc.pod \ perldtrace.pod \ perlebcdic.pod \ @@ -264,6 +265,7 @@ MAN = perl.man \ perldelta.man \ perldeprecation.man \ perldiag.man \ + perldocstyle.man \ perldsc.man \ perldtrace.man \ perlebcdic.man \ @@ -429,6 +431,7 @@ HTML = perl.html \ perldelta.html \ perldeprecation.html \ perldiag.html \ + perldocstyle.html \ perldsc.html \ perldtrace.html \ perlebcdic.html \ @@ -594,6 +597,7 @@ TEX = perl.tex \ perldelta.tex \ perldeprecation.tex \ perldiag.tex \ + perldocstyle.tex \ perldsc.tex \ perldtrace.tex \ perlebcdic.tex \ From f0041f146d430111c9b3b9937dde35b1f921e9b2 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 19 Dec 2020 17:42:48 +0000 Subject: [PATCH 246/503] perldelta for edd16cfcff --- pod/perldelta.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 8d4cf7e9e07e..a366ae899323 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -157,7 +157,7 @@ file and be sure to link to the appropriate page, e.g. L. =head2 New Documentation -XXX Changes which create B files in F go here. +L has been added to F. =head3 L From eaeb7e669a1ee38dfa4e0bdd9a488214ab931529 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Thu, 17 Dec 2020 02:17:31 +0900 Subject: [PATCH 247/503] ext/POSIX: Change integer constants to IV. Some floating-point related constants, such as (FLT|L?DBL)_DIG, FLT_RADIX, FP_*, etc. had been defined as NV, but these are actually integer constants. This change should not affect the behaviour of user programs. --- ext/POSIX/Makefile.PL | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/ext/POSIX/Makefile.PL b/ext/POSIX/Makefile.PL index 5d5c009c3c96..a124003f23a2 100644 --- a/ext/POSIX/Makefile.PL +++ b/ext/POSIX/Makefile.PL @@ -116,15 +116,18 @@ push @names, {name=>$_, type=>"NV", not_constant=>1} foreach (qw(DBL_MAX FLT_MAX LDBL_MAX LDBL_MIN LDBL_EPSILON DBL_EPSILON DBL_MIN FLT_EPSILON FLT_MIN)); -push @names, {name=>$_, type=>"NV"} +push @names, {name=>$_, type=>"IV"} foreach (qw(DBL_DIG DBL_MANT_DIG DBL_MAX_10_EXP DBL_MAX_EXP DBL_MIN_10_EXP DBL_MIN_EXP FLT_DIG FLT_MANT_DIG FLT_MAX_10_EXP FLT_MAX_EXP FLT_MIN_10_EXP FLT_MIN_EXP FLT_RADIX LDBL_DIG LDBL_MANT_DIG LDBL_MAX_10_EXP LDBL_MAX_EXP LDBL_MIN_10_EXP LDBL_MIN_EXP)); -push @names, {name=>$_, type=>"NV"} +push @names, {name=>$_, type=>"IV"} foreach (qw(FP_ILOGB0 FP_ILOGBNAN FP_INFINITE FP_NAN FP_NORMAL - FP_SUBNORMAL FP_ZERO M_1_PI M_2_PI M_2_SQRTPI M_E M_LN10 M_LN2 + FP_SUBNORMAL FP_ZERO)); + +push @names, {name=>$_, type=>"NV"} + foreach (qw(M_1_PI M_2_PI M_2_SQRTPI M_E M_LN10 M_LN2 M_LOG10E M_LOG2E M_PI M_PI_2 M_PI_4 M_SQRT1_2 M_SQRT2)); push @names, {name=>$_, type=>"IV"} From 08756710140df3852d98e588db931e5d9b4aca16 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Thu, 17 Dec 2020 23:27:31 +0900 Subject: [PATCH 248/503] ext/POSIX: Added tests to check integer constants are defined as IV --- ext/POSIX/t/iv_const.t | 69 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 69 insertions(+) create mode 100644 ext/POSIX/t/iv_const.t diff --git a/ext/POSIX/t/iv_const.t b/ext/POSIX/t/iv_const.t new file mode 100644 index 000000000000..38d1b366fb22 --- /dev/null +++ b/ext/POSIX/t/iv_const.t @@ -0,0 +1,69 @@ +#! perl -w + +# Test integer constants (DBL_DIG, DBL_MAX_EXP, FP_*, ...) are IV, not NV. + +use strict; +use Test::More; +use Devel::Peek; +use POSIX; +use Config; + +# Capture output from Devel::Peek::Dump() into Perl string +sub capture_dump +{ + open my $olderr, '>&', *STDERR + or die "Can't save STDERR: $!"; + my $str; + my $result = eval { + local $SIG{__DIE__}; + close STDERR; + open STDERR, '>', \$str + or die "Can't redirect STDERR: $!"; + Dump($_[0]); + 1; + }; + my $reason = $@; + open STDERR, '>&', $olderr + or die "Can't restore STDERR: $!"; + $result or die $reason; + $str; +} + +# Avoid die() in a test harness. +sub capture_dump_in_test +{ + my $str; + eval { $str = capture_dump($_[0]); 1 } or BAIL_OUT $@; + $str; +} + +sub is_iv ($$) +{ + # We would write "ok(SvIOK($_[0]), ...)", + # but unfortunately SvIOK is not available in Perl. + + my $dump = capture_dump_in_test($_[0]); + #note($dump); + ok($dump =~ /^\h*FLAGS = .*\bIOK\b/m && $dump =~ /^\h*IV =/m, $_[1]); +} + +my @tests = qw(EXIT_SUCCESS); + +push @tests, qw(FLT_RADIX FP_NORMAL FP_ZERO FP_SUBNORMAL FP_INFINITE FP_NAN); + +if ($Config{uselongdouble} ? $Config{d_ilogbl} : $Config{d_ilogb}) { + push @tests, qw(FP_ILOGB0); + push @tests, qw(FP_ILOGBNAN) if $Config{d_double_has_nan}; +} + +foreach my $flt ('FLT', 'DBL', ($Config{d_longdbl} ? ('LDBL') : ())) { + push @tests, "${flt}_$_" + foreach qw(DIG MANT_DIG MAX_10_EXP MAX_EXP MIN_10_EXP MIN_EXP); +} + +push @tests, qw(FE_TONEAREST FE_TOWARDZERO FE_UPWARD FE_DOWNWARD) + if $Config{d_fegetround}; + +is_iv(eval "POSIX::$_", "$_ is an integer") foreach @tests; + +done_testing(); From 4f61b328f5219abf2183c2c6b68bc9aaadf683cd Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Fri, 18 Dec 2020 18:55:50 +0900 Subject: [PATCH 249/503] MANIFEST: Add ext/POSIX/t/iv_const.t --- MANIFEST | 1 + 1 file changed, 1 insertion(+) diff --git a/MANIFEST b/MANIFEST index 6e9f6c64a2ab..3330df87b23a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4363,6 +4363,7 @@ ext/POSIX/Makefile.PL POSIX extension makefile writer ext/POSIX/POSIX.xs POSIX extension external subroutines ext/POSIX/t/export.t Test @EXPORT and @EXPORT_OK ext/POSIX/t/iscrash See if POSIX isxxx() crashes with threads on Win32 +ext/POSIX/t/iv_const.t See if integer constants of POSIX are IV ext/POSIX/t/math.t Basic math tests for POSIX ext/POSIX/t/mb.t Multibyte function tests for POSIX ext/POSIX/t/posix.t See if POSIX works From 798ebbce5d557ead8dba98f8fa407c8865349c11 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 19 Dec 2020 15:41:56 -0500 Subject: [PATCH 250/503] ext/POSIX/t/waitpid.t: Correct one typo --- ext/POSIX/t/waitpid.t | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ext/POSIX/t/waitpid.t b/ext/POSIX/t/waitpid.t index 7e821fd8257b..d47382bf5771 100644 --- a/ext/POSIX/t/waitpid.t +++ b/ext/POSIX/t/waitpid.t @@ -61,7 +61,7 @@ if ($child_pid) { $state = NEG1_REQUIRED; is(WIFEXITED(${^CHILD_ERROR_NATIVE}), 1, 'child exited cleanly'); is(WEXITSTATUS(${^CHILD_ERROR_NATIVE}), 0, - 'child exited with 0 (the retun value of its sleep(3) call)'); + 'child exited with 0 (the return value of its sleep(3) call)'); } } From aceeeadc611887db471a0774dfaf0c05c75e5725 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 11 Nov 2020 16:37:23 -0700 Subject: [PATCH 251/503] regen/regcharclass.pl: Rmv special case This avoided checking for optimizations. Whatever its original use, it doesn't do any good, and the optimizations are actually useful. --- regcharclass.h | 2 +- regen/regcharclass.pl | 16 +--------------- 2 files changed, 2 insertions(+), 16 deletions(-) diff --git a/regcharclass.h b/regcharclass.h index f7217b4a10e0..dbcf50a1f03c 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -2297,6 +2297,6 @@ * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * 1c2b06a33a2fd4ea6a2df233f99167cb89e9e4041e1732bd49d5c2f145df38d8 regen/regcharclass.pl + * e3e72d7df46550e894d860fec08cc81ca9e1d2205a81fb48733e74b8853281be regen/regcharclass.pl * c0a5e4cb2b9ffad78691938e122c1310bbc98aca2364af243e5c6b2ec0f59dc3 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index e9944f101659..8d97a79f7a72 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1077,22 +1077,8 @@ sub _cond_as_str { return $self->_combine( $test, @ranges ) if $combine; - if ($is_cp_ret) { - @ranges= map { - ref $_ - ? "isRANGE( $test, " - . $self->val_fmt($_[0]) . ", " - . $self->val_fmt($_[1]) . " )" - : $self->val_fmt($_) . " == $test"; - } @ranges; - - return "( " . join( " || ", @ranges ) . " )"; - } - # If the input set has certain characteristics, we can optimize tests - # for it. This doesn't apply if returning the code point, as we want - # each element of the set individually. The code above is for this - # simpler case. + # for it. return 1 if @$cond == 256; # If all bytes match, is trivially true From a50454ce0f79538d3cedde9015ef68d4d6dfb89f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 18 Oct 2020 10:20:38 -0600 Subject: [PATCH 252/503] regcharclass.pl: Get code point folding to a seq Previously regcharclass.pl could tell if an input string was a multi-character fold of some Unicode code point. This commit adds the ability to return what that code point is. This capability will be used in a later commit. --- regcharclass.h | 1360 +++++++++++++++++++++++- regen/regcharclass.pl | 47 +- regen/regcharclass_multi_char_folds.pl | 15 +- 3 files changed, 1377 insertions(+), 45 deletions(-) diff --git a/regcharclass.h b/regcharclass.h index dbcf50a1f03c..9aa98ed4d580 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -239,7 +239,7 @@ /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('u', 'a') + %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ @@ -478,10 +478,436 @@ : 0 ) \ : ((e)-(s) > 3) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +( ( 0x81 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x93 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x85 == ((const U8*)s)[1] ) ? \ + ( ( 0xCC == ((const U8*)s)[2] ) ? \ + ( ( 0x88 == ((const U8*)s)[3] ) ? \ + ( ( 0xCC == ((const U8*)s)[4] ) ? \ + ( ( 0x80 == ((const U8*)s)[5] ) ? 0x1FE2 \ + : ( 0x81 == ((const U8*)s)[5] ) ? 0x3B0 : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 0x1FE7 : 0 )\ + : ( 0x93 == ((const U8*)s)[3] ) ? \ + ( ( 0xCC == ((const U8*)s)[4] ) ? \ + ( ( 0x80 == ((const U8*)s)[5] ) ? 0x1F52 \ + : ( 0x81 == ((const U8*)s)[5] ) ? 0x1F54 : 0x1F50 ) \ + : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 0x1F56 : 0x1F50 )\ + : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x89 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[4] ) && ( 0xB9 == ((const U8*)s)[5] ) ) ? 0x1FF7 : 0x1FF6 )\ + : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x8E == ((const U8*)s)[1] ) && ( 0xCE == ((const U8*)s)[2] ) ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +( ( 0xD5 == ((const U8*)s)[0] ) ? \ + ( ( 0xA5 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xD6 == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x587 : 0 )\ + : ( 0xB4 == ((const U8*)s)[1] ) ? \ + ( ( 0xD5 == ((const U8*)s)[2] ) ? \ + ( ( 0xA5 == ((const U8*)s)[3] ) ? 0xFB14 \ + : ( 0xAB == ((const U8*)s)[3] ) ? 0xFB15 \ + : ( 0xAD == ((const U8*)s)[3] ) ? 0xFB17 \ + : ( 0xB6 == ((const U8*)s)[3] ) ? 0xFB13 : 0 ) \ + : 0 ) \ + : ( ( ( 0xBE == ((const U8*)s)[1] ) && ( 0xD5 == ((const U8*)s)[2] ) ) && ( 0xB6 == ((const U8*)s)[3] ) ) ? 0xFB16 : 0 )\ + : ( 0xE1 == ((const U8*)s)[0] ) ? \ + ( ( 0xBC == ((const U8*)s)[1] ) ? \ + ( ( 0x80 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x81 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x82 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x83 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x84 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x85 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x86 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( 0x87 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0xA0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0xA1 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0xA2 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0xA3 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0xA4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0xA5 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0xA6 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0xA7 == ((const U8*)s)[2] ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0xBD == ((const U8*)s)[1] ) ? \ + ( ( 0xA0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0xA1 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0xA2 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0xA3 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0xA4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0xA5 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0xA6 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0xA7 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0xB0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0xB4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0xBC == ((const U8*)s)[2] ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +( ( 0x81 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x93 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x85 == ((const U8*)s)[1] ) ? \ + ( ( 0xCC == ((const U8*)s)[2] ) ? \ + ( ( 0x93 == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x89 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x8E == ((const U8*)s)[1] ) && ( 0xCE == ((const U8*)s)[2] ) ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +( ( 0xD5 == ((const U8*)s)[0] ) ? \ + ( ( 0xA5 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xD6 == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x587 : 0 )\ + : ( 0xB4 == ((const U8*)s)[1] ) ? \ + ( ( 0xD5 == ((const U8*)s)[2] ) ? \ + ( ( 0xA5 == ((const U8*)s)[3] ) ? 0xFB14 \ + : ( 0xAB == ((const U8*)s)[3] ) ? 0xFB15 \ + : ( 0xAD == ((const U8*)s)[3] ) ? 0xFB17 \ + : ( 0xB6 == ((const U8*)s)[3] ) ? 0xFB13 : 0 ) \ + : 0 ) \ + : ( ( ( 0xBE == ((const U8*)s)[1] ) && ( 0xD5 == ((const U8*)s)[2] ) ) && ( 0xB6 == ((const U8*)s)[3] ) ) ? 0xFB16 : 0 )\ + : ( 0xE1 == ((const U8*)s)[0] ) ? \ + ( ( 0xBC == ((const U8*)s)[1] ) ? \ + ( ( 0x80 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x81 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x82 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x83 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x84 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x85 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x86 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( 0x87 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0xA0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0xA1 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0xA2 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0xA3 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0xA4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0xA5 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0xA6 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0xA7 == ((const U8*)s)[2] ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0xBD == ((const U8*)s)[1] ) ? \ + ( ( 0xA0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0xA1 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0xA2 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0xA3 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0xA4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0xA5 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0xA6 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0xA7 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0xB0 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0xB4 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[3] ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0xBC == ((const U8*)s)[2] ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ + ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'H' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'I' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x87 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 0xDF : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'W' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'Y' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xC5 == ((const U8*)s)[0] ) ? \ + ( ( 0xBF == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 0xDF : 0 )\ + : 0 ) \ + : ( 0xCA == ((const U8*)s)[0] ) ? \ + ( ( ( 0xBC == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xDF ) == 'N' ) ) ? 0x149 : 0 )\ + : ( 0xCE == ((const U8*)s)[0] ) ? \ + ( ( 0xAC == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0xAE == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0xB1 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0xB7 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0xB9 == ((const U8*)s)[1] ) && ( 0xCD == ((const U8*)s)[2] ) ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xCF == ((const U8*)s)[0] ) ? \ + ( ( 0x81 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x93 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x85 == ((const U8*)s)[1] ) ? \ + ( ( 0xCC == ((const U8*)s)[2] ) ? \ + ( ( 0x93 == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x89 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x8E == ((const U8*)s)[1] ) && ( 0xCE == ((const U8*)s)[2] ) ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ + : ( 0xD5 == ((const U8*)s)[0] ) ? \ + ( ( 0xA5 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xD6 == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x587 : 0 )\ + : ( 0xB4 == ((const U8*)s)[1] ) ? \ + ( ( 0xD5 == ((const U8*)s)[2] ) ? \ + ( ( 0xA5 == ((const U8*)s)[3] ) ? 0xFB14 \ + : ( 0xAB == ((const U8*)s)[3] ) ? 0xFB15 \ + : ( 0xAD == ((const U8*)s)[3] ) ? 0xFB17 \ + : ( 0xB6 == ((const U8*)s)[3] ) ? 0xFB13 : 0 ) \ + : 0 ) \ + : ( ( ( 0xBE == ((const U8*)s)[1] ) && ( 0xD5 == ((const U8*)s)[2] ) ) && ( 0xB6 == ((const U8*)s)[3] ) ) ? 0xFB16 : 0 )\ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ + ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'H' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'I' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x87 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 0xDF : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'W' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'Y' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xC5 == ((const U8*)s)[0] ) ? \ + ( ( 0xBF == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'T' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ( 0xCA == ((const U8*)s)[0] ) && ( 0xBC == ((const U8*)s)[1] ) ) && ( ( ((const U8*)s)[2] & 0xDF ) == 'N' ) ) ? 0x149 : 0 )\ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ + ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'H' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'I' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x87 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 0xDF : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'W' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'Y' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xC5 == ((const U8*)s)[0] ) ? \ + ( ( 0xBF == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 0xDF : 0 )\ + : 0 ) \ + : ( 0xCA == ((const U8*)s)[0] ) ? \ + ( ( ( 0xBC == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xDF ) == 'N' ) ) ? 0x149 : 0 )\ + : ( 0xCE == ((const U8*)s)[0] ) ? \ + ( ( 0xAC == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0xAE == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0xB1 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[4] ) && ( 0xB9 == ((const U8*)s)[5] ) ) ? 0x1FB7 : 0x1FB6 )\ + : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0xB7 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[4] ) && ( 0xB9 == ((const U8*)s)[5] ) ) ? 0x1FC7 : 0x1FC6 )\ + : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( 0xB9 == ((const U8*)s)[1] ) ? \ + ( ( 0xCC == ((const U8*)s)[2] ) ? \ + ( ( 0x88 == ((const U8*)s)[3] ) ? \ + ( ( 0xCC == ((const U8*)s)[4] ) ? \ + ( ( 0x80 == ((const U8*)s)[5] ) ? 0x1FD2 \ + : ( 0x81 == ((const U8*)s)[5] ) ? 0x390 : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[4] ) && ( 0x82 == ((const U8*)s)[5] ) ) ? 0x1FD7 : 0 )\ + : 0 ) \ + : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : 0 ) \ + : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +( ((e)-(s) > 4) ? \ + ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ + ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'H' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'I' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x87 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'J' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8C == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[1] ) && ( 0xBF == ((const U8*)s)[2] ) ) ? 0xDF : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'T' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x88 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'W' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'Y' ) ? \ + ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0x8A == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xC5 == ((const U8*)s)[0] ) ? \ + ( ( 0xBF == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'T' ) ? 0xFB05 \ + : ( ( 0xC5 == ((const U8*)s)[2] ) && ( 0xBF == ((const U8*)s)[3] ) ) ? 0xDF : 0 )\ + : 0 ) \ + : ( 0xCA == ((const U8*)s)[0] ) ? \ + ( ( ( 0xBC == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xDF ) == 'N' ) ) ? 0x149 : 0 )\ + : ( 0xCE == ((const U8*)s)[0] ) ? \ + ( ( 0xAC == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0xAE == ((const U8*)s)[1] ) ? \ + ( ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0xB1 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0xB7 == ((const U8*)s)[1] ) ? \ + ( ( 0xCD == ((const U8*)s)[2] ) ? \ + ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0xB9 == ((const U8*)s)[1] ) && ( 0xCD == ((const U8*)s)[2] ) ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe(s,e) \ +( ((e)-(s) > 5) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) + /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('l', 'a') + %regcharclass_multi_char_folds::multi_char_folds('l', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_latin1_safe(s,e) \ @@ -497,10 +923,34 @@ : ( ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) && ( inRANGE_helper_(U8, ((const U8*)s)[1], 'S', 'T') || inRANGE_helper_(U8, ((const U8*)s)[1], 's', 't') ) ) ? 2 : 0 )\ : 0 ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_latin1_safe(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'S' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xDF ) == 'S' ) ? 0xDF \ + : ( ( ((const U8*)s)[1] & 0xDF ) == 'T' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('u', '3') + %regcharclass_multi_char_folds::multi_char_folds('u', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_utf8_safe(s,e) \ @@ -525,7 +975,7 @@ /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('l', '3') + %regcharclass_multi_char_folds::multi_char_folds('l', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_latin1_safe(s,e) \ @@ -534,7 +984,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('u', 'h') + %regcharclass_multi_char_folds::multi_char_folds('u', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_utf8_safe(s,e) \ @@ -606,7 +1056,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('l', 'h') + %regcharclass_multi_char_folds::multi_char_folds('l', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_latin1_safe(s,e) \ @@ -996,7 +1446,7 @@ /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('u', 'a') + %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ @@ -1232,10 +1682,421 @@ : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ : ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +( ( 0x52 == ((const U8*)s)[1] ) ? \ + ( ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( ( 0xB8 == ((const U8*)s)[3] ) && ( 0x53 == ((const U8*)s)[4] ) ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x587 : 0 )\ + : ( 0x63 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB8 == ((const U8*)s)[3] ) && ( 0x52 == ((const U8*)s)[4] ) ) ? ( ( 0x46 == ((const U8*)s)[5] ) ? 0xFB14\ + : ( 0x52 == ((const U8*)s)[5] ) ? 0xFB15 \ + : ( 0x54 == ((const U8*)s)[5] ) ? 0xFB17 \ + : ( 0x65 == ((const U8*)s)[5] ) ? 0xFB13 : 0 ) : 0 )\ + : ( ( ( ( 0x72 == ((const U8*)s)[2] ) && ( 0xB8 == ((const U8*)s)[3] ) ) && ( 0x52 == ((const U8*)s)[4] ) ) && ( 0x65 == ((const U8*)s)[5] ) ) ? 0xFB16 : 0 )\ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +( ( 0xBF == ((const U8*)s)[0] ) ? \ + ( ( 0x67 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0x68 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0x6A == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0x48 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0x57 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0x63 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0x70 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +( ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8F == ((const U8*)s)[0] ) ? \ + ( ( 0x73 == ((const U8*)s)[1] ) ? \ + ( ( 0x8F == ((const U8*)s)[2] ) ? \ + ( ( 0x73 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8F == ((const U8*)s)[1] ) ? \ + ( ( 0x73 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAB == ((const U8*)s)[0] ) ? \ + ( ( ( 0x70 == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB4 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[4] ) && ( 0x68 == ((const U8*)s)[5] ) ) ? 0x1FB7 : 0x1FB6 )\ + : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x66 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[4] ) && ( 0x68 == ((const U8*)s)[5] ) ) ? 0x1FC7 : 0x1FC6 )\ + : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( 0x68 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x49 == ((const U8*)s)[3] ) ? \ + ( ( 0xAF == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1FD2 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x390 : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1FD7 : 0 )\ + : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : 0 ) \ + : ( 0xB5 == ((const U8*)s)[0] ) ? \ + ( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x62 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x49 == ((const U8*)s)[3] ) ? \ + ( ( 0xAF == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1FE2 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x3B0 : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1FE7 : 0 )\ + : ( 0x62 == ((const U8*)s)[3] ) ? \ + ( ( 0xAF == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1F52 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x1F54 : 0x1F50 ) \ + : ( ( 0xB1 == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1F56 : 0x1F50 )\ + : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[4] ) && ( 0x68 == ((const U8*)s)[5] ) ) ? 0x1FF7 : 0x1FF6 )\ + : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB4 == ((const U8*)s)[2] ) ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ + : ( 0xB8 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x62 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x62 == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB4 == ((const U8*)s)[2] ) ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +( ( 0xBF == ((const U8*)s)[0] ) ? \ + ( ( 0x67 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0x68 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0x6A == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0x48 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0x57 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0x63 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[3] ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0x70 == ((const U8*)s)[2] ) && ( 0xB4 == ((const U8*)s)[3] ) ) && ( 0x68 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8F == ((const U8*)s)[0] ) ? \ + ( ( 0x73 == ((const U8*)s)[1] ) ? \ + ( ( 0x8F == ((const U8*)s)[2] ) ? \ + ( ( 0x73 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8F == ((const U8*)s)[1] ) ? \ + ( ( 0x73 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAB == ((const U8*)s)[0] ) ? \ + ( ( ( 0x70 == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB4 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x66 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0x68 == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xB5 == ((const U8*)s)[0] ) ? \ + ( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x62 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x62 == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xB1 == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB4 == ((const U8*)s)[2] ) ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8F == ((const U8*)s)[0] ) ? \ + ( ( 0x73 == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8F == ((const U8*)s)[1] ) ? \ + ( ( 0x73 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( ( ( 0xAB == ((const U8*)s)[0] ) && ( 0x70 == ((const U8*)s)[1] ) ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe(s,e) \ +( ((e)-(s) > 5) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ +: ((e)-(s) > 4) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8F == ((const U8*)s)[0] ) ? \ + ( ( 0x73 == ((const U8*)s)[1] ) ? \ + ( ( 0x8F == ((const U8*)s)[2] ) ? \ + ( ( 0x73 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8F == ((const U8*)s)[1] ) ? \ + ( ( 0x73 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAB == ((const U8*)s)[0] ) ? \ + ( ( ( 0x70 == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB4 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x66 == ((const U8*)s)[1] ) ? \ + ( ( 0xB1 == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0x68 == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xB5 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) + /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('l', 'a') + %regcharclass_multi_char_folds::multi_char_folds('l', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_latin1_safe(s,e) \ @@ -1251,10 +2112,34 @@ : ( ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) && ( ( ((const U8*)s)[1] & 0xBE ) == 's' ) ) ? 2 : 0 )\ : 0 ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_latin1_safe(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('u', '3') + %regcharclass_multi_char_folds::multi_char_folds('u', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_utf8_safe(s,e) \ @@ -1279,7 +2164,7 @@ /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('l', '3') + %regcharclass_multi_char_folds::multi_char_folds('l', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_latin1_safe(s,e) \ @@ -1288,7 +2173,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('u', 'h') + %regcharclass_multi_char_folds::multi_char_folds('u', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_utf8_safe(s,e) \ @@ -1358,7 +2243,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('l', 'h') + %regcharclass_multi_char_folds::multi_char_folds('l', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_latin1_safe(s,e) \ @@ -1739,7 +2624,7 @@ /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('u', 'a') + %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ @@ -1975,10 +2860,421 @@ : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ : ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +( ( 0x52 == ((const U8*)s)[1] ) ? \ + ( ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( ( 0xB7 == ((const U8*)s)[3] ) && ( 0x53 == ((const U8*)s)[4] ) ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x587 : 0 )\ + : ( 0x62 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB7 == ((const U8*)s)[3] ) && ( 0x52 == ((const U8*)s)[4] ) ) ? ( ( 0x46 == ((const U8*)s)[5] ) ? 0xFB14\ + : ( 0x52 == ((const U8*)s)[5] ) ? 0xFB15 \ + : ( 0x54 == ((const U8*)s)[5] ) ? 0xFB17 \ + : ( 0x64 == ((const U8*)s)[5] ) ? 0xFB13 : 0 ) : 0 )\ + : ( ( ( ( 0x71 == ((const U8*)s)[2] ) && ( 0xB7 == ((const U8*)s)[3] ) ) && ( 0x52 == ((const U8*)s)[4] ) ) && ( 0x64 == ((const U8*)s)[5] ) ) ? 0xFB16 : 0 )\ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +( ( 0xBF == ((const U8*)s)[0] ) ? \ + ( ( 0x66 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0x67 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0x69 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0x48 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0x57 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0x62 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0x6A == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +( ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8E == ((const U8*)s)[0] ) ? \ + ( ( 0x72 == ((const U8*)s)[1] ) ? \ + ( ( 0x8E == ((const U8*)s)[2] ) ? \ + ( ( 0x72 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8E == ((const U8*)s)[1] ) ? \ + ( ( 0x72 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAA == ((const U8*)s)[0] ) ? \ + ( ( ( 0x6A == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB3 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[4] ) && ( 0x67 == ((const U8*)s)[5] ) ) ? 0x1FB7 : 0x1FB6 )\ + : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x65 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[4] ) && ( 0x67 == ((const U8*)s)[5] ) ) ? 0x1FC7 : 0x1FC6 )\ + : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( 0x67 == ((const U8*)s)[1] ) ? \ + ( ( 0xAD == ((const U8*)s)[2] ) ? \ + ( ( 0x49 == ((const U8*)s)[3] ) ? \ + ( ( 0xAD == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1FD2 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x390 : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1FD7 : 0 )\ + : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : 0 ) \ + : ( 0xB4 == ((const U8*)s)[0] ) ? \ + ( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAD == ((const U8*)s)[2] ) && ( 0x5F == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAD == ((const U8*)s)[2] ) ? \ + ( ( 0x49 == ((const U8*)s)[3] ) ? \ + ( ( 0xAD == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1FE2 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x3B0 : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1FE7 : 0 )\ + : ( 0x5F == ((const U8*)s)[3] ) ? \ + ( ( 0xAD == ((const U8*)s)[4] ) ? \ + ( ( 0x41 == ((const U8*)s)[5] ) ? 0x1F52 \ + : ( 0x42 == ((const U8*)s)[5] ) ? 0x1F54 : 0x1F50 ) \ + : ( ( 0xAF == ((const U8*)s)[4] ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x1F56 : 0x1F50 )\ + : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[4] ) && ( 0x67 == ((const U8*)s)[5] ) ) ? 0x1FF7 : 0x1FF6 )\ + : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB3 == ((const U8*)s)[2] ) ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ + : ( 0xB7 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAD == ((const U8*)s)[2] ) && ( 0x5F == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAD == ((const U8*)s)[2] ) ? \ + ( ( 0x5F == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB3 == ((const U8*)s)[2] ) ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +( ( 0xBF == ((const U8*)s)[0] ) ? \ + ( ( 0x66 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F80 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F81 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F82 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F83 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F84 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F85 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F86 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F87 : 0 )\ + : ( 0x67 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F90 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F91 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F92 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F93 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F94 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F95 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F96 : 0 )\ + : ( ( ( 0x48 == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1F97 : 0 )\ + : ( 0x69 == ((const U8*)s)[1] ) ? \ + ( ( 0x41 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA0 : 0 )\ + : ( 0x42 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA1 : 0 )\ + : ( 0x43 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA2 : 0 )\ + : ( 0x44 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA3 : 0 )\ + : ( 0x45 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA4 : 0 )\ + : ( 0x46 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA5 : 0 )\ + : ( 0x47 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA6 : 0 )\ + : ( 0x48 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FA7 : 0 )\ + : ( 0x57 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FB2 : 0 )\ + : ( 0x62 == ((const U8*)s)[2] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[3] ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FC2 : 0 )\ + : ( ( ( 0x6A == ((const U8*)s)[2] ) && ( 0xB3 == ((const U8*)s)[3] ) ) && ( 0x67 == ((const U8*)s)[4] ) ) ? 0x1FF2 : 0 )\ + : 0 ) \ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8E == ((const U8*)s)[0] ) ? \ + ( ( 0x72 == ((const U8*)s)[1] ) ? \ + ( ( 0x8E == ((const U8*)s)[2] ) ? \ + ( ( 0x72 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8E == ((const U8*)s)[1] ) ? \ + ( ( 0x72 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAA == ((const U8*)s)[0] ) ? \ + ( ( ( 0x6A == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB3 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x65 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0x67 == ((const U8*)s)[1] ) && ( 0xAF == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xB4 == ((const U8*)s)[0] ) ? \ + ( ( 0x42 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xAD == ((const U8*)s)[2] ) && ( 0x5F == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ + : ( 0x46 == ((const U8*)s)[1] ) ? \ + ( ( 0xAD == ((const U8*)s)[2] ) ? \ + ( ( 0x5F == ((const U8*)s)[3] ) ? 0x1F50 : 0 ) \ + : ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FE6 : 0 )\ + : ( 0x4A == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FF6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ + : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB3 == ((const U8*)s)[2] ) ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ + : 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8E == ((const U8*)s)[0] ) ? \ + ( ( 0x72 == ((const U8*)s)[1] ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8E == ((const U8*)s)[1] ) ? \ + ( ( 0x72 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( ( ( 0xAA == ((const U8*)s)[0] ) && ( 0x6A == ((const U8*)s)[1] ) ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + + +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_utf8_safe(s,e) \ +( ((e)-(s) > 5) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ +: ((e)-(s) > 4) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ + ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ + ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 0x130 : 0 )\ + : ( 0x8E == ((const U8*)s)[0] ) ? \ + ( ( 0x72 == ((const U8*)s)[1] ) ? \ + ( ( 0x8E == ((const U8*)s)[2] ) ? \ + ( ( 0x72 == ((const U8*)s)[3] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'j' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x53 == ((const U8*)s)[2] ) ) ? 0x1F0 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( 0x8E == ((const U8*)s)[1] ) ? \ + ( ( 0x72 == ((const U8*)s)[2] ) ? 0x59 : 0 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 't' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x49 == ((const U8*)s)[2] ) ) ? 0x1E97 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'w' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E98 : 0 )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'y' ) ? \ + ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x51 == ((const U8*)s)[2] ) ) ? 0x1E99 : 0 )\ + : ( 0xAA == ((const U8*)s)[0] ) ? \ + ( ( ( 0x6A == ((const U8*)s)[1] ) && ( ( ((const U8*)s)[2] & 0xBF ) == 'n' ) ) ? 0x149 : 0 )\ + : ( 0xB3 == ((const U8*)s)[0] ) ? \ + ( ( 0x53 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB4 : 0 )\ + : ( 0x55 == ((const U8*)s)[1] ) ? \ + ( ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC4 : 0 )\ + : ( 0x58 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FB6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FB3 : 0 )\ + : ( 0x65 == ((const U8*)s)[1] ) ? \ + ( ( 0xAF == ((const U8*)s)[2] ) ? \ + ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ + : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ + : ( ( ( 0x67 == ((const U8*)s)[1] ) && ( 0xAF == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ + : ( 0xB4 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) + /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character - ®charclass_multi_char_folds::multi_char_folds('l', 'a') + %regcharclass_multi_char_folds::multi_char_folds('l', 'a') */ /*** GENERATED CODE ***/ #define is_MULTI_CHAR_FOLD_latin1_safe(s,e) \ @@ -1994,10 +3290,34 @@ : ( ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) && ( ( ((const U8*)s)[1] & 0xBE ) == 's' ) ) ? 2 : 0 )\ : 0 ) +/*** GENERATED CODE ***/ +#define what_MULTI_CHAR_FOLD_latin1_safe(s,e) \ +( ((e)-(s) > 2) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ + : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: ((e)-(s) > 1) ? \ + ( ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? 0xFB00 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) ? 0xFB01 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ? 0xFB02 : 0 ) \ + : ( ( ((const U8*)s)[0] & 0xBF ) == 's' ) ? \ + ( ( ( ((const U8*)s)[1] & 0xBF ) == 's' ) ? 0x59 \ + : ( ( ((const U8*)s)[1] & 0xBF ) == 't' ) ? 0xFB05 : 0 ) \ + : 0 ) \ +: 0 ) + /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('u', '3') + %regcharclass_multi_char_folds::multi_char_folds('u', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_utf8_safe(s,e) \ @@ -2022,7 +3342,7 @@ /* THREE_CHAR_FOLD: A three-character multi-char fold - ®charclass_multi_char_folds::multi_char_folds('l', '3') + %regcharclass_multi_char_folds::multi_char_folds('l', '3') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_latin1_safe(s,e) \ @@ -2031,7 +3351,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('u', 'h') + %regcharclass_multi_char_folds::multi_char_folds('u', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_utf8_safe(s,e) \ @@ -2101,7 +3421,7 @@ /* THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds - ®charclass_multi_char_folds::multi_char_folds('l', 'h') + %regcharclass_multi_char_folds::multi_char_folds('l', 'h') */ /*** GENERATED CODE ***/ #define is_THREE_CHAR_FOLD_HEAD_latin1_safe(s,e) \ @@ -2297,6 +3617,6 @@ * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * e3e72d7df46550e894d860fec08cc81ca9e1d2205a81fb48733e74b8853281be regen/regcharclass.pl - * c0a5e4cb2b9ffad78691938e122c1310bbc98aca2364af243e5c6b2ec0f59dc3 regen/regcharclass_multi_char_folds.pl + * f0ac417314b8da8e05d386ca3d0d8074e38ecd9dc77a7d966aa48ec4ec247e2a regen/regcharclass.pl + * b2f896452d2b30da3e04800f478c60c1fd0b03d6b668689b020f1e3cf1f1cdd9 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 8d97a79f7a72..5fd8e255e318 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -366,6 +366,7 @@ sub val_fmt sub new { my $class= shift; my %opt= @_; + my %hash_return; for ( qw(op txt) ) { die "in " . __PACKAGE__ . " constructor '$_;' is a mandatory field" if !exists $opt{$_}; @@ -437,19 +438,31 @@ sub new { die "eval '$1' failed: $@" if $@; push @{$opt{txt}}, @results; next; + } elsif ($str =~ / ^ % \s* ( .* ) /x) { # user-furnished sub() call + %hash_return = eval "$1"; + die "eval '$1' failed: $@" if $@; + push @{$opt{txt}}, keys %hash_return; + die "Only one multi character expansion currently allowed per rule" + if $self->{multi_maps}; + next; } else { die "Unparsable line: $txt\n"; } my ( $cp, $cp_high, $low, $latin1, $utf8 ) = __uni_latin1($charset, $a2n, $str ); + my $from; + if (defined $hash_return{"\"$str\""}) { + $from = $hash_return{"\"$str\""}; + $from = $a2n->[$from] if $from < 256; + } my $UTF8= $low || $utf8; my $LATIN1= $low || $latin1; my $high = (scalar grep { $_ < 256 } @$cp) ? 0 : $utf8; #die Dumper($txt,$cp,$low,$latin1,$utf8) # if $txt=~/NEL/ or $utf8 and @$utf8>3; - @{ $self->{strs}{$str} }{qw( str txt low utf8 latin1 high cp cp_high UTF8 LATIN1 )}= - ( $str, $txt, $low, $utf8, $latin1, $high, $cp, $cp_high, $UTF8, $LATIN1 ); + @{ $self->{strs}{$str} }{qw( str txt low utf8 latin1 high cp cp_high UTF8 LATIN1 from )}= + ( $str, $txt, $low, $utf8, $latin1, $high, $cp, $cp_high, $UTF8, $LATIN1, $from ); my $rec= $self->{strs}{$str}; foreach my $key ( qw(low utf8 latin1 high cp cp_high UTF8 LATIN1) ) { $self->{size}{$key}{ 0 + @{ $self->{strs}{$str}{$key} } }++ @@ -522,9 +535,6 @@ ($) sub _optree { my ( $self, $trie, $test_type, $ret_type, $else, $depth )= @_; return unless defined $trie; - if ( $self->{has_multi} and $ret_type =~ /cp|both/ ) { - die "Can't do 'cp' optree from multi-codepoint strings"; - } $ret_type ||= 'len'; $else= 0 unless defined $else; $depth= 0 unless defined $depth; @@ -535,13 +545,16 @@ sub _optree { if (exists $trie->{''} ) { # we can now update the "else" value, anything failing to match # after this point should return the value from this. + my $prefix = $self->{strs}{ $trie->{''} }; if ( $ret_type eq 'cp' ) { - $else= $self->{strs}{ $trie->{''} }{cp}[0]; + $else= $prefix->{from}; + $else= $self->{strs}{ $trie->{''} }{cp}[0] unless defined $else; $else= $self->val_fmt($else) if $else > 9; } elsif ( $ret_type eq 'len' ) { $else= $depth; } elsif ( $ret_type eq 'both') { - $else= $self->{strs}{ $trie->{''} }{cp}[0]; + $else= $prefix->{from}; + $else= $self->{strs}{ $trie->{''} }{cp}[0] unless defined $else; $else= $self->val_fmt($else) if $else > 9; $else= "len=$depth, $else"; } @@ -1648,36 +1661,36 @@ sub make_macro { \p{_Perl_Quotemeta} MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character -=> UTF8 :safe -®charclass_multi_char_folds::multi_char_folds('u', 'a') +=> UTF8 UTF8-cp :safe +%regcharclass_multi_char_folds::multi_char_folds('u', 'a') MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character -=> LATIN1 : safe -®charclass_multi_char_folds::multi_char_folds('l', 'a') +=> LATIN1 LATIN1-cp : safe +%regcharclass_multi_char_folds::multi_char_folds('l', 'a') THREE_CHAR_FOLD: A three-character multi-char fold => UTF8 :safe -®charclass_multi_char_folds::multi_char_folds('u', '3') +%regcharclass_multi_char_folds::multi_char_folds('u', '3') THREE_CHAR_FOLD: A three-character multi-char fold => LATIN1 :safe -®charclass_multi_char_folds::multi_char_folds('l', '3') +%regcharclass_multi_char_folds::multi_char_folds('l', '3') THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds => UTF8 :safe -®charclass_multi_char_folds::multi_char_folds('u', 'h') +%regcharclass_multi_char_folds::multi_char_folds('u', 'h') THREE_CHAR_FOLD_HEAD: The first two of three-character multi-char folds => LATIN1 :safe -®charclass_multi_char_folds::multi_char_folds('l', 'h') +%regcharclass_multi_char_folds::multi_char_folds('l', 'h') # #THREE_CHAR_FOLD_NON_FINAL: The first or middle character of multi-char folds #=> UTF8 :safe -#®charclass_multi_char_folds::multi_char_folds('u', 'fm') +#%regcharclass_multi_char_folds::multi_char_folds('u', 'fm') # #THREE_CHAR_FOLD_NON_FINAL: The first or middle character of multi-char folds #=> LATIN1 :safe -#®charclass_multi_char_folds::multi_char_folds('l', 'fm') +#%regcharclass_multi_char_folds::multi_char_folds('l', 'fm') FOLDS_TO_MULTI: characters that fold to multi-char strings => UTF8 :fast diff --git a/regen/regcharclass_multi_char_folds.pl b/regen/regcharclass_multi_char_folds.pl index a72e1497cee8..e7c6fb91bfa4 100644 --- a/regen/regcharclass_multi_char_folds.pl +++ b/regen/regcharclass_multi_char_folds.pl @@ -42,6 +42,7 @@ ($;) my @ret; # Look at each element in this level's array. + if (ref $fold_ref->[$i]) { foreach my $j (0 .. @{$fold_ref->[$i]} - 1) { # Append its representation to what we have currently @@ -56,6 +57,7 @@ ($;) push @ret, &gen_combinations($fold_ref, $new_string, $i + 1); } } + } return @ret; } @@ -87,7 +89,7 @@ ($$) } my @folds; - my @output_folds; + my %output_folds; for my $i (0 .. @$folds_ref - 1) { next unless ref $folds_ref->[$i]; # Skip single-char folds @@ -122,10 +124,8 @@ ($$) $fold = "\"$fold\""; # Skip if something else already has this fold - next if grep { $_ eq $fold } @output_folds; + next if grep { $_ eq $fold } keys %output_folds; - # If the fold is to a cased letter, replace the entry with an - # array which also includes its upper case. my $this_fold_ref = \@folds; for my $j (0 .. @$this_fold_ref - 1) { my $this_ord = $this_fold_ref->[$j]; @@ -143,8 +143,7 @@ ($$) } # Then generate all combinations of upper/lower case of the fold. - push @output_folds, gen_combinations($this_fold_ref); - + $output_folds{$_} = $cp_ref->[$i] for gen_combinations($this_fold_ref); } # \x17F is the small LONG S, which folds to 's'. Both Capital and small @@ -167,9 +166,9 @@ ($$) # # No combinations of this with 's' need be added, as any of these # containing 's' are prohibited under /iaa. - push @output_folds, '"\x{17F}\x{17F}"' if $type eq 'u' && $range eq 'a'; + $output_folds{"\"\x{17F}\x{17F}\""} = 0xDF if $type eq 'u' && $range eq 'a'; - return @output_folds; + return %output_folds; } 1 From 22025c3030a7de7ac2690f126304d8d8b5d7656a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 18 Oct 2020 10:46:14 -0600 Subject: [PATCH 253/503] regexec.c: Trim trailing blanks --- regexec.c | 174 +++++++++++++++++++++++++++--------------------------- 1 file changed, 87 insertions(+), 87 deletions(-) diff --git a/regexec.c b/regexec.c index f3edc3a7bbe0..f1ba07b5e1fd 100644 --- a/regexec.c +++ b/regexec.c @@ -209,7 +209,7 @@ static const char non_utf8_target_but_utf8_required[] rn = (rn->flags == 0) ? NEXTOPER(NEXTOPER(rn)) : rn + ARG(rn); \ else rn += NEXT_OFF(rn); \ } \ -} STMT_END +} STMT_END #define SLAB_FIRST(s) (&(s)->states[0]) #define SLAB_LAST(s) (&(s)->states[PERL_REGMATCH_SLAB_SLOTS-1]) @@ -250,7 +250,7 @@ S_regcppush(pTHX_ const regexp *rex, I32 parenfloor, U32 maxopenparen _pDEPTH) (long)parenfloor); SSGROW(total_elems + REGCP_FRAME_ELEMS); - + DEBUG_BUFFERS_r( if ((int)maxopenparen > (int)parenfloor) Perl_re_exec_indentf( aTHX_ @@ -1007,7 +1007,7 @@ Perl_re_intuit_start(pTHX_ /* Substring at constant offset from beg-of-str... */ SSize_t slen = SvCUR(check); char *s = HOP3c(strpos, prog->check_offset_min, strend); - + DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ " Looking for check substr at fixed offset %" IVdf "...\n", (IV)prog->check_offset_min)); @@ -1053,7 +1053,7 @@ Perl_re_intuit_start(pTHX_ #endif restart: - + /* This is the (re)entry point of the main loop in this function. * The goal of this loop is to: * 1) find the "check" substring in the region rx_origin..strend @@ -1094,7 +1094,7 @@ Perl_re_intuit_start(pTHX_ (IV)end_shift, (IV)prog->check_end_shift); }); - + end_point = HOPBACK3(strend, end_shift, rx_origin); if (!end_point) goto fail_finish; @@ -1526,9 +1526,9 @@ Perl_re_intuit_start(pTHX_ rx_max_float = HOP3c(check_at, -start_shift, strbeg); endpos = HOP3clim(rx_max_float, cl_l, strend); } - else + else endpos= strend; - + DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ " looking for class: start_shift: %" IVdf " check_at: %" IVdf " rx_origin: %" IVdf " endpos: %" IVdf "\n", @@ -2155,7 +2155,7 @@ S_get_break_val_cp_checked(SV* const invlist, const UV cp_in) { /* annoyingly all the vars in this routine have different names from their counterparts in regmatch. /grrr */ STATIC char * -S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, +S_find_byclass(pTHX_ regexp * prog, const regnode *c, char *s, const char *strend, regmatch_info *reginfo) { @@ -3671,13 +3671,13 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, } multiline = prog->extflags & RXf_PMf_MULTILINE; - + if (strend - s < (minlen+(prog->check_offset_min<0?prog->check_offset_min:0))) { DEBUG_EXECUTE_r(Perl_re_printf( aTHX_ "String too short [regexec_flags]...\n")); goto phooey; } - + /* Check validity of program. */ if (UCHARAT(progi->program) != REG_MAGIC) { Perl_croak(aTHX_ "corrupted regexp program"); @@ -3933,7 +3933,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, back_max = prog->float_max_offset; back_min = prog->float_min_offset; } - + if (back_min<0) { last = strend; } else { @@ -3992,7 +3992,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, ((must == prog->anchored_substr || must == prog->anchored_utf8) ? "anchored" : "floating"), quoted, RE_SV_TAIL(must)); - }); + }); goto phooey; } else if ( (c = progi->regstclass) ) { @@ -4160,7 +4160,7 @@ Perl_regexec_flags(pTHX_ REGEXP * const rx, char *stringarg, char *strend, LEAVE_SCOPE(oldsave); - if (RXp_PAREN_NAMES(prog)) + if (RXp_PAREN_NAMES(prog)) (void)hv_iterinit(RXp_PAREN_NAMES(prog)); /* make sure $`, $&, $', and $digit will work later */ @@ -4328,33 +4328,33 @@ S_debug_start_match(pTHX_ const REGEXP *prog, const bool utf8_target, PERL_ARGS_ASSERT_DEBUG_START_MATCH; - if (!PL_colorset) - reginitcolors(); + if (!PL_colorset) + reginitcolors(); { - RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), + RE_PV_QUOTED_DECL(s0, utf8_pat, PERL_DEBUG_PAD_ZERO(0), RX_PRECOMP_const(prog), RX_PRELEN(prog), PL_dump_re_max_len); - + RE_PV_QUOTED_DECL(s1, utf8_target, PERL_DEBUG_PAD_ZERO(1), start, end - start, PL_dump_re_max_len); - + Perl_re_printf( aTHX_ - "%s%s REx%s %s against %s\n", - PL_colors[4], blurb, PL_colors[5], s0, s1); - + "%s%s REx%s %s against %s\n", + PL_colors[4], blurb, PL_colors[5], s0, s1); + if (utf8_target||utf8_pat) Perl_re_printf( aTHX_ "UTF-8 %s%s%s...\n", utf8_pat ? "pattern" : "", utf8_pat && utf8_target ? " and " : "", utf8_target ? "string" : "" - ); + ); } } STATIC void -S_dump_exec_pos(pTHX_ const char *locinput, - const regnode *scan, - const char *loc_regeol, - const char *loc_bostr, +S_dump_exec_pos(pTHX_ const char *locinput, + const regnode *scan, + const char *loc_regeol, + const char *loc_bostr, const char *loc_reg_starttry, const bool utf8_target, const U32 depth @@ -4392,11 +4392,11 @@ S_dump_exec_pos(pTHX_ const char *locinput, RE_PV_COLOR_DECL(s0,len0,is_uni,PERL_DEBUG_PAD(0), (locinput - pref_len),pref0_len, PL_dump_re_max_len, 4, 5); - + RE_PV_COLOR_DECL(s1,len1,is_uni,PERL_DEBUG_PAD(1), (locinput - pref_len + pref0_len), pref_len - pref0_len, PL_dump_re_max_len, 2, 3); - + RE_PV_COLOR_DECL(s2,len2,is_uni,PERL_DEBUG_PAD(2), locinput, loc_regeol - locinput, 10, 0, 1); @@ -4417,7 +4417,7 @@ S_dump_exec_pos(pTHX_ const char *locinput, #endif /* reg_check_named_buff_matched() - * Checks to see if a named buffer has matched. The data array of + * Checks to see if a named buffer has matched. The data array of * buffer numbers corresponding to the buffer is expected to reside * in the regexp->data->data array in the slot stored in the ARG() of * node involved. Note that this routine doesn't actually care about the @@ -6017,7 +6017,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) 3 * rex->nparens : MAX_RECURSE_EVAL_NOCHANGE_DEPTH; regmatch_state *yes_state = NULL; /* state to pop to on success of subpattern */ - /* mark_state piggy backs on the yes_state logic so that when we unwind + /* mark_state piggy backs on the yes_state logic so that when we unwind the stack on success we can update the mark_state as we go */ regmatch_state *mark_state = NULL; /* last mark state we have seen */ regmatch_state *cur_eval = NULL; /* most recent EVAL_AB state */ @@ -6028,7 +6028,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) char *startpoint = locinput; SV *popmark = NULL; /* are we looking for a mark? */ SV *sv_commit = NULL; /* last mark name seen in failure */ - SV *sv_yes_mark = NULL; /* last mark name we have seen + SV *sv_yes_mark = NULL; /* last mark name we have seen during a successful match */ U32 lastopen = 0; /* last open we saw */ bool has_cutgroup = RXp_HAS_CUTGROUP(rex) ? 1 : 0; @@ -6189,7 +6189,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) #define ST st->u.trie case TRIEC: /* (ab|cd) with known charclass */ /* In this case the charclass data is available inline so - we can fail fast without a lot of extra overhead. + we can fail fast without a lot of extra overhead. */ if ( ! NEXTCHR_IS_EOS && locinput < loceol @@ -6293,7 +6293,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } } - { + { U8 *uc = ( U8* )locinput; STRLEN len = 0; @@ -6538,7 +6538,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) tmp ? pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 0, PL_colors[0], PL_colors[1], (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0)|PERL_PV_ESCAPE_NONASCII - ) + ) : "not compiled under -Dr", PL_colors[5] ); }); @@ -7421,7 +7421,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) } break; - + case REFFLN: /* /\g{name}/il */ { /* The capture buffer cases. The ones beginning with N for the named buffers just convert to the equivalent numbered and @@ -7584,7 +7584,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) arg= (U32)ARG(scan); if (cur_eval && cur_eval->locinput == locinput) { if ( ++nochange_depth > max_nochange_depth ) - Perl_croak(aTHX_ + Perl_croak(aTHX_ "Pattern subroutine nesting without pos change" " exceeded limit in regex"); } else { @@ -7636,7 +7636,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) Perl_croak(aTHX_ "EVAL without pos change exceeded limit in regex"); } else { nochange_depth = 0; - } + } { /* execute the code in the {...} */ @@ -7920,7 +7920,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) DEBUG_EXECUTE_r( debug_start_match(re_sv, utf8_target, locinput, reginfo->strend, "EVAL/GOSUB: Matching embedded"); - ); + ); startpoint = rei->program + 1; EVAL_CLOSE_PAREN_CLEAR(st); /* ST.close_paren = 0; * close_paren only for GOSUB */ @@ -8032,7 +8032,7 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) is_utf8_pat = reginfo->is_utf8_pat = cBOOL(RX_UTF8(rex_sv)); SET_reg_curpm(rex_sv); rex = ReANY(rex_sv); - rexi = RXi_GET(rex); + rexi = RXi_GET(rex); REGCP_UNWIND(ST.lastcp); regcppop(rex, &maxopenparen); @@ -8095,8 +8095,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) if (ARG2L(scan)){ regnode *cursor; for (cursor=scan; - cursor && OP(cursor)!=END; - cursor=regnext(cursor)) + cursor && OP(cursor)!=END; + cursor=regnext(cursor)) { if ( OP(cursor)==CLOSE ){ n = ARG(cursor); @@ -8215,19 +8215,19 @@ I and O refer to inner and outer, C and W refer to CURLYX and WHILEM: cur_ curlyx backtrack stack ------ --------------- -NULL +NULL CO -CI ai -CO ai bi +CI ai +CO ai bi NULL ai bi bo At this point the pattern succeeds, and we work back down the stack to clean up, restoring as we go: -CO ai bi -CI ai +CO ai bi +CI ai CO -NULL +NULL *******************************************************************/ @@ -8237,7 +8237,7 @@ NULL { /* No need to save/restore up to this paren */ I32 parenfloor = scan->flags; - + assert(next); /* keep Coverity happy */ if (OP(PREVOPER(next)) == NOTHING) /* LONGJMP */ next += ARG(next); @@ -8297,7 +8297,7 @@ NULL ST.save_lastloc = cur_curlyx->u.curlyx.lastloc; ST.cache_offset = 0; ST.cache_mask = 0; - + DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "WHILEM: matched %ld out of %d..%d\n", depth, (long)n, min, max) @@ -8557,7 +8557,7 @@ NULL no_final = 1; if (st->u.mark.mark_name) sv_commit = st->u.mark.mark_name; - sayNO; + sayNO; NOT_REACHED; /* NOTREACHED */ case BRANCH_next: @@ -8584,7 +8584,7 @@ NULL } continue; /* execute next BRANCH[J] op */ /* NOTREACHED */ - + case MINMOD: /* next op will be non-greedy, e.g. A*? */ minmod = 1; break; @@ -8654,7 +8654,7 @@ NULL if (EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags)) goto fake_end; - + { I32 max = (ST.minmod ? ARG1(ST.me) : ARG2(ST.me)); if ( max == REG_INFTY || ST.count < max ) @@ -8666,7 +8666,7 @@ NULL REGCP_UNWIND(ST.cp); - if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ + if (ST.minmod || ST.count < ARG1(ST.me) /* min*/ || EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags)) sayNO; @@ -8744,13 +8744,13 @@ NULL if (EVAL_CLOSE_PAREN_IS_TRUE(cur_eval,(U32)ST.me->flags)) { - if (ST.count) + if (ST.count) goto fake_end; else sayNO; } } - + PUSH_STATE_GOTO(CURLYM_B, ST.B, locinput, loceol, /* match B */ script_run_begin); NOT_REACHED; /* NOTREACHED */ @@ -8845,7 +8845,7 @@ NULL else { regnode *text_node = next; - if (! HAS_TEXT(text_node)) + if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); if (! HAS_TEXT(text_node)) @@ -9148,7 +9148,7 @@ NULL (long)(locinput - startpos), (long)(reginfo->till - startpos), PL_colors[5])); - + sayNO_SILENT; /* Cannot match: too short. */ } sayYES; /* Success! */ @@ -9167,7 +9167,7 @@ NULL ST.start = locinput; ST.end = loceol; ST.count = 1; - goto do_ifmatch; + goto do_ifmatch; case UNLESSM: /* -ve lookaround: (?!A), or with 'flags', (?u.mark case MARKPOINT: /* (*MARK:foo) */ ST.prev_mark = mark_state; - ST.mark_name = sv_commit = sv_yes_mark + ST.mark_name = sv_commit = sv_yes_mark = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); mark_state = st; ST.mark_loc = locinput; @@ -9324,7 +9324,7 @@ NULL NOT_REACHED; /* NOTREACHED */ case MARKPOINT_next_fail: - if (popmark && sv_eq(ST.mark_name,popmark)) + if (popmark && sv_eq(ST.mark_name,popmark)) { if (ST.mark_loc > startpoint) reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1); @@ -9338,7 +9338,7 @@ NULL }); } mark_state = ST.prev_mark; - sv_yes_mark = mark_state ? + sv_yes_mark = mark_state ? mark_state->u.mark.mark_name : NULL; sayNO; NOT_REACHED; /* NOTREACHED */ @@ -9351,15 +9351,15 @@ NULL PUSH_STATE_GOTO(SKIP_next,next, locinput, loceol, script_run_begin); } else { - /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, - otherwise do nothing. Meaning we need to scan + /* (*SKIP:NAME) : if there is a (*MARK:NAME) fail where it was, + otherwise do nothing. Meaning we need to scan */ regmatch_state *cur = mark_state; SV *find = MUTABLE_SV(rexi->data->data[ ARG( scan ) ]); - + while (cur) { - if ( sv_eq( cur->u.mark.mark_name, - find ) ) + if ( sv_eq( cur->u.mark.mark_name, + find ) ) { ST.mark_name = find; PUSH_STATE_GOTO( SKIP_next, next, locinput, loceol, @@ -9367,26 +9367,26 @@ NULL } cur = cur->u.mark.prev_mark; } - } + } /* Didn't find our (*MARK:NAME) so ignore this (*SKIP:NAME) */ - break; + break; case SKIP_next_fail: if (ST.mark_name) { - /* (*CUT:NAME) - Set up to search for the name as we + /* (*CUT:NAME) - Set up to search for the name as we collapse the stack*/ - popmark = ST.mark_name; + popmark = ST.mark_name; } else { /* (*CUT) - No name, we cut here.*/ if (ST.mark_loc > startpoint) reginfo->cutpoint = HOPBACKc(ST.mark_loc, 1); /* but we set sv_commit to latest mark_name if there is one so they can test to see how things lead to this - cut */ - if (mark_state) - sv_commit=mark_state->u.mark.mark_name; - } - no_final = 1; + cut */ + if (mark_state) + sv_commit=mark_state->u.mark.mark_name; + } + no_final = 1; sayNO; NOT_REACHED; /* NOTREACHED */ #undef ST @@ -9417,8 +9417,8 @@ NULL else locinput++; break; - - } /* end switch */ + + } /* end switch */ /* switch break jumps here */ scan = next; /* prepare to execute the next op and ... */ @@ -9463,7 +9463,7 @@ NULL st->locinput = locinput; st->loceol = loceol; st->sr0 = script_run_begin; - newst = st+1; + newst = st+1; if (newst > SLAB_LAST(PL_regmatch_slab)) newst = S_push_slab(aTHX); PL_regmatch_state = newst; @@ -9501,7 +9501,7 @@ NULL } DEBUG_STATE_r({ if (no_final) { - DEBUG_STATE_pp("pop (no final)"); + DEBUG_STATE_pp("pop (no final)"); } else { DEBUG_STATE_pp("pop (yes)"); } @@ -9522,7 +9522,7 @@ NULL st = yes_state; yes_state = st->u.yes.prev_yes_state; PL_regmatch_state = st; - + if (no_final) { locinput= st->locinput; loceol= st->loceol; @@ -9567,7 +9567,7 @@ NULL } else { goto final_exit; } - } + } if (depth) { /* there's a previous state to backtrack to */ st--; @@ -9597,10 +9597,10 @@ NULL SV *sv_mrk = get_sv("REGMARK", 1); if (result) { sv_commit = &PL_sv_no; - if (!sv_yes_mark) + if (!sv_yes_mark) sv_yes_mark = &PL_sv_yes; } else { - if (!sv_commit) + if (!sv_commit) sv_commit = &PL_sv_yes; sv_yes_mark = &PL_sv_no; } @@ -10298,7 +10298,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, /* - reginclass - determine if a character falls into a character class - + n is the ANYOF-type regnode p is the target string p_end points to one byte beyond the end of the target string From 954dc197ae9570855eb54ab9467b24c2f1b95eba Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 18 Oct 2020 10:51:22 -0600 Subject: [PATCH 254/503] regexec.c: Change name of static function The new name reflects its new functionality coming in future commits --- regexec.c | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/regexec.c b/regexec.c index f1ba07b5e1fd..96c392edbeb1 100644 --- a/regexec.c +++ b/regexec.c @@ -4451,7 +4451,7 @@ S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan) #define CHRTEST_NOT_A_CP_2 -998 static bool -S_setup_EXACTISH_ST_c1_c2(pTHX_ const regnode * const text_node, int *c1p, +S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, int *c1p, U8* c1_utf8, int *c2p, U8* c2_utf8, regmatch_info *reginfo) { /* This function determines if there are zero, one, two, or more characters @@ -8681,7 +8681,7 @@ NULL if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); if (PL_regkind[OP(text_node)] == EXACT) { - if (! S_setup_EXACTISH_ST_c1_c2(aTHX_ + if (! S_setup_EXACTISH_ST(aTHX_ text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8, reginfo)) { @@ -8855,7 +8855,7 @@ NULL ST.c1 = ST.c2 = CHRTEST_VOID; } else { - if (! S_setup_EXACTISH_ST_c1_c2(aTHX_ + if (! S_setup_EXACTISH_ST(aTHX_ text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8, reginfo)) { @@ -9860,7 +9860,7 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, assert(STR_LENs(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRINGs(p)) : 1); - if (S_setup_EXACTISH_ST_c1_c2(aTHX_ p, &c1, c1_utf8, &c2, c2_utf8, + if (S_setup_EXACTISH_ST(aTHX_ p, &c1, c1_utf8, &c2, c2_utf8, reginfo)) { if (c1 == CHRTEST_VOID) { From bb3825626ed2b1217a2ac184eff66d0d4ed6e070 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 13 Nov 2020 09:38:21 -0700 Subject: [PATCH 255/503] regexec.c: Revamp S_setup_EXACTISH_ST() loop end conditions Consider the pattern /A*B/ where A and B are arbitrary. The pattern matching code tries to make a tight loop to match the span of A's. The logic of this was not really updated when UTF-8 was added. I did revamp it some releases ago to fix some bugs and to at least consider UTF-8. This commit changes it so that Unicode is now a first class citizen. Some details are listed in the ticket GH #18414 --- regexec.c | 1379 ++++++++++++++++++++++++++++++----------------------- regexp.h | 34 +- 2 files changed, 808 insertions(+), 605 deletions(-) diff --git a/regexec.c b/regexec.c index 96c392edbeb1..533c0df5038c 100644 --- a/regexec.c +++ b/regexec.c @@ -4445,318 +4445,590 @@ S_reg_check_named_buff_matched(const regexp *rex, const regnode *scan) return 0; } -#define CHRTEST_UNINIT -1001 /* c1/c2 haven't been calculated yet */ -#define CHRTEST_VOID -1000 /* the c1/c2 "next char" test should be skipped */ -#define CHRTEST_NOT_A_CP_1 -999 -#define CHRTEST_NOT_A_CP_2 -998 - static bool -S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, int *c1p, - U8* c1_utf8, int *c2p, U8* c2_utf8, regmatch_info *reginfo) +S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, + struct next_matchable_info * m, + regmatch_info *reginfo) { - /* This function determines if there are zero, one, two, or more characters - * that match the first character of the passed-in EXACTish node - * , and if there are one or two, it returns them in the - * passed-in pointers. + /* This function determines various characteristics about every possible + * initial match of the passed-in EXACTish , and stores them in + * <*m>. * - * If it determines that no possible character in the target string can - * match, it returns FALSE; otherwise TRUE. (The FALSE situation occurs if - * the first character in requires UTF-8 to represent, and the - * target string isn't in UTF-8.) + * That includes a match string and a parallel mask, such that if you AND + * the target string with the mask and compare with the match string, + * you'll have a pretty good idea, perhaps even perfect, if that portion of + * the target matches or not. * - * If there are more than two characters that could match the beginning of - * , or if more context is required to determine a match or not, - * it sets both * and * to CHRTEST_VOID. + * The motivation behind this function is to allow the caller to set up + * tight loops for matching. Consider patterns like '.*B' or '.*?B' where + * B is an arbitrary EXACTish node. To find the end of .*, we look for the + * beginning oF B, which is the passed in That's where this + * function comes in. The values it returns can quickly be used to rule + * out many, or all, cases of possible matches not actually being the + * beginning of B, . It is also used in regrepeat() where we + * have 'A*', for arbitrary 'A'. This sets up criteria to more efficiently + * determine where the span of 'A's stop. * - * The motiviation behind this function is to allow the caller to set up - * tight loops for matching. If is of type EXACT, there is - * only one possible character that can match its first character, and so - * the situation is quite simple. But things get much more complicated if - * folding is involved. It may be that the first character of an EXACTFish - * node doesn't participate in any possible fold, e.g., punctuation, so it - * can be matched only by itself. The vast majority of characters that are - * in folds match just two things, their lower and upper-case equivalents. + * If is of type EXACT, there is only one possible character + * that can match its first character, and so the situation is quite + * simple. But things can get much more complicated if folding is + * involved. It may be that the first character of an EXACTFish node + * doesn't participate in any possible fold, e.g., punctuation, so it can + * be matched only by itself. The vast majority of characters that are in + * folds match just two things, their lower and upper-case equivalents. * But not all are like that; some have multiple possible matches, or match * sequences of more than one character. This function sorts all that out. * - * Consider the patterns A*B or A*?B where A and B are arbitrary. In a - * loop of trying to match A*, we know we can't exit where the thing - * following it isn't a B. And something can't be a B unless it is the - * beginning of B. By putting a quick test for that beginning in a tight - * loop, we can rule out things that can't possibly be B without having to - * break out of the loop, thus avoiding work. Similarly, if A is a single - * character, we can make a tight loop matching A*, using the outputs of - * this function. + * It returns information about all possibilities of what the first + * character(s) of could look like. Again, if is a + * plain EXACT node, that's just the actual first bytes of the first + * character; but otherwise it is the bytes, that when masked, match all + * possible combinations of all the initial bytes of all the characters + * that could match, folded. (Actually, this is a slight over promise. It + * handles only up to the initial 5 bytes, which is enough for all Unicode + * characters, but not for all non-Unicode ones.) + * + * Here's an example to clarify. Suppose the first character of + * is the letter 'C', and we are under /i matching. That means + * 'c' also matches. The representations of these two characters differ in + * just one bit, so the mask would be a zero in that position and ones in + * the other 7. And the returned string would be the AND of these two + * characters, and would be one byte long, since these characters are each + * a single byte. ANDing the target with this mask will yield + * the returned string if and only if begins with one of these + * two characters. So, the function would also return that the definitive + * length matched is 1 byte. + * + * Now, suppose instead of the letter 'C', begins with the + * letter 'F'. The situation is much more complicated because there are + * various ligatures such as LATIN SMALL LIGATURE FF, whose fold also + * begins with 'f', and hence could match. We add these into the returned + * string and mask, but the result isn't definitive; the caller has to + * check further if its AND and compare pass. But the failure of that + * compare will quickly rule out most possible inputs. * - * If the target string to match isn't in UTF-8, and there aren't - * complications which require CHRTEST_VOID, * and * are set to - * the one or two possible octets (which are characters in this situation) - * that can match. In all cases, if there is only one character that can - * match, * and * will be identical. + * Much of this could be done in regcomp.c at compile time, except for + * locale-dependent, and UTF-8 target dependent data. Extra data fields + * could be used for one or the other eventualities. * - * If the target string is in UTF-8, the buffers pointed to by - * and will contain the one or two UTF-8 sequences of bytes that - * can match the beginning of . They should be declared with at - * least length UTF8_MAXBYTES+1. (If the target string isn't in UTF-8, it is - * undefined what these contain.) If one or both of the buffers are - * invariant under UTF-8, *, and * will also be set to the - * corresponding invariant. If variant, the corresponding * and/or - * * will be set to a negative number(s) that shouldn't match any code - * point (unless inappropriately coerced to unsigned). * will equal - * * if and only if and are the same. */ + * If this function determines that no possible character in the target + * string can match, it returns FALSE; otherwise TRUE. (The FALSE + * situation occurs if the first character in requires UTF-8 to + * represent, and the target string isn't in UTF-8.) + */ const bool utf8_target = reginfo->is_utf8_target; + bool utf8_pat = reginfo->is_utf8_pat; - UV c1 = (UV)CHRTEST_NOT_A_CP_1; - UV c2 = (UV)CHRTEST_NOT_A_CP_2; - bool use_chrtest_void = FALSE; - const bool utf8_pat = reginfo->is_utf8_pat; + PERL_UINT_FAST8_T i; - /* Used when we have both utf8 input and utf8 output, to avoid converting - * to/from code points */ - bool utf8_has_been_setup = FALSE; + /* Here and below, '15' is the value of UTF8_MAXBYTES_CASE, which requires at least :e + */ + U8 matches[MAX_MATCHES][UTF8_MAXBYTES_CASE + 1] = { 0 }; + U8 lengths[MAX_MATCHES] = { 0 }; + U8 index_of_longest = 0; U8 *pat = (U8*)STRING(text_node); - U8 folded[UTF8_MAX_FOLD_CHAR_EXPAND * UTF8_MAXBYTES_CASE + 1] = { '\0' }; - const U8 op = OP(text_node); + Size_t pat_len = STR_LEN(text_node); + U8 op = OP(text_node); - if (! isEXACTFish(OP(text_node))) { + U8 byte_mask[5] = {0}; + U8 byte_anded[5] = {0}; - /* In an exact node, only one thing can be matched, that first - * character. If both the pat and the target are UTF-8, we can just - * copy the input to the output, avoiding finding the code point of - * that character */ - if (! utf8_pat) { - assert(! isEXACT_REQ8(OP(text_node))); - c2 = c1 = *pat; - } - else if (utf8_target) { - Copy(pat, c1_utf8, UTF8SKIP(pat), U8); - Copy(pat, c2_utf8, UTF8SKIP(pat), U8); - utf8_has_been_setup = TRUE; - } - else if (isEXACT_REQ8(OP(text_node))) { - return FALSE; /* Can only match UTF-8 target */ + /* There are some folds in Unicode to multiple characters. This will hold + * such characters that could fold to the beginning of 'text_node' */ + UV multi_fold_from = 0; + + /* We may have to create a modified copy of the pattern */ + U8 mod_pat[UTF8_MAXBYTES_CASE + 1] = { '\0' }; + + m->max_length = 0; + m->min_length = 255; + m->count = 0; + + /* Even if the first character in the node can match something in Latin1, + * if there is anything in the node that can't, the match must fail */ + if (! utf8_target && isEXACT_REQ8(op)) { + return FALSE; + } + +/* Define a temporary op for use in this function, using an existing one that + * should never be a real op during execution */ +#define TURKISH PSEUDO + + /* What to do about these two nodes had to be deferred to runtime (which is + * now). If the extra information we now have so indicates, turn them into + * EXACTFU nodes */ + if ( (op == EXACTF && utf8_target) + || (op == EXACTFL && IN_UTF8_CTYPE_LOCALE)) + { + if (op == EXACTFL && PL_in_utf8_turkic_locale) { + op = TURKISH; } else { - c2 = c1 = valid_utf8_to_uvchr(pat, NULL); - } - } - else { /* an EXACTFish node */ - U8 *pat_end = pat + STR_LENs(text_node); - - /* An EXACTFL node has at least some characters unfolded, because what - * they match is not known until now. So, now is the time to fold - * the first few of them, as many as are needed to determine 'c1' and - * 'c2' later in the routine. If the pattern isn't UTF-8, we only need - * to fold if in a UTF-8 locale, and then only the Sharp S; everything - * else is 1-1 and isn't assumed to be folded. In a UTF-8 pattern, we - * need to fold as many characters as a single character can fold to, - * so that later we can check if the first ones are such a multi-char - * fold. But, in such a pattern only locale-problematic characters - * aren't folded, so we can skip this completely if the first character - * in the node isn't one of the tricky ones */ - if (op == EXACTFL) { - - if (! utf8_pat) { - if (IN_UTF8_CTYPE_LOCALE && *pat == LATIN_SMALL_LETTER_SHARP_S) - { - folded[0] = folded[1] = 's'; - pat = folded; - pat_end = folded + 2; + op = EXACTFU; + } + + /* And certain situations are better handled if we create a modified + * version of the pattern */ + if (utf8_pat) { /* Here, must have been EXACTFL, so look at the + specific problematic characters */ + if (is_PROBLEMATIC_LOCALE_FOLD_utf8(pat)) { + + /* The node could start with characters that are the first ones + * of a multi-character fold. */ + multi_fold_from + = what_MULTI_CHAR_FOLD_utf8_safe(pat, pat + pat_len); + if (multi_fold_from) { + + /* Here, they do form a sequence that matches the fold of a + * single character. That single character then is a + * possible match. Below we will look again at this, but + * the code below is expecting every character in the + * pattern to be folded, which the input isn't required to + * be in this case. So, just fold the single character, + * and the result will be in the expected form. */ + _to_uni_fold_flags(multi_fold_from, mod_pat, &pat_len, + FOLD_FLAGS_FULL); + pat = mod_pat; } - } - else if (is_PROBLEMATIC_LOCALE_FOLDEDS_START_utf8(pat)) { - U8 *s = pat; - U8 *d = folded; - int i; - - for (i = 0; i < UTF8_MAX_FOLD_CHAR_EXPAND && s < pat_end; i++) { - if (isASCII(*s) && LIKELY(! PL_in_utf8_turkic_locale)) { - *(d++) = (U8) toFOLD_LC(*s); - s++; + /* Turkish has a couple extra possibilities. */ + else if ( UNLIKELY(op == TURKISH) + && pat_len >= 3 + && isALPHA_FOLD_EQ(pat[0], 'f') + && ( memBEGINs(pat + 1, pat_len - 1, + LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE_UTF8) + || ( pat_len >= 4 + && isALPHA_FOLD_EQ(pat[1], 'f') + && memBEGINs(pat + 2, pat_len - 2, + LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE_UTF8) + ))) { + /* The macros for finding a multi-char fold don't include + * the Turkish possibilities, in which U+130 folds to 'i'. + * Hard-code these. It's very unlikely that Unicode will + * ever add any others. */ + if (pat[1] == 'f') { + pat_len = 3; + Copy("ffi", mod_pat, pat_len, U8); } else { - STRLEN len; - _toFOLD_utf8_flags(s, - pat_end, - d, - &len, - FOLD_FLAGS_FULL | FOLD_FLAGS_LOCALE); - d += len; - s += UTF8SKIP(s); + pat_len = 2; + Copy("fi", mod_pat, pat_len, U8); } + pat = mod_pat; + } + else if ( UTF8_IS_DOWNGRADEABLE_START(*pat) + && LIKELY(memNEs(pat, pat_len, MICRO_SIGN_UTF8)) + && LIKELY(memNEs(pat, pat_len, + LATIN_SMALL_LETTER_SHARP_S_UTF8)) + && (LIKELY(op != TURKISH || *pat != 'I'))) + { + /* For all cases of things between 0-255, except the ones + * in the conditional above, the fold is just the lower + * case, which is faster than the more general case. */ + mod_pat[0] = toLOWER_L1(EIGHT_BIT_UTF8_TO_NATIVE(pat[0], + pat[1])); + pat_len = 1; + pat = mod_pat; + utf8_pat = FALSE; + } + else { /* Code point above 255, or needs special handling */ + _to_utf8_fold_flags(pat, pat + pat_len, + mod_pat, &pat_len, + FOLD_FLAGS_FULL|FOLD_FLAGS_LOCALE); + pat = mod_pat; } - - pat = folded; - pat_end = d; } } + else if /* Below is not a UTF-8 pattern; there's a somewhat different + set of problematic characters */ + ((multi_fold_from + = what_MULTI_CHAR_FOLD_latin1_safe(pat, pat + pat_len))) + { + /* We may have to canonicalize a multi-char fold, as in the UTF-8 + * case */ + _to_uni_fold_flags(multi_fold_from, mod_pat, &pat_len, + FOLD_FLAGS_FULL); + pat = mod_pat; + } + else if (UNLIKELY(*pat == LATIN_SMALL_LETTER_SHARP_S)) { + mod_pat[0] = mod_pat[1] = 's'; + pat_len = 2; + utf8_pat = utf8_target; /* UTF-8ness immaterial for invariant + chars, and speeds copying */ + pat = mod_pat; + } + else if (LIKELY(op != TURKISH || *pat != 'I')) { + mod_pat[0] = toLOWER_L1(*pat); + pat_len = 1; + pat = mod_pat; + } + } + else if /* Below isn't a node that we convert to UTF-8 */ + ( utf8_target + && ! utf8_pat + && op == EXACTFAA_NO_TRIE + && *pat == LATIN_SMALL_LETTER_SHARP_S) + { + /* A very special case. Folding U+DF goes to U+17F under /iaa. We + * did this at compile time when the pattern was UTF-8 , but otherwise + * we couldn't do it earlier, because it requires a UTF-8 target for + * this match to be legal. */ + pat_len = 2 * (sizeof(LATIN_SMALL_LETTER_LONG_S_UTF8) - 1); + Copy(LATIN_SMALL_LETTER_LONG_S_UTF8 + LATIN_SMALL_LETTER_LONG_S_UTF8, mod_pat, pat_len, U8); + pat = mod_pat; + utf8_pat = TRUE; + } + + /* Here, we have taken care of the initial work for a few very problematic + * situations, possibly creating a modified pattern. + * + * Now ready for the general case. We build up all the possible things + * that could match the first character of the pattern into the elements of + * 'matches[]' + * + * Everything generally matches at least itself. But if there is a + * UTF8ness mismatch, we have to convert to that of the target string. */ + if (utf8_pat == utf8_target || UTF8_IS_INVARIANT(*pat)) { + lengths[0] = MIN(pat_len, C_ARRAY_LENGTH(matches[0])); + Copy(pat, matches[0], lengths[0], U8); + m->count++; + } + else if (utf8_target) { /* target is UTF-8; pattern isn't */ + matches[0][0] = UTF8_EIGHT_BIT_HI(pat[0]); + matches[0][1] = UTF8_EIGHT_BIT_LO(pat[0]); + lengths[0] = 2; + m->count++; + } + else { /* pattern is UTF-8, target isn't */ + if (UTF8_IS_DOWNGRADEABLE_START(*pat)) { + matches[0][0] = EIGHT_BIT_UTF8_TO_NATIVE(pat[0], pat[1]); + lengths[0] = 1; + m->count++; + } + } + + /* Here we have taken care of any necessary node-type changes */ + + if (m->count) { + m->max_length = lengths[0]; + m->min_length = lengths[0]; + } + + /* For non-folding nodes, there are no other possible candidate matches, + * but for foldable ones, we have to look further. */ + if (UNLIKELY(op == TURKISH) || isEXACTFish(op)) { /* A folding node */ + UV folded; /* The first character in the pattern, folded */ + U32 first_fold_from; /* A character that folds to it */ + const U32 * remaining_fold_froms; /* The remaining characters that + fold to it, if any */ + Size_t folds_to_count; /* The total number of characters that fold to + 'folded' */ + + /* If the node begins with a sequence of more than one character that + * together form the fold of a single character, it is called a + * 'multi-character fold', and the normal functions don't handle this + * case. We set 'multi_fold_from' to the single folded-from character, + * which is handled in an extra iteration below */ + if (utf8_pat) { + folded = valid_utf8_to_uvchr(pat, NULL); + multi_fold_from + = what_MULTI_CHAR_FOLD_utf8_safe(pat, pat + pat_len); + } + else { + folded = *pat; + + /* This may generate illegal combinations for things like EXACTF, + * but rather than repeat the logic and exclude them here, all such + * illegalities are checked for and skipped below in the loop */ + multi_fold_from + = what_MULTI_CHAR_FOLD_latin1_safe(pat, pat + pat_len); + } - if ( ( utf8_pat && is_MULTI_CHAR_FOLD_utf8_safe(pat, pat_end)) - || (!utf8_pat && is_MULTI_CHAR_FOLD_latin1_safe(pat, pat_end))) + /* Everything matches at least itself; initialize to that because the + * only the branches below that set it are the ones where the number + * isn't 1. */ + folds_to_count = 1; + + /* There are a few special cases for locale-dependent nodes, where the + * run-time context was needed before we could know what matched */ + if (UNLIKELY(op == EXACTFL) && folded < 256) { + first_fold_from = PL_fold_locale[folded]; + } + else if ( op == EXACTFL && utf8_target && utf8_pat + && memBEGINs(pat, pat_len, LATIN_SMALL_LETTER_LONG_S_UTF8 + LATIN_SMALL_LETTER_LONG_S_UTF8)) { - /* Multi-character folds require more context to sort out. Also - * PL_utf8_foldclosures used below doesn't handle them, so have to - * be handled outside this routine */ - use_chrtest_void = TRUE; - } - else { /* an EXACTFish node which doesn't begin with a multi-char fold */ - c1 = utf8_pat ? valid_utf8_to_uvchr(pat, NULL) : *pat; - - if ( UNLIKELY(PL_in_utf8_turkic_locale) - && op == EXACTFL - && UNLIKELY( c1 == 'i' || c1 == 'I' - || c1 == LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE - || c1 == LATIN_SMALL_LETTER_DOTLESS_I)) - { /* Hard-coded Turkish locale rules for these 4 characters - override normal rules */ - if (c1 == 'i') { - c2 = LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE; - } - else if (c1 == 'I') { - c2 = LATIN_SMALL_LETTER_DOTLESS_I; - } - else if (c1 == LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE) { - c2 = 'i'; - } - else if (c1 == LATIN_SMALL_LETTER_DOTLESS_I) { - c2 = 'I'; - } + first_fold_from = LATIN_CAPITAL_LETTER_SHARP_S; + } + else if (UNLIKELY( op == TURKISH + && ( isALPHA_FOLD_EQ(folded, 'i') + || inRANGE(folded, + LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE, + LATIN_SMALL_LETTER_DOTLESS_I)))) + { /* Turkish folding requires special handling */ + if (folded == 'i') + first_fold_from = LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE; + else if (folded == 'I') + first_fold_from = LATIN_SMALL_LETTER_DOTLESS_I; + else if (folded == LATIN_CAPITAL_LETTER_I_WITH_DOT_ABOVE) + first_fold_from = 'i'; + else first_fold_from = 'I'; + } + else { + /* Here, isn't a special case: use the generic function to + * calculate what folds to this */ + redo_multi: + /* Look up what code points (besides itself) fold to 'folded'; + * e.g., [ 'K', KELVIN_SIGN ] both fold to 'k'. */ + folds_to_count = _inverse_folds(folded, &first_fold_from, + &remaining_fold_froms); + } + + /* Add each character that folds to 'folded' to the list of them, + * subject to limitations based on the node type and target UTF8ness. + * If there was a character that folded to multiple characters, do an + * extra iteration for it. (Note the extra iteration if there is a + * multi-character fold) */ + for (i = 0; i < folds_to_count + + UNLIKELY(multi_fold_from != 0); i++) + { + UV fold_from = 0; + + if (i >= folds_to_count) { /* Final iteration: handle the + multi-char */ + fold_from = multi_fold_from; } - else if (c1 > 255) { - const U32 * remaining_folds; - U32 first_fold; - - /* Look up what code points (besides c1) fold to c1; e.g., - * [ 'K', KELVIN_SIGN ] both fold to 'k'. */ - Size_t folds_count = _inverse_folds(c1, &first_fold, - &remaining_folds); - if (folds_count == 0) { - c2 = c1; /* there is only a single character that could - match */ - } - else if (folds_count != 1) { - /* If there aren't exactly two folds to this (itself and - * another), it is outside the scope of this function */ - use_chrtest_void = TRUE; - } - else { /* There are two. We already have one, get the other */ - c2 = first_fold; - - /* Folds that cross the 255/256 boundary are forbidden if - * EXACTFL (and isnt a UTF8 locale), or EXACTFAA and one is - * ASCIII. The only other match to c1 is c2, and since c1 - * is above 255, c2 better be as well under these - * circumstances. If it isn't, it means the only legal - * match of c1 is itself. */ - if ( c2 < 256 - && ( ( op == EXACTFL - && ! IN_UTF8_CTYPE_LOCALE) - || (( op == EXACTFAA - || op == EXACTFAA_NO_TRIE) - && (isASCII(c1) || isASCII(c2))))) - { - c2 = c1; - } - } + else if (i == 0) { + fold_from = first_fold_from; + } + else if (i < folds_to_count) { + fold_from = remaining_fold_froms[i-1]; + } + + if (folded == fold_from) { /* We already added the character itself */ + continue; } - else /* Here, c1 is <= 255 */ - if ( utf8_target - && HAS_NONLATIN1_FOLD_CLOSURE(c1) - && ( ! (op == EXACTFL && ! IN_UTF8_CTYPE_LOCALE)) - && ( ( op != EXACTFAA - && op != EXACTFAA_NO_TRIE) - || ! isASCII(c1))) + + /* EXACTF doesn't have any non-ascii folds */ + if (op == EXACTF && (! isASCII(folded) || ! isASCII(fold_from))) { + continue; + } + + /* In /iaa nodes, neither or both must be ASCII to be a legal fold + * */ + if ( isASCII(folded) != isASCII(fold_from) + && inRANGE(op, EXACTFAA, EXACTFAA_NO_TRIE)) + { - /* Here, there could be something above Latin1 in the target - * which folds to this character in the pattern. All such - * cases except LATIN SMALL LETTER Y WITH DIAERESIS have more - * than two characters involved in their folds, so are outside - * the scope of this function */ - if (UNLIKELY(c1 == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) { - c2 = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS; - } - else { - use_chrtest_void = TRUE; + continue; + } + + /* In /il nodes, can't cross 255/256 boundary (unless in a UTF-8 + * locale, but those have been converted to EXACTFU above) */ + if ( op == EXACTFL + && (folded < 256) != (fold_from < 256)) + { + continue; + } + + /* If this triggers, it likely is because of the unlikely case + * where a new Unicode standard has changed what MAX_MATCHES should + * be set to */ + assert(m->count < MAX_MATCHES); + + /* Add this character to the list of possible matches */ + if (utf8_target) { + uvchr_to_utf8(matches[m->count], fold_from); + lengths[m->count] = UVCHR_SKIP(fold_from); + m->count++; + } + else { /* Non-UTF8 target: any code point above 255 + can't appear in it */ + if (fold_from > 255) { + continue; } + + matches[m->count][0] = fold_from; + lengths[m->count] = 1; + m->count++; } - else { /* Here nothing above Latin1 can fold to the pattern - character */ - switch (op) { - case EXACTFL: /* /l rules */ - c2 = PL_fold_locale[c1]; - break; + /* Update min and mlengths */ + if (m->min_length > lengths[m->count-1]) { + m->min_length = lengths[m->count-1]; + } - case EXACTF: /* This node only generated for non-utf8 - patterns */ - assert(! utf8_pat); - if (! utf8_target) { /* /d rules */ - c2 = PL_fold[c1]; - break; - } - /* FALLTHROUGH */ - /* /u rules for all these. This happens to work for - * EXACTFAA as nothing in Latin1 folds to ASCII */ - case EXACTFAA_NO_TRIE: /* This node only generated for - non-utf8 patterns */ - assert(! utf8_pat); - /* FALLTHROUGH */ - case EXACTFAA: - case EXACTFUP: - case EXACTFU: - c2 = PL_fold_latin1[c1]; - break; - case EXACTFU_REQ8: - return FALSE; - NOT_REACHED; /* NOTREACHED */ + if (m->max_length < lengths[m->count-1]) { + index_of_longest = m->count - 1; + m->max_length = lengths[index_of_longest]; + } + } /* looped through each potential fold */ - default: - Perl_croak(aTHX_ "panic: Unexpected op %u", op); - NOT_REACHED; /* NOTREACHED */ + /* If there is something that folded to an initial multi-character + * fold, repeat, using it. This catches some edge cases. An example + * of one is /ss/i when UTF-8 encoded. The function + * what_MULTI_CHAR_FOLD_utf8_safe('ss') gets called and returns U+DF + * (LATIN SMALL SHARP S). If it returned a list of characters, this + * code wouldn't be needed. But since it doesn't, we have to look what + * folds to the U+DF. In this case, U+1E9E does, and has to be added. + * */ + if (multi_fold_from) { + folded = multi_fold_from; + multi_fold_from = 0; + goto redo_multi; + } + } /* End of finding things that participate in this fold */ + + if (m->count == 0) { /* If nothing found, can't match */ + m->min_length = 0; + return FALSE; + } + + /* Have calculated all possible matches. Now calculate the mask and AND + * values */ + m->initial_exact = 0; + m->initial_definitive = 0; + + { + unsigned int mask_ones = 0; + unsigned int possible_ones = 0; + U8 j; + + /* For each byte that is in all possible matches ... */ + for (j = 0; j < MIN(m->min_length, 5); j++) { + + /* Initialize the accumulator for this byte */ + byte_mask[j] = 0xFF; + byte_anded[j] = matches[0][j]; + + /* Then the rest of the rows (folds). The mask is based on, like, + * ~('A' ^ 'a') is a 1 in all bits where these are the same, and 0 + * where they differ. */ + for (i = 1; i < (PERL_UINT_FAST8_T) m->count; i++) { + byte_mask[j] &= ~ (byte_anded[j] ^ matches[i][j]); + byte_anded[j] &= matches[i][j]; + } + + /* Keep track of the number of initial mask bytes that are all one + * bits. The code calling this can use this number to know that + * a string that matches this number of bytes in the pattern is an + * exact match of that pattern for this number of bytes. But also + * counted are the number of initial bytes that in total have a + * single zero bit. If a string matches those, masked, it must be + * one of two possibilites, both of which this function has + * determined are legal. (But if that single 0 is one of the + * initial bits for masking a UTF-8 start byte, that could + * incorrectly lead to different length strings appearing to be + * equivalent, so only do this optimization when the matchables are + * all the same length. This was uncovered by testing + * /\x{029E}/i.) */ + if (m->min_length == m->max_length) { + mask_ones += PL_bitcount[byte_mask[j]]; + possible_ones += 8; + if (mask_ones + 1 >= possible_ones) { + m->initial_definitive++; + if (mask_ones >= possible_ones) { + m->initial_exact++; + } } } } } - /* Here have figured things out. Set up the returns */ - if (use_chrtest_void) { - *c2p = *c1p = CHRTEST_VOID; + /* The first byte is separate for speed */ + m->first_byte_mask = byte_mask[0]; + m->first_byte_anded = byte_anded[0]; + + /* Then pack up to the next 4 bytes into a word */ + m->mask32 = m->anded32 = 0; + for (i = 1; i < MIN(m->min_length, 5); i++) { + U8 which = i; + U8 shift = (which - 1) * 8; + m->mask32 |= (U32) byte_mask[i] << shift; + m->anded32 |= (U32) byte_anded[i] << shift; } - else if (utf8_target) { - if (! utf8_has_been_setup) { /* Don't have the utf8; must get it */ - uvchr_to_utf8(c1_utf8, c1); - uvchr_to_utf8(c2_utf8, c2); + + /* Finally, take the match strings and place them sequentially into a + * one-dimensional array. (This is done to save significant space in the + * structure.) Sort so the longest (presumably the least likely) is last. + * XXX When this gets moved to regcomp, may want to fully sort shortest + * first, but above we generally used the folded code point first, and + * those tend to be no longer than their upper case values, so this is + * already pretty well sorted by size. + * + * If the asserts fail, it's most likely because a new version of the + * Unicode standard requires more space; simply increase the declaration + * size. */ + { + U8 cur_pos = 0; + U8 output_index = 0; + + if (m->count > 1) { /* No need to sort a single entry */ + for (i = 0; i < (PERL_UINT_FAST8_T) m->count; i++) { + + /* Keep the same order for all but the longest */ + if (i != index_of_longest) { + assert(cur_pos + lengths[i] <= C_ARRAY_LENGTH(m->matches)); + Copy(matches[i], m->matches + cur_pos, lengths[i], U8); + cur_pos += lengths[i]; + m->lengths[output_index++] = lengths[i]; + } + } } - /* Invariants are stored in both the utf8 and byte outputs; Use - * negative numbers otherwise for the byte ones. Make sure that the - * byte ones are the same iff the utf8 ones are the same */ - *c1p = (UTF8_IS_INVARIANT(*c1_utf8)) ? *c1_utf8 : CHRTEST_NOT_A_CP_1; - *c2p = (UTF8_IS_INVARIANT(*c2_utf8)) - ? *c2_utf8 - : (c1 == c2) - ? CHRTEST_NOT_A_CP_1 - : CHRTEST_NOT_A_CP_2; - } - else if (c1 > 255) { - if (c2 > 255) { /* both possibilities are above what a non-utf8 string - can represent */ - return FALSE; - } + assert(cur_pos + lengths[index_of_longest] <= C_ARRAY_LENGTH(m->matches)); + Copy(matches[index_of_longest], m->matches + cur_pos, + lengths[index_of_longest], U8); - *c1p = *c2p = c2; /* c2 is the only representable value */ - } - else { /* c1 is representable; see about c2 */ - *c1p = c1; - *c2p = (c2 < 256) ? c2 : c1; + /* Place the longest match last */ + m->lengths[output_index] = lengths[index_of_longest]; } return TRUE; } +PERL_STATIC_FORCE_INLINE /* We want speed at the expense of size */ +bool +S_test_EXACTISH_ST(const char * loc, + struct next_matchable_info info) +{ + /* This function uses the data set up in setup_EXACTISH_ST() to see if the + * bytes starting at 'loc' can match based on 'next_matchable_info' */ + + U32 input32 = 0; + + /* Check the first byte */ + if (((U8) loc[0] & info.first_byte_mask) != info.first_byte_anded) + return FALSE; + + /* Pack the next up-to-4 bytes into a 32 bit word */ + switch (info.min_length) { + default: + input32 |= (U32) ((U8) loc[4]) << 3 * 8; + /* FALLTHROUGH */ + case 4: + input32 |= (U8) loc[3] << 2 * 8; + /* FALLTHROUGH */ + case 3: + input32 |= (U8) loc[2] << 1 * 8; + /* FALLTHROUGH */ + case 2: + input32 |= (U8) loc[1]; + break; + case 1: + return TRUE; /* We already tested and passed the 0th byte */ + case 0: + ASSUME(0); + } + + /* And AND that with the mask and compare that with the assembled ANDED + * values */ + return (input32 & info.mask32) == info.anded32; +} + STATIC bool S_isGCB(pTHX_ const GCB_enum before, const GCB_enum after, const U8 * const strbeg, const U8 * const curpos, const bool utf8_target) { @@ -8619,7 +8891,7 @@ NULL ST.count = 0; ST.minmod = minmod; minmod = 0; - ST.c1 = CHRTEST_UNINIT; + ST.Binfo.count = -1; REGCP_SET(ST.cp); if (!(ST.minmod ? ARG1(ST.me) : ARG2(ST.me))) /* min/max */ @@ -8671,19 +8943,16 @@ NULL sayNO; curlym_do_B: /* execute the B in /A{m,n}B/ */ - if (ST.c1 == CHRTEST_UNINIT) { - /* calculate c1 and c2 for possible match of 1st char - * following curly */ - ST.c1 = ST.c2 = CHRTEST_VOID; + if (ST.Binfo.count < 0) { + /* calculate possible match of 1st char following curly */ assert(ST.B); if (HAS_TEXT(ST.B) || JUMPABLE(ST.B)) { regnode *text_node = ST.B; if (! HAS_TEXT(text_node)) FIND_NEXT_IMPT(text_node); if (PL_regkind[OP(text_node)] == EXACT) { - if (! S_setup_EXACTISH_ST(aTHX_ - text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8, - reginfo)) + if (! S_setup_EXACTISH_ST(aTHX_ text_node, + &ST.Binfo, reginfo)) { sayNO; } @@ -8694,37 +8963,21 @@ NULL DEBUG_EXECUTE_r( Perl_re_exec_indentf( aTHX_ "CURLYM trying tail with matches=%" IVdf "...\n", depth, (IV)ST.count) - ); - if (! NEXTCHR_IS_EOS && ST.c1 != CHRTEST_VOID) { - if (! UTF8_IS_INVARIANT(nextbyte) && utf8_target) { - - /* (We can use memEQ and memNE in this file without - * having to worry about one being shorter than the - * other, since the first byte of each gives the - * length of the character) */ - if ( memNE(locinput, ST.c1_utf8, UTF8_SAFE_SKIP(locinput, - reginfo->strend)) - && memNE(locinput, ST.c2_utf8, UTF8_SAFE_SKIP(locinput, - reginfo->strend))) - { - /* simulate B failing */ - DEBUG_OPTIMISE_r( - Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%" UVXf " c1=0x%" UVXf " c2=0x%" UVXf "\n", - depth, - valid_utf8_to_uvchr((U8 *) locinput, NULL), - valid_utf8_to_uvchr(ST.c1_utf8, NULL), - valid_utf8_to_uvchr(ST.c2_utf8, NULL)) - ); - state_num = CURLYM_B_fail; - goto reenter_switch; - } - } - else if (nextbyte != ST.c1 && nextbyte != ST.c2) { - /* simulate B failing */ + ); + if (! NEXTCHR_IS_EOS && ST.Binfo.count >= 0) { + assert(ST.Binfo.count > 0); + + /* Do a quick test to hopefully rule out most non-matches */ + if ( locinput + ST.Binfo.min_length > loceol + || ! S_test_EXACTISH_ST(locinput, ST.Binfo)) + { DEBUG_OPTIMISE_r( - Perl_re_exec_indentf( aTHX_ "CURLYM Fast bail next target=0x%X c1=0x%X c2=0x%X\n", + Perl_re_exec_indentf( aTHX_ + "CURLYM Fast bail next target=0x%X anded==0x%X" + " mask=0x%X\n", depth, - (int) nextbyte, ST.c1, ST.c2) + (int) nextbyte, ST.Binfo.first_byte_anded, + ST.Binfo.first_byte_mask) ); state_num = CURLYM_B_fail; goto reenter_switch; @@ -8840,7 +9093,7 @@ NULL assert(ST.min <= ST.max); if (! HAS_TEXT(next) && ! JUMPABLE(next)) { - ST.c1 = ST.c2 = CHRTEST_VOID; + ST.Binfo.count = 0; } else { regnode *text_node = next; @@ -8849,15 +9102,14 @@ NULL FIND_NEXT_IMPT(text_node); if (! HAS_TEXT(text_node)) - ST.c1 = ST.c2 = CHRTEST_VOID; + ST.Binfo.count = 0; else { if ( PL_regkind[OP(text_node)] != EXACT ) { - ST.c1 = ST.c2 = CHRTEST_VOID; + ST.Binfo.count = 0; } else { - if (! S_setup_EXACTISH_ST(aTHX_ - text_node, &ST.c1, ST.c1_utf8, &ST.c2, ST.c2_utf8, - reginfo)) + if (! S_setup_EXACTISH_ST(aTHX_ text_node, + &ST.Binfo, reginfo)) { sayNO; } @@ -8877,13 +9129,15 @@ NULL SET_locinput(li); ST.count = ST.min; REGCP_SET(ST.cp); - if (ST.c1 == CHRTEST_VOID) - goto curly_try_B_min; + + if (ST.Binfo.count <= 0) + goto curly_try_B_min; ST.oldloc = locinput; /* set ST.maxpos to the furthest point along the - * string that could possibly match */ + * string that could possibly match, i.e., that a match could + * start at. */ if (ST.max == REG_INFTY) { ST.maxpos = loceol - 1; if (utf8_target) @@ -8930,15 +9184,14 @@ NULL NOT_REACHED; /* NOTREACHED */ case CURLY_B_min_fail: - /* failed to find B in a non-greedy match. - * Handles both cases where c1,c2 valid or not */ + /* failed to find B in a non-greedy match. */ REGCP_UNWIND(ST.cp); if (ST.paren) { UNWIND_PAREN(ST.lastparen, ST.lastcloseparen); } - if (ST.c1 == CHRTEST_VOID) { + if (ST.Binfo.count == 0) { /* failed -- move forward one */ char *li = locinput; if (!regrepeat(rex, &li, ST.A, loceol, reginfo, 1)) { @@ -8964,84 +9217,78 @@ NULL curly_try_B_min_known: /* find the next place where 'B' could work, then call B */ - if (utf8_target) { - n = (ST.oldloc == locinput) ? 0 : 1; - if (ST.c1 == ST.c2) { - /* set n to utf8_distance(oldloc, locinput) */ - while ( locinput <= ST.maxpos - && locinput < loceol - && memNE(locinput, ST.c1_utf8, - UTF8_SAFE_SKIP(locinput, reginfo->strend))) - { - locinput += UTF8_SAFE_SKIP(locinput, - reginfo->strend); - n++; - } - } - else { - /* set n to utf8_distance(oldloc, locinput) */ - while ( locinput <= ST.maxpos - && locinput < loceol - && memNE(locinput, ST.c1_utf8, - UTF8_SAFE_SKIP(locinput, reginfo->strend)) - && memNE(locinput, ST.c2_utf8, - UTF8_SAFE_SKIP(locinput, reginfo->strend))) - { - locinput += UTF8_SAFE_SKIP(locinput, reginfo->strend); - n++; - } - } - } - else { /* Not utf8_target */ - if (ST.c1 == ST.c2) { - locinput = (char *) memchr(locinput, - ST.c1, - ST.maxpos + 1 - locinput); - if (! locinput) { - locinput = ST.maxpos + 1; - } - } - else { - U8 c1_c2_bits_differing = ST.c1 ^ ST.c2; - - if (! isPOWER_OF_2(c1_c2_bits_differing)) { - while ( locinput <= ST.maxpos - && UCHARAT(locinput) != ST.c1 - && UCHARAT(locinput) != ST.c2) - { - locinput++; - } - } - else { - /* If c1 and c2 only differ by a single bit, we can - * avoid a conditional each time through the loop, - * at the expense of a little preliminary setup and - * an extra mask each iteration. By masking out - * that bit, we match exactly two characters, c1 - * and c2, and so we don't have to test for both. - * On both ASCII and EBCDIC platforms, most of the - * ASCII-range and Latin1-range folded equivalents - * differ only in a single bit, so this is actually - * the most common case. (e.g. 'A' 0x41 vs 'a' - * 0x61). */ - U8 c1_masked = ST.c1 &~ c1_c2_bits_differing; - U8 c1_c2_mask = ~ c1_c2_bits_differing; - while ( locinput <= ST.maxpos - && (UCHARAT(locinput) & c1_c2_mask) - != c1_masked) + if (locinput + ST.Binfo.initial_exact < loceol) { + if (ST.Binfo.initial_exact >= ST.Binfo.max_length) { + + /* Here, the mask is all 1's for the entire length of + * any possible match. (That actually means that there + * is only one possible match.) Look for the next + * occurrence */ + locinput = ninstr(locinput, loceol, + (char *) ST.Binfo.matches, + (char *) ST.Binfo.matches + + ST.Binfo.initial_exact); + if (locinput == NULL) { + sayNO; + } + } + else do { + /* If the first byte(s) of the mask are all ones, it + * means those bytes must match identically, so can use + * ninstr() to find the next possible matchpoint */ + if (ST.Binfo.initial_exact > 0) { + locinput = ninstr(locinput, loceol, + (char *) ST.Binfo.matches, + (char *) ST.Binfo.matches + + ST.Binfo.initial_exact); + } + else { /* Otherwise find the next byte that matches, + masked */ + locinput = (char *) find_next_masked( + (U8 *) locinput, (U8 *) loceol, + ST.Binfo.first_byte_anded, + ST.Binfo.first_byte_mask); + /* Advance to the end of a multi-byte character */ + if (utf8_target) { + while ( locinput < loceol + && UTF8_IS_CONTINUATION(*locinput)) { locinput++; } } } - n = locinput - ST.oldloc; - } + if ( locinput == NULL + || locinput + ST.Binfo.min_length > loceol) + { + sayNO; + } + + /* Here, we have found a possible match point; if can't + * rule it out, quit the loop so can check fully */ + if (S_test_EXACTISH_ST(locinput, ST.Binfo)) { + break; + } + + locinput += (utf8_target) ? UTF8SKIP(locinput) : 1; + + } while (locinput <= ST.maxpos); + } + if (locinput > ST.maxpos) sayNO; + + n = (utf8_target) + ? utf8_length((U8 *) ST.oldloc, (U8 *) locinput) + : locinput - ST.oldloc; + + + /* Here is at the beginning of a character that meets the mask + * criteria. Need to make sure that some real possibility */ + if (n) { /* In /a{m,n}b/, ST.oldloc is at "a" x m, locinput is - * at b; check that everything between oldloc and - * locinput matches */ + * at what may be the beginning of b; check that everything + * between oldloc and locinput matches */ char *li = ST.oldloc; ST.count += n; if (regrepeat(rex, &li, ST.A, loceol, reginfo, n) < n) @@ -9059,32 +9306,16 @@ NULL curly_try_B_max: /* a successful greedy match: now try to match B */ - { - bool could_match = locinput < loceol; - - /* If it could work, try it. */ - if (ST.c1 != CHRTEST_VOID && could_match) { - if (! UTF8_IS_INVARIANT(UCHARAT(locinput)) && utf8_target) - { - could_match = memEQ(locinput, ST.c1_utf8, - UTF8_SAFE_SKIP(locinput, - reginfo->strend)) - || memEQ(locinput, ST.c2_utf8, - UTF8_SAFE_SKIP(locinput, - reginfo->strend)); - } - else { - could_match = UCHARAT(locinput) == ST.c1 - || UCHARAT(locinput) == ST.c2; - } - } - if (ST.c1 == CHRTEST_VOID || could_match) { - CURLY_SETPAREN(ST.paren, ST.count); - PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput, loceol, - script_run_begin); - NOT_REACHED; /* NOTREACHED */ - } - } + if ( ST.Binfo.count <= 0 + || ( ST.Binfo.count > 0 + && locinput + ST.Binfo.min_length <= loceol + && S_test_EXACTISH_ST(locinput, ST.Binfo))) + { + CURLY_SETPAREN(ST.paren, ST.count); + PUSH_STATE_GOTO(CURLY_B_max, ST.B, locinput, loceol, + script_run_begin); + NOT_REACHED; /* NOTREACHED */ + } /* FALLTHROUGH */ case CURLY_B_max_fail: @@ -9650,7 +9881,6 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, I32 hardcount = 0; /* How many matches so far */ bool utf8_target = reginfo->is_utf8_target; unsigned int to_complement = 0; /* Invert the result? */ - UV utf8_flags = 0; _char_class_number classnum; PERL_ARGS_ASSERT_REGREPEAT; @@ -9668,22 +9898,22 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, this_eol = scan + max; /* Here, for the case of a non-UTF-8 target we have adjusted down - * to the maximum of how far we should go in it (leaving it set to the real - * end, if the maximum permissible would take us beyond that). This allows - * us to make the loop exit condition that we haven't gone past to - * also mean that we haven't exceeded the max permissible count, saving a - * test each time through the loops. But it assumes that the OP matches a - * single byte, which is true for most of the OPs below when applied to a - * non-UTF-8 target. Those relatively few OPs that don't have this - * characteristic will have to compensate. + * to the maximum of how far we should go in it (but leaving it set to the + * real end if the maximum permissible would take us beyond that). This + * allows us to make the loop exit condition that we haven't gone past + * to also mean that we haven't exceeded the max permissible + * count, saving a test each time through the loop. But it assumes that + * the OP matches a single byte, which is true for most of the OPs below + * when applied to a non-UTF-8 target. Those relatively few OPs that don't + * have this characteristic have to compensate. * - * There is no adjustment for UTF-8 targets, as the number of bytes per - * character varies. OPs will have to test both that the count is less - * than the max permissible (using to keep track), and that we - * are still within the bounds of the string (using . A few OPs - * match a single byte no matter what the encoding. They can omit the max - * test if, for the UTF-8 case, they do the adjustment that was skipped - * above. + * There is no such adjustment for UTF-8 targets, sinc the number of bytes + * per character can vary. OPs will have to test both that the count is + * less than the max permissible (using to keep track), and + * that we are still within the bounds of the string (using . A + * few OPs match a single byte no matter what the encoding. They can omit + * the max test if, for the UTF-8 case, they do the adjustment that was + * skipped above. * * Thus, the code above sets things up for the common case; and exceptional * cases need extra work; the common case is to make sure doesn't @@ -9715,220 +9945,171 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, scan = this_eol; break; - case LEXACT_REQ8: - if (! utf8_target) { - break; - } - /* FALLTHROUGH */ - - case LEXACT: - { - U8 * string; - Size_t str_len; - - string = (U8 *) STRINGl(p); - str_len = STR_LENl(p); - goto join_short_long_exact; - case EXACTL: - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; if (utf8_target && UTF8_IS_ABOVE_LATIN1(*scan)) { _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(scan, loceol); } + /* FALLTHROUGH */ + + case EXACTFL: + case EXACTFLU8: + _CHECK_AND_WARN_PROBLEMATIC_LOCALE; goto do_exact; case EXACT_REQ8: + case LEXACT_REQ8: + case EXACTFU_REQ8: if (! utf8_target) { break; } /* FALLTHROUGH */ - case EXACT: - do_exact: - string = (U8 *) STRINGs(p); - str_len = STR_LENs(p); - - join_short_long_exact: - assert(str_len == reginfo->is_utf8_pat ? UTF8SKIP(string) : 1); - - c = *string; - - /* Can use a simple find if the pattern char to match on is invariant - * under UTF-8, or both target and pattern aren't UTF-8. Note that we - * can use UTF8_IS_INVARIANT() even if the pattern isn't UTF-8, as it's - * true iff it doesn't matter if the argument is in UTF-8 or not */ - if (UTF8_IS_INVARIANT(c) || (! utf8_target && ! reginfo->is_utf8_pat)) { - if (utf8_target && this_eol - scan > max) { - /* We didn't adjust because is UTF-8, but ok to do so, - * since here, to match at all, 1 char == 1 byte */ - this_eol = scan + max; - } - scan = (char *) find_span_end((U8 *) scan, (U8 *) this_eol, (U8) c); - } - else if (reginfo->is_utf8_pat) { - if (utf8_target) { - STRLEN scan_char_len; - - /* When both target and pattern are UTF-8, we have to do - * string EQ */ - while (hardcount < max - && scan < this_eol - && (scan_char_len = UTF8SKIP(scan)) <= str_len - && memEQ(scan, string, scan_char_len)) - { - scan += scan_char_len; - hardcount++; - } - } - else if (! UTF8_IS_ABOVE_LATIN1(c)) { - - /* Target isn't utf8; convert the character in the UTF-8 - * pattern to non-UTF8, and do a simple find */ - c = EIGHT_BIT_UTF8_TO_NATIVE(c, *(string + 1)); - scan = (char *) find_span_end((U8 *) scan, (U8 *) this_eol, (U8) c); - } /* else pattern char is above Latin1, can't possibly match the - non-UTF-8 target */ - } - else { - /* Here, the string must be utf8; pattern isn't, and is - * different in utf8 than not, so can't compare them directly. - * Outside the loop, find the two utf8 bytes that represent c, and - * then look for those in sequence in the utf8 string */ - U8 high = UTF8_TWO_BYTE_HI(c); - U8 low = UTF8_TWO_BYTE_LO(c); + case LEXACT: + case EXACT: + case EXACTF: + case EXACTFAA_NO_TRIE: + case EXACTFAA: + case EXACTFU: + case EXACTFUP: - while (hardcount < max - && scan + 1 < this_eol - && UCHARAT(scan) == high - && UCHARAT(scan + 1) == low) - { - scan += 2; - hardcount++; - } - } - break; - } + do_exact: { + struct next_matchable_info Binfo; + PERL_UINT_FAST8_T definitive_len; - case EXACTFAA_NO_TRIE: /* This node only generated for non-utf8 patterns */ - assert(! reginfo->is_utf8_pat); - /* FALLTHROUGH */ - case EXACTFAA: - utf8_flags = FOLDEQ_UTF8_NOMIX_ASCII; - if (reginfo->is_utf8_pat || ! utf8_target) { + assert(STR_LEN(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRING(p)) : 1); - /* The possible presence of a MICRO SIGN in the pattern forbids us - * to view a non-UTF-8 pattern as folded when there is a UTF-8 - * target. */ - utf8_flags |= FOLDEQ_S2_ALREADY_FOLDED|FOLDEQ_S2_FOLDS_SANE; + /* Set up termination info, and quit if we can rule out that we've + * gotten a match of the termination criteria */ + if ( ! S_setup_EXACTISH_ST(aTHX_ p, &Binfo, reginfo) + || scan + Binfo.min_length > this_eol + || ! S_test_EXACTISH_ST(scan, Binfo)) + { + break; } - goto do_exactf; - case EXACTFL: - _CHECK_AND_WARN_PROBLEMATIC_LOCALE; - utf8_flags = FOLDEQ_LOCALE; - goto do_exactf; + definitive_len = Binfo.initial_definitive; - case EXACTF: /* This node only generated for non-utf8 patterns */ - assert(! reginfo->is_utf8_pat); - goto do_exactf; + /* Here there are potential matches, and the first byte(s) matched our + * filter + * + * If we got a definitive match of some initial bytes, there is no + * possibility of false positives as far as it got */ + if (definitive_len > 0) { - case EXACTFLU8: - if (! utf8_target) { - break; - } - utf8_flags = FOLDEQ_LOCALE | FOLDEQ_S2_ALREADY_FOLDED - | FOLDEQ_S2_FOLDS_SANE; - goto do_exactf; + /* If as far as it got is the maximum possible, there were no false + * positives at all. Since we have everything set up, see how many + * repeats there are. */ + if (definitive_len >= Binfo.max_length) { - case EXACTFU_REQ8: - if (! utf8_target) { - break; - } - assert(reginfo->is_utf8_pat); - utf8_flags = FOLDEQ_S2_ALREADY_FOLDED; - goto do_exactf; + /* We've already found one match */ + scan += definitive_len; + hardcount++; - case EXACTFU: - utf8_flags = FOLDEQ_S2_ALREADY_FOLDED; - /* FALLTHROUGH */ + /* If want more than the one match, and there is room for more, + * see if there are any */ + if (hardcount < max && scan + definitive_len <= this_eol) { - case EXACTFUP: + /* If the character is only a single byte long, just span + * all such bytes. */ + if (definitive_len == 1) { + const char * orig_scan = scan; - do_exactf: { - int c1, c2; - U8 c1_utf8[UTF8_MAXBYTES+1], c2_utf8[UTF8_MAXBYTES+1]; + this_eol = MIN(this_eol, scan + max - hardcount); - assert(STR_LENs(p) == reginfo->is_utf8_pat ? UTF8SKIP(STRINGs(p)) : 1); + /* Use different routines depending on whether it's an + * exact match or matches with a mask */ + if (Binfo.initial_exact == 1) { + scan = (char *) find_span_end((U8 *) scan, + (U8 *) this_eol, + Binfo.matches[0]); + } + else { + scan = (char *) find_span_end_mask( + (U8 *) scan, + (U8 *) this_eol, + Binfo.first_byte_anded, + Binfo.first_byte_mask); + } - if (S_setup_EXACTISH_ST(aTHX_ p, &c1, c1_utf8, &c2, c2_utf8, - reginfo)) - { - if (c1 == CHRTEST_VOID) { - /* Use full Unicode fold matching */ - char *tmpeol = loceol; - STRLEN pat_len = reginfo->is_utf8_pat ? UTF8SKIP(STRINGs(p)) : 1; - while (hardcount < max - && foldEQ_utf8_flags(scan, &tmpeol, 0, utf8_target, - STRINGs(p), NULL, pat_len, - reginfo->is_utf8_pat, utf8_flags)) - { - scan = tmpeol; - tmpeol = loceol; - hardcount++; - } - } - else if (utf8_target) { - if (c1 == c2) { - while (scan < this_eol - && hardcount < max - && memEQ(scan, c1_utf8, UTF8_SAFE_SKIP(scan, - loceol))) - { - scan += UTF8SKIP(c1_utf8); - hardcount++; + hardcount += scan - orig_scan; } - } - else { - while (scan < this_eol - && hardcount < max - && ( memEQ(scan, c1_utf8, UTF8_SAFE_SKIP(scan, - loceol)) - || memEQ(scan, c2_utf8, UTF8_SAFE_SKIP(scan, - loceol)))) - { - scan += UTF8_SAFE_SKIP(scan, loceol); - hardcount++; + else { /* Here, the full character definitive match is more + than one byte */ + while ( hardcount < max + && scan + definitive_len <= this_eol + && S_test_EXACTISH_ST(scan, Binfo)) + { + scan += definitive_len; + hardcount++; + } } } - } - else if (c1 == c2) { - scan = (char *) find_span_end((U8 *) scan, (U8 *) this_eol, (U8) c1); - } - else { - /* See comments in regmatch() CURLY_B_min_known_fail. We avoid - * a conditional each time through the loop if the characters - * differ only in a single bit, as is the usual situation */ - U8 c1_c2_bits_differing = c1 ^ c2; - if (isPOWER_OF_2(c1_c2_bits_differing)) { - U8 c1_c2_mask = ~ c1_c2_bits_differing; + break; + } /* End of a full character is definitively matched */ - scan = (char *) find_span_end_mask((U8 *) scan, - (U8 *) this_eol, - c1 & c1_c2_mask, - c1_c2_mask); - } - else { - while ( scan < this_eol - && (UCHARAT(scan) == c1 || UCHARAT(scan) == c2)) + /* Here, an initial portion of the character matched definitively, + * and the rest matched as well, but could have false positives */ + + do { + PERL_INT_FAST8_T i; + U8 * matches = Binfo.matches; + + /* The first bytes were definitive. Look at the remaining */ + for (i = 0; i < Binfo.count; i++) { + if (memEQ(scan + definitive_len, + matches + definitive_len, + Binfo.lengths[i] - definitive_len)) { - scan++; + goto found_a_completion; } + + matches += Binfo.lengths[i]; } + + /* Didn't find anything to complete our initial match. Stop + * here */ + break; + + found_a_completion: + + /* Here, matched a full character, Include it in the result, + * and then look to see if the next char matches */ + hardcount++; + scan += Binfo.lengths[i]; + + } while ( hardcount < max + && scan + definitive_len < this_eol + && S_test_EXACTISH_ST(scan, Binfo)); + + /* Here, have advanced as far as possible */ + break; + } /* End of found some initial bytes that definitively matched */ + + /* Here, we can't rule out that we have found the beginning of 'B', but + * there were no initial bytes that could rule out anything + * definitively. Use brute force to examine all the possibilities */ + while (scan < this_eol && hardcount < max) { + PERL_INT_FAST8_T i; + U8 * matches = Binfo.matches; + + for (i = 0; i < Binfo.count; i++) { + if (memEQ(scan, matches, Binfo.lengths[i])) { + goto found1; + } + + matches += Binfo.lengths[i]; } - } + + break; + + found1: + hardcount++; + scan += Binfo.lengths[i]; + } + break; - } + } case ANYOFPOSIXL: case ANYOFL: _CHECK_AND_WARN_PROBLEMATIC_LOCALE; diff --git a/regexp.h b/regexp.h index d9f1a4090993..cfb8d443ceea 100644 --- a/regexp.h +++ b/regexp.h @@ -706,6 +706,32 @@ typedef struct { # define MAX_RECURSE_EVAL_NOCHANGE_DEPTH 10 #endif +/* The +3 is based on the current Unicode standards needs, and is unlikely to + * change. An assertion should fail in regexec.c if it is too low. It is + * needed for certain edge cases involving multi-character folds when the first + * component also participates in a fold individually. */ +#define MAX_MATCHES (MAX_FOLD_FROMS + 3) + +struct next_matchable_info { + U8 first_byte_mask; + U8 first_byte_anded; + U32 mask32; + U32 anded32; + PERL_INT_FAST8_T count; /* Negative means not initialized */ + PERL_UINT_FAST8_T min_length; + PERL_UINT_FAST8_T max_length; + PERL_UINT_FAST8_T initial_definitive; + PERL_UINT_FAST8_T initial_exact; + PERL_UINT_FAST8_T lengths[MAX_MATCHES]; + + /* The size is from trial and error, and could change with new Unicode + * standards, in which case there is an assertion that should start + * failing. This size could be calculated in one of the regen scripts + * dealing with Unicode, but khw thinks the likelihood of it changing is + * low enough that it isn't worth the effort. */ + U8 matches[18]; +}; + typedef I32 CHECKPOINT; typedef struct regmatch_state { @@ -854,7 +880,6 @@ typedef struct regmatch_state { struct { /* this first element must match u.yes */ struct regmatch_state *prev_yes_state; - int c1, c2; /* case fold search */ CHECKPOINT cp; U32 lastparen; U32 lastcloseparen; @@ -863,8 +888,7 @@ typedef struct regmatch_state { bool minmod; regnode *A, *B; /* the nodes corresponding to /A*B/ */ regnode *me; /* the curlym node */ - U8 c1_utf8[UTF8_MAXBYTES+1]; /* */ - U8 c2_utf8[UTF8_MAXBYTES+1]; + struct next_matchable_info Binfo; } curlym; struct { @@ -872,14 +896,12 @@ typedef struct regmatch_state { CHECKPOINT cp; U32 lastparen; U32 lastcloseparen; - int c1, c2; /* case fold search */ char *maxpos; /* highest possible point in string to match */ char *oldloc; /* the previous locinput */ int count; int min, max; /* {m,n} */ regnode *A, *B; /* the nodes corresponding to /A*B/ */ - U8 c1_utf8[UTF8_MAXBYTES+1]; /* */ - U8 c2_utf8[UTF8_MAXBYTES+1]; + struct next_matchable_info Binfo; } curly; /* and CURLYN/PLUS/STAR */ } u; From fbd8d54d31dadf460479192f11f6569ab3d10dd3 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 14 Nov 2020 13:55:38 -0700 Subject: [PATCH 256/503] regexec.c: White-space, comments only Mostly indent because the prior commit created a new block --- regexec.c | 98 ++++++++++++++++++++++++++++--------------------------- 1 file changed, 50 insertions(+), 48 deletions(-) diff --git a/regexec.c b/regexec.c index 533c0df5038c..597b49283fc6 100644 --- a/regexec.c +++ b/regexec.c @@ -1412,7 +1412,7 @@ Perl_re_intuit_start(pTHX_ * On the one hand you'd expect rare substrings to appear less * often than \n's. On the other hand, searching for \n means * we're effectively flipping between check_substr and "\n" on each - * iteration as the current "rarest" string candidate, which + * iteration as the current "rarest" candidate string, which * means for example that we'll quickly reject the whole string if * hasn't got a \n, rather than trying every substr position * first @@ -4808,7 +4808,8 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, fold_from = remaining_fold_froms[i-1]; } - if (folded == fold_from) { /* We already added the character itself */ + if (folded == fold_from) { /* We already added the character + itself */ continue; } @@ -4987,6 +4988,7 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, m->lengths[output_index] = lengths[index_of_longest]; } + return TRUE; } @@ -9218,60 +9220,60 @@ NULL curly_try_B_min_known: /* find the next place where 'B' could work, then call B */ if (locinput + ST.Binfo.initial_exact < loceol) { - if (ST.Binfo.initial_exact >= ST.Binfo.max_length) { - - /* Here, the mask is all 1's for the entire length of - * any possible match. (That actually means that there - * is only one possible match.) Look for the next - * occurrence */ - locinput = ninstr(locinput, loceol, - (char *) ST.Binfo.matches, - (char *) ST.Binfo.matches - + ST.Binfo.initial_exact); - if (locinput == NULL) { - sayNO; - } - } - else do { - /* If the first byte(s) of the mask are all ones, it - * means those bytes must match identically, so can use - * ninstr() to find the next possible matchpoint */ - if (ST.Binfo.initial_exact > 0) { + if (ST.Binfo.initial_exact >= ST.Binfo.max_length) { + + /* Here, the mask is all 1's for the entire length of + * any possible match. (That actually means that there + * is only one possible match.) Look for the next + * occurrence */ locinput = ninstr(locinput, loceol, - (char *) ST.Binfo.matches, - (char *) ST.Binfo.matches + (char *) ST.Binfo.matches, + (char *) ST.Binfo.matches + ST.Binfo.initial_exact); + if (locinput == NULL) { + sayNO; + } } - else { /* Otherwise find the next byte that matches, - masked */ - locinput = (char *) find_next_masked( - (U8 *) locinput, (U8 *) loceol, - ST.Binfo.first_byte_anded, - ST.Binfo.first_byte_mask); - /* Advance to the end of a multi-byte character */ - if (utf8_target) { - while ( locinput < loceol - && UTF8_IS_CONTINUATION(*locinput)) - { - locinput++; + else do { + /* If the first byte(s) of the mask are all ones, it + * means those bytes must match identically, so can use + * ninstr() to find the next possible matchpoint */ + if (ST.Binfo.initial_exact > 0) { + locinput = ninstr(locinput, loceol, + (char *) ST.Binfo.matches, + (char *) ST.Binfo.matches + + ST.Binfo.initial_exact); + } + else { /* Otherwise find the next byte that matches, + masked */ + locinput = (char *) find_next_masked( + (U8 *) locinput, (U8 *) loceol, + ST.Binfo.first_byte_anded, + ST.Binfo.first_byte_mask); + /* Advance to the end of a multi-byte character */ + if (utf8_target) { + while ( locinput < loceol + && UTF8_IS_CONTINUATION(*locinput)) + { + locinput++; + } } } - } - if ( locinput == NULL - || locinput + ST.Binfo.min_length > loceol) - { - sayNO; - } + if ( locinput == NULL + || locinput + ST.Binfo.min_length > loceol) + { + sayNO; + } - /* Here, we have found a possible match point; if can't - * rule it out, quit the loop so can check fully */ - if (S_test_EXACTISH_ST(locinput, ST.Binfo)) { - break; - } + /* Here, we have found a possible match point; if can't + * rule it out, quit the loop so can check fully */ + if (S_test_EXACTISH_ST(locinput, ST.Binfo)) { + break; + } - locinput += (utf8_target) ? UTF8SKIP(locinput) : 1; + locinput += (utf8_target) ? UTF8SKIP(locinput) : 1; - } while (locinput <= ST.maxpos); + } while (locinput <= ST.maxpos); } if (locinput > ST.maxpos) From 7510ca24a0ab79a6cf9eb76f13117b4e4d18051e Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 8 Dec 2020 18:30:56 -0700 Subject: [PATCH 257/503] Make many-reader mutexes more resilient These mutexes rely on a counter being accurate to work. If for some reason that I can't imagine happening, the count goes below 0, this commit resets it to zero, which may be enough to cause the program to continue. --- thread.h | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/thread.h b/thread.h index 4c4966f79df8..99679b22f5da 100644 --- a/thread.h +++ b/thread.h @@ -298,6 +298,7 @@ MUTEX_LOCK(&(mutex)->lock); \ (mutex)->readers_count--; \ if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ COND_SIGNAL(&(mutex)->wakeup); \ (mutex)->readers_count = 0; \ } \ @@ -308,8 +309,11 @@ STMT_START { \ MUTEX_LOCK(&(mutex)->lock); \ do { \ - if ((mutex)->readers_count == 0) \ + if ((mutex)->readers_count <= 0) { \ + assert((mutex)->readers_count == 0); \ + (mutex)->readers_count = 0; \ break; \ + } \ COND_WAIT(&(mutex)->wakeup, &(mutex)->lock); \ } \ while (1); \ From 57d4826ad702b8c483b826af1c82f52ce64651ff Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 1 Dec 2020 07:17:21 -0700 Subject: [PATCH 258/503] perl.h: Add capability for many-reader ENV mutex locking There are several places where there could be a problem in the environment were changed by another thread when a function is executing, but otherwise if another thread were reading the environment at the same time, there isn't a problem. This adds mutex for that situation. Future commits will take advantage of it. --- perl.h | 24 ++++++++++++------------ perlvars.h | 2 +- 2 files changed, 13 insertions(+), 13 deletions(-) diff --git a/perl.h b/perl.h index 76b6e72e19b5..9243ca82cb06 100644 --- a/perl.h +++ b/perl.h @@ -7003,19 +7003,19 @@ cannot have changed since the precalculation. #endif /* !USE_LOCALE_NUMERIC */ #ifdef USE_ITHREADS - /* On some platforms it would be safe to use a read/write mutex with many - * readers possible at the same time. On other platforms, notably IBM ones, - * subsequent getenv calls destroy earlier ones. Those platforms would not - * be able to handle simultaneous getenv calls */ -# define ENV_LOCK MUTEX_LOCK(&PL_env_mutex) -# define ENV_UNLOCK MUTEX_UNLOCK(&PL_env_mutex) -# define ENV_INIT MUTEX_INIT(&PL_env_mutex); -# define ENV_TERM MUTEX_DESTROY(&PL_env_mutex); +# define ENV_LOCK PERL_WRITE_LOCK(&PL_env_mutex) +# define ENV_UNLOCK PERL_WRITE_UNLOCK(&PL_env_mutex) +# define ENV_READ_LOCK PERL_READ_LOCK(&PL_env_mutex) +# define ENV_READ_UNLOCK PERL_READ_UNLOCK(&PL_env_mutex) +# define ENV_INIT PERL_RW_MUTEX_INIT(&PL_env_mutex) +# define ENV_TERM PERL_RW_MUTEX_DESTROY(&PL_env_mutex) #else -# define ENV_LOCK NOOP -# define ENV_UNLOCK NOOP -# define ENV_INIT NOOP -# define ENV_TERM NOOP +# define ENV_LOCK NOOP +# define ENV_UNLOCK NOOP +# define ENV_READ_LOCK NOOP +# define ENV_READ_UNLOCK NOOP +# define ENV_INIT NOOP +# define ENV_TERM NOOP #endif #ifndef PERL_NO_INLINE_FUNCTIONS diff --git a/perlvars.h b/perlvars.h index 1bbe5e3ed379..3bfd46fe9415 100644 --- a/perlvars.h +++ b/perlvars.h @@ -104,7 +104,7 @@ PERLVARI(G, mmap_page_size, IV, 0) #if defined(USE_ITHREADS) PERLVAR(G, hints_mutex, perl_mutex) /* Mutex for refcounted he refcounting */ -PERLVAR(G, env_mutex, perl_mutex) /* Mutex for accessing ENV */ +PERLVAR(G, env_mutex, perl_RnW1_mutex_t) /* Mutex for accessing ENV */ PERLVAR(G, locale_mutex, perl_mutex) /* Mutex related to locale handling */ # ifndef USE_THREAD_SAFE_LOCALE PERLVAR(G, lc_numeric_mutex, perl_mutex) /* Mutex for switching LC_NUMERIC */ From 9d228af78ad17dabb51f9059d215cc88c059a22a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 28 Nov 2020 09:20:46 -0700 Subject: [PATCH 259/503] Add Configure probe for getenv() buffer race Most implementations do not have a problem with two getenv()'s running simultaneously in different threads. But Posix doesn't require such good behavior. This adds a simple probe to test the current system. --- Configure | 82 ++++++++++++++++++++++++++++++++++ Cross/config.sh-arm-linux | 1 + Cross/config.sh-arm-linux-n770 | 1 + NetWare/config.wc | 1 + Porting/config.sh | 1 + config_h.SH | 13 ++++++ configure.com | 2 + metaconfig.h | 2 + plan9/config_sh.sample | 1 + uconfig.h | 17 ++++++- uconfig.sh | 1 + uconfig64.sh | 1 + win32/config.gc | 1 + win32/config.vc | 1 + 14 files changed, 123 insertions(+), 2 deletions(-) diff --git a/Configure b/Configure index 16d63709ee4a..90ea4bd55249 100755 --- a/Configure +++ b/Configure @@ -514,6 +514,7 @@ d_gai_strerror='' d_Gconvert='' d_getaddrinfo='' d_getcwd='' +d_getenv_preserves_other_thread='' d_getespwnam='' d_getfsstat='' d_getgrent='' @@ -14206,6 +14207,86 @@ eval $inlibc set getcwd d_getcwd eval $inlibc +: check for getenv behavior +case "$d_getenv_preserves_other_thread" in +'') +$echo "Checking to see if getenv() preserves a different thread's results" >&4 +$cat >try.c < +#endif +#include +#include +#$i_pthread I_PTHREAD +#ifdef I_PTHREAD +# include +#endif + +void * +thread_start(void * arg) +{ + (void *) getenv("HOME"); +} + +int main() { + char * main_buffer; + char save_main_buffer[1000]; + pthread_t subthread; + pthread_attr_t attr; + + main_buffer = getenv("PATH"); + + /* If too large for our generous allowance, return we couldn't figure it + * out. */ + if (strlen(main_buffer) >= sizeof(save_main_buffer)) { + exit(2); + } + + strcpy(save_main_buffer, main_buffer); + + if (pthread_attr_init(&attr) != 0) { + exit(2); + } + + if (pthread_create(&subthread, &attr, thread_start, NULL) != 0) { + exit(2); + } + + if (pthread_join(subthread, NULL) != 0) { + exit(2); + } + + exit(! strcmp(main_buffer, save_main_buffer) == 0); +} +EOCP +val= +set try +if eval $compile_ok; then + $run ./try + rc=$? + case "$rc" in + 0) echo "getenv() didn't destroy another thread's buffer" >&4 + val=$define + ;; + 1) echo "getenv() does destroy another thread's buffer" >&4 + val=$undef + ;; + *) echo "Couldn't determine if getenv() destroys another thread's return value (code=$rc); assuming it does" >&4 + val=$undef + ;; + esac +else + echo "(I can't seem to compile the test program.)" >&4 + echo "Assuming that your C library's getenv destroys another thread's return value." >&4 + val=$undef +fi +set d_getenv_preserves_other_thread +eval $setvar +$rm_try +;; +esac + : see if getespwnam exists set getespwnam d_getespwnam eval $inlibc @@ -24251,6 +24332,7 @@ d_gdbm_ndbm_h_uses_prototypes='$d_gdbm_ndbm_h_uses_prototypes' d_gdbmndbm_h_uses_prototypes='$d_gdbmndbm_h_uses_prototypes' d_getaddrinfo='$d_getaddrinfo' d_getcwd='$d_getcwd' +d_getenv_preserves_other_thread='$d_getenv_preserves_other_thread' d_getespwnam='$d_getespwnam' d_getfsstat='$d_getfsstat' d_getgrent='$d_getgrent' diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index fa4d036ce837..170da9b50ff6 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -248,6 +248,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='define' diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index b49c2f104d18..668d690ae94f 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -247,6 +247,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='define' diff --git a/NetWare/config.wc b/NetWare/config.wc index 5f55e121c5fc..26c1755798ed 100644 --- a/NetWare/config.wc +++ b/NetWare/config.wc @@ -236,6 +236,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' diff --git a/Porting/config.sh b/Porting/config.sh index 1401eaa6155c..392decb9ae60 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -264,6 +264,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='define' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='define' diff --git a/config_h.SH b/config_h.SH index 19e182444430..dceb480e1fde 100755 --- a/config_h.SH +++ b/config_h.SH @@ -4575,6 +4575,19 @@ sed <$CONFIG_H -e 's!^#undef\(.*/\)\*!/\*#define\1 \*!' -e 's!^#un #$d_endservent_r HAS_ENDSERVENT_R /**/ #define ENDSERVENT_R_PROTO $endservent_r_proto /**/ +/* GETENV_PRESERVES_OTHER_THREAD: + * This symbol, if defined, indicates that the getenv system call doesn't + * zap the static buffer of getenv() in a different thread. + * + * The typical getenv() implementation will return a pointer to the proper + * position in **environ. But some may instead copy them to a static + * buffer in getenv(). If there is a per-thread instance of that buffer, + * or the return points to **environ, then a many-reader/1-writer mutex + * will work; otherwise an exclusive locking mutex is required to prevent + * races. + */ +#$d_getenv_preserves_other_thread GETENV_PRESERVES_OTHER_THREAD /**/ + /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine * is available to getgrent re-entrantly. diff --git a/configure.com b/configure.com index e7ea8b9fcb69..77ce7ae0866d 100644 --- a/configure.com +++ b/configure.com @@ -5603,6 +5603,7 @@ $ THEN $ vms_cc_type="decc" $ ENDIF $ d_faststdio="define" +$ d_getenv_preserves_other_thread="define" $ d_locconv="define" $ d_mblen="define" $ d_mbstowcs="define" @@ -6398,6 +6399,7 @@ $ WC "d_nextafter='" + d_nextafter + "'" $ WC "d_nexttoward='" + d_nexttoward + "'" $ WC "d_nice='define'" $ WC "d_nl_langinfo='" + d_nl_langinfo + "'" +$ WC "d_getenv_preserves_other_thread='" + d_getenv_preserves_other_thread + "'" $ WC "d_nv_preserves_uv='" + d_nv_preserves_uv + "'" $ WC "nv_overflows_integers_at='" + nv_overflows_integers_at + "'" $ WC "nv_preserves_uv_bits='" + nv_preserves_uv_bits + "'" diff --git a/metaconfig.h b/metaconfig.h index baba5eac6879..ae0093afd420 100644 --- a/metaconfig.h +++ b/metaconfig.h @@ -14,4 +14,6 @@ * they should be removed from here. * * HAS_WCRTOMB + * GETENV_PRESERVES_OTHER_THREAD + * */ diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index dfd7c32772c5..691f90791754 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -248,6 +248,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='define' diff --git a/uconfig.h b/uconfig.h index 91f40df1411b..9df156400585 100644 --- a/uconfig.h +++ b/uconfig.h @@ -4540,6 +4540,19 @@ /*#define HAS_ENDSERVENT_R / **/ #define ENDSERVENT_R_PROTO 0 /**/ +/* GETENV_PRESERVES_OTHER_THREAD: + * This symbol, if defined, indicates that the getenv system call doesn't + * zap the static buffer of getenv() in a different thread. + * + * The typical getenv() implementation will return a pointer to the proper + * position in **environ. But some may instead copy them to a static + * buffer in getenv(). If there is a per-thread instance of that buffer, + * or the return points to **environ, then a many-reader/1-writer mutex + * will work; otherwise an exclusive locking mutex is required to prevent + * races. + */ +#define GETENV_PRESERVES_OTHER_THREAD /**/ + /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine * is available to getgrent re-entrantly. @@ -5269,6 +5282,6 @@ #endif /* Generated from: - * 404722487cbb4753192fd5c9d2e186551220f35fef1347ce39d942abaa90cbf4 config_h.SH - * 4c3159a6a9875b7811c2a920d7936d5199193afdb163473c313b9531ba2c0648 uconfig.sh + * 53ec858c462f9fa2669095834b3d350458c955777a07a0ad7a3a73162ff8ef0e config_h.SH + * b53784d20c0f250807f47a3130cdc8e01a92da948e6747af87ebc24f11904722 uconfig.sh * ex: set ro: */ diff --git a/uconfig.sh b/uconfig.sh index 7747dd633253..392070d59c3e 100644 --- a/uconfig.sh +++ b/uconfig.sh @@ -187,6 +187,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='undef' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' diff --git a/uconfig64.sh b/uconfig64.sh index f87cb0585029..6f238fc6e3d6 100644 --- a/uconfig64.sh +++ b/uconfig64.sh @@ -187,6 +187,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='undef' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' diff --git a/win32/config.gc b/win32/config.gc index 9ffec527bfdb..b6e298f3b5f2 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -235,6 +235,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' diff --git a/win32/config.vc b/win32/config.vc index 6d6e675c7a76..f4625bf2a4b9 100644 --- a/win32/config.vc +++ b/win32/config.vc @@ -235,6 +235,7 @@ d_gdbm_ndbm_h_uses_prototypes='undef' d_gdbmndbm_h_uses_prototypes='undef' d_getaddrinfo='undef' d_getcwd='define' +d_getenv_preserves_other_thread='define' d_getespwnam='undef' d_getfsstat='undef' d_getgrent='undef' From 35bcf7ffa2bfeab79ab7b4eb0d35f462775b54d2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 1 Dec 2020 07:44:18 -0700 Subject: [PATCH 260/503] Add GETENV_LOCK get_env() needs to lock other threads from writing to the environment while it is executing. It may need to have an exclusive lock if those threads can clobber its buffer before it gets a chance to save them. The previous commit has added a Configure probe which tells us if that is the case. This commit uses it to select which type of mutex to use. --- inline.h | 5 +++-- perl.h | 17 +++++++++++++++++ 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/inline.h b/inline.h index c18637208ffe..dbfb89a6b0e3 100644 --- a/inline.h +++ b/inline.h @@ -2654,7 +2654,7 @@ Perl_mortal_getenv(const char * str) return getenv(str); } - ENV_LOCK; + GETENV_LOCK; ret = getenv(str); @@ -2662,7 +2662,8 @@ Perl_mortal_getenv(const char * str) ret = SvPVX(sv_2mortal(newSVpv(ret, 0))); } - ENV_UNLOCK; + GETENV_UNLOCK; + return ret; } diff --git a/perl.h b/perl.h index 9243ca82cb06..cbb6905fe0af 100644 --- a/perl.h +++ b/perl.h @@ -7009,6 +7009,21 @@ cannot have changed since the precalculation. # define ENV_READ_UNLOCK PERL_READ_UNLOCK(&PL_env_mutex) # define ENV_INIT PERL_RW_MUTEX_INIT(&PL_env_mutex) # define ENV_TERM PERL_RW_MUTEX_DESTROY(&PL_env_mutex) + + /* On platforms where the static buffer contained in getenv() is per-thread + * rather than process-wide, another thread executing a getenv() at the same + * time won't destroy ours before we have copied the result safely away and + * unlocked the mutex. On such platforms (which is most), we can have many + * readers of the environment at the same time. */ +# ifdef GETENV_PRESERVES_OTHER_THREAD +# define GETENV_LOCK ENV_READ_LOCK +# define GETENV_UNLOCK ENV_READ_UNLOCK +# else + /* If, on the other hand, another thread could zap our getenv() return, we + * need to keep them from executing until we are done */ +# define GETENV_LOCK ENV_LOCK +# define GETENV_UNLOCK ENV_UNLOCK +# endif #else # define ENV_LOCK NOOP # define ENV_UNLOCK NOOP @@ -7016,6 +7031,8 @@ cannot have changed since the precalculation. # define ENV_READ_UNLOCK NOOP # define ENV_INIT NOOP # define ENV_TERM NOOP +# define GETENV_LOCK NOOP +# define GETENV_UNLOCK NOOP #endif #ifndef PERL_NO_INLINE_FUNCTIONS From 03694582f8c247d4a1cc8a7bb8348af0173944d7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 6 Dec 2020 15:01:14 -0700 Subject: [PATCH 261/503] Fix broken PERL_MEM_LOG under threads This fixes GH #18341 There are problems with getenv() on threaded perls wchich can lead to incorrect results when compiled with PERL_MEM_LOG. Commit 0b83dfe6dd9b0bda197566adec923f16b9a693cd fixed this for some platforms, but as Tony Cook, pointed out there may be standards-compliant platforms that that didn't fix. The detailed comments outline the issues and (complicated) full solution. --- embedvar.h | 1 + inline.h | 174 ++++++++++++++++++++++++++++++++++++++++++++++++----- intrpvar.h | 6 ++ makedef.pl | 4 ++ sv.c | 4 ++ util.c | 9 ++- 6 files changed, 178 insertions(+), 20 deletions(-) diff --git a/embedvar.h b/embedvar.h index 4427e0750efd..67ccd6b72302 100644 --- a/embedvar.h +++ b/embedvar.h @@ -204,6 +204,7 @@ #define PL_maxsysfd (vTHX->Imaxsysfd) #define PL_mbrlen_ps (vTHX->Imbrlen_ps) #define PL_mbrtowc_ps (vTHX->Imbrtowc_ps) +#define PL_mem_log (vTHX->Imem_log) #define PL_memory_debug_header (vTHX->Imemory_debug_header) #define PL_mess_sv (vTHX->Imess_sv) #define PL_min_intro_pending (vTHX->Imin_intro_pending) diff --git a/inline.h b/inline.h index dbfb89a6b0e3..bed8afa51060 100644 --- a/inline.h +++ b/inline.h @@ -2618,23 +2618,31 @@ Perl_mortal_getenv(const char * str) { /* This implements a (mostly) thread-safe, sequential-call-safe getenv(). * - * It's (mostly) thread-safe because it uses a mutex to prevent - * simultaneous access from other threads that use the same mutex, and - * makes a copy of the result before releasing that mutex. All of the Perl - * core uses that mutex, but, like all mutexes, everything has to cooperate - * for it to completely work. It is possible for code from, say XS, to not - * use this mutex, defeating the safety. + * It's (mostly) thread-safe because it uses a mutex to prevent other + * threads (that look at this mutex) from destroying the result before this + * routine has a chance to copy the result to a place that won't be + * destroyed before the caller gets a chance to handle it. That place is a + * mortal SV. khw chose this over SAVEFREEPV because he is under the + * impression that the SV will hang around longer under more circumstances * - * On some platforms, getenv() is not sequential-call-safe, because - * subsequent calls destroy the static storage inside the C library - * returned by an earlier call. The result must be copied or completely - * acted upon before a subsequent getenv call. Those calls could come from - * another thread. Again, making a copy while controlling the mutex - * prevents these problems.. + * The reason it isn't completely thread-safe is that other code could + * simply not pay attention to the mutex. All of the Perl core uses the + * mutex, but it is possible for code from, say XS, to not use this mutex, + * defeating the safety. * - * To prevent leaks, the copy is made by creating a new SV containing it, - * mortalizing the SV, and returning the SV's string (the copy). Thus this - * is a drop-in replacement for getenv(). + * getenv() returns, in some implementations, a pointer to a spot in the + * **environ array, which could be invalidated at any time by this or + * another thread changing the environment. Other implementations copy the + * **environ value to a static buffer, returning a pointer to that. That + * buffer might or might not be invalidated by a getenv() call in another + * thread. If it does get zapped, we need an exclusive lock. Otherwise, + * many getenv() calls can safely be running simultaneously, so a + * many-reader (but no simultaneous writers) lock is ok. There is a + * Configure probe to see if another thread destroys the buffer, and the + * mutex is defined accordingly. + * + * But in all cases, using the mutex prevents these problems, as long as + * all code uses the same mutex.. * * A complication is that this can be called during phases where the * mortalization process isn't available. These are in interpreter @@ -2654,8 +2662,137 @@ Perl_mortal_getenv(const char * str) return getenv(str); } +#ifdef PERL_MEM_LOG + + /* A major complication arises under PERL_MEM_LOG. When that is active, + * every memory allocation may result in logging, depending on the value of + * ENV{PERL_MEM_LOG} at the moment. That means, as we create the SV for + * saving ENV{foo}'s value (but before saving it), the logging code will + * call us recursively to find out what ENV{PERL_MEM_LOG} is. Without some + * care that could lead to: 1) infinite recursion; or 2) deadlock (trying to + * lock a boolean mutex recursively); 3) destroying the getenv() static + * buffer; or 4) destroying the temporary created by this for the copy + * causes a log entry to be made which could cause a new temporary to be + * created, which will need to be destroyed at some point, leading to an + * infinite loop. + * + * The solution adopted here (after some gnashing of teeth) is to detect + * the recursive calls and calls from the logger, and treat them specially. + * Let's say we want to do getenv("foo"). We first find + * getenv(PERL_MEM_LOG) and save it to a fixed-length per-interpreter + * variable, so no temporary is required. Then we do getenv(foo}, and in + * the process of creating a temporary to save it, this function will be + * called recursively to do a getenv(PERL_MEM_LOG). On the recursed call, + * we detect that it is such a call and return our saved value instead of + * locking and doing a new getenv(). This solves all of problems 1), 2), + * and 3). Because all the getenv()s are done while the mutex is locked, + * the state cannot have changed. To solve 4), we don't create a temporary + * when this is called from the logging code. That code disposes of the + * return value while the mutex is still locked. + * + * The value of getenv(PERL_MEM_LOG) can be anything, but only initial + * digits and 3 particular letters are significant; the rest are ignored by + * the memory logging code. Thus the per-interpreter variable only needs + * to be large enough to save the significant information, the size of + * which is known at compile time. The first byte is extra, reserved for + * flags for our use. To protect against overflowing, only the reserved + * byte, as many digits as don't overflow, and the three letters are + * stored. + * + * The reserved byte has two bits: + * 0x1 if set indicates that if we get here, it is a recursive call of + * getenv() + * 0x2 if set indicates that the call is from the logging code. + * + * If the flag indicates this is a recursive call, just return the stored + * value of PL_mem_log; An empty value gets turned into NULL. */ + if (strEQ(str, "PERL_MEM_LOG") && PL_mem_log[0] & 0x1) { + if (PL_mem_log[1] == '\0') { + return NULL; + } else { + return PL_mem_log + 1; + } + } + +#endif + GETENV_LOCK; +#ifdef PERL_MEM_LOG + + /* Here we are in a critical section. As explained above, we do our own + * getenv(PERL_MEM_LOG), saving the result safely. */ + ret = getenv("PERL_MEM_LOG"); + if (ret == NULL) { /* No logging active */ + + /* Return that immediately if called from the logging code */ + if (PL_mem_log[0] & 0x2) { + GETENV_UNLOCK; + return NULL; + } + + PL_mem_log[1] = '\0'; + } + else { + char *mem_log_meat = PL_mem_log + 1; /* first byte reserved */ + + /* There is nothing to prevent the value of PERL_MEM_LOG from being an + * extremely long string. But we want only a few characters from it. + * PL_mem_log has been made large enough to hold just the ones we need. + * First the file descriptor. */ + if (isDIGIT(*ret)) { + const char * s = ret; + if (UNLIKELY(*s == '0')) { + + /* Reduce multiple leading zeros to a single one. This is to + * allow the caller to change what to do with leading zeros. */ + *mem_log_meat++ = '0'; + s++; + while (*s == '0') { + s++; + } + } + + /* If the input overflows, copy just enough for the result to also + * overflow, plus 1 to make sure */ + while (isDIGIT(*s) && s < ret + TYPE_DIGITS(UV) + 1) { + *mem_log_meat++ = *s++; + } + } + + /* Then each of the three significant characters */ + if (strchr(ret, 'm')) { + *mem_log_meat++ = 'm'; + } + if (strchr(ret, 's')) { + *mem_log_meat++ = 's'; + } + if (strchr(ret, 't')) { + *mem_log_meat++ = 't'; + } + *mem_log_meat = '\0'; + + assert(mem_log_meat < PL_mem_log + sizeof(PL_mem_log)); + } + + /* If we are being called from the logger, it only needs the significant + * portion of PERL_MEM_LOG, and doesn't need a safe copy */ + if (PL_mem_log[0] & 0x2) { + assert(strEQ(str, "PERL_MEM_LOG")); + GETENV_UNLOCK; + return PL_mem_log + 1; + } + + /* Here is a generic getenv(). This could be a getenv("PERL_MEM_LOG") that + * is coming from other than the logging code, so it should be treated the + * same as any other getenv(), returning the full value, not just the + * significant part, and having its value saved. Set the flag that + * indicates any call to this routine will be a recursion from here */ + PL_mem_log[0] = 0x1; + +#endif + + /* Now get the value of the real desired variable, and save a copy */ ret = getenv(str); if (ret != NULL) { @@ -2664,6 +2801,13 @@ Perl_mortal_getenv(const char * str) GETENV_UNLOCK; +#ifdef PERL_MEM_LOG + + /* Clear the buffer */ + Zero(PL_mem_log, sizeof(PL_mem_log), char); + +#endif + return ret; } diff --git a/intrpvar.h b/intrpvar.h index b11607bc7909..f16d6dd3bc0e 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -1020,6 +1020,12 @@ PERLVAR(I, mbrtowc_ps, mbstate_t) #ifdef HAS_WCRTOMB PERLVAR(I, wcrtomb_ps, mbstate_t) #endif +#ifdef PERL_MEM_LOG +/* Enough space for the reserved byte, 1 for a potential leading 0, then enough + * for the longest representable integer plus an extra, the 3 flag characters, + * and NUL */ +PERLVARA(I, mem_log, 1 + 1 + TYPE_DIGITS(UV) + 1 + 3 + 1, char); +#endif /* If you are adding a U8 or U16, check to see if there are 'Space' comments * above on where there are gaps which currently will be structure padding. */ diff --git a/makedef.pl b/makedef.pl index 1d1941f5893b..16dd951086d2 100644 --- a/makedef.pl +++ b/makedef.pl @@ -486,6 +486,10 @@ sub readvar { ++$skip{PL_memory_debug_header}; } +unless ($define{'PERL_MEM_LOG'}) { + ++$skip{PL_mem_log}; +} + unless ($define{'MULTIPLICITY'}) { ++$skip{$_} foreach qw( PL_interp_size diff --git a/sv.c b/sv.c index 18d9e0436b8c..d4df78fb0200 100644 --- a/sv.c +++ b/sv.c @@ -15407,6 +15407,10 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, /* op_free() hook */ PL_opfreehook = proto_perl->Iopfreehook; +# ifdef PERL_MEM_LOG + Zero(PL_mem_log, sizeof(PL_mem_log), char); +# endif + #ifdef USE_REENTRANT_API /* XXX: things like -Dm will segfault here in perlio, but doing * PERL_SET_CONTEXT(proto_perl); diff --git a/util.c b/util.c index 1bfa7f5764e7..4cd23e897344 100644 --- a/util.c +++ b/util.c @@ -5001,14 +5001,13 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, const char *funcname) { const char *pmlenv; + dTHX; PERL_ARGS_ASSERT_MEM_LOG_COMMON; - /* Use plain getenv() to avoid potential deadlock with PerlEnv_getenv(). - * This means that 'pmlenv' is not protected from other threads overwriting - * it on platforms where getenv() returns an internal static pointer. See - * GH #18341 */ - pmlenv = getenv("PERL_MEM_LOG"); + PL_mem_log[0] |= 0x2; /* Flag that the call is from this code */ + pmlenv = PerlEnv_getenv("PERL_MEM_LOG"); + PL_mem_log[0] &= ~0x2; if (!pmlenv) return; if (mlt < MLT_NEW_SV ? strchr(pmlenv,'m') : strchr(pmlenv,'s')) From f84bd5086832f1839161f93c9d2099e08eb990af Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 10:32:01 +0100 Subject: [PATCH 262/503] Finalise perldelta for 5.33.5 --- pod/perldelta.pod | 283 ++++++---------------------------------------- 1 file changed, 35 insertions(+), 248 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a366ae899323..f917bdf17863 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,9 +2,6 @@ =head1 NAME -[ this is a template for a new perldelta file. Any text flagged as XXX needs -to be processed before release. ] - perldelta - what is new for perl v5.33.5 =head1 DESCRIPTION @@ -15,18 +12,8 @@ release. If you are upgrading from an earlier release such as 5.33.3, first read L, which describes differences between 5.33.3 and 5.33.4. -=head1 Notice - -XXX Any important notices here - =head1 Core Enhancements -XXX New core language features go here. Summarize user-visible core language -enhancements. Particularly prominent performance optimisations could go -here, but most should go in the L section. - -[ List each enhancement as a =head2 entry ] - =head2 New octal syntax C<0oI> It is now possible to specify octal literals with C<0o> prefixes, @@ -36,72 +23,6 @@ Also, the builtin C function now accepts this new syntax. See L and L. -=head1 Security - -XXX Any security-related notices go here. In particular, any security -vulnerabilities closed should be noted here rather than in the -L section. - -[ List each security issue as a =head2 entry ] - -=head1 Incompatible Changes - -XXX For a release on a stable branch, this section aspires to be: - - There are no changes intentionally incompatible with 5.XXX.XXX - If any exist, they are bugs, and we request that you submit a - report. See L below. - -[ List each incompatible change as a =head2 entry ] - -=head1 Deprecations - -XXX Any deprecated features, syntax, modules etc. should be listed here. - -=head2 Module removals - -XXX Remove this section if not applicable. - -The following modules will be removed from the core distribution in a -future release, and will at that time need to be installed from CPAN. -Distributions on CPAN which require these modules will need to list them as -prerequisites. - -The core versions of these modules will now issue C<"deprecated">-category -warnings to alert you to this fact. To silence these deprecation warnings, -install the modules in question from CPAN. - -Note that these are (with rare exceptions) fine modules that you are encouraged -to continue to use. Their disinclusion from core primarily hinges on their -necessity to bootstrapping a fully functional, CPAN-capable Perl installation, -not usually on concerns over their design. - -=over - -=item XXX - -XXX Note that deprecated modules should be listed here even if they are listed -as an updated module in the L section. - -=back - -[ List each other deprecation as a =head2 entry ] - -=head1 Performance Enhancements - -XXX Changes which enhance performance without changing behaviour go here. -There may well be none in a stable release. - -[ List each enhancement as an =item entry ] - -=over 4 - -=item * - -XXX - -=back - =head1 Modules and Pragmata XXX All changes to installed files in F, F, F and F @@ -152,16 +73,12 @@ XXX =head1 Documentation -XXX Changes to files in F go here. Consider grouping entries by -file and be sure to link to the appropriate page, e.g. L. - =head2 New Documentation -L has been added to F. - -=head3 L +=head3 L has been added to F. -XXX Description of the purpose of the new file here +This document is a guide for the authorship and maintenance of the +documentation that ships with Perl. =head2 Changes to Existing Documentation @@ -169,10 +86,6 @@ We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. -XXX Changes which significantly change existing files in F go here. -However, any changes to F should go in the L -section. - Additionally, the following selected changes have been made: =head3 L @@ -187,109 +100,12 @@ C contains only the type and the message content. =back -=head1 Diagnostics - -The following additions or changes have been made to diagnostic output, -including warnings and fatal error messages. For the complete list of -diagnostic messages, see L. - -XXX New or changed warnings emitted by the core's C code go here. Also -include any changes in L that reconcile it to the C code. - -=head2 New Diagnostics - -XXX Newly added diagnostic messages go under here, separated into New Errors -and New Warnings - -=head3 New Errors - -=over 4 - -=item * - -XXX L - -=back - -=head3 New Warnings - -=over 4 - -=item * - -XXX L - -=back - -=head2 Changes to Existing Diagnostics - -XXX Changes (i.e. rewording) of diagnostic messages go here - -=over 4 - -=item * - -XXX Describe change here - -=back - -=head1 Utility Changes - -XXX Changes to installed programs such as F and F go here. -Most of these are built within the directory F. - -[ List utility changes as a =head2 entry for each utility and =item -entries for each change -Use L with program names to get proper documentation linking. ] - -=head2 L - -=over 4 - -=item * - -XXX - -=back - -=head1 Configuration and Compilation - -XXX Changes to F, F, F, and analogous tools -go here. Any other changes to the Perl build process should be listed here. -However, any platform-specific changes should be listed in the -L section, instead. - -[ List changes as an =item entry ]. - -=over 4 - -=item * - -XXX - -=back - =head1 Testing -XXX Any significant changes to the testing of a freshly built perl should be -listed here. Changes which create B files in F go here as do any -large changes to the testing harness (e.g. when parallel testing was added). -Changes to existing files in F aren't worth summarizing, although the bugs -that they represent may be covered elsewhere. - -XXX If there were no significant test changes, say this: - -Tests were added and changed to reflect the other additions and changes -in this release. - -XXX If instead there were significant changes, say this: - Tests were added and changed to reflect the other additions and changes in this release. Furthermore, these significant changes were made: -[ List each test improvement as an =item entry ] - =over 4 =item * @@ -304,47 +120,8 @@ while running the test suite. =back -=head1 Platform Support - -XXX Any changes to platform support should be listed in the sections below. - -[ Within the sections, list each platform as an =item entry with specific -changes as paragraphs below it. ] - -=head2 New Platforms - -XXX List any platforms that this version of perl compiles on, that previous -versions did not. These will either be enabled by new files in the F -directories, or new subdirectories and F files at the top level of the -source tree. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - -=head2 Discontinued Platforms - -XXX List any platforms that this version of perl no longer compiles on. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - =head2 Platform-Specific Notes -XXX List any changes for specific platforms. This could include configuration -and compilation changes or changes in portability/compatibility. However, -changes within modules for platforms should generally be listed in the -L section. - =over 4 =item Windows @@ -388,12 +165,6 @@ L<[#12431]|https://github.com/Perl/perl5/issues/12431>. =head1 Internal Changes -XXX Changes which affect the interface available to C code go here. Other -significant internal changes for future core maintainers should be noted as -well. - -[ List each change as an =item entry ] - =over 4 =item * @@ -402,14 +173,16 @@ All C-ish functions now evaluate their arguments exactly once. In 5.32, plain L> was changed to do that; now the rest do as well. -=back +=item * -=head1 Selected Bug Fixes +Unicode is now a first class citizen when considering the pattern /A*B/ where +A and B are arbitrary. The pattern matching code tries to make a tight loop +to match the span of A's. The logic of this was now really updated with +support for UTF-8. -XXX Important bug fixes in the core language are summarized here. Bug fixes in -files in F and F are best summarized in L. +=back -[ List each fix as an =item entry ] +=head1 Selected Bug Fixes =over 4 @@ -468,25 +241,39 @@ XXX =head1 Errata From Previous Releases -=over 4 +None -=item * +=head1 Acknowledgements -XXX Add anything here that we forgot to add, or were mistaken about, in -the perldelta of a previous release. +Perl 5.33.5 represents approximately 4 weeks of development since Perl +5.33.4 and contains approximately 22,000 lines of changes across 370 files +from 27 authors. -=back +Excluding auto-generated files, documentation and release tools, there were +approximately 15,000 lines of changes to 220 .pm, .t, .c and .h files. -=head1 Obituary +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.5: -XXX If any significant core contributor or member of the CPAN community has -died, add a short obituary here. +Branislav Zahradník, Chris 'BinGOs' Williams, Dan Book, Dan Kogai, David +Cantrell, David Mitchell, Graham Knop, H.Merijn Brand, Jae Bradley, James E +Keenan, Jason McIntosh, jkahrman, John Karr, Karen Etheridge, Karl +Williamson, Leon Timmermans, Max Maischein, Paul Evans, Sawyer X, Sevan +Janiyan, Shlomi Fish, Steve Hay, TAKAI Kousuke, Thibault Duponchelle, Tomasz +Konojacki, Tom Hukins, Tony Cook. -=head1 Acknowledgements +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. -XXX Generate this with: +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. - perl Porting/acknowledgements.pl v5.33.4..HEAD +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. =head1 Reporting Bugs From 5c9a521be53817c75b9906c30416c1c77f010396 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 10:45:48 +0100 Subject: [PATCH 263/503] Finalize perldelta for 5.33.5 --- pod/perldelta.pod | 335 +++++++++++----------------------------------- 1 file changed, 75 insertions(+), 260 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a366ae899323..482733026b0a 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,9 +2,6 @@ =head1 NAME -[ this is a template for a new perldelta file. Any text flagged as XXX needs -to be processed before release. ] - perldelta - what is new for perl v5.33.5 =head1 DESCRIPTION @@ -15,18 +12,8 @@ release. If you are upgrading from an earlier release such as 5.33.3, first read L, which describes differences between 5.33.3 and 5.33.4. -=head1 Notice - -XXX Any important notices here - =head1 Core Enhancements -XXX New core language features go here. Summarize user-visible core language -enhancements. Particularly prominent performance optimisations could go -here, but most should go in the L section. - -[ List each enhancement as a =head2 entry ] - =head2 New octal syntax C<0oI> It is now possible to specify octal literals with C<0o> prefixes, @@ -36,132 +23,102 @@ Also, the builtin C function now accepts this new syntax. See L and L. -=head1 Security +=head1 Modules and Pragmata -XXX Any security-related notices go here. In particular, any security -vulnerabilities closed should be noted here rather than in the -L section. +=head2 Updated Modules and Pragmata -[ List each security issue as a =head2 entry ] +=over 4 -=head1 Incompatible Changes +=item * -XXX For a release on a stable branch, this section aspires to be: +L has been upgraded from version 1.50 to 1.51. - There are no changes intentionally incompatible with 5.XXX.XXX - If any exist, they are bugs, and we request that you submit a - report. See L below. +=item * -[ List each incompatible change as a =head2 entry ] +L has been upgraded from version 0.32 to 0.33. -=head1 Deprecations +=item * -XXX Any deprecated features, syntax, modules etc. should be listed here. +L has been upgraded from version 1.48 to 1.49. -=head2 Module removals +=item * -XXX Remove this section if not applicable. +L has been upgraded from version 3.07 to 3.08. -The following modules will be removed from the core distribution in a -future release, and will at that time need to be installed from CPAN. -Distributions on CPAN which require these modules will need to list them as -prerequisites. +=item * -The core versions of these modules will now issue C<"deprecated">-category -warnings to alert you to this fact. To silence these deprecation warnings, -install the modules in question from CPAN. +L has been upgraded from version 2.18 to 2.20. -Note that these are (with rare exceptions) fine modules that you are encouraged -to continue to use. Their disinclusion from core primarily hinges on their -necessity to bootstrapping a fully functional, CPAN-capable Perl installation, -not usually on concerns over their design. +=item * -=over +L has been upgraded from version 3.41 to 3.42. -=item XXX +=item * -XXX Note that deprecated modules should be listed here even if they are listed -as an updated module in the L section. +L has been upgraded from version 2.34 to 2.35. -=back +=item * -[ List each other deprecation as a =head2 entry ] +L has been upgraded from version 1.37 to 1.38. -=head1 Performance Enhancements +=item * -XXX Changes which enhance performance without changing behaviour go here. -There may well be none in a stable release. +L has been upgraded from version 3.79 to 3.80. -[ List each enhancement as an =item entry ] +=item * -=over 4 +The libnet distribution has been upgraded from version 3.11 to 3.12. =item * -XXX +L has been upgraded from version 5.20201120 to 5.20201220. -=back +=item * -=head1 Modules and Pragmata +L has been upgraded from version 1.16 to 1.17. -XXX All changes to installed files in F, F, F and F -go here. If Module::CoreList is updated, generate an initial draft of the -following sections using F. A paragraph summary -for important changes should then be added by hand. In an ideal world, -dual-life modules would have a F file that could be cribbed. +=item * -The list of new and updated modules is modified automatically as part of -preparing a Perl release, so the only reason to manually add entries here is if -you're summarising the important changes in the module update. (Also, if the -manually-added details don't match the automatically-generated ones, the -release manager will have to investigate the situation carefully.) +L has been upgraded from version 1.48 to 1.49. -[ Within each section, list entries as an =item entry ] +=item * -=head2 New Modules and Pragmata - -=over 4 +L has been upgraded from version 0.08 to 0.09. =item * -XXX Remove this section if not applicable. - -=back +L has been upgraded from version 1.95 to 1.96. -=head2 Updated Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 3.42 to 3.43. =item * -L has been upgraded from version A.xx to B.yy. +L has been upgraded from version 2.03 to 2.04. -If there was something important to note about this change, include that here. +=item * -=back +L has been upgraded from version 1.9765 to 1.9766. -=head2 Removed Modules and Pragmata +=item * -=over 4 +L has been upgraded from version 1.48 to 1.49. =item * -XXX +L has been upgraded from version 1.13 to 1.14. =back =head1 Documentation -XXX Changes to files in F go here. Consider grouping entries by -file and be sure to link to the appropriate page, e.g. L. - =head2 New Documentation -L has been added to F. +=head3 L has been added to F. -=head3 L - -XXX Description of the purpose of the new file here +This document is a guide for the authorship and maintenance of the +documentation that ships with Perl. =head2 Changes to Existing Documentation @@ -169,10 +126,6 @@ We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. -XXX Changes which significantly change existing files in F go here. -However, any changes to F should go in the L -section. - Additionally, the following selected changes have been made: =head3 L @@ -187,109 +140,12 @@ C contains only the type and the message content. =back -=head1 Diagnostics - -The following additions or changes have been made to diagnostic output, -including warnings and fatal error messages. For the complete list of -diagnostic messages, see L. - -XXX New or changed warnings emitted by the core's C code go here. Also -include any changes in L that reconcile it to the C code. - -=head2 New Diagnostics - -XXX Newly added diagnostic messages go under here, separated into New Errors -and New Warnings - -=head3 New Errors - -=over 4 - -=item * - -XXX L - -=back - -=head3 New Warnings - -=over 4 - -=item * - -XXX L - -=back - -=head2 Changes to Existing Diagnostics - -XXX Changes (i.e. rewording) of diagnostic messages go here - -=over 4 - -=item * - -XXX Describe change here - -=back - -=head1 Utility Changes - -XXX Changes to installed programs such as F and F go here. -Most of these are built within the directory F. - -[ List utility changes as a =head2 entry for each utility and =item -entries for each change -Use L with program names to get proper documentation linking. ] - -=head2 L - -=over 4 - -=item * - -XXX - -=back - -=head1 Configuration and Compilation - -XXX Changes to F, F, F, and analogous tools -go here. Any other changes to the Perl build process should be listed here. -However, any platform-specific changes should be listed in the -L section, instead. - -[ List changes as an =item entry ]. - -=over 4 - -=item * - -XXX - -=back - =head1 Testing -XXX Any significant changes to the testing of a freshly built perl should be -listed here. Changes which create B files in F go here as do any -large changes to the testing harness (e.g. when parallel testing was added). -Changes to existing files in F aren't worth summarizing, although the bugs -that they represent may be covered elsewhere. - -XXX If there were no significant test changes, say this: - -Tests were added and changed to reflect the other additions and changes -in this release. - -XXX If instead there were significant changes, say this: - Tests were added and changed to reflect the other additions and changes in this release. Furthermore, these significant changes were made: -[ List each test improvement as an =item entry ] - =over 4 =item * @@ -304,47 +160,8 @@ while running the test suite. =back -=head1 Platform Support - -XXX Any changes to platform support should be listed in the sections below. - -[ Within the sections, list each platform as an =item entry with specific -changes as paragraphs below it. ] - -=head2 New Platforms - -XXX List any platforms that this version of perl compiles on, that previous -versions did not. These will either be enabled by new files in the F -directories, or new subdirectories and F files at the top level of the -source tree. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - -=head2 Discontinued Platforms - -XXX List any platforms that this version of perl no longer compiles on. - -=over 4 - -=item XXX-some-platform - -XXX - -=back - =head2 Platform-Specific Notes -XXX List any changes for specific platforms. This could include configuration -and compilation changes or changes in portability/compatibility. However, -changes within modules for platforms should generally be listed in the -L section. - =over 4 =item Windows @@ -388,12 +205,6 @@ L<[#12431]|https://github.com/Perl/perl5/issues/12431>. =head1 Internal Changes -XXX Changes which affect the interface available to C code go here. Other -significant internal changes for future core maintainers should be noted as -well. - -[ List each change as an =item entry ] - =over 4 =item * @@ -402,14 +213,16 @@ All C-ish functions now evaluate their arguments exactly once. In 5.32, plain L> was changed to do that; now the rest do as well. -=back +=item * -=head1 Selected Bug Fixes +Unicode is now a first class citizen when considering the pattern /A*B/ where +A and B are arbitrary. The pattern matching code tries to make a tight loop +to match the span of A's. The logic of this was now really updated with +support for UTF-8. -XXX Important bug fixes in the core language are summarized here. Bug fixes in -files in F and F are best summarized in L. +=back -[ List each fix as an =item entry ] +=head1 Selected Bug Fixes =over 4 @@ -452,41 +265,43 @@ be left on, resulting in a possibly corrupt result in C. =head1 Known Problems -XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any -tests that had to be Ced for the release would be noted here. Unfixed -platform specific bugs also go here. - -[ List each fix as an =item entry ] - -=over 4 - -=item * - -XXX - -=back +None =head1 Errata From Previous Releases -=over 4 +None -=item * +=head1 Acknowledgements -XXX Add anything here that we forgot to add, or were mistaken about, in -the perldelta of a previous release. +Perl 5.33.5 represents approximately 4 weeks of development since Perl +5.33.4 and contains approximately 22,000 lines of changes across 370 files +from 27 authors. -=back +Excluding auto-generated files, documentation and release tools, there were +approximately 15,000 lines of changes to 220 .pm, .t, .c and .h files. -=head1 Obituary +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.5: -XXX If any significant core contributor or member of the CPAN community has -died, add a short obituary here. +Branislav Zahradník, Chris 'BinGOs' Williams, Dan Book, Dan Kogai, David +Cantrell, David Mitchell, Graham Knop, H.Merijn Brand, Jae Bradley, James E +Keenan, Jason McIntosh, jkahrman, John Karr, Karen Etheridge, Karl +Williamson, Leon Timmermans, Max Maischein, Paul Evans, Sawyer X, Sevan +Janiyan, Shlomi Fish, Steve Hay, TAKAI Kousuke, Thibault Duponchelle, Tomasz +Konojacki, Tom Hukins, Tony Cook. -=head1 Acknowledgements +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. -XXX Generate this with: +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. - perl Porting/acknowledgements.pl v5.33.4..HEAD +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. =head1 Reporting Bugs From eeda0517e1c1b8df9f095ae4ab97f5dcc4f6f092 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 10:53:09 +0100 Subject: [PATCH 264/503] Update Module::CoreList for 5.33.5 --- dist/Module-CoreList/lib/Module/CoreList.pm | 99 ++++++++++++++++++++- 1 file changed, 98 insertions(+), 1 deletion(-) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 4b1b7583612c..a938a03e3d6a 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -18090,10 +18090,107 @@ for my $version ( sort { $a <=> $b } keys %released ) { 5.033005 => { delta_from => 5.033004, changed => { + 'App::Prove' => '3.43', + 'App::Prove::State' => '3.43', + 'App::Prove::State::Result'=> '3.43', + 'App::Prove::State::Result::Test'=> '3.43', 'B::Op_private' => '5.033005', + 'Carp' => '1.51', + 'Carp::Heavy' => '1.51', 'Config' => '5.033005', + 'Config::Perl::V' => '0.33', + 'Cwd' => '3.80', + 'DynaLoader' => '1.49', + 'Encode' => '3.08', + 'Encode::GSM0338' => '2.09', + 'ExtUtils::Install' => '2.20', + 'ExtUtils::Installed' => '2.20', + 'ExtUtils::Packlist' => '2.20', + 'ExtUtils::ParseXS' => '3.42', + 'ExtUtils::ParseXS::Constants'=> '3.42', + 'ExtUtils::ParseXS::CountLines'=> '3.42', + 'ExtUtils::ParseXS::Eval'=> '3.42', + 'ExtUtils::ParseXS::Utilities'=> '3.42', + 'File::Copy' => '2.35', + 'File::Find' => '1.38', + 'File::Spec' => '3.80', + 'File::Spec::AmigaOS' => '3.80', + 'File::Spec::Cygwin' => '3.80', + 'File::Spec::Epoc' => '3.80', + 'File::Spec::Functions' => '3.80', + 'File::Spec::Mac' => '3.80', + 'File::Spec::OS2' => '3.80', + 'File::Spec::Unix' => '3.80', + 'File::Spec::VMS' => '3.80', + 'File::Spec::Win32' => '3.80', 'Module::CoreList' => '5.20201220', 'Module::CoreList::Utils'=> '5.20201220', + 'Net::Cmd' => '3.12', + 'Net::Config' => '3.12', + 'Net::Domain' => '3.12', + 'Net::FTP' => '3.12', + 'Net::FTP::A' => '3.12', + 'Net::FTP::E' => '3.12', + 'Net::FTP::I' => '3.12', + 'Net::FTP::L' => '3.12', + 'Net::FTP::dataconn' => '3.12', + 'Net::NNTP' => '3.12', + 'Net::Netrc' => '3.12', + 'Net::POP3' => '3.12', + 'Net::SMTP' => '3.12', + 'Net::Time' => '3.12', + 'ODBM_File' => '1.17', + 'Opcode' => '1.49', + 'POSIX' => '1.96', + 'PerlIO::via::QuotedPrint'=> '0.09', + 'TAP::Base' => '3.43', + 'TAP::Formatter::Base' => '3.43', + 'TAP::Formatter::Color' => '3.43', + 'TAP::Formatter::Console'=> '3.43', + 'TAP::Formatter::Console::ParallelSession'=> '3.43', + 'TAP::Formatter::Console::Session'=> '3.43', + 'TAP::Formatter::File' => '3.43', + 'TAP::Formatter::File::Session'=> '3.43', + 'TAP::Formatter::Session'=> '3.43', + 'TAP::Harness' => '3.43', + 'TAP::Harness::Env' => '3.43', + 'TAP::Object' => '3.43', + 'TAP::Parser' => '3.43', + 'TAP::Parser::Aggregator'=> '3.43', + 'TAP::Parser::Grammar' => '3.43', + 'TAP::Parser::Iterator' => '3.43', + 'TAP::Parser::Iterator::Array'=> '3.43', + 'TAP::Parser::Iterator::Process'=> '3.43', + 'TAP::Parser::Iterator::Stream'=> '3.43', + 'TAP::Parser::IteratorFactory'=> '3.43', + 'TAP::Parser::Multiplexer'=> '3.43', + 'TAP::Parser::Result' => '3.43', + 'TAP::Parser::Result::Bailout'=> '3.43', + 'TAP::Parser::Result::Comment'=> '3.43', + 'TAP::Parser::Result::Plan'=> '3.43', + 'TAP::Parser::Result::Pragma'=> '3.43', + 'TAP::Parser::Result::Test'=> '3.43', + 'TAP::Parser::Result::Unknown'=> '3.43', + 'TAP::Parser::Result::Version'=> '3.43', + 'TAP::Parser::Result::YAML'=> '3.43', + 'TAP::Parser::ResultFactory'=> '3.43', + 'TAP::Parser::Scheduler'=> '3.43', + 'TAP::Parser::Scheduler::Job'=> '3.43', + 'TAP::Parser::Scheduler::Spinner'=> '3.43', + 'TAP::Parser::Source' => '3.43', + 'TAP::Parser::SourceHandler'=> '3.43', + 'TAP::Parser::SourceHandler::Executable'=> '3.43', + 'TAP::Parser::SourceHandler::File'=> '3.43', + 'TAP::Parser::SourceHandler::Handle'=> '3.43', + 'TAP::Parser::SourceHandler::Perl'=> '3.43', + 'TAP::Parser::SourceHandler::RawTAP'=> '3.43', + 'TAP::Parser::YAMLish::Reader'=> '3.43', + 'TAP::Parser::YAMLish::Writer'=> '3.43', + 'Test::Harness' => '3.43', + 'Text::Balanced' => '2.04', + 'Time::HiRes' => '1.9766', + 'XS::APItest' => '1.14', + 'warnings' => '1.49', }, removed => { } @@ -19753,7 +19850,7 @@ sub is_core 'Compress::Raw::Bzip2' => 'https://github.com/pmqs/Compress-Raw-Bzip2/issues', 'Compress::Raw::Zlib' => 'https://github.com/pmqs/Compress-Raw-Zlib/issues', 'Compress::Zlib' => 'https://github.com/pmqs/IO-Compress/issues', - 'Config::Perl::V' => undef, + 'Config::Perl::V' => 'https://github.com/Tux/Config-Perl-V/issues', 'DB_File' => 'https://github.com/pmqs/DB_File/issues', 'Digest' => 'https://github.com/Dual-Life/digest/issues', 'Digest::MD5' => 'https://github.com/Dual-Life/digest-md5/issues', From b0d2479a156520088b5c09de9b5322bb2381c19c Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 11:19:16 +0100 Subject: [PATCH 265/503] add new release to perlhist --- pod/perlhist.pod | 1 + 1 file changed, 1 insertion(+) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 3bf660200c3e..5b7c2e18c6b8 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -700,6 +700,7 @@ the strings?). Sawyer X 5.33.2 2020-Sep-20 Steve 5.33.3 2020-Oct-20 Tom H 5.33.4 2020-Nov-20 + Max M 5.33.5 2020-Dec-20 =head2 SELECTED RELEASE SIZES From cb3055457b8af3615b233f18a8ea27f325bca728 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 15:22:54 +0100 Subject: [PATCH 266/503] Update epigraphs.pod with quote from Max Weber --- Porting/epigraphs.pod | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index b6bcf201e8e0..8121849fac78 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,13 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.33.5 - Max Weber, (from "Understanding Administration", by Wolfgang Seibel) + +L + +Authority is primarily: Administration + -- Max Weber + =head2 v5.33.4 - George Eliot, "Adam Bede" L From 726eb38ebe55ff58f98f5dc47a6354b1342c067b Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 15:23:02 +0100 Subject: [PATCH 267/503] Update release schedule --- Porting/release_schedule.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 9390a65a7071..9c624e25bac5 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -44,7 +44,7 @@ you should reset the version numbers to the next blead series. 2020-09-20 5.33.2 ✓ Sawyer X 2020-10-20 5.33.3 ✓ Steve Hay 2020-11-20 5.33.4 ✓ Tom Hukins - 2020-12-20 5.33.5 Max Maischein + 2020-12-20 5.33.5 ✓ Max Maischein 2021-01-20 5.33.6 Richard Leach 2021-02-20 5.33.7 Renee Backer 2021-03-20 5.33.8 Atoomic From 6aeb63c3044d526a89b34cc5053aada4eacaecd5 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 15:28:55 +0100 Subject: [PATCH 268/503] new perldelta for 5.33.6 --- MANIFEST | 1 + Makefile.SH | 8 +- pod/.gitignore | 2 +- pod/perl.pod | 1 + pod/perl5335delta.pod | 341 ++++++++++++++++++++++++++++++++ pod/perldelta.pod | 408 ++++++++++++++++++++++++--------------- vms/descrip_mms.template | 2 +- win32/GNUmakefile | 4 +- win32/Makefile | 4 +- win32/makefile.mk | 4 +- win32/pod.mak | 4 + 11 files changed, 614 insertions(+), 165 deletions(-) create mode 100644 pod/perl5335delta.pod diff --git a/MANIFEST b/MANIFEST index 3330df87b23a..1585a9990224 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5228,6 +5228,7 @@ pod/perl5331delta.pod Perl changes in version 5.33.1 pod/perl5332delta.pod Perl changes in version 5.33.2 pod/perl5333delta.pod Perl changes in version 5.33.3 pod/perl5334delta.pod Perl changes in version 5.33.4 +pod/perl5335delta.pod Perl changes in version 5.33.5 pod/perl561delta.pod Perl changes in version 5.6.1 pod/perl56delta.pod Perl changes in version 5.6 pod/perl581delta.pod Perl changes in version 5.8.1 diff --git a/Makefile.SH b/Makefile.SH index 7356f0a8f4fe..ba8d9bd19d3c 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -589,7 +589,7 @@ esac $spitshell >>$Makefile <<'!NO!SUBS!' -perltoc_pod_prereqs = extra.pods pod/perl5335delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +perltoc_pod_prereqs = extra.pods pod/perl5336delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs) generated_headers = uudmap.h bitcount.h mg_data.h @@ -1153,9 +1153,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST $(MINIPERL) pod/perlmodlib.PL -q -pod/perl5335delta.pod: pod/perldelta.pod - $(RMS) pod/perl5335delta.pod - $(LNS) perldelta.pod pod/perl5335delta.pod +pod/perl5336delta.pod: pod/perldelta.pod + $(RMS) pod/perl5336delta.pod + $(LNS) perldelta.pod pod/perl5336delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` diff --git a/pod/.gitignore b/pod/.gitignore index def64fd7ee31..5ff5f607bca6 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -48,7 +48,7 @@ /roffitall # generated -/perl5335delta.pod +/perl5336delta.pod /perlapi.pod /perlintern.pod /perlmodlib.pod diff --git a/pod/perl.pod b/pod/perl.pod index eaccc2e51c75..90c1c8a5eb6f 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -183,6 +183,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhist Perl history records perldelta Perl changes since previous version + perl5335delta Perl changes in version 5.33.5 perl5334delta Perl changes in version 5.33.4 perl5333delta Perl changes in version 5.33.3 perl5332delta Perl changes in version 5.33.2 diff --git a/pod/perl5335delta.pod b/pod/perl5335delta.pod new file mode 100644 index 000000000000..b6b51f26eca6 --- /dev/null +++ b/pod/perl5335delta.pod @@ -0,0 +1,341 @@ +=encoding utf8 + +=head1 NAME + +perl5335delta - what is new for perl v5.33.5 + +=head1 DESCRIPTION + +This document describes differences between the 5.33.4 release and the 5.33.5 +release. + +If you are upgrading from an earlier release such as 5.33.3, first read +L, which describes differences between 5.33.3 and 5.33.4. + +=head1 Core Enhancements + +=head2 New octal syntax C<0oI> + +It is now possible to specify octal literals with C<0o> prefixes, +as in C<0o123_456>, parallel to the existing construct to specify +hexadecimal literal C<0xI> and binary literal C<0bI>. +Also, the builtin C function now accepts this new syntax. + +See L and L. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 1.50 to 1.51. + +=item * + +L has been upgraded from version 0.32 to 0.33. + +=item * + +L has been upgraded from version 1.48 to 1.49. + +=item * + +L has been upgraded from version 3.07 to 3.08. + +=item * + +L has been upgraded from version 2.18 to 2.20. + +=item * + +L has been upgraded from version 3.41 to 3.42. + +=item * + +L has been upgraded from version 2.34 to 2.35. + +=item * + +L has been upgraded from version 1.37 to 1.38. + +=item * + +L has been upgraded from version 3.79 to 3.80. + +=item * + +The libnet distribution has been upgraded from version 3.11 to 3.12. + +=item * + +L has been upgraded from version 5.20201120 to 5.20201220. + +=item * + +L has been upgraded from version 1.16 to 1.17. + +=item * + +L has been upgraded from version 1.48 to 1.49. + +=item * + +L has been upgraded from version 0.08 to 0.09. + +=item * + +L has been upgraded from version 1.95 to 1.96. + +=item * + +L has been upgraded from version 3.42 to 3.43. + +=item * + +L has been upgraded from version 2.03 to 2.04. + +=item * + +L has been upgraded from version 1.9765 to 1.9766. + +=item * + +L has been upgraded from version 1.48 to 1.49. + +=item * + +L has been upgraded from version 1.13 to 1.14. + +=back + +=head1 Documentation + +=head2 New Documentation + +=head3 L has been added to F. + +This document is a guide for the authorship and maintenance of the +documentation that ships with Perl. + +=head2 Changes to Existing Documentation + +We have attempted to update the documentation to reflect the changes +listed in this document. If you find any we have missed, open an issue +at L. + +Additionally, the following selected changes have been made: + +=head3 L + +=over 4 + +=item * + +L documented a length field included in the +packed C parameter to msgsnd(), but there was no such field. +C contains only the type and the message content. + +=back + +=head1 Testing + +Tests were added and changed to reflect the other additions and +changes in this release. Furthermore, these significant changes were +made: + +=over 4 + +=item * + +When testing in parallel on many-core platforms, you can now cause the +test suite to finish somewhat earlier, but with less logical ordering of +the tests, by setting + + PERL_TEST_HARNESS_ASAP=1 + +while running the test suite. + +=back + +=head2 Platform-Specific Notes + +=over 4 + +=item Windows + +Windows now supports L and +L, and L is no +longer an alias for L. +L<[#18005]|https://github.com/Perl/perl5/issues/18005>. + +Unlike POSIX systems, creating a symbolic link on Windows requires +either elevated privileges or Windows 10 1703 or later with Developer +Mode enabled. + +stat(), including C, and lstat() now uses our own +implementation that populates the device C and inode numbers +C returned rather than always returning zero. The number of +links C field is now always populated. + +L<< C<${^WIN32_SLOPPY_STAT}> |perlvar/${^WIN32_SLOPPY_STAT} >> previously +controlled whether the C field was populated requiring a +separate Windows API call to fetch, since nlink and the other +information required for stat() is now retrieved in a single API call. + +The C<-r> and C<-w> operators now return true for the C, +C and C handles. Unfortunately it still won't return +true for duplicates of those handles. +L<[#8502]|https://github.com/Perl/perl5/issues/8502>. + +The times returned by stat() and lstat() are no longer incorrect +across Daylight Savings Time adjustments. +L<[#6080]|https://github.com/Perl/perl5/issues/6080>. + +C<-x> on a filehandle should now match C<-x> on the corresponding +filename on Vista or later. +L<[#4145]|https://github.com/Perl/perl5/issues/4145>. + +C<-e '"'> no longer incorrectly returns true. +L<[#12431]|https://github.com/Perl/perl5/issues/12431>. + +=back + +=head1 Internal Changes + +=over 4 + +=item * + +All C-ish functions now evaluate their arguments exactly once. +In 5.32, plain L> was changed to do that; now the rest +do as well. + +=item * + +Unicode is now a first class citizen when considering the pattern /A*B/ where +A and B are arbitrary. The pattern matching code tries to make a tight loop +to match the span of A's. The logic of this was now really updated with +support for UTF-8. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +L, L, and +L now properly reset the UTF-8 flag on the +C parameter if it's modified for C or C +operations. + +=item * + +semctl(), msgctl(), and shmctl() now attempt to downgrade the C +parameter if it's value is being used as input to C or +C calls. A failed downgrade will thrown an exception. + +=item * + +In cases where semctl(), msgctl() or shmctl() would treat the C +parameter as a pointer, an undefined value no longer generates a +warning. In most such calls the pointer isn't used anyway and this +allows you to supply C for a value not used by the underlying +function. + +=item * + +L now downgrades the C parameter, +L now downgrades the C parameter and +L now downgrades the C parameter +to treat them as bytes. Previously they would be left upgraded, +providing a corrupted structure to the underlying function call. + +=item * + +L now properly resets the UTF-8 flag the +C parameter when it is modified. Previusly the UTF-8 flag could +be left on, resulting in a possibly corrupt result in C. + +=back + +=head1 Known Problems + +None + +=head1 Errata From Previous Releases + +None + +=head1 Acknowledgements + +Perl 5.33.5 represents approximately 4 weeks of development since Perl +5.33.4 and contains approximately 22,000 lines of changes across 370 files +from 27 authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 15,000 lines of changes to 220 .pm, .t, .c and .h files. + +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.5: + +Branislav Zahradník, Chris 'BinGOs' Williams, Dan Book, Dan Kogai, David +Cantrell, David Mitchell, Graham Knop, H.Merijn Brand, Jae Bradley, James E +Keenan, Jason McIntosh, jkahrman, John Karr, Karen Etheridge, Karl +Williamson, Leon Timmermans, Max Maischein, Paul Evans, Sawyer X, Sevan +Janiyan, Shlomi Fish, Steve Hay, TAKAI Kousuke, Thibault Duponchelle, Tomasz +Konojacki, Tom Hukins, Tony Cook. + +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. + +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the perl bug database +at L. There may also be information at +L, the Perl Home Page. + +If you believe you have an unreported bug, please open an issue at +L. Be sure to trim your bug down to a +tiny but sufficient test case. + +If the bug you are reporting has security implications which make it +inappropriate to send to a public issue tracker, then see +L +for details of how to report the issue. + +=head1 Give Thanks + +If you wish to thank the Perl 5 Porters for the work we had done in Perl 5, +you can do so by running the C program: + + perlthanks + +This will send an email to the Perl 5 Porters list with your show of thanks. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 482733026b0a..bc2614eb5615 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,123 +2,157 @@ =head1 NAME -perldelta - what is new for perl v5.33.5 +[ this is a template for a new perldelta file. Any text flagged as XXX needs +to be processed before release. ] + +perldelta - what is new for perl v5.33.6 =head1 DESCRIPTION -This document describes differences between the 5.33.4 release and the 5.33.5 +This document describes differences between the 5.33.5 release and the 5.33.6 release. -If you are upgrading from an earlier release such as 5.33.3, first read -L, which describes differences between 5.33.3 and 5.33.4. +If you are upgrading from an earlier release such as 5.33.4, first read +L, which describes differences between 5.33.4 and 5.33.5. -=head1 Core Enhancements +=head1 Notice -=head2 New octal syntax C<0oI> +XXX Any important notices here -It is now possible to specify octal literals with C<0o> prefixes, -as in C<0o123_456>, parallel to the existing construct to specify -hexadecimal literal C<0xI> and binary literal C<0bI>. -Also, the builtin C function now accepts this new syntax. +=head1 Core Enhancements -See L and L. +XXX New core language features go here. Summarize user-visible core language +enhancements. Particularly prominent performance optimisations could go +here, but most should go in the L section. -=head1 Modules and Pragmata +[ List each enhancement as a =head2 entry ] -=head2 Updated Modules and Pragmata +=head1 Security -=over 4 +XXX Any security-related notices go here. In particular, any security +vulnerabilities closed should be noted here rather than in the +L section. -=item * +[ List each security issue as a =head2 entry ] -L has been upgraded from version 1.50 to 1.51. +=head1 Incompatible Changes -=item * +XXX For a release on a stable branch, this section aspires to be: -L has been upgraded from version 0.32 to 0.33. + There are no changes intentionally incompatible with 5.XXX.XXX + If any exist, they are bugs, and we request that you submit a + report. See L below. -=item * +[ List each incompatible change as a =head2 entry ] -L has been upgraded from version 1.48 to 1.49. +=head1 Deprecations -=item * +XXX Any deprecated features, syntax, modules etc. should be listed here. -L has been upgraded from version 3.07 to 3.08. +=head2 Module removals -=item * +XXX Remove this section if not applicable. -L has been upgraded from version 2.18 to 2.20. +The following modules will be removed from the core distribution in a +future release, and will at that time need to be installed from CPAN. +Distributions on CPAN which require these modules will need to list them as +prerequisites. -=item * +The core versions of these modules will now issue C<"deprecated">-category +warnings to alert you to this fact. To silence these deprecation warnings, +install the modules in question from CPAN. -L has been upgraded from version 3.41 to 3.42. +Note that these are (with rare exceptions) fine modules that you are encouraged +to continue to use. Their disinclusion from core primarily hinges on their +necessity to bootstrapping a fully functional, CPAN-capable Perl installation, +not usually on concerns over their design. -=item * +=over -L has been upgraded from version 2.34 to 2.35. +=item XXX -=item * +XXX Note that deprecated modules should be listed here even if they are listed +as an updated module in the L section. -L has been upgraded from version 1.37 to 1.38. +=back -=item * +[ List each other deprecation as a =head2 entry ] -L has been upgraded from version 3.79 to 3.80. +=head1 Performance Enhancements -=item * +XXX Changes which enhance performance without changing behaviour go here. +There may well be none in a stable release. + +[ List each enhancement as an =item entry ] -The libnet distribution has been upgraded from version 3.11 to 3.12. +=over 4 =item * -L has been upgraded from version 5.20201120 to 5.20201220. +XXX -=item * +=back -L has been upgraded from version 1.16 to 1.17. +=head1 Modules and Pragmata -=item * +XXX All changes to installed files in F, F, F and F +go here. If Module::CoreList is updated, generate an initial draft of the +following sections using F. A paragraph summary +for important changes should then be added by hand. In an ideal world, +dual-life modules would have a F file that could be cribbed. -L has been upgraded from version 1.48 to 1.49. +The list of new and updated modules is modified automatically as part of +preparing a Perl release, so the only reason to manually add entries here is if +you're summarising the important changes in the module update. (Also, if the +manually-added details don't match the automatically-generated ones, the +release manager will have to investigate the situation carefully.) -=item * +[ Within each section, list entries as an =item entry ] -L has been upgraded from version 0.08 to 0.09. +=head2 New Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 1.95 to 1.96. +XXX Remove this section if not applicable. -=item * +=back -L has been upgraded from version 3.42 to 3.43. +=head2 Updated Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 2.03 to 2.04. +L has been upgraded from version A.xx to B.yy. -=item * +If there was something important to note about this change, include that here. -L has been upgraded from version 1.9765 to 1.9766. +=back -=item * +=head2 Removed Modules and Pragmata -L has been upgraded from version 1.48 to 1.49. +=over 4 =item * -L has been upgraded from version 1.13 to 1.14. +XXX =back =head1 Documentation +XXX Changes to files in F go here. Consider grouping entries by +file and be sure to link to the appropriate page, e.g. L. + =head2 New Documentation -=head3 L has been added to F. +XXX Changes which create B files in F go here. -This document is a guide for the authorship and maintenance of the -documentation that ships with Perl. +=head3 L + +XXX Description of the purpose of the new file here =head2 Changes to Existing Documentation @@ -126,182 +160,250 @@ We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. +XXX Changes which significantly change existing files in F go here. +However, any changes to F should go in the L +section. + Additionally, the following selected changes have been made: -=head3 L +=head3 L =over 4 =item * -L documented a length field included in the -packed C parameter to msgsnd(), but there was no such field. -C contains only the type and the message content. +XXX Description of the change here =back -=head1 Testing +=head1 Diagnostics -Tests were added and changed to reflect the other additions and -changes in this release. Furthermore, these significant changes were -made: +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. + +XXX New or changed warnings emitted by the core's C code go here. Also +include any changes in L that reconcile it to the C code. + +=head2 New Diagnostics + +XXX Newly added diagnostic messages go under here, separated into New Errors +and New Warnings + +=head3 New Errors =over 4 =item * -When testing in parallel on many-core platforms, you can now cause the -test suite to finish somewhat earlier, but with less logical ordering of -the tests, by setting +XXX L + +=back + +=head3 New Warnings + +=over 4 - PERL_TEST_HARNESS_ASAP=1 +=item * -while running the test suite. +XXX L =back -=head2 Platform-Specific Notes +=head2 Changes to Existing Diagnostics + +XXX Changes (i.e. rewording) of diagnostic messages go here =over 4 -=item Windows +=item * + +XXX Describe change here -Windows now supports L and -L, and L is no -longer an alias for L. -L<[#18005]|https://github.com/Perl/perl5/issues/18005>. +=back -Unlike POSIX systems, creating a symbolic link on Windows requires -either elevated privileges or Windows 10 1703 or later with Developer -Mode enabled. +=head1 Utility Changes -stat(), including C, and lstat() now uses our own -implementation that populates the device C and inode numbers -C returned rather than always returning zero. The number of -links C field is now always populated. +XXX Changes to installed programs such as F and F go here. +Most of these are built within the directory F. -L<< C<${^WIN32_SLOPPY_STAT}> |perlvar/${^WIN32_SLOPPY_STAT} >> previously -controlled whether the C field was populated requiring a -separate Windows API call to fetch, since nlink and the other -information required for stat() is now retrieved in a single API call. +[ List utility changes as a =head2 entry for each utility and =item +entries for each change +Use L with program names to get proper documentation linking. ] -The C<-r> and C<-w> operators now return true for the C, -C and C handles. Unfortunately it still won't return -true for duplicates of those handles. -L<[#8502]|https://github.com/Perl/perl5/issues/8502>. +=head2 L -The times returned by stat() and lstat() are no longer incorrect -across Daylight Savings Time adjustments. -L<[#6080]|https://github.com/Perl/perl5/issues/6080>. +=over 4 -C<-x> on a filehandle should now match C<-x> on the corresponding -filename on Vista or later. -L<[#4145]|https://github.com/Perl/perl5/issues/4145>. +=item * -C<-e '"'> no longer incorrectly returns true. -L<[#12431]|https://github.com/Perl/perl5/issues/12431>. +XXX =back -=head1 Internal Changes +=head1 Configuration and Compilation + +XXX Changes to F, F, F, and analogous tools +go here. Any other changes to the Perl build process should be listed here. +However, any platform-specific changes should be listed in the +L section, instead. + +[ List changes as an =item entry ]. =over 4 =item * -All C-ish functions now evaluate their arguments exactly once. -In 5.32, plain L> was changed to do that; now the rest -do as well. +XXX + +=back + +=head1 Testing + +XXX Any significant changes to the testing of a freshly built perl should be +listed here. Changes which create B files in F go here as do any +large changes to the testing harness (e.g. when parallel testing was added). +Changes to existing files in F aren't worth summarizing, although the bugs +that they represent may be covered elsewhere. + +XXX If there were no significant test changes, say this: + +Tests were added and changed to reflect the other additions and changes +in this release. + +XXX If instead there were significant changes, say this: + +Tests were added and changed to reflect the other additions and +changes in this release. Furthermore, these significant changes were +made: + +[ List each test improvement as an =item entry ] + +=over 4 =item * -Unicode is now a first class citizen when considering the pattern /A*B/ where -A and B are arbitrary. The pattern matching code tries to make a tight loop -to match the span of A's. The logic of this was now really updated with -support for UTF-8. +XXX =back -=head1 Selected Bug Fixes +=head1 Platform Support + +XXX Any changes to platform support should be listed in the sections below. + +[ Within the sections, list each platform as an =item entry with specific +changes as paragraphs below it. ] + +=head2 New Platforms + +XXX List any platforms that this version of perl compiles on, that previous +versions did not. These will either be enabled by new files in the F +directories, or new subdirectories and F files at the top level of the +source tree. =over 4 -=item * +=item XXX-some-platform -L, L, and -L now properly reset the UTF-8 flag on the -C parameter if it's modified for C or C -operations. +XXX -=item * +=back -semctl(), msgctl(), and shmctl() now attempt to downgrade the C -parameter if it's value is being used as input to C or -C calls. A failed downgrade will thrown an exception. +=head2 Discontinued Platforms -=item * +XXX List any platforms that this version of perl no longer compiles on. + +=over 4 -In cases where semctl(), msgctl() or shmctl() would treat the C -parameter as a pointer, an undefined value no longer generates a -warning. In most such calls the pointer isn't used anyway and this -allows you to supply C for a value not used by the underlying -function. +=item XXX-some-platform + +XXX + +=back + +=head2 Platform-Specific Notes + +XXX List any changes for specific platforms. This could include configuration +and compilation changes or changes in portability/compatibility. However, +changes within modules for platforms should generally be listed in the +L section. + +=over 4 + +=item XXX-some-platform + +XXX + +=back + +=head1 Internal Changes + +XXX Changes which affect the interface available to C code go here. Other +significant internal changes for future core maintainers should be noted as +well. + +[ List each change as an =item entry ] + +=over 4 =item * -L now downgrades the C parameter, -L now downgrades the C parameter and -L now downgrades the C parameter -to treat them as bytes. Previously they would be left upgraded, -providing a corrupted structure to the underlying function call. +XXX + +=back + +=head1 Selected Bug Fixes + +XXX Important bug fixes in the core language are summarized here. Bug fixes in +files in F and F are best summarized in L. + +[ List each fix as an =item entry ] + +=over 4 =item * -L now properly resets the UTF-8 flag the -C parameter when it is modified. Previusly the UTF-8 flag could -be left on, resulting in a possibly corrupt result in C. +XXX =back =head1 Known Problems -None +XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any +tests that had to be Ced for the release would be noted here. Unfixed +platform specific bugs also go here. + +[ List each fix as an =item entry ] + +=over 4 + +=item * + +XXX + +=back =head1 Errata From Previous Releases -None +=over 4 -=head1 Acknowledgements +=item * -Perl 5.33.5 represents approximately 4 weeks of development since Perl -5.33.4 and contains approximately 22,000 lines of changes across 370 files -from 27 authors. +XXX Add anything here that we forgot to add, or were mistaken about, in +the perldelta of a previous release. -Excluding auto-generated files, documentation and release tools, there were -approximately 15,000 lines of changes to 220 .pm, .t, .c and .h files. +=back -Perl continues to flourish into its fourth decade thanks to a vibrant -community of users and developers. The following people are known to have -contributed the improvements that became Perl 5.33.5: +=head1 Obituary -Branislav Zahradník, Chris 'BinGOs' Williams, Dan Book, Dan Kogai, David -Cantrell, David Mitchell, Graham Knop, H.Merijn Brand, Jae Bradley, James E -Keenan, Jason McIntosh, jkahrman, John Karr, Karen Etheridge, Karl -Williamson, Leon Timmermans, Max Maischein, Paul Evans, Sawyer X, Sevan -Janiyan, Shlomi Fish, Steve Hay, TAKAI Kousuke, Thibault Duponchelle, Tomasz -Konojacki, Tom Hukins, Tony Cook. +XXX If any significant core contributor or member of the CPAN community has +died, add a short obituary here. -The list above is almost certainly incomplete as it is automatically -generated from version control history. In particular, it does not include -the names of the (very much appreciated) contributors who reported issues to -the Perl bug tracker. +=head1 Acknowledgements -Many of the changes included in this version originated in the CPAN modules -included in Perl's core. We're grateful to the entire CPAN community for -helping Perl to flourish. +XXX Generate this with: -For a more complete list of all of Perl's historical contributors, please -see the F file in the Perl source distribution. + perl Porting/acknowledgements.pl v5.33.5..HEAD =head1 Reporting Bugs diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 0323f0603588..925d2c34ca76 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -313,7 +313,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5) extra.pods : miniperl @ @extra_pods.com -PERLDELTA_CURRENT = [.pod]perl5335delta.pod +PERLDELTA_CURRENT = [.pod]perl5336delta.pod $(PERLDELTA_CURRENT) : [.pod]perldelta.pod Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index cb8c5cbb6bba..17605bc9ca24 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1723,7 +1723,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1821,7 +1821,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/Makefile b/win32/Makefile index efd6d4bbf845..86129e3959c0 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1240,7 +1240,7 @@ utils: $(PERLEXE) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. @@ -1339,7 +1339,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/makefile.mk b/win32/makefile.mk index 1e3d5e0f120d..711894545818 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1641,7 +1641,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5335delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1739,7 +1739,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5335delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/pod.mak b/win32/pod.mak index 9261aff3cda0..f5ee35d83007 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -69,6 +69,7 @@ POD = perl.pod \ perl5333delta.pod \ perl5334delta.pod \ perl5335delta.pod \ + perl5336delta.pod \ perl561delta.pod \ perl56delta.pod \ perl581delta.pod \ @@ -235,6 +236,7 @@ MAN = perl.man \ perl5333delta.man \ perl5334delta.man \ perl5335delta.man \ + perl5336delta.man \ perl561delta.man \ perl56delta.man \ perl581delta.man \ @@ -401,6 +403,7 @@ HTML = perl.html \ perl5333delta.html \ perl5334delta.html \ perl5335delta.html \ + perl5336delta.html \ perl561delta.html \ perl56delta.html \ perl581delta.html \ @@ -567,6 +570,7 @@ TEX = perl.tex \ perl5333delta.tex \ perl5334delta.tex \ perl5335delta.tex \ + perl5336delta.tex \ perl561delta.tex \ perl56delta.tex \ perl581delta.tex \ From 374df6dff259e3036b330623c0e424656a7ca60a Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 15:32:28 +0100 Subject: [PATCH 269/503] Bump version to 5.33.6 --- Cross/config.sh-arm-linux | 40 ++++++++++++++++---------------- Cross/config.sh-arm-linux-n770 | 40 ++++++++++++++++---------------- INSTALL | 30 ++++++++++++------------ META.json | 2 +- META.yml | 2 +- NetWare/Makefile | 4 ++-- NetWare/config_H.wc | 10 ++++---- Porting/config.sh | 42 +++++++++++++++++----------------- Porting/config_H | 18 +++++++-------- Porting/perldelta_template.pod | 2 +- Porting/todo.pod | 4 ++-- README.haiku | 4 ++-- README.macosx | 8 +++---- README.os2 | 2 +- README.vms | 4 ++-- hints/catamount.sh | 4 ++-- lib/B/Op_private.pm | 2 +- patchlevel.h | 4 ++-- plan9/config_sh.sample | 38 +++++++++++++++--------------- win32/GNUmakefile | 2 +- win32/Makefile | 2 +- win32/makefile.mk | 2 +- 22 files changed, 133 insertions(+), 133 deletions(-) diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index 170da9b50ff6..0ea35b0ff6e8 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='5' +api_subversion='6' api_version='33' -api_versionstring='5.33.5' +api_versionstring='5.33.6' ar='ar' -archlib='/usr/lib/perl5/5.33.5/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.5/armv4l-linux' +archlib='/usr/lib/perl5/5.33.6/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.6/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -55,7 +55,7 @@ castflags='0' cat='cat' cc='cc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.5/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.6/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -825,7 +825,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.5/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.6/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -833,13 +833,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.5' +installprivlib='./install_me_here/usr/lib/perl5/5.33.6' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.5' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.6' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -973,8 +973,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.5' -privlibexp='/usr/lib/perl5/5.33.5' +privlib='/usr/lib/perl5/5.33.6' +privlibexp='/usr/lib/perl5/5.33.6' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1039,17 +1039,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.5' +sitelib='/usr/lib/perl5/site_perl/5.33.6' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.5' +sitelibexp='/usr/lib/perl5/site_perl/5.33.6' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1088,7 +1088,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='5' +subversion='6' sysman='/usr/share/man/man1' tail='' tar='' @@ -1179,8 +1179,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.5' -version_patchlevel_string='version 33 subversion 5' +version='5.33.6' +version_patchlevel_string='version 33 subversion 6' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1194,9 +1194,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=5 +PERL_SUBVERSION=6 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=5 +PERL_API_SUBVERSION=6 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index 668d690ae94f..ca3b2c19770e 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='5' +api_subversion='6' api_version='33' -api_versionstring='5.33.5' +api_versionstring='5.33.6' ar='ar' -archlib='/usr/lib/perl5/5.33.5/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.5/armv4l-linux' +archlib='/usr/lib/perl5/5.33.6/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.6/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -54,7 +54,7 @@ castflags='0' cat='cat' cc='arm-none-linux-gnueabi-gcc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.5/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.6/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -823,7 +823,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.5/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.6/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -831,13 +831,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.5' +installprivlib='./install_me_here/usr/lib/perl5/5.33.6' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.5' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.6' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -971,8 +971,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.5' -privlibexp='/usr/lib/perl5/5.33.5' +privlib='/usr/lib/perl5/5.33.6' +privlibexp='/usr/lib/perl5/5.33.6' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1037,17 +1037,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.5/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.5' +sitelib='/usr/lib/perl5/site_perl/5.33.6' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.5' +sitelibexp='/usr/lib/perl5/site_perl/5.33.6' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1086,7 +1086,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='5' +subversion='6' sysman='/usr/share/man/man1' tail='' tar='' @@ -1177,8 +1177,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.5' -version_patchlevel_string='version 33 subversion 5' +version='5.33.6' +version_patchlevel_string='version 33 subversion 6' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1192,9 +1192,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=5 +PERL_SUBVERSION=6 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=5 +PERL_API_SUBVERSION=6 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/INSTALL b/INSTALL index ce38af0b8a64..001178a2ba9b 100644 --- a/INSTALL +++ b/INSTALL @@ -615,7 +615,7 @@ The directories set up by Configure fall into three broad categories. =item Directories for the perl distribution -By default, Configure will use the following directories for 5.33.5. +By default, Configure will use the following directories for 5.33.6. $version is the full perl version number, including subversion, e.g. 5.12.3, and $archname is a string like sun4-sunos, determined by Configure. The full definitions of all Configure @@ -2438,7 +2438,7 @@ L =head1 Coexistence with earlier versions of perl 5 -Perl 5.33.5 is not binary compatible with earlier versions of Perl. +Perl 5.33.6 is not binary compatible with earlier versions of Perl. In other words, you will have to recompile your XS modules. In general, you can usually safely upgrade from one stable version of Perl @@ -2513,9 +2513,9 @@ won't interfere with another version. (The defaults guarantee this for libraries after 5.6.0, but not for executables. TODO?) One convenient way to do this is by using a separate prefix for each version, such as - sh Configure -Dprefix=/opt/perl5.33.5 + sh Configure -Dprefix=/opt/perl5.33.6 -and adding /opt/perl5.33.5/bin to the shell PATH variable. Such users +and adding /opt/perl5.33.6/bin to the shell PATH variable. Such users may also wish to add a symbolic link /usr/local/bin/perl so that scripts can still start with #!/usr/local/bin/perl. @@ -2528,13 +2528,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from 5.33.4 or earlier +=head2 Upgrading from 5.33.5 or earlier -B Perl modules having binary parts (meaning that a C compiler is used) will have to be recompiled to be -used with 5.33.5. If you find you do need to rebuild an extension with -5.33.5, you may safely do so without disturbing the older +used with 5.33.6. If you find you do need to rebuild an extension with +5.33.6, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2567,15 +2567,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.33.5 is as follows (under $Config{prefix}): +in Linux with perl-5.33.6 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.33.5/strict.pm - ./lib/perl5/5.33.5/warnings.pm - ./lib/perl5/5.33.5/i686-linux/File/Glob.pm - ./lib/perl5/5.33.5/feature.pm - ./lib/perl5/5.33.5/XSLoader.pm - ./lib/perl5/5.33.5/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.33.6/strict.pm + ./lib/perl5/5.33.6/warnings.pm + ./lib/perl5/5.33.6/i686-linux/File/Glob.pm + ./lib/perl5/5.33.6/feature.pm + ./lib/perl5/5.33.6/XSLoader.pm + ./lib/perl5/5.33.6/i686-linux/auto/File/Glob/Glob.so Secondly, for perl-5.10.1, the Debian perl-base package contains 591 files, (of which 510 are for lib/unicore) totaling about 3.5MB in its diff --git a/META.json b/META.json index 77d5811c9853..1aaa841d76ce 100644 --- a/META.json +++ b/META.json @@ -130,6 +130,6 @@ "url" : "https://github.com/Perl/perl5" } }, - "version" : "5.033005", + "version" : "5.033006", "x_serialization_backend" : "JSON::PP version 4.05" } diff --git a/META.yml b/META.yml index 09696b28eef0..74699ed94e03 100644 --- a/META.yml +++ b/META.yml @@ -117,5 +117,5 @@ resources: homepage: https://www.perl.org/ license: https://dev.perl.org/licenses/ repository: https://github.com/Perl/perl5 -version: '5.033005' +version: '5.033006' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/NetWare/Makefile b/NetWare/Makefile index c917ab7282fe..3eb56a641e15 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -86,7 +86,7 @@ NLM_VERSION = 3,20,0 # Here comes the CW tools - TO BE FILLED TO BUILD WITH CW - -MODULE_DESC = "Perl 5.33.5 for NetWare" +MODULE_DESC = "Perl 5.33.6 for NetWare" CCTYPE = CodeWarrior C_COMPILER = mwccnlm -c CPP_COMPILER = mwccnlm @@ -462,7 +462,7 @@ INST_NW_TOP2 = $(INST_NW_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.33.5 +INST_VER = \5.33.6 # # Comment this out if you DON'T want your perl installation to have diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index 19e6ce424081..045ae574f788 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -887,7 +887,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.33.5\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.33.6\\lib\\NetWare-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -918,8 +918,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.33.5\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.33.5\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.33.6\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.33.6\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -2878,7 +2878,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.33.5\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.33.6\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2901,7 +2901,7 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.33.5\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.33.6\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/Porting/config.sh b/Porting/config.sh index 392decb9ae60..4c1cf7b83161 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -46,12 +46,12 @@ afsroot='/afs' alignbytes='16' aphostname='' api_revision='5' -api_subversion='5' +api_subversion='6' api_version='33' -api_versionstring='5.33.5' +api_versionstring='5.33.6' ar='ar' -archlib='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' -archlibexp='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' +archlib='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' +archlibexp='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' archname64='' archname='x86_64-linux-thread-multi-ld' archobjs='' @@ -854,7 +854,7 @@ incpath='' incpth='/usr/lib64/gcc/x86_64-suse-linux/10/include /usr/local/include /usr/lib64/gcc/x86_64-suse-linux/10/include-fixed /usr/lib64/gcc/x86_64-suse-linux/10/../../../../x86_64-suse-linux/include /usr/include' inews='' initialinstalllocation='/opt/perl/bin' -installarchlib='/opt/perl/lib/5.33.5/x86_64-linux-thread-multi-ld' +installarchlib='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' installbin='/opt/perl/bin' installhtml1dir='' installhtml3dir='' @@ -862,13 +862,13 @@ installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.33.5' +installprivlib='/opt/perl/lib/5.33.6' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' +installsitearch='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' installsitebin='/opt/perl/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/opt/perl/lib/site_perl/5.33.5' +installsitelib='/opt/perl/lib/site_perl/5.33.6' installsiteman1dir='/opt/perl/man/man1' installsiteman3dir='/opt/perl/man/man3' installsitescript='/opt/perl/bin' @@ -993,7 +993,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='yourname@yourhost.yourplace.com' perllibs='-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc' -perlpath='/opt/perl/bin/perl5.33.5' +perlpath='/opt/perl/bin/perl5.33.6' pg='pg' phostname='' pidtype='pid_t' @@ -1002,8 +1002,8 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.33.5' -privlibexp='/opt/perl/lib/5.33.5' +privlib='/opt/perl/lib/5.33.6' +privlibexp='/opt/perl/lib/5.33.6' procselfexe='"/proc/self/exe"' ptrsize='8' quadkind='2' @@ -1068,17 +1068,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 6, 17, 29, 0' sig_size='68' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' -sitearchexp='/opt/perl/lib/site_perl/5.33.5/x86_64-linux-thread-multi-ld' +sitearch='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' +sitearchexp='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/opt/perl/lib/site_perl/5.33.5' +sitelib='/opt/perl/lib/site_perl/5.33.6' sitelib_stem='/opt/perl/lib/site_perl' -sitelibexp='/opt/perl/lib/site_perl/5.33.5' +sitelibexp='/opt/perl/lib/site_perl/5.33.6' siteman1dir='/opt/perl/man/man1' siteman1direxp='/opt/perl/man/man1' siteman3dir='/opt/perl/man/man3' @@ -1104,7 +1104,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/opt/perl/bin/perl5.33.5' +startperl='#!/opt/perl/bin/perl5.33.6' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1116,7 +1116,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='' strerror_r_proto='REENTRANT_PROTO_B_IBW' submit='' -subversion='5' +subversion='6' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1215,8 +1215,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.5' -version_patchlevel_string='version 33 subversion 5' +version='5.33.6' +version_patchlevel_string='version 33 subversion 6' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1226,10 +1226,10 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=5 +PERL_SUBVERSION=6 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=5 +PERL_API_SUBVERSION=6 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true : Variables propagated from previous config.sh file. diff --git a/Porting/config_H b/Porting/config_H index 096611f6a6c7..3809fd2bf8cf 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -1239,8 +1239,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.33.5/x86_64-linux" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.33.5/x86_64-linux" /**/ +#define ARCHLIB "/opt/perl/lib/5.33.6/x86_64-linux" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.33.6/x86_64-linux" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -1293,8 +1293,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.33.5" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.33.5" /**/ +#define PRIVLIB "/opt/perl/lib/5.33.6" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.33.6" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1311,8 +1311,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.33.5/x86_64-linux" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.5/x86_64-linux" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.33.6/x86_64-linux" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.6/x86_64-linux" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1334,8 +1334,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/opt/perl/lib/site_perl/5.33.5" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.5" /**/ +#define SITELIB "/opt/perl/lib/site_perl/5.33.6" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.6" /**/ #define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ /* PERL_VENDORARCH: @@ -4109,7 +4109,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/opt/perl/bin/perl5.33.5" /**/ +#define STARTPERL "#!/opt/perl/bin/perl5.33.6" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index a7b78d466a6b..873655fe2e7e 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -403,7 +403,7 @@ died, add a short obituary here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.33.5..HEAD + perl Porting/acknowledgements.pl v5.33.6..HEAD =head1 Reporting Bugs diff --git a/Porting/todo.pod b/Porting/todo.pod index 72b5f0db2a5f..33b2aa09cea7 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -486,7 +486,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall. On these systems, it might be the default compilation mode, and there is currently no guarantee that passing no use64bitall option to the Configure process will build a 32bit perl. Implementing -Duse32bit* -options would be nice for perl 5.33.5. +options would be nice for perl 5.33.6. =head2 Profile Perl - am I hot or not? @@ -1189,7 +1189,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.33.5" +of 5.33.6" =head2 make ithreads more robust diff --git a/README.haiku b/README.haiku index 415a4fdeeaf1..44c55d0b3241 100644 --- a/README.haiku +++ b/README.haiku @@ -22,9 +22,9 @@ The build procedure is completely standard: Make perl executable and create a symlink for libperl: chmod a+x /boot/common/bin/perl - cd /boot/common/lib; ln -s perl5/5.33.5/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.33.6/BePC-haiku/CORE/libperl.so . -Replace C<5.33.5> with your respective version of Perl. +Replace C<5.33.6> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index e57bb1bf7557..d583fe66037d 100644 --- a/README.macosx +++ b/README.macosx @@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X This document briefly describes Perl under Mac OS X. - curl -O https://www.cpan.org/src/perl-5.33.5.tar.gz - tar -xzf perl-5.33.5.tar.gz - cd perl-5.33.5 + curl -O https://www.cpan.org/src/perl-5.33.6.tar.gz + tar -xzf perl-5.33.6.tar.gz + cd perl-5.33.6 ./Configure -des -Dprefix=/usr/local/ make make test @@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X. =head1 DESCRIPTION -The latest Perl release (5.33.5 as of this writing) builds without changes +The latest Perl release (5.33.6 as of this writing) builds without changes under all versions of Mac OS X from 10.3 "Panther" onwards. In order to build your own version of Perl you will need 'make', diff --git a/README.os2 b/README.os2 index 3bcd3a162a7e..85b15f9fdd13 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.5/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.6/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C), you diff --git a/README.vms b/README.vms index 79191c274ed6..372c74bd328a 100644 --- a/README.vms +++ b/README.vms @@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of choice. Once you have done so, use a command like the following to unpack the archive: - vmstar -xvf perl-5^.33^.5.tar + vmstar -xvf perl-5^.33^.6.tar Then set default to the top-level source directory like so: - set default [.perl-5^.33^.5] + set default [.perl-5^.33^.6] and proceed with configuration as described in the next section. diff --git a/hints/catamount.sh b/hints/catamount.sh index 16b901a9c9de..dc3e340ad64a 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # mkdir -p /opt/perl-catamount # mkdir -p /opt/perl-catamount/include # mkdir -p /opt/perl-catamount/lib -# mkdir -p /opt/perl-catamount/lib/perl5/5.33.5 +# mkdir -p /opt/perl-catamount/lib/perl5/5.33.6 # mkdir -p /opt/perl-catamount/bin # cp *.h /opt/perl-catamount/include # cp libperl.a /opt/perl-catamount/lib -# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.5 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.6 # cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib # # With the headers and the libperl.a you can embed Perl to your Catamount diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 2961bd97e94f..716aec88d6fe 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.033005"; +our $VERSION = "5.033006"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); diff --git a/patchlevel.h b/patchlevel.h index b2c04427be75..77bc59cfcb08 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -39,7 +39,7 @@ Instead use one of the version comparison macros. See C>. #define PERL_REVISION 5 /* age */ #define PERL_VERSION 33 /* epoch */ -#define PERL_SUBVERSION 5 /* generation */ +#define PERL_SUBVERSION 6 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -60,7 +60,7 @@ Instead use one of the version comparison macros. See C>. */ #define PERL_API_REVISION 5 #define PERL_API_VERSION 33 -#define PERL_API_SUBVERSION 5 +#define PERL_API_SUBVERSION 6 /* XXX Note: The selection of non-default Configure options, such as -Duselonglong may invalidate these settings. Currently, Configure diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index 691f90791754..a639d0f85d5a 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/uname -n' api_revision='5' -api_subversion='5' +api_subversion='6' api_version='33' -api_versionstring='5.33.5' +api_versionstring='5.33.6' ar='ar' -archlib='/sys/lib/perl5/5.33.5/386' -archlibexp='/sys/lib/perl5/5.33.5/386' +archlib='/sys/lib/perl5/5.33.6/386' +archlibexp='/sys/lib/perl5/5.33.6/386' archname64='' archname='386' archobjs='' @@ -819,17 +819,17 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/sys/lib/perl/5.33.5/386' +installarchlib='/sys/lib/perl/5.33.6/386' installbin='/usr/bin' installman1dir='/sys/man/1pub' installman3dir='/sys/man/2pub' installprefix='/usr' installprefixexp='/usr' -installprivlib='/sys/lib/perl/5.33.5' +installprivlib='/sys/lib/perl/5.33.6' installscript='/usr/bin' -installsitearch='/sys/lib/perl/5.33.5/site_perl/386' +installsitearch='/sys/lib/perl/5.33.6/site_perl/386' installsitebin='/usr/bin' -installsitelib='/sys/lib/perl/5.33.5/site_perl' +installsitelib='/sys/lib/perl/5.33.6/site_perl' installstyle='lib/perl5' installusrbinperl='undef' installvendorarch='' @@ -954,8 +954,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/sys/lib/perl/5.33.5' -privlibexp='/sys/lib/perl/5.33.5' +privlib='/sys/lib/perl/5.33.6' +privlibexp='/sys/lib/perl/5.33.6' procselfexe='' prototype='define' ptrsize='4' @@ -1020,13 +1020,13 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0' sig_size='50' signal_t='void' -sitearch='/sys/lib/perl/5.33.5/site_perl/386' +sitearch='/sys/lib/perl/5.33.6/site_perl/386' sitearchexp='/sys/lib/perl/site_perl/386' sitebin='/usr/bin' sitebinexp='/usr/bin' -sitelib='/sys/lib/perl/5.33.5/site_perl' -sitelib_stem='/sys/lib/perl/5.33.5/site_perl' -sitelibexp='/sys/lib/perl/5.33.5/site_perl' +sitelib='/sys/lib/perl/5.33.6/site_perl' +sitelib_stem='/sys/lib/perl/5.33.6/site_perl' +sitelibexp='/sys/lib/perl/5.33.6/site_perl' siteprefix='/usr' siteprefixexp='/usr' sizesize='4' @@ -1059,7 +1059,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='5' +subversion='6' sysman='/sys/man/1pub' tail='' tar='' @@ -1140,8 +1140,8 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.33.5' -version_patchlevel_string='version 33 subversion 5' +version='5.33.6' +version_patchlevel_string='version 33 subversion 6' versiononly='undef' vi='' xlibpth='' @@ -1155,9 +1155,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=5 +PERL_SUBVERSION=6 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=5 +PERL_API_SUBVERSION=6 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 17605bc9ca24..2aa79e5a0d29 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -64,7 +64,7 @@ INST_TOP := $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER := \5.33.5 +#INST_VER := \5.33.6 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/Makefile b/win32/Makefile index 86129e3959c0..4986f0b230c7 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -38,7 +38,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER = \5.33.5 +#INST_VER = \5.33.6 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/makefile.mk b/win32/makefile.mk index 711894545818..fc47aa11c38f 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -45,7 +45,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER *= \5.33.5 +#INST_VER *= \5.33.6 # # Comment this out if you DON'T want your perl installation to have From 1e6ddea0fe7a351ec1130ce2f72d08cd861c92b0 Mon Sep 17 00:00:00 2001 From: Max Maischein Date: Sun, 20 Dec 2020 15:44:10 +0100 Subject: [PATCH 270/503] Prepare Module::CoreList for 5.33.6 --- dist/Module-CoreList/Changes | 3 +++ dist/Module-CoreList/lib/Module/CoreList.pm | 21 ++++++++++++++++++- .../lib/Module/CoreList/Utils.pm | 9 +++++++- 3 files changed, 31 insertions(+), 2 deletions(-) diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index 768e99e7a474..27f989929f75 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.20210120 + - Updated for v5.33.6 + 5.20201220 - Updated for v5.33.5 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index a938a03e3d6a..f8f491975ee0 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use strict; our ( %released, %version, %families, %upstream, %bug_tracker, %deprecated, %delta ); use version; -our $VERSION = '5.20201220'; +our $VERSION = '5.20210120'; sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# } sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } } @@ -372,6 +372,7 @@ sub changes_between { 5.033003 => '2020-10-20', 5.033004 => '2020-11-20', 5.033005 => '2020-12-20', + 5.033006 => '2021-01-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -18195,6 +18196,17 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.033006 => { + delta_from => 5.033005, + changed => { + 'B::Op_private' => '5.033006', + 'Config' => '5.033006', + 'Module::CoreList' => '5.20210120', + 'Module::CoreList::Utils'=> '5.20210120', + }, + removed => { + } + } ); sub is_core @@ -19358,6 +19370,13 @@ sub is_core removed => { } }, + 5.033006 => { + delta_from => 5.033005, + changed => { + }, + removed => { + } + }, ); %deprecated = _undelta(\%deprecated); diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 036fe87823a6..8c8752b1f44a 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Module::CoreList; -our $VERSION = '5.20201220'; +our $VERSION = '5.20210120'; our %utilities; sub utilities { @@ -1664,6 +1664,13 @@ my %delta = ( removed => { } }, + 5.033006 => { + delta_from => 5.033005, + changed => { + }, + removed => { + } + }, ); %utilities = Module::CoreList::_undelta(\%delta); From f6bdfd6173cf3b1a517d2e859c53f83250988e48 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 06:28:38 -0700 Subject: [PATCH 271/503] regexec.c: Link to github issue in comment --- regexec.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/regexec.c b/regexec.c index 597b49283fc6..74f95e73d02c 100644 --- a/regexec.c +++ b/regexec.c @@ -4515,6 +4515,9 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, * string can match, it returns FALSE; otherwise TRUE. (The FALSE * situation occurs if the first character in requires UTF-8 to * represent, and the target string isn't in UTF-8.) + * + * Some analysis is in GH #18414, located at the time of this writing at: + * https://github.com/Perl/perl5/issues/18414 */ const bool utf8_target = reginfo->is_utf8_target; From 62e9eaa93fa2015420d8cdcaf7c1e83d1c846e57 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 13 Dec 2020 19:07:54 -0700 Subject: [PATCH 272/503] perlfunc: Improve localtime entry This rearranges some paragraphs that really belong together, and clarifies the result is always in English --- pod/perlfunc.pod | 43 ++++++++++++++++++++++--------------------- 1 file changed, 22 insertions(+), 21 deletions(-) diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod index de24eef27465..927d3740bfea 100644 --- a/pod/perlfunc.pod +++ b/pod/perlfunc.pod @@ -3419,7 +3419,7 @@ X X X =for Pod::Functions convert UNIX time into record or string using Greenwich time -Works just like L|/localtime EXPR> but the returned values +Works just like L|/localtime EXPR>, but the returned values are localized for the standard Greenwich time zone. Note: When called in list context, $isdst, the last value @@ -4055,8 +4055,8 @@ C<$wday> is the day of the week, with 0 indicating Sunday and 3 indicating Wednesday. C<$yday> is the day of the year, in the range C<0..364> (or C<0..365> in leap years.) -C<$isdst> is true if the specified time occurs during Daylight Saving -Time, false otherwise. +C<$isdst> is true if the specified time occurs when Daylight Saving +Time is in effect, false otherwise. If EXPR is omitted, L|/localtime EXPR> uses the current time (as returned by L|/time>). @@ -4064,27 +4064,21 @@ time (as returned by L|/time>). In scalar context, L|/localtime EXPR> returns the L value: - my $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" + my $now_string = localtime; # e.g., "Thu Oct 13 04:54:34 1994" -The format of this scalar value is B locale-dependent but built -into Perl. For GMT instead of local time use the -L|/gmtime EXPR> builtin. See also the -L|Time::Local> module (for converting seconds, minutes, -hours, and such back to the integer value returned by L|/time>), -and the L module's L|POSIX/C> and -L|POSIX/C> functions. +This scalar value is always in English, and is B locale-dependent. +To get similar but locale-dependent date strings, try for example: -To get somewhat similar but locale-dependent date strings, set up your -locale environment variables appropriately (please see L) and -try for example: + use POSIX qw(strftime); + my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime; + # or for GMT formatted appropriately for your locale: + my $now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime; - use POSIX qw(strftime); - my $now_string = strftime "%a %b %e %H:%M:%S %Y", localtime; - # or for GMT formatted appropriately for your locale: - my $now_string = strftime "%a %b %e %H:%M:%S %Y", gmtime; - -Note that C<%a> and C<%b>, the short forms of the day of the week -and the month of the year, may not necessarily be three characters wide. +C$now_string> will be formatted according to the current LC_TIME locale +the program or thread is running in. See L for how to set +up and change that locale. Note that C<%a> and C<%b>, the short forms +of the day of the week and the month of the year, may not necessarily be +three characters wide. The L and L modules provide a convenient, by-name access mechanism to the L|/gmtime EXPR> and @@ -4093,6 +4087,13 @@ L|/localtime EXPR> functions, respectively. For a comprehensive date and time representation look at the L module on CPAN. +For GMT instead of local time use the L|/gmtime EXPR> builtin. + +See also the L|Time::Local> module (for converting +seconds, minutes, hours, and such back to the integer value returned by +L|/time>), and the L module's +L|POSIX/C> function. + Portability issues: L. =item lock THING From ff22dd7054d2f46d7451cabb1722dcaa04f8a3d6 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 14 Dec 2020 08:51:45 -0700 Subject: [PATCH 273/503] POSIX::asctime pod: Note it always returns English And give locale's alternative --- ext/POSIX/lib/POSIX.pod | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod index e756a51963f7..a92a20c6d725 100644 --- a/ext/POSIX/lib/POSIX.pod +++ b/ext/POSIX/lib/POSIX.pod @@ -139,6 +139,10 @@ The C<$mon> is zero-based: January equals C<0>. The C<$year> is 1900-based: 2001 equals C<101>. C<$wday> and C<$yday> default to zero (and are usually ignored anyway), and C<$isdst> defaults to -1. +Note the result is always in English. Use C> instead to +get a result suitable for the current locale. That function's C<%c> +format yields the locale's preferred representation. + =item C This is identical to the C function C, returning From 1e0eb5c5bc2ce4bc5ed0f5c3c8b4bdf610ebd502 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 13 Dec 2020 19:41:24 -0700 Subject: [PATCH 274/503] perlapi: Document and consolidate SvPV functions --- sv.h | 127 ++++++++++++++++++++++++++++++++++++++++------------------- 1 file changed, 87 insertions(+), 40 deletions(-) diff --git a/sv.h b/sv.h index 246f6121fb7b..58e86ae7bf39 100644 --- a/sv.h +++ b/sv.h @@ -1596,35 +1596,93 @@ C is like C, but guarantees to evaluate C only once; use the more efficient C otherwise. =for apidoc Am|char*|SvPV|SV* sv|STRLEN len -Returns a pointer to the string in the SV, or a stringified form of -the SV if the SV does not contain a string. The SV may cache the -stringified version becoming C. Handles 'get' magic. The -C variable will be set to the length of the string (this is a macro, so -don't use C<&len>). See also C> for a version which guarantees to -evaluate C only once. - -Note that there is no guarantee that the return value of C is -equal to C, or that C contains valid data, or that -successive calls to C will return the same pointer value each -time. This is due to the way that things like overloading and -Copy-On-Write are handled. In these cases, the return value may point to -a temporary buffer or similar. If you absolutely need the C field to -be valid (for example, if you intend to write to it), then see -C>. - -=for apidoc Am|char*|SvPVx|SV* sv|STRLEN len -A version of C which guarantees to evaluate C only once. -Only use this if C is an expression with side effects, otherwise use the -more efficient C. - -=for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len -Like C but doesn't process magic. - -=for apidoc Am|char*|SvPV_nolen|SV* sv -Like C but doesn't set a length variable. - -=for apidoc Am|char*|SvPV_nomg_nolen|SV* sv -Like C but doesn't process magic. +=for apidoc_item |char*|SvPVx|SV* sv|STRLEN len +=for apidoc_item |char*|SvPV_nomg|SV* sv|STRLEN len +=for apidoc_item |char*|SvPV_nolen|SV* sv +=for apidoc_item |char*|SvPVx_nolen|SV* sv +=for apidoc_item |char*|SvPV_nomg_nolen|SV* sv +=for apidoc_item |char*|SvPV_mutable|SV* sv|STRLEN len +=for apidoc_item |const char*|SvPV_const|SV* sv|STRLEN len +=for apidoc_item |const char*|SvPVx_const|SV* sv|STRLEN len +=for apidoc_item |const char*|SvPV_nolen_const|SV* sv +=for apidoc_item |const char*|SvPVx_nolen_const|SV* sv +=for apidoc_item |const char*|SvPV_nomg_const|SV* sv|STRLEN len +=for apidoc_item |const char*|SvPV_nomg_const_nolen|SV* sv +=for apidoc_item |char *|SvPV_flags|SV * sv|STRLEN len|U32 flags +=for apidoc_item |const char *|SvPV_flags_const|SV * sv|STRLEN len|U32 flags +=for apidoc_item |char *|SvPV_flags_mutable|SV * sv|STRLEN len|U32 flags +=for apidoc_item |char*|SvPVbyte|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVbyte_nomg|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVbyte_nolen|SV* sv +=for apidoc_item |char*|SvPVbytex_nolen|SV* sv +=for apidoc_item |char*|SvPVbytex|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVbyte_or_null|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVbyte_or_null_nomg|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVutf8|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVutf8x|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVutf8_nomg|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVutf8_nolen|SV* sv +=for apidoc_item |char*|SvPVutf8_or_null|SV* sv|STRLEN len +=for apidoc_item |char*|SvPVutf8_or_null_nomg|SV* sv|STRLEN len + +All these return a pointer to the string in C, or a stringified form of +C if it does not contain a string. The SV may cache the stringified +version becoming C. + +This is a very basic and common operation, so there are lots of slightly +different versions of it. + +Note that there is no guarantee that the return value of C, for +example, is equal to C, or that C contains valid data, or +that successive calls to C (or another of these forms) will return +the same pointer value each time. This is due to the way that things like +overloading and Copy-On-Write are handled. In these cases, the return value +may point to a temporary buffer or similar. If you absolutely need the +C field to be valid (for example, if you intend to write to it), then +see C>. + +The differences between the forms are: + +The forms with C in their names allow you to use the C parameter +to specify to process 'get' magic (by setting the C flag) or to skip +'get' magic (by clearing it). The other forms process 'get' magic, except for +the ones with C in their names, which skip 'get' magic. + +The forms that take a C parameter will set that variable to the byte +length of the resultant string (these are macros, so don't use C<&len>). + +The forms with C in their names indicate they don't have a C +parameter. They should be used only when it is known that the PV is a C +string, terminated by a NUL byte, and without intermediate NUL characters; or +when you don't care about its length. + +The forms with C in their names return S> so that the +compiler will hopefully complain if you were to try to modify the contents of +the string (unless you cast away const yourself). + +The other forms return a mutable pointer so that the string is modifiable by +the caller; this is emphasized for the ones with C in their names. + +The forms whose name ends in C are the same as the corresponding form +without the C, but the C form is guaranteed to evaluate C exactly +once, with a slight loss of efficiency. Use this if C is an expression +with side effects. + +C is like C, but converts C to UTF-8 first if not already +UTF-8. Similiarly, the other forms with C in their names correspond to +their respective forms without. + +C and C don't have corresponding +non-C forms. Instead they are like C, but when C is +undef, they return C. + +C is like C, but converts C to byte representation first if +currently encoded as UTF-8. If C cannot be downgraded from UTF-8, it +croaks. Similiarly, the other forms with C in their names correspond to +their respective forms without. + +C doesn't have a corresponding non-C form. Instead it +is like C, but when C is undef, it returns C. =for apidoc Am|IV|SvIV|SV* sv =for apidoc_item SvIVx @@ -1735,17 +1793,6 @@ Like C, but does not process get magic. Like C, but converts C to byte representation first if necessary. If the SV cannot be downgraded from UTF-8, this croaks. - -=for apidoc Am|char*|SvPVutf8x|SV* sv|STRLEN len -Like C, but converts C to UTF-8 first if necessary. -Guarantees to evaluate C only once; use the more efficient C -otherwise. - -=for apidoc Am|char*|SvPVbytex|SV* sv|STRLEN len -Like C, but converts C to byte representation first if necessary. -Guarantees to evaluate C only once; use the more efficient C -otherwise. If the SV cannot be downgraded from UTF-8, this croaks. - =for apidoc Am|U32|SvIsCOW|SV* sv Returns a U32 value indicating whether the SV is Copy-On-Write (either shared hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for From e39fb0f3e5add24b2f9b432f90e130e29d2b1c8f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:19:41 -0600 Subject: [PATCH 275/503] embed.fnc: Mark cx_dup as Core only Similar cx functions are supposed to be called with a macro for their functionality, but no such macro exists for this, and there are no uses on CPAN --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index c66a2801b85e..9717cbfca643 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2744,7 +2744,7 @@ p |CV* |newSTUB |NN GV *gv|bool fake : Used in perly.y p |OP * |my_attrs |NN OP *o|NULLOK OP *attrs #if defined(USE_ITHREADS) -ApR |PERL_CONTEXT*|cx_dup |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param +CpR |PERL_CONTEXT*|cx_dup |NULLOK PERL_CONTEXT* cx|I32 ix|I32 max|NN CLONE_PARAMS* param ApR |PERL_SI*|si_dup |NULLOK PERL_SI* si|NN CLONE_PARAMS* param ApR |ANY* |ss_dup |NN PerlInterpreter* proto_perl|NN CLONE_PARAMS* param ApR |void* |any_dup |NULLOK void* v|NN const PerlInterpreter* proto_perl From eb0353e2530a3b0f6e4e636509e31138727fdd52 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:29:01 -0600 Subject: [PATCH 276/503] embed.fnc: Mark regnext as Core only This is used internally by the regex engine; there is one use in cpan, an internals module, Devel::RegExp by Ilya Zakharevich, with nothing dependent on it, and last updated in 1995. --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 9717cbfca643..e608df16c52a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1961,7 +1961,7 @@ Cp |I32 |regexec_flags |NN REGEXP *const rx|NN char *stringarg \ |NN char *strend|NN char *strbeg \ |SSize_t minend|NN SV *sv \ |NULLOK void *data|U32 flags -ApR |regnode*|regnext |NULLOK regnode* p +CpR |regnode*|regnext |NULLOK regnode* p EXp |SV*|reg_named_buff |NN REGEXP * const rx|NULLOK SV * const key \ |NULLOK SV * const value|const U32 flags EXp |SV*|reg_named_buff_iter |NN REGEXP * const rx|NULLOK const SV * const lastkey \ From dcb0f7c312e02aa1c22eedb5fd02a62922a9083b Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:38:37 -0600 Subject: [PATCH 277/503] embed.fnc: Mark runops_debug, runops_standard as Core only These are internal functions to run the program; there are no cpan uses --- embed.fnc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/embed.fnc b/embed.fnc index e608df16c52a..425ff7a0aaaa 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2653,8 +2653,8 @@ ATpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size ATpR |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes ATp |Free_t |safesysfree |Malloc_t where CrTp |void |croak_memory_wrap -Ap |int |runops_standard -Ap |int |runops_debug +Cp |int |runops_standard +Cp |int |runops_debug Afpd |void |sv_catpvf_mg |NN SV *const sv|NN const char *const pat|... Apd |void |sv_vcatpvf_mg |NN SV *const sv|NN const char *const pat \ |NULLOK va_list *const args From 90df162eb2d430fdcd7cee9d6269ed70c4224c90 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:46:35 -0600 Subject: [PATCH 278/503] embed.fnc: Mark moreswitches as Core only This is an internal function used to parse command line options; there are no cpan uses. --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 425ff7a0aaaa..967def726a65 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1392,7 +1392,7 @@ S |void |move_proto_attr|NN OP **proto|NN OP **attrs \ #endif : Used in op.c and pp_sys.c p |int |mode_from_discipline|NULLOK const char* s|STRLEN len -Ap |const char* |moreswitches |NN const char* s +Cp |const char* |moreswitches |NN const char* s Apd |NV |my_atof |NN const char *s ATdpR |NV |my_strtod |NN const char * const s|NULLOK char ** e Aprd |void |my_exit |U32 status From 1fc4b13275c3552852886d217b36d72d8c9e8123 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 05:48:53 -0600 Subject: [PATCH 279/503] embed.fnc: Mark cxinc as Core only The macro CXINC is what one is supposed to use for this functionality. (though it is currently undocumented) --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 967def726a65..819fe928d1c8 100644 --- a/embed.fnc +++ b/embed.fnc @@ -745,7 +745,7 @@ pPR |const char* |get_no_modify pPR |U32* |get_opargs ApPR |PPADDR_t*|get_ppaddr : Used by CXINC, which appears to be in widespread use -ApR |I32 |cxinc +CpR |I32 |cxinc Afp |void |deb |NN const char* pat|... Ap |void |vdeb |NN const char* pat|NULLOK va_list* args Ap |void |debprofdump From 1065fe43314e39d95a847f7abda27bb7fc9d9cc2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:02:56 -0600 Subject: [PATCH 280/503] embed.fnc: Mark doing_taint as Core only This appears to be for internal use, and there are no cpan usages --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 819fe928d1c8..0476d1fd6441 100644 --- a/embed.fnc +++ b/embed.fnc @@ -574,7 +574,7 @@ ATod |void |perl_free |NN PerlInterpreter *my_perl ATod |int |perl_run |NN PerlInterpreter *my_perl ATod |int |perl_parse |NN PerlInterpreter *my_perl|XSINIT_t xsinit \ |int argc|NULLOK char** argv|NULLOK char** env -ATpR |bool |doing_taint |int argc|NULLOK char** argv|NULLOK char** env +CTpR |bool |doing_taint |int argc|NULLOK char** argv|NULLOK char** env #if defined(USE_ITHREADS) ATod |PerlInterpreter*|perl_clone|NN PerlInterpreter *proto_perl|UV flags # if defined(PERL_IMPLICIT_SYS) From f6ecfb3ada10f4def8a8707283cbd47b7fbc4c73 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:07:30 -0600 Subject: [PATCH 281/503] embed.fnc: Mark av_arylen_p, av_iter_p as Core only These appear to be internal functions, and there is no cpan usage The macro GIMME_V is what one is supposed to use for this functionality. --- embed.fnc | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/embed.fnc b/embed.fnc index 0476d1fd6441..22fe0816562a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -647,8 +647,8 @@ AmdR |SSize_t|av_tindex |NN AV *av Apd |void |av_undef |NN AV *av Apdoex |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val Apd |void |av_unshift |NN AV *av|SSize_t num -Apo |SV** |av_arylen_p |NN AV *av -Apo |IV* |av_iter_p |NN AV *av +Cpo |SV** |av_arylen_p |NN AV *av +Cpo |IV* |av_iter_p |NN AV *av #if defined(PERL_IN_AV_C) S |MAGIC* |get_aux_mg |NN AV *av #endif From f0a7783c659d8808123597cbe1323c36de213ba0 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:16:28 -0600 Subject: [PATCH 282/503] embed.fnc: Mark cx_dump as Core only This appears to be for internal debugging; there is no cpan usage --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 22fe0816562a..3fd59fcf5125 100644 --- a/embed.fnc +++ b/embed.fnc @@ -731,7 +731,7 @@ Apd |SV * |cv_name |NN CV *cv|NULLOK SV *sv|U32 flags Apd |void |cv_undef |NN CV* cv p |void |cv_undef_flags |NN CV* cv|U32 flags pd |void |cv_forget_slab |NULLOK CV *cv -Ap |void |cx_dump |NN PERL_CONTEXT* cx +Cp |void |cx_dump |NN PERL_CONTEXT* cx AiMpd |GV * |CvGV |NN CV *sv AiMTp |I32 * |CvDEPTH |NN const CV * const sv Aphd |SV* |filter_add |NULLOK filter_t funcp|NULLOK SV* datasv From f9e2355490f8b3197256a0c520009f2820d370d7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:19:36 -0600 Subject: [PATCH 283/503] embed.fnc: Mark scan_num as Core only This is used by the toker to scan a number; there is no cpan usage --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 3fd59fcf5125..ee448c0e06e5 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1729,7 +1729,7 @@ S |OP* |scalarseq |NULLOK OP* o p |OP* |scalarvoid |NN OP* o Apd |NV |scan_bin |NN const char* start|STRLEN len|NN STRLEN* retlen Apd |NV |scan_hex |NN const char* start|STRLEN len|NN STRLEN* retlen -Ap |char* |scan_num |NN const char* s|NN YYSTYPE *lvalp +Cp |char* |scan_num |NN const char* s|NN YYSTYPE *lvalp Apd |NV |scan_oct |NN const char* start|STRLEN len|NN STRLEN* retlen Axpd |OP* |op_scope |NULLOK OP* o : Only used by perl.c/miniperl.c, but defined in caretx.c From b4e8926749490c5508711d4f539744340c520fc6 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:23:16 -0600 Subject: [PATCH 284/503] embed.fnc: Mark stack_grow as Core only This is a helper function used by such things as SSGROW; there is no cpan usage --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index ee448c0e06e5..5f1cb55c1436 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1749,7 +1749,7 @@ CTp |Signal_t |csighandler1 |int sig Tp |Signal_t |sighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap CTp |Signal_t |csighandler3 |int sig|NULLOK Siginfo_t *info|NULLOK void *uap CTp |Signal_t |perly_sighandler |int sig|NULLOK Siginfo_t *info|NULLOK void *uap|bool safe -Ap |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n +Cp |SV** |stack_grow |NN SV** sp|NN SV** p|SSize_t n Ap |I32 |start_subparse |I32 is_format|U32 flags Xp |void |init_named_cv |NN CV *cv|NN OP *nameop : Used in pp_ctl.c From baf0bea7d35c79152c97fb52ffa5762ff103351d Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:25:44 -0600 Subject: [PATCH 285/503] embed.fnc: Mark sv_2uv, etc. as Core only There are documented macros that one is supposed to use instead for this functionality. --- embed.fnc | 8 ++++---- sv.c | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/embed.fnc b/embed.fnc index 5f1cb55c1436..e768c408416c 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1762,20 +1762,20 @@ Apd |IO* |sv_2io |NN SV *const sv #if defined(PERL_IN_SV_C) S |bool |glob_2number |NN GV* const gv #endif -ApMb |IV |sv_2iv |NN SV *sv +CpMb |IV |sv_2iv |NN SV *sv Apd |IV |sv_2iv_flags |NN SV *const sv|const I32 flags Apd |SV* |sv_2mortal |NULLOK SV *const sv Apd |NV |sv_2nv_flags |NN SV *const sv|const I32 flags : Used in pp.c, pp_hot.c, sv.c pxd |SV* |sv_2num |NN SV *const sv -ApMb |char* |sv_2pv |NN SV *sv|NULLOK STRLEN *lp -Apd |char* |sv_2pv_flags |NN SV *const sv|NULLOK STRLEN *const lp|const U32 flags +CpMb |char* |sv_2pv |NN SV *sv|NULLOK STRLEN *lp +Cpd |char* |sv_2pv_flags |NN SV *const sv|NULLOK STRLEN *const lp|const U32 flags ApdMb |char* |sv_2pvutf8 |NN SV *sv|NULLOK STRLEN *const lp Ap |char* |sv_2pvutf8_flags |NN SV *sv|NULLOK STRLEN *const lp|const U32 flags ApdMb |char* |sv_2pvbyte |NN SV *sv|NULLOK STRLEN *const lp Ap |char* |sv_2pvbyte_flags |NN SV *sv|NULLOK STRLEN *const lp|const U32 flags AbpD |char* |sv_pvn_nomg |NN SV* sv|NULLOK STRLEN* lp -ApMb |UV |sv_2uv |NN SV *sv +CpMb |UV |sv_2uv |NN SV *sv Apd |UV |sv_2uv_flags |NN SV *const sv|const I32 flags CbpdD |IV |sv_iv |NN SV* sv CbpdD |UV |sv_uv |NN SV* sv diff --git a/sv.c b/sv.c index d4df78fb0200..dc73edabfaec 100644 --- a/sv.c +++ b/sv.c @@ -3271,8 +3271,8 @@ These copy a stringified representation of the source SV into the destination SV. They automatically perform coercion of numeric values into strings. Guaranteed to preserve the C flag even from overloaded objects. Similar in nature to C but they operate directly on an SV -instead of just the string. Mostly they use C> to do the -work, except when that would lose the UTF-8'ness of the PV. +instead of just the string. Mostly they use L> to +do the work, except when that would lose the UTF-8'ness of the PV. The three forms differ only in whether or not they perform 'get magic' on C. C skips 'get magic'; C performs it; and From 6c041ec2c6e3f68af32f1ca92db0633ec2bcfd75 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 06:31:56 -0600 Subject: [PATCH 286/503] embed.fnc: Mark several do_dump fcns as Core only These appear to be helper functions for various API functions; there are no uses of them in cpan --- embed.fnc | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/embed.fnc b/embed.fnc index e768c408416c..51bcf589b425 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2684,20 +2684,20 @@ Apd |char* |pv_pretty |NN SV *dsv|NN char const * const str\ |NULLOK char const * const start_color\ |NULLOK char const * const end_color\ |const U32 flags -Afp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... -Ap |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ +Cfp |void |dump_indent |I32 level|NN PerlIO *file|NN const char* pat|... +Cp |void |dump_vindent |I32 level|NN PerlIO *file|NN const char* pat \ |NULLOK va_list *args -Ap |void |do_gv_dump |I32 level|NN PerlIO *file|NN const char *name\ +Cp |void |do_gv_dump |I32 level|NN PerlIO *file|NN const char *name\ |NULLOK GV *sv -Ap |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\ +Cp |void |do_gvgv_dump |I32 level|NN PerlIO *file|NN const char *name\ |NULLOK GV *sv -Ap |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\ +Cp |void |do_hv_dump |I32 level|NN PerlIO *file|NN const char *name\ |NULLOK HV *sv -Ap |void |do_magic_dump |I32 level|NN PerlIO *file|NULLOK const MAGIC *mg|I32 nest \ +Cp |void |do_magic_dump |I32 level|NN PerlIO *file|NULLOK const MAGIC *mg|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim -Ap |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o -Ap |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm -Ap |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ +Cp |void |do_op_dump |I32 level|NN PerlIO *file|NULLOK const OP *o +Cp |void |do_pmop_dump |I32 level|NN PerlIO *file|NULLOK const PMOP *pm +Cp |void |do_sv_dump |I32 level|NN PerlIO *file|NULLOK SV *sv|I32 nest \ |I32 maxnest|bool dumpops|STRLEN pvlim Ap |void |magic_dump |NULLOK const MAGIC *mg Cp |void |reginitcolors From 1e9f4e257f487950331eba0803d5efcd1c386713 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 09:43:06 -0700 Subject: [PATCH 287/503] perlapi: Document newSVsv_flags --- sv.c | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/sv.c b/sv.c index dc73edabfaec..682656f63052 100644 --- a/sv.c +++ b/sv.c @@ -9742,12 +9742,14 @@ Perl_newRV(pTHX_ SV *const sv) /* =for apidoc newSVsv =for apidoc_item newSVsv_nomg +=for apidoc_item newSVsv_flags -These create a new SV which is an exact duplicate of the original SV. -(Uses C.) +These create a new SV which is an exact duplicate of the original SV +(using C.) They differ only in that C performs 'get' magic; C skips -any magic. +any magic; and C allows you to explicitly set a C +parameter. =cut */ From e97ba88224d5c0d59252d9295deddec8426e12b0 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 09:52:10 -0700 Subject: [PATCH 288/503] perlapi: SvPVbyte_force() and kin: clarify. --- sv.h | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/sv.h b/sv.h index 58e86ae7bf39..1afbf59c4eb6 100644 --- a/sv.h +++ b/sv.h @@ -1555,10 +1555,10 @@ attention to precisely which outputs are influenced by which inputs. =for apidoc_item ||SvPVutf8_force =for apidoc_item ||SvPVutf8x_force -These are like C> but will force the SV into containing a string -(C>), and only a string (C>), by hook or by crook. -You need to use one of these C routines if you are going to update the -C> directly. +These are like C>, returning the string in the SV, but will force the +SV into containing a string (C>), and only a string +(C>), by hook or by crook. You need to use one of these +C routines if you are going to update the C> directly. Note that coercing an arbitrary scalar into a plain PV will potentially strip useful data from it. For example if the SV was C, then the @@ -1573,10 +1573,13 @@ to specify to perform 'get' magic (by setting the C flag) or to skip 'get' magic (by clearing it). The other forms do perform 'get' magic, except for the ones with C in their names, which skip 'get' magic. -The forms with C in their names do not return the length of the string. -They should be used only when it is known that the PV is a C string, terminated by -a NUL byte, and without intermediate NUL characters; or when you don't care -about its length. +The forms that take a C parameter will set that variable to the byte +length of the resultant string (these are macros, so don't use C<&len>). + +The forms with C in their names indicate they don't have a C +parameter. They should be used only when it is known that the PV is a C +string, terminated by a NUL byte, and without intermediate NUL characters; or +when you don't care about its length. The forms with C in their names are effectively the same as those without, but the name emphasizes that the string is modifiable by the caller, which it is From e51b4db5730ae5783d9eeef20decc773ab051247 Mon Sep 17 00:00:00 2001 From: Dan Book Date: Sun, 20 Dec 2020 12:24:24 -0500 Subject: [PATCH 289/503] perl5335delta grammar nit --- pod/perl5335delta.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perl5335delta.pod b/pod/perl5335delta.pod index b6b51f26eca6..eea2ba0f8c9d 100644 --- a/pod/perl5335delta.pod +++ b/pod/perl5335delta.pod @@ -236,7 +236,7 @@ operations. =item * semctl(), msgctl(), and shmctl() now attempt to downgrade the C -parameter if it's value is being used as input to C or +parameter if its value is being used as input to C or C calls. A failed downgrade will thrown an exception. =item * From e406736c4117f8f403b44413687d4c8df036c44b Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sun, 20 Dec 2020 17:14:32 -0500 Subject: [PATCH 290/503] Correct one misspelled variable name Correct one other typo --- lib/B/Deparse-core.t | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t index 991412a1dda9..80dbc052153b 100644 --- a/lib/B/Deparse-core.t +++ b/lib/B/Deparse-core.t @@ -44,7 +44,7 @@ use B::Deparse; my $deparse = new B::Deparse; my %SEEN; -my %SEEN_STRENGH; +my %SEEN_STRENGTH; # for a given keyword, create a sub of that name, then # deparse "() = $expr", and see if it matches $expected_expr @@ -135,7 +135,7 @@ my %infix_map = qw(and && or ||); sub do_infix_keyword { my ($keyword, $parens, $strong) = @_; - $SEEN_STRENGH{$keyword} = $strong; + $SEEN_STRENGTH{$keyword} = $strong; my $expr = "(\$a $keyword \$b)"; my $nkey = $infix_map{$keyword} // $keyword; my $expr = "(\$a $keyword \$b)"; @@ -158,7 +158,7 @@ sub do_infix_keyword { testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1; } -# test a keyword that is as tandard op/function, like 'index(...)'. +# test a keyword that is a standard op/function, like 'index(...)'. # narg - how many args to test it with # $parens - "foo $a, $b" is deparsed as "foo($a, $b)" # $dollar - an extra '$_' arg will appear in the deparsed output @@ -168,7 +168,7 @@ sub do_infix_keyword { sub do_std_keyword { my ($keyword, $narg, $parens, $dollar, $strong) = @_; - $SEEN_STRENGH{$keyword} = $strong; + $SEEN_STRENGTH{$keyword} = $strong; for my $core (0,1) { # if true, add CORE:: to keyword being deparsed for my $lexsub (0,1) { # if true, define lex sub @@ -413,7 +413,7 @@ SKIP: diag("keyword '$key' seen in $file, but not tested here!!"); $pass = 0; } - if (exists $SEEN_STRENGH{$key} and $SEEN_STRENGH{$key} != $strength) { + if (exists $SEEN_STRENGTH{$key} and $SEEN_STRENGTH{$key} != $strength) { diag("keyword '$key' strengh as seen in $file doen't match here!!"); $pass = 0; } From 2f338e940005dc728823c28fe6289f055e27f853 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 06:24:25 -0600 Subject: [PATCH 291/503] regen/regcharclass.pl: Mark intermediate macros as internal The macros generated by this script may have to be split into sub-macros to make the overall macro fit the maximum number of characters allowed by the compiler for a macro definition. This commit adds a trailing underscore to the names of such intermediate macros so as to mark them as non-API for autodoc. --- regcharclass.h | 122 +++++++++++++++++++++--------------------- regen/regcharclass.pl | 8 +-- 2 files changed, 65 insertions(+), 65 deletions(-) diff --git a/regcharclass.h b/regcharclass.h index 9aa98ed4d580..4ef90f34b97d 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -242,14 +242,14 @@ %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( ( ((const U8*)s)[1] & 0xDF ) == 'F' ) ? \ ( ( ( ( ((const U8*)s)[2] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[2] & 0xDF ) == 'L' ) ) ? 3 : 2 )\ : ( ( ( ((const U8*)s)[1] & 0xDF ) == 'I' ) || ( ( ((const U8*)s)[1] & 0xDF ) == 'L' ) ) ? 2 : 0 ) /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'H' ) ? \ ( ( ( 0xCC == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'I' ) ? \ @@ -324,7 +324,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ @@ -381,7 +381,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ((e)-(s) > 2) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -417,7 +417,7 @@ ( ((e)-(s) > 5) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 3 : 0 )\ - : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ + : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) )\ : ((e)-(s) > 4) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -476,10 +476,10 @@ ( ( ( ( ( ((const U8*)s)[2] & 0xD8 ) == 0x80 ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : ( ( ( ( 0xBD == ((const U8*)s)[1] ) && ( ( ( ((const U8*)s)[2] & 0xF8 ) == 0xA0 ) || ( ( ((const U8*)s)[2] & 0xFB ) == 0xB0 ) || ((const U8*)s)[2] == 0xBC ) ) && ( 0xCE == ((const U8*)s)[3] ) ) && ( 0xB9 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ : 0 ) \ -: ((e)-(s) > 3) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) +: ((e)-(s) > 3) ? is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( 0x81 == ((const U8*)s)[1] ) ? \ ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x93 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ : ( 0x85 == ((const U8*)s)[1] ) ? \ @@ -506,7 +506,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( 0xD5 == ((const U8*)s)[0] ) ? \ ( ( 0xA5 == ((const U8*)s)[1] ) ? \ ( ( ( 0xD6 == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x587 : 0 )\ @@ -578,7 +578,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( 0x81 == ((const U8*)s)[1] ) ? \ ( ( ( 0xCC == ((const U8*)s)[2] ) && ( 0x93 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ : ( 0x85 == ((const U8*)s)[1] ) ? \ @@ -593,7 +593,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ( 0xD5 == ((const U8*)s)[0] ) ? \ ( ( 0xA5 == ((const U8*)s)[1] ) ? \ ( ( ( 0xD6 == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x587 : 0 )\ @@ -665,7 +665,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ @@ -739,7 +739,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) \ ( ((e)-(s) > 2) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -784,7 +784,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ : ( ( ((const U8*)s)[0] & 0xDF ) == 'F' ) ? \ @@ -844,11 +844,11 @@ : 0 ) \ : ( ( 0xCD == ((const U8*)s)[2] ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ : 0 ) \ - : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) \ ( ((e)-(s) > 4) ? \ ( ( ( ((const U8*)s)[0] & 0xDF ) == 'A' ) ? \ ( ( ( 0xCA == ((const U8*)s)[1] ) && ( 0xBE == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -896,13 +896,13 @@ ( ( 0x82 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ : ( ( 0xCE == ((const U8*)s)[2] ) && ( 0xB9 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ : ( ( ( 0xB9 == ((const U8*)s)[1] ) && ( 0xCD == ((const U8*)s)[2] ) ) && ( 0x82 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ - : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ -: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) ) + : ( 0xCF == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) ) /*** GENERATED CODE ***/ #define what_MULTI_CHAR_FOLD_utf8_safe(s,e) \ -( ((e)-(s) > 5) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) +( ((e)-(s) > 5) ? what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -1374,14 +1374,14 @@ \p{_Perl_Quotemeta} */ /*** GENERATED CODE ***/ -#define is_QUOTEMETA_high_part0(s) \ +#define is_QUOTEMETA_high_part0_(s) \ ( ( 0x63 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x71 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x63, 0x64) ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ -#define is_QUOTEMETA_high_part1(s) \ +#define is_QUOTEMETA_high_part1_(s) \ ( ( 0xBE == ((const U8*)s)[0] ) ? \ ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ : ( 0xCA == ((const U8*)s)[0] ) ? \ @@ -1441,7 +1441,7 @@ ( ( 0x51 == ((const U8*)s)[1] ) ? \ ( ( 0x73 == ((const U8*)s)[2] ) ? 3 : 0 ) \ : ( ( 0x52 == ((const U8*)s)[1] ) && ( 0x41 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ -: ( 0xBC == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0(s) : is_QUOTEMETA_high_part1(s) ) +: ( 0xBC == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0_(s) : is_QUOTEMETA_high_part1_(s) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -1449,12 +1449,12 @@ %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( ( 0xAF == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( 0x8F == ((const U8*)s)[0] ) ? \ ( ( 0x73 == ((const U8*)s)[1] ) ? \ ( ( 0x8F == ((const U8*)s)[2] ) ? \ @@ -1529,7 +1529,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ @@ -1586,7 +1586,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ((e)-(s) > 3) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -1679,11 +1679,11 @@ : ( ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ) ? 2 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ -: ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) )\ +: ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( 0x52 == ((const U8*)s)[1] ) ? \ ( ( 0x46 == ((const U8*)s)[2] ) ? \ ( ( ( ( 0xB8 == ((const U8*)s)[3] ) && ( 0x53 == ((const U8*)s)[4] ) ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x587 : 0 )\ @@ -1697,7 +1697,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x67 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? \ @@ -1758,7 +1758,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ @@ -1767,7 +1767,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ ( ( ( 0xB0 == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ @@ -1845,11 +1845,11 @@ : 0 ) \ : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB4 == ((const U8*)s)[2] ) ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ - : ( 0xB8 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + : ( 0xB8 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) \ ( ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( ( 0xAF == ((const U8*)s)[2] ) && ( 0x62 == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ : ( 0x46 == ((const U8*)s)[1] ) ? \ @@ -1864,7 +1864,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) \ ( ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x67 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? \ @@ -1925,7 +1925,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ @@ -1990,7 +1990,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) \ ( ((e)-(s) > 2) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -2040,7 +2040,7 @@ ( ((e)-(s) > 5) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) )\ : ((e)-(s) > 4) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAB == ((const U8*)s)[1] ) && ( 0x72 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -2090,8 +2090,8 @@ ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ : ( ( 0xB4 == ((const U8*)s)[2] ) && ( 0x68 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ : ( ( ( 0x68 == ((const U8*)s)[1] ) && ( 0xB1 == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ - : ( 0xB5 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) )\ -: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) + : ( 0xB5 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -2552,7 +2552,7 @@ \p{_Perl_Quotemeta} */ /*** GENERATED CODE ***/ -#define is_QUOTEMETA_high_part0(s) \ +#define is_QUOTEMETA_high_part0_(s) \ ( ( 0x41 == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x54, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ?\ ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ @@ -2565,7 +2565,7 @@ /*** GENERATED CODE ***/ -#define is_QUOTEMETA_high_part1(s) \ +#define is_QUOTEMETA_high_part1_(s) \ ( ( 0xCB == ((const U8*)s)[0] ) ? \ ( ( inRANGE_helper_(U8, ((const U8*)s)[1], 0x41, 0x43) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x49, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x51, 0x59) || 0x5F == ((const U8*)s)[1] || inRANGE_helper_(U8, ((const U8*)s)[1], 0x62, 0x68) || inRANGE_helper_(U8, ((const U8*)s)[1], 0x70, 0x72) ) ?\ ( ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x41, 0x4A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x51, 0x59) || 0x5F == ((const U8*)s)[2] || inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x6A) || inRANGE_helper_(U8, ((const U8*)s)[2], 0x70, 0x72) ) ? 3 : 0 )\ @@ -2619,7 +2619,7 @@ : ( ( 0x70 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x62, 0x63) ) ) ? 3 : 0 )\ : ( 0xBE == ((const U8*)s)[0] ) ? \ ( ( ( 0x41 == ((const U8*)s)[1] ) && ( inRANGE_helper_(U8, ((const U8*)s)[2], 0x52, 0x55) ) ) ? 3 : 0 )\ -: ( 0xCA == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0(s) : is_QUOTEMETA_high_part1(s) ) +: ( 0xCA == ((const U8*)s)[0] ) ? is_QUOTEMETA_high_part0_(s) : is_QUOTEMETA_high_part1_(s) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -2627,12 +2627,12 @@ %regcharclass_multi_char_folds::multi_char_folds('u', 'a') */ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( ( 0xAD == ((const U8*)s)[1] ) && ( 0x48 == ((const U8*)s)[2] ) ) ? 3 : 0 ) /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( 0x8E == ((const U8*)s)[0] ) ? \ ( ( 0x72 == ((const U8*)s)[1] ) ? \ ( ( 0x8E == ((const U8*)s)[2] ) ? \ @@ -2707,7 +2707,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ @@ -2764,7 +2764,7 @@ /*** GENERATED CODE ***/ -#define is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ((e)-(s) > 3) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ @@ -2857,11 +2857,11 @@ : ( ( ( ((const U8*)s)[1] & 0xBF ) == 'i' ) || ( ( ((const U8*)s)[1] & 0xBF ) == 'l' ) ) ? 2 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 3 : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) )\ -: ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) ) + : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? is_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) )\ +: ((e)-(s) > 4) ? is_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : is_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) \ ( ( 0x52 == ((const U8*)s)[1] ) ? \ ( ( 0x46 == ((const U8*)s)[2] ) ? \ ( ( ( ( 0xB7 == ((const U8*)s)[3] ) && ( 0x53 == ((const U8*)s)[4] ) ) && ( 0x43 == ((const U8*)s)[5] ) ) ? 0x587 : 0 )\ @@ -2875,7 +2875,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) \ ( ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x66 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? \ @@ -2936,7 +2936,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) \ ( ( ( ((const U8*)s)[1] & 0xBF ) == 'f' ) ? \ ( ( ( ((const U8*)s)[2] & 0xBF ) == 'i' ) ? 0xFB03 \ : ( ( ((const U8*)s)[2] & 0xBF ) == 'l' ) ? 0xFB04 : 0xFB00 ) \ @@ -2945,7 +2945,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'h' ) ? \ ( ( ( 0xAE == ((const U8*)s)[1] ) && ( 0x58 == ((const U8*)s)[2] ) ) ? 0x1E96 : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'i' ) ? \ @@ -3023,11 +3023,11 @@ : 0 ) \ : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF3 : 0 )\ : ( ( ( 0x55 == ((const U8*)s)[1] ) && ( 0xB3 == ((const U8*)s)[2] ) ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FF4 : 0 )\ - : ( 0xB7 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1(s,e) ) + : ( 0xB7 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part0_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part1_(s,e) ) /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) \ ( ( 0x42 == ((const U8*)s)[1] ) ? \ ( ( ( 0xAD == ((const U8*)s)[2] ) && ( 0x5F == ((const U8*)s)[3] ) ) ? 0x1FE4 : 0 )\ : ( 0x46 == ((const U8*)s)[1] ) ? \ @@ -3042,7 +3042,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) \ ( ( 0xBF == ((const U8*)s)[0] ) ? \ ( ( 0x66 == ((const U8*)s)[1] ) ? \ ( ( 0x41 == ((const U8*)s)[2] ) ? \ @@ -3103,7 +3103,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? \ @@ -3168,7 +3168,7 @@ /*** GENERATED CODE ***/ -#define what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) \ +#define what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) \ ( ((e)-(s) > 2) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -3218,7 +3218,7 @@ ( ((e)-(s) > 5) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ - : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3(s,e) )\ + : ( ( ((const U8*)s)[0] & 0xBF ) == 'f' ) ? what_MULTI_CHAR_FOLD_utf8_safe_part2_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part3_(s,e) )\ : ((e)-(s) > 4) ? \ ( ( ( ((const U8*)s)[0] & 0xBF ) == 'a' ) ? \ ( ( ( 0xAA == ((const U8*)s)[1] ) && ( 0x71 == ((const U8*)s)[2] ) ) ? 0x1E9A : 0 )\ @@ -3268,8 +3268,8 @@ ( ( 0x43 == ((const U8*)s)[3] ) ? 0x1FC6 : 0 ) \ : ( ( 0xB3 == ((const U8*)s)[2] ) && ( 0x67 == ((const U8*)s)[3] ) ) ? 0x1FC3 : 0 )\ : ( ( ( 0x67 == ((const U8*)s)[1] ) && ( 0xAF == ((const U8*)s)[2] ) ) && ( 0x43 == ((const U8*)s)[3] ) ) ? 0x1FD6 : 0 )\ - : ( 0xB4 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5(s,e) )\ -: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7(s,e) ) + : ( 0xB4 == ((const U8*)s)[0] ) ? what_MULTI_CHAR_FOLD_utf8_safe_part4_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part5_(s,e) )\ +: ((e)-(s) > 3) ? what_MULTI_CHAR_FOLD_utf8_safe_part6_(s,e) : what_MULTI_CHAR_FOLD_utf8_safe_part7_(s,e) ) /* MULTI_CHAR_FOLD: multi-char strings that are folded to by a single character @@ -3617,6 +3617,6 @@ * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * f0ac417314b8da8e05d386ca3d0d8074e38ecd9dc77a7d966aa48ec4ec247e2a regen/regcharclass.pl + * 491175747e1f1e52ce6d6fbcbd7ad75fc5c7a77eec49c0b6fff46fc9a31ca089 regen/regcharclass.pl * b2f896452d2b30da3e04800f478c60c1fd0b03d6b668689b020f1e3cf1f1cdd9 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 5fd8e255e318..852ea0d3e8ad 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1270,11 +1270,11 @@ sub _render { my $str= "$lb$cond ?$yes$ind: $no$rb"; if (length $str > 6000) { push @$submacros, sprintf "#define $def\n( %s )", "_part" - . (my $yes_idx= 0+@$submacros), $yes; + . (my $yes_idx= 0+@$submacros) . "_", $yes; push @$submacros, sprintf "#define $def\n( %s )", "_part" - . (my $no_idx= 0+@$submacros), $no; - return sprintf "%s%s ? $def : $def%s", $lb, $cond, "_part$yes_idx", - "_part$no_idx", $rb; + . (my $no_idx= 0+@$submacros) . "_", $no; + return sprintf "%s%s ? $def : $def%s", $lb, $cond, + "_part${yes_idx}_", "_part${no_idx}_", $rb; } return $str; } From 1a7ee1dc1e657347ff0fa95272f0cbecbfca421f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 21 Dec 2020 11:04:02 -0700 Subject: [PATCH 292/503] regexec.c: Fix failing CI 32-bit tests This bug was introduced by bb3825626ed2b1217a2ac184eff66d0d4ed6e070, and was the result of overflowing a 32 bit space. The solution is to rework the expression so that it can't overflow. --- regexec.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/regexec.c b/regexec.c index 74f95e73d02c..61a3075cc26a 100644 --- a/regexec.c +++ b/regexec.c @@ -10019,7 +10019,9 @@ S_regrepeat(pTHX_ regexp *prog, char **startposp, const regnode *p, if (definitive_len == 1) { const char * orig_scan = scan; - this_eol = MIN(this_eol, scan + max - hardcount); + if (this_eol - (scan - hardcount) > max) { + this_eol = scan - hardcount + max; + } /* Use different routines depending on whether it's an * exact match or matches with a mask */ From 05a3a9e270acbdb476e3ca1a8ef39a7eaf374406 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 24 Nov 2020 09:17:46 -0500 Subject: [PATCH 293/503] perlgov: the perl governance document --- MANIFEST | 1 + pod/perl.pod | 1 + pod/perlgov.pod | 531 ++++++++++++++++++++++++++++++++++++++++++++++++ win32/pod.mak | 4 + 4 files changed, 537 insertions(+) create mode 100644 pod/perlgov.pod diff --git a/MANIFEST b/MANIFEST index 1585a9990224..014f2f6ba61d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5269,6 +5269,7 @@ pod/perlfork.pod Perl fork() information pod/perlform.pod Perl formats pod/perlfunc.pod Perl built-in functions pod/perlgit.pod Using git with the Perl repository +pod/perlgov.pod Perl Rules of Governance pod/perlgpl.pod GNU General Public License pod/perlguts.pod Perl internal functions for those doing extensions pod/perlhack.pod Perl hackers guide diff --git a/pod/perl.pod b/pod/perl.pod index 90c1c8a5eb6f..fd1beb290678 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -172,6 +172,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhacktut Walk through the creation of a simple C code patch perlhacktips Tips for Perl core C code hacking perlpolicy Perl development policies + perlgov Perl Rules of Governance perlgit Using git with the Perl repository =head2 Miscellaneous diff --git a/pod/perlgov.pod b/pod/perlgov.pod new file mode 100644 index 000000000000..2a500def45b6 --- /dev/null +++ b/pod/perlgov.pod @@ -0,0 +1,531 @@ +=encoding utf-8 + +=head1 NAME + +perlgov - Perl Rules of Governance + +=head2 PREAMBLE + +We are forming a system of governance for development of the Perl programming +language. + +The scope of governance includes the language definition, its +implementation, its test suite, its documentation, and the policies and +procedures by which it is developed and maintained. + +The system of governance includes definitions of the groups that will make +decisions, the rules by which these groups are formed and changed, and the +enumerated powers and constraints on the activities of these governing +groups. + +In forming a system of governance, we seek to achieve the following goals: + +=over + +=item * + +We want a system that is functional. That means the governing groups may +decide to undertake large changes, or they may decide to act conservatively, +but they will act with intent and clear communication rather than fail to reach +decisions when needed. + +=item * + +We want a system that is trusted. That means that a reasonable contributor to +Perl might disagree with decisions made by the governing groups, but will +accept that they were made in good faith in consultation with relevant +communities outside the governing groups. + +=item * + +We want a system that is sustainable. That means it has provisions to +self-modify, including ways of adding new members to the governing groups, ways +to survive members becoming inactive, and ways of amending the rules of +governance themselves if needed. + +=item * + +We want a system that is transparent. That means that it will prefer policies +that manage ordinary matters in public, and it will prefer secrecy in a limited +number of situations. + +=item * + +We want a system that is respectful. That means that it will establish +standards of civil discourse that allow for healthy disagreement but avoid +rancor and hostility in the community for which it is responsible. + +=back + +=head1 Mandate + +Perl language governance shall work to: + +=over + +=item * + +Maintain the quality, stability, and continuity of the Perl language and +interpreter + +=item * + +Guide the evolution of the Perl language and interpreter + +=item * + +Establish and oversee the policies, procedures, systems, and mechanisms that +enable a community of contributors to the Perl language and interpreter + +=item * + +Encourage discussion and consensus among contributors as preferential to formal +decision making by governance groups + +=item * + +Facilitate communication between contributors and external stakeholders in the +broader Perl ecosystem + +=back + +=head1 Definitions + +This document describes three roles involved in governance: + +=over + +=item "Core Team" + +=item "Steering Council" + +=item "Vote Administrator" + +=back + +A section on each follows. + +=head2 The Core Team + +The Core Team are a group of trusted volunteers involved in the ongoing +development of the Perl language and interpreter. They are not required to be +language developers or committers. + +References to specific votes are explained in the "Rules for Voting" section. + +=head3 Powers + +In addition to their contributions to the Perl language, the Core Team sets +the rules of Perl governance, decides who participates in what role in +governance, and delegates substantial decision making power to the Steering +Council. + +Specifically: + +=over + +=item * + +They elect the Steering Council and have the power to remove Steering +Council members. + +=item * + +In concert with the Steering Council, they manage Core Team membership. + +=item * + +In concert with the Steering Council, they have the power to modify the Perl +Rules of Governance. + +=back + +The Core Team do not have any authority over parts of the Perl ecosystem +unrelated to developing and releasing the language itself. These include, but +are not limited to: + +=over + +=item * + +The Perl Foundation + +=item * + +CPAN administration and CPAN authors + +=item * + +perl.org, metacpan.org, and other community-maintained websites and services + +=item * + +Perl conferences and events, except those organized directly by Core Team + +=item * + +Perl-related intellectual property legally owned by third-parties, except as +allowed by applicable licenses or agreements. + +=back + +=head3 Membership + +The initial Core Team members will be specified when this document is +first ratified. + +Any Core Team member may nominate someone to be added to the Core Team by +sending the nomination to the Steering Council. The Steering Council must +approve or reject the nomination. If approved, the Steering Council will +organize a Membership Change Vote to ratify the addition. + +Core Team members should demonstrate: + +=over + +=item * + +A solid track record of being constructive and helpful + +=item * + +Significant contributions to the project's goals, in any form + +=item * + +Willingness to dedicate some time to improving Perl + +=back + +Contributions are not limited to code. Here is an incomplete list of areas +where contributions may be considered for joining the Core Team: + +=over + +=item * + +Working on community management and outreach + +=item * + +Providing support on mailing lists, IRC, or other forums + +=item * + +Triaging tickets + +=item * + +Writing patches (code, docs, or tests) + +=item * + +Reviewing patches (code, docs, or tests) + +=item * + +Participating in design discussions + +=item * + +Providing expertise in a particular domain (security, i18n, etc.) + +=item * + +Managing Perl infrastructure (websites, CI, documentation, etc.) + +=item * + +Maintaining significant projects in the Perl ecosystem + +=item * + +Creating visual designs + +=back + +Core Team membership acknowledges sustained and valuable efforts that align +well with the philosophy and the goals of the Perl project. + +Core Team members are expected to act as role models for the community and +custodians of the project, on behalf of the community and all those who rely +on Perl. + +=head3 Term + +Core Team members serve until they are removed. + +=head3 Removal + +Core Team Members may resign their position at any time. + +In exceptional circumstances, it may be necessary to remove someone from the +Core Team against their will, such as for flagrant or repeated violations of a +Code of Conduct. Any Core Team member may send a recall request to the +Steering Council naming the individual to be removed. The Steering Council +must approve or reject the recall request. If approved, the Steering Council +will organize a Membership Change vote to ratify the removal. + +If the removed member is also on the Steering Council, then they are removed +from the Steering Council as well. + +=head3 Inactivity + +Core Team members who have stopped contributing are encouraged to declare +themselves "inactive". Inactive members do not nominate or vote. Inactive +members may declare themselves active at any time, except when a vote has been +proposed and is not concluded. Eligibility to nominate or vote will be +determined by the Vote Administrator. + +To record and honor their contributions, inactive Core Team members will +continue to be listed alongside active members. + +=head3 No Confidence in the Steering Council + +The Core Team may remove either a single Steering Council member or the entire +Steering Council via a No Confidence Vote. + +A No Confidence Vote is triggered when a Core Team member calls for one +publicly on an appropriate project communication channel, and another Core +Team member seconds the proposal. + +If a No Confidence Vote removes all Steering Council members, the Vote +Administrator of the No Confidence Vote will then administer an election +to select a new Steering Council. + +=head3 Amending Perl Rules of Governance + +Any Core Team member may propose amending the Perl Rules of Governance by +sending a proposal to the Steering Council. The Steering Council must decide +to approve or reject the proposal. If approved, the Steering Council will +administer an Amendment Vote. + +=head3 Rules for Voting + +Membership Change, Amendment, and No Confidence Votes require 2/3 of +participating votes from Core Team members to pass. + +A Vote Administrator must be selected following the rules in the "Vote +Administrator" section. + +The vote occurs in two steps: + +=over + +=item 1 + +The Vote Administrator describes the proposal being voted upon. The Core Team +then may discuss the matter in advance of voting. + +=item 2 + +Active Core Team members vote in favor or against the proposal. Voting is +performed anonymously. + +=back + +For a Membership Change Vote, each phase will last one week. For Amendment and +No Confidence Votes, each phase will last two weeks. + +=head2 The Steering Council + +The Steering Council is a 3-person committee, elected by the Core +Team. Candidates are not required to be members of the Core Team. Non-member +candidates are added to the Core Team if elected as if by a Membership Change +Vote. + +References to specific elections are explained in the "Rules for Elections" section. + +=head3 Powers + +The Steering Council has broad authority to make decisions about the +development of the Perl language, the interpreter, and all other components, +systems and processes that result in new releases of the language interpreter. + +For example, it can: + +=over + +=item * + +Manage the schedule and process for shipping new releases + +=item * + +Establish procedures for proposing, discussing and deciding upon changes to the +language + +=item * + +Delegate power to individuals on or outside the Steering Council + +=back + +Decisions of the Steering Council will be made by majority vote of non-vacant +seats on the council. + +The Steering Council should look for ways to use these powers as little as +possible. Instead of voting, it's better to seek consensus. Instead of ruling +on individual cases, it's better to define standards and processes that apply +to all cases. + +As with the Core Team, the Steering Council does not have any authority over +parts of the Perl ecosystem unrelated to developing and releasing the language +itself. + +The Steering Council does not have the power to modify the Perl Rules of +Governance, except as provided in the section "Amending Perl Rules of +Governance". + +=head3 Term + +A new Steering Council will be chosen by a Term Election within two weeks after +each stable feature release (that is, change to C or +C) or after two years, whichever comes first. The council members +will serve until the completion of the next Term Election unless they are +removed. + +=head3 Removal + +Steering Council members may resign their position at any time. + +Whenever there are vacancies on the Steering Council, the council will +organize a Special Election within one week after the vacancy occurs. If the +entire Steering Council is ever vacant, a Term Election will be held instead. + +If a Steering Council member is deceased, or drops out of touch and cannot be +contacted for a month or longer, then the rest of the council may vote to +declare their seat vacant. If an absent member returns after such a +declaration is made, they are not reinstated automatically, but may run in the +Special Election to fill the vacancy. + +Otherwise, Steering Council members may only be removed before the end of +their term through a No Confidence Vote by the Core Team. + +=head3 Rules for Elections + +Term and Special Election are ranked-choice votes to construct an ordered list +of candidates to fill vacancies in the Steering Council. + +A Vote Administrator must be selected following the rules in the "Vote +Administrator" section. + +Both Term and Special Elections occur in two stages: + +=over + +=item 1 + +Candidates advertise their interest in serving. Candidates must be nominated by +an active Core Team member. Self-nominations are allowed. Nominated candidates +may share a statement about their candidacy with the Core Team. + +=item 2 + +Active Core Team Members vote by ranking all candidates. Voting is performed +anonymously. After voting is complete, candidates are ranked using the +Condorcet Internet Voting Service's proportional representation mode. If a tie +occurs, it may be resolved by mutual agreement among the tied candidates, or +else the tie will be resolved through random selection by the Vote +Administrator. + +=back + +Anyone voted off the Core Team is not eligible to be a candidate for Steering +Council unless re-instated to the Core Team. + +For a Term Election, each phase will last two weeks. At the end of the second +phase, the top three ranked candidates are elected as the new Steering Council. + +For a Special Election, each phase will last one week. At the end of the +second phase, vacancies are filled from the ordered list of candidates until +no vacancies remain. + +The election of the first Steering Council will be a Term Election. Ricardo +Signes will be the Vote Administrator for the initial Term Election unless he +is a candidate, in which case he will select a non-candidate administrator to +replace him. + +=head2 The Vote Administrator + +Every election or vote requires a Vote Administrator who manages +communication, collection of secret ballots, and all other necessary +activities to complete the voting process. + +Unless otherwise specified, the Steering Council selects the Vote +Administrator. + +A Vote Administrator must not be a member of the Steering Council nor a +candidate or subject of the vote. A Vote Administrator may be a member of the +Core Team and, if so, may cast a vote while also serving as administrator. If +the Vote Administrator becomes a candidate during an election vote, they will +appoint a non-candidate replacement. + +If the entire Steering Council is vacant or is the subject of a No Confidence +Vote, then the Core Team will select a Vote Administrator by consensus. If +consensus cannot be reached within one week, the President of The Perl +Foundation will select a Vote Administrator. + +=head1 Core Team Members + +The current members of the Perl Core Team are: + +=over + +=item * Abhijit Menon-Sen (inactive) + +=item * Andy Dougherty + +=item * Chad Granum + +=item * Chris 'BinGOs' Williams + +=item * Craig Berry + +=item * Dagfinn Ilmari Mannsåker + +=item * Dave Mitchell + +=item * David Golden + +=item * H. Merijn Brand + +=item * Hugo van der Sanden + +=item * James E Keenan + +=item * Jan Dubois (inactive) + +=item * Jesse Vincent (inactive) + +=item * Karen Etheridge + +=item * Karl Williamson + +=item * Leon Timmermans + +=item * Matthew Horsfall + +=item * Max Maischein + +=item * Nicholas Clark + +=item * Nicolas R. + +=item * Paul "LeoNerd" Evans + +=item * Philippe "BooK" Bruhat + +=item * Ricardo Signes + +=item * Sawyer X + +=item * Steve Hay + +=item * Stuart Mackintosh + +=item * Todd Rinaldo + +=item * Tony Cook + +=back diff --git a/win32/pod.mak b/win32/pod.mak index f5ee35d83007..1e7329566bfa 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -111,6 +111,7 @@ POD = perl.pod \ perlform.pod \ perlfunc.pod \ perlgit.pod \ + perlgov.pod \ perlgpl.pod \ perlguts.pod \ perlhack.pod \ @@ -278,6 +279,7 @@ MAN = perl.man \ perlform.man \ perlfunc.man \ perlgit.man \ + perlgov.man \ perlgpl.man \ perlguts.man \ perlhack.man \ @@ -445,6 +447,7 @@ HTML = perl.html \ perlform.html \ perlfunc.html \ perlgit.html \ + perlgov.html \ perlgpl.html \ perlguts.html \ perlhack.html \ @@ -612,6 +615,7 @@ TEX = perl.tex \ perlform.tex \ perlfunc.tex \ perlgit.tex \ + perlgov.tex \ perlgpl.tex \ perlguts.tex \ perlhack.tex \ From f8e911a1fee93e2ec18731a39a30b6c880c64951 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Tue, 24 Nov 2020 22:01:25 -0500 Subject: [PATCH 294/503] perlgov: formatting tweaks from code review --- pod/perl.pod | 2 +- pod/perlgov.pod | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perl.pod b/pod/perl.pod index fd1beb290678..b9503d53fe07 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -172,7 +172,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhacktut Walk through the creation of a simple C code patch perlhacktips Tips for Perl core C code hacking perlpolicy Perl development policies - perlgov Perl Rules of Governance + perlgov Perl Rules of Governance perlgit Using git with the Perl repository =head2 Miscellaneous diff --git a/pod/perlgov.pod b/pod/perlgov.pod index 2a500def45b6..6411f64d3754 100644 --- a/pod/perlgov.pod +++ b/pod/perlgov.pod @@ -4,7 +4,7 @@ perlgov - Perl Rules of Governance -=head2 PREAMBLE +=head1 PREAMBLE We are forming a system of governance for development of the Perl programming language. From 159f10880013e565e0bc0f6347e036c8a947c267 Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Fri, 27 Nov 2020 16:19:10 -0500 Subject: [PATCH 295/503] perlgov: add a missing "the" and remove a full stop --- pod/perlgov.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perlgov.pod b/pod/perlgov.pod index 6411f64d3754..64ba6105802e 100644 --- a/pod/perlgov.pod +++ b/pod/perlgov.pod @@ -160,12 +160,12 @@ perl.org, metacpan.org, and other community-maintained websites and services =item * -Perl conferences and events, except those organized directly by Core Team +Perl conferences and events, except those organized directly by the Core Team =item * Perl-related intellectual property legally owned by third-parties, except as -allowed by applicable licenses or agreements. +allowed by applicable licenses or agreements =back From e5211ca5a0e1bd8b736cc82b3525ca4939fea0eb Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 16 Dec 2020 13:19:02 -0700 Subject: [PATCH 296/503] perlapi: Note that my_strftime's result is localized --- util.c | 3 +++ 1 file changed, 3 insertions(+) diff --git a/util.c b/util.c index 4cd23e897344..e4e194cdb230 100644 --- a/util.c +++ b/util.c @@ -4152,6 +4152,9 @@ so that the caller doesn't have to worry about that. Note that yday and wday effectively are ignored by this function, as mini_mktime() overwrites them +Also note that this is always executed in the underlying locale of the program, +giving localized results. + =cut */ From 1e9024cf5bf80071c67ed0757a0f250d3cc7432a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 21:04:31 -0700 Subject: [PATCH 297/503] t/test.pl: Note 2nd spelling for fcn This makes it easier to grep for --- t/test.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/test.pl b/t/test.pl index 8c8902f89029..945ad20702c6 100644 --- a/t/test.pl +++ b/t/test.pl @@ -614,7 +614,7 @@ ($) } } -# runperl - Runs a separate perl interpreter and returns its output. +# runperl, run_perl - Runs a separate perl interpreter and returns its output. # Arguments : # switches => [ command-line switches ] # nolib => 1 # don't use -I../lib (included by default) From dde36b936a80fa9b440332e67d7ca32546f12bdd Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 20:51:20 -0700 Subject: [PATCH 298/503] globals.c: Fix typo in comment --- globals.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/globals.c b/globals.c index 5439ba241a4b..045c71ca3fb9 100644 --- a/globals.c +++ b/globals.c @@ -15,7 +15,7 @@ */ /* This file exists to #include "perl.h" _ONCE_ with - * PERL_IN_GLOBALS_C defined. That causes various global varaiables + * PERL_IN_GLOBALS_C defined. That causes various global variables * in perl.h and other files it includes to be _defined_ (and initialized) * rather than just declared. */ From 54469f5eb1d2aa4254fc96105e865fcf236b2252 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 20:52:12 -0700 Subject: [PATCH 299/503] POSIX.xs: Remove redundant #ifdef HAS_DUPLOCALE is implied by HAS_POSIX_2008_LOCALE; no need to mention it --- ext/POSIX/POSIX.xs | 4 ++-- ext/POSIX/lib/POSIX.pm | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 6bd30e847419..60c7fd2c7402 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1804,6 +1804,7 @@ fix_win32_tzenv(void) char* newenv; const char* perl_tz_env = win32_getenv("TZ"); const char* crt_tz_env = getenv("TZ"); + if (perl_tz_env == NULL) perl_tz_env = ""; if (crt_tz_env == NULL) @@ -2174,8 +2175,7 @@ localeconv() sv_2mortal((SV*)RETVAL); # if defined(USE_ITHREADS) \ && defined(HAS_POSIX_2008_LOCALE) \ - && defined(HAS_LOCALECONV_L) \ - && defined(HAS_DUPLOCALE) + && defined(HAS_LOCALECONV_L) cur = uselocale((locale_t) 0); if (cur == LC_GLOBAL_LOCALE) { diff --git a/ext/POSIX/lib/POSIX.pm b/ext/POSIX/lib/POSIX.pm index c374af6aa077..08986d26577d 100644 --- a/ext/POSIX/lib/POSIX.pm +++ b/ext/POSIX/lib/POSIX.pm @@ -4,7 +4,7 @@ use warnings; our ($AUTOLOAD, %SIGRT); -our $VERSION = '1.96'; +our $VERSION = '1.97'; require XSLoader; From 2f02cce303d81a43727b0514e7c6d39a579bd217 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 20 Dec 2020 20:56:35 -0700 Subject: [PATCH 300/503] POSIX.pod: Document [C99] notation This fixes GH #18404 --- ext/POSIX/lib/POSIX.pod | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/ext/POSIX/lib/POSIX.pod b/ext/POSIX/lib/POSIX.pod index a92a20c6d725..6265a4505056 100644 --- a/ext/POSIX/lib/POSIX.pod +++ b/ext/POSIX/lib/POSIX.pod @@ -32,6 +32,11 @@ and other miscellaneous objects. The remaining sections list various constants and macros in an organization which roughly follows IEEE Std 1003.1b-1993. +The notation C<[C99]> indicates functions that were added in the ISO/IEC +9899:1999 version of the C language standard. Some may not be available +on your system if it adheres to an earlier standard. Attempts to use +any missing one will result in a fatal runtime error message. + =head1 CAVEATS I (with a handful of exceptions). From 49fb50ea6e42cacccde2683fbed0b89f9eeb16cf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Mon, 21 Dec 2020 15:19:10 -0700 Subject: [PATCH 301/503] regexec.c: Silence compiler warning --- regexec.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regexec.c b/regexec.c index 61a3075cc26a..2a5fa540bc49 100644 --- a/regexec.c +++ b/regexec.c @@ -9284,7 +9284,7 @@ NULL n = (utf8_target) ? utf8_length((U8 *) ST.oldloc, (U8 *) locinput) - : locinput - ST.oldloc; + : (STRLEN) (locinput - ST.oldloc); /* Here is at the beginning of a character that meets the mask From 45d112b438bda9b5b1d59789449ba051a6dcf687 Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Mon, 21 Dec 2020 17:00:42 -0800 Subject: [PATCH 302/503] Win32API::File::inc::ExtUtils::Myconst2perl is not indexed ..and Porting/corelist.pl warns about it This is a re-application of commit cdac9b8288885 after the change was reversed a month later. --- dist/Module-CoreList/lib/Module/CoreList.pm | 3 --- 1 file changed, 3 deletions(-) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index f8f491975ee0..d6a318249608 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -17712,7 +17712,6 @@ for my $version ( sort { $a <=> $b } keys %released ) { 'Test::Tester::CaptureRunner'=> '1.302181', 'Test::Tester::Delegate'=> '1.302181', 'Test::use::ok' => '1.302181', - 'Win32API::File::inc::ExtUtils::Myconst2perl'=> '1', 'ok' => '1.302181', 'overload' => '1.32', }, @@ -19791,7 +19790,6 @@ sub is_core 'Unicode::Collate::Locale'=> 'cpan', 'Win32' => 'cpan', 'Win32API::File' => 'cpan', - 'Win32API::File::inc::ExtUtils::Myconst2perl'=> 'cpan', 'autodie' => 'cpan', 'autodie::Scope::Guard' => 'cpan', 'autodie::Scope::GuardStack'=> 'cpan', @@ -20220,7 +20218,6 @@ sub is_core 'Unicode::Collate::Locale'=> undef, 'Win32' => 'https://github.com/perl-libwin32/win32/issues', 'Win32API::File' => undef, - 'Win32API::File::inc::ExtUtils::Myconst2perl'=> undef, 'autodie' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', 'autodie::Scope::Guard' => 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', 'autodie::Scope::GuardStack'=> 'http://rt.cpan.org/NoAuth/Bugs.html?Dist=autodie', From f2e5aa2da3e37a8c827b3cf964d88d27a39ebf3e Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Tue, 22 Dec 2020 10:57:59 +0000 Subject: [PATCH 303/503] Update ExtUtils-MakeMaker to CPAN version 7.58 [DELTA] 7.58 Mon 21 Dec 18:16:04 GMT 2020 No changes since v7.57_02 7.57_02 Fri 18 Dec 23:04:09 GMT 2020 Macosx fixes: - Improve dlopen check on MacOS 7.57_01 Fri 18 Dec 13:30:30 GMT 2020 Macosx fixes: - Use dlopen to check for library presence on Mac OS (Big Sur fix) Bug fixes: - check CPAN::Meta::Requirements capabilities rather than prereqs --- Porting/Maintainers.pl | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm | 6 +++++- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm | 7 +++++-- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm | 2 +- .../ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm | 2 +- .../lib/ExtUtils/MakeMaker/version/regex.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm | 2 +- cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm | 2 +- 34 files changed, 42 insertions(+), 35 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 42abcd564366..66330fe4f451 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -466,7 +466,7 @@ package Maintainers; }, 'ExtUtils::MakeMaker' => { - 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.56.tar.gz', + 'DISTRIBUTION' => 'BINGOS/ExtUtils-MakeMaker-7.58.tar.gz', 'FILES' => q[cpan/ExtUtils-MakeMaker], 'EXCLUDED' => [ qr{^t/lib/Test/}, diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm index 7472b41f194b..bce04cccb078 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command.pm @@ -8,7 +8,7 @@ use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION); @ISA = qw(Exporter); @EXPORT = qw(cp rm_f rm_rf mv cat eqtime mkpath touch test_f test_d chmod dos2unix); -$VERSION = '7.56'; +$VERSION = '7.58'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm index a63845ba2dcb..93bddbfd5b98 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Command/MM.pm @@ -10,7 +10,7 @@ our @ISA = qw(Exporter); our @EXPORT = qw(test_harness pod2man perllocal_install uninstall warn_if_old_packlist test_s cp_nonempty); -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; my $Is_VMS = $^O eq 'VMS'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm index afc8a0da1aad..877bffaf3d7d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist.pm @@ -3,7 +3,7 @@ package ExtUtils::Liblist; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use File::Spec; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm index 6861628bc3a3..ef53dbc43be0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Liblist/Kid.pm @@ -11,7 +11,7 @@ use 5.006; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; @@ -174,6 +174,10 @@ sub _unix_os2_ext { && -f ( $fullname = "$thispth/lib$thislib.$Config_dlext" ) ) { } + elsif ( $^O eq 'darwin' && require DynaLoader && defined &DynaLoader::dl_load_file + && DynaLoader::dl_load_file( $fullname = "$thispth/lib$thislib.$so", 0 ) ) + { + } elsif ( -f ( $fullname = "$thispth/$thislib$Config_libext" ) ) { } elsif ( -f ( $fullname = "$thispth/lib$thislib.dll$Config_libext" ) ) { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm index ce15e65df3b8..fc8d1c8a5f82 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM.pm @@ -4,7 +4,7 @@ use strict; use warnings; use ExtUtils::MakeMaker::Config; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::Liblist; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm index 65b2769639f3..b2864e75749c 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_AIX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_AIX; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm index d705baca6067..2f86884ef5b7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Any.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_Any; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use Carp; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm index 655bd9b95e47..9e054f56c0c3 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_BeOS.pm @@ -27,7 +27,7 @@ require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm index c7bf93f17f55..403f052be953 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Cygwin.pm @@ -10,7 +10,7 @@ require ExtUtils::MM_Unix; require ExtUtils::MM_Win32; our @ISA = qw( ExtUtils::MM_Unix ); -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm index ebf2e3682da0..cb6cb650e9e0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_DOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_DOS; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm index 113a2a44f99c..2fed5634c006 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Darwin.pm @@ -8,7 +8,7 @@ BEGIN { our @ISA = qw( ExtUtils::MM_Unix ); } -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm index de2f870e8c7b..8a0bba474433 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_MacOS.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_MacOS; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; sub new { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm index 4bc87f22f3c3..fc35d28a41f6 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_NW5.pm @@ -23,7 +23,7 @@ use warnings; use ExtUtils::MakeMaker::Config; use File::Basename; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm index 970dfb3757bc..da43f6b9a5ed 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS2.pm @@ -6,7 +6,7 @@ use warnings; use ExtUtils::MakeMaker qw(neatvalue); use File::Spec; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm index 7b910ce1aabc..f3e687988651 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_OS390.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_OS390; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use ExtUtils::MakeMaker::Config; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm index 6b63fc3c6802..145a826c38c0 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_QNX.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_QNX; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm index c186ba02de7e..80074c7402ff 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_UWIN.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_UWIN; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm index c9a185994bec..46d457cc2a3b 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Unix.pm @@ -15,7 +15,7 @@ use ExtUtils::MakeMaker qw($Verbose neatvalue _sprintf562); # If we make $VERSION an our variable parse_version() breaks use vars qw($VERSION); -$VERSION = '7.56'; +$VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm index be8bc6790f6a..c0039c8f3bc2 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VMS.pm @@ -16,7 +16,7 @@ BEGIN { use File::Basename; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Any; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm index 3ddc98e9b7c6..08c3a80f5c1f 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_VOS.pm @@ -2,7 +2,7 @@ package ExtUtils::MM_VOS; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Unix; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm index 1d320c758ce7..1fa000bf7dd7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win32.pm @@ -27,7 +27,7 @@ use ExtUtils::MakeMaker qw(neatvalue _sprintf562); require ExtUtils::MM_Any; require ExtUtils::MM_Unix; our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix ); -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; $ENV{EMXSHELL} = 'sh'; # to run `commands` diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm index 9f44c6cfaadc..f17d536958d7 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MM_Win95.pm @@ -3,7 +3,7 @@ package ExtUtils::MM_Win95; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require ExtUtils::MM_Win32; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm index 39f662f41469..a179de921610 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MY.pm @@ -3,7 +3,7 @@ package ExtUtils::MY; use strict; require ExtUtils::MM; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; our @ISA = qw(ExtUtils::MM); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm index efb2c16ee60a..aed2a7487685 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker.pm @@ -25,7 +25,7 @@ my %Recognized_Att_Keys; our %macro_fsentity; # whether a macro is a filesystem name our %macro_dep; # whether a macro is a dependency -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; # Emulate something resembling CVS $Revision$ @@ -426,7 +426,10 @@ sub _has_cpan_meta_requirements { return eval { require CPAN::Meta::Requirements; CPAN::Meta::Requirements->VERSION(2.130); - require B; # CMR requires this, for core we have to too. + # Make sure vstrings can be handled. Some versions of CMR require B to + # do this, which won't be available in miniperl. + CPAN::Meta::Requirements->new->add_string_requirement('Module' => v1.2); + 1; }; } diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm index caa565340bb4..1140a61293ec 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Config.pm @@ -3,7 +3,7 @@ package ExtUtils::MakeMaker::Config; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use Config (); diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod index 4875109f7a29..0dccca320b8e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/FAQ.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::FAQ; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; 1; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm index ccdce22dbb22..d2ca5c695f0d 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Locale.pm @@ -2,7 +2,7 @@ package ExtUtils::MakeMaker::Locale; use strict; use warnings; -our $VERSION = "7.56"; +our $VERSION = "7.58"; $VERSION =~ tr/_//d; use base 'Exporter'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod index 9acaba6e573e..54bf7cb4306f 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/Tutorial.pod @@ -1,6 +1,6 @@ package ExtUtils::MakeMaker::Tutorial; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm index 09b4e3ae6516..72a4ef713828 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version.pm @@ -16,7 +16,7 @@ use warnings; use vars qw(@ISA $VERSION $CLASS $STRICT $LAX *declare *qv); -$VERSION = '7.56'; +$VERSION = '7.58'; $VERSION =~ tr/_//d; $CLASS = 'version'; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm index 5f9b17ccc0fd..6742d98028bc 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/MakeMaker/version/regex.pm @@ -11,7 +11,7 @@ use warnings; use vars qw($VERSION $CLASS $STRICT $LAX); -$VERSION = '7.56'; +$VERSION = '7.58'; $VERSION =~ tr/_//d; #--------------------------------------------------------------------------# diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm index f5ff0832340f..7e7a545e02db 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mkbootstrap.pm @@ -3,7 +3,7 @@ package ExtUtils::Mkbootstrap; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; require Exporter; diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm index b15eb31ef94b..562c9c38e4a1 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/Mksymlists.pm @@ -11,7 +11,7 @@ use Config; our @ISA = qw(Exporter); our @EXPORT = qw(&Mksymlists); -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; sub Mksymlists { diff --git a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm index 1f36f4888971..c4006c29f58e 100644 --- a/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm +++ b/cpan/ExtUtils-MakeMaker/lib/ExtUtils/testlib.pm @@ -3,7 +3,7 @@ package ExtUtils::testlib; use strict; use warnings; -our $VERSION = '7.56'; +our $VERSION = '7.58'; $VERSION =~ tr/_//d; use Cwd; From d4f7ec970b3e468fa723d650fc87974550189f0e Mon Sep 17 00:00:00 2001 From: Karen Etheridge Date: Tue, 22 Dec 2020 11:22:13 -0800 Subject: [PATCH 304/503] do not look for modules under */*/{inc,t} for Module::CoreList this avoids adding the internal modules inc::QuestionList (from perlfaq) or Win32API::File::inc::ExtUtils::Myconst2perl (from Win32API-File) --- Porting/corelist.pl | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/Porting/corelist.pl b/Porting/corelist.pl index 05393c0ada6d..7c75f06d1600 100755 --- a/Porting/corelist.pl +++ b/Porting/corelist.pl @@ -96,6 +96,12 @@ find( sub { + if (-d) { + my @parts = File::Spec->splitdir($File::Find::name); + # be careful not to skip inc::latest + return $File::Find::prune = 1 if @parts == 3 and ($parts[-1] eq 'inc' or $parts[-1] eq 't'); + } + /(\.pm|_pm\.PL)$/ or return; /PPPort\.pm$/ and return; my $module = $File::Find::name; From d296ead16762852ec34d173616a271c856711f77 Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Thu, 17 Dec 2020 17:05:57 +0100 Subject: [PATCH 305/503] Make DynaLoader on MacOS check library existence with dlopen A number of system libraries no longer exist as actual files, even though dlopen will pretend they do, so now we fall back to dlopen if a library file can not be found. --- ext/DynaLoader/DynaLoader_pm.PL | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/ext/DynaLoader/DynaLoader_pm.PL b/ext/DynaLoader/DynaLoader_pm.PL index f68d59aa7ebe..002569f98c74 100644 --- a/ext/DynaLoader/DynaLoader_pm.PL +++ b/ext/DynaLoader/DynaLoader_pm.PL @@ -88,7 +88,7 @@ package DynaLoader; # Tim.Bunce@ig.co.uk, August 1994 BEGIN { - $VERSION = '1.49'; + $VERSION = '1.50'; } EOT @@ -494,12 +494,20 @@ sub dl_findfile { foreach $name (@names) { my($file) = "$dir$dirsep$name"; print STDERR " checking in $dir for $name\n" if $dl_debug; - $file = ($do_expand) ? dl_expandspec($file) : (-f $file && $file); - #$file = _check_file($file); - if ($file) { + if ($do_expand && ($file = dl_expandspec($file))) { + push @found, $file; + next arg; # no need to look any further + } + elsif (-f $file) { push(@found, $file); next arg; # no need to look any further } + <<$^O-eq-darwin>> + elsif (dl_load_file($file, 0)) { + push @found, $file; + next arg; # no need to look any further + } + <> } } } From c389fd835662dedb4c6dcbdabe25c986cb960859 Mon Sep 17 00:00:00 2001 From: Sawyer X Date: Wed, 23 Dec 2020 02:16:01 +0200 Subject: [PATCH 306/503] GH #18163: Stricter, cleaned up test example: (#18165) * GH #18163: Stricter, cleaned up test example: This just adds 'my $i' to make the test pass on strict, and it cleans it up and provides test names for the tests. I kept the tabs that were used. * Use relative path * Indent for readability * Missing variables * Add another reference * Remove '&' in function calls * Add some hints * Normalize quoting in WriteMakeFile examples * Remove explicit quotes * Apply all additional suggestions * replace tabs, make line shorter --- dist/ExtUtils-ParseXS/lib/perlxstut.pod | 119 ++++++++++++++---------- 1 file changed, 71 insertions(+), 48 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/perlxstut.pod b/dist/ExtUtils-ParseXS/lib/perlxstut.pod index f9fe9e76fe90..8e1372167073 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxstut.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxstut.pod @@ -115,14 +115,15 @@ Mytest directory. The file Makefile.PL should look something like this: use ExtUtils::MakeMaker; + # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( - NAME => 'Mytest', - VERSION_FROM => 'Mytest.pm', # finds $VERSION - LIBS => [''], # e.g., '-lm' - DEFINE => '', # e.g., '-DHAVE_SOMETHING' - INC => '', # e.g., '-I/usr/include/other' + NAME => 'Mytest', + VERSION_FROM => 'Mytest.pm', # finds $VERSION + LIBS => [''], # e.g., '-lm' + DEFINE => '', # e.g., '-DHAVE_SOMETHING' + INC => '-I', # e.g., '-I. -I/usr/include/other' ); The file Mytest.pm should start with something like this: @@ -276,9 +277,9 @@ when the test is correct, "not ok" when it is not. # so read its man page ( perldoc Test::More ) for help writing this # test script. - is(&Mytest::is_even(0), 1); - is(&Mytest::is_even(1), 0); - is(&Mytest::is_even(2), 1); + is( Mytest::is_even(0), 1 ); + is( Mytest::is_even(1), 0 ); + is( Mytest::is_even(2), 1 ); We will be calling the test script through the command "C". You should see output that looks something like this: @@ -390,16 +391,32 @@ Add the following to the end of Mytest.xs: Edit the Makefile.PL file so that the corresponding line looks like this: - 'LIBS' => ['-lm'], # e.g., '-lm' + LIBS => ['-lm'], # e.g., '-lm' Generate the Makefile and run make. Change the test number in Mytest.t to "9" and add the following tests: - $i = -1.5; &Mytest::round($i); is( $i, -2.0 ); - $i = -1.1; &Mytest::round($i); is( $i, -1.0 ); - $i = 0.0; &Mytest::round($i); is( $i, 0.0 ); - $i = 0.5; &Mytest::round($i); is( $i, 1.0 ); - $i = 1.2; &Mytest::round($i); is( $i, 1.0 ); + my $i; + + $i = -1.5; + Mytest::round($i); + is( $i, -2.0, 'Rounding -1.5 to -2.0' ); + + $i = -1.1; + Mytest::round($i); + is( $i, -1.0, 'Rounding -1.1 to -1.0' ); + + $i = 0.0; + Mytest::round($i); + is( $i, 0.0, 'Rounding 0.0 to 0.0' ); + + $i = 0.5; + Mytest::round($i); + is( $i, 1.0, 'Rounding 0.5 to 1.0' ); + + $i = 1.2; + Mytest::round($i); + is( $i, 1.0, 'Rounding 1.2 to 1.0' ); Running "C" should now print out that all nine tests are okay. @@ -407,7 +424,7 @@ Notice that in these new test cases, the argument passed to round was a scalar variable. You might be wondering if you can round a constant or literal. To see what happens, temporarily add the following line to Mytest.t: - &Mytest::round(3); + Mytest::round(3); Run "C" and notice that Perl dies with a fatal error. Perl won't let you change the value of constants! @@ -534,7 +551,7 @@ In the mylib directory, create a file mylib.h that looks like this: Also create a file mylib.c that looks like this: #include - #include "./mylib.h" + #include "mylib.h" double foo(int a, long b, const char *c) @@ -547,9 +564,9 @@ And finally create a file Makefile.PL that looks like this: use ExtUtils::MakeMaker; $Verbose = 1; WriteMakefile( - NAME => 'Mytest2::mylib', - SKIP => [qw(all static static_lib dynamic dynamic_lib)], - clean => {'FILES' => 'libmylib$(LIB_EXT)'}, + NAME => 'Mytest2::mylib', + SKIP => [qw(all static static_lib dynamic dynamic_lib)], + clean => {'FILES' => 'libmylib$(LIB_EXT)'}, ); @@ -576,7 +593,7 @@ on Win32 systems. We will now create the main top-level Mytest2 files. Change to the directory above Mytest2 and run the following command: - % h2xs -O -n Mytest2 ./Mytest2/mylib/mylib.h + % h2xs -O -n Mytest2 Mytest2/mylib/mylib.h This will print out a warning about overwriting Mytest2, but that's okay. Our files are stored in Mytest2/mylib, and will be untouched. @@ -587,12 +604,12 @@ will be generating a library in it. Let's add the argument MYEXTLIB to the WriteMakefile call so that it looks like this: WriteMakefile( - 'NAME' => 'Mytest2', - 'VERSION_FROM' => 'Mytest2.pm', # finds $VERSION - 'LIBS' => [''], # e.g., '-lm' - 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' - 'INC' => '', # e.g., '-I/usr/include/other' - 'MYEXTLIB' => 'mylib/libmylib$(LIB_EXT)', + NAME => 'Mytest2', + VERSION_FROM => 'Mytest2.pm', # finds $VERSION + LIBS => [''], # e.g., '-lm' + DEFINE => '', # e.g., '-DHAVE_SOMETHING' + INC => '', # e.g., '-I/usr/include/other' + MYEXTLIB => 'mylib/libmylib$(LIB_EXT)', ); and then at the end add a subroutine (which will override the pre-existing @@ -606,9 +623,7 @@ with "cd"! '; } -Let's also fix the MANIFEST file so that it accurately reflects the contents -of our extension. The single line that says "mylib" should be replaced by -the following three lines: +Let's also fix the MANIFEST file by appending the following three lines: mylib/Makefile.PL mylib/mylib.c @@ -642,12 +657,12 @@ Now run perl on the top-level Makefile.PL. Notice that it also created a Makefile in the mylib directory. Run make and watch that it does cd into the mylib directory and run make in there as well. -Now edit the Mytest2.t script and change the number of tests to "4", +Now edit the Mytest2.t script and change the number of tests to "5", and add the following lines to the end of the script: - is( &Mytest2::foo(1, 2, "Hello, world!"), 7 ); - is( &Mytest2::foo(1, 2, "0.0"), 7 ); - ok( abs(&Mytest2::foo(0, 0, "-3.4") - 0.6) <= 0.01 ); + is( Mytest2::foo( 1, 2, "Hello, world!" ), 7 ); + is( Mytest2::foo( 1, 2, "0.0" ), 7 ); + ok( abs( Mytest2::foo( 0, 0, "-3.4" ) - 0.6 ) <= 0.01 ); (When dealing with floating-point comparisons, it is best to not check for equality, but rather that the difference between the expected and actual @@ -1017,9 +1032,12 @@ after the include of "XSUB.h": Also add the following code segment to Mytest.t while incrementing the "9" tests to "11": - @a = &Mytest::statfs("/blech"); + my @a; + + @a = Mytest::statfs("/blech"); ok( scalar(@a) == 1 && $a[0] == 2 ); - @a = &Mytest::statfs("/"); + + @a = Mytest::statfs("/"); is( scalar(@a), 7 ); =head2 New Things in this Example @@ -1152,7 +1170,7 @@ Mytest.xs: And add the following code to Mytest.t, while incrementing the "11" tests to "13": - $results = Mytest::multi_statfs([ '/', '/blech' ]); + my $results = Mytest::multi_statfs([ '/', '/blech' ]); ok( ref $results->[0] ); ok( ! ref $results->[1] ); @@ -1246,21 +1264,24 @@ typeglobs and stuff. Well, it isn't. Suppose that for some strange reason we need a wrapper around the standard C library function C. This is all we need: - #define PERLIO_NOT_STDIO 0 - #define PERL_NO_GET_CONTEXT - #include "EXTERN.h" - #include "perl.h" - #include "XSUB.h" + #define PERLIO_NOT_STDIO 0 /* For co-existence with stdio only */ + #define PERL_NO_GET_CONTEXT /* This is more efficient */ + #include "EXTERN.h" + #include "perl.h" + #include "XSUB.h" - #include + #include - int - fputs(s, stream) - char * s - FILE * stream + int + fputs(s, stream) + char * s + FILE * stream The real work is done in the standard typemap. +For more details, see +L. + B you lose all the fine stuff done by the perlio layers. This calls the stdio function C, which knows nothing about them. @@ -1382,7 +1403,7 @@ Some systems may have installed Perl version 5 as "perl5". =head1 See also For more information, consult L, L, L, L, -and L. +L, and L =head1 Author @@ -1396,6 +1417,8 @@ by Nick Ing-Simmons. Changes for h2xs as of Perl 5.8.x by Renee Baecker +This document is now maintained as part of Perl itself. + =head2 Last Changed -2012-01-20 +2020-10-05 From 150d2b0b3a4665f34c3168e835bf777bdda060da Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Thu, 10 Dec 2020 14:41:41 +0000 Subject: [PATCH 307/503] Remove workaround for distros needing dot in @INC In commit 19641fd71a (Apr 07 2017), as part of ceasing to pass '.' to @INC in tests, we added a workaround to t/TEST for CPAN distributions which ship with core which were not yet fully adapted to the new regulation on @INC. All such CPAN distributions have now been adapted. Hence, we can remove the workaround. --- t/TEST | 13 ------------- 1 file changed, 13 deletions(-) diff --git a/t/TEST b/t/TEST index d011d1263c56..11e672f76caf 100755 --- a/t/TEST +++ b/t/TEST @@ -76,16 +76,6 @@ my %temp_no_core = ( '../dist/Unicode-Normalize' => 1, ); -# temporary workaround Apr 2017. These need '.' in @INC. -# Ideally this # list will eventually be empty - -my %temp_needs_dot = map { $_ => 1 } qw( - ../cpan/Filter-Util-Call - ../cpan/libnet - ../cpan/Test-Simple -); - - # delete env vars that may influence the results # but allow override via *_TEST env var if wanted # (e.g. PERL5OPT_TEST=-d:NYTProf) @@ -255,9 +245,6 @@ sub _scan_test { if ($temp_no_core{$run_dir}) { $testswitch = $testswitch . ',NC'; } - if($temp_needs_dot{$run_dir}) { - $testswitch = $testswitch . ',DOT'; - } } } elsif ($test =~ m!^\.\./lib!) { $testswitch = '-I.. -MTestInit=U1'; # -T will remove . from @INC From 08be3ef7f1190d94279ad0b3e13519ac8dc3b0ec Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 8 Dec 2020 14:28:29 +1100 Subject: [PATCH 308/503] skip trying to constant fold an incomplete op tree This code would try to constant fold an op tree like relop +- null +- constant which would underflow the stack, potentially crashing perl. This is intended as a quick fix rather than as a complete solution. Fixes #18380 --- op.c | 2 +- t/op/cmpchain.t | 17 ++++++++++------- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/op.c b/op.c index 822ea18a5b6a..b2e12dd0c0c0 100644 --- a/op.c +++ b/op.c @@ -5591,7 +5591,7 @@ Perl_cmpchain_finish(pTHX_ OP *ch) cmpop->op_private = 2; cmpop = CHECKOP(cmpoptype, cmpop); if(!cmpop->op_next && cmpop->op_type == cmpoptype) - cmpop = fold_constants(op_integerize(op_std_init(cmpop))); + cmpop = op_integerize(op_std_init(cmpop)); condop = condop ? newLOGOP(OP_CMPCHAIN_AND, 0, cmpop, condop) : cmpop; if (!nextrightarg) diff --git a/t/op/cmpchain.t b/t/op/cmpchain.t index 92a2f4133df7..236d5f9a8303 100644 --- a/t/op/cmpchain.t +++ b/t/op/cmpchain.t @@ -14,13 +14,6 @@ my @nceqop = qw(<=> cmp ~~); my @chrelop = qw(< > <= >= lt gt le ge); my @ncrelop = qw(isa); -plan tests => @nceqop*@nceqop + 2*@cheqop*@nceqop + 2*@cheqop*@cheqop*@nceqop + - @ncrelop*@ncrelop + 2*@chrelop*@ncrelop + 2*@chrelop*@chrelop*@ncrelop + - - @cheqop*@cheqop + @chrelop*@chrelop + - @cheqop*@cheqop*@cheqop + @chrelop*@chrelop*@chrelop + - (9 + 6*9)*13; - foreach my $c0 (@nceqop) { foreach my $c1 (@nceqop) { is eval("sub { \$a $c0 \$b $c1 \$c }"), undef, @@ -168,3 +161,13 @@ foreach( "operand evaluation order"; } } + +# https://github.com/Perl/perl5/issues/18380 +fresh_perl_is(<<'CODE', "", {}, "stack underflow"); +no warnings "uninitialized"; +my $v; +1 < $v < 2; +2 < $v < 3; +CODE + +done_testing(); From 3ba9bc53be8a9aa29f1b8cdace189e92045bc08f Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 19 Dec 2020 19:24:05 -0500 Subject: [PATCH 309/503] Porting/pod_rules.pl: no '--test' command-line switch As is illustrated by the following (trimmed) invocation: ./perl -Ilib Porting/pod_rules.pl --test Unknown option: test ... there is no '--test' option available for this program. Remove inaccurate inline documentation. In partial satisfaction of https://github.com/Perl/perl5/issues/18413. --- Porting/pod_rules.pl | 2 -- 1 file changed, 2 deletions(-) diff --git a/Porting/pod_rules.pl b/Porting/pod_rules.pl index 2ba023ba7c9d..73efc3e60754 100644 --- a/Porting/pod_rules.pl +++ b/Porting/pod_rules.pl @@ -18,8 +18,6 @@ # --build-all tries to build everything # --build-foo updates foo as follows # --showfiles shows the files to be changed -# --test exit if perl.pod, MANIFEST are consistent, and regenerated -# files are up to date, die otherwise. %Targets = ( manifest => 'MANIFEST', From 76f5a288f2bc83951c2de04136d1d4a1080c6303 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 19 Dec 2020 21:03:07 -0500 Subject: [PATCH 310/503] Better documentation for two Porting/*.pl programs In partial satisfaction of https://github.com/Perl/perl5/issues/18413. --- Porting/manifest_lib.pl | 2 ++ Porting/pod_lib.pl | 47 +++++++++++++++++++++++++++++++++++++---- 2 files changed, 45 insertions(+), 4 deletions(-) diff --git a/Porting/manifest_lib.pl b/Porting/manifest_lib.pl index 0b63046056e6..6232c05851a8 100644 --- a/Porting/manifest_lib.pl +++ b/Porting/manifest_lib.pl @@ -12,6 +12,8 @@ =head1 SYNOPSIS =head1 DESCRIPTION +This file makes available one function, C. + =head2 C Treats its arguments as (chomped) lines from a MANIFEST file, and returns that diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl index 097d96f2627b..3e6483732333 100644 --- a/Porting/pod_lib.pl +++ b/Porting/pod_lib.pl @@ -176,28 +176,57 @@ =head2 C =item * Purpose -Verify that a file contains exactly one contiguous run of lines which matches -the passed in pattern. Cs if the pattern is not found, or found in -more than one place. +Verify that a makefile or makefile constructor contains exactly one contiguous +run of lines which matches a given pattern. Cs if the pattern is not +found, or found in more than one place. + +By "makefile or makefile constructor" we mean a file which is one of the +right-hand values in this list of key-value pairs: + + manifest => 'MANIFEST', + vms => 'vms/descrip_mms.template', + nmake => 'win32/Makefile', + dmake => 'win32/makefile.mk', + gmake => 'win32/GNUmakefile', + podmak => 'win32/pod.mak', + unix => 'Makefile.SH', + +(Currently found in C<%Targets> in F.) =item * Arguments =over 4 -=item * Name of file +=item * Name of target + +String holding the key of one element in C<%Targets> in F. =item * Contents of file +String holding slurped contents of the file named in the value of the element +in C<%Targets> in F named in the first argument. + =item * Pattern of interest +Compiled regular expression pertinent to a particular makefile constructor. + =item * Name to report on error +String holding description. + =back =item * Return Value The contents of the file, with C substituted for the pattern. +=item * Example (drawn from F C): + + my $makefile_SH = slurp_or_die('./Makefile.SH'); + my $re = qr/some\s+pattern/; + my $makefile_SH_out = + verify_contiguous('unix', $makefile_SH, $re, 'copy rules'); + =back =cut @@ -521,6 +550,8 @@ =head2 C =item * Purpose +Create a data structure holding information about files containing text in POD format. + =item * Arguments List of one or more arguments. @@ -565,6 +596,14 @@ =head2 C 'copies' => { # patch version perldelta => minor version perldelta } +=item * Comment + +Instances where this subroutine is used may be found in these files: + + pod/buildtoc + Porting/new-perldelta.pl + Porting/pod_rules.pl + =back =cut From 961cdb3cdc9172ffa7b739123059cfb43034e6a8 Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Thu, 1 Oct 2020 23:58:48 +0100 Subject: [PATCH 311/503] Add test harness for regexp optimization --- MANIFEST | 1 + t/re/opt.t | 208 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 209 insertions(+) create mode 100644 t/re/opt.t diff --git a/MANIFEST b/MANIFEST index 014f2f6ba61d..1d334a514cb6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6041,6 +6041,7 @@ t/re/fold_grind_T.t Wrapper for fold_grind.pl for /l testing with a Turkic loca t/re/fold_grind_u.t Wrapper for fold_grind.pl for /u testing t/re/keep_tabs.t Tests where \t can't be expanded. t/re/no_utf8_pm.t Verify utf8.pm doesn't get loaded unless required +t/re/opt.t Test regexp optimizations t/re/overload.t Test against string corruption in pattern matches on overloaded objects t/re/pat.t See if esoteric patterns work t/re/pat_advanced.t See if advanced esoteric patterns work diff --git a/t/re/opt.t b/t/re/opt.t new file mode 100644 index 000000000000..68dca2701bf8 --- /dev/null +++ b/t/re/opt.t @@ -0,0 +1,208 @@ +#!./perl +# +# ex: set ts=8 sts=4 sw=4 et: +# +# Here we test for optimizations in the regexp engine. +# We try to distinguish between "nice to have" optimizations and those +# we consider essential: failure of the latter should be considered bugs, +# while failure of the former should at worst be TODO. +# +# Format of data lines is tab-separated: pattern, minlen, anchored, floating, +# other-options, comment. +# - pattern will be subject to string eval as "qr{$pattern}". +# - minlen is a non-negative integer. +# - anchored/floating are of the form "u23:45+string". If initial "u" is +# present we expect a utf8 substring, else a byte substring; subsequent +# digits are the min offset; optional /:\d+/ is the max offset (not +# supported for anchored; assumed undef if not present for floating); +# subsequent '-' or '+' indicates if this is the substring being checked; +# "string" is the substring to expect. Use "-" for the whole entry to +# indicate no substring of this type. +# - other-options is a comma-separated list of bare flags or option=value +# strings. Those with an initial "T" mark the corresponding test TODO. +# Booleans (noscan, isall, skip, implicit, anchor SBOL, anchor MBOL, +# anchor GPOS) are expected false if not mentioned, expected true if +# supplied as bare flags. stclass may be supplied as a pattern match +# as eg "stclass=~^ANYOF". +# - as a special-case, minlenret is expected to be the same as minlen +# unless specified in other-options. +# + +use strict; +use warnings; +use 5.010; + +$| = 1; + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc('../lib'); + skip_all_if_miniperl("no dynamic loading on miniperl, no re::optimization"); +} + +no warnings qw{ experimental }; +use feature qw{ refaliasing declared_refs }; +our \$TODO = \$::TODO; + +plan tests => 104; + +use re (); + +while () { + chomp; + my($pat, $minlen, $anchored, $floating, $other, $comment) = split /\t/; + my %todo; + my %opt = map { + my($k, $v) = split /=/, $_, 2; + ($k =~ s/^T//) ? do { $todo{$k} = $v; () } : ($k => $v); + } split /,/, $other // ''; + $comment = (defined $comment && length $comment) + ? "$pat ($comment):" + : "$pat:"; + + my $o = re::optimization(eval "qr{$pat}"); + ok($o, "$comment compiled ok"); + + my $skip = !$o; + my $test = 0; + + my($got, $expect) = ($o->{minlen}, $minlen); + if (exists $todo{minlen}) { + ++$test; + $skip || ok($got >= $expect, "$comment minlen $got >= $expect"); + my $todo = $todo{minlen}; + local $TODO = 1; + $skip || is($got, $todo, "$comment minlen $got = $todo"); + } else { + ++$test; + $skip || is($got, $expect, "$comment minlen $got = $expect"); + } + + ($got, $expect) = ($o->{minlenret}, $opt{minlenret} // $minlen); + if (exists $todo{minlenret}) { + ++$test; + $skip || ok($got >= $expect, "$comment minlenret $got >= $expect"); + my $todo = $todo{minlenret}; + local $TODO = 1; + $skip || is($got, $todo, "$comment minlenret $got = $todo"); + } else { + ++$test; + $skip || is($got, $expect, "$comment minlenret $got = $expect"); + } + + my($autf, $aoff, $acheck, $astr) = ($anchored =~ m{ + ^ (u?) (\d*) ([-+]) (.*) \z + }sx) or die "Can't parse anchored test '$anchored'"; + if ($autf eq 'u') { + ++$test; + $skip || is($o->{anchored}, undef, "$comment no anchored"); + ++$test; + local $TODO = 1 if exists $todo{'anchored utf8'}; + $skip || is($o->{'anchored utf8'}, $astr, "$comment got anchored utf8"); + } elsif (length $astr) { + ++$test; + $skip || is($o->{anchored_utf8}, undef, "$comment no anchored utf8"); + ++$test; + local $TODO = 1 if exists $todo{anchored}; + $skip || is($o->{anchored}, $astr, "$comment got anchored"); + } else { + ++$test; + $skip || is($o->{anchored}, undef, "$comment no anchored"); + ++$test; + $skip || is($o->{anchored_utf8}, undef, "$comment no anchored utf8"); + } + if (length $aoff) { + ++$test; + local $TODO = 1 if exists $todo{'anchored min offset'}; + $skip || is($o->{'anchored min offset'}, $aoff, + "$comment anchored min offset"); + # we don't care about anchored max: it may be set same as min or 0 + } + + my($futf, $fmin, $fmax, $fcheck, $fstr) = ($floating =~ m{ + ^ (u?) (\d*) (?: : (\d*) )? ([-+]) (.*) \z + }sx) or die "Can't parse floating test '$floating'"; + if ($futf eq 'u') { + ++$test; + $skip || is($o->{floating}, undef, "$comment no floating"); + ++$test; + local $TODO = 1 if exists $todo{'floating utf8'}; + $skip || is($o->{'floating utf8'}, $fstr, "$comment got floating utf8"); + } elsif (length $fstr) { + ++$test; + $skip || is($o->{floating_utf8}, undef, "$comment no floating utf8"); + ++$test; + local $TODO = 1 if exists $todo{floating}; + $skip || is($o->{floating}, $fstr, "$comment got floating"); + } else { + ++$test; + $skip || is($o->{floating}, undef, "$comment no floating"); + ++$test; + $skip || is($o->{floating_utf8}, undef, "$comment no floating utf8"); + } + if (length $fmin) { + ++$test; + local $TODO = 1 if exists $todo{'floating min offset'}; + $skip || is($o->{'floating min offset'}, $fmin, + "$comment floating min offset"); + } + if (defined $fmax) { + ++$test; + local $TODO = 1 if exists $todo{'floating max offset'}; + $skip || is($o->{'floating max offset'}, $fmax, + "$comment floating min offset"); + } + + my $check = ($acheck eq '+') ? 'anchored' + : ($fcheck eq '+') ? 'floating' + : ($acheck eq '-') ? undef + : 'none'; + if (defined $check) { + ++$test; + local $TODO = 1 if exists $todo{checking}; + $skip || is($o->{checking}, $check, "$comment checking $check"); + } + + # booleans + for (qw{ noscan isall skip implicit }, + 'anchor SBOL', 'anchor MBOL', 'anchor GPOS' + ) { + my $got = $o->{$_}; + my $expect = exists($opt{$_}) ? ($opt{$_} // 1) : 0; + ++$test; + local $TODO = 1 if exists $todo{"T$_"}; + $skip || is($got, $expect ? 1 : 0, "$comment $_"); + } + + # integer + for (qw{ gofs }) { + my $got = $o->{$_}; + my $expect = $opt{$_} // 0; + ++$test; + local $TODO = 1 if exists $todo{"T$_"}; + $skip || is($got, $expect || 0, "$comment $_"); + } + + # string + for (qw{ stclass }) { + my $got = $o->{$_}; + my $expect = $opt{$_}; + my $qr = (defined($expect) && ($expect =~ s{^~}{})) ? 1 : 0; + ++$test; + local $TODO = 1 if exists $todo{"T$_"}; + $skip || ($qr + ? like($got, qr{$expect}, "$comment $_") + : is($got, $expect, "$comment $_") + ); + } + + skip($test) if $skip; +} +__END__ + 0 - - +abc 3 +abc - isall +(?=abc) 0 - - Tminlen=3,minlenret=0 +a(b){2,3}c 4 -abb 1+bbc +a(b|bb)c 3 -ab 1+bc Tfloating,Tfloating min offset,Tchecking +a(b|bb){2}c 4 -abb 1+bbc Tanchored,Tfloating,Tfloating min offset From fb67667549e18bb42e118c2d07aa4607e926cd6d Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Fri, 13 Nov 2020 15:18:31 +0000 Subject: [PATCH 312/503] Allow comments in regexp optimization tests --- t/re/opt.t | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/t/re/opt.t b/t/re/opt.t index 68dca2701bf8..01ac6e36a66c 100644 --- a/t/re/opt.t +++ b/t/re/opt.t @@ -51,6 +51,10 @@ use re (); while () { chomp; + if (m{^\s*(?:#|\z)}) { + # skip blank/comment lines + next; + } my($pat, $minlen, $anchored, $floating, $other, $comment) = split /\t/; my %todo; my %opt = map { From 2c6e5439c9a9b5286c617de96af39e5fd3fc3ea5 Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Fri, 13 Nov 2020 16:13:52 +0000 Subject: [PATCH 313/503] No plan for regexp optimization tests With a varying number of tests per data line, the plan is too much work to maintain. --- t/re/opt.t | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/t/re/opt.t b/t/re/opt.t index 01ac6e36a66c..e37f9f604377 100644 --- a/t/re/opt.t +++ b/t/re/opt.t @@ -45,8 +45,6 @@ no warnings qw{ experimental }; use feature qw{ refaliasing declared_refs }; our \$TODO = \$::TODO; -plan tests => 104; - use re (); while () { @@ -203,6 +201,7 @@ while () { skip($test) if $skip; } +done_testing(); __END__ 0 - - abc 3 +abc - isall From e1b0ee053aef77aaae7ebd435aaece3cdfd08e6c Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Fri, 13 Nov 2020 16:15:10 +0000 Subject: [PATCH 314/503] Better skipping for regexp optimization tests Say why we're skipping; skip min/max tests for substrings if we didn't get the substring; skip checking test for substrings if we didn't get the substring we expect to be checked. --- t/re/opt.t | 54 +++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 41 insertions(+), 13 deletions(-) diff --git a/t/re/opt.t b/t/re/opt.t index e37f9f604377..24a3dc0e676e 100644 --- a/t/re/opt.t +++ b/t/re/opt.t @@ -66,7 +66,7 @@ while () { my $o = re::optimization(eval "qr{$pat}"); ok($o, "$comment compiled ok"); - my $skip = !$o; + my $skip = $o ? undef : "could not get info for qr{$pat}"; my $test = 0; my($got, $expect) = ($o->{minlen}, $minlen); @@ -114,11 +114,18 @@ while () { ++$test; $skip || is($o->{anchored_utf8}, undef, "$comment no anchored utf8"); } + # skip offset checks if we failed to find a string + my $local_skip = ( + !$skip && !defined($o->{anchored} // $o->{anchored_utf8}) + ) ? 'no anchored string' : undef; if (length $aoff) { ++$test; - local $TODO = 1 if exists $todo{'anchored min offset'}; - $skip || is($o->{'anchored min offset'}, $aoff, - "$comment anchored min offset"); + SKIP: { + skip($local_skip) if $local_skip; + local $TODO = 1 if exists $todo{'anchored min offset'}; + $skip || is($o->{'anchored min offset'}, $aoff, + "$comment anchored min offset"); + } # we don't care about anchored max: it may be set same as min or 0 } @@ -143,27 +150,48 @@ while () { ++$test; $skip || is($o->{floating_utf8}, undef, "$comment no floating utf8"); } + # skip offset checks if we failed to find a string + $local_skip = ( + !$skip && !defined($o->{floating} // $o->{floating_utf8}) + ) ? 'no floating string' : undef; if (length $fmin) { ++$test; - local $TODO = 1 if exists $todo{'floating min offset'}; - $skip || is($o->{'floating min offset'}, $fmin, - "$comment floating min offset"); + SKIP: { + skip($local_skip) if $local_skip; + local $TODO = 1 if exists $todo{'floating min offset'}; + $skip || is($o->{'floating min offset'}, $fmin, + "$comment floating min offset"); + } } if (defined $fmax) { ++$test; - local $TODO = 1 if exists $todo{'floating max offset'}; - $skip || is($o->{'floating max offset'}, $fmax, - "$comment floating min offset"); + SKIP: { + skip($local_skip) if $local_skip; + local $TODO = 1 if exists $todo{'floating max offset'}; + $skip || is($o->{'floating max offset'}, $fmax, + "$comment floating max offset"); + } } my $check = ($acheck eq '+') ? 'anchored' : ($fcheck eq '+') ? 'floating' : ($acheck eq '-') ? undef : 'none'; + $local_skip = ( + !$skip && $check && ( + ($check eq 'anchored' + && !defined($o->{anchored} // $o->{anchored_utf8})) + || ($check eq 'floating' + && !defined($o->{floating} // $o->{floating_utf8})) + ) + ) ? "$check not found" : undef; if (defined $check) { ++$test; - local $TODO = 1 if exists $todo{checking}; - $skip || is($o->{checking}, $check, "$comment checking $check"); + SKIP: { + skip($local_skip) if $local_skip; + local $TODO = 1 if exists $todo{checking}; + $skip || is($o->{checking}, $check, "$comment checking $check"); + } } # booleans @@ -199,7 +227,7 @@ while () { ); } - skip($test) if $skip; + skip($skip, $test) if $skip; } done_testing(); __END__ From 36ff5b942287220554d8420d38416c4a7b06c17d Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Sat, 14 Nov 2020 12:42:31 +0000 Subject: [PATCH 315/503] Test regexp optimizations for substrings --- t/re/opt.t | 41 ++++++++++++++++++++++++++++++++++++----- 1 file changed, 36 insertions(+), 5 deletions(-) diff --git a/t/re/opt.t b/t/re/opt.t index 24a3dc0e676e..802fdcaaad14 100644 --- a/t/re/opt.t +++ b/t/re/opt.t @@ -231,9 +231,40 @@ while () { } done_testing(); __END__ - 0 - - -abc 3 +abc - isall -(?=abc) 0 - - Tminlen=3,minlenret=0 +(?:) 0 - - Tisall + +# various forms of anchored substring +abc 3 0+abc - isall +.{10}abc 13 10+abc - - +(?i:)abc 3 0+abc - isall +a(?:)bc 3 0+abc - isall +a()bc 3 0+abc - - +a(?i:)bc 3 0+abc - isall +a(b)c 3 0+abc - - +a((?i:b))c 3 0+abc - Tanchored +a[bB]c 3 0+abc - Tanchored +(?=abc) 0 0+abc - Tanchored,Tminlen=3,minlenret=0 +abc|abc 3 0+abc - isall +abcd|abce 4 0+abc - - +acde|bcde 4 1+cde - Tanchored,stclass=~[ab] +acdef|bcdeg 5 1+cde - Tanchored,stclass=~[ab] + +# same as above, floating +.?abc 3 - 0:1+abc - +.?.{10}abc 13 - 10:11+abc - +.?(?i:)abc 3 - 0:1+abc - +.?a(?:)bc 3 - 0:1+abc - +.?a()bc 3 - 0:1+abc - +.?a(?i:)bc 3 - 0:1+abc - +.?a(b)c 3 - 0+abc - +.?a((?i:b))c 3 - 0+abc Tfloating +.?a[bB]c 3 - 0:1+abc Tfloating +.?(?=abc) 0 - 0:1+abc Tfloating,Tminlen=3,minlenret=0 +.?(?:abc|abc) 3 - 0:1+abc - +.?(?:abcd|abce) 4 - 0:1+abc - +.?(?:acde|bcde) 4 - 1:2+cde Tfloating +.?(?:acdef|bcdeg) 5 - 1:2+cde Tfloating + a(b){2,3}c 4 -abb 1+bbc -a(b|bb)c 3 -ab 1+bc Tfloating,Tfloating min offset,Tchecking -a(b|bb){2}c 4 -abb 1+bbc Tanchored,Tfloating,Tfloating min offset +a(b|bb)c 3 -ab 1-bc Tfloating,Tfloating min offset +a(b|bb){2}c 4 -abb 1-bbc Tanchored,Tfloating,Tfloating min offset From 9f9c5d81a615222775dcd39d9f6e281fcd3bdd1a Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Thu, 24 Dec 2020 11:32:49 -0500 Subject: [PATCH 316/503] pod_rules.pl: document (in a comment) --tap --- Porting/pod_rules.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/Porting/pod_rules.pl b/Porting/pod_rules.pl index 73efc3e60754..434f1fd35af8 100644 --- a/Porting/pod_rules.pl +++ b/Porting/pod_rules.pl @@ -18,6 +18,7 @@ # --build-all tries to build everything # --build-foo updates foo as follows # --showfiles shows the files to be changed +# --tap emit TAP (testing) output describing the state of the pod files %Targets = ( manifest => 'MANIFEST', From 387608880ebf5408efb63a7fbd36309dd17758d8 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Thu, 24 Dec 2020 08:41:13 -0600 Subject: [PATCH 317/503] Don't define Perl_regcurly in re extension This makes the linker have to decide (or guess) which of the identically-named symbols to include. The VMS linker refuses and throws a multiply-defined symbol error. --- regcomp.c | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/regcomp.c b/regcomp.c index d2433a4df190..eb891a040207 100644 --- a/regcomp.c +++ b/regcomp.c @@ -12544,6 +12544,7 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) - regcurly - a little FSA that accepts {\d+,?\d*} Pulled from reg.c. */ +#ifndef PERL_IN_XSUB_RE bool Perl_regcurly(const char *s) { @@ -12563,7 +12564,7 @@ Perl_regcurly(const char *s) return *s == '}'; } - +#endif /* - regpiece - something followed by possible quantifier * + ? {n,m} * From 9eebd4ca7bb8610f51a27d96c12e9b1676958d55 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Thu, 24 Dec 2020 08:48:47 -0600 Subject: [PATCH 318/503] Fix Time::HiRes compile probe on VMS The probe was checking the severity bits of the compiler exit status and requiring the value to be 1, which is what they are for SS$_NORMAL. But actually any true (odd) value is considered successful. So, for example, if the compile succeeds but emits "informational messages" that do not rise to the level of warnings or errors, the severity bits have a value of 3, not 1. The probe should not fail (and end up halting the build) in this case, so allow any successful value. --- Porting/Maintainers.pl | 3 +++ dist/Time-HiRes/Makefile.PL | 2 +- t/porting/customized.dat | 1 + 3 files changed, 5 insertions(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 66330fe4f451..ed248761c728 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1206,6 +1206,9 @@ package Maintainers; 'Time::HiRes' => { 'DISTRIBUTION' => 'ATOOMIC/Time-HiRes-1.9764.tar.gz', 'FILES' => q[dist/Time-HiRes], + 'CUSTOMIZED' => [ + qw( Makefile.PL ), + ], }, 'Time::Local' => { diff --git a/dist/Time-HiRes/Makefile.PL b/dist/Time-HiRes/Makefile.PL index c918cd14545b..0c01fc03e8ac 100644 --- a/dist/Time-HiRes/Makefile.PL +++ b/dist/Time-HiRes/Makefile.PL @@ -88,7 +88,7 @@ __EOD__ open( CMDFILE, '>', "$tmp.com" ); print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; print CMDFILE "\$ $cccmd\n"; - print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate + print CMDFILE "\$ IF .NOT. \$SEVERITY THEN EXIT 44\n"; # escalate close CMDFILE; system("\@ $tmp.com"); $ok = $?==0; diff --git a/t/porting/customized.dat b/t/porting/customized.dat index bf97579afee5..c90372da1388 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -22,6 +22,7 @@ Net::Ping dist/Net-Ping/t/500_ping_icmp.t 3eeb60181c01b85f876bd6658644548fdf2e24 Net::Ping dist/Net-Ping/t/501_ping_icmpv6.t 54373de5858f8fb7e078e4998a4b3b8dbca91783 Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm 582be34c077c9ff44d99914724a0cc2140bcd48c Test::Harness cpan/Test-Harness/t/source.t aaa3939591114c0c52ecd44159218336d1f762b9 +Time::HiRes dist/Time-HiRes/Makefile.PL a8c1da5ec1672780e453304925ee0615b422c61f Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5 experimental cpan/experimental/t/basic.t cb9da8dd05b854375809872a05dd32637508d5da From 3e793456f290720aae56fa4de27535046ea3f467 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 24 Dec 2020 18:09:13 -0700 Subject: [PATCH 319/503] newSVsv_flags is now documented --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 51bcf589b425..1d012ed32a95 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1496,7 +1496,7 @@ ApRd |SV* |vnewSVpvf |NN const char *const pat|NULLOK va_list *const args Apd |SV* |newSVrv |NN SV *const rv|NULLOK const char *const classname ApMbdR |SV* |newSVsv |NULLOK SV *const old AmdR |SV* |newSVsv_nomg |NULLOK SV *const old -ApR |SV* |newSVsv_flags |NULLOK SV *const old|I32 flags +AdpR |SV* |newSVsv_flags |NULLOK SV *const old|I32 flags ApdR |SV* |newSV_type |const svtype type ApdR |OP* |newUNOP |I32 type|I32 flags|NULLOK OP* first ApdR |OP* |newUNOP_AUX |I32 type|I32 flags|NULLOK OP* first \ From 345560c9fb124eb9b3b2788d5bb036f15ec8b64a Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 26 Dec 2020 19:00:48 -0500 Subject: [PATCH 320/503] List all programs which require regen/embed_lib.pl --- regen/embed_lib.pl | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/regen/embed_lib.pl b/regen/embed_lib.pl index d7e1c5a0b695..774b4f25a360 100644 --- a/regen/embed_lib.pl +++ b/regen/embed_lib.pl @@ -1,7 +1,8 @@ #!/usr/bin/perl -w use strict; -# read embed.fnc and regen/opcodes, needed by regen/embed.pl and makedef.pl +# read embed.fnc and regen/opcodes, needed by regen/embed.pl, makedef.pl, +# autodoc.pl and t/porting/diag.t require 5.004; # keep this compatible, an old perl is all we may have before # we build the new one From dba7cf2eab9433e2b03074d49e3473dfbf0d85b1 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Wed, 4 Nov 2020 21:11:53 -0500 Subject: [PATCH 321/503] Provide code example for 'my' declared in initialization of 'for' loop For: https://github.com/Perl/perl5/issues/18260 --- pod/perlsyn.pod | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/pod/perlsyn.pod b/pod/perlsyn.pod index 81270f13f6c7..a96331fe2e4b 100644 --- a/pod/perlsyn.pod +++ b/pod/perlsyn.pod @@ -455,9 +455,23 @@ is the same as this: There is one minor difference: if variables are declared with C in the initialization section of the C, the lexical scope of those variables is exactly the C loop (the body of the loop -and the control sections). +and the control sections). To illustrate: X + my $i = 'samba'; + for (my $i = 1; $i <= 4; $i++) { + print "$i\n"; + } + print "$i\n"; + +when executed, gives: + + 1 + 2 + 3 + 4 + samba + As a special case, if the test in the C loop (or the corresponding C loop) is empty, it is treated as true. That is, both From cd188aff2b7442bf17858a475456a5031341a88c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 22 Jul 2020 09:41:34 -0600 Subject: [PATCH 322/503] Document SvPV_renew --- sv.h | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/sv.h b/sv.h index 1afbf59c4eb6..3bddfeffe9e9 100644 --- a/sv.h +++ b/sv.h @@ -1383,6 +1383,17 @@ object type. Exposed to perl code via Internals::SvREADONLY(). STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END +/* +=for apidoc Am|void|SvPV_renew|SV* sv|STRLEN len +Low level micro optimization of C>. It is generally better to use +C instead. This is because C ignores potential issues that +C handles. C needs to have a real C that is unencombered by +things like COW. Using C> or +C> before calling this should clean it up, but +why not just use C if you're not sure about the provenance? + +=cut +*/ #define SvPV_renew(sv,n) \ STMT_START { SvLEN_set(sv, n); \ SvPV_set((sv), (MEM_WRAP_CHECK_(n,char) \ From b1b6b79f3ffca57ea3d7ab68b23e6dabc52bf526 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 24 Jul 2020 08:09:26 -0600 Subject: [PATCH 323/503] embed.fnc: Mark gv_check as internal The purpose of this function is to raise a parse warning; not something something outside core should be doing. --- embed.fnc | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index 1d012ed32a95..f0078bff5579 100644 --- a/embed.fnc +++ b/embed.fnc @@ -947,7 +947,7 @@ ApR |GV* |gv_autoload_pv |NULLOK HV* stash|NN const char* namepv \ |U32 flags ApR |GV* |gv_autoload_pvn |NULLOK HV* stash|NN const char* name \ |STRLEN len|U32 flags -Ap |void |gv_check |NN HV* stash +Cp |void |gv_check |NN HV* stash AbpD |void |gv_efullname |NN SV* sv|NN const GV* gv ApMb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain From c588171e624c7ef69a51c51bb22df460e83e6dd8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:18:57 +0100 Subject: [PATCH 324/503] Distinguish C- and perly- literals - PERLY_BRACE_OPEN regardless of the fact that both have same value their meaning is different and should not be mixed --- perly.act | 536 ++++++++++---------- perly.h | 163 +++--- perly.tab | 1456 +++++++++++++++++++++++++++-------------------------- perly.y | 47 +- toke.c | 10 +- 5 files changed, 1116 insertions(+), 1096 deletions(-) diff --git a/perly.act b/perly.act index 1004d34e611d..11e91b8066b9 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 122 "perly.y" +#line 123 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 127 "perly.y" +#line 128 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 133 "perly.y" +#line 134 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 138 "perly.y" +#line 139 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 143 "perly.y" +#line 144 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 148 "perly.y" +#line 149 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 156 "perly.y" +#line 157 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 161 "perly.y" +#line 162 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 169 "perly.y" +#line 170 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 174 "perly.y" +#line 175 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 182 "perly.y" +#line 183 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 187 "perly.y" +#line 188 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 192 "perly.y" +#line 193 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 197 "perly.y" +#line 198 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 205 "perly.y" +#line 206 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 213 "perly.y" +#line 214 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 220 "perly.y" +#line 221 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 225 "perly.y" +#line 226 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 232 "perly.y" +#line 233 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 238 "perly.y" +#line 239 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 240 "perly.y" +#line 241 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 249 "perly.y" +#line 250 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 251 "perly.y" +#line 252 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 260 "perly.y" +#line 261 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 264 "perly.y" +#line 265 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 268 "perly.y" +#line 269 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 275 "perly.y" +#line 276 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 285 "perly.y" +#line 286 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 287 "perly.y" +#line 288 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 299 "perly.y" +#line 300 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 305 "perly.y" +#line 306 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 320 "perly.y" +#line 321 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 326 "perly.y" +#line 327 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 337 "perly.y" +#line 338 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 344 "perly.y" +#line 345 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 346 "perly.y" +#line 347 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 353 "perly.y" +#line 354 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 359 "perly.y" +#line 360 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 365 "perly.y" +#line 366 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 370 "perly.y" +#line 371 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 372 "perly.y" +#line 373 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 374 "perly.y" +#line 375 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 381 "perly.y" +#line 382 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 388 "perly.y" +#line 389 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 390 "perly.y" +#line 391 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 393 "perly.y" +#line 394 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 408 "perly.y" +#line 409 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 413 "perly.y" +#line 414 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 419 "perly.y" +#line 420 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 421 "perly.y" +#line 422 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 434 "perly.y" +#line 435 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 442 "perly.y" +#line 443 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 448 "perly.y" +#line 449 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 454 "perly.y" +#line 455 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 461 "perly.y" +#line 462 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 469 "perly.y" +#line 470 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 473 "perly.y" +#line 474 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 478 "perly.y" +#line 479 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 486 "perly.y" +#line 487 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 503 "perly.y" +#line 504 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 505 "perly.y" +#line 506 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 513 "perly.y" +#line 514 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 515 "perly.y" +#line 516 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 519 "perly.y" +#line 520 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 521 "perly.y" +#line 522 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 535 "perly.y" +#line 536 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 540 "perly.y" +#line 541 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 550 "perly.y" +#line 551 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 552 "perly.y" +#line 553 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 557 "perly.y" +#line 558 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 563 "perly.y" +#line 564 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 569 "perly.y" +#line 570 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 577 "perly.y" +#line 578 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 582 "perly.y" +#line 583 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 586 "perly.y" +#line 587 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 589 "perly.y" +#line 590 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 590 "perly.y" +#line 591 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 594 "perly.y" +#line 595 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 605 "perly.y" +#line 606 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 616 "perly.y" +#line 617 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 622 "perly.y" +#line 623 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 624 "perly.y" +#line 625 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 626 "perly.y" +#line 627 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 631 "perly.y" +#line 632 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 633 "perly.y" +#line 634 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 644 "perly.y" +#line 645 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 646 "perly.y" +#line 647 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 651 "perly.y" +#line 652 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 653 "perly.y" +#line 654 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 657 "perly.y" +#line 658 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 676 "perly.y" +#line 677 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 678 "perly.y" +#line 679 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 680 "perly.y" +#line 681 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 686 "perly.y" +#line 687 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 751 "perly.y" +#line 752 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 753 "perly.y" +#line 754 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 759 "perly.y" +#line 760 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 761 "perly.y" +#line 762 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 765 "perly.y" +#line 766 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 770 "perly.y" +#line 771 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 772 "perly.y" +#line 773 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 776 "perly.y" +#line 777 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 778 "perly.y" +#line 779 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 782 "perly.y" +#line 783 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 785 "perly.y" +#line 786 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 796 "perly.y" +#line 797 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 853 "perly.y" +#line 854 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 854 "perly.y" +#line 855 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 860 "perly.y" +#line 861 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 870 "perly.y" +#line 871 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 871 "perly.y" +#line 872 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 875 "perly.y" +#line 876 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 886 "perly.y" +#line 887 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 888 "perly.y" +#line 889 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 890 "perly.y" +#line 891 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 896 "perly.y" +#line 897 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 898 "perly.y" +#line 899 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 907 "perly.y" +#line 908 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 911 "perly.y" +#line 912 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 915 "perly.y" +#line 916 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 921 "perly.y" +#line 922 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 926 "perly.y" +#line 927 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 932 "perly.y" +#line 933 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 938 "perly.y" +#line 939 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 940 "perly.y" +#line 941 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 942 "perly.y" +#line 943 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 944 "perly.y" +#line 945 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 947 "perly.y" +#line 948 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 962 "perly.y" +#line 963 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 964 "perly.y" +#line 965 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 967 "perly.y" +#line 968 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 972 "perly.y" +#line 973 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 977 "perly.y" +#line 978 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 980 "perly.y" +#line 981 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 984 "perly.y" +#line 985 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 988 "perly.y" +#line 989 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 994 "perly.y" +#line 995 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1002 "perly.y" +#line 1003 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1009 "perly.y" +#line 1010 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1015 "perly.y" +#line 1016 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1017 "perly.y" +#line 1018 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1019 "perly.y" +#line 1020 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1024 "perly.y" +#line 1025 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1026 "perly.y" +#line 1027 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1028 "perly.y" +#line 1029 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1033 "perly.y" +#line 1034 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1035 "perly.y" +#line 1036 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1037 "perly.y" +#line 1038 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1039 "perly.y" +#line 1040 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1041 "perly.y" +#line 1042 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1061 "perly.y" +#line 1062 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1063 "perly.y" +#line 1064 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1067 "perly.y" +#line 1068 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1069 "perly.y" +#line 1070 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1073 "perly.y" +#line 1074 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1075 "perly.y" +#line 1076 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1077 "perly.y" +#line 1078 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1079 "perly.y" +#line 1080 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1083 "perly.y" +#line 1084 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1085 "perly.y" +#line 1086 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1090 "perly.y" +#line 1091 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1092 "perly.y" +#line 1093 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1095 "perly.y" +#line 1096 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1116 "perly.y" +#line 1117 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1119 "perly.y" +#line 1120 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1126 "perly.y" +#line 1127 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1128 "perly.y" +#line 1129 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1130 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1132 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1134 "perly.y" +#line 1135 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1137 "perly.y" +#line 1138 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1143 "perly.y" +#line 1144 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1145 "perly.y" +#line 1146 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1153 "perly.y" +#line 1154 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1155 "perly.y" +#line 1156 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1157 "perly.y" +#line 1158 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1159 "perly.y" +#line 1160 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1161 "perly.y" +#line 1162 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1191 "perly.y" +#line 1192 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1201 "perly.y" +#line 1202 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1211 "perly.y" +#line 1212 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1221 "perly.y" +#line 1222 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1223 "perly.y" +#line 1224 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1225 "perly.y" +#line 1226 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1228 "perly.y" +#line 1229 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1233 "perly.y" +#line 1234 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1237 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1239 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1241 "perly.y" +#line 1242 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1243 "perly.y" +#line 1244 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1286 "perly.y" +#line 1287 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1297 "perly.y" +#line 1298 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1305 "perly.y" +#line 1306 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1307 "perly.y" +#line 1308 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1309 "perly.y" +#line 1310 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1314 "perly.y" +#line 1315 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1316 "perly.y" +#line 1317 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1334 "perly.y" +#line 1335 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1336 "perly.y" +#line 1337 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1340 "perly.y" +#line 1341 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1348 "perly.y" +#line 1349 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1365 "perly.y" +#line 1366 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1369 "perly.y" +#line 1370 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1373 "perly.y" +#line 1374 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1379 "perly.y" +#line 1380 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1385 "perly.y" +#line 1386 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1387 "perly.y" +#line 1388 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1391 "perly.y" +#line 1392 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1396 "perly.y" +#line 1397 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1401 "perly.y" +#line 1402 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1406 "perly.y" +#line 1407 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1411 "perly.y" +#line 1412 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1413 "perly.y" +#line 1414 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1415 "perly.y" +#line 1416 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1418 "perly.y" +#line 1419 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 1bc9d6332508..e78d4a37981b 100644 --- a/perly.h +++ b/perly.h @@ -63,86 +63,87 @@ extern int yydebug; GRAMFULLSTMT = 262, GRAMSTMTSEQ = 263, GRAMSUBSIGNATURE = 264, - BAREWORD = 265, - METHOD = 266, - FUNCMETH = 267, - THING = 268, - PMFUNC = 269, - PRIVATEREF = 270, - QWLIST = 271, - FUNC0OP = 272, - FUNC0SUB = 273, - UNIOPSUB = 274, - LSTOPSUB = 275, - PLUGEXPR = 276, - PLUGSTMT = 277, - LABEL = 278, - FORMAT = 279, - SUB = 280, - SIGSUB = 281, - ANONSUB = 282, - ANON_SIGSUB = 283, - PACKAGE = 284, - USE = 285, - WHILE = 286, - UNTIL = 287, - IF = 288, - UNLESS = 289, - ELSE = 290, - ELSIF = 291, - CONTINUE = 292, - FOR = 293, - GIVEN = 294, - WHEN = 295, - DEFAULT = 296, - LOOPEX = 297, - DOTDOT = 298, - YADAYADA = 299, - FUNC0 = 300, - FUNC1 = 301, - FUNC = 302, - UNIOP = 303, - LSTOP = 304, - MULOP = 305, - ADDOP = 306, - DOLSHARP = 307, - DO = 308, - HASHBRACK = 309, - NOAMP = 310, - LOCAL = 311, - MY = 312, - REQUIRE = 313, - COLONATTR = 314, - FORMLBRACK = 315, - FORMRBRACK = 316, - SUBLEXSTART = 317, - SUBLEXEND = 318, - PREC_LOW = 319, - OROP = 320, - DOROP = 321, - ANDOP = 322, - NOTOP = 323, - ASSIGNOP = 324, - OROR = 325, - DORDOR = 326, - ANDAND = 327, - BITOROP = 328, - BITANDOP = 329, - CHEQOP = 330, - NCEQOP = 331, - CHRELOP = 332, - NCRELOP = 333, - SHIFTOP = 334, - MATCHOP = 335, - UMINUS = 336, - REFGEN = 337, - POWOP = 338, - PREINC = 339, - PREDEC = 340, - POSTINC = 341, - POSTDEC = 342, - POSTJOIN = 343, - ARROW = 344 + PERLY_BRACE_OPEN = 265, + BAREWORD = 266, + METHOD = 267, + FUNCMETH = 268, + THING = 269, + PMFUNC = 270, + PRIVATEREF = 271, + QWLIST = 272, + FUNC0OP = 273, + FUNC0SUB = 274, + UNIOPSUB = 275, + LSTOPSUB = 276, + PLUGEXPR = 277, + PLUGSTMT = 278, + LABEL = 279, + FORMAT = 280, + SUB = 281, + SIGSUB = 282, + ANONSUB = 283, + ANON_SIGSUB = 284, + PACKAGE = 285, + USE = 286, + WHILE = 287, + UNTIL = 288, + IF = 289, + UNLESS = 290, + ELSE = 291, + ELSIF = 292, + CONTINUE = 293, + FOR = 294, + GIVEN = 295, + WHEN = 296, + DEFAULT = 297, + LOOPEX = 298, + DOTDOT = 299, + YADAYADA = 300, + FUNC0 = 301, + FUNC1 = 302, + FUNC = 303, + UNIOP = 304, + LSTOP = 305, + MULOP = 306, + ADDOP = 307, + DOLSHARP = 308, + DO = 309, + HASHBRACK = 310, + NOAMP = 311, + LOCAL = 312, + MY = 313, + REQUIRE = 314, + COLONATTR = 315, + FORMLBRACK = 316, + FORMRBRACK = 317, + SUBLEXSTART = 318, + SUBLEXEND = 319, + PREC_LOW = 320, + OROP = 321, + DOROP = 322, + ANDOP = 323, + NOTOP = 324, + ASSIGNOP = 325, + OROR = 326, + DORDOR = 327, + ANDAND = 328, + BITOROP = 329, + BITANDOP = 330, + CHEQOP = 331, + NCEQOP = 332, + CHRELOP = 333, + NCRELOP = 334, + SHIFTOP = 335, + MATCHOP = 336, + UMINUS = 337, + REFGEN = 338, + POWOP = 339, + PREINC = 340, + PREDEC = 341, + POSTINC = 342, + POSTDEC = 343, + POSTJOIN = 344, + ARROW = 345 }; #endif @@ -194,6 +195,6 @@ int yyparse (void); /* Generated from: - * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 42ac1f6a5735..d78c5dfba589 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3303 +#define YYLAST 3366 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 344 +#define YYMAXUTOK 345 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,16 +33,16 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 95, 2, 2, 109, 17, 18, 2, - 107, 106, 110, 15, 80, 14, 20, 111, 2, 2, + 2, 2, 2, 95, 2, 2, 109, 16, 17, 2, + 107, 106, 110, 14, 80, 13, 19, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 83, 108, - 2, 19, 2, 82, 16, 2, 2, 2, 2, 2, + 2, 18, 2, 82, 15, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 12, 2, 13, 2, 2, 2, 2, 2, 2, + 2, 11, 2, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 10, 2, 11, 96, 2, 2, 2, + 2, 2, 2, 2, 2, 10, 96, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,51 +56,51 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 21, 22, 23, 24, 25, - 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, - 76, 77, 78, 79, 81, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, 97, 98, 99, 100, - 101, 102, 103, 104, 105 + 5, 6, 7, 8, 9, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, + 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, + 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, + 75, 76, 77, 78, 79, 81, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 97, 98, 99, + 100, 101, 102, 103, 104, 105 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 122, 122, 121, 133, 132, 143, 142, 156, 155, - 169, 168, 182, 181, 192, 191, 204, 212, 220, 224, - 232, 238, 239, 249, 250, 259, 263, 267, 274, 284, - 286, 299, 296, 320, 315, 336, 344, 343, 352, 358, - 364, 369, 371, 373, 380, 388, 390, 387, 407, 412, - 419, 418, 433, 441, 447, 454, 453, 468, 472, 477, - 485, 503, 504, 508, 512, 514, 516, 518, 520, 522, - 524, 527, 533, 534, 539, 550, 551, 557, 563, 564, - 569, 572, 576, 581, 585, 589, 590, 594, 600, 605, - 610, 611, 616, 617, 622, 623, 625, 630, 632, 644, - 645, 650, 652, 656, 676, 677, 679, 685, 750, 752, - 758, 760, 764, 770, 771, 776, 777, 781, 785, 785, - 853, 854, 859, 870, 871, 874, 885, 887, 889, 891, - 895, 897, 902, 906, 910, 914, 920, 925, 931, 937, - 939, 941, 944, 943, 954, 955, 959, 963, 966, 971, - 976, 979, 983, 987, 993, 1001, 1008, 1014, 1016, 1018, - 1023, 1025, 1027, 1032, 1034, 1036, 1038, 1040, 1042, 1044, - 1046, 1048, 1050, 1052, 1056, 1058, 1060, 1062, 1066, 1068, - 1072, 1074, 1076, 1078, 1082, 1084, 1089, 1091, 1094, 1096, - 1098, 1101, 1104, 1115, 1118, 1125, 1127, 1129, 1131, 1133, - 1136, 1142, 1144, 1148, 1149, 1150, 1151, 1152, 1154, 1156, - 1158, 1160, 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, - 1178, 1180, 1190, 1200, 1210, 1220, 1222, 1224, 1227, 1232, - 1236, 1238, 1240, 1242, 1245, 1247, 1250, 1252, 1254, 1256, - 1258, 1260, 1262, 1264, 1266, 1269, 1271, 1273, 1275, 1277, - 1279, 1283, 1286, 1285, 1298, 1299, 1300, 1304, 1306, 1308, - 1313, 1315, 1318, 1320, 1322, 1327, 1329, 1334, 1335, 1340, - 1341, 1347, 1351, 1352, 1353, 1356, 1357, 1360, 1361, 1364, - 1368, 1372, 1378, 1384, 1386, 1390, 1394, 1395, 1399, 1400, - 1404, 1405, 1410, 1412, 1414, 1417 + 0, 123, 123, 122, 134, 133, 144, 143, 157, 156, + 170, 169, 183, 182, 193, 192, 205, 213, 221, 225, + 233, 239, 240, 250, 251, 260, 264, 268, 275, 285, + 287, 300, 297, 321, 316, 337, 345, 344, 353, 359, + 365, 370, 372, 374, 381, 389, 391, 388, 408, 413, + 420, 419, 434, 442, 448, 455, 454, 469, 473, 478, + 486, 504, 505, 509, 513, 515, 517, 519, 521, 523, + 525, 528, 534, 535, 540, 551, 552, 558, 564, 565, + 570, 573, 577, 582, 586, 590, 591, 595, 601, 606, + 611, 612, 617, 618, 623, 624, 626, 631, 633, 645, + 646, 651, 653, 657, 677, 678, 680, 686, 751, 753, + 759, 761, 765, 771, 772, 777, 778, 782, 786, 786, + 854, 855, 860, 871, 872, 875, 886, 888, 890, 892, + 896, 898, 903, 907, 911, 915, 921, 926, 932, 938, + 940, 942, 945, 944, 955, 956, 960, 964, 967, 972, + 977, 980, 984, 988, 994, 1002, 1009, 1015, 1017, 1019, + 1024, 1026, 1028, 1033, 1035, 1037, 1039, 1041, 1043, 1045, + 1047, 1049, 1051, 1053, 1057, 1059, 1061, 1063, 1067, 1069, + 1073, 1075, 1077, 1079, 1083, 1085, 1090, 1092, 1095, 1097, + 1099, 1102, 1105, 1116, 1119, 1126, 1128, 1130, 1132, 1134, + 1137, 1143, 1145, 1149, 1150, 1151, 1152, 1153, 1155, 1157, + 1159, 1161, 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, + 1179, 1181, 1191, 1201, 1211, 1221, 1223, 1225, 1228, 1233, + 1237, 1239, 1241, 1243, 1246, 1248, 1251, 1253, 1255, 1257, + 1259, 1261, 1263, 1265, 1267, 1270, 1272, 1274, 1276, 1278, + 1280, 1284, 1287, 1286, 1299, 1300, 1301, 1305, 1307, 1309, + 1314, 1316, 1319, 1321, 1323, 1328, 1330, 1335, 1336, 1341, + 1342, 1348, 1352, 1353, 1354, 1357, 1358, 1361, 1362, 1365, + 1369, 1373, 1379, 1385, 1387, 1391, 1395, 1396, 1400, 1401, + 1405, 1406, 1411, 1413, 1415, 1418 }; #endif @@ -110,37 +110,37 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'{'", - "'}'", "'['", "']'", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", - "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", - "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", - "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", - "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", - "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", - "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", - "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", - "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", - "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", - "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", - "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", - "POSTJOIN", "ARROW", "')'", "'('", "';'", "'$'", "'*'", "'/'", "$accept", - "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", - "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", - "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", - "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", - "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", - "formname", "startsub", "startanonsub", "startformsub", "subname", - "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", - "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", - "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", - "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", - "listexpr", "listop", "@16", "method", "subscripted", "termbinop", - "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", - "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", - "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", - "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", - "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'}'", + "'['", "']'", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", + "PERLY_BRACE_OPEN", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", + "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", + "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", + "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", + "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", + "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", + "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", + "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", + "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", + "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", + "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", + "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "';'", "'$'", + "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", + "@7", "block", "formblock", "remember", "mblock", "mremember", "stmtseq", + "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", + "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", + "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", + "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", + "startformsub", "subname", "proto", "subattrlist", "myattrlist", + "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", + "sigscalarelem", "sigelem", "siglist", "siglistornull", + "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", + "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", + "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", + "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", + "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", + "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", + "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -150,21 +150,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 123, 125, 91, 93, 45, 43, 64, 37, 38, 61, - 46, 265, 266, 267, 268, 269, 270, 271, 272, 273, - 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, - 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, - 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, - 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, - 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, - 44, 324, 63, 58, 325, 326, 327, 328, 329, 330, - 331, 332, 333, 334, 335, 33, 126, 336, 337, 338, - 339, 340, 341, 342, 343, 344, 41, 40, 59, 36, + 125, 91, 93, 45, 43, 64, 37, 38, 61, 46, + 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, + 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, + 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, + 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, + 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, + 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, + 44, 325, 63, 58, 326, 327, 328, 329, 330, 331, + 332, 333, 334, 335, 336, 33, 126, 337, 338, 339, + 340, 341, 342, 343, 344, 345, 41, 40, 59, 36, 42, 47 }; # endif -#define YYPACT_NINF (-456) +#define YYPACT_NINF (-474) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -178,64 +178,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 842, -456, -456, -456, -456, -456, -456, -456, 57, -456, - 2977, 17, 1583, 1482, -456, -456, -456, -456, 2086, 2977, - 2977, 5, 5, 5, -456, 5, 5, -456, -456, 50, - -13, -456, 2977, -456, -456, -456, -456, 2977, -7, 32, - -24, 1987, 1886, 5, 1987, 2185, 4, 2977, 0, 2977, - 2977, 2977, 2977, 2977, 2977, 2977, 2284, 5, 5, -11, - -10, -456, -1, -456, -41, 52, -43, 64, -456, -456, - -456, 3106, -456, -456, 60, 72, 89, 230, -456, 176, - 318, 359, 216, -456, -456, -456, -456, -456, 4, 4, - 157, -456, 100, 134, 140, 150, 272, 169, 172, 17, - 148, -456, 217, -456, 175, 437, 1482, -456, -456, -456, - 673, -456, 16, 775, -456, 55, -30, -30, -456, -456, - -456, -456, -456, -456, -456, 2977, 201, 236, 2977, 209, - 431, 17, 292, 251, 3106, 237, 2383, 2977, 1886, -456, - 431, 573, -10, -456, 477, 2977, -456, -456, 431, 331, - 197, -456, -456, 2977, 431, 3076, 2482, 278, -456, -456, - -456, 431, -10, -30, -30, -30, 58, 58, 341, 313, - -456, -456, 2977, 2977, 2977, 2977, 2977, 2977, 2581, -456, - -456, 2977, -456, -456, 2977, 2977, 2977, 2977, 2977, 2977, - 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, 2977, - 2977, 2977, -456, -456, -456, 75, 2680, 2977, 2977, 2977, - 2977, 2977, 2977, 2977, -456, 340, -456, -456, 344, -456, - -456, -456, -456, -456, 270, 36, -456, -456, 267, -456, - -456, -456, -456, 17, -456, -456, 2977, 2977, 2977, 2977, - 2977, 2977, -456, -456, -456, -456, -456, 352, 352, -456, - -456, -456, 300, -456, -456, -456, 2977, 2977, 111, -456, - -456, -456, 251, 358, -456, -456, -456, 379, 309, 281, - 2977, -10, -456, 391, -456, 2779, -30, 278, 67, 105, - 256, -456, 440, 377, -456, 2977, 396, 333, 333, -456, - 3106, 204, 114, -456, 471, 431, 1929, 3198, 652, 301, - 3106, 360, 1668, 1668, 1768, 1868, 539, 1929, 1929, 431, - 431, 659, -30, -30, 2977, 2977, 303, 305, 307, -456, - 308, 2878, 2, 310, 302, -456, -456, 513, 299, 133, - 320, 136, 390, 158, 419, 876, -456, 404, -456, -456, - -3, 405, 2977, 2977, 2977, 2977, -456, 316, -456, -456, - 322, -456, -456, -456, -456, 1684, 27, -456, 2977, 2977, - -456, -456, -11, -456, -11, -456, -456, -456, -456, -456, - 349, 349, 16, 327, -35, -456, 2977, -456, -456, 328, - -456, -456, -456, -456, 517, -456, 109, 520, -456, -456, - -456, 168, 2977, 423, -456, -456, 2977, 434, 183, -456, - -456, -456, -456, -456, 530, -456, -456, 2977, -456, 426, - -456, 427, -456, 429, -456, 447, -456, -456, -456, 292, - 251, -456, -456, 439, 363, -11, 367, 369, -11, 370, - 371, -456, -456, -456, -456, 378, 386, 280, -456, 2977, - 394, 395, 2977, -456, -456, -456, -456, 2977, 449, -456, - 498, -456, -456, 519, -456, -456, 194, -456, 242, -456, - 3152, 521, -456, -456, 435, -456, -456, -456, -456, 432, - 251, 436, -456, 2977, -456, -456, 542, 542, 2977, 2977, - 542, -456, 465, 450, 542, 542, 3106, -11, -456, -456, - 468, -456, -456, -456, -456, 503, 470, -456, -456, -456, - -456, 476, 542, 542, -456, 43, 43, 481, 486, 217, - 2977, 2977, 542, -456, -456, 977, -456, 1078, -456, -456, - -456, -456, 1179, -456, 217, 217, -456, 542, 492, -456, - -456, 542, 542, -456, 494, 497, 217, -456, -456, 18, - -456, -456, -456, 1280, -456, 2977, 217, 217, -456, 542, - -456, 533, 585, -456, -456, 504, -456, -456, -456, 217, - -456, -456, -456, 542, 1785, -456, 1381, 43, 505, -456, - -456, 542, -456 + 850, -474, -474, -474, -474, -474, -474, -474, 47, -474, + 2993, 49, 1591, 1490, -474, -474, -474, -474, 1993, 2993, + 2993, 64, 64, 64, -474, 64, 64, -474, -474, 1, + -49, -474, 2993, -474, -474, -474, -474, 2993, -20, -14, + -53, 2093, 1893, 64, 2093, 2193, 44, 2993, 8, 2993, + 2993, 2993, 2993, 2993, 2993, 2993, 2293, 64, 64, 345, + 21, -474, -4, -474, -16, 16, 70, 25, -474, -474, + -474, 3169, -474, -474, -3, 46, 71, 78, -474, 98, + 164, 167, 106, -474, -474, -474, -474, -474, 44, 44, + 122, -474, 60, 65, 72, 75, 280, 81, 85, 49, + 45, -474, 101, -474, 86, 231, 1490, -474, -474, -474, + 681, -474, 10, 783, -474, 55, 660, 660, -474, -474, + -474, -474, -474, -474, -474, 2993, 119, 161, 2993, 132, + 431, 49, 218, 195, 3169, 160, 2393, 2993, 1893, -474, + 431, 572, 21, -474, 477, 2993, -474, -474, 431, 258, + 136, -474, -474, 2993, 431, 3093, 2493, 209, -474, -474, + -474, 431, 21, 660, 660, 660, 565, 565, 270, 471, + -474, -474, 2993, 2993, 2993, 2993, 2993, 2993, 2593, -474, + -474, 2993, -474, -474, 2993, 2993, 2993, 2993, 2993, 2993, + 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, + 2993, 2993, -474, -474, -474, 29, 2693, 2993, 2993, 2993, + 2993, 2993, 2993, 2993, -474, 262, -474, -474, 294, -474, + -474, -474, -474, -474, 220, 15, -474, -474, 215, -474, + -474, -474, -474, 49, -474, -474, 2993, 2993, 2993, 2993, + 2993, 2993, -474, -474, -474, -474, -474, 290, 290, -474, + -474, -474, 251, -474, -474, -474, 2993, 2993, 113, -474, + -474, -474, 195, 299, -474, -474, -474, 497, 268, 234, + 2993, 21, -474, 333, -474, 2793, 660, 209, 42, 57, + 126, -474, 513, 329, -474, 2993, 346, 283, 283, -474, + 3169, 133, 248, -474, 516, 431, 364, 3261, 585, 382, + 3169, 3123, 315, 315, 1675, 1775, 538, 364, 364, 431, + 431, 667, 660, 660, 2993, 255, 264, 265, 2993, -474, + 272, 2893, 53, 273, 261, -474, -474, 519, 159, 303, + 169, 320, 183, 357, 434, 884, -474, 340, -474, -474, + -11, 341, 2993, 2993, 2993, 2993, -474, 277, -474, -474, + 284, -474, -474, -474, -474, 1692, 12, -474, 2993, 2993, + -474, -474, 345, -474, 345, -474, -474, -474, -474, -474, + 309, 309, 10, 289, -39, -474, 2993, -474, -474, 306, + -474, -474, -474, -474, 529, -474, 39, 532, -474, -474, + -474, 243, 2993, -474, 390, -474, 2993, 252, -474, -474, + -474, 438, -474, -474, 679, -474, -474, 2993, -474, -474, + 405, -474, 419, -474, 420, 427, -474, -474, -474, 218, + 195, -474, -474, 417, 334, 345, 335, 336, 345, 342, + 343, -474, -474, -474, -474, 348, 344, 402, -474, 2993, + 353, 354, 2993, -474, -474, -474, -474, 2993, 375, -474, + 442, -474, -474, 444, -474, -474, 41, -474, 293, -474, + 3215, -474, 463, -474, 369, -474, -474, -474, -474, 374, + 195, 386, -474, 2993, -474, -474, 470, 470, 2993, 2993, + 470, -474, 388, 392, 470, 470, 3169, 345, -474, -474, + 394, -474, -474, -474, -474, 424, 393, -474, -474, -474, + -474, 409, 470, 470, -474, 139, 139, 407, 412, 101, + 2993, 2993, 470, -474, -474, 985, -474, 1086, -474, -474, + -474, -474, 1187, -474, 101, 101, -474, 470, 416, -474, + -474, 470, 470, -474, 421, 426, 101, -474, -474, -9, + -474, -474, -474, 1288, -474, 2993, 101, 101, -474, 470, + -474, 456, 521, -474, -474, 435, -474, -474, -474, 101, + -474, -474, -474, 470, 1793, -474, 1389, 139, 446, -474, + -474, 470, -474 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -274,7 +274,7 @@ static const yytype_int16 yydefact[] = 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 0, 0, 287, 289, 0, 144, + 175, 164, 173, 161, 0, 287, 289, 0, 0, 144, 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, @@ -282,14 +282,14 @@ static const yytype_int16 yydefact[] = 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, - 97, 0, 0, 0, 149, 155, 0, 0, 0, 231, - 232, 233, 284, 153, 0, 230, 234, 267, 228, 0, - 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, + 97, 0, 0, 149, 0, 155, 0, 0, 231, 232, + 233, 0, 284, 153, 0, 230, 234, 267, 228, 147, + 0, 221, 0, 222, 0, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, 0, 0, 105, 107, 103, 111, 138, 0, 0, 143, 0, 199, 118, 0, 116, 134, 212, 159, 0, 152, - 207, 0, 148, 154, 0, 150, 223, 224, 146, 0, + 207, 148, 0, 154, 0, 150, 223, 224, 146, 0, 94, 18, 55, 265, 77, 77, 0, 0, 0, 0, 0, 45, 0, 0, 0, 0, 106, 270, 253, 21, 0, 21, 157, 151, 135, 0, 18, 124, 34, 123, @@ -306,16 +306,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -456, -456, -456, -456, -456, -456, -456, -456, -456, 228, - -456, -5, -139, -456, -17, -456, 596, 506, 12, -456, - -456, -456, -456, -456, -456, -456, -456, -456, 266, -341, - -448, -192, -455, -456, 104, 277, -337, 49, -456, -44, - 159, -456, 149, 202, -243, 348, 389, -456, -456, 268, - -456, 273, -456, -456, -456, -456, 188, -456, -456, 152, - -456, 181, -8, -37, -456, -456, -456, -456, -456, -456, - -456, -456, -456, -456, -456, -456, 103, -456, -456, 491, - -124, -97, -456, -456, 312, -456, -456, 444, 38, -45, - -42, -456, -456, -456, -456, -456, 13 + -474, -474, -474, -474, -474, -474, -474, -474, -474, 228, + -474, -5, -139, -474, -17, -474, 531, 450, -1, -474, + -474, -474, -474, -474, -474, -474, -474, -474, 266, -341, + -473, -192, -458, -474, 68, 244, -337, 22, -474, -10, + 205, -474, 168, 179, -243, 324, 356, -474, -474, 240, + -474, 230, -474, -474, -474, -474, 166, -474, -474, 116, + -474, 142, -8, -37, -474, -474, -474, -474, -474, -474, + -474, -474, -474, -474, -474, -474, 103, -474, -474, 465, + -124, -95, -474, -474, 288, -474, -474, 399, 38, -45, + -42, -474, -474, -474, -474, -474, 13 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -338,96 +338,117 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 421, 429, 176, - 115, 177, 83, 162, 433, 83, 21, 22, 435, 377, - 503, 440, 441, 118, 103, 151, 118, 83, 119, 274, - 152, 119, 245, 246, 122, 123, 124, 150, 125, 126, - 268, 269, 551, 21, 22, 175, 182, 183, 169, 137, - 179, 180, 21, 22, 23, 145, 146, 16, 530, 121, - 121, 121, 128, 121, 121, 172, 173, 174, 254, 201, - 175, 171, 202, 203, 204, 205, 447, 207, 214, 208, - 144, 121, 207, 138, 208, 314, 158, 315, 142, 527, - 528, 316, 317, 318, 129, 121, 121, 319, 155, -286, - 135, -286, 483, 564, 348, 422, 178, 156, 271, 57, - 279, 57, 405, 280, 57, -286, 142, -286, 243, 570, - 258, 285, 116, 117, 375, 247, 552, 394, 267, 59, - 59, 172, 173, 174, 228, 130, 57, -262, 320, 136, - 134, 507, 508, 181, 140, 57, 410, 148, 282, 412, - 154, 270, 161, 184, 163, 164, 165, 166, 167, 373, - -291, -291, -291, 205, 287, 288, 289, 206, 291, 292, - 294, 414, 338, 339, 535, -264, 144, 471, 218, -261, - 353, 457, 321, 354, 322, 323, -290, 172, 173, 174, - 172, 173, 174, 278, 132, 133, 462, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 392, 220, 555, 172, + 113, 255, 59, 159, 17, 142, 160, 176, 429, 421, + 115, 103, 128, 162, 433, 551, 177, 503, 435, 377, + 137, 440, 441, 21, 22, 245, 246, 21, 22, 274, + 21, 22, 23, 530, 122, 123, 124, 150, 125, 126, + 314, 175, 268, 269, 315, 316, 317, 16, 169, 318, + 285, 319, 392, 207, 138, 145, 146, 207, 129, 121, + 121, 121, 208, 121, 121, 151, 208, 254, -286, 83, + 152, 171, 447, 83, 118, 179, 180, -286, 214, 119, + 144, 121, -286, 348, 83, 118, 158, 135, 142, -288, + 119, -286, 320, 136, 570, 121, 121, 422, -288, 552, + 564, 175, 483, 178, 206, 243, 155, 181, 271, -261, + 279, -260, -262, 280, 184, 156, 142, 57, -290, 247, + 258, 57, 116, 117, 57, 375, 213, -264, 267, 59, + 59, 172, 173, 174, 228, 130, 321, -288, 322, 323, + 134, 507, 508, 218, 140, 393, -288, 148, 282, 233, + 154, 270, 161, 232, 163, 164, 165, 166, 167, 182, + 183, 373, 57, 405, 287, 288, 289, 220, 291, 292, + 294, 409, 221, 57, 535, 209, 144, 471, 211, 222, + 353, 411, 223, 354, 210, 527, 528, 212, 229, 172, + 173, 174, 230, 278, 235, 413, -263, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 338, 339, 555, 172, 173, 174, 172, 173, 174, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 213, 496, 362, 364, - 362, 362, 362, 362, 172, 173, 174, 216, 217, 84, - -288, 221, -288, 325, 172, 173, 174, 222, 59, 120, - 120, 120, 449, 120, 120, 492, 232, 223, 276, 172, - 173, 174, 384, 352, -260, 233, -288, 387, -288, 139, - 120, 120, 147, 172, 173, 174, 229, 391, 290, 230, - 172, 173, 174, 235, 295, 120, 120, 296, 297, 298, + 374, 355, 356, 433, 358, 359, 256, 496, 362, 364, + 362, 362, 362, 362, 257, 172, 173, 174, 259, 84, + 132, 133, 261, 325, 273, 172, 173, 174, 59, 120, + 120, 120, 449, 120, 120, 457, 216, 217, 276, 172, + 173, 174, 384, 352, 461, 263, 265, 387, 272, 139, + 120, 120, 147, 236, 237, 238, 239, 391, 290, 283, + 240, 285, 241, 336, 295, 120, 120, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 273, 397, 398, 256, 257, - 464, 353, 393, 404, 354, 259, 261, 533, 172, 173, - 174, 263, 236, 237, 238, 239, -263, 231, 209, 240, - 210, 241, 541, 542, 425, 364, 428, 428, 506, 142, - 224, 509, 272, 265, 550, 513, 514, 437, 283, 501, - 428, 428, 439, 285, 556, 557, 172, 173, 174, 260, - 121, 336, 186, 524, 525, 340, 120, 565, 346, 211, - 225, 212, 450, 536, 357, 172, 173, 174, 369, 226, - 372, 57, 378, 382, 458, 431, -83, 383, 544, 172, - 173, 174, 546, 547, 352, 200, 172, 173, 174, 59, - 201, 390, 385, 202, 203, 204, 205, 409, 392, 407, - 559, 174, 469, 399, 185, 400, 472, 401, 402, 286, - 406, 186, 187, 417, 567, 57, 423, 479, 411, 432, - 442, 428, 572, 446, 459, 452, 142, 465, 466, 487, - 467, 188, 189, 396, 190, 191, 192, 193, 194, 195, - 196, 197, 198, 199, 200, 172, 173, 174, 468, 201, - 473, 360, 202, 203, 204, 205, 172, 173, 174, 474, - 428, 428, 515, 475, 517, 476, 477, -215, 478, 236, - 237, 238, 239, 522, 480, 381, 240, 207, 241, 208, - -215, 450, 186, 187, 481, 172, 173, 174, 413, 460, - 484, 485, 425, 428, 365, 366, 367, 368, 489, 543, - 172, 173, 174, 172, 173, 174, 172, 173, 174, -215, - -215, -215, -215, 488, 199, 200, -215, 415, -215, 491, - 201, -215, 493, 202, 203, 204, 205, 428, -215, -215, - 495, 494, 461, 566, 497, 486, 389, 172, 173, 174, - 120, -215, 504, -215, -215, -215, 512, -215, -215, -215, + 309, 310, 311, 312, 313, 492, 397, 172, 173, 174, + 401, 353, 464, 404, 354, 340, 369, 533, 346, 172, + 173, 174, 357, 378, 172, 173, 174, 231, 172, 173, + 174, 372, 541, 542, 425, 364, 428, 428, 506, 142, + 383, 509, 382, 385, 550, 513, 514, 437, 224, 501, + 428, 428, 439, 390, 556, 557, 394, 392, 417, 260, + 121, 174, 423, 524, 525, 398, 120, 565, 407, 172, + 173, 174, 450, 536, 399, 400, 186, 187, 225, 172, + 173, 174, 402, 406, 458, 431, 57, 226, 544, 57, + 442, 432, 546, 547, 352, 446, 172, 173, 174, 59, + 459, 192, 193, 194, 195, 196, 197, 198, 199, 200, + 559, 410, 469, 452, 201, 465, 472, 202, 203, 204, + 205, 172, 173, 174, 567, 186, 187, 479, 412, 466, + 467, 428, 572, 172, 173, 174, 142, 468, 473, 487, + 474, 475, 476, 186, 236, 237, 238, 239, 477, 488, + 478, 240, 481, 241, 480, 197, 198, 199, 200, 484, + 485, 360, 489, 201, 491, 414, 202, 203, 204, 205, + 428, 428, 515, 493, 517, 494, 200, -215, 172, 173, + 174, 201, 495, 522, 202, 203, 204, 205, 207, -215, + 504, 450, 186, 187, 497, 511, 518, 208, 512, 460, + 516, 519, 425, 428, 365, 366, 367, 368, -83, 543, + 172, 173, 174, 531, 172, 173, 174, 523, 532, -215, + -215, -215, -215, 545, 199, 200, -215, 560, -215, 548, + 201, -215, 549, 202, 203, 204, 205, 428, -215, -215, + 562, 563, 415, 566, 107, 486, 462, 172, 173, 174, + 120, -215, 571, -215, -215, -215, 242, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, 511, -254, 516, 518, -215, 395, 519, -215, - -215, -215, -215, -215, 523, -215, -254, 531, -215, 172, - 173, 174, 532, 172, 173, 174, 172, 173, 174, 545, - 186, 187, 548, 549, 560, 562, 172, 173, 174, 107, - 563, 571, 242, 568, 534, -254, -254, -254, -254, 408, - 426, 470, -254, 455, -254, 388, 456, -254, 195, 196, - 197, 198, 199, 200, -254, -254, 463, 371, 201, 444, - 490, 202, 203, 204, 205, 445, 277, -254, 521, -254, - -254, -254, 499, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, 438, 351, - 0, 0, -254, -13, 85, -254, -254, -254, -254, -254, - 0, -254, 0, 83, -254, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, + -215, -215, -254, 172, 173, 174, -215, 286, 534, -215, + -215, -215, -215, -215, -254, -215, 568, 426, -215, 172, + 173, 174, 172, 173, 174, 172, 173, 174, 470, 186, + 187, 388, 445, 381, 371, 172, 173, 174, 172, 173, + 174, 444, 521, 499, -254, -254, -254, -254, 490, 389, + 277, -254, 395, -254, 351, 408, -254, 195, 196, 197, + 198, 199, 200, -254, -254, 455, 0, 201, 456, 0, + 202, 203, 204, 205, 438, 0, -254, 0, -254, -254, + -254, 0, -254, -254, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -291, -291, -291, + 205, -254, 0, 0, -254, -254, -254, -254, -254, 200, + -254, -13, 85, -254, 201, 0, 0, 202, 203, 204, + 205, 0, 18, 0, 19, 20, 21, 22, 23, 0, + 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, + 36, 90, 91, 92, 93, 94, 95, 0, 186, 187, + 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 172, 173, 174, 0, 201, + 50, 200, 202, 203, 204, 205, 201, 0, 0, 202, + 203, 204, 205, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, -3, 85, 463, 0, 0, 56, 101, + 57, 58, 0, 0, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 186, 187, 96, 97, 98, 99, 37, 0, 100, 38, + 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 200, 0, 0, 0, - 0, 201, 50, 200, 202, 203, 204, 205, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, - 56, 101, 57, 58, 0, 83, 0, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, + 47, 48, 49, 1, 2, 3, 4, 5, 6, 7, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 101, 57, 58, 416, 18, 0, 19, 20, 21, + 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, + 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, + 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, 101, 57, 58, 537, 18, 0, 19, 20, + 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, - 6, 7, 0, 0, 50, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 83, 416, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, + 0, 0, 56, 101, 57, 58, 538, 18, 0, 19, + 20, 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, @@ -436,8 +457,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 101, 57, 58, 83, 537, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, + 0, 0, 0, 56, 101, 57, 58, 540, 18, 0, + 19, 20, 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, @@ -446,8 +467,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 101, 57, 58, 83, 538, - 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, + 0, 0, 0, 0, 56, 101, 57, 58, 554, 18, + 0, 19, 20, 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, @@ -456,19 +477,19 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 101, 57, 58, 83, - 540, 18, 0, 19, 20, 21, 22, 23, 0, 0, + 85, 0, 0, 0, 0, 56, 101, 57, 58, 0, + 18, 0, 19, 20, 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 83, 554, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, + 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, @@ -477,108 +498,88 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, - 58, 83, 0, 18, 0, 19, 20, 21, 22, 23, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, + 58, 0, 18, 0, 19, 20, 21, 22, 23, 0, + 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 86, 0, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, - 57, 58, 83, 0, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, - 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, - 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, + 57, 58, 0, 18, 0, 19, 20, 21, 22, 23, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 48, 49, 193, 194, 195, 196, 197, 198, 199, 200, + 0, 50, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 101, 57, 58, 83, 0, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 86, 0, 87, 88, - 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, + -78, 57, 58, 0, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 194, 195, 196, 197, 198, 199, 200, + 0, 0, 50, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, -78, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 83, 141, 25, 26, 27, 28, 119, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 101, 57, 58, 0, 0, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, -78, 57, 58, 0, 0, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 50, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, -78, 56, 0, 57, 58, 83, 0, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 141, 25, 26, - 27, 28, 119, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 50, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 186, 187, 0, 56, 0, 57, 58, 83, 0, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 197, 198, 199, 200, 0, 35, 36, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 0, 57, 58, 18, 114, - 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 0, 57, 58, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 56, 149, 57, 58, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 168, 56, 0, 57, 58, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 24, 25, 26, 27, 28, 0, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 56, 0, 57, 58, 18, 114, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 56, 149, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 168, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -588,181 +589,207 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 266, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, - 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 293, 56, 0, - 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 326, 56, 0, 57, - 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 386, 56, 0, 57, 58, - 18, 0, 19, 20, 21, 22, 23, 0, 0, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 403, 56, 0, 57, 58, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 281, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 386, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 403, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 185, 0, 0, + 0, 0, 0, 0, 186, 187, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 275, 0, 57, 58, 188, 189, 396, 190, 191, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, + 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, + 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 185, 0, 0, 0, 0, 0, 0, 186, 187, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 275, 0, 57, 58, 188, 189, 0, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, - 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, + 188, 189, 0, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 189, 0, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, -291, 0, 202, 203, 204, 205, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 189, 0, 190, + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, + 0, 0, 0, 0, 201, -291, 0, 202, 203, 204, + 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 190, 191, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205 + 0, 0, 0, 0, 0, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 10, 345, 10, - 18, 12, 10, 50, 355, 10, 16, 17, 355, 262, - 475, 358, 359, 21, 12, 21, 21, 10, 26, 153, - 26, 26, 16, 17, 21, 22, 23, 45, 25, 26, - 137, 138, 24, 16, 17, 80, 89, 90, 56, 73, - 91, 92, 16, 17, 18, 42, 43, 0, 506, 21, - 22, 23, 12, 25, 26, 76, 77, 78, 13, 99, - 80, 58, 102, 103, 104, 105, 111, 10, 83, 12, - 42, 43, 10, 107, 12, 10, 48, 12, 125, 46, - 47, 16, 17, 18, 107, 57, 58, 22, 98, 10, - 107, 12, 439, 558, 68, 108, 107, 107, 145, 109, - 155, 109, 110, 155, 109, 10, 153, 12, 106, 567, - 128, 12, 19, 20, 13, 109, 108, 13, 136, 137, - 138, 76, 77, 78, 96, 32, 109, 70, 63, 107, - 37, 478, 479, 91, 41, 109, 13, 44, 156, 13, - 47, 138, 49, 89, 51, 52, 53, 54, 55, 256, - 102, 103, 104, 105, 172, 173, 174, 107, 176, 177, - 178, 13, 216, 217, 511, 70, 138, 420, 21, 70, - 225, 13, 107, 225, 109, 110, 10, 76, 77, 78, - 76, 77, 78, 155, 35, 36, 13, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 12, 107, 545, 76, + 17, 125, 10, 48, 9, 42, 48, 11, 345, 20, + 18, 12, 11, 50, 355, 24, 20, 475, 355, 262, + 73, 358, 359, 15, 16, 15, 16, 15, 16, 153, + 15, 16, 17, 506, 21, 22, 23, 45, 25, 26, + 11, 80, 137, 138, 15, 16, 17, 0, 56, 20, + 11, 22, 11, 11, 107, 42, 43, 11, 107, 21, + 22, 23, 20, 25, 26, 21, 20, 12, 11, 20, + 26, 58, 111, 20, 21, 91, 92, 20, 83, 26, + 42, 43, 11, 68, 20, 21, 48, 107, 125, 11, + 26, 20, 63, 107, 567, 57, 58, 108, 20, 108, + 558, 80, 439, 107, 107, 106, 98, 91, 145, 70, + 155, 70, 70, 155, 89, 107, 153, 109, 20, 109, + 128, 109, 19, 20, 109, 12, 20, 70, 136, 137, + 138, 76, 77, 78, 96, 32, 107, 11, 109, 110, + 37, 478, 479, 21, 41, 12, 20, 44, 156, 48, + 47, 138, 49, 108, 51, 52, 53, 54, 55, 89, + 90, 256, 109, 110, 172, 173, 174, 107, 176, 177, + 178, 12, 107, 109, 511, 11, 138, 420, 11, 107, + 225, 12, 107, 225, 20, 46, 47, 20, 107, 76, + 77, 78, 107, 155, 108, 12, 70, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 216, 217, 545, 76, 77, 78, 76, 77, 78, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 10, 470, 236, 237, - 238, 239, 240, 241, 76, 77, 78, 88, 89, 11, - 10, 107, 12, 205, 76, 77, 78, 107, 256, 21, - 22, 23, 376, 25, 26, 13, 108, 107, 155, 76, - 77, 78, 270, 225, 70, 48, 10, 275, 12, 41, - 42, 43, 44, 76, 77, 78, 107, 285, 175, 107, - 76, 77, 78, 108, 181, 57, 58, 184, 185, 186, + 257, 226, 227, 564, 229, 230, 107, 470, 236, 237, + 238, 239, 240, 241, 73, 76, 77, 78, 106, 11, + 35, 36, 24, 205, 108, 76, 77, 78, 256, 21, + 22, 23, 376, 25, 26, 12, 88, 89, 155, 76, + 77, 78, 270, 225, 12, 70, 106, 275, 10, 41, + 42, 43, 44, 42, 43, 44, 45, 285, 175, 70, + 49, 11, 51, 21, 181, 57, 58, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 108, 314, 315, 107, 73, - 407, 356, 108, 321, 356, 106, 24, 509, 76, 77, - 78, 70, 42, 43, 44, 45, 70, 99, 10, 49, - 12, 51, 524, 525, 342, 343, 344, 345, 477, 376, - 68, 480, 11, 106, 536, 484, 485, 355, 70, 473, - 358, 359, 357, 12, 546, 547, 76, 77, 78, 131, - 322, 21, 61, 502, 503, 21, 138, 559, 98, 10, - 98, 12, 377, 512, 107, 76, 77, 78, 26, 107, - 80, 109, 24, 74, 392, 347, 106, 106, 527, 76, - 77, 78, 531, 532, 356, 94, 76, 77, 78, 407, - 99, 24, 11, 102, 103, 104, 105, 108, 12, 107, - 549, 78, 417, 110, 54, 110, 421, 110, 110, 106, - 110, 61, 62, 19, 563, 109, 21, 432, 108, 107, - 81, 439, 571, 106, 11, 107, 473, 11, 11, 447, - 11, 81, 82, 83, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 76, 77, 78, 11, 99, - 21, 233, 102, 103, 104, 105, 76, 77, 78, 106, - 478, 479, 489, 106, 491, 106, 106, 0, 107, 42, - 43, 44, 45, 500, 106, 106, 49, 10, 51, 12, - 13, 496, 61, 62, 108, 76, 77, 78, 108, 396, - 106, 106, 510, 511, 238, 239, 240, 241, 10, 526, - 76, 77, 78, 76, 77, 78, 76, 77, 78, 42, - 43, 44, 45, 74, 93, 94, 49, 108, 51, 10, - 99, 54, 11, 102, 103, 104, 105, 545, 61, 62, - 108, 106, 108, 560, 108, 442, 106, 76, 77, 78, - 322, 74, 10, 76, 77, 78, 106, 80, 81, 82, + 197, 198, 199, 200, 201, 12, 314, 76, 77, 78, + 318, 356, 407, 321, 356, 21, 26, 509, 98, 76, + 77, 78, 107, 24, 76, 77, 78, 99, 76, 77, + 78, 80, 524, 525, 342, 343, 344, 345, 477, 376, + 106, 480, 74, 10, 536, 484, 485, 355, 68, 473, + 358, 359, 357, 24, 546, 547, 108, 11, 18, 131, + 322, 78, 21, 502, 503, 110, 138, 559, 107, 76, + 77, 78, 377, 512, 110, 110, 61, 62, 98, 76, + 77, 78, 110, 110, 392, 347, 109, 107, 527, 109, + 81, 107, 531, 532, 356, 106, 76, 77, 78, 407, + 10, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 549, 108, 417, 107, 99, 10, 421, 102, 103, 104, + 105, 76, 77, 78, 563, 61, 62, 432, 108, 10, + 10, 439, 571, 76, 77, 78, 473, 10, 21, 447, + 106, 106, 106, 61, 42, 43, 44, 45, 106, 74, + 107, 49, 108, 51, 106, 91, 92, 93, 94, 106, + 106, 233, 20, 99, 20, 108, 102, 103, 104, 105, + 478, 479, 489, 10, 491, 106, 94, 0, 76, 77, + 78, 99, 108, 500, 102, 103, 104, 105, 11, 12, + 20, 496, 61, 62, 108, 107, 72, 20, 106, 396, + 106, 108, 510, 511, 238, 239, 240, 241, 106, 526, + 76, 77, 78, 106, 76, 77, 78, 108, 106, 42, + 43, 44, 45, 107, 93, 94, 49, 71, 51, 108, + 99, 54, 106, 102, 103, 104, 105, 545, 61, 62, + 19, 106, 108, 560, 13, 442, 108, 76, 77, 78, + 322, 74, 106, 76, 77, 78, 106, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 107, 0, 106, 72, 99, 106, 108, 102, - 103, 104, 105, 106, 108, 108, 13, 106, 111, 76, - 77, 78, 106, 76, 77, 78, 76, 77, 78, 107, - 61, 62, 108, 106, 71, 20, 76, 77, 78, 13, - 106, 106, 106, 564, 510, 42, 43, 44, 45, 106, - 343, 419, 49, 106, 51, 277, 106, 54, 89, 90, - 91, 92, 93, 94, 61, 62, 106, 248, 99, 371, - 452, 102, 103, 104, 105, 372, 155, 74, 496, 76, - 77, 78, 471, 80, 81, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 356, 225, - -1, -1, 99, 0, 1, 102, 103, 104, 105, 106, - -1, 108, -1, 10, 111, 12, -1, 14, 15, 16, - 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, + 93, 94, 0, 76, 77, 78, 99, 106, 510, 102, + 103, 104, 105, 106, 12, 108, 564, 343, 111, 76, + 77, 78, 76, 77, 78, 76, 77, 78, 419, 61, + 62, 277, 372, 106, 248, 76, 77, 78, 76, 77, + 78, 371, 496, 471, 42, 43, 44, 45, 452, 106, + 155, 49, 106, 51, 225, 106, 54, 89, 90, 91, + 92, 93, 94, 61, 62, 106, -1, 99, 106, -1, + 102, 103, 104, 105, 356, -1, 74, -1, 76, 77, + 78, -1, 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 102, 103, 104, + 105, 99, -1, -1, 102, 103, 104, 105, 106, 94, + 108, 0, 1, 111, 99, -1, -1, 102, 103, 104, + 105, -1, 11, -1, 13, 14, 15, 16, 17, -1, + -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, 61, 62, + 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, + 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, + 69, -1, -1, -1, -1, 76, 77, 78, -1, 99, + 79, 94, 102, 103, 104, 105, 99, -1, -1, 102, + 103, 104, 105, -1, -1, -1, 95, 96, -1, 98, + -1, 100, 101, 0, 1, 106, -1, -1, 107, 108, + 109, 110, -1, -1, 11, -1, 13, 14, 15, 16, + 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - 61, 62, 49, 50, 51, 52, 53, -1, 55, 56, + -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, 94, -1, -1, -1, - -1, 99, 79, 94, 102, 103, 104, 105, 99, -1, - -1, 102, 103, 104, 105, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 0, 1, -1, -1, -1, - 107, 108, 109, 110, -1, 10, -1, 12, -1, 14, - 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, + 67, 68, 69, 3, 4, 5, 6, 7, 8, 9, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, + 107, 108, 109, 110, 10, 11, -1, 13, 14, 15, + 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, + -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, + 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, + 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, + -1, 107, 108, 109, 110, 10, 11, -1, 13, 14, + 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, 3, 4, 5, 6, 7, - 8, 9, -1, -1, 79, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, 12, -1, - 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, + -1, -1, 107, 108, 109, 110, 10, 11, -1, 13, + 14, 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, @@ -771,8 +798,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, - -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, + -1, -1, -1, 107, 108, 109, 110, 10, 11, -1, + 13, 14, 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, @@ -782,7 +809,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, + -1, 13, 14, 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, @@ -791,19 +818,19 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, -1, 14, 15, 16, 17, 18, -1, -1, + 1, -1, -1, -1, -1, 107, 108, 109, 110, -1, + 11, -1, 13, 14, 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, 72, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, -1, 14, 15, 16, 17, 18, -1, - -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, + -1, 11, -1, 13, 14, 15, 16, 17, -1, -1, + 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, @@ -812,108 +839,78 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, - 110, 10, -1, 12, -1, 14, 15, 16, 17, 18, - -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 110, -1, 11, -1, 13, 14, 15, 16, 17, -1, + -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, 33, -1, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, 72, -1, -1, -1, -1, -1, -1, + 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, - 109, 110, 10, -1, 12, -1, 14, 15, 16, 17, - 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, - -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, + 109, 110, -1, 11, -1, 13, 14, 15, 16, 17, + -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, + 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, + 38, 39, -1, -1, -1, -1, 61, 62, -1, -1, + -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, + 68, 69, 87, 88, 89, 90, 91, 92, 93, 94, + -1, 79, -1, -1, 99, -1, -1, 102, 103, 104, + 105, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, 10, -1, 12, -1, 14, 15, 16, - 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, 33, -1, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, + 108, 109, 110, -1, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, 61, 62, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, 88, 89, 90, 91, 92, 93, 94, + -1, -1, 79, -1, 99, -1, -1, 102, 103, 104, + 105, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, 20, 21, 22, 23, 24, 25, 26, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, - 107, 108, 109, 110, -1, -1, 12, -1, 14, 15, - 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, 53, -1, -1, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 79, -1, -1, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, - -1, 107, 108, 109, 110, -1, -1, 12, -1, 14, - 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, 87, 88, 89, 90, 91, - 92, 93, 94, -1, 79, -1, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, 106, 107, -1, 109, 110, 10, -1, 12, -1, - 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, 88, 89, 90, 91, - 92, 93, 94, -1, -1, 79, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - 61, 62, -1, 107, -1, 109, 110, 10, -1, 12, - -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - 91, 92, 93, 94, -1, 38, 39, -1, 99, -1, - -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, - 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, - -1, -1, -1, -1, 107, -1, 109, 110, 12, 13, - 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 12, -1, 14, - 15, 16, 17, 18, -1, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, -1, 107, 108, 109, 110, 12, -1, 14, 15, - 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - 106, 107, -1, 109, 110, 12, -1, 14, 15, 16, - 17, 18, -1, -1, 21, 22, 23, 24, 25, -1, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 11, 12, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, 108, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, @@ -922,88 +919,103 @@ static const yytype_int16 yycheck[] = -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 12, -1, 14, 15, 16, 17, - 18, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, - 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, - -1, 109, 110, 12, -1, 14, 15, 16, 17, 18, - -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, - 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, - 109, 110, 12, -1, 14, 15, 16, 17, 18, -1, - -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, - 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, - 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, - 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, - 110, 12, -1, 14, 15, 16, 17, 18, -1, -1, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, - 101, -1, -1, -1, -1, 106, 107, -1, 109, 110, - 12, -1, 14, 15, 16, 17, 18, -1, -1, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 12, - -1, 14, 15, 16, 17, 18, -1, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, + 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, 54, -1, -1, + -1, -1, -1, -1, 61, 62, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, -1, -1, + -1, -1, 99, 54, -1, 102, 103, 104, 105, -1, + 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, - -1, -1, -1, -1, 107, -1, 109, 110, 12, -1, - 14, 15, 16, 17, 18, -1, -1, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, - 54, -1, -1, -1, -1, -1, -1, 61, 62, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 81, 82, -1, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, -1, -1, -1, -1, 99, 54, -1, 102, 103, - 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, + 81, 82, -1, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, -1, -1, -1, -1, 99, 54, + -1, 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 82, -1, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, -1, -1, -1, - -1, 99, 54, -1, 102, 103, 104, 105, -1, 61, - 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 82, -1, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + -1, -1, -1, -1, 99, 54, -1, 102, 103, 104, + 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, -1, -1, -1, -1, 99, -1, -1, - 102, 103, 104, 105 + -1, -1, -1, -1, -1, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, -1, -1, -1, -1, + 99, -1, -1, 102, 103, 104, 105 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1011,62 +1023,62 @@ static const yytype_int16 yycheck[] = static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 12, 14, - 15, 16, 17, 18, 21, 22, 23, 24, 25, 27, + 115, 116, 117, 118, 119, 120, 0, 123, 11, 13, + 14, 15, 16, 17, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 10, 121, 1, 33, 35, 36, 37, + 205, 206, 207, 20, 121, 1, 33, 35, 36, 37, 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, - 126, 168, 169, 126, 13, 174, 188, 188, 21, 26, - 121, 200, 208, 208, 208, 208, 208, 189, 12, 107, + 126, 168, 169, 126, 12, 174, 188, 188, 21, 26, + 121, 200, 208, 208, 208, 208, 208, 189, 11, 107, 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, - 208, 208, 76, 77, 78, 80, 10, 12, 107, 91, + 208, 208, 76, 77, 78, 80, 11, 20, 107, 91, 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 99, 102, 103, 104, 105, 107, 10, 12, 10, - 12, 10, 12, 10, 123, 153, 154, 154, 21, 151, + 94, 99, 102, 103, 104, 105, 107, 11, 20, 11, + 20, 11, 20, 20, 123, 153, 154, 154, 21, 151, 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 16, 17, 109, 159, 160, - 162, 163, 164, 165, 13, 192, 107, 73, 174, 106, + 49, 51, 129, 130, 128, 15, 16, 109, 159, 160, + 162, 163, 164, 165, 12, 192, 107, 73, 174, 106, 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, - 208, 175, 11, 108, 192, 107, 188, 191, 200, 201, - 202, 106, 174, 70, 157, 12, 106, 174, 174, 174, + 208, 175, 10, 108, 192, 107, 188, 191, 200, 201, + 202, 106, 174, 70, 157, 11, 106, 174, 174, 174, 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 12, 16, 17, 18, 22, + 188, 188, 188, 188, 11, 15, 16, 17, 20, 22, 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, - 158, 158, 80, 193, 175, 13, 177, 156, 24, 123, - 173, 106, 74, 106, 174, 11, 106, 174, 157, 106, - 24, 174, 12, 108, 13, 106, 83, 174, 174, 110, - 110, 110, 110, 106, 174, 110, 110, 107, 106, 108, - 13, 108, 13, 108, 13, 108, 11, 19, 122, 131, - 132, 10, 108, 21, 146, 174, 147, 148, 174, 148, + 158, 158, 80, 193, 175, 12, 177, 156, 24, 123, + 173, 106, 74, 106, 174, 10, 106, 174, 157, 106, + 24, 174, 11, 12, 108, 106, 83, 174, 110, 110, + 110, 174, 110, 106, 174, 110, 110, 107, 106, 12, + 108, 12, 108, 12, 108, 108, 10, 18, 122, 131, + 132, 20, 108, 21, 146, 174, 147, 148, 174, 148, 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, - 123, 171, 107, 166, 167, 106, 106, 13, 174, 11, - 188, 108, 13, 106, 193, 11, 11, 11, 11, 123, + 123, 171, 107, 166, 167, 106, 106, 12, 174, 10, + 188, 12, 108, 106, 193, 10, 10, 10, 10, 123, 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, - 106, 108, 136, 148, 106, 106, 188, 174, 74, 10, - 168, 10, 13, 11, 106, 108, 156, 108, 172, 173, - 137, 192, 144, 144, 10, 124, 124, 148, 148, 124, + 106, 108, 136, 148, 106, 106, 188, 174, 74, 20, + 168, 20, 12, 10, 106, 108, 156, 108, 172, 173, + 137, 192, 144, 144, 20, 124, 124, 148, 148, 124, 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, - 142, 106, 106, 143, 146, 148, 124, 11, 11, 127, - 11, 143, 143, 126, 124, 107, 124, 124, 108, 106, - 143, 24, 108, 138, 11, 148, 143, 143, 135, 124, - 71, 139, 20, 106, 144, 143, 126, 124, 149, 72, + 142, 106, 106, 143, 146, 148, 124, 10, 10, 127, + 10, 143, 143, 126, 124, 107, 124, 124, 108, 106, + 143, 24, 108, 138, 10, 148, 143, 143, 135, 124, + 71, 139, 19, 106, 144, 143, 126, 124, 149, 72, 142, 106, 124 }; @@ -1149,39 +1161,39 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * cb0b53384d9fa75068c8e30d8fe9016dec2e65e0a5c16ce6479563d6b41626d6 perly.y + * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 433de1f48172..c9a6d9a76cc4 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,8 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '{' '}' '[' ']' '-' '+' '@' '%' '&' '=' '.' +%token '}' '[' ']' '-' '+' '@' '%' '&' '=' '.' +%token PERLY_BRACE_OPEN %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -113,7 +114,7 @@ %left ARROW %nonassoc ')' %left '(' -%left '[' '{' +%left '[' PERLY_BRACE_OPEN %% /* RULES */ @@ -201,9 +202,9 @@ grammar : GRAMPROG ; /* An ordinary block */ -block : '{' remember stmtseq '}' - { if (parser->copline > (line_t)$1) - parser->copline = (line_t)$1; +block : PERLY_BRACE_OPEN remember stmtseq '}' + { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) + parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($remember, $stmtseq); } ; @@ -221,9 +222,9 @@ remember: /* NULL */ /* start a full lexical scope */ parser->parsed_sub = 0; } ; -mblock : '{' mremember stmtseq '}' - { if (parser->copline > (line_t)$1) - parser->copline = (line_t)$1; +mblock : PERLY_BRACE_OPEN mremember stmtseq '}' + { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) + parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($mremember, $stmtseq); } ; @@ -450,7 +451,7 @@ barestmt: PLUGSTMT $$ = newWHILEOP(0, 1, NULL, NULL, $block, $cont, 0); } - | PACKAGE BAREWORD[version] BAREWORD[package] '{' remember + | PACKAGE BAREWORD[version] BAREWORD[package] PERLY_BRACE_OPEN remember { package($package); if ($version) { @@ -462,8 +463,8 @@ barestmt: PLUGSTMT /* a block is a loop that happens once */ $$ = newWHILEOP(0, 1, NULL, NULL, block_end($remember, $stmtseq), NULL, 0); - if (parser->copline > (line_t)$4) - parser->copline = (line_t)$4; + if (parser->copline > (line_t)$PERLY_BRACE_OPEN) + parser->copline = (line_t)$PERLY_BRACE_OPEN; } | sideff ';' { @@ -856,10 +857,10 @@ optsubbody: subbody { $$ = $subbody; } /* Subroutine body (without signature) */ -subbody: remember '{' stmtseq '}' +subbody: remember PERLY_BRACE_OPEN stmtseq '}' { - if (parser->copline > (line_t)$2) - parser->copline = (line_t)$2; + if (parser->copline > (line_t)$PERLY_BRACE_OPEN) + parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($remember, $stmtseq); } ; @@ -871,10 +872,10 @@ optsigsubbody: sigsubbody { $$ = $sigsubbody; } | ';' { $$ = NULL; } /* Subroutine body with optional signature */ -sigsubbody: remember optsubsignature '{' stmtseq '}' +sigsubbody: remember optsubsignature PERLY_BRACE_OPEN stmtseq '}' { - if (parser->copline > (line_t)$3) - parser->copline = (line_t)$3; + if (parser->copline > (line_t)$PERLY_BRACE_OPEN) + parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($remember, op_append_list(OP_LINESEQ, $optsubsignature, $stmtseq)); } @@ -956,7 +957,7 @@ method : METHOD ; /* Some kind of subscripted expression */ -subscripted: gelem '{' expr ';' '}' /* *main::{something} */ +subscripted: gelem PERLY_BRACE_OPEN expr ';' '}' /* *main::{something} */ /* In this and all the hash accessors, ';' is * provided by the tokeniser */ { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } @@ -973,14 +974,14 @@ subscripted: gelem '{' expr ';' '}' /* *main::{something} */ ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); } - | scalar[hash] '{' expr ';' '}' /* $foo{bar();} */ + | scalar[hash] PERLY_BRACE_OPEN expr ';' '}' /* $foo{bar();} */ { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); } - | term[hash_reference] ARROW '{' expr ';' '}' /* somehref->{bar();} */ + | term[hash_reference] ARROW PERLY_BRACE_OPEN expr ';' '}' /* somehref->{bar();} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } - | subscripted[hash_reference] '{' expr ';' '}' /* $foo->[bar]->{baz;} */ + | subscripted[hash_reference] PERLY_BRACE_OPEN expr ';' '}' /* $foo->[bar]->{baz;} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } @@ -1197,7 +1198,7 @@ term[product] : termbinop $$->op_private |= $kvslice->op_private & OPpSLICEWARNING; } - | sliceme '{' expr ';' '}' /* @hash{@keys} */ + | sliceme PERLY_BRACE_OPEN expr ';' '}' /* @hash{@keys} */ { $$ = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1207,7 +1208,7 @@ term[product] : termbinop $$->op_private |= $sliceme->op_private & OPpSLICEWARNING; } - | kvslice '{' expr ';' '}' /* %hash{@keys} */ + | kvslice PERLY_BRACE_OPEN expr ';' '}' /* %hash{@keys} */ { $$ = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, diff --git a/toke.c b/toke.c index 9d9495f2c894..07134b57c45b 100644 --- a/toke.c +++ b/toke.c @@ -327,6 +327,9 @@ enum token_type { TOKENTYPE_OPVAL }; +#define DEBUG_TOKEN(Type, Name) \ + { Name, TOKENTYPE_##Type, #Name } + static struct debug_tokens { const int token; enum token_type type; @@ -383,6 +386,7 @@ static struct debug_tokens { { OROP, TOKENTYPE_IVAL, "OROP" }, { OROR, TOKENTYPE_NONE, "OROR" }, { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, + DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" }, @@ -415,6 +419,8 @@ static struct debug_tokens { { 0, TOKENTYPE_NONE, NULL } }; +#undef DEBUG_TOKEN + /* dump the returned token in rv, plus any optional arg in pl_yylval */ STATIC int @@ -2056,7 +2062,7 @@ Perl_yyunlex(pTHX) if (yyc != YYEMPTY) { if (yyc) { NEXTVAL_NEXTTOKE = PL_parser->yylval; - if (yyc == '{'/*}*/ || yyc == HASHBRACK || yyc == '['/*]*/) { + if (yyc == PERLY_BRACE_OPEN || yyc == HASHBRACK || yyc == '['/*]*/) { PL_lex_allbrackets--; PL_lex_brackets--; yyc |= (3<<24) | (PL_lex_brackstack[PL_lex_brackets] << 16); @@ -6175,7 +6181,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) pl_yylval.ival = CopLINE(PL_curcop); PL_copline = NOLINE; /* invalidate current command line number */ - TOKEN(formbrack ? '=' : '{'); + TOKEN(formbrack ? '=' : PERLY_BRACE_OPEN); } static int From d0a6a9c741483b2070b7815882f9135746610435 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:18:59 +0100 Subject: [PATCH 325/503] Distinguish C- and perly- literals - PERLY_BRACE_CLOSE --- perly.act | 536 ++++++++++---------- perly.h | 163 +++--- perly.tab | 1450 ++++++++++++++++++++++++++--------------------------- perly.y | 29 +- toke.c | 3 +- 5 files changed, 1089 insertions(+), 1092 deletions(-) diff --git a/perly.act b/perly.act index 11e91b8066b9..ea0608279a9a 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 123 "perly.y" +#line 124 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 128 "perly.y" +#line 129 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 134 "perly.y" +#line 135 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 139 "perly.y" +#line 140 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 144 "perly.y" +#line 145 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 149 "perly.y" +#line 150 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 157 "perly.y" +#line 158 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 162 "perly.y" +#line 163 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 170 "perly.y" +#line 171 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 175 "perly.y" +#line 176 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 183 "perly.y" +#line 184 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 188 "perly.y" +#line 189 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 193 "perly.y" +#line 194 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 198 "perly.y" +#line 199 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 206 "perly.y" +#line 207 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 214 "perly.y" +#line 215 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 221 "perly.y" +#line 222 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 226 "perly.y" +#line 227 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 233 "perly.y" +#line 234 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 239 "perly.y" +#line 240 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 241 "perly.y" +#line 242 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 250 "perly.y" +#line 251 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 252 "perly.y" +#line 253 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 261 "perly.y" +#line 262 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 265 "perly.y" +#line 266 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 269 "perly.y" +#line 270 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 276 "perly.y" +#line 277 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 286 "perly.y" +#line 287 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 288 "perly.y" +#line 289 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 300 "perly.y" +#line 301 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 306 "perly.y" +#line 307 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 321 "perly.y" +#line 322 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 327 "perly.y" +#line 328 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 338 "perly.y" +#line 339 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 345 "perly.y" +#line 346 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 347 "perly.y" +#line 348 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 354 "perly.y" +#line 355 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 360 "perly.y" +#line 361 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 366 "perly.y" +#line 367 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 371 "perly.y" +#line 372 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 373 "perly.y" +#line 374 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 375 "perly.y" +#line 376 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 382 "perly.y" +#line 383 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 389 "perly.y" +#line 390 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 391 "perly.y" +#line 392 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 394 "perly.y" +#line 395 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 409 "perly.y" +#line 410 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 414 "perly.y" +#line 415 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 420 "perly.y" +#line 421 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 422 "perly.y" +#line 423 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 435 "perly.y" +#line 436 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 443 "perly.y" +#line 444 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 449 "perly.y" +#line 450 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 455 "perly.y" +#line 456 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 462 "perly.y" +#line 463 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 470 "perly.y" +#line 471 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 474 "perly.y" +#line 475 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 479 "perly.y" +#line 480 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 487 "perly.y" +#line 488 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 504 "perly.y" +#line 505 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 506 "perly.y" +#line 507 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 514 "perly.y" +#line 515 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 516 "perly.y" +#line 517 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 518 "perly.y" +#line 519 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 520 "perly.y" +#line 521 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 522 "perly.y" +#line 523 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 536 "perly.y" +#line 537 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 541 "perly.y" +#line 542 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 551 "perly.y" +#line 552 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 553 "perly.y" +#line 554 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 558 "perly.y" +#line 559 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 564 "perly.y" +#line 565 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 570 "perly.y" +#line 571 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 578 "perly.y" +#line 579 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 583 "perly.y" +#line 584 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 587 "perly.y" +#line 588 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 590 "perly.y" +#line 591 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 591 "perly.y" +#line 592 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 595 "perly.y" +#line 596 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 601 "perly.y" +#line 602 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 606 "perly.y" +#line 607 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 617 "perly.y" +#line 618 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 623 "perly.y" +#line 624 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 625 "perly.y" +#line 626 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 627 "perly.y" +#line 628 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 632 "perly.y" +#line 633 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 634 "perly.y" +#line 635 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 645 "perly.y" +#line 646 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 647 "perly.y" +#line 648 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 652 "perly.y" +#line 653 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 654 "perly.y" +#line 655 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 658 "perly.y" +#line 659 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 677 "perly.y" +#line 678 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 679 "perly.y" +#line 680 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 681 "perly.y" +#line 682 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 687 "perly.y" +#line 688 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 752 "perly.y" +#line 753 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 754 "perly.y" +#line 755 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 760 "perly.y" +#line 761 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 762 "perly.y" +#line 763 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 766 "perly.y" +#line 767 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 771 "perly.y" +#line 772 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 773 "perly.y" +#line 774 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 777 "perly.y" +#line 778 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 779 "perly.y" +#line 780 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 783 "perly.y" +#line 784 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 786 "perly.y" +#line 787 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 797 "perly.y" +#line 798 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 854 "perly.y" +#line 855 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 855 "perly.y" +#line 856 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 861 "perly.y" +#line 862 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 871 "perly.y" +#line 872 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 872 "perly.y" +#line 873 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 876 "perly.y" +#line 877 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 887 "perly.y" +#line 888 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 889 "perly.y" +#line 890 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 891 "perly.y" +#line 892 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 897 "perly.y" +#line 898 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 899 "perly.y" +#line 900 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 908 "perly.y" +#line 909 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 912 "perly.y" +#line 913 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 916 "perly.y" +#line 917 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 922 "perly.y" +#line 923 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 927 "perly.y" +#line 928 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 933 "perly.y" +#line 934 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 939 "perly.y" +#line 940 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 941 "perly.y" +#line 942 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 943 "perly.y" +#line 944 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 945 "perly.y" +#line 946 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 948 "perly.y" +#line 949 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 963 "perly.y" +#line 964 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 965 "perly.y" +#line 966 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 968 "perly.y" +#line 969 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 973 "perly.y" +#line 974 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 978 "perly.y" +#line 979 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 981 "perly.y" +#line 982 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 985 "perly.y" +#line 986 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 989 "perly.y" +#line 990 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 995 "perly.y" +#line 996 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1003 "perly.y" +#line 1004 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1010 "perly.y" +#line 1011 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1016 "perly.y" +#line 1017 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1018 "perly.y" +#line 1019 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1020 "perly.y" +#line 1021 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1025 "perly.y" +#line 1026 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1027 "perly.y" +#line 1028 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1029 "perly.y" +#line 1030 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1034 "perly.y" +#line 1035 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1036 "perly.y" +#line 1037 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1038 "perly.y" +#line 1039 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1040 "perly.y" +#line 1041 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1042 "perly.y" +#line 1043 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1062 "perly.y" +#line 1063 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1064 "perly.y" +#line 1065 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1068 "perly.y" +#line 1069 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1070 "perly.y" +#line 1071 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1074 "perly.y" +#line 1075 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1076 "perly.y" +#line 1077 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1078 "perly.y" +#line 1079 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1080 "perly.y" +#line 1081 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1084 "perly.y" +#line 1085 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1086 "perly.y" +#line 1087 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1091 "perly.y" +#line 1092 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1093 "perly.y" +#line 1094 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1096 "perly.y" +#line 1097 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1098 "perly.y" +#line 1099 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1100 "perly.y" +#line 1101 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1117 "perly.y" +#line 1118 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1120 "perly.y" +#line 1121 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1127 "perly.y" +#line 1128 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1129 "perly.y" +#line 1130 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1131 "perly.y" +#line 1132 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1133 "perly.y" +#line 1134 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1135 "perly.y" +#line 1136 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1138 "perly.y" +#line 1139 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1144 "perly.y" +#line 1145 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1146 "perly.y" +#line 1147 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1154 "perly.y" +#line 1155 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1156 "perly.y" +#line 1157 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1158 "perly.y" +#line 1159 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1160 "perly.y" +#line 1161 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1162 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1192 "perly.y" +#line 1193 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1202 "perly.y" +#line 1203 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1212 "perly.y" +#line 1213 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1222 "perly.y" +#line 1223 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1224 "perly.y" +#line 1225 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1226 "perly.y" +#line 1227 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1229 "perly.y" +#line 1230 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1234 "perly.y" +#line 1235 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1238 "perly.y" +#line 1239 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1240 "perly.y" +#line 1241 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1242 "perly.y" +#line 1243 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1244 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1287 "perly.y" +#line 1288 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1298 "perly.y" +#line 1299 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1306 "perly.y" +#line 1307 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1308 "perly.y" +#line 1309 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1310 "perly.y" +#line 1311 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1315 "perly.y" +#line 1316 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1317 "perly.y" +#line 1318 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1320 "perly.y" +#line 1321 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1322 "perly.y" +#line 1323 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1324 "perly.y" +#line 1325 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1329 "perly.y" +#line 1330 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1331 "perly.y" +#line 1332 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1335 "perly.y" +#line 1336 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1337 "perly.y" +#line 1338 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1341 "perly.y" +#line 1342 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1343 "perly.y" +#line 1344 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1349 "perly.y" +#line 1350 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1366 "perly.y" +#line 1367 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1370 "perly.y" +#line 1371 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1374 "perly.y" +#line 1375 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1380 "perly.y" +#line 1381 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1386 "perly.y" +#line 1387 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1388 "perly.y" +#line 1389 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1392 "perly.y" +#line 1393 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1397 "perly.y" +#line 1398 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1402 "perly.y" +#line 1403 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1407 "perly.y" +#line 1408 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1412 "perly.y" +#line 1413 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1414 "perly.y" +#line 1415 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1416 "perly.y" +#line 1417 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1419 "perly.y" +#line 1420 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y + * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index e78d4a37981b..b91de7377d4e 100644 --- a/perly.h +++ b/perly.h @@ -64,86 +64,87 @@ extern int yydebug; GRAMSTMTSEQ = 263, GRAMSUBSIGNATURE = 264, PERLY_BRACE_OPEN = 265, - BAREWORD = 266, - METHOD = 267, - FUNCMETH = 268, - THING = 269, - PMFUNC = 270, - PRIVATEREF = 271, - QWLIST = 272, - FUNC0OP = 273, - FUNC0SUB = 274, - UNIOPSUB = 275, - LSTOPSUB = 276, - PLUGEXPR = 277, - PLUGSTMT = 278, - LABEL = 279, - FORMAT = 280, - SUB = 281, - SIGSUB = 282, - ANONSUB = 283, - ANON_SIGSUB = 284, - PACKAGE = 285, - USE = 286, - WHILE = 287, - UNTIL = 288, - IF = 289, - UNLESS = 290, - ELSE = 291, - ELSIF = 292, - CONTINUE = 293, - FOR = 294, - GIVEN = 295, - WHEN = 296, - DEFAULT = 297, - LOOPEX = 298, - DOTDOT = 299, - YADAYADA = 300, - FUNC0 = 301, - FUNC1 = 302, - FUNC = 303, - UNIOP = 304, - LSTOP = 305, - MULOP = 306, - ADDOP = 307, - DOLSHARP = 308, - DO = 309, - HASHBRACK = 310, - NOAMP = 311, - LOCAL = 312, - MY = 313, - REQUIRE = 314, - COLONATTR = 315, - FORMLBRACK = 316, - FORMRBRACK = 317, - SUBLEXSTART = 318, - SUBLEXEND = 319, - PREC_LOW = 320, - OROP = 321, - DOROP = 322, - ANDOP = 323, - NOTOP = 324, - ASSIGNOP = 325, - OROR = 326, - DORDOR = 327, - ANDAND = 328, - BITOROP = 329, - BITANDOP = 330, - CHEQOP = 331, - NCEQOP = 332, - CHRELOP = 333, - NCRELOP = 334, - SHIFTOP = 335, - MATCHOP = 336, - UMINUS = 337, - REFGEN = 338, - POWOP = 339, - PREINC = 340, - PREDEC = 341, - POSTINC = 342, - POSTDEC = 343, - POSTJOIN = 344, - ARROW = 345 + PERLY_BRACE_CLOSE = 266, + BAREWORD = 267, + METHOD = 268, + FUNCMETH = 269, + THING = 270, + PMFUNC = 271, + PRIVATEREF = 272, + QWLIST = 273, + FUNC0OP = 274, + FUNC0SUB = 275, + UNIOPSUB = 276, + LSTOPSUB = 277, + PLUGEXPR = 278, + PLUGSTMT = 279, + LABEL = 280, + FORMAT = 281, + SUB = 282, + SIGSUB = 283, + ANONSUB = 284, + ANON_SIGSUB = 285, + PACKAGE = 286, + USE = 287, + WHILE = 288, + UNTIL = 289, + IF = 290, + UNLESS = 291, + ELSE = 292, + ELSIF = 293, + CONTINUE = 294, + FOR = 295, + GIVEN = 296, + WHEN = 297, + DEFAULT = 298, + LOOPEX = 299, + DOTDOT = 300, + YADAYADA = 301, + FUNC0 = 302, + FUNC1 = 303, + FUNC = 304, + UNIOP = 305, + LSTOP = 306, + MULOP = 307, + ADDOP = 308, + DOLSHARP = 309, + DO = 310, + HASHBRACK = 311, + NOAMP = 312, + LOCAL = 313, + MY = 314, + REQUIRE = 315, + COLONATTR = 316, + FORMLBRACK = 317, + FORMRBRACK = 318, + SUBLEXSTART = 319, + SUBLEXEND = 320, + PREC_LOW = 321, + OROP = 322, + DOROP = 323, + ANDOP = 324, + NOTOP = 325, + ASSIGNOP = 326, + OROR = 327, + DORDOR = 328, + ANDAND = 329, + BITOROP = 330, + BITANDOP = 331, + CHEQOP = 332, + NCEQOP = 333, + CHRELOP = 334, + NCRELOP = 335, + SHIFTOP = 336, + MATCHOP = 337, + UMINUS = 338, + REFGEN = 339, + POWOP = 340, + PREINC = 341, + PREDEC = 342, + POSTINC = 343, + POSTDEC = 344, + POSTJOIN = 345, + ARROW = 346 }; #endif @@ -195,6 +196,6 @@ int yyparse (void); /* Generated from: - * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y + * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index d78c5dfba589..10a02b9bf0de 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3366 +#define YYLAST 3325 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 345 +#define YYMAXUTOK 346 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,16 +33,16 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 95, 2, 2, 109, 16, 17, 2, - 107, 106, 110, 14, 80, 13, 19, 111, 2, 2, + 2, 2, 2, 95, 2, 2, 109, 15, 16, 2, + 107, 106, 110, 13, 80, 12, 18, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 83, 108, - 2, 18, 2, 82, 15, 2, 2, 2, 2, 2, + 2, 17, 2, 82, 14, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 11, 2, 12, 2, 2, 2, 2, 2, 2, + 2, 10, 2, 11, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 10, 96, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 96, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,51 +56,51 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 20, 21, 22, 23, 24, - 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, - 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, - 75, 76, 77, 78, 79, 81, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 97, 98, 99, - 100, 101, 102, 103, 104, 105 + 5, 6, 7, 8, 9, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, + 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, + 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, + 74, 75, 76, 77, 78, 79, 81, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 97, 98, + 99, 100, 101, 102, 103, 104, 105 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 123, 123, 122, 134, 133, 144, 143, 157, 156, - 170, 169, 183, 182, 193, 192, 205, 213, 221, 225, - 233, 239, 240, 250, 251, 260, 264, 268, 275, 285, - 287, 300, 297, 321, 316, 337, 345, 344, 353, 359, - 365, 370, 372, 374, 381, 389, 391, 388, 408, 413, - 420, 419, 434, 442, 448, 455, 454, 469, 473, 478, - 486, 504, 505, 509, 513, 515, 517, 519, 521, 523, - 525, 528, 534, 535, 540, 551, 552, 558, 564, 565, - 570, 573, 577, 582, 586, 590, 591, 595, 601, 606, - 611, 612, 617, 618, 623, 624, 626, 631, 633, 645, - 646, 651, 653, 657, 677, 678, 680, 686, 751, 753, - 759, 761, 765, 771, 772, 777, 778, 782, 786, 786, - 854, 855, 860, 871, 872, 875, 886, 888, 890, 892, - 896, 898, 903, 907, 911, 915, 921, 926, 932, 938, - 940, 942, 945, 944, 955, 956, 960, 964, 967, 972, - 977, 980, 984, 988, 994, 1002, 1009, 1015, 1017, 1019, - 1024, 1026, 1028, 1033, 1035, 1037, 1039, 1041, 1043, 1045, - 1047, 1049, 1051, 1053, 1057, 1059, 1061, 1063, 1067, 1069, - 1073, 1075, 1077, 1079, 1083, 1085, 1090, 1092, 1095, 1097, - 1099, 1102, 1105, 1116, 1119, 1126, 1128, 1130, 1132, 1134, - 1137, 1143, 1145, 1149, 1150, 1151, 1152, 1153, 1155, 1157, - 1159, 1161, 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, - 1179, 1181, 1191, 1201, 1211, 1221, 1223, 1225, 1228, 1233, - 1237, 1239, 1241, 1243, 1246, 1248, 1251, 1253, 1255, 1257, - 1259, 1261, 1263, 1265, 1267, 1270, 1272, 1274, 1276, 1278, - 1280, 1284, 1287, 1286, 1299, 1300, 1301, 1305, 1307, 1309, - 1314, 1316, 1319, 1321, 1323, 1328, 1330, 1335, 1336, 1341, - 1342, 1348, 1352, 1353, 1354, 1357, 1358, 1361, 1362, 1365, - 1369, 1373, 1379, 1385, 1387, 1391, 1395, 1396, 1400, 1401, - 1405, 1406, 1411, 1413, 1415, 1418 + 0, 124, 124, 123, 135, 134, 145, 144, 158, 157, + 171, 170, 184, 183, 194, 193, 206, 214, 222, 226, + 234, 240, 241, 251, 252, 261, 265, 269, 276, 286, + 288, 301, 298, 322, 317, 338, 346, 345, 354, 360, + 366, 371, 373, 375, 382, 390, 392, 389, 409, 414, + 421, 420, 435, 443, 449, 456, 455, 470, 474, 479, + 487, 505, 506, 510, 514, 516, 518, 520, 522, 524, + 526, 529, 535, 536, 541, 552, 553, 559, 565, 566, + 571, 574, 578, 583, 587, 591, 592, 596, 602, 607, + 612, 613, 618, 619, 624, 625, 627, 632, 634, 646, + 647, 652, 654, 658, 678, 679, 681, 687, 752, 754, + 760, 762, 766, 772, 773, 778, 779, 783, 787, 787, + 855, 856, 861, 872, 873, 876, 887, 889, 891, 893, + 897, 899, 904, 908, 912, 916, 922, 927, 933, 939, + 941, 943, 946, 945, 956, 957, 961, 965, 968, 973, + 978, 981, 985, 989, 995, 1003, 1010, 1016, 1018, 1020, + 1025, 1027, 1029, 1034, 1036, 1038, 1040, 1042, 1044, 1046, + 1048, 1050, 1052, 1054, 1058, 1060, 1062, 1064, 1068, 1070, + 1074, 1076, 1078, 1080, 1084, 1086, 1091, 1093, 1096, 1098, + 1100, 1103, 1106, 1117, 1120, 1127, 1129, 1131, 1133, 1135, + 1138, 1144, 1146, 1150, 1151, 1152, 1153, 1154, 1156, 1158, + 1160, 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, + 1180, 1182, 1192, 1202, 1212, 1222, 1224, 1226, 1229, 1234, + 1238, 1240, 1242, 1244, 1247, 1249, 1252, 1254, 1256, 1258, + 1260, 1262, 1264, 1266, 1268, 1271, 1273, 1275, 1277, 1279, + 1281, 1285, 1288, 1287, 1300, 1301, 1302, 1306, 1308, 1310, + 1315, 1317, 1320, 1322, 1324, 1329, 1331, 1336, 1337, 1342, + 1343, 1349, 1353, 1354, 1355, 1358, 1359, 1362, 1363, 1366, + 1370, 1374, 1380, 1386, 1388, 1392, 1396, 1397, 1401, 1402, + 1406, 1407, 1412, 1414, 1416, 1419 }; #endif @@ -110,37 +110,38 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'}'", - "'['", "']'", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", - "PERLY_BRACE_OPEN", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", - "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", - "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", - "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", - "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", - "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", - "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", - "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", - "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", - "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", - "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", - "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "';'", "'$'", - "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", - "@7", "block", "formblock", "remember", "mblock", "mremember", "stmtseq", - "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", - "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", - "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", - "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", - "startformsub", "subname", "proto", "subattrlist", "myattrlist", - "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", - "sigscalarelem", "sigelem", "siglist", "siglistornull", - "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", - "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", - "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", - "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", - "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", - "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", - "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'['", + "']'", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", + "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "BAREWORD", "METHOD", + "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", + "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", + "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", + "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", + "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", + "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", + "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", + "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", + "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", + "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", + "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", + "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", + "ARROW", "')'", "'('", "';'", "'$'", "'*'", "'/'", "$accept", "grammar", + "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", + "remember", "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", + "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", + "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", + "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", + "startsub", "startanonsub", "startformsub", "subname", "proto", + "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", + "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", + "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", + "listexpr", "listop", "@16", "method", "subscripted", "termbinop", + "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", + "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", + "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", + "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", + "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -150,21 +151,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 125, 91, 93, 45, 43, 64, 37, 38, 61, 46, - 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, - 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, - 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, - 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, - 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, - 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, - 44, 325, 63, 58, 326, 327, 328, 329, 330, 331, - 332, 333, 334, 335, 336, 33, 126, 337, 338, 339, - 340, 341, 342, 343, 344, 345, 41, 40, 59, 36, + 91, 93, 45, 43, 64, 37, 38, 61, 46, 265, + 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, + 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, + 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, + 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, + 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, + 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, + 44, 326, 63, 58, 327, 328, 329, 330, 331, 332, + 333, 334, 335, 336, 337, 33, 126, 338, 339, 340, + 341, 342, 343, 344, 345, 346, 41, 40, 59, 36, 42, 47 }; # endif -#define YYPACT_NINF (-474) +#define YYPACT_NINF (-495) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -178,64 +179,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 850, -474, -474, -474, -474, -474, -474, -474, 47, -474, - 2993, 49, 1591, 1490, -474, -474, -474, -474, 1993, 2993, - 2993, 64, 64, 64, -474, 64, 64, -474, -474, 1, - -49, -474, 2993, -474, -474, -474, -474, 2993, -20, -14, - -53, 2093, 1893, 64, 2093, 2193, 44, 2993, 8, 2993, - 2993, 2993, 2993, 2993, 2993, 2993, 2293, 64, 64, 345, - 21, -474, -4, -474, -16, 16, 70, 25, -474, -474, - -474, 3169, -474, -474, -3, 46, 71, 78, -474, 98, - 164, 167, 106, -474, -474, -474, -474, -474, 44, 44, - 122, -474, 60, 65, 72, 75, 280, 81, 85, 49, - 45, -474, 101, -474, 86, 231, 1490, -474, -474, -474, - 681, -474, 10, 783, -474, 55, 660, 660, -474, -474, - -474, -474, -474, -474, -474, 2993, 119, 161, 2993, 132, - 431, 49, 218, 195, 3169, 160, 2393, 2993, 1893, -474, - 431, 572, 21, -474, 477, 2993, -474, -474, 431, 258, - 136, -474, -474, 2993, 431, 3093, 2493, 209, -474, -474, - -474, 431, 21, 660, 660, 660, 565, 565, 270, 471, - -474, -474, 2993, 2993, 2993, 2993, 2993, 2993, 2593, -474, - -474, 2993, -474, -474, 2993, 2993, 2993, 2993, 2993, 2993, - 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, 2993, - 2993, 2993, -474, -474, -474, 29, 2693, 2993, 2993, 2993, - 2993, 2993, 2993, 2993, -474, 262, -474, -474, 294, -474, - -474, -474, -474, -474, 220, 15, -474, -474, 215, -474, - -474, -474, -474, 49, -474, -474, 2993, 2993, 2993, 2993, - 2993, 2993, -474, -474, -474, -474, -474, 290, 290, -474, - -474, -474, 251, -474, -474, -474, 2993, 2993, 113, -474, - -474, -474, 195, 299, -474, -474, -474, 497, 268, 234, - 2993, 21, -474, 333, -474, 2793, 660, 209, 42, 57, - 126, -474, 513, 329, -474, 2993, 346, 283, 283, -474, - 3169, 133, 248, -474, 516, 431, 364, 3261, 585, 382, - 3169, 3123, 315, 315, 1675, 1775, 538, 364, 364, 431, - 431, 667, 660, 660, 2993, 255, 264, 265, 2993, -474, - 272, 2893, 53, 273, 261, -474, -474, 519, 159, 303, - 169, 320, 183, 357, 434, 884, -474, 340, -474, -474, - -11, 341, 2993, 2993, 2993, 2993, -474, 277, -474, -474, - 284, -474, -474, -474, -474, 1692, 12, -474, 2993, 2993, - -474, -474, 345, -474, 345, -474, -474, -474, -474, -474, - 309, 309, 10, 289, -39, -474, 2993, -474, -474, 306, - -474, -474, -474, -474, 529, -474, 39, 532, -474, -474, - -474, 243, 2993, -474, 390, -474, 2993, 252, -474, -474, - -474, 438, -474, -474, 679, -474, -474, 2993, -474, -474, - 405, -474, 419, -474, 420, 427, -474, -474, -474, 218, - 195, -474, -474, 417, 334, 345, 335, 336, 345, 342, - 343, -474, -474, -474, -474, 348, 344, 402, -474, 2993, - 353, 354, 2993, -474, -474, -474, -474, 2993, 375, -474, - 442, -474, -474, 444, -474, -474, 41, -474, 293, -474, - 3215, -474, 463, -474, 369, -474, -474, -474, -474, 374, - 195, 386, -474, 2993, -474, -474, 470, 470, 2993, 2993, - 470, -474, 388, 392, 470, 470, 3169, 345, -474, -474, - 394, -474, -474, -474, -474, 424, 393, -474, -474, -474, - -474, 409, 470, 470, -474, 139, 139, 407, 412, 101, - 2993, 2993, 470, -474, -474, 985, -474, 1086, -474, -474, - -474, -474, 1187, -474, 101, 101, -474, 470, 416, -474, - -474, 470, 470, -474, 421, 426, 101, -474, -474, -9, - -474, -474, -474, 1288, -474, 2993, 101, 101, -474, 470, - -474, 456, 521, -474, -474, 435, -474, -474, -474, 101, - -474, -474, -474, 470, 1793, -474, 1389, 139, 446, -474, - -474, 470, -474 + 842, -495, -495, -495, -495, -495, -495, -495, 20, -495, + 2997, 11, 1583, 1482, -495, -495, -495, -495, 1987, 2997, + 2997, 28, 28, 28, -495, 28, 28, -495, -495, 18, + -67, -495, 2997, -495, -495, -495, -495, 2997, -61, -55, + -20, 2088, 1886, 28, 2088, 2189, 36, 2997, 17, 2997, + 2997, 2997, 2997, 2997, 2997, 2997, 2290, 28, 28, 111, + -22, -495, -3, -495, -23, -26, 70, -19, -495, -495, + -495, 3128, -495, -495, -25, 65, 93, 176, -495, 88, + 237, 245, 90, -495, -495, -495, -495, -495, 36, 36, + 96, -495, 7, 39, 42, 46, 128, 71, 74, 11, + 105, -495, 186, -495, 130, 325, 1482, -495, -495, -495, + 673, -495, 12, 775, -495, 55, 500, 500, -495, -495, + -495, -495, -495, -495, -495, 2997, 129, 184, 2997, 162, + 431, 11, 249, 235, 3128, 209, 2391, 2997, 1886, -495, + 431, 573, -22, -495, 477, 2997, -495, -495, 431, 99, + 240, -495, -495, 2997, 431, 3098, 2492, 239, -495, -495, + -495, 431, -22, 500, 500, 500, 507, 507, 314, 280, + -495, -495, 2997, 2997, 2997, 2997, 2997, 2997, 2593, -495, + -495, 2997, -495, -495, 2997, 2997, 2997, 2997, 2997, 2997, + 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, + 2997, 2997, -495, -495, -495, 75, 2694, 2997, 2997, 2997, + 2997, 2997, 2997, 2997, -495, 302, -495, -495, 304, -495, + -495, -495, -495, -495, 234, 9, -495, -495, 226, -495, + -495, -495, -495, 11, -495, -495, 2997, 2997, 2997, 2997, + 2997, 2997, -495, -495, -495, -495, -495, 316, 316, -495, + -495, -495, 260, -495, -495, -495, 2997, 2997, 95, -495, + -495, -495, 235, 319, -495, -495, -495, 313, 270, 256, + 2997, -22, -495, 345, -495, 2795, 500, 239, 31, 57, + 73, -495, 328, 347, -495, 2997, 365, 303, 303, -495, + 3128, 114, 253, -495, 379, 431, 1929, 3220, 652, 412, + 3128, 360, 1668, 1668, 1768, 1868, 539, 1929, 1929, 431, + 431, 659, 500, 500, 2997, 272, 287, 288, 2997, -495, + 290, 2896, 53, 298, 306, -495, -495, 513, 134, 301, + 164, 390, 168, 402, 464, 876, -495, 370, -495, -495, + -10, 394, 2997, 2997, 2997, 2997, -495, 311, -495, -495, + 318, -495, -495, -495, -495, 1684, 30, -495, 2997, 2997, + -495, -495, 111, -495, 111, -495, -495, -495, -495, -495, + 330, 330, 12, 317, 56, -495, 2997, -495, -495, 321, + -495, -495, -495, -495, 517, -495, 23, 520, -495, -495, + -495, 183, 2997, -495, 406, -495, 2997, 198, -495, -495, + -495, 470, -495, -495, 530, -495, -495, 2997, -495, -495, + 409, -495, 413, -495, 415, 417, -495, -495, -495, 249, + 235, -495, -495, 419, 332, 111, 352, 354, 111, 363, + 368, -495, -495, -495, -495, 375, 374, 277, -495, 2997, + 378, 380, 2997, -495, -495, -495, -495, 2997, 416, -495, + 457, -495, -495, 475, -495, -495, 41, -495, 203, -495, + 3174, -495, 469, -495, 389, -495, -495, -495, -495, 392, + 235, 393, -495, 2997, -495, -495, 478, 478, 2997, 2997, + 478, -495, 397, 399, 478, 478, 3128, 111, -495, -495, + 401, -495, -495, -495, -495, 436, 404, -495, -495, -495, + -495, 405, 478, 478, -495, 160, 160, 421, 423, 186, + 2997, 2997, 478, -495, -495, 977, -495, 1078, -495, -495, + -495, -495, 1179, -495, 186, 186, -495, 478, 411, -495, + -495, 478, 478, -495, 424, 438, 186, -495, -495, -9, + -495, -495, -495, 1280, -495, 2997, 186, 186, -495, 478, + -495, 452, 531, -495, -495, 446, -495, -495, -495, 186, + -495, -495, -495, 478, 1785, -495, 1381, 160, 450, -495, + -495, 478, -495 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -306,16 +307,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -474, -474, -474, -474, -474, -474, -474, -474, -474, 228, - -474, -5, -139, -474, -17, -474, 531, 450, -1, -474, - -474, -474, -474, -474, -474, -474, -474, -474, 266, -341, - -473, -192, -458, -474, 68, 244, -337, 22, -474, -10, - 205, -474, 168, 179, -243, 324, 356, -474, -474, 240, - -474, 230, -474, -474, -474, -474, 166, -474, -474, 116, - -474, 142, -8, -37, -474, -474, -474, -474, -474, -474, - -474, -474, -474, -474, -474, -474, 103, -474, -474, 465, - -124, -95, -474, -474, 288, -474, -474, 399, 38, -45, - -42, -474, -474, -474, -474, -474, 13 + -495, -495, -495, -495, -495, -495, -495, -495, -495, 228, + -495, -5, -139, -495, -17, -495, 561, 471, -1, -495, + -495, -495, -495, -495, -495, -495, -495, -495, 430, -341, + -494, -129, -458, -495, 76, 232, -337, 50, -495, 49, + 247, -495, 219, 173, -243, 310, 372, -495, -495, 242, + -495, 265, -495, -495, -495, -495, 169, -495, -495, 143, + -495, 154, -8, -37, -495, -495, -495, -495, -495, -495, + -495, -495, -495, -495, -495, -495, 103, -495, -495, 485, + -124, -95, -495, -495, 289, -495, -495, 427, 38, -45, + -42, -495, -495, -495, -495, -495, 13 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -339,116 +340,95 @@ static const yytype_int16 yydefgoto[] = static const yytype_int16 yytable[] = { 113, 255, 59, 159, 17, 142, 160, 176, 429, 421, - 115, 103, 128, 162, 433, 551, 177, 503, 435, 377, - 137, 440, 441, 21, 22, 245, 246, 21, 22, 274, - 21, 22, 23, 530, 122, 123, 124, 150, 125, 126, - 314, 175, 268, 269, 315, 316, 317, 16, 169, 318, - 285, 319, 392, 207, 138, 145, 146, 207, 129, 121, - 121, 121, 208, 121, 121, 151, 208, 254, -286, 83, - 152, 171, 447, 83, 118, 179, 180, -286, 214, 119, - 144, 121, -286, 348, 83, 118, 158, 135, 142, -288, - 119, -286, 320, 136, 570, 121, 121, 422, -288, 552, - 564, 175, 483, 178, 206, 243, 155, 181, 271, -261, - 279, -260, -262, 280, 184, 156, 142, 57, -290, 247, - 258, 57, 116, 117, 57, 375, 213, -264, 267, 59, - 59, 172, 173, 174, 228, 130, 321, -288, 322, 323, - 134, 507, 508, 218, 140, 393, -288, 148, 282, 233, - 154, 270, 161, 232, 163, 164, 165, 166, 167, 182, - 183, 373, 57, 405, 287, 288, 289, 220, 291, 292, - 294, 409, 221, 57, 535, 209, 144, 471, 211, 222, - 353, 411, 223, 354, 210, 527, 528, 212, 229, 172, - 173, 174, 230, 278, 235, 413, -263, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 338, 339, 555, 172, - 173, 174, 172, 173, 174, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 256, 496, 362, 364, - 362, 362, 362, 362, 257, 172, 173, 174, 259, 84, - 132, 133, 261, 325, 273, 172, 173, 174, 59, 120, - 120, 120, 449, 120, 120, 457, 216, 217, 276, 172, - 173, 174, 384, 352, 461, 263, 265, 387, 272, 139, - 120, 120, 147, 236, 237, 238, 239, 391, 290, 283, - 240, 285, 241, 336, 295, 120, 120, 296, 297, 298, + 115, 103, 530, 162, 433, 551, 177, 503, 435, 377, + 16, 440, 441, 21, 22, 23, 245, 246, 128, 274, + 83, 21, 22, 285, 122, 123, 124, 150, 125, 126, + 129, 207, 268, 269, 21, 22, 135, 83, 169, 118, + 208, 392, 136, 137, 119, 145, 146, 151, 175, 121, + 121, 121, 152, 121, 121, 181, 254, -286, 179, 180, + 184, 171, 83, 570, 118, 207, -286, 348, 214, 119, + 144, 121, 206, -288, 208, 314, 158, 138, 142, 315, + 316, 317, -288, -261, 318, 121, 121, 319, 422, 552, + 564, -262, 483, -286, 178, 243, 375, -290, 271, 213, + 279, -260, -286, 280, 220, 155, 142, 218, 57, 272, + 258, 247, 116, 117, 156, 393, 57, -264, 267, 59, + 59, 172, 173, 174, 228, 130, 175, 57, 320, 57, + 134, 507, 508, -263, 140, 409, 221, 148, 282, 222, + 154, 270, 161, 223, 163, 164, 165, 166, 167, 182, + 183, 373, 57, 405, 287, 288, 289, 447, 291, 292, + 294, 172, 173, 174, 535, 411, 144, 471, 229, 413, + 353, 230, 321, 354, 322, 323, -288, 172, 173, 174, + 172, 173, 174, 278, 457, -288, 224, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 527, 528, 555, 461, + 172, 173, 174, 232, 492, 342, 343, 344, 345, 347, + 374, 355, 356, 433, 358, 359, 225, 496, 362, 364, + 362, 362, 362, 362, 233, 226, 256, 57, 235, 84, + 172, 173, 174, 325, 172, 173, 174, 209, 59, 120, + 120, 120, 449, 120, 120, 211, 210, 257, 276, 172, + 173, 174, 384, 352, 212, 338, 339, 387, 259, 139, + 120, 120, 147, 261, 172, 173, 174, 391, 290, 172, + 173, 174, 132, 133, 295, 120, 120, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 492, 397, 172, 173, 174, - 401, 353, 464, 404, 354, 340, 369, 533, 346, 172, - 173, 174, 357, 378, 172, 173, 174, 231, 172, 173, - 174, 372, 541, 542, 425, 364, 428, 428, 506, 142, - 383, 509, 382, 385, 550, 513, 514, 437, 224, 501, - 428, 428, 439, 390, 556, 557, 394, 392, 417, 260, - 121, 174, 423, 524, 525, 398, 120, 565, 407, 172, - 173, 174, 450, 536, 399, 400, 186, 187, 225, 172, - 173, 174, 402, 406, 458, 431, 57, 226, 544, 57, - 442, 432, 546, 547, 352, 446, 172, 173, 174, 59, - 459, 192, 193, 194, 195, 196, 197, 198, 199, 200, - 559, 410, 469, 452, 201, 465, 472, 202, 203, 204, - 205, 172, 173, 174, 567, 186, 187, 479, 412, 466, - 467, 428, 572, 172, 173, 174, 142, 468, 473, 487, - 474, 475, 476, 186, 236, 237, 238, 239, 477, 488, - 478, 240, 481, 241, 480, 197, 198, 199, 200, 484, - 485, 360, 489, 201, 491, 414, 202, 203, 204, 205, - 428, 428, 515, 493, 517, 494, 200, -215, 172, 173, - 174, 201, 495, 522, 202, 203, 204, 205, 207, -215, - 504, 450, 186, 187, 497, 511, 518, 208, 512, 460, - 516, 519, 425, 428, 365, 366, 367, 368, -83, 543, - 172, 173, 174, 531, 172, 173, 174, 523, 532, -215, - -215, -215, -215, 545, 199, 200, -215, 560, -215, 548, - 201, -215, 549, 202, 203, 204, 205, 428, -215, -215, - 562, 563, 415, 566, 107, 486, 462, 172, 173, 174, - 120, -215, 571, -215, -215, -215, 242, -215, -215, -215, + 309, 310, 311, 312, 313, 263, 397, 216, 217, 283, + 401, 353, 464, 404, 354, 265, 172, 173, 174, 236, + 237, 238, 239, 336, 285, 340, 240, 231, 241, 172, + 173, 174, 346, 357, 425, 364, 428, 428, 506, 142, + 372, 509, 369, 378, 382, 513, 514, 437, 273, 501, + 428, 428, 439, 172, 173, 174, 172, 173, 174, 260, + 121, 394, 383, 524, 525, 385, 120, 236, 237, 238, + 239, 390, 450, 536, 240, 392, 241, 172, 173, 174, + 533, 174, 398, -83, 458, 431, 286, 417, 544, 172, + 173, 174, 546, 547, 352, 541, 542, 399, 400, 59, + 402, 172, 173, 174, 172, 173, 174, 550, 406, 410, + 559, 442, 469, 407, 185, 423, 472, 556, 557, 381, + 57, 186, 187, 446, 567, 432, 459, 479, 452, 465, + 565, 428, 572, 466, 389, 467, 142, 468, 474, 487, + 473, 188, 189, 396, 190, 191, 192, 193, 194, 195, + 196, 197, 198, 199, 200, 172, 173, 174, 475, 201, + 476, 360, 202, 203, 204, 205, 172, 173, 174, 477, + 428, 428, 515, 186, 517, 478, 489, -215, 172, 173, + 174, 480, 481, 522, 484, 395, 485, 207, -215, 493, + 488, 450, 186, 187, 491, 494, 208, 504, 412, 460, + 495, 497, 425, 428, 511, 512, 200, 516, 518, 543, + 414, 201, 519, 523, 202, 203, 204, 205, 545, -215, + -215, -215, -215, 560, 199, 200, -215, 531, -215, 532, + 201, -215, 548, 202, 203, 204, 205, 428, -215, -215, + 172, 173, 174, 566, 549, 486, 172, 173, 174, 562, + 120, -215, 563, -215, -215, -215, 571, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -254, 172, 173, 174, -215, 286, 534, -215, - -215, -215, -215, -215, -254, -215, 568, 426, -215, 172, - 173, 174, 172, 173, 174, 172, 173, 174, 470, 186, - 187, 388, 445, 381, 371, 172, 173, 174, 172, 173, - 174, 444, 521, 499, -254, -254, -254, -254, 490, 389, - 277, -254, 395, -254, 351, 408, -254, 195, 196, 197, - 198, 199, 200, -254, -254, 455, 0, 201, 456, 0, - 202, 203, 204, 205, 438, 0, -254, 0, -254, -254, - -254, 0, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -291, -291, -291, - 205, -254, 0, 0, -254, -254, -254, -254, -254, 200, - -254, -13, 85, -254, 201, 0, 0, 202, 203, 204, - 205, 0, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, - 36, 90, 91, 92, 93, 94, 95, 0, 186, 187, - 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 172, 173, 174, 0, 201, - 50, 200, 202, 203, 204, 205, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, -3, 85, 463, 0, 0, 56, 101, - 57, 58, 0, 0, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, + -215, -215, 415, -254, 107, 426, -215, 242, 462, -215, + -215, -215, -215, -215, -254, -215, 534, 388, -215, 172, + 173, 174, 470, 172, 173, 174, 172, 173, 174, 201, + 186, 187, 202, 203, 204, 205, 172, 173, 174, -291, + -291, -291, 205, 444, 568, -254, -254, -254, -254, 408, + 371, 490, -254, 455, -254, 499, 456, -254, 195, 196, + 197, 198, 199, 200, -254, -254, 463, 445, 201, 521, + 277, 202, 203, 204, 205, 438, 0, -254, 0, -254, + -254, -254, 351, -254, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, 365, 366, + 367, 368, -254, -13, 85, -254, -254, -254, -254, -254, + 0, -254, 0, 18, -254, 19, 20, 21, 22, 23, + 0, 0, 83, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, + 186, 187, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 1, 2, 3, 4, 5, 6, 7, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 101, 57, 58, 416, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 83, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, - 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, - 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 101, 57, 58, 537, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 83, 24, 25, 26, 27, + 47, 48, 49, 0, 0, 0, 200, 0, 0, 0, + 0, 201, 50, 200, 202, 203, 204, 205, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, + 56, 101, 57, 58, 0, 18, 0, 19, 20, 21, + 22, 23, 0, 0, 83, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, + 6, 7, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 538, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 83, 24, 25, 26, + 0, 0, 56, 101, 57, 58, 18, 0, 19, 20, + 21, 22, 23, 0, 0, 83, 416, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, @@ -457,8 +437,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 101, 57, 58, 540, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 83, 24, 25, + 0, 0, 0, 56, 101, 57, 58, 18, 0, 19, + 20, 21, 22, 23, 0, 0, 83, 537, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, @@ -467,8 +447,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 101, 57, 58, 554, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 83, 24, + 0, 0, 0, 0, 56, 101, 57, 58, 18, 0, + 19, 20, 21, 22, 23, 0, 0, 83, 538, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, @@ -477,19 +457,19 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 101, 57, 58, 0, - 18, 0, 19, 20, 21, 22, 23, 0, 0, 83, + 85, 0, 0, 0, 0, 56, 101, 57, 58, 18, + 0, 19, 20, 21, 22, 23, 0, 0, 83, 540, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 569, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 0, 18, 0, 19, 20, 21, 22, 23, 0, 0, - 83, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 18, 0, 19, 20, 21, 22, 23, 0, 0, 83, + 554, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, @@ -498,108 +478,129 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, - 58, 0, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 83, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 86, 0, 87, 88, 89, 35, + 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, + 83, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, - 57, 58, 0, 18, 0, 19, 20, 21, 22, 23, - 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, + 0, 83, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, + 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, + 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 193, 194, 195, 196, 197, 198, 199, 200, - 0, 50, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - -78, 57, 58, 0, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 194, 195, 196, 197, 198, 199, 200, - 0, 0, 50, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, -78, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 83, 141, 25, 26, 27, 28, 119, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 0, 57, 58, 18, 114, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 83, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 149, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 168, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 266, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 101, 57, 58, 18, 0, 19, 20, 21, 22, 23, + 0, 0, 83, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 86, 0, 87, 88, + 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, + 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 281, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 101, 57, 58, 18, 0, 19, 20, 21, 22, + 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, -78, 57, 58, 18, 0, 19, 20, 21, + 22, 23, 0, 0, 0, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 50, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, + 0, -78, 56, 0, 57, 58, 18, 0, 19, 20, + 21, 22, 23, 0, 0, 83, 0, 141, 25, 26, + 27, 28, 119, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 50, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 186, 187, 0, 56, 0, 57, 58, 18, 114, 19, + 20, 21, 22, 23, 0, 0, 0, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 197, 198, 199, 200, 0, 35, 36, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, + 19, 20, 21, 22, 23, 0, 0, 83, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 0, 56, 0, 57, 58, 18, + 0, 19, 20, 21, 22, 23, 0, 0, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 0, 56, 149, 57, 58, + 18, 0, 19, 20, 21, 22, 23, 0, 0, 0, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 0, 0, 0, 0, 168, 56, 0, 57, + 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, + 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, 266, 56, 0, + 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, + 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, + 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -609,187 +610,162 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 386, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 403, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 185, 0, 0, - 0, 0, 0, 0, 186, 187, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 275, 0, 57, 58, 188, 189, 396, 190, 191, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, - 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, - 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, + 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, + 326, 56, 0, 57, 58, 18, 0, 19, 20, 21, + 22, 23, 0, 0, 0, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 188, 189, 0, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 386, 56, 0, 57, 58, 18, 0, 19, 20, + 21, 22, 23, 0, 0, 0, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 189, 0, 190, - 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, - 0, 0, 0, 0, 201, -291, 0, 202, 203, 204, - 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 403, 56, 0, 57, 58, 18, 0, 19, + 20, 21, 22, 23, 0, 0, 0, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205 + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, + 19, 20, 21, 22, 23, 0, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 0, 275, 0, 57, 58, 188, + 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, + 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 189, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, -291, 0, 202, 203, 204, 205, + 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 190, 191, 192, 193, 194, 195, + 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, + 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 11, 345, 20, - 18, 12, 11, 50, 355, 24, 20, 475, 355, 262, - 73, 358, 359, 15, 16, 15, 16, 15, 16, 153, - 15, 16, 17, 506, 21, 22, 23, 45, 25, 26, - 11, 80, 137, 138, 15, 16, 17, 0, 56, 20, - 11, 22, 11, 11, 107, 42, 43, 11, 107, 21, - 22, 23, 20, 25, 26, 21, 20, 12, 11, 20, - 26, 58, 111, 20, 21, 91, 92, 20, 83, 26, - 42, 43, 11, 68, 20, 21, 48, 107, 125, 11, - 26, 20, 63, 107, 567, 57, 58, 108, 20, 108, - 558, 80, 439, 107, 107, 106, 98, 91, 145, 70, - 155, 70, 70, 155, 89, 107, 153, 109, 20, 109, - 128, 109, 19, 20, 109, 12, 20, 70, 136, 137, - 138, 76, 77, 78, 96, 32, 107, 11, 109, 110, - 37, 478, 479, 21, 41, 12, 20, 44, 156, 48, - 47, 138, 49, 108, 51, 52, 53, 54, 55, 89, - 90, 256, 109, 110, 172, 173, 174, 107, 176, 177, - 178, 12, 107, 109, 511, 11, 138, 420, 11, 107, - 225, 12, 107, 225, 20, 46, 47, 20, 107, 76, - 77, 78, 107, 155, 108, 12, 70, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 216, 217, 545, 76, - 77, 78, 76, 77, 78, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 107, 470, 236, 237, - 238, 239, 240, 241, 73, 76, 77, 78, 106, 11, - 35, 36, 24, 205, 108, 76, 77, 78, 256, 21, - 22, 23, 376, 25, 26, 12, 88, 89, 155, 76, - 77, 78, 270, 225, 12, 70, 106, 275, 10, 41, - 42, 43, 44, 42, 43, 44, 45, 285, 175, 70, - 49, 11, 51, 21, 181, 57, 58, 184, 185, 186, + 17, 125, 10, 48, 9, 42, 48, 10, 345, 19, + 18, 12, 506, 50, 355, 24, 19, 475, 355, 262, + 0, 358, 359, 14, 15, 16, 14, 15, 10, 153, + 19, 14, 15, 10, 21, 22, 23, 45, 25, 26, + 107, 10, 137, 138, 14, 15, 107, 19, 56, 21, + 19, 10, 107, 73, 26, 42, 43, 21, 80, 21, + 22, 23, 26, 25, 26, 91, 11, 10, 91, 92, + 89, 58, 19, 567, 21, 10, 19, 68, 83, 26, + 42, 43, 107, 10, 19, 10, 48, 107, 125, 14, + 15, 16, 19, 70, 19, 57, 58, 22, 108, 108, + 558, 70, 439, 10, 107, 106, 11, 19, 145, 19, + 155, 70, 19, 155, 107, 98, 153, 21, 109, 20, + 128, 109, 19, 20, 107, 11, 109, 70, 136, 137, + 138, 76, 77, 78, 96, 32, 80, 109, 63, 109, + 37, 478, 479, 70, 41, 11, 107, 44, 156, 107, + 47, 138, 49, 107, 51, 52, 53, 54, 55, 89, + 90, 256, 109, 110, 172, 173, 174, 111, 176, 177, + 178, 76, 77, 78, 511, 11, 138, 420, 107, 11, + 225, 107, 107, 225, 109, 110, 10, 76, 77, 78, + 76, 77, 78, 155, 11, 19, 68, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 46, 47, 545, 11, + 76, 77, 78, 108, 11, 220, 221, 222, 223, 224, + 257, 226, 227, 564, 229, 230, 98, 470, 236, 237, + 238, 239, 240, 241, 48, 107, 107, 109, 108, 11, + 76, 77, 78, 205, 76, 77, 78, 10, 256, 21, + 22, 23, 376, 25, 26, 10, 19, 73, 155, 76, + 77, 78, 270, 225, 19, 216, 217, 275, 106, 41, + 42, 43, 44, 24, 76, 77, 78, 285, 175, 76, + 77, 78, 35, 36, 181, 57, 58, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 12, 314, 76, 77, 78, - 318, 356, 407, 321, 356, 21, 26, 509, 98, 76, - 77, 78, 107, 24, 76, 77, 78, 99, 76, 77, - 78, 80, 524, 525, 342, 343, 344, 345, 477, 376, - 106, 480, 74, 10, 536, 484, 485, 355, 68, 473, - 358, 359, 357, 24, 546, 547, 108, 11, 18, 131, - 322, 78, 21, 502, 503, 110, 138, 559, 107, 76, - 77, 78, 377, 512, 110, 110, 61, 62, 98, 76, - 77, 78, 110, 110, 392, 347, 109, 107, 527, 109, - 81, 107, 531, 532, 356, 106, 76, 77, 78, 407, - 10, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 549, 108, 417, 107, 99, 10, 421, 102, 103, 104, - 105, 76, 77, 78, 563, 61, 62, 432, 108, 10, - 10, 439, 571, 76, 77, 78, 473, 10, 21, 447, - 106, 106, 106, 61, 42, 43, 44, 45, 106, 74, - 107, 49, 108, 51, 106, 91, 92, 93, 94, 106, - 106, 233, 20, 99, 20, 108, 102, 103, 104, 105, - 478, 479, 489, 10, 491, 106, 94, 0, 76, 77, - 78, 99, 108, 500, 102, 103, 104, 105, 11, 12, - 20, 496, 61, 62, 108, 107, 72, 20, 106, 396, - 106, 108, 510, 511, 238, 239, 240, 241, 106, 526, - 76, 77, 78, 106, 76, 77, 78, 108, 106, 42, - 43, 44, 45, 107, 93, 94, 49, 71, 51, 108, - 99, 54, 106, 102, 103, 104, 105, 545, 61, 62, - 19, 106, 108, 560, 13, 442, 108, 76, 77, 78, + 197, 198, 199, 200, 201, 70, 314, 88, 89, 70, + 318, 356, 407, 321, 356, 106, 76, 77, 78, 42, + 43, 44, 45, 21, 10, 21, 49, 99, 51, 76, + 77, 78, 98, 107, 342, 343, 344, 345, 477, 376, + 80, 480, 26, 24, 74, 484, 485, 355, 108, 473, + 358, 359, 357, 76, 77, 78, 76, 77, 78, 131, + 322, 108, 106, 502, 503, 20, 138, 42, 43, 44, + 45, 24, 377, 512, 49, 10, 51, 76, 77, 78, + 509, 78, 110, 106, 392, 347, 106, 17, 527, 76, + 77, 78, 531, 532, 356, 524, 525, 110, 110, 407, + 110, 76, 77, 78, 76, 77, 78, 536, 110, 108, + 549, 81, 417, 107, 54, 21, 421, 546, 547, 106, + 109, 61, 62, 106, 563, 107, 20, 432, 107, 20, + 559, 439, 571, 20, 106, 20, 473, 20, 106, 447, + 21, 81, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 76, 77, 78, 106, 99, + 106, 233, 102, 103, 104, 105, 76, 77, 78, 106, + 478, 479, 489, 61, 491, 107, 19, 0, 76, 77, + 78, 106, 108, 500, 106, 106, 106, 10, 11, 20, + 74, 496, 61, 62, 19, 106, 19, 19, 108, 396, + 108, 108, 510, 511, 107, 106, 94, 106, 72, 526, + 108, 99, 108, 108, 102, 103, 104, 105, 107, 42, + 43, 44, 45, 71, 93, 94, 49, 106, 51, 106, + 99, 54, 108, 102, 103, 104, 105, 545, 61, 62, + 76, 77, 78, 560, 106, 442, 76, 77, 78, 18, 322, 74, 106, 76, 77, 78, 106, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 0, 76, 77, 78, 99, 106, 510, 102, - 103, 104, 105, 106, 12, 108, 564, 343, 111, 76, - 77, 78, 76, 77, 78, 76, 77, 78, 419, 61, - 62, 277, 372, 106, 248, 76, 77, 78, 76, 77, - 78, 371, 496, 471, 42, 43, 44, 45, 452, 106, - 155, 49, 106, 51, 225, 106, 54, 89, 90, 91, - 92, 93, 94, 61, 62, 106, -1, 99, 106, -1, - 102, 103, 104, 105, 356, -1, 74, -1, 76, 77, - 78, -1, 80, 81, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 102, 103, 104, - 105, 99, -1, -1, 102, 103, 104, 105, 106, 94, - 108, 0, 1, 111, 99, -1, -1, 102, 103, 104, - 105, -1, 11, -1, 13, 14, 15, 16, 17, -1, - -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, -1, 61, 62, - 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, 76, 77, 78, -1, 99, - 79, 94, 102, 103, 104, 105, 99, -1, -1, 102, - 103, 104, 105, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, 0, 1, 106, -1, -1, 107, 108, - 109, 110, -1, -1, 11, -1, 13, 14, 15, 16, - 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, + 93, 94, 108, 0, 13, 343, 99, 106, 108, 102, + 103, 104, 105, 106, 11, 108, 510, 277, 111, 76, + 77, 78, 419, 76, 77, 78, 76, 77, 78, 99, + 61, 62, 102, 103, 104, 105, 76, 77, 78, 102, + 103, 104, 105, 371, 564, 42, 43, 44, 45, 106, + 248, 452, 49, 106, 51, 471, 106, 54, 89, 90, + 91, 92, 93, 94, 61, 62, 106, 372, 99, 496, + 155, 102, 103, 104, 105, 356, -1, 74, -1, 76, + 77, 78, 225, 80, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 238, 239, + 240, 241, 99, 0, 1, 102, 103, 104, 105, 106, + -1, 108, -1, 10, 111, 12, 13, 14, 15, 16, + -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, + 61, 62, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, 3, 4, 5, 6, 7, 8, 9, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, -1, 13, 14, 15, - 16, 17, -1, -1, 20, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, -1, 13, 14, - 15, 16, 17, -1, -1, 20, 21, 22, 23, 24, + 67, 68, 69, -1, -1, -1, 94, -1, -1, -1, + -1, 99, 79, 94, 102, 103, 104, 105, 99, -1, + -1, 102, 103, 104, 105, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, 0, 1, -1, -1, -1, + 107, 108, 109, 110, -1, 10, -1, 12, 13, 14, + 15, 16, -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, 3, 4, 5, 6, 7, + 8, 9, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, -1, 13, - 14, 15, 16, 17, -1, -1, 20, 21, 22, 23, + -1, -1, 107, 108, 109, 110, 10, -1, 12, 13, + 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, @@ -798,8 +774,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, -1, - 13, 14, 15, 16, 17, -1, -1, 20, 21, 22, + -1, -1, -1, 107, 108, 109, 110, 10, -1, 12, + 13, 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, @@ -808,8 +784,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, - -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - -1, 13, 14, 15, 16, 17, -1, -1, 20, 21, + -1, -1, -1, -1, 107, 108, 109, 110, 10, -1, + 12, 13, 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, @@ -818,18 +794,18 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - 1, -1, -1, -1, -1, 107, 108, 109, 110, -1, - 11, -1, 13, 14, 15, 16, 17, -1, -1, 20, + 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, + -1, 12, 13, 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, 72, -1, -1, -1, -1, -1, -1, 79, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - -1, 11, -1, 13, 14, 15, 16, 17, -1, -1, + 10, -1, 12, 13, 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, @@ -839,138 +815,129 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, - 110, -1, 11, -1, 13, 14, 15, 16, 17, -1, - -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, 33, -1, 35, 36, 37, 38, + 110, 10, -1, 12, 13, 14, 15, 16, -1, -1, + 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 69, -1, -1, 72, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, - 109, 110, -1, 11, -1, 13, 14, 15, 16, 17, - -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, - 38, 39, -1, -1, -1, -1, 61, 62, -1, -1, - -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, + 109, 110, 10, -1, 12, 13, 14, 15, 16, -1, + -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, + -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, 87, 88, 89, 90, 91, 92, 93, 94, - -1, 79, -1, -1, 99, -1, -1, 102, 103, 104, - 105, -1, -1, -1, -1, -1, -1, 95, 96, -1, + 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, -1, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, 61, 62, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, 88, 89, 90, 91, 92, 93, 94, - -1, -1, 79, -1, 99, -1, -1, 102, 103, 104, - 105, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, 20, 21, 22, 23, 24, 25, 26, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, -1, 109, 110, 11, 12, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, 20, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, 108, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, + 108, 109, 110, 10, -1, 12, 13, 14, 15, 16, + -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, 33, -1, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, + -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, + -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, + 107, 108, 109, 110, 10, -1, 12, 13, 14, 15, + 16, -1, -1, -1, -1, 21, 22, 23, 24, 25, + -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, + -1, -1, 38, 39, -1, -1, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, 53, -1, -1, + 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, + 66, 67, 68, 69, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 79, -1, -1, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, + -1, 107, 108, 109, 110, 10, -1, 12, 13, 14, + 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, + 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, + -1, -1, -1, 38, 39, -1, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, -1, 53, -1, + -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, + 65, 66, 67, 68, 69, 87, 88, 89, 90, 91, + 92, 93, 94, -1, 79, -1, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, + 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, + -1, 106, 107, -1, 109, 110, 10, -1, 12, 13, + 14, 15, 16, -1, -1, 19, -1, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, + -1, -1, -1, -1, 38, 39, -1, -1, -1, 61, + 62, -1, -1, -1, -1, -1, -1, -1, -1, 53, + -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, + 64, 65, 66, 67, 68, 69, 88, 89, 90, 91, + 92, 93, 94, -1, -1, 79, -1, 99, -1, -1, + 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, + -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, + 61, 62, -1, 107, -1, 109, 110, 10, 11, 12, + 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, + 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + 91, 92, 93, 94, -1, 38, 39, -1, 99, -1, + -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, + 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, + 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, + -1, -1, -1, -1, 107, -1, 109, 110, 10, -1, + 12, 13, 14, 15, 16, -1, -1, 19, -1, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, -1, 107, -1, 109, 110, 10, + -1, 12, 13, 14, 15, 16, -1, -1, -1, -1, + 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, + 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, + -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, + 101, -1, -1, -1, -1, -1, 107, 108, 109, 110, + 10, -1, 12, 13, 14, 15, 16, -1, -1, -1, + -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, + 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, + 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, + 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, + 110, 10, -1, 12, 13, 14, 15, 16, -1, -1, + -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, + 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, + 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, + 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, + -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, + 109, 110, 10, -1, 12, 13, 14, 15, 16, -1, + -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, + 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, + 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, + 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, + 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, + 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, + -1, 109, 110, 10, -1, 12, 13, 14, 15, 16, + -1, -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, @@ -979,43 +946,69 @@ static const yytype_int16 yycheck[] = -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, -1, 109, 110, 11, -1, 13, 14, 15, 16, - 17, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, 54, -1, -1, - -1, -1, -1, -1, 61, 62, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, -1, - 107, -1, 109, 110, 81, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, -1, -1, - -1, -1, 99, 54, -1, 102, 103, 104, 105, -1, - 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, + 107, -1, 109, 110, 10, -1, 12, 13, 14, 15, + 16, -1, -1, -1, -1, 21, 22, 23, 24, 25, + -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, + -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, + 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, + 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, + 106, 107, -1, 109, 110, 10, -1, 12, 13, 14, + 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, + 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, + -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, + -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, + 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, 82, -1, 84, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, -1, -1, -1, -1, 99, 54, - -1, 102, 103, 104, 105, -1, 61, 62, -1, -1, + 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, + -1, 106, 107, -1, 109, 110, 10, -1, 12, 13, + 14, 15, 16, -1, -1, -1, -1, 21, 22, 23, + 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, + -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, + -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, + 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 82, -1, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - -1, -1, -1, -1, 99, 54, -1, 102, 103, 104, - 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, + -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, + -1, -1, 106, 107, -1, 109, 110, 10, -1, 12, + 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, + 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, -1, -1, -1, -1, - 99, -1, -1, 102, 103, 104, 105 + 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, + 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, + -1, -1, -1, -1, 107, -1, 109, 110, 10, -1, + 12, 13, 14, 15, 16, -1, -1, -1, -1, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + -1, -1, 54, -1, -1, -1, -1, -1, -1, 61, + 62, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, -1, 107, -1, 109, 110, 81, + 82, -1, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, -1, -1, -1, -1, 99, 54, -1, + 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 82, -1, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, + -1, -1, -1, 99, 54, -1, 102, 103, 104, 105, + -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, -1, -1, -1, -1, 99, + -1, -1, 102, 103, 104, 105 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1023,62 +1016,62 @@ static const yytype_int16 yycheck[] = static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 11, 13, - 14, 15, 16, 17, 21, 22, 23, 24, 25, 27, + 115, 116, 117, 118, 119, 120, 0, 123, 10, 12, + 13, 14, 15, 16, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 20, 121, 1, 33, 35, 36, 37, + 205, 206, 207, 19, 121, 1, 33, 35, 36, 37, 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, - 126, 168, 169, 126, 12, 174, 188, 188, 21, 26, - 121, 200, 208, 208, 208, 208, 208, 189, 11, 107, + 126, 168, 169, 126, 11, 174, 188, 188, 21, 26, + 121, 200, 208, 208, 208, 208, 208, 189, 10, 107, 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, - 208, 208, 76, 77, 78, 80, 11, 20, 107, 91, + 208, 208, 76, 77, 78, 80, 10, 19, 107, 91, 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 99, 102, 103, 104, 105, 107, 11, 20, 11, - 20, 11, 20, 20, 123, 153, 154, 154, 21, 151, + 94, 99, 102, 103, 104, 105, 107, 10, 19, 10, + 19, 10, 19, 19, 123, 153, 154, 154, 21, 151, 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 15, 16, 109, 159, 160, - 162, 163, 164, 165, 12, 192, 107, 73, 174, 106, + 49, 51, 129, 130, 128, 14, 15, 109, 159, 160, + 162, 163, 164, 165, 11, 192, 107, 73, 174, 106, 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, - 208, 175, 10, 108, 192, 107, 188, 191, 200, 201, - 202, 106, 174, 70, 157, 11, 106, 174, 174, 174, + 208, 175, 20, 108, 192, 107, 188, 191, 200, 201, + 202, 106, 174, 70, 157, 10, 106, 174, 174, 174, 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 11, 15, 16, 17, 20, 22, + 188, 188, 188, 188, 10, 14, 15, 16, 19, 22, 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, - 158, 158, 80, 193, 175, 12, 177, 156, 24, 123, - 173, 106, 74, 106, 174, 10, 106, 174, 157, 106, - 24, 174, 11, 12, 108, 106, 83, 174, 110, 110, - 110, 174, 110, 106, 174, 110, 110, 107, 106, 12, - 108, 12, 108, 12, 108, 108, 10, 18, 122, 131, - 132, 20, 108, 21, 146, 174, 147, 148, 174, 148, + 158, 158, 80, 193, 175, 11, 177, 156, 24, 123, + 173, 106, 74, 106, 174, 20, 106, 174, 157, 106, + 24, 174, 10, 11, 108, 106, 83, 174, 110, 110, + 110, 174, 110, 106, 174, 110, 110, 107, 106, 11, + 108, 11, 108, 11, 108, 108, 20, 17, 122, 131, + 132, 19, 108, 21, 146, 174, 147, 148, 174, 148, 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, - 123, 171, 107, 166, 167, 106, 106, 12, 174, 10, - 188, 12, 108, 106, 193, 10, 10, 10, 10, 123, + 123, 171, 107, 166, 167, 106, 106, 11, 174, 20, + 188, 11, 108, 106, 193, 20, 20, 20, 20, 123, 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, - 106, 108, 136, 148, 106, 106, 188, 174, 74, 20, - 168, 20, 12, 10, 106, 108, 156, 108, 172, 173, - 137, 192, 144, 144, 20, 124, 124, 148, 148, 124, + 106, 108, 136, 148, 106, 106, 188, 174, 74, 19, + 168, 19, 11, 20, 106, 108, 156, 108, 172, 173, + 137, 192, 144, 144, 19, 124, 124, 148, 148, 124, 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, - 142, 106, 106, 143, 146, 148, 124, 10, 10, 127, - 10, 143, 143, 126, 124, 107, 124, 124, 108, 106, - 143, 24, 108, 138, 10, 148, 143, 143, 135, 124, - 71, 139, 19, 106, 144, 143, 126, 124, 149, 72, + 142, 106, 106, 143, 146, 148, 124, 20, 20, 127, + 20, 143, 143, 126, 124, 107, 124, 124, 108, 106, + 143, 24, 108, 138, 20, 148, 143, 143, 135, 124, + 71, 139, 18, 106, 144, 143, 126, 124, 149, 72, 142, 106, 124 }; @@ -1161,39 +1154,40 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 02a06827b806e2b15485d141a7d326a8d857c6dec7d73a07a62f675706a91638 perly.y + * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index c9a6d9a76cc4..349ed4c6fb57 100644 --- a/perly.y +++ b/perly.y @@ -45,8 +45,9 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '}' '[' ']' '-' '+' '@' '%' '&' '=' '.' +%token '[' ']' '-' '+' '@' '%' '&' '=' '.' %token PERLY_BRACE_OPEN +%token PERLY_BRACE_CLOSE %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -202,7 +203,7 @@ grammar : GRAMPROG ; /* An ordinary block */ -block : PERLY_BRACE_OPEN remember stmtseq '}' +block : PERLY_BRACE_OPEN remember stmtseq PERLY_BRACE_CLOSE { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($remember, $stmtseq); @@ -222,7 +223,7 @@ remember: /* NULL */ /* start a full lexical scope */ parser->parsed_sub = 0; } ; -mblock : PERLY_BRACE_OPEN mremember stmtseq '}' +mblock : PERLY_BRACE_OPEN mremember stmtseq PERLY_BRACE_CLOSE { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) parser->copline = (line_t)$PERLY_BRACE_OPEN; $$ = block_end($mremember, $stmtseq); @@ -458,7 +459,7 @@ barestmt: PLUGSTMT package_version($version); } } - stmtseq '}' + stmtseq PERLY_BRACE_CLOSE { /* a block is a loop that happens once */ $$ = newWHILEOP(0, 1, NULL, @@ -857,7 +858,7 @@ optsubbody: subbody { $$ = $subbody; } /* Subroutine body (without signature) */ -subbody: remember PERLY_BRACE_OPEN stmtseq '}' +subbody: remember PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) parser->copline = (line_t)$PERLY_BRACE_OPEN; @@ -872,7 +873,7 @@ optsigsubbody: sigsubbody { $$ = $sigsubbody; } | ';' { $$ = NULL; } /* Subroutine body with optional signature */ -sigsubbody: remember optsubsignature PERLY_BRACE_OPEN stmtseq '}' +sigsubbody: remember optsubsignature PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE { if (parser->copline > (line_t)$PERLY_BRACE_OPEN) parser->copline = (line_t)$PERLY_BRACE_OPEN; @@ -957,7 +958,7 @@ method : METHOD ; /* Some kind of subscripted expression */ -subscripted: gelem PERLY_BRACE_OPEN expr ';' '}' /* *main::{something} */ +subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *main::{something} */ /* In this and all the hash accessors, ';' is * provided by the tokeniser */ { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } @@ -974,14 +975,14 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' '}' /* *main::{something} ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); } - | scalar[hash] PERLY_BRACE_OPEN expr ';' '}' /* $foo{bar();} */ + | scalar[hash] PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* $foo{bar();} */ { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); } - | term[hash_reference] ARROW PERLY_BRACE_OPEN expr ';' '}' /* somehref->{bar();} */ + | term[hash_reference] ARROW PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* somehref->{bar();} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } - | subscripted[hash_reference] PERLY_BRACE_OPEN expr ';' '}' /* $foo->[bar]->{baz;} */ + | subscripted[hash_reference] PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* $foo->[bar]->{baz;} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } @@ -1127,9 +1128,9 @@ anonymous: '[' expr ']' { $$ = newANONLIST($expr); } | '[' ']' { $$ = newANONLIST(NULL);} - | HASHBRACK expr ';' '}' %prec '(' /* { foo => "Bar" } */ + | HASHBRACK expr ';' PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($expr); } - | HASHBRACK ';' '}' %prec '(' /* { } (';' by tokener) */ + | HASHBRACK ';' PERLY_BRACE_CLOSE %prec '(' /* { } (';' by tokener) */ { $$ = newANONHASH(NULL); } | ANONSUB startanonsub proto subattrlist subbody %prec '(' { SvREFCNT_inc_simple_void(PL_compcv); @@ -1198,7 +1199,7 @@ term[product] : termbinop $$->op_private |= $kvslice->op_private & OPpSLICEWARNING; } - | sliceme PERLY_BRACE_OPEN expr ';' '}' /* @hash{@keys} */ + | sliceme PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* @hash{@keys} */ { $$ = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1208,7 +1209,7 @@ term[product] : termbinop $$->op_private |= $sliceme->op_private & OPpSLICEWARNING; } - | kvslice PERLY_BRACE_OPEN expr ';' '}' /* %hash{@keys} */ + | kvslice PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* %hash{@keys} */ { $$ = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, diff --git a/toke.c b/toke.c index 07134b57c45b..d7027639ace2 100644 --- a/toke.c +++ b/toke.c @@ -386,6 +386,7 @@ static struct debug_tokens { { OROP, TOKENTYPE_IVAL, "OROP" }, { OROR, TOKENTYPE_NONE, "OROR" }, { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, + DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -6222,7 +6223,7 @@ yyl_rightcurly(pTHX_ char *s, const U8 formbrack) return yylex(); /* ignore fake brackets */ } - force_next(formbrack ? '.' : '}'); + force_next(formbrack ? '.' : PERLY_BRACE_CLOSE); if (formbrack) LEAVE_with_name("lex_format"); if (formbrack == 2) { /* means . where arguments were expected */ force_next(';'); From 669dd22c48876f64e654ab5a755cf115f927ebdf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:00 +0100 Subject: [PATCH 326/503] Distinguish C- and perly- literals - PERLY_BRACKET_OPEN --- perly.act | 536 ++++++++++++------------- perly.h | 163 ++++---- perly.tab | 1160 ++++++++++++++++++++++++++--------------------------- perly.y | 25 +- toke.c | 9 +- 5 files changed, 947 insertions(+), 946 deletions(-) diff --git a/perly.act b/perly.act index ea0608279a9a..150c7183fbe3 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 124 "perly.y" +#line 125 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 129 "perly.y" +#line 130 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 135 "perly.y" +#line 136 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 140 "perly.y" +#line 141 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 145 "perly.y" +#line 146 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 150 "perly.y" +#line 151 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 158 "perly.y" +#line 159 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 163 "perly.y" +#line 164 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 171 "perly.y" +#line 172 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 176 "perly.y" +#line 177 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 184 "perly.y" +#line 185 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 189 "perly.y" +#line 190 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 194 "perly.y" +#line 195 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 199 "perly.y" +#line 200 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 207 "perly.y" +#line 208 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 215 "perly.y" +#line 216 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 222 "perly.y" +#line 223 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 227 "perly.y" +#line 228 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 234 "perly.y" +#line 235 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 240 "perly.y" +#line 241 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 242 "perly.y" +#line 243 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 251 "perly.y" +#line 252 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 253 "perly.y" +#line 254 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 262 "perly.y" +#line 263 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 266 "perly.y" +#line 267 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 270 "perly.y" +#line 271 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 277 "perly.y" +#line 278 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 287 "perly.y" +#line 288 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 289 "perly.y" +#line 290 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 301 "perly.y" +#line 302 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 307 "perly.y" +#line 308 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 322 "perly.y" +#line 323 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 328 "perly.y" +#line 329 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 339 "perly.y" +#line 340 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 346 "perly.y" +#line 347 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 348 "perly.y" +#line 349 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 355 "perly.y" +#line 356 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 361 "perly.y" +#line 362 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 367 "perly.y" +#line 368 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 372 "perly.y" +#line 373 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 374 "perly.y" +#line 375 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 376 "perly.y" +#line 377 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 383 "perly.y" +#line 384 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 390 "perly.y" +#line 391 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 392 "perly.y" +#line 393 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 395 "perly.y" +#line 396 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 410 "perly.y" +#line 411 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 415 "perly.y" +#line 416 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 421 "perly.y" +#line 422 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 423 "perly.y" +#line 424 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 436 "perly.y" +#line 437 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 444 "perly.y" +#line 445 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 450 "perly.y" +#line 451 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 456 "perly.y" +#line 457 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 463 "perly.y" +#line 464 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 471 "perly.y" +#line 472 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 475 "perly.y" +#line 476 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 480 "perly.y" +#line 481 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 488 "perly.y" +#line 489 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 505 "perly.y" +#line 506 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 507 "perly.y" +#line 508 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 515 "perly.y" +#line 516 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 519 "perly.y" +#line 520 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 521 "perly.y" +#line 522 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 535 "perly.y" +#line 536 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 537 "perly.y" +#line 538 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 542 "perly.y" +#line 543 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 552 "perly.y" +#line 553 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 554 "perly.y" +#line 555 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 559 "perly.y" +#line 560 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 565 "perly.y" +#line 566 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 571 "perly.y" +#line 572 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 579 "perly.y" +#line 580 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 584 "perly.y" +#line 585 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 588 "perly.y" +#line 589 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 591 "perly.y" +#line 592 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 592 "perly.y" +#line 593 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 602 "perly.y" +#line 603 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 607 "perly.y" +#line 608 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 618 "perly.y" +#line 619 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 624 "perly.y" +#line 625 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 626 "perly.y" +#line 627 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 628 "perly.y" +#line 629 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 633 "perly.y" +#line 634 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 635 "perly.y" +#line 636 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 646 "perly.y" +#line 647 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 648 "perly.y" +#line 649 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 653 "perly.y" +#line 654 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 655 "perly.y" +#line 656 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 659 "perly.y" +#line 660 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 678 "perly.y" +#line 679 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 680 "perly.y" +#line 681 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 682 "perly.y" +#line 683 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 688 "perly.y" +#line 689 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 753 "perly.y" +#line 754 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 755 "perly.y" +#line 756 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 761 "perly.y" +#line 762 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 763 "perly.y" +#line 764 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 767 "perly.y" +#line 768 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 772 "perly.y" +#line 773 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 774 "perly.y" +#line 775 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 778 "perly.y" +#line 779 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 780 "perly.y" +#line 781 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 787 "perly.y" +#line 788 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 798 "perly.y" +#line 799 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 855 "perly.y" +#line 856 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 856 "perly.y" +#line 857 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 862 "perly.y" +#line 863 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 872 "perly.y" +#line 873 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 873 "perly.y" +#line 874 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 877 "perly.y" +#line 878 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 888 "perly.y" +#line 889 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 890 "perly.y" +#line 891 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 892 "perly.y" +#line 893 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 898 "perly.y" +#line 899 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 900 "perly.y" +#line 901 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 909 "perly.y" +#line 910 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 913 "perly.y" +#line 914 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 917 "perly.y" +#line 918 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 923 "perly.y" +#line 924 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 928 "perly.y" +#line 929 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 934 "perly.y" +#line 935 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 940 "perly.y" +#line 941 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 942 "perly.y" +#line 943 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 944 "perly.y" +#line 945 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 946 "perly.y" +#line 947 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 949 "perly.y" +#line 950 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 964 "perly.y" +#line 965 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 966 "perly.y" +#line 967 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 969 "perly.y" +#line 970 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 974 "perly.y" +#line 975 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 979 "perly.y" +#line 980 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 982 "perly.y" +#line 983 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 986 "perly.y" +#line 987 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 990 "perly.y" +#line 991 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 996 "perly.y" +#line 997 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1004 "perly.y" +#line 1005 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1011 "perly.y" +#line 1012 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1017 "perly.y" +#line 1018 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1019 "perly.y" +#line 1020 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1021 "perly.y" +#line 1022 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1026 "perly.y" +#line 1027 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1028 "perly.y" +#line 1029 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1030 "perly.y" +#line 1031 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1035 "perly.y" +#line 1036 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1037 "perly.y" +#line 1038 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1039 "perly.y" +#line 1040 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1041 "perly.y" +#line 1042 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1063 "perly.y" +#line 1064 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1065 "perly.y" +#line 1066 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1069 "perly.y" +#line 1070 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1071 "perly.y" +#line 1072 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1075 "perly.y" +#line 1076 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1077 "perly.y" +#line 1078 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1079 "perly.y" +#line 1080 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1081 "perly.y" +#line 1082 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1085 "perly.y" +#line 1086 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1087 "perly.y" +#line 1088 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1092 "perly.y" +#line 1093 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1094 "perly.y" +#line 1095 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1101 "perly.y" +#line 1102 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1107 "perly.y" +#line 1108 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1118 "perly.y" +#line 1119 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1121 "perly.y" +#line 1122 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1128 "perly.y" +#line 1129 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1130 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1132 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1134 "perly.y" +#line 1135 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1136 "perly.y" +#line 1137 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1139 "perly.y" +#line 1140 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1145 "perly.y" +#line 1146 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1147 "perly.y" +#line 1148 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1155 "perly.y" +#line 1156 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1157 "perly.y" +#line 1158 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1159 "perly.y" +#line 1160 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1161 "perly.y" +#line 1162 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1193 "perly.y" +#line 1194 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1203 "perly.y" +#line 1204 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1213 "perly.y" +#line 1214 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1223 "perly.y" +#line 1224 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1225 "perly.y" +#line 1226 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1227 "perly.y" +#line 1228 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1230 "perly.y" +#line 1231 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1235 "perly.y" +#line 1236 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1239 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1241 "perly.y" +#line 1242 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1243 "perly.y" +#line 1244 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1245 "perly.y" +#line 1246 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1288 "perly.y" +#line 1289 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1299 "perly.y" +#line 1300 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1307 "perly.y" +#line 1308 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1309 "perly.y" +#line 1310 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1311 "perly.y" +#line 1312 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1316 "perly.y" +#line 1317 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1318 "perly.y" +#line 1319 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1325 "perly.y" +#line 1326 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1332 "perly.y" +#line 1333 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1336 "perly.y" +#line 1337 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1338 "perly.y" +#line 1339 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1344 "perly.y" +#line 1345 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1350 "perly.y" +#line 1351 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1367 "perly.y" +#line 1368 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1371 "perly.y" +#line 1372 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1375 "perly.y" +#line 1376 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1381 "perly.y" +#line 1382 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1387 "perly.y" +#line 1388 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1389 "perly.y" +#line 1390 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1393 "perly.y" +#line 1394 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1398 "perly.y" +#line 1399 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1403 "perly.y" +#line 1404 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1408 "perly.y" +#line 1409 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1413 "perly.y" +#line 1414 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1415 "perly.y" +#line 1416 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1417 "perly.y" +#line 1418 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1420 "perly.y" +#line 1421 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y + * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index b91de7377d4e..3d3f33b4e1bf 100644 --- a/perly.h +++ b/perly.h @@ -65,86 +65,87 @@ extern int yydebug; GRAMSUBSIGNATURE = 264, PERLY_BRACE_OPEN = 265, PERLY_BRACE_CLOSE = 266, - BAREWORD = 267, - METHOD = 268, - FUNCMETH = 269, - THING = 270, - PMFUNC = 271, - PRIVATEREF = 272, - QWLIST = 273, - FUNC0OP = 274, - FUNC0SUB = 275, - UNIOPSUB = 276, - LSTOPSUB = 277, - PLUGEXPR = 278, - PLUGSTMT = 279, - LABEL = 280, - FORMAT = 281, - SUB = 282, - SIGSUB = 283, - ANONSUB = 284, - ANON_SIGSUB = 285, - PACKAGE = 286, - USE = 287, - WHILE = 288, - UNTIL = 289, - IF = 290, - UNLESS = 291, - ELSE = 292, - ELSIF = 293, - CONTINUE = 294, - FOR = 295, - GIVEN = 296, - WHEN = 297, - DEFAULT = 298, - LOOPEX = 299, - DOTDOT = 300, - YADAYADA = 301, - FUNC0 = 302, - FUNC1 = 303, - FUNC = 304, - UNIOP = 305, - LSTOP = 306, - MULOP = 307, - ADDOP = 308, - DOLSHARP = 309, - DO = 310, - HASHBRACK = 311, - NOAMP = 312, - LOCAL = 313, - MY = 314, - REQUIRE = 315, - COLONATTR = 316, - FORMLBRACK = 317, - FORMRBRACK = 318, - SUBLEXSTART = 319, - SUBLEXEND = 320, - PREC_LOW = 321, - OROP = 322, - DOROP = 323, - ANDOP = 324, - NOTOP = 325, - ASSIGNOP = 326, - OROR = 327, - DORDOR = 328, - ANDAND = 329, - BITOROP = 330, - BITANDOP = 331, - CHEQOP = 332, - NCEQOP = 333, - CHRELOP = 334, - NCRELOP = 335, - SHIFTOP = 336, - MATCHOP = 337, - UMINUS = 338, - REFGEN = 339, - POWOP = 340, - PREINC = 341, - PREDEC = 342, - POSTINC = 343, - POSTDEC = 344, - POSTJOIN = 345, - ARROW = 346 + PERLY_BRACKET_OPEN = 267, + BAREWORD = 268, + METHOD = 269, + FUNCMETH = 270, + THING = 271, + PMFUNC = 272, + PRIVATEREF = 273, + QWLIST = 274, + FUNC0OP = 275, + FUNC0SUB = 276, + UNIOPSUB = 277, + LSTOPSUB = 278, + PLUGEXPR = 279, + PLUGSTMT = 280, + LABEL = 281, + FORMAT = 282, + SUB = 283, + SIGSUB = 284, + ANONSUB = 285, + ANON_SIGSUB = 286, + PACKAGE = 287, + USE = 288, + WHILE = 289, + UNTIL = 290, + IF = 291, + UNLESS = 292, + ELSE = 293, + ELSIF = 294, + CONTINUE = 295, + FOR = 296, + GIVEN = 297, + WHEN = 298, + DEFAULT = 299, + LOOPEX = 300, + DOTDOT = 301, + YADAYADA = 302, + FUNC0 = 303, + FUNC1 = 304, + FUNC = 305, + UNIOP = 306, + LSTOP = 307, + MULOP = 308, + ADDOP = 309, + DOLSHARP = 310, + DO = 311, + HASHBRACK = 312, + NOAMP = 313, + LOCAL = 314, + MY = 315, + REQUIRE = 316, + COLONATTR = 317, + FORMLBRACK = 318, + FORMRBRACK = 319, + SUBLEXSTART = 320, + SUBLEXEND = 321, + PREC_LOW = 322, + OROP = 323, + DOROP = 324, + ANDOP = 325, + NOTOP = 326, + ASSIGNOP = 327, + OROR = 328, + DORDOR = 329, + ANDAND = 330, + BITOROP = 331, + BITANDOP = 332, + CHEQOP = 333, + NCEQOP = 334, + CHRELOP = 335, + NCRELOP = 336, + SHIFTOP = 337, + MATCHOP = 338, + UMINUS = 339, + REFGEN = 340, + POWOP = 341, + PREINC = 342, + PREDEC = 343, + POSTINC = 344, + POSTDEC = 345, + POSTJOIN = 346, + ARROW = 347 }; #endif @@ -196,6 +197,6 @@ int yyparse (void); /* Generated from: - * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y + * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 10a02b9bf0de..ae6e8d9baceb 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3325 +#define YYLAST 3322 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 346 +#define YYMAXUTOK 347 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,13 +33,13 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 95, 2, 2, 109, 15, 16, 2, - 107, 106, 110, 13, 80, 12, 18, 111, 2, 2, + 2, 2, 2, 95, 2, 2, 109, 14, 15, 2, + 107, 106, 110, 12, 80, 11, 17, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 83, 108, - 2, 17, 2, 82, 14, 2, 2, 2, 2, 2, + 2, 16, 2, 82, 13, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 10, 2, 11, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 10, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 96, 2, 2, 2, @@ -56,51 +56,51 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, - 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, - 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, - 74, 75, 76, 77, 78, 79, 81, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 97, 98, - 99, 100, 101, 102, 103, 104, 105 + 5, 6, 7, 8, 9, 18, 19, 20, 21, 22, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, + 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, + 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, + 73, 74, 75, 76, 77, 78, 79, 81, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 97, + 98, 99, 100, 101, 102, 103, 104, 105 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 124, 124, 123, 135, 134, 145, 144, 158, 157, - 171, 170, 184, 183, 194, 193, 206, 214, 222, 226, - 234, 240, 241, 251, 252, 261, 265, 269, 276, 286, - 288, 301, 298, 322, 317, 338, 346, 345, 354, 360, - 366, 371, 373, 375, 382, 390, 392, 389, 409, 414, - 421, 420, 435, 443, 449, 456, 455, 470, 474, 479, - 487, 505, 506, 510, 514, 516, 518, 520, 522, 524, - 526, 529, 535, 536, 541, 552, 553, 559, 565, 566, - 571, 574, 578, 583, 587, 591, 592, 596, 602, 607, - 612, 613, 618, 619, 624, 625, 627, 632, 634, 646, - 647, 652, 654, 658, 678, 679, 681, 687, 752, 754, - 760, 762, 766, 772, 773, 778, 779, 783, 787, 787, - 855, 856, 861, 872, 873, 876, 887, 889, 891, 893, - 897, 899, 904, 908, 912, 916, 922, 927, 933, 939, - 941, 943, 946, 945, 956, 957, 961, 965, 968, 973, - 978, 981, 985, 989, 995, 1003, 1010, 1016, 1018, 1020, - 1025, 1027, 1029, 1034, 1036, 1038, 1040, 1042, 1044, 1046, - 1048, 1050, 1052, 1054, 1058, 1060, 1062, 1064, 1068, 1070, - 1074, 1076, 1078, 1080, 1084, 1086, 1091, 1093, 1096, 1098, - 1100, 1103, 1106, 1117, 1120, 1127, 1129, 1131, 1133, 1135, - 1138, 1144, 1146, 1150, 1151, 1152, 1153, 1154, 1156, 1158, - 1160, 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, - 1180, 1182, 1192, 1202, 1212, 1222, 1224, 1226, 1229, 1234, - 1238, 1240, 1242, 1244, 1247, 1249, 1252, 1254, 1256, 1258, - 1260, 1262, 1264, 1266, 1268, 1271, 1273, 1275, 1277, 1279, - 1281, 1285, 1288, 1287, 1300, 1301, 1302, 1306, 1308, 1310, - 1315, 1317, 1320, 1322, 1324, 1329, 1331, 1336, 1337, 1342, - 1343, 1349, 1353, 1354, 1355, 1358, 1359, 1362, 1363, 1366, - 1370, 1374, 1380, 1386, 1388, 1392, 1396, 1397, 1401, 1402, - 1406, 1407, 1412, 1414, 1416, 1419 + 0, 125, 125, 124, 136, 135, 146, 145, 159, 158, + 172, 171, 185, 184, 195, 194, 207, 215, 223, 227, + 235, 241, 242, 252, 253, 262, 266, 270, 277, 287, + 289, 302, 299, 323, 318, 339, 347, 346, 355, 361, + 367, 372, 374, 376, 383, 391, 393, 390, 410, 415, + 422, 421, 436, 444, 450, 457, 456, 471, 475, 480, + 488, 506, 507, 511, 515, 517, 519, 521, 523, 525, + 527, 530, 536, 537, 542, 553, 554, 560, 566, 567, + 572, 575, 579, 584, 588, 592, 593, 597, 603, 608, + 613, 614, 619, 620, 625, 626, 628, 633, 635, 647, + 648, 653, 655, 659, 679, 680, 682, 688, 753, 755, + 761, 763, 767, 773, 774, 779, 780, 784, 788, 788, + 856, 857, 862, 873, 874, 877, 888, 890, 892, 894, + 898, 900, 905, 909, 913, 917, 923, 928, 934, 940, + 942, 944, 947, 946, 957, 958, 962, 966, 969, 974, + 979, 982, 986, 990, 996, 1004, 1011, 1017, 1019, 1021, + 1026, 1028, 1030, 1035, 1037, 1039, 1041, 1043, 1045, 1047, + 1049, 1051, 1053, 1055, 1059, 1061, 1063, 1065, 1069, 1071, + 1075, 1077, 1079, 1081, 1085, 1087, 1092, 1094, 1097, 1099, + 1101, 1104, 1107, 1118, 1121, 1128, 1130, 1132, 1134, 1136, + 1139, 1145, 1147, 1151, 1152, 1153, 1154, 1155, 1157, 1159, + 1161, 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, + 1181, 1183, 1193, 1203, 1213, 1223, 1225, 1227, 1230, 1235, + 1239, 1241, 1243, 1245, 1248, 1250, 1253, 1255, 1257, 1259, + 1261, 1263, 1265, 1267, 1269, 1272, 1274, 1276, 1278, 1280, + 1282, 1286, 1289, 1288, 1301, 1302, 1303, 1307, 1309, 1311, + 1316, 1318, 1321, 1323, 1325, 1330, 1332, 1337, 1338, 1343, + 1344, 1350, 1354, 1355, 1356, 1359, 1360, 1363, 1364, 1367, + 1371, 1375, 1381, 1387, 1389, 1393, 1397, 1398, 1402, 1403, + 1407, 1408, 1413, 1415, 1417, 1420 }; #endif @@ -110,9 +110,9 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'['", - "']'", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", - "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "BAREWORD", "METHOD", + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "']'", + "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", "PERLY_BRACE_OPEN", + "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", @@ -151,21 +151,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 91, 93, 45, 43, 64, 37, 38, 61, 46, 265, - 266, 267, 268, 269, 270, 271, 272, 273, 274, 275, - 276, 277, 278, 279, 280, 281, 282, 283, 284, 285, - 286, 287, 288, 289, 290, 291, 292, 293, 294, 295, - 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, - 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, - 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, - 44, 326, 63, 58, 327, 328, 329, 330, 331, 332, - 333, 334, 335, 336, 337, 33, 126, 338, 339, 340, - 341, 342, 343, 344, 345, 346, 41, 40, 59, 36, + 93, 45, 43, 64, 37, 38, 61, 46, 265, 266, + 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, + 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, + 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, + 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, + 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, + 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, + 44, 327, 63, 58, 328, 329, 330, 331, 332, 333, + 334, 335, 336, 337, 338, 33, 126, 339, 340, 341, + 342, 343, 344, 345, 346, 347, 41, 40, 59, 36, 42, 47 }; # endif -#define YYPACT_NINF (-495) +#define YYPACT_NINF (-468) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -179,64 +179,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 842, -495, -495, -495, -495, -495, -495, -495, 20, -495, - 2997, 11, 1583, 1482, -495, -495, -495, -495, 1987, 2997, - 2997, 28, 28, 28, -495, 28, 28, -495, -495, 18, - -67, -495, 2997, -495, -495, -495, -495, 2997, -61, -55, - -20, 2088, 1886, 28, 2088, 2189, 36, 2997, 17, 2997, - 2997, 2997, 2997, 2997, 2997, 2997, 2290, 28, 28, 111, - -22, -495, -3, -495, -23, -26, 70, -19, -495, -495, - -495, 3128, -495, -495, -25, 65, 93, 176, -495, 88, - 237, 245, 90, -495, -495, -495, -495, -495, 36, 36, - 96, -495, 7, 39, 42, 46, 128, 71, 74, 11, - 105, -495, 186, -495, 130, 325, 1482, -495, -495, -495, - 673, -495, 12, 775, -495, 55, 500, 500, -495, -495, - -495, -495, -495, -495, -495, 2997, 129, 184, 2997, 162, - 431, 11, 249, 235, 3128, 209, 2391, 2997, 1886, -495, - 431, 573, -22, -495, 477, 2997, -495, -495, 431, 99, - 240, -495, -495, 2997, 431, 3098, 2492, 239, -495, -495, - -495, 431, -22, 500, 500, 500, 507, 507, 314, 280, - -495, -495, 2997, 2997, 2997, 2997, 2997, 2997, 2593, -495, - -495, 2997, -495, -495, 2997, 2997, 2997, 2997, 2997, 2997, - 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, 2997, - 2997, 2997, -495, -495, -495, 75, 2694, 2997, 2997, 2997, - 2997, 2997, 2997, 2997, -495, 302, -495, -495, 304, -495, - -495, -495, -495, -495, 234, 9, -495, -495, 226, -495, - -495, -495, -495, 11, -495, -495, 2997, 2997, 2997, 2997, - 2997, 2997, -495, -495, -495, -495, -495, 316, 316, -495, - -495, -495, 260, -495, -495, -495, 2997, 2997, 95, -495, - -495, -495, 235, 319, -495, -495, -495, 313, 270, 256, - 2997, -22, -495, 345, -495, 2795, 500, 239, 31, 57, - 73, -495, 328, 347, -495, 2997, 365, 303, 303, -495, - 3128, 114, 253, -495, 379, 431, 1929, 3220, 652, 412, - 3128, 360, 1668, 1668, 1768, 1868, 539, 1929, 1929, 431, - 431, 659, 500, 500, 2997, 272, 287, 288, 2997, -495, - 290, 2896, 53, 298, 306, -495, -495, 513, 134, 301, - 164, 390, 168, 402, 464, 876, -495, 370, -495, -495, - -10, 394, 2997, 2997, 2997, 2997, -495, 311, -495, -495, - 318, -495, -495, -495, -495, 1684, 30, -495, 2997, 2997, - -495, -495, 111, -495, 111, -495, -495, -495, -495, -495, - 330, 330, 12, 317, 56, -495, 2997, -495, -495, 321, - -495, -495, -495, -495, 517, -495, 23, 520, -495, -495, - -495, 183, 2997, -495, 406, -495, 2997, 198, -495, -495, - -495, 470, -495, -495, 530, -495, -495, 2997, -495, -495, - 409, -495, 413, -495, 415, 417, -495, -495, -495, 249, - 235, -495, -495, 419, 332, 111, 352, 354, 111, 363, - 368, -495, -495, -495, -495, 375, 374, 277, -495, 2997, - 378, 380, 2997, -495, -495, -495, -495, 2997, 416, -495, - 457, -495, -495, 475, -495, -495, 41, -495, 203, -495, - 3174, -495, 469, -495, 389, -495, -495, -495, -495, 392, - 235, 393, -495, 2997, -495, -495, 478, 478, 2997, 2997, - 478, -495, 397, 399, 478, 478, 3128, 111, -495, -495, - 401, -495, -495, -495, -495, 436, 404, -495, -495, -495, - -495, 405, 478, 478, -495, 160, 160, 421, 423, 186, - 2997, 2997, 478, -495, -495, 977, -495, 1078, -495, -495, - -495, -495, 1179, -495, 186, 186, -495, 478, 411, -495, - -495, 478, 478, -495, 424, 438, 186, -495, -495, -9, - -495, -495, -495, 1280, -495, 2997, 186, 186, -495, 478, - -495, 452, 531, -495, -495, 446, -495, -495, -495, 186, - -495, -495, -495, 478, 1785, -495, 1381, 160, 450, -495, - -495, 478, -495 + 600, -468, -468, -468, -468, -468, -468, -468, 76, -468, + 2958, 6, 1593, 1492, -468, -468, -468, -468, 2958, 2958, + 54, 54, 54, 1876, -468, 54, 54, -468, -468, 26, + -21, -468, 2958, -468, -468, -468, -468, 2958, -6, 2, + -26, 2076, 1976, 54, 2076, 2167, 39, 2958, -2, 2958, + 2958, 2958, 2958, 2958, 2958, 2958, 2258, 54, 54, 187, + 37, -468, 14, -468, 70, 52, 170, 57, -468, -468, + -468, 3125, -468, -468, 43, 20, 59, 69, -468, 139, + 75, 84, 149, -468, -468, -468, -468, -468, 39, 39, + 152, -468, 71, 74, 78, 80, 272, 88, 107, 6, + 81, -468, 192, -468, 127, 1974, 1492, -468, -468, -468, + 683, -468, 17, 785, 587, 587, -468, -468, -468, -468, + -468, -468, -468, -468, 46, 2958, 138, 174, 2958, 162, + 339, 6, 249, 206, 3125, 199, 2358, 2958, 1976, -468, + 339, 574, 37, -468, 477, 2958, -468, -468, 339, 261, + 230, -468, -468, 2958, 339, 3049, 2458, 242, -468, -468, + -468, 339, 37, 587, 587, 587, 239, 239, 305, 173, + -468, -468, 2958, 2958, 2958, 2958, 2958, 2958, 2558, -468, + -468, 2958, -468, -468, 2958, 2958, 2958, 2958, 2958, 2958, + 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, + 2958, 2958, -468, -468, -468, 304, 2658, 2958, 2958, 2958, + 2958, 2958, 2958, 2958, -468, 309, -468, -468, 324, -468, + -468, -468, -468, -468, 248, 3, -468, -468, 257, -468, + -468, -468, -468, 6, -468, -468, 2958, 2958, 2958, 2958, + 2958, 2958, -468, -468, -468, -468, -468, 340, 340, -468, + -468, -468, 285, -468, -468, -468, 2958, 2958, 82, -468, + -468, -468, 206, 345, -468, -468, -468, 255, 303, 274, + 2958, 37, -468, 359, -468, 2758, 587, 242, 118, 164, + 176, -468, 423, 358, -468, 2958, 363, 308, 308, -468, + 3125, 251, 115, -468, 469, 339, 364, 3217, 167, 412, + 3125, 3079, 1668, 1668, 1758, 1858, 540, 364, 364, 339, + 339, 431, 587, 587, 281, 282, 287, 2958, 2958, -468, + 288, 2858, 24, 292, 283, -468, -468, 472, 329, 132, + 343, 135, 352, 161, 370, 886, -468, 388, -468, -468, + 7, 389, 2958, 2958, 2958, 2958, -468, 300, -468, -468, + 317, -468, -468, -468, -468, 1684, 22, -468, 2958, 2958, + -468, -468, 187, -468, 187, -468, -468, -468, -468, -468, + 334, 334, 17, 328, -47, -468, 2958, -468, -468, 338, + -468, -468, -468, -468, 514, -468, -13, 518, -468, -468, + -468, 166, 2958, 416, -468, -468, 2958, -468, -468, -468, + 404, 180, -468, -468, 521, -468, -468, 2958, -468, 430, + -468, 433, -468, 434, -468, 440, -468, -468, -468, 249, + 206, -468, -468, 429, 355, 187, 369, 373, 187, 378, + 357, -468, -468, -468, -468, 379, 368, 311, -468, 2958, + 380, 382, 2958, -468, -468, -468, -468, 2958, 391, -468, + 471, -468, -468, 476, -468, -468, 33, -468, 226, -468, + 3171, 479, -468, -468, 384, -468, -468, -468, -468, 396, + 206, 397, -468, 2958, -468, -468, 489, 489, 2958, 2958, + 489, -468, 401, 407, 489, 489, 3125, 187, -468, -468, + 417, -468, -468, -468, -468, 438, 410, -468, -468, -468, + -468, 419, 489, 489, -468, 207, 207, 418, 426, 192, + 2958, 2958, 489, -468, -468, 987, -468, 1088, -468, -468, + -468, -468, 1189, -468, 192, 192, -468, 489, 437, -468, + -468, 489, 489, -468, 432, 435, 192, -468, -468, -14, + -468, -468, -468, 1290, -468, 2958, 192, 192, -468, 489, + -468, 481, 539, -468, -468, 466, -468, -468, -468, 192, + -468, -468, -468, 489, 1775, -468, 1391, 207, 467, -468, + -468, 489, -468 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -255,8 +255,8 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 18, 7, 64, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 59, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 196, 0, 186, 187, 292, 295, - 294, 293, 281, 282, 279, 265, 0, 0, 0, 0, + 0, 15, 113, 0, 186, 187, 292, 295, 294, 293, + 281, 282, 279, 196, 0, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, @@ -275,7 +275,7 @@ static const yytype_int16 yydefact[] = 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 0, 287, 289, 0, 0, 144, + 175, 164, 173, 161, 287, 289, 0, 0, 0, 144, 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, @@ -283,14 +283,14 @@ static const yytype_int16 yydefact[] = 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, - 97, 0, 0, 149, 0, 155, 0, 0, 231, 232, - 233, 0, 284, 153, 0, 230, 234, 267, 228, 147, - 0, 221, 0, 222, 0, 0, 16, 18, 30, 92, + 97, 0, 0, 0, 149, 155, 0, 231, 232, 233, + 0, 0, 284, 153, 0, 230, 234, 267, 228, 0, + 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, 0, 0, 105, 107, 103, 111, 138, 0, 0, 143, 0, 199, 118, 0, 116, 134, 212, 159, 0, 152, - 207, 148, 0, 154, 0, 150, 223, 224, 146, 0, + 207, 0, 148, 154, 0, 150, 223, 224, 146, 0, 94, 18, 55, 265, 77, 77, 0, 0, 0, 0, 0, 45, 0, 0, 0, 0, 106, 270, 253, 21, 0, 21, 157, 151, 135, 0, 18, 124, 34, 123, @@ -307,16 +307,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -495, -495, -495, -495, -495, -495, -495, -495, -495, 228, - -495, -5, -139, -495, -17, -495, 561, 471, -1, -495, - -495, -495, -495, -495, -495, -495, -495, -495, 430, -341, - -494, -129, -458, -495, 76, 232, -337, 50, -495, 49, - 247, -495, 219, 173, -243, 310, 372, -495, -495, 242, - -495, 265, -495, -495, -495, -495, 169, -495, -495, 143, - -495, 154, -8, -37, -495, -495, -495, -495, -495, -495, - -495, -495, -495, -495, -495, -495, 103, -495, -495, 485, - -124, -95, -495, -495, 289, -495, -495, 427, 38, -45, - -42, -495, -495, -495, -495, -495, 13 + -468, -468, -468, -468, -468, -468, -468, -468, -468, 41, + -468, -5, -109, -468, -17, -468, 564, 480, 8, -468, + -468, -468, -468, -468, -468, -468, -468, -468, 372, -341, + -467, -151, -447, -468, 77, 246, -304, 29, -468, 66, + 280, -468, 232, 181, -243, 337, 367, -468, -468, 250, + -468, 254, -468, -468, -468, -468, 185, -468, -468, 126, + -468, 169, -8, -37, -468, -468, -468, -468, -468, -468, + -468, -468, -468, -468, -468, -468, 100, -468, -468, 483, + -124, -129, -468, -468, 290, -468, -468, 422, 1, -45, + -42, -468, -468, -468, -468, -468, 48 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -339,96 +339,97 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 176, 429, 421, - 115, 103, 530, 162, 433, 551, 177, 503, 435, 377, - 16, 440, 441, 21, 22, 23, 245, 246, 128, 274, - 83, 21, 22, 285, 122, 123, 124, 150, 125, 126, - 129, 207, 268, 269, 21, 22, 135, 83, 169, 118, - 208, 392, 136, 137, 119, 145, 146, 151, 175, 121, - 121, 121, 152, 121, 121, 181, 254, -286, 179, 180, - 184, 171, 83, 570, 118, 207, -286, 348, 214, 119, - 144, 121, 206, -288, 208, 314, 158, 138, 142, 315, - 316, 317, -288, -261, 318, 121, 121, 319, 422, 552, - 564, -262, 483, -286, 178, 243, 375, -290, 271, 213, - 279, -260, -286, 280, 220, 155, 142, 218, 57, 272, - 258, 247, 116, 117, 156, 393, 57, -264, 267, 59, - 59, 172, 173, 174, 228, 130, 175, 57, 320, 57, - 134, 507, 508, -263, 140, 409, 221, 148, 282, 222, - 154, 270, 161, 223, 163, 164, 165, 166, 167, 182, - 183, 373, 57, 405, 287, 288, 289, 447, 291, 292, - 294, 172, 173, 174, 535, 411, 144, 471, 229, 413, - 353, 230, 321, 354, 322, 323, -288, 172, 173, 174, - 172, 173, 174, 278, 457, -288, 224, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 527, 528, 555, 461, - 172, 173, 174, 232, 492, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 225, 496, 362, 364, - 362, 362, 362, 362, 233, 226, 256, 57, 235, 84, - 172, 173, 174, 325, 172, 173, 174, 209, 59, 120, - 120, 120, 449, 120, 120, 211, 210, 257, 276, 172, - 173, 174, 384, 352, 212, 338, 339, 387, 259, 139, - 120, 120, 147, 261, 172, 173, 174, 391, 290, 172, - 173, 174, 132, 133, 295, 120, 120, 296, 297, 298, - 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 263, 397, 216, 217, 283, - 401, 353, 464, 404, 354, 265, 172, 173, 174, 236, - 237, 238, 239, 336, 285, 340, 240, 231, 241, 172, - 173, 174, 346, 357, 425, 364, 428, 428, 506, 142, - 372, 509, 369, 378, 382, 513, 514, 437, 273, 501, - 428, 428, 439, 172, 173, 174, 172, 173, 174, 260, - 121, 394, 383, 524, 525, 385, 120, 236, 237, 238, - 239, 390, 450, 536, 240, 392, 241, 172, 173, 174, - 533, 174, 398, -83, 458, 431, 286, 417, 544, 172, - 173, 174, 546, 547, 352, 541, 542, 399, 400, 59, - 402, 172, 173, 174, 172, 173, 174, 550, 406, 410, - 559, 442, 469, 407, 185, 423, 472, 556, 557, 381, - 57, 186, 187, 446, 567, 432, 459, 479, 452, 465, - 565, 428, 572, 466, 389, 467, 142, 468, 474, 487, - 473, 188, 189, 396, 190, 191, 192, 193, 194, 195, - 196, 197, 198, 199, 200, 172, 173, 174, 475, 201, - 476, 360, 202, 203, 204, 205, 172, 173, 174, 477, - 428, 428, 515, 186, 517, 478, 489, -215, 172, 173, - 174, 480, 481, 522, 484, 395, 485, 207, -215, 493, - 488, 450, 186, 187, 491, 494, 208, 504, 412, 460, - 495, 497, 425, 428, 511, 512, 200, 516, 518, 543, - 414, 201, 519, 523, 202, 203, 204, 205, 545, -215, - -215, -215, -215, 560, 199, 200, -215, 531, -215, 532, - 201, -215, 548, 202, 203, 204, 205, 428, -215, -215, - 172, 173, 174, 566, 549, 486, 172, 173, 174, 562, - 120, -215, 563, -215, -215, -215, 571, -215, -215, -215, + 113, 255, 59, 159, 17, 142, 160, 285, 268, 269, + 551, 20, 21, 162, 433, 124, 20, 21, 22, 377, + 103, 119, 119, 119, 83, 421, 119, 119, 503, 274, + 245, 246, 176, 175, 177, 20, 21, 150, 207, 530, + 208, 429, 83, 144, 119, 116, 128, 137, 169, 158, + 117, 435, 84, 392, 440, 441, 254, -261, 119, 119, + 151, 118, 118, 118, 447, 152, 118, 118, 120, 121, + 122, 348, 83, 125, 126, 116, 16, -286, 214, -286, + 117, 138, 139, 118, 118, 147, 129, -288, 142, -288, + 145, 146, 375, 209, 552, 210, 155, 228, 118, 118, + 570, 135, 211, -260, 212, 156, 171, 57, 271, 136, + 279, 564, 57, 280, 243, 422, 142, 175, 114, 115, + 258, 178, 172, 173, 174, 394, 247, 373, 267, 59, + 59, 57, 130, 57, 405, 483, 207, 134, 208, 144, + 231, 140, 410, 181, 148, 412, 184, 154, 282, 161, + 206, 163, 164, 165, 166, 167, 278, -290, 172, 173, + 174, 179, 180, 57, 287, 288, 289, 213, 291, 292, + 294, 414, 260, 218, 507, 508, 457, 471, 220, 118, + 353, 221, -286, 354, -286, 222, 270, 223, -262, 232, + 462, 172, 173, 174, -288, 229, -288, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 535, 172, 173, + 174, 172, 173, 174, 230, 342, 343, 344, 345, 347, + 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, + 362, 362, 362, 362, -264, 235, 492, 172, 173, 174, + 233, 555, 172, 173, 174, 256, -263, 257, 59, 172, + 173, 174, 449, 527, 528, 276, 172, 173, 174, 182, + 183, 200, 384, 172, 173, 174, 201, 387, 259, 202, + 203, 204, 205, 261, 360, 290, 263, 391, 464, 286, + 272, 295, 338, 339, 296, 297, 298, 299, 300, 301, + 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, + 312, 313, 172, 173, 174, 265, 172, 173, 174, 400, + 401, 353, 283, 404, 354, 132, 133, 314, 315, 316, + 216, 217, 317, 119, 318, 285, 319, 172, 173, 174, + 336, 172, 173, 174, 425, 364, 428, 428, 273, 142, + 224, -291, -291, -291, 205, 340, 346, 437, 431, 501, + 428, 428, 439, 236, 237, 238, 239, 352, 533, 393, + 240, 381, 241, 118, 357, 372, 369, 320, 506, 378, + 225, 509, 450, 541, 542, 513, 514, 382, 385, 226, + 383, 57, 390, 392, 458, 550, 174, 172, 173, 174, + 407, 397, 398, 524, 525, 556, 557, 399, 402, 59, + 186, 187, 406, 536, 417, 172, 173, 174, 565, 57, + 423, 321, 469, 322, 323, 442, 472, -83, 544, 172, + 173, 174, 546, 547, 432, 186, 187, 479, 172, 173, + 174, 428, 199, 200, 446, 459, 142, 409, 201, 487, + 559, 202, 203, 204, 205, 452, 172, 173, 174, 465, + 473, 411, 466, 467, 567, 197, 198, 199, 200, 468, + 413, 474, 572, 201, 478, 488, 202, 203, 204, 205, + 428, 428, 515, 186, 517, 475, 481, -215, 415, 476, + 172, 173, 174, 522, 477, 480, 484, -215, 485, 489, + 494, 450, 186, 187, 491, 207, 460, 208, 493, 172, + 173, 174, 425, 428, 495, 497, 200, 504, 511, 543, + 518, 201, 461, 512, 202, 203, 204, 205, 519, -215, + -215, -215, -215, 516, 531, 200, -215, 523, -215, 389, + 201, -215, 532, 202, 203, 204, 205, 428, -215, -215, + 548, 549, 486, 566, 545, 172, 173, 174, 172, 173, + 174, -215, 560, -215, -215, -215, 562, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, 415, -254, 107, 426, -215, 242, 462, -215, - -215, -215, -215, -215, -254, -215, 534, 388, -215, 172, - 173, 174, 470, 172, 173, 174, 172, 173, 174, 201, - 186, 187, 202, 203, 204, 205, 172, 173, 174, -291, - -291, -291, 205, 444, 568, -254, -254, -254, -254, 408, - 371, 490, -254, 455, -254, 499, 456, -254, 195, 196, - 197, 198, 199, 200, -254, -254, 463, 445, 201, 521, - 277, 202, 203, 204, 205, 438, 0, -254, 0, -254, - -254, -254, 351, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, 365, 366, - 367, 368, -254, -13, 85, -254, -254, -254, -254, -254, - 0, -254, 0, 18, -254, 19, 20, 21, 22, 23, - 0, 0, 83, 0, 24, 25, 26, 27, 28, 0, + -215, -215, 563, 571, -254, 395, -215, 107, 408, -215, + -215, -215, -215, -215, -254, -215, 242, 534, -215, 426, + 172, 173, 174, 568, 172, 173, 174, 172, 173, 174, + 470, 186, 187, 1, 2, 3, 4, 5, 6, 7, + 365, 366, 367, 368, 388, 371, -254, -254, -254, -254, + 455, 444, 521, -254, 456, -254, 445, 463, -254, 195, + 196, 197, 198, 199, 200, -254, -254, 490, 277, 201, + 499, 0, 202, 203, 204, 205, 438, 351, -254, 0, + -254, -254, -254, 0, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, -254, 0, + 0, 0, 0, -254, 0, 0, -254, -254, -254, -254, + -254, 0, -254, -13, 85, -254, 201, 0, 0, 202, + 203, 204, 205, 0, 18, 19, 20, 21, 22, 0, + 0, 83, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 186, 187, 96, 97, 98, 99, 37, 0, 100, 38, + 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 200, 0, 0, 0, - 0, 201, 50, 200, 202, 203, 204, 205, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 51, 52, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, - 56, 101, 57, 58, 0, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 83, 0, 24, 25, 26, 27, + 56, 101, 57, 58, 0, 0, 18, 19, 20, 21, + 22, 0, 0, 83, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, - 6, 7, 0, 0, 50, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 83, 416, 24, 25, 26, + 0, 0, 56, 101, 57, 58, 0, 18, 19, 20, + 21, 22, 0, 0, 83, 416, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, @@ -437,8 +438,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 101, 57, 58, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 83, 537, 24, 25, + 0, 0, 0, 56, 101, 57, 58, 0, 18, 19, + 20, 21, 22, 0, 0, 83, 537, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, @@ -447,8 +448,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 101, 57, 58, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 83, 538, 24, + 0, 0, 0, 0, 56, 101, 57, 58, 0, 18, + 19, 20, 21, 22, 0, 0, 83, 538, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, @@ -457,8 +458,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 101, 57, 58, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 83, 540, + 85, 0, 0, 0, 0, 56, 101, 57, 58, 0, + 18, 19, 20, 21, 22, 0, 0, 83, 540, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, @@ -468,8 +469,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 18, 0, 19, 20, 21, 22, 23, 0, 0, 83, - 554, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 18, 19, 20, 21, 22, 0, 0, 83, 554, + 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, @@ -478,8 +479,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, - 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, - 83, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 58, 0, 18, 19, 20, 21, 22, 0, 0, 83, + 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, @@ -488,8 +489,8 @@ static const yytype_int16 yytable[] = 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, - 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 83, 0, 24, 25, 26, 27, 28, 0, 29, + 57, 58, 0, 18, 19, 20, 21, 22, 0, 0, + 83, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, @@ -498,28 +499,26 @@ static const yytype_int16 yytable[] = 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 101, 57, 58, 18, 0, 19, 20, 21, 22, 23, - 0, 0, 83, 0, 24, 25, 26, 27, 28, 0, + 101, 57, 58, 0, 18, 19, 20, 21, 22, 0, + 0, 83, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 0, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 101, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, + 0, 0, 0, 0, 0, 85, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, + 56, 101, 57, 58, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, -78, 57, 58, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 0, 0, 24, 25, 26, 27, + 202, 203, 204, 205, 0, 0, 85, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 18, 19, 20, 21, + 22, 56, -78, 57, 58, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -528,9 +527,9 @@ static const yytype_int16 yytable[] = 198, 199, 200, 0, 50, 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, -78, 56, 0, 57, 58, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 83, 0, 141, 25, 26, - 27, 28, 119, 29, 30, 31, 32, 33, 34, 0, + 0, -78, 56, 0, 57, 58, 123, 18, 19, 20, + 21, 22, 0, 0, 0, 0, 23, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, @@ -538,18 +537,36 @@ static const yytype_int16 yytable[] = 198, 199, 200, 0, 0, 50, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 186, 187, 0, 56, 0, 57, 58, 18, 114, 19, - 20, 21, 22, 23, 0, 0, 0, 0, 24, 25, + 0, 0, 0, 56, 0, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 83, 0, 23, 141, 25, 26, + 27, 28, 117, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 236, 237, 238, 239, + 0, 0, 0, 240, 0, 241, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 172, 173, 174, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 0, 56, 0, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 83, 0, 23, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, + 20, 21, 22, 56, 0, 57, 58, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 197, 198, 199, 200, 0, 35, 36, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 83, 0, 24, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 20, 21, 22, 56, 149, 57, 58, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -558,214 +575,198 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 0, 56, 0, 57, 58, 18, - 0, 19, 20, 21, 22, 23, 0, 0, 0, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 168, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 56, 149, 57, 58, - 18, 0, 19, 20, 21, 22, 23, 0, 0, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 266, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 168, 56, 0, 57, - 58, 18, 0, 19, 20, 21, 22, 23, 0, 0, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 266, 56, 0, - 57, 58, 18, 0, 19, 20, 21, 22, 23, 0, - 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, - 0, 57, 58, 18, 0, 19, 20, 21, 22, 23, - 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, - 56, 0, 57, 58, 18, 0, 19, 20, 21, 22, - 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 326, 56, 0, 57, 58, 18, 0, 19, 20, 21, - 22, 23, 0, 0, 0, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 281, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 386, 56, 0, 57, 58, 18, 0, 19, 20, - 21, 22, 23, 0, 0, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 403, 56, 0, 57, 58, 18, 0, 19, - 20, 21, 22, 23, 0, 0, 0, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 293, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 0, 57, 58, 18, 0, - 19, 20, 21, 22, 23, 0, 0, 0, 0, 24, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 326, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 386, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 403, 56, 0, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 0, 275, 0, 57, 58, 188, - 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, - 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 189, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, -291, 0, 202, 203, 204, 205, - 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 18, 19, 20, 21, 22, 56, 0, 57, 58, 23, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 185, 0, 0, 0, 0, 0, 0, + 186, 187, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 0, 275, 0, 57, 58, + 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 188, 189, 0, 190, + 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, + 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, + 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 190, 191, 192, 193, 194, 195, - 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, - 0, 0, 202, 203, 204, 205 + 0, 0, 0, 189, 0, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, -291, 0, 202, 203, 204, 205, 0, 186, 187, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 199, 200, 0, 0, 0, 0, 201, 0, 0, 202, + 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 10, 345, 19, - 18, 12, 506, 50, 355, 24, 19, 475, 355, 262, - 0, 358, 359, 14, 15, 16, 14, 15, 10, 153, - 19, 14, 15, 10, 21, 22, 23, 45, 25, 26, - 107, 10, 137, 138, 14, 15, 107, 19, 56, 21, - 19, 10, 107, 73, 26, 42, 43, 21, 80, 21, - 22, 23, 26, 25, 26, 91, 11, 10, 91, 92, - 89, 58, 19, 567, 21, 10, 19, 68, 83, 26, - 42, 43, 107, 10, 19, 10, 48, 107, 125, 14, - 15, 16, 19, 70, 19, 57, 58, 22, 108, 108, - 558, 70, 439, 10, 107, 106, 11, 19, 145, 19, - 155, 70, 19, 155, 107, 98, 153, 21, 109, 20, - 128, 109, 19, 20, 107, 11, 109, 70, 136, 137, - 138, 76, 77, 78, 96, 32, 80, 109, 63, 109, - 37, 478, 479, 70, 41, 11, 107, 44, 156, 107, - 47, 138, 49, 107, 51, 52, 53, 54, 55, 89, - 90, 256, 109, 110, 172, 173, 174, 111, 176, 177, - 178, 76, 77, 78, 511, 11, 138, 420, 107, 11, - 225, 107, 107, 225, 109, 110, 10, 76, 77, 78, - 76, 77, 78, 155, 11, 19, 68, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 46, 47, 545, 11, - 76, 77, 78, 108, 11, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 98, 470, 236, 237, - 238, 239, 240, 241, 48, 107, 107, 109, 108, 11, - 76, 77, 78, 205, 76, 77, 78, 10, 256, 21, - 22, 23, 376, 25, 26, 10, 19, 73, 155, 76, - 77, 78, 270, 225, 19, 216, 217, 275, 106, 41, - 42, 43, 44, 24, 76, 77, 78, 285, 175, 76, - 77, 78, 35, 36, 181, 57, 58, 184, 185, 186, - 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 70, 314, 88, 89, 70, - 318, 356, 407, 321, 356, 106, 76, 77, 78, 42, - 43, 44, 45, 21, 10, 21, 49, 99, 51, 76, - 77, 78, 98, 107, 342, 343, 344, 345, 477, 376, - 80, 480, 26, 24, 74, 484, 485, 355, 108, 473, - 358, 359, 357, 76, 77, 78, 76, 77, 78, 131, - 322, 108, 106, 502, 503, 20, 138, 42, 43, 44, - 45, 24, 377, 512, 49, 10, 51, 76, 77, 78, - 509, 78, 110, 106, 392, 347, 106, 17, 527, 76, - 77, 78, 531, 532, 356, 524, 525, 110, 110, 407, - 110, 76, 77, 78, 76, 77, 78, 536, 110, 108, - 549, 81, 417, 107, 54, 21, 421, 546, 547, 106, - 109, 61, 62, 106, 563, 107, 20, 432, 107, 20, - 559, 439, 571, 20, 106, 20, 473, 20, 106, 447, - 21, 81, 82, 83, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 76, 77, 78, 106, 99, - 106, 233, 102, 103, 104, 105, 76, 77, 78, 106, - 478, 479, 489, 61, 491, 107, 19, 0, 76, 77, - 78, 106, 108, 500, 106, 106, 106, 10, 11, 20, - 74, 496, 61, 62, 19, 106, 19, 19, 108, 396, - 108, 108, 510, 511, 107, 106, 94, 106, 72, 526, - 108, 99, 108, 108, 102, 103, 104, 105, 107, 42, - 43, 44, 45, 71, 93, 94, 49, 106, 51, 106, - 99, 54, 108, 102, 103, 104, 105, 545, 61, 62, - 76, 77, 78, 560, 106, 442, 76, 77, 78, 18, - 322, 74, 106, 76, 77, 78, 106, 80, 81, 82, + 17, 125, 10, 48, 9, 42, 48, 20, 137, 138, + 24, 13, 14, 50, 355, 23, 13, 14, 15, 262, + 12, 20, 21, 22, 18, 18, 25, 26, 475, 153, + 13, 14, 18, 80, 20, 13, 14, 45, 18, 506, + 20, 345, 18, 42, 43, 21, 20, 73, 56, 48, + 26, 355, 11, 20, 358, 359, 10, 70, 57, 58, + 21, 20, 21, 22, 111, 26, 25, 26, 20, 21, + 22, 68, 18, 25, 26, 21, 0, 18, 83, 20, + 26, 107, 41, 42, 43, 44, 107, 18, 125, 20, + 42, 43, 10, 18, 108, 20, 98, 96, 57, 58, + 567, 107, 18, 70, 20, 107, 58, 109, 145, 107, + 155, 558, 109, 155, 106, 108, 153, 80, 18, 19, + 128, 107, 76, 77, 78, 10, 109, 256, 136, 137, + 138, 109, 32, 109, 110, 439, 18, 37, 20, 138, + 99, 41, 10, 91, 44, 10, 89, 47, 156, 49, + 107, 51, 52, 53, 54, 55, 155, 18, 76, 77, + 78, 91, 92, 109, 172, 173, 174, 18, 176, 177, + 178, 10, 131, 21, 478, 479, 10, 420, 107, 138, + 225, 107, 18, 225, 20, 107, 138, 107, 70, 108, + 10, 76, 77, 78, 18, 107, 20, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 511, 76, 77, + 78, 76, 77, 78, 107, 220, 221, 222, 223, 224, + 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, + 238, 239, 240, 241, 70, 108, 10, 76, 77, 78, + 48, 545, 76, 77, 78, 107, 70, 73, 256, 76, + 77, 78, 376, 46, 47, 155, 76, 77, 78, 89, + 90, 94, 270, 76, 77, 78, 99, 275, 106, 102, + 103, 104, 105, 24, 233, 175, 70, 285, 407, 106, + 19, 181, 216, 217, 184, 185, 186, 187, 188, 189, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 76, 77, 78, 106, 76, 77, 78, 317, + 318, 356, 70, 321, 356, 35, 36, 13, 14, 15, + 88, 89, 18, 322, 20, 20, 22, 76, 77, 78, + 21, 76, 77, 78, 342, 343, 344, 345, 108, 376, + 68, 102, 103, 104, 105, 21, 98, 355, 347, 473, + 358, 359, 357, 42, 43, 44, 45, 356, 509, 108, + 49, 106, 51, 322, 107, 80, 26, 63, 477, 24, + 98, 480, 377, 524, 525, 484, 485, 74, 19, 107, + 106, 109, 24, 20, 392, 536, 78, 76, 77, 78, + 107, 110, 110, 502, 503, 546, 547, 110, 110, 407, + 61, 62, 110, 512, 16, 76, 77, 78, 559, 109, + 21, 107, 417, 109, 110, 81, 421, 106, 527, 76, + 77, 78, 531, 532, 107, 61, 62, 432, 76, 77, + 78, 439, 93, 94, 106, 19, 473, 108, 99, 447, + 549, 102, 103, 104, 105, 107, 76, 77, 78, 19, + 21, 108, 19, 19, 563, 91, 92, 93, 94, 19, + 108, 106, 571, 99, 107, 74, 102, 103, 104, 105, + 478, 479, 489, 61, 491, 106, 108, 0, 108, 106, + 76, 77, 78, 500, 106, 106, 106, 10, 106, 18, + 106, 496, 61, 62, 18, 18, 396, 20, 19, 76, + 77, 78, 510, 511, 108, 108, 94, 18, 107, 526, + 72, 99, 108, 106, 102, 103, 104, 105, 108, 42, + 43, 44, 45, 106, 106, 94, 49, 108, 51, 106, + 99, 54, 106, 102, 103, 104, 105, 545, 61, 62, + 108, 106, 442, 560, 107, 76, 77, 78, 76, 77, + 78, 74, 71, 76, 77, 78, 17, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 108, 0, 13, 343, 99, 106, 108, 102, - 103, 104, 105, 106, 11, 108, 510, 277, 111, 76, - 77, 78, 419, 76, 77, 78, 76, 77, 78, 99, - 61, 62, 102, 103, 104, 105, 76, 77, 78, 102, - 103, 104, 105, 371, 564, 42, 43, 44, 45, 106, - 248, 452, 49, 106, 51, 471, 106, 54, 89, 90, - 91, 92, 93, 94, 61, 62, 106, 372, 99, 496, - 155, 102, 103, 104, 105, 356, -1, 74, -1, 76, - 77, 78, 225, 80, 81, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 238, 239, - 240, 241, 99, 0, 1, 102, 103, 104, 105, 106, - -1, 108, -1, 10, 111, 12, 13, 14, 15, 16, - -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, + 93, 94, 106, 106, 0, 106, 99, 13, 106, 102, + 103, 104, 105, 106, 10, 108, 106, 510, 111, 343, + 76, 77, 78, 564, 76, 77, 78, 76, 77, 78, + 419, 61, 62, 3, 4, 5, 6, 7, 8, 9, + 238, 239, 240, 241, 277, 248, 42, 43, 44, 45, + 106, 371, 496, 49, 106, 51, 372, 106, 54, 89, + 90, 91, 92, 93, 94, 61, 62, 452, 155, 99, + 471, -1, 102, 103, 104, 105, 356, 225, 74, -1, + 76, 77, 78, -1, 80, 81, 82, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, + -1, -1, -1, 99, -1, -1, 102, 103, 104, 105, + 106, -1, 108, 0, 1, 111, 99, -1, -1, 102, + 103, 104, 105, -1, 11, 12, 13, 14, 15, -1, + -1, 18, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - 61, 62, 49, 50, 51, 52, 53, -1, 55, 56, + -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, 94, -1, -1, -1, - -1, 99, 79, 94, 102, 103, 104, 105, 99, -1, - -1, 102, 103, 104, 105, -1, -1, -1, 95, 96, + 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 0, 1, -1, -1, -1, - 107, 108, 109, 110, -1, 10, -1, 12, 13, 14, - 15, 16, -1, -1, 19, -1, 21, 22, 23, 24, + 107, 108, 109, 110, -1, -1, 11, 12, 13, 14, + 15, -1, -1, 18, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, 3, 4, 5, 6, 7, - 8, 9, -1, -1, 79, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, - -1, -1, 107, 108, 109, 110, 10, -1, 12, 13, - 14, 15, 16, -1, -1, 19, 20, 21, 22, 23, + -1, -1, 107, 108, 109, 110, -1, 11, 12, 13, + 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, @@ -774,8 +775,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, - -1, -1, -1, 107, 108, 109, 110, 10, -1, 12, - 13, 14, 15, 16, -1, -1, 19, 20, 21, 22, + -1, -1, -1, 107, 108, 109, 110, -1, 11, 12, + 13, 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, @@ -784,8 +785,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, - -1, -1, -1, -1, 107, 108, 109, 110, 10, -1, - 12, 13, 14, 15, 16, -1, -1, 19, 20, 21, + -1, -1, -1, -1, 107, 108, 109, 110, -1, 11, + 12, 13, 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, @@ -794,8 +795,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - 1, -1, -1, -1, -1, 107, 108, 109, 110, 10, - -1, 12, 13, 14, 15, 16, -1, -1, 19, 20, + 1, -1, -1, -1, -1, 107, 108, 109, 110, -1, + 11, 12, 13, 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, @@ -805,7 +806,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - 10, -1, 12, 13, 14, 15, 16, -1, -1, 19, + -1, 11, 12, 13, 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, @@ -815,8 +816,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, - 110, 10, -1, 12, 13, 14, 15, 16, -1, -1, - 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 110, -1, 11, 12, 13, 14, 15, -1, -1, 18, + -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, @@ -825,8 +826,8 @@ static const yytype_int16 yycheck[] = 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, - 109, 110, 10, -1, 12, 13, 14, 15, 16, -1, - -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, + 109, 110, -1, 11, 12, 13, 14, 15, -1, -1, + 18, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, @@ -835,28 +836,26 @@ static const yytype_int16 yycheck[] = -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, 10, -1, 12, 13, 14, 15, 16, - -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, + 108, 109, 110, -1, 11, 12, 13, 14, 15, -1, + -1, 18, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, -1, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, - 107, 108, 109, 110, 10, -1, 12, 13, 14, 15, - 16, -1, -1, -1, -1, 21, 22, 23, 24, 25, + -1, -1, -1, -1, -1, 1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, 11, 12, 13, 14, 15, + 107, 108, 109, 110, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, 61, 62, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, 86, 87, 88, 89, 90, 91, 92, 93, 94, 79, -1, -1, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, - -1, 107, 108, 109, 110, 10, -1, 12, 13, 14, - 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, + 102, 103, 104, 105, -1, -1, 1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, 11, 12, 13, 14, + 15, 107, 108, 109, 110, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, 53, -1, @@ -865,9 +864,9 @@ static const yytype_int16 yycheck[] = 92, 93, 94, -1, 79, -1, -1, 99, -1, -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, 106, 107, -1, 109, 110, 10, -1, 12, 13, - 14, 15, 16, -1, -1, 19, -1, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, + -1, 106, 107, -1, 109, 110, 10, 11, 12, 13, + 14, 15, -1, -1, -1, -1, 20, 21, 22, 23, + 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, @@ -875,18 +874,36 @@ static const yytype_int16 yycheck[] = 92, 93, 94, -1, -1, 79, -1, 99, -1, -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - 61, 62, -1, 107, -1, 109, 110, 10, 11, 12, - 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, + -1, -1, -1, 107, -1, 109, 110, 11, 12, 13, + 14, 15, -1, -1, 18, -1, 20, 21, 22, 23, + 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, + -1, -1, -1, -1, 38, 39, 42, 43, 44, 45, + -1, -1, -1, 49, -1, 51, -1, -1, -1, 53, + -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, + 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, + 76, 77, 78, -1, -1, 79, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, + -1, -1, -1, 107, -1, 109, 110, 11, 12, 13, + 14, 15, -1, -1, 18, -1, 20, 21, 22, 23, + 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, + -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, + -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, + 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 95, 96, -1, 98, -1, 100, 101, 11, 12, + 13, 14, 15, 107, -1, 109, 110, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - 91, 92, 93, 94, -1, 38, 39, -1, 99, -1, - -1, 102, 103, 104, 105, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, - -1, -1, -1, -1, 107, -1, 109, 110, 10, -1, - 12, 13, 14, 15, 16, -1, -1, 19, -1, 21, + -1, -1, 95, 96, -1, 98, -1, 100, 101, 11, + 12, 13, 14, 15, 107, 108, 109, 110, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -895,120 +912,103 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, -1, 107, -1, 109, 110, 10, - -1, 12, 13, 14, 15, 16, -1, -1, -1, -1, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, - 101, -1, -1, -1, -1, -1, 107, 108, 109, 110, - 10, -1, 12, 13, 14, 15, 16, -1, -1, -1, - -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, - 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, - 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, - 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, - 110, 10, -1, 12, 13, 14, 15, 16, -1, -1, - -1, -1, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, - 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, - 109, 110, 10, -1, 12, 13, 14, 15, 16, -1, - -1, -1, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, - 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, - -1, 109, 110, 10, -1, 12, 13, 14, 15, 16, - -1, -1, -1, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 10, -1, 12, 13, 14, 15, - 16, -1, -1, -1, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - 106, 107, -1, 109, 110, 10, -1, 12, 13, 14, - 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, 106, 107, -1, 109, 110, 10, -1, 12, 13, - 14, 15, 16, -1, -1, -1, -1, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, 106, 107, -1, 109, 110, 10, -1, 12, - 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, - -1, -1, -1, -1, 107, -1, 109, 110, 10, -1, - 12, 13, 14, 15, 16, -1, -1, -1, -1, 21, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, 54, -1, -1, -1, -1, -1, -1, 61, - 62, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, -1, 107, -1, 109, 110, 81, - 82, -1, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, -1, -1, -1, -1, 99, 54, -1, - 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 82, -1, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, - -1, -1, -1, 99, 54, -1, 102, 103, 104, 105, - -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, + 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, + -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, + 11, 12, 13, 14, 15, 107, -1, 109, 110, 20, + 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, + 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, + -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, -1, -1, 54, -1, -1, -1, -1, -1, -1, + 61, 62, -1, -1, 95, 96, -1, 98, -1, 100, + 101, -1, -1, -1, -1, -1, 107, -1, 109, 110, + 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, -1, -1, -1, -1, 99, 54, + -1, 102, 103, 104, 105, -1, 61, 62, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 81, 82, -1, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + -1, -1, -1, -1, 99, 54, -1, 102, 103, 104, + 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 82, -1, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, -1, -1, -1, -1, + 99, 54, -1, 102, 103, 104, 105, -1, 61, 62, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, -1, -1, -1, -1, 99, - -1, -1, 102, 103, 104, 105 + -1, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, -1, -1, -1, -1, 99, -1, -1, 102, + 103, 104, 105 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1016,62 +1016,62 @@ static const yytype_int16 yycheck[] = static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 10, 12, - 13, 14, 15, 16, 21, 22, 23, 24, 25, 27, + 115, 116, 117, 118, 119, 120, 0, 123, 11, 12, + 13, 14, 15, 20, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 19, 121, 1, 33, 35, 36, 37, + 205, 206, 207, 18, 121, 1, 33, 35, 36, 37, 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, - 126, 168, 169, 126, 11, 174, 188, 188, 21, 26, - 121, 200, 208, 208, 208, 208, 208, 189, 10, 107, + 126, 168, 169, 126, 188, 188, 21, 26, 121, 200, + 208, 208, 208, 10, 174, 208, 208, 189, 20, 107, 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, - 208, 208, 76, 77, 78, 80, 10, 19, 107, 91, + 208, 208, 76, 77, 78, 80, 18, 20, 107, 91, 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 99, 102, 103, 104, 105, 107, 10, 19, 10, - 19, 10, 19, 19, 123, 153, 154, 154, 21, 151, + 94, 99, 102, 103, 104, 105, 107, 18, 20, 18, + 20, 18, 20, 18, 123, 153, 154, 154, 21, 151, 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 14, 15, 109, 159, 160, - 162, 163, 164, 165, 11, 192, 107, 73, 174, 106, + 49, 51, 129, 130, 128, 13, 14, 109, 159, 160, + 162, 163, 164, 165, 10, 192, 107, 73, 174, 106, 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, - 208, 175, 20, 108, 192, 107, 188, 191, 200, 201, - 202, 106, 174, 70, 157, 10, 106, 174, 174, 174, + 208, 175, 19, 108, 192, 107, 188, 191, 200, 201, + 202, 106, 174, 70, 157, 20, 106, 174, 174, 174, 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 14, 15, 16, 19, 22, + 188, 188, 188, 188, 13, 14, 15, 18, 20, 22, 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, - 158, 158, 80, 193, 175, 11, 177, 156, 24, 123, - 173, 106, 74, 106, 174, 20, 106, 174, 157, 106, - 24, 174, 10, 11, 108, 106, 83, 174, 110, 110, - 110, 174, 110, 106, 174, 110, 110, 107, 106, 11, - 108, 11, 108, 11, 108, 108, 20, 17, 122, 131, - 132, 19, 108, 21, 146, 174, 147, 148, 174, 148, + 158, 158, 80, 193, 175, 10, 177, 156, 24, 123, + 173, 106, 74, 106, 174, 19, 106, 174, 157, 106, + 24, 174, 20, 108, 10, 106, 83, 110, 110, 110, + 174, 174, 110, 106, 174, 110, 110, 107, 106, 108, + 10, 108, 10, 108, 10, 108, 19, 16, 122, 131, + 132, 18, 108, 21, 146, 174, 147, 148, 174, 148, 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, - 123, 171, 107, 166, 167, 106, 106, 11, 174, 20, - 188, 11, 108, 106, 193, 20, 20, 20, 20, 123, + 123, 171, 107, 166, 167, 106, 106, 10, 174, 19, + 188, 108, 10, 106, 193, 19, 19, 19, 19, 123, 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, - 106, 108, 136, 148, 106, 106, 188, 174, 74, 19, - 168, 19, 11, 20, 106, 108, 156, 108, 172, 173, - 137, 192, 144, 144, 19, 124, 124, 148, 148, 124, + 106, 108, 136, 148, 106, 106, 188, 174, 74, 18, + 168, 18, 10, 19, 106, 108, 156, 108, 172, 173, + 137, 192, 144, 144, 18, 124, 124, 148, 148, 124, 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, - 142, 106, 106, 143, 146, 148, 124, 20, 20, 127, - 20, 143, 143, 126, 124, 107, 124, 124, 108, 106, - 143, 24, 108, 138, 20, 148, 143, 143, 135, 124, - 71, 139, 18, 106, 144, 143, 126, 124, 149, 72, + 142, 106, 106, 143, 146, 148, 124, 19, 19, 127, + 19, 143, 143, 126, 124, 107, 124, 124, 108, 106, + 143, 24, 108, 138, 19, 148, 143, 143, 135, 124, + 71, 139, 17, 106, 144, 143, 126, 124, 149, 72, 142, 106, 124 }; @@ -1188,6 +1188,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 6c3ea5db928a29814d45a0242b73172509984d1db7abce64794b630c401219d7 perly.y + * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 349ed4c6fb57..56d2f321249e 100644 --- a/perly.y +++ b/perly.y @@ -45,9 +45,10 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '[' ']' '-' '+' '@' '%' '&' '=' '.' +%token ']' '-' '+' '@' '%' '&' '=' '.' %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE +%token PERLY_BRACKET_OPEN %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -115,7 +116,7 @@ %left ARROW %nonassoc ')' %left '(' -%left '[' PERLY_BRACE_OPEN +%left PERLY_BRACKET_OPEN PERLY_BRACE_OPEN %% /* RULES */ @@ -962,15 +963,15 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *mai /* In this and all the hash accessors, ';' is * provided by the tokeniser */ { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } - | scalar[array] '[' expr ']' /* $array[$element] */ + | scalar[array] PERLY_BRACKET_OPEN expr ']' /* $array[$element] */ { $$ = newBINOP(OP_AELEM, 0, oopsAV($array), scalar($expr)); } - | term[array_reference] ARROW '[' expr ']' /* somearef->[$element] */ + | term[array_reference] ARROW PERLY_BRACKET_OPEN expr ']' /* somearef->[$element] */ { $$ = newBINOP(OP_AELEM, 0, ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); } - | subscripted[array_reference] '[' expr ']' /* $foo->[$bar]->[$baz] */ + | subscripted[array_reference] PERLY_BRACKET_OPEN expr ']' /* $foo->[$bar]->[$baz] */ { $$ = newBINOP(OP_AELEM, 0, ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); @@ -1013,11 +1014,11 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *mai if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | '(' expr[list] ')' '[' expr[slice] ']' /* list slice */ + | '(' expr[list] ')' PERLY_BRACKET_OPEN expr[slice] ']' /* list slice */ { $$ = newSLICEOP(0, $slice, $list); } - | QWLIST '[' expr ']' /* list literal slice */ + | QWLIST PERLY_BRACKET_OPEN expr ']' /* list literal slice */ { $$ = newSLICEOP(0, $expr, $QWLIST); } - | '(' ')' '[' expr ']' /* empty list slice! */ + | '(' ')' PERLY_BRACKET_OPEN expr ']' /* empty list slice! */ { $$ = newSLICEOP(0, $expr, NULL); } ; @@ -1124,9 +1125,9 @@ termunop : '-' term %prec UMINUS /* -$x */ ; /* Constructors for anonymous data */ -anonymous: '[' expr ']' +anonymous: PERLY_BRACKET_OPEN expr ']' { $$ = newANONLIST($expr); } - | '[' ']' + | PERLY_BRACKET_OPEN ']' { $$ = newANONLIST(NULL);} | HASHBRACK expr ';' PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($expr); } @@ -1179,7 +1180,7 @@ term[product] : termbinop { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} | subscripted { $$ = $subscripted; } - | sliceme '[' expr ']' /* array slice */ + | sliceme PERLY_BRACKET_OPEN expr ']' /* array slice */ { $$ = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1189,7 +1190,7 @@ term[product] : termbinop $$->op_private |= $sliceme->op_private & OPpSLICEWARNING; } - | kvslice '[' expr ']' /* array key/value slice */ + | kvslice PERLY_BRACKET_OPEN expr ']' /* array key/value slice */ { $$ = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, diff --git a/toke.c b/toke.c index d7027639ace2..944e9d306c4d 100644 --- a/toke.c +++ b/toke.c @@ -388,6 +388,7 @@ static struct debug_tokens { { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), + DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" }, @@ -2063,7 +2064,7 @@ Perl_yyunlex(pTHX) if (yyc != YYEMPTY) { if (yyc) { NEXTVAL_NEXTTOKE = PL_parser->yylval; - if (yyc == PERLY_BRACE_OPEN || yyc == HASHBRACK || yyc == '['/*]*/) { + if (yyc == PERLY_BRACE_OPEN || yyc == HASHBRACK || yyc == PERLY_BRACKET_OPEN) { PL_lex_allbrackets--; PL_lex_brackets--; yyc |= (3<<24) | (PL_lex_brackstack[PL_lex_brackets] << 16); @@ -6430,14 +6431,12 @@ yyl_slash(pTHX_ char *s) static int yyl_leftsquare(pTHX_ char *s) { - char tmp; - if (PL_lex_brackets > 100) Renew(PL_lex_brackstack, PL_lex_brackets + 10, char); PL_lex_brackstack[PL_lex_brackets++] = 0; PL_lex_allbrackets++; - tmp = *s++; - OPERATOR(tmp); + s++; + OPERATOR(PERLY_BRACKET_OPEN); } static int From fceeeb7744cc70fab3c07beb6365a987a1567bb4 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:01 +0100 Subject: [PATCH 327/503] Distinguish C- and perly- literals - PERLY_BRACKET_CLOSE --- perly.act | 536 ++++++++++---------- perly.h | 163 ++++--- perly.tab | 1406 ++++++++++++++++++++++++++--------------------------- perly.y | 23 +- toke.c | 3 +- 5 files changed, 1065 insertions(+), 1066 deletions(-) diff --git a/perly.act b/perly.act index 150c7183fbe3..12096013b9c9 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 125 "perly.y" +#line 126 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 130 "perly.y" +#line 131 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 136 "perly.y" +#line 137 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 141 "perly.y" +#line 142 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 146 "perly.y" +#line 147 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 151 "perly.y" +#line 152 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 159 "perly.y" +#line 160 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 164 "perly.y" +#line 165 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 172 "perly.y" +#line 173 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 177 "perly.y" +#line 178 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 185 "perly.y" +#line 186 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 190 "perly.y" +#line 191 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 195 "perly.y" +#line 196 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 200 "perly.y" +#line 201 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 208 "perly.y" +#line 209 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 216 "perly.y" +#line 217 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 223 "perly.y" +#line 224 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 228 "perly.y" +#line 229 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 235 "perly.y" +#line 236 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 241 "perly.y" +#line 242 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 243 "perly.y" +#line 244 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 252 "perly.y" +#line 253 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 254 "perly.y" +#line 255 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 263 "perly.y" +#line 264 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 267 "perly.y" +#line 268 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 271 "perly.y" +#line 272 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 278 "perly.y" +#line 279 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 288 "perly.y" +#line 289 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 290 "perly.y" +#line 291 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 302 "perly.y" +#line 303 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 308 "perly.y" +#line 309 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 323 "perly.y" +#line 324 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 329 "perly.y" +#line 330 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 340 "perly.y" +#line 341 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 347 "perly.y" +#line 348 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 349 "perly.y" +#line 350 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 356 "perly.y" +#line 357 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 362 "perly.y" +#line 363 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 368 "perly.y" +#line 369 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 373 "perly.y" +#line 374 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 375 "perly.y" +#line 376 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 377 "perly.y" +#line 378 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 384 "perly.y" +#line 385 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 391 "perly.y" +#line 392 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 393 "perly.y" +#line 394 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 396 "perly.y" +#line 397 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 411 "perly.y" +#line 412 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 416 "perly.y" +#line 417 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 422 "perly.y" +#line 423 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 424 "perly.y" +#line 425 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 437 "perly.y" +#line 438 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 445 "perly.y" +#line 446 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 451 "perly.y" +#line 452 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 457 "perly.y" +#line 458 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 464 "perly.y" +#line 465 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 472 "perly.y" +#line 473 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 476 "perly.y" +#line 477 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 481 "perly.y" +#line 482 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 489 "perly.y" +#line 490 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 506 "perly.y" +#line 507 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 508 "perly.y" +#line 509 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 516 "perly.y" +#line 517 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 518 "perly.y" +#line 519 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 520 "perly.y" +#line 521 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 522 "perly.y" +#line 523 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 536 "perly.y" +#line 537 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 538 "perly.y" +#line 539 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 543 "perly.y" +#line 544 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 553 "perly.y" +#line 554 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 555 "perly.y" +#line 556 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 560 "perly.y" +#line 561 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 566 "perly.y" +#line 567 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 572 "perly.y" +#line 573 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 580 "perly.y" +#line 581 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 585 "perly.y" +#line 586 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 589 "perly.y" +#line 590 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 592 "perly.y" +#line 593 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 593 "perly.y" +#line 594 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 597 "perly.y" +#line 598 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 603 "perly.y" +#line 604 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 608 "perly.y" +#line 609 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 619 "perly.y" +#line 620 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 625 "perly.y" +#line 626 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 627 "perly.y" +#line 628 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 629 "perly.y" +#line 630 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 634 "perly.y" +#line 635 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 647 "perly.y" +#line 648 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 649 "perly.y" +#line 650 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 654 "perly.y" +#line 655 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 656 "perly.y" +#line 657 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 660 "perly.y" +#line 661 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 679 "perly.y" +#line 680 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 681 "perly.y" +#line 682 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 683 "perly.y" +#line 684 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 689 "perly.y" +#line 690 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 754 "perly.y" +#line 755 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 756 "perly.y" +#line 757 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 762 "perly.y" +#line 763 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 764 "perly.y" +#line 765 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 768 "perly.y" +#line 769 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 773 "perly.y" +#line 774 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 775 "perly.y" +#line 776 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 779 "perly.y" +#line 780 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 781 "perly.y" +#line 782 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 785 "perly.y" +#line 786 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 788 "perly.y" +#line 789 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 799 "perly.y" +#line 800 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 856 "perly.y" +#line 857 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 857 "perly.y" +#line 858 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 863 "perly.y" +#line 864 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 873 "perly.y" +#line 874 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 874 "perly.y" +#line 875 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 878 "perly.y" +#line 879 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 889 "perly.y" +#line 890 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 891 "perly.y" +#line 892 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 893 "perly.y" +#line 894 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 899 "perly.y" +#line 900 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 901 "perly.y" +#line 902 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 910 "perly.y" +#line 911 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 914 "perly.y" +#line 915 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 918 "perly.y" +#line 919 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 924 "perly.y" +#line 925 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 929 "perly.y" +#line 930 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 935 "perly.y" +#line 936 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 941 "perly.y" +#line 942 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 943 "perly.y" +#line 944 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 945 "perly.y" +#line 946 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 947 "perly.y" +#line 948 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 950 "perly.y" +#line 951 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 965 "perly.y" +#line 966 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 967 "perly.y" +#line 968 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 970 "perly.y" +#line 971 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 975 "perly.y" +#line 976 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 980 "perly.y" +#line 981 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 983 "perly.y" +#line 984 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 987 "perly.y" +#line 988 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 991 "perly.y" +#line 992 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 997 "perly.y" +#line 998 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1005 "perly.y" +#line 1006 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1012 "perly.y" +#line 1013 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1018 "perly.y" +#line 1019 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1020 "perly.y" +#line 1021 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1022 "perly.y" +#line 1023 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1027 "perly.y" +#line 1028 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1029 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1031 "perly.y" +#line 1032 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1036 "perly.y" +#line 1037 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1038 "perly.y" +#line 1039 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1040 "perly.y" +#line 1041 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1042 "perly.y" +#line 1043 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1062 "perly.y" +#line 1063 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1064 "perly.y" +#line 1065 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1066 "perly.y" +#line 1067 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1070 "perly.y" +#line 1071 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1072 "perly.y" +#line 1073 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1076 "perly.y" +#line 1077 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1078 "perly.y" +#line 1079 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1080 "perly.y" +#line 1081 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1082 "perly.y" +#line 1083 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1086 "perly.y" +#line 1087 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1088 "perly.y" +#line 1089 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1093 "perly.y" +#line 1094 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1095 "perly.y" +#line 1096 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1098 "perly.y" +#line 1099 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1100 "perly.y" +#line 1101 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1108 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1119 "perly.y" +#line 1120 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1122 "perly.y" +#line 1123 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1129 "perly.y" +#line 1130 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1131 "perly.y" +#line 1132 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1133 "perly.y" +#line 1134 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1135 "perly.y" +#line 1136 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1137 "perly.y" +#line 1138 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1140 "perly.y" +#line 1141 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1146 "perly.y" +#line 1147 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1148 "perly.y" +#line 1149 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1156 "perly.y" +#line 1157 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1158 "perly.y" +#line 1159 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1160 "perly.y" +#line 1161 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1162 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1194 "perly.y" +#line 1195 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1204 "perly.y" +#line 1205 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1214 "perly.y" +#line 1215 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1224 "perly.y" +#line 1225 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1226 "perly.y" +#line 1227 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1228 "perly.y" +#line 1229 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1231 "perly.y" +#line 1232 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1236 "perly.y" +#line 1237 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1240 "perly.y" +#line 1241 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1242 "perly.y" +#line 1243 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1244 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1287 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1289 "perly.y" +#line 1290 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1300 "perly.y" +#line 1301 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1308 "perly.y" +#line 1309 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1310 "perly.y" +#line 1311 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1312 "perly.y" +#line 1313 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1317 "perly.y" +#line 1318 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1322 "perly.y" +#line 1323 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1324 "perly.y" +#line 1325 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1326 "perly.y" +#line 1327 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1331 "perly.y" +#line 1332 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1333 "perly.y" +#line 1334 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1337 "perly.y" +#line 1338 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1339 "perly.y" +#line 1340 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1343 "perly.y" +#line 1344 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1345 "perly.y" +#line 1346 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1351 "perly.y" +#line 1352 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1368 "perly.y" +#line 1369 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1372 "perly.y" +#line 1373 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1376 "perly.y" +#line 1377 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1382 "perly.y" +#line 1383 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1388 "perly.y" +#line 1389 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1390 "perly.y" +#line 1391 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1394 "perly.y" +#line 1395 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1399 "perly.y" +#line 1400 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1404 "perly.y" +#line 1405 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1409 "perly.y" +#line 1410 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1414 "perly.y" +#line 1415 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1416 "perly.y" +#line 1417 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1418 "perly.y" +#line 1419 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1421 "perly.y" +#line 1422 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y + * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 3d3f33b4e1bf..cb653dfa1e0e 100644 --- a/perly.h +++ b/perly.h @@ -66,86 +66,87 @@ extern int yydebug; PERLY_BRACE_OPEN = 265, PERLY_BRACE_CLOSE = 266, PERLY_BRACKET_OPEN = 267, - BAREWORD = 268, - METHOD = 269, - FUNCMETH = 270, - THING = 271, - PMFUNC = 272, - PRIVATEREF = 273, - QWLIST = 274, - FUNC0OP = 275, - FUNC0SUB = 276, - UNIOPSUB = 277, - LSTOPSUB = 278, - PLUGEXPR = 279, - PLUGSTMT = 280, - LABEL = 281, - FORMAT = 282, - SUB = 283, - SIGSUB = 284, - ANONSUB = 285, - ANON_SIGSUB = 286, - PACKAGE = 287, - USE = 288, - WHILE = 289, - UNTIL = 290, - IF = 291, - UNLESS = 292, - ELSE = 293, - ELSIF = 294, - CONTINUE = 295, - FOR = 296, - GIVEN = 297, - WHEN = 298, - DEFAULT = 299, - LOOPEX = 300, - DOTDOT = 301, - YADAYADA = 302, - FUNC0 = 303, - FUNC1 = 304, - FUNC = 305, - UNIOP = 306, - LSTOP = 307, - MULOP = 308, - ADDOP = 309, - DOLSHARP = 310, - DO = 311, - HASHBRACK = 312, - NOAMP = 313, - LOCAL = 314, - MY = 315, - REQUIRE = 316, - COLONATTR = 317, - FORMLBRACK = 318, - FORMRBRACK = 319, - SUBLEXSTART = 320, - SUBLEXEND = 321, - PREC_LOW = 322, - OROP = 323, - DOROP = 324, - ANDOP = 325, - NOTOP = 326, - ASSIGNOP = 327, - OROR = 328, - DORDOR = 329, - ANDAND = 330, - BITOROP = 331, - BITANDOP = 332, - CHEQOP = 333, - NCEQOP = 334, - CHRELOP = 335, - NCRELOP = 336, - SHIFTOP = 337, - MATCHOP = 338, - UMINUS = 339, - REFGEN = 340, - POWOP = 341, - PREINC = 342, - PREDEC = 343, - POSTINC = 344, - POSTDEC = 345, - POSTJOIN = 346, - ARROW = 347 + PERLY_BRACKET_CLOSE = 268, + BAREWORD = 269, + METHOD = 270, + FUNCMETH = 271, + THING = 272, + PMFUNC = 273, + PRIVATEREF = 274, + QWLIST = 275, + FUNC0OP = 276, + FUNC0SUB = 277, + UNIOPSUB = 278, + LSTOPSUB = 279, + PLUGEXPR = 280, + PLUGSTMT = 281, + LABEL = 282, + FORMAT = 283, + SUB = 284, + SIGSUB = 285, + ANONSUB = 286, + ANON_SIGSUB = 287, + PACKAGE = 288, + USE = 289, + WHILE = 290, + UNTIL = 291, + IF = 292, + UNLESS = 293, + ELSE = 294, + ELSIF = 295, + CONTINUE = 296, + FOR = 297, + GIVEN = 298, + WHEN = 299, + DEFAULT = 300, + LOOPEX = 301, + DOTDOT = 302, + YADAYADA = 303, + FUNC0 = 304, + FUNC1 = 305, + FUNC = 306, + UNIOP = 307, + LSTOP = 308, + MULOP = 309, + ADDOP = 310, + DOLSHARP = 311, + DO = 312, + HASHBRACK = 313, + NOAMP = 314, + LOCAL = 315, + MY = 316, + REQUIRE = 317, + COLONATTR = 318, + FORMLBRACK = 319, + FORMRBRACK = 320, + SUBLEXSTART = 321, + SUBLEXEND = 322, + PREC_LOW = 323, + OROP = 324, + DOROP = 325, + ANDOP = 326, + NOTOP = 327, + ASSIGNOP = 328, + OROR = 329, + DORDOR = 330, + ANDAND = 331, + BITOROP = 332, + BITANDOP = 333, + CHEQOP = 334, + NCEQOP = 335, + CHRELOP = 336, + NCRELOP = 337, + SHIFTOP = 338, + MATCHOP = 339, + UMINUS = 340, + REFGEN = 341, + POWOP = 342, + PREINC = 343, + PREDEC = 344, + POSTINC = 345, + POSTDEC = 346, + POSTJOIN = 347, + ARROW = 348 }; #endif @@ -197,6 +198,6 @@ int yyparse (void); /* Generated from: - * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y + * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index ae6e8d9baceb..ff2a6f48f342 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3322 +#define YYLAST 3301 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 347 +#define YYMAXUTOK 348 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,13 +33,13 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 95, 2, 2, 109, 14, 15, 2, - 107, 106, 110, 12, 80, 11, 17, 111, 2, 2, + 2, 2, 2, 95, 2, 2, 109, 13, 14, 2, + 107, 106, 110, 11, 80, 10, 16, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 83, 108, - 2, 16, 2, 82, 13, 2, 2, 2, 2, 2, + 2, 15, 2, 82, 12, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 10, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 96, 2, 2, 2, @@ -56,51 +56,51 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 18, 19, 20, 21, 22, - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, - 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, - 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, - 73, 74, 75, 76, 77, 78, 79, 81, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, 97, - 98, 99, 100, 101, 102, 103, 104, 105 + 5, 6, 7, 8, 9, 17, 18, 19, 20, 21, + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, + 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, + 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, + 72, 73, 74, 75, 76, 77, 78, 79, 81, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 97, 98, 99, 100, 101, 102, 103, 104, 105 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 125, 125, 124, 136, 135, 146, 145, 159, 158, - 172, 171, 185, 184, 195, 194, 207, 215, 223, 227, - 235, 241, 242, 252, 253, 262, 266, 270, 277, 287, - 289, 302, 299, 323, 318, 339, 347, 346, 355, 361, - 367, 372, 374, 376, 383, 391, 393, 390, 410, 415, - 422, 421, 436, 444, 450, 457, 456, 471, 475, 480, - 488, 506, 507, 511, 515, 517, 519, 521, 523, 525, - 527, 530, 536, 537, 542, 553, 554, 560, 566, 567, - 572, 575, 579, 584, 588, 592, 593, 597, 603, 608, - 613, 614, 619, 620, 625, 626, 628, 633, 635, 647, - 648, 653, 655, 659, 679, 680, 682, 688, 753, 755, - 761, 763, 767, 773, 774, 779, 780, 784, 788, 788, - 856, 857, 862, 873, 874, 877, 888, 890, 892, 894, - 898, 900, 905, 909, 913, 917, 923, 928, 934, 940, - 942, 944, 947, 946, 957, 958, 962, 966, 969, 974, - 979, 982, 986, 990, 996, 1004, 1011, 1017, 1019, 1021, - 1026, 1028, 1030, 1035, 1037, 1039, 1041, 1043, 1045, 1047, - 1049, 1051, 1053, 1055, 1059, 1061, 1063, 1065, 1069, 1071, - 1075, 1077, 1079, 1081, 1085, 1087, 1092, 1094, 1097, 1099, - 1101, 1104, 1107, 1118, 1121, 1128, 1130, 1132, 1134, 1136, - 1139, 1145, 1147, 1151, 1152, 1153, 1154, 1155, 1157, 1159, - 1161, 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, - 1181, 1183, 1193, 1203, 1213, 1223, 1225, 1227, 1230, 1235, - 1239, 1241, 1243, 1245, 1248, 1250, 1253, 1255, 1257, 1259, - 1261, 1263, 1265, 1267, 1269, 1272, 1274, 1276, 1278, 1280, - 1282, 1286, 1289, 1288, 1301, 1302, 1303, 1307, 1309, 1311, - 1316, 1318, 1321, 1323, 1325, 1330, 1332, 1337, 1338, 1343, - 1344, 1350, 1354, 1355, 1356, 1359, 1360, 1363, 1364, 1367, - 1371, 1375, 1381, 1387, 1389, 1393, 1397, 1398, 1402, 1403, - 1407, 1408, 1413, 1415, 1417, 1420 + 0, 126, 126, 125, 137, 136, 147, 146, 160, 159, + 173, 172, 186, 185, 196, 195, 208, 216, 224, 228, + 236, 242, 243, 253, 254, 263, 267, 271, 278, 288, + 290, 303, 300, 324, 319, 340, 348, 347, 356, 362, + 368, 373, 375, 377, 384, 392, 394, 391, 411, 416, + 423, 422, 437, 445, 451, 458, 457, 472, 476, 481, + 489, 507, 508, 512, 516, 518, 520, 522, 524, 526, + 528, 531, 537, 538, 543, 554, 555, 561, 567, 568, + 573, 576, 580, 585, 589, 593, 594, 598, 604, 609, + 614, 615, 620, 621, 626, 627, 629, 634, 636, 648, + 649, 654, 656, 660, 680, 681, 683, 689, 754, 756, + 762, 764, 768, 774, 775, 780, 781, 785, 789, 789, + 857, 858, 863, 874, 875, 878, 889, 891, 893, 895, + 899, 901, 906, 910, 914, 918, 924, 929, 935, 941, + 943, 945, 948, 947, 958, 959, 963, 967, 970, 975, + 980, 983, 987, 991, 997, 1005, 1012, 1018, 1020, 1022, + 1027, 1029, 1031, 1036, 1038, 1040, 1042, 1044, 1046, 1048, + 1050, 1052, 1054, 1056, 1060, 1062, 1064, 1066, 1070, 1072, + 1076, 1078, 1080, 1082, 1086, 1088, 1093, 1095, 1098, 1100, + 1102, 1105, 1108, 1119, 1122, 1129, 1131, 1133, 1135, 1137, + 1140, 1146, 1148, 1152, 1153, 1154, 1155, 1156, 1158, 1160, + 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, + 1182, 1184, 1194, 1204, 1214, 1224, 1226, 1228, 1231, 1236, + 1240, 1242, 1244, 1246, 1249, 1251, 1254, 1256, 1258, 1260, + 1262, 1264, 1266, 1268, 1270, 1273, 1275, 1277, 1279, 1281, + 1283, 1287, 1290, 1289, 1302, 1303, 1304, 1308, 1310, 1312, + 1317, 1319, 1322, 1324, 1326, 1331, 1333, 1338, 1339, 1344, + 1345, 1351, 1355, 1356, 1357, 1360, 1361, 1364, 1365, 1368, + 1372, 1376, 1382, 1388, 1390, 1394, 1398, 1399, 1403, 1404, + 1408, 1409, 1414, 1416, 1418, 1421 }; #endif @@ -110,29 +110,29 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "']'", - "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", "PERLY_BRACE_OPEN", - "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "BAREWORD", "METHOD", - "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", - "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", - "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", - "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", - "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", - "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", - "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", - "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", - "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", - "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", - "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", - "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", - "ARROW", "')'", "'('", "';'", "'$'", "'*'", "'/'", "$accept", "grammar", - "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", - "remember", "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", - "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", - "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", + "'+'", "'@'", "'%'", "'&'", "'='", "'.'", "PERLY_BRACE_OPEN", + "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", + "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", + "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", + "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", + "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", + "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", + "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", + "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", + "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", + "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", + "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", + "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", + "POSTJOIN", "ARROW", "')'", "'('", "';'", "'$'", "'*'", "'/'", "$accept", + "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", + "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", + "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", + "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", + "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", + "formname", "startsub", "startanonsub", "startformsub", "subname", + "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", @@ -151,21 +151,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 93, 45, 43, 64, 37, 38, 61, 46, 265, 266, - 267, 268, 269, 270, 271, 272, 273, 274, 275, 276, - 277, 278, 279, 280, 281, 282, 283, 284, 285, 286, - 287, 288, 289, 290, 291, 292, 293, 294, 295, 296, - 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, - 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, - 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, - 44, 327, 63, 58, 328, 329, 330, 331, 332, 333, - 334, 335, 336, 337, 338, 33, 126, 339, 340, 341, - 342, 343, 344, 345, 346, 347, 41, 40, 59, 36, + 45, 43, 64, 37, 38, 61, 46, 265, 266, 267, + 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, + 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, + 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, + 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, + 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, + 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, + 44, 328, 63, 58, 329, 330, 331, 332, 333, 334, + 335, 336, 337, 338, 339, 33, 126, 340, 341, 342, + 343, 344, 345, 346, 347, 348, 41, 40, 59, 36, 42, 47 }; # endif -#define YYPACT_NINF (-468) +#define YYPACT_NINF (-491) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -179,64 +179,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 600, -468, -468, -468, -468, -468, -468, -468, 76, -468, - 2958, 6, 1593, 1492, -468, -468, -468, -468, 2958, 2958, - 54, 54, 54, 1876, -468, 54, 54, -468, -468, 26, - -21, -468, 2958, -468, -468, -468, -468, 2958, -6, 2, - -26, 2076, 1976, 54, 2076, 2167, 39, 2958, -2, 2958, - 2958, 2958, 2958, 2958, 2958, 2958, 2258, 54, 54, 187, - 37, -468, 14, -468, 70, 52, 170, 57, -468, -468, - -468, 3125, -468, -468, 43, 20, 59, 69, -468, 139, - 75, 84, 149, -468, -468, -468, -468, -468, 39, 39, - 152, -468, 71, 74, 78, 80, 272, 88, 107, 6, - 81, -468, 192, -468, 127, 1974, 1492, -468, -468, -468, - 683, -468, 17, 785, 587, 587, -468, -468, -468, -468, - -468, -468, -468, -468, 46, 2958, 138, 174, 2958, 162, - 339, 6, 249, 206, 3125, 199, 2358, 2958, 1976, -468, - 339, 574, 37, -468, 477, 2958, -468, -468, 339, 261, - 230, -468, -468, 2958, 339, 3049, 2458, 242, -468, -468, - -468, 339, 37, 587, 587, 587, 239, 239, 305, 173, - -468, -468, 2958, 2958, 2958, 2958, 2958, 2958, 2558, -468, - -468, 2958, -468, -468, 2958, 2958, 2958, 2958, 2958, 2958, - 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, 2958, - 2958, 2958, -468, -468, -468, 304, 2658, 2958, 2958, 2958, - 2958, 2958, 2958, 2958, -468, 309, -468, -468, 324, -468, - -468, -468, -468, -468, 248, 3, -468, -468, 257, -468, - -468, -468, -468, 6, -468, -468, 2958, 2958, 2958, 2958, - 2958, 2958, -468, -468, -468, -468, -468, 340, 340, -468, - -468, -468, 285, -468, -468, -468, 2958, 2958, 82, -468, - -468, -468, 206, 345, -468, -468, -468, 255, 303, 274, - 2958, 37, -468, 359, -468, 2758, 587, 242, 118, 164, - 176, -468, 423, 358, -468, 2958, 363, 308, 308, -468, - 3125, 251, 115, -468, 469, 339, 364, 3217, 167, 412, - 3125, 3079, 1668, 1668, 1758, 1858, 540, 364, 364, 339, - 339, 431, 587, 587, 281, 282, 287, 2958, 2958, -468, - 288, 2858, 24, 292, 283, -468, -468, 472, 329, 132, - 343, 135, 352, 161, 370, 886, -468, 388, -468, -468, - 7, 389, 2958, 2958, 2958, 2958, -468, 300, -468, -468, - 317, -468, -468, -468, -468, 1684, 22, -468, 2958, 2958, - -468, -468, 187, -468, 187, -468, -468, -468, -468, -468, - 334, 334, 17, 328, -47, -468, 2958, -468, -468, 338, - -468, -468, -468, -468, 514, -468, -13, 518, -468, -468, - -468, 166, 2958, 416, -468, -468, 2958, -468, -468, -468, - 404, 180, -468, -468, 521, -468, -468, 2958, -468, 430, - -468, 433, -468, 434, -468, 440, -468, -468, -468, 249, - 206, -468, -468, 429, 355, 187, 369, 373, 187, 378, - 357, -468, -468, -468, -468, 379, 368, 311, -468, 2958, - 380, 382, 2958, -468, -468, -468, -468, 2958, 391, -468, - 471, -468, -468, 476, -468, -468, 33, -468, 226, -468, - 3171, 479, -468, -468, 384, -468, -468, -468, -468, 396, - 206, 397, -468, 2958, -468, -468, 489, 489, 2958, 2958, - 489, -468, 401, 407, 489, 489, 3125, 187, -468, -468, - 417, -468, -468, -468, -468, 438, 410, -468, -468, -468, - -468, 419, 489, 489, -468, 207, 207, 418, 426, 192, - 2958, 2958, 489, -468, -468, 987, -468, 1088, -468, -468, - -468, -468, 1189, -468, 192, 192, -468, 489, 437, -468, - -468, 489, 489, -468, 432, 435, 192, -468, -468, -14, - -468, -468, -468, 1290, -468, 2958, 192, 192, -468, 489, - -468, 481, 539, -468, -468, 466, -468, -468, -468, 192, - -468, -468, -468, 489, 1775, -468, 1391, 207, 467, -468, - -468, 489, -468 + 724, -491, -491, -491, -491, -491, -491, -491, 7, -491, + 2936, 15, 1567, 1466, -491, -491, -491, -491, 2936, 2936, + 54, 54, 54, 1944, -491, 54, 54, -491, -491, 20, + -57, -491, 2936, -491, -491, -491, -491, 2936, -47, -43, + -20, 2045, 1852, 54, 2045, 2137, 83, 2936, -2, 2936, + 2936, 2936, 2936, 2936, 2936, 2936, 2229, 54, 54, 133, + -4, -491, 19, -491, -35, -19, 72, -10, -491, -491, + -491, 3104, -491, -491, -21, 154, 165, 241, -491, 86, + 263, 285, 95, -491, -491, -491, -491, -491, 83, 83, + 68, -491, -7, 8, 18, 26, 208, 29, 36, 15, + 38, -491, 109, -491, 42, 435, 1466, -491, -491, -491, + 657, -491, 5, 759, 141, 141, -491, -491, -491, -491, + -491, -491, -491, -491, 82, 2936, 60, 103, 2936, 79, + 426, 15, 218, 177, 3104, 147, 2330, 2936, 1852, -491, + 426, 548, -4, -491, 473, 2936, -491, -491, 426, 239, + 195, -491, -491, 2936, 426, 3028, 2431, 193, -491, -491, + -491, 426, -4, 141, 141, 141, 283, 283, 260, 352, + -491, -491, 2936, 2936, 2936, 2936, 2936, 2936, 2532, -491, + -491, 2936, -491, -491, 2936, 2936, 2936, 2936, 2936, 2936, + 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, + 2936, 2936, -491, -491, -491, 308, 2633, 2936, 2936, 2936, + 2936, 2936, 2936, 2936, -491, 262, -491, -491, 284, -491, + -491, -491, -491, -491, 210, 33, -491, -491, 217, -491, + -491, -491, -491, 15, -491, -491, 2936, 2936, 2936, 2936, + 2936, 2936, -491, -491, -491, -491, -491, 300, 300, -491, + -491, -491, 253, -491, -491, -491, 2936, 2936, 111, -491, + -491, -491, 177, 314, -491, -491, -491, 389, 281, 236, + 2936, -4, -491, 338, -491, 2734, 141, 193, 75, 237, + 242, -491, 430, 340, -491, 2936, 343, 290, 290, -491, + 3104, 268, 114, -491, 463, 426, 341, 3196, 395, 358, + 3104, 3058, 1643, 1643, 1734, 1834, 1925, 341, 341, 426, + 426, 509, 141, 141, 259, 264, 265, 2936, 2936, -491, + 272, 2835, 14, 273, 291, -491, -491, 468, 303, 118, + 313, 158, 330, 161, 373, 860, -491, 382, -491, -491, + 3, 379, 2936, 2936, 2936, 2936, -491, 292, -491, -491, + 297, -491, -491, -491, -491, 1659, 12, -491, 2936, 2936, + -491, -491, 133, -491, 133, -491, -491, -491, -491, -491, + 328, 328, 5, 304, -46, -491, 2936, -491, -491, 306, + -491, -491, -491, -491, 510, -491, 11, 542, -491, -491, + -491, 173, 2936, 396, -491, -491, 2936, -491, -491, -491, + 377, 188, -491, -491, 567, -491, -491, 2936, -491, 405, + -491, 408, -491, 419, -491, 423, -491, -491, -491, 218, + 177, -491, -491, 427, 353, 133, 362, 363, 133, 369, + 375, -491, -491, -491, -491, 370, 339, 316, -491, 2936, + 398, 399, 2936, -491, -491, -491, -491, 2936, 436, -491, + 484, -491, -491, 497, -491, -491, 23, -491, 192, -491, + 3150, 503, -491, -491, 417, -491, -491, -491, -491, 418, + 177, 424, -491, 2936, -491, -491, 516, 516, 2936, 2936, + 516, -491, 431, 446, 516, 516, 3104, 133, -491, -491, + 467, -491, -491, -491, -491, 508, 474, -491, -491, -491, + -491, 475, 516, 516, -491, 167, 167, 479, 483, 109, + 2936, 2936, 516, -491, -491, 961, -491, 1062, -491, -491, + -491, -491, 1163, -491, 109, 109, -491, 516, 487, -491, + -491, 516, 516, -491, 488, 489, 109, -491, -491, 9, + -491, -491, -491, 1264, -491, 2936, 109, 109, -491, 516, + -491, 527, 584, -491, -491, 495, -491, -491, -491, 109, + -491, -491, -491, 516, 1751, -491, 1365, 167, 511, -491, + -491, 516, -491 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -307,16 +307,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -468, -468, -468, -468, -468, -468, -468, -468, -468, 41, - -468, -5, -109, -468, -17, -468, 564, 480, 8, -468, - -468, -468, -468, -468, -468, -468, -468, -468, 372, -341, - -467, -151, -447, -468, 77, 246, -304, 29, -468, 66, - 280, -468, 232, 181, -243, 337, 367, -468, -468, 250, - -468, 254, -468, -468, -468, -468, 185, -468, -468, 126, - -468, 169, -8, -37, -468, -468, -468, -468, -468, -468, - -468, -468, -468, -468, -468, -468, 100, -468, -468, 483, - -124, -129, -468, -468, 290, -468, -468, 422, 1, -45, - -42, -468, -468, -468, -468, -468, 48 + -491, -491, -491, -491, -491, -491, -491, -491, -491, 41, + -491, -5, -107, -491, -17, -491, 602, 515, 16, -491, + -491, -491, -491, -491, -491, -491, -491, -491, 366, -341, + -490, -193, -463, -491, 113, 312, -304, 63, -491, 102, + 293, -491, 252, 227, -243, 372, 412, -491, -491, 294, + -491, 289, -491, -491, -491, -491, 211, -491, -491, 166, + -491, 201, -8, -37, -491, -491, -491, -491, -491, -491, + -491, -491, -491, -491, -491, -491, 100, -491, -491, 520, + -124, -129, -491, -491, 310, -491, -491, 439, 1, -45, + -42, -491, -491, -491, -491, -491, 48 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -339,127 +339,84 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 285, 268, 269, - 551, 20, 21, 162, 433, 124, 20, 21, 22, 377, - 103, 119, 119, 119, 83, 421, 119, 119, 503, 274, - 245, 246, 176, 175, 177, 20, 21, 150, 207, 530, - 208, 429, 83, 144, 119, 116, 128, 137, 169, 158, - 117, 435, 84, 392, 440, 441, 254, -261, 119, 119, - 151, 118, 118, 118, 447, 152, 118, 118, 120, 121, - 122, 348, 83, 125, 126, 116, 16, -286, 214, -286, - 117, 138, 139, 118, 118, 147, 129, -288, 142, -288, - 145, 146, 375, 209, 552, 210, 155, 228, 118, 118, - 570, 135, 211, -260, 212, 156, 171, 57, 271, 136, - 279, 564, 57, 280, 243, 422, 142, 175, 114, 115, - 258, 178, 172, 173, 174, 394, 247, 373, 267, 59, - 59, 57, 130, 57, 405, 483, 207, 134, 208, 144, - 231, 140, 410, 181, 148, 412, 184, 154, 282, 161, - 206, 163, 164, 165, 166, 167, 278, -290, 172, 173, - 174, 179, 180, 57, 287, 288, 289, 213, 291, 292, - 294, 414, 260, 218, 507, 508, 457, 471, 220, 118, - 353, 221, -286, 354, -286, 222, 270, 223, -262, 232, - 462, 172, 173, 174, -288, 229, -288, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 535, 172, 173, - 174, 172, 173, 174, 230, 342, 343, 344, 345, 347, + 113, 255, 59, 159, 17, 142, 160, 16, 268, 269, + 20, 21, 503, 162, 433, 124, 530, 245, 246, 377, + 421, 119, 119, 119, 20, 21, 119, 119, 103, 274, + 285, 83, 83, 551, 175, 116, 176, 150, 177, 128, + 117, 429, 392, 144, 119, 20, 21, 22, 169, 158, + 129, 435, 84, 137, 440, 441, 179, 180, 119, 119, + 135, 118, 118, 118, 136, 447, 118, 118, 120, 121, + 122, 83, 181, 125, 126, 116, 175, 570, 214, 184, + 117, -261, 139, 118, 118, 147, 206, 138, 142, 218, + 145, 146, 207, -260, 208, 564, 155, 228, 118, 118, + 220, 348, 254, -290, 151, 156, 171, 57, 271, 152, + 279, 422, 213, 280, 247, 221, 142, 552, 114, 115, + 258, 57, 243, 57, 405, 222, 178, 373, 267, 59, + 59, 375, 130, 223, 394, 483, 229, 134, 410, 144, + 231, 140, 57, 230, 148, -262, 232, 154, 282, 161, + 235, 163, 164, 165, 166, 167, 278, 233, 172, 173, + 174, 182, 183, 57, 287, 288, 289, 256, 291, 292, + 294, 207, 260, 208, 507, 508, 257, 471, 412, 118, + 353, 414, -286, 354, -286, 259, 270, 172, 173, 174, + 172, 173, 174, 457, 172, 173, 174, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 535, 462, 172, + 173, 174, 492, 527, 528, 342, 343, 344, 345, 347, 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, -264, 235, 492, 172, 173, 174, - 233, 555, 172, 173, 174, 256, -263, 257, 59, 172, - 173, 174, 449, 527, 528, 276, 172, 173, 174, 182, - 183, 200, 384, 172, 173, 174, 201, 387, 259, 202, - 203, 204, 205, 261, 360, 290, 263, 391, 464, 286, - 272, 295, 338, 339, 296, 297, 298, 299, 300, 301, + 362, 362, 362, 362, 172, 173, 174, 172, 173, 174, + 201, 555, 261, 202, 203, 204, 205, 263, 59, 172, + 173, 174, 449, 265, -286, 276, -286, 272, -288, -288, + -288, -288, 384, 283, 172, 173, 174, 387, 172, 173, + 174, 172, 173, 174, 360, 290, 224, 391, 464, 285, + 209, 295, 210, 336, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, 265, 172, 173, 174, 400, - 401, 353, 283, 404, 354, 132, 133, 314, 315, 316, - 216, 217, 317, 119, 318, 285, 319, 172, 173, 174, - 336, 172, 173, 174, 425, 364, 428, 428, 273, 142, - 224, -291, -291, -291, 205, 340, 346, 437, 431, 501, - 428, 428, 439, 236, 237, 238, 239, 352, 533, 393, - 240, 381, 241, 118, 357, 372, 369, 320, 506, 378, - 225, 509, 450, 541, 542, 513, 514, 382, 385, 226, - 383, 57, 390, 392, 458, 550, 174, 172, 173, 174, - 407, 397, 398, 524, 525, 556, 557, 399, 402, 59, - 186, 187, 406, 536, 417, 172, 173, 174, 565, 57, - 423, 321, 469, 322, 323, 442, 472, -83, 544, 172, - 173, 174, 546, 547, 432, 186, 187, 479, 172, 173, - 174, 428, 199, 200, 446, 459, 142, 409, 201, 487, - 559, 202, 203, 204, 205, 452, 172, 173, 174, 465, - 473, 411, 466, 467, 567, 197, 198, 199, 200, 468, - 413, 474, 572, 201, 478, 488, 202, 203, 204, 205, - 428, 428, 515, 186, 517, 475, 481, -215, 415, 476, - 172, 173, 174, 522, 477, 480, 484, -215, 485, 489, - 494, 450, 186, 187, 491, 207, 460, 208, 493, 172, - 173, 174, 425, 428, 495, 497, 200, 504, 511, 543, - 518, 201, 461, 512, 202, 203, 204, 205, 519, -215, - -215, -215, -215, 516, 531, 200, -215, 523, -215, 389, - 201, -215, 532, 202, 203, 204, 205, 428, -215, -215, - 548, 549, 486, 566, 545, 172, 173, 174, 172, 173, - 174, -215, 560, -215, -215, -215, 562, -215, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, 563, 571, -254, 395, -215, 107, 408, -215, - -215, -215, -215, -215, -254, -215, 242, 534, -215, 426, - 172, 173, 174, 568, 172, 173, 174, 172, 173, 174, - 470, 186, 187, 1, 2, 3, 4, 5, 6, 7, - 365, 366, 367, 368, 388, 371, -254, -254, -254, -254, - 455, 444, 521, -254, 456, -254, 445, 463, -254, 195, - 196, 197, 198, 199, 200, -254, -254, 490, 277, 201, - 499, 0, 202, 203, 204, 205, 438, 351, -254, 0, - -254, -254, -254, 0, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, -254, 0, - 0, 0, 0, -254, 0, 0, -254, -254, -254, -254, - -254, 0, -254, -13, 85, -254, 201, 0, 0, 202, - 203, 204, 205, 0, 18, 19, 20, 21, 22, 0, - 0, 83, 0, 23, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, - 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, - 56, 101, 57, 58, 0, 0, 18, 19, 20, 21, - 22, 0, 0, 83, 0, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, - 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, - 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, - 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 0, 18, 19, 20, - 21, 22, 0, 0, 83, 416, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, - 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, - 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, - 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 101, 57, 58, 0, 18, 19, - 20, 21, 22, 0, 0, 83, 537, 23, 24, 25, + 312, 313, 211, 273, 212, 340, 225, -264, 346, 400, + 401, 353, -263, 404, 354, 226, 533, 57, 338, 339, + 314, 315, 316, 119, 357, 317, 369, 318, 132, 133, + 319, 541, 542, 372, 425, 364, 428, 428, 378, 142, + 216, 217, 383, 550, 172, 173, 174, 437, 431, 501, + 428, 428, 439, 556, 557, 382, 385, 352, 236, 237, + 238, 239, 392, 118, 390, 240, 565, 241, 174, 397, + 506, 320, 450, 509, 398, 399, 393, 513, 514, 172, + 173, 174, 402, 406, 458, -291, -291, -291, 205, 172, + 173, 174, 172, 173, 174, 524, 525, 417, 407, 59, + 423, 57, 186, 187, 432, 536, 172, 173, 174, 442, + 446, 409, 469, 452, 459, 321, 472, 322, 323, 186, + 544, 411, -83, 465, 546, 547, 466, 479, 172, 173, + 174, 428, 197, 198, 199, 200, 142, 467, 413, 487, + 201, 468, 559, 202, 203, 204, 205, 481, 473, 172, + 173, 174, 200, 172, 173, 174, 567, 201, 286, 474, + 202, 203, 204, 205, 572, 172, 173, 174, 475, 476, + 428, 428, 515, -215, 517, 477, 480, 236, 237, 238, + 239, 415, 478, 522, 240, 461, 241, 186, 187, 200, + 207, 450, 208, -215, 201, 381, 460, 202, 203, 204, + 205, 489, 425, 428, 484, 485, 172, 173, 174, 543, + 488, 172, 173, 174, 491, -215, -215, -215, -215, 199, + 200, 493, -215, 494, -215, 201, 495, -215, 202, 203, + 204, 205, 497, 504, -215, -215, 389, 428, 511, 172, + 173, 174, 486, 566, 172, 173, 174, -215, -254, -215, + -215, -215, 512, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -215, -215, -215, -215, -254, 395, + 186, 187, -215, 516, 408, -215, -215, -215, -215, -215, + 518, -215, 519, 523, -215, 531, 172, 173, 174, 532, + -254, -254, -254, -254, 545, 549, 548, -254, 560, -254, + 562, 563, -254, 200, 365, 366, 367, 368, 201, -254, + -254, 202, 203, 204, 205, 107, 455, 571, 172, 173, + 174, 242, -254, 534, -254, -254, -254, 568, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, + -254, -254, -254, 172, 173, 174, 470, -254, 456, 388, + -254, -254, -254, -254, -254, 426, -254, -13, 85, -254, + 371, 445, 521, 490, 351, 444, 438, 18, 19, 20, + 21, 22, 499, 463, 83, 277, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 1, 2, 3, + 4, 5, 6, 7, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 101, 57, 58, 0, 18, - 19, 20, 21, 22, 0, 0, 83, 538, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, - 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, - 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 101, 57, 58, 0, - 18, 19, 20, 21, 22, 0, 0, 83, 540, 23, + 0, 0, 51, 52, 0, 53, 0, 54, 55, -3, + 85, 0, 0, 0, 56, 101, 57, 58, 0, 18, + 19, 20, 21, 22, 0, 0, 83, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, @@ -469,8 +426,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 0, 18, 19, 20, 21, 22, 0, 0, 83, 554, - 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 18, 19, 20, 21, 22, 0, 0, 83, 416, 23, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, @@ -479,18 +436,18 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, - 58, 0, 18, 19, 20, 21, 22, 0, 0, 83, - 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, + 58, 18, 19, 20, 21, 22, 0, 0, 83, 537, + 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, - 57, 58, 0, 18, 19, 20, 21, 22, 0, 0, - 83, 0, 23, 24, 25, 26, 27, 28, 0, 29, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, + 538, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, @@ -499,65 +456,105 @@ static const yytype_int16 yytable[] = 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 101, 57, 58, 0, 18, 19, 20, 21, 22, 0, - 0, 83, 0, 23, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 86, 0, 87, 88, + 101, 57, 58, 18, 19, 20, 21, 22, 0, 0, + 83, 540, 23, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 85, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, - 56, 101, 57, 58, 23, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 101, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 83, 554, 23, 0, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, + 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, + 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 85, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 18, 19, 20, 21, - 22, 56, -78, 57, 58, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 50, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, -78, 56, 0, 57, 58, 123, 18, 19, 20, - 21, 22, 0, 0, 0, 0, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 50, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 0, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 83, 0, 23, 141, 25, 26, - 27, 28, 117, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 236, 237, 238, 239, - 0, 0, 0, 240, 0, 241, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 172, 173, 174, 0, 0, 50, 0, 0, 0, 0, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, 101, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 83, 0, 23, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, + 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, + 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, + 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 569, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 0, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 83, 0, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 101, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 83, 0, 23, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, + 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, + 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, + 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 20, 21, 22, 56, 0, 57, 58, 23, 24, 25, + 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, + 0, 0, 0, 56, 101, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 83, 0, 23, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 86, 0, 87, 88, 89, 35, 36, 90, 91, 92, + 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, + 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 20, 21, 22, 56, 101, 57, 58, 23, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, + 55, 18, 19, 20, 21, 22, 56, -78, 57, 58, + 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 186, 187, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 50, 0, 0, 201, 0, 0, 202, 203, 204, 205, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, -78, 56, 0, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, + 0, 23, 0, 141, 25, 26, 27, 28, 117, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 186, 187, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 50, 0, 201, 0, 0, 202, 203, 204, 205, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 18, 19, 20, 21, 22, 56, + 0, 57, 58, 23, 123, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 195, 196, 197, 198, 199, 200, + 0, 0, 0, 50, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, + 0, 56, 0, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 83, 0, 23, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 18, 19, 20, + 21, 22, 56, 0, 57, 58, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -566,187 +563,236 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 20, 21, 22, 56, 149, 57, 58, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 168, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 266, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 281, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 293, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 19, 20, 21, 22, 56, 149, 57, 58, 23, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 326, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 168, 56, 0, 57, 58, + 18, 19, 20, 21, 22, 0, 0, 0, 0, 23, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 386, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 0, 0, 0, 0, 266, 56, 0, 57, + 58, 18, 19, 20, 21, 22, 0, 0, 0, 0, + 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, 281, 56, 0, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 0, + 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, + 0, 57, 58, 18, 19, 20, 21, 22, 0, 0, + 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, + 56, 0, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, + 386, 56, 0, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 403, 56, 0, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 403, 56, 0, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 24, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, + 20, 21, 22, 56, 0, 57, 58, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 0, 275, 0, 57, 58, 188, + 189, 396, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, + 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 18, 19, 20, 21, 22, 56, 0, 57, 58, 23, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 0, 185, 0, 0, 0, 0, 0, 0, - 186, 187, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 275, 0, 57, 58, - 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 188, 189, 0, 190, - 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, - 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, - 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, + 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 189, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, -291, 0, 202, 203, 204, 205, 0, 186, 187, + 0, 0, 189, 0, 190, 191, 192, 193, 194, 195, + 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, + -291, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, 0, 0, 202, - 203, 204, 205 + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 20, 137, 138, - 24, 13, 14, 50, 355, 23, 13, 14, 15, 262, - 12, 20, 21, 22, 18, 18, 25, 26, 475, 153, - 13, 14, 18, 80, 20, 13, 14, 45, 18, 506, - 20, 345, 18, 42, 43, 21, 20, 73, 56, 48, - 26, 355, 11, 20, 358, 359, 10, 70, 57, 58, - 21, 20, 21, 22, 111, 26, 25, 26, 20, 21, - 22, 68, 18, 25, 26, 21, 0, 18, 83, 20, - 26, 107, 41, 42, 43, 44, 107, 18, 125, 20, - 42, 43, 10, 18, 108, 20, 98, 96, 57, 58, - 567, 107, 18, 70, 20, 107, 58, 109, 145, 107, - 155, 558, 109, 155, 106, 108, 153, 80, 18, 19, - 128, 107, 76, 77, 78, 10, 109, 256, 136, 137, - 138, 109, 32, 109, 110, 439, 18, 37, 20, 138, - 99, 41, 10, 91, 44, 10, 89, 47, 156, 49, - 107, 51, 52, 53, 54, 55, 155, 18, 76, 77, - 78, 91, 92, 109, 172, 173, 174, 18, 176, 177, - 178, 10, 131, 21, 478, 479, 10, 420, 107, 138, - 225, 107, 18, 225, 20, 107, 138, 107, 70, 108, - 10, 76, 77, 78, 18, 107, 20, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 511, 76, 77, - 78, 76, 77, 78, 107, 220, 221, 222, 223, 224, + 17, 125, 10, 48, 9, 42, 48, 0, 137, 138, + 12, 13, 475, 50, 355, 23, 506, 12, 13, 262, + 17, 20, 21, 22, 12, 13, 25, 26, 12, 153, + 19, 17, 17, 24, 80, 21, 17, 45, 19, 19, + 26, 345, 19, 42, 43, 12, 13, 14, 56, 48, + 107, 355, 11, 73, 358, 359, 91, 92, 57, 58, + 107, 20, 21, 22, 107, 111, 25, 26, 20, 21, + 22, 17, 91, 25, 26, 21, 80, 567, 83, 89, + 26, 70, 41, 42, 43, 44, 107, 107, 125, 21, + 42, 43, 17, 70, 19, 558, 98, 96, 57, 58, + 107, 68, 20, 17, 21, 107, 58, 109, 145, 26, + 155, 108, 17, 155, 109, 107, 153, 108, 18, 19, + 128, 109, 106, 109, 110, 107, 107, 256, 136, 137, + 138, 20, 32, 107, 20, 439, 107, 37, 20, 138, + 99, 41, 109, 107, 44, 70, 108, 47, 156, 49, + 108, 51, 52, 53, 54, 55, 155, 48, 76, 77, + 78, 89, 90, 109, 172, 173, 174, 107, 176, 177, + 178, 17, 131, 19, 478, 479, 73, 420, 20, 138, + 225, 20, 17, 225, 19, 106, 138, 76, 77, 78, + 76, 77, 78, 20, 76, 77, 78, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 511, 20, 76, + 77, 78, 20, 46, 47, 220, 221, 222, 223, 224, 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 70, 108, 10, 76, 77, 78, - 48, 545, 76, 77, 78, 107, 70, 73, 256, 76, - 77, 78, 376, 46, 47, 155, 76, 77, 78, 89, - 90, 94, 270, 76, 77, 78, 99, 275, 106, 102, - 103, 104, 105, 24, 233, 175, 70, 285, 407, 106, - 19, 181, 216, 217, 184, 185, 186, 187, 188, 189, + 238, 239, 240, 241, 76, 77, 78, 76, 77, 78, + 99, 545, 24, 102, 103, 104, 105, 70, 256, 76, + 77, 78, 376, 106, 17, 155, 19, 18, 17, 17, + 19, 19, 270, 70, 76, 77, 78, 275, 76, 77, + 78, 76, 77, 78, 233, 175, 68, 285, 407, 19, + 17, 181, 19, 21, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 76, 77, 78, 106, 76, 77, 78, 317, - 318, 356, 70, 321, 356, 35, 36, 13, 14, 15, - 88, 89, 18, 322, 20, 20, 22, 76, 77, 78, - 21, 76, 77, 78, 342, 343, 344, 345, 108, 376, - 68, 102, 103, 104, 105, 21, 98, 355, 347, 473, - 358, 359, 357, 42, 43, 44, 45, 356, 509, 108, - 49, 106, 51, 322, 107, 80, 26, 63, 477, 24, - 98, 480, 377, 524, 525, 484, 485, 74, 19, 107, - 106, 109, 24, 20, 392, 536, 78, 76, 77, 78, - 107, 110, 110, 502, 503, 546, 547, 110, 110, 407, - 61, 62, 110, 512, 16, 76, 77, 78, 559, 109, - 21, 107, 417, 109, 110, 81, 421, 106, 527, 76, - 77, 78, 531, 532, 107, 61, 62, 432, 76, 77, - 78, 439, 93, 94, 106, 19, 473, 108, 99, 447, - 549, 102, 103, 104, 105, 107, 76, 77, 78, 19, - 21, 108, 19, 19, 563, 91, 92, 93, 94, 19, - 108, 106, 571, 99, 107, 74, 102, 103, 104, 105, - 478, 479, 489, 61, 491, 106, 108, 0, 108, 106, - 76, 77, 78, 500, 106, 106, 106, 10, 106, 18, - 106, 496, 61, 62, 18, 18, 396, 20, 19, 76, - 77, 78, 510, 511, 108, 108, 94, 18, 107, 526, - 72, 99, 108, 106, 102, 103, 104, 105, 108, 42, - 43, 44, 45, 106, 106, 94, 49, 108, 51, 106, - 99, 54, 106, 102, 103, 104, 105, 545, 61, 62, - 108, 106, 442, 560, 107, 76, 77, 78, 76, 77, - 78, 74, 71, 76, 77, 78, 17, 80, 81, 82, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 106, 106, 0, 106, 99, 13, 106, 102, - 103, 104, 105, 106, 10, 108, 106, 510, 111, 343, - 76, 77, 78, 564, 76, 77, 78, 76, 77, 78, - 419, 61, 62, 3, 4, 5, 6, 7, 8, 9, - 238, 239, 240, 241, 277, 248, 42, 43, 44, 45, - 106, 371, 496, 49, 106, 51, 372, 106, 54, 89, - 90, 91, 92, 93, 94, 61, 62, 452, 155, 99, - 471, -1, 102, 103, 104, 105, 356, 225, 74, -1, - 76, 77, 78, -1, 80, 81, 82, 83, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, - -1, -1, -1, 99, -1, -1, 102, 103, 104, 105, - 106, -1, 108, 0, 1, 111, 99, -1, -1, 102, - 103, 104, 105, -1, 11, 12, 13, 14, 15, -1, - -1, 18, -1, 20, 21, 22, 23, 24, 25, -1, + 200, 201, 17, 108, 19, 21, 98, 70, 98, 317, + 318, 356, 70, 321, 356, 107, 509, 109, 216, 217, + 12, 13, 14, 322, 107, 17, 26, 19, 35, 36, + 22, 524, 525, 80, 342, 343, 344, 345, 24, 376, + 88, 89, 106, 536, 76, 77, 78, 355, 347, 473, + 358, 359, 357, 546, 547, 74, 18, 356, 42, 43, + 44, 45, 19, 322, 24, 49, 559, 51, 78, 110, + 477, 63, 377, 480, 110, 110, 108, 484, 485, 76, + 77, 78, 110, 110, 392, 102, 103, 104, 105, 76, + 77, 78, 76, 77, 78, 502, 503, 15, 107, 407, + 21, 109, 61, 62, 107, 512, 76, 77, 78, 81, + 106, 108, 417, 107, 18, 107, 421, 109, 110, 61, + 527, 108, 106, 18, 531, 532, 18, 432, 76, 77, + 78, 439, 91, 92, 93, 94, 473, 18, 108, 447, + 99, 18, 549, 102, 103, 104, 105, 108, 21, 76, + 77, 78, 94, 76, 77, 78, 563, 99, 106, 106, + 102, 103, 104, 105, 571, 76, 77, 78, 106, 106, + 478, 479, 489, 0, 491, 106, 106, 42, 43, 44, + 45, 108, 107, 500, 49, 108, 51, 61, 62, 94, + 17, 496, 19, 20, 99, 106, 396, 102, 103, 104, + 105, 17, 510, 511, 106, 106, 76, 77, 78, 526, + 74, 76, 77, 78, 17, 42, 43, 44, 45, 93, + 94, 18, 49, 106, 51, 99, 108, 54, 102, 103, + 104, 105, 108, 17, 61, 62, 106, 545, 107, 76, + 77, 78, 442, 560, 76, 77, 78, 74, 0, 76, + 77, 78, 106, 80, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 20, 106, + 61, 62, 99, 106, 106, 102, 103, 104, 105, 106, + 72, 108, 108, 108, 111, 106, 76, 77, 78, 106, + 42, 43, 44, 45, 107, 106, 108, 49, 71, 51, + 16, 106, 54, 94, 238, 239, 240, 241, 99, 61, + 62, 102, 103, 104, 105, 13, 106, 106, 76, 77, + 78, 106, 74, 510, 76, 77, 78, 564, 80, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 76, 77, 78, 419, 99, 106, 277, + 102, 103, 104, 105, 106, 343, 108, 0, 1, 111, + 248, 372, 496, 452, 225, 371, 356, 10, 11, 12, + 13, 14, 471, 106, 17, 155, 19, -1, 21, 22, + 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, + 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, + 63, 64, 65, 66, 67, 68, 69, 3, 4, 5, + 6, 7, 8, 9, -1, -1, 79, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 95, 96, -1, 98, -1, 100, 101, 0, + 1, -1, -1, -1, 107, 108, 109, 110, -1, 10, + 11, 12, 13, 14, -1, -1, 17, -1, 19, -1, + 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, + 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, + -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, + 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, + 10, 11, 12, 13, 14, -1, -1, 17, 18, 19, + -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, + 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, + 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, + 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, + 110, 10, 11, 12, 13, 14, -1, -1, 17, 18, + 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, + 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, + 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, + 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, + -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, + 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, + 18, 19, -1, 21, 22, 23, 24, 25, -1, 27, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, + -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, + 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, + 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, + 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, + 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, + 17, 18, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, @@ -754,19 +800,29 @@ static const yytype_int16 yycheck[] = 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 0, 1, -1, -1, -1, - 107, 108, 109, 110, -1, -1, 11, 12, 13, 14, - 15, -1, -1, 18, -1, 20, 21, 22, 23, 24, + -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, + 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, + -1, 17, 18, 19, -1, 21, 22, 23, 24, 25, + -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, + 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, + 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, + -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, + -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, -1, -1, 72, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, - -1, -1, 107, 108, 109, 110, -1, 11, 12, 13, - 14, 15, -1, -1, 18, 19, 20, 21, 22, 23, + -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, + 14, -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, @@ -775,117 +831,145 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, - -1, -1, -1, 107, 108, 109, 110, -1, 11, 12, - 13, 14, 15, -1, -1, 18, 19, 20, 21, 22, + -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, + 13, 14, -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 33, -1, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, 1, - -1, -1, -1, -1, 107, 108, 109, 110, -1, 11, - 12, 13, 14, 15, -1, -1, 18, 19, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, -1, -1, -1, 49, 50, 51, - 52, 53, -1, 55, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + 1, -1, 95, 96, -1, 98, -1, 100, 101, 10, + 11, 12, 13, 14, 107, 108, 109, 110, 19, -1, + 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, + 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, 61, 62, -1, -1, -1, -1, + -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, + -1, -1, 63, 64, 65, 66, 67, 68, 69, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 79, -1, + -1, -1, 99, -1, -1, 102, 103, 104, 105, -1, + -1, -1, 1, -1, 95, 96, -1, 98, -1, 100, + 101, 10, 11, 12, 13, 14, 107, 108, 109, 110, + 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, + 39, -1, -1, -1, -1, 61, 62, -1, -1, -1, + -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, + 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, + 69, 87, 88, 89, 90, 91, 92, 93, 94, -1, + 79, -1, -1, 99, -1, -1, 102, 103, 104, 105, + -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, + -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, + 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, + -1, 19, -1, 21, 22, 23, 24, 25, 26, 27, + 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, + 38, 39, -1, -1, -1, 61, 62, -1, -1, -1, + -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, + 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, + 68, 69, 88, 89, 90, 91, 92, 93, 94, -1, + -1, 79, -1, 99, -1, -1, 102, 103, 104, 105, + -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, + 98, -1, 100, 101, 10, 11, 12, 13, 14, 107, + -1, 109, 110, 19, 20, 21, 22, 23, 24, 25, + -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, + -1, -1, 38, 39, -1, -1, 61, 62, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, + 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, + 66, 67, 68, 69, 89, 90, 91, 92, 93, 94, + -1, -1, -1, 79, 99, -1, -1, 102, 103, 104, + 105, -1, -1, -1, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, + -1, 107, -1, 109, 110, 10, 11, 12, 13, 14, + -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, + 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, + -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, + -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, + 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 95, 96, -1, 98, -1, 100, 101, 10, 11, 12, + 13, 14, 107, -1, 109, 110, 19, -1, 21, 22, + 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, + 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - 1, -1, -1, -1, -1, 107, 108, 109, 110, -1, - 11, 12, 13, 14, 15, -1, -1, 18, 19, 20, + -1, -1, 95, 96, -1, 98, -1, 100, 101, 10, + 11, 12, 13, 14, 107, 108, 109, 110, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, - 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, + 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, - 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - -1, 11, 12, 13, 14, 15, -1, -1, 18, 19, - 20, 21, 22, 23, 24, 25, -1, 27, 28, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, - 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, + 101, -1, -1, -1, -1, 106, 107, -1, 109, 110, + 10, 11, 12, 13, 14, -1, -1, -1, -1, 19, + -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, + 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, - 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, - 110, -1, 11, 12, 13, 14, 15, -1, -1, 18, - -1, 20, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, - 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, + 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, + 110, 10, 11, 12, 13, 14, -1, -1, -1, -1, + 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, + 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, 72, -1, -1, -1, -1, -1, -1, + 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, - 109, 110, -1, 11, 12, 13, 14, 15, -1, -1, - 18, -1, 20, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, - -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, + -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, + 109, 110, 10, 11, 12, 13, 14, -1, -1, -1, + -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, + 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, + 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, -1, 11, 12, 13, 14, 15, -1, - -1, 18, -1, 20, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, 33, -1, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, + 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, + -1, 109, 110, 10, 11, 12, 13, 14, -1, -1, + -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, + 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, + -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 11, 12, 13, 14, 15, - 107, 108, 109, 110, 20, 21, 22, 23, 24, 25, + -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, + -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, + 107, -1, 109, 110, 10, 11, 12, 13, 14, -1, + -1, -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, 53, -1, -1, + -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 79, -1, -1, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, 1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 11, 12, 13, 14, - 15, 107, 108, 109, 110, 20, 21, 22, 23, 24, + 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, + 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, + 106, 107, -1, 109, 110, 10, 11, 12, 13, 14, + -1, -1, -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, -1, 53, -1, + -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, 87, 88, 89, 90, 91, - 92, 93, 94, -1, 79, -1, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, + 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, 110, 10, 11, 12, 13, - 14, 15, -1, -1, -1, -1, 20, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, 61, - 62, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, 88, 89, 90, 91, - 92, 93, 94, -1, -1, 79, -1, 99, -1, -1, - 102, 103, 104, 105, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 11, 12, 13, - 14, 15, -1, -1, 18, -1, 20, 21, 22, 23, - 24, 25, 26, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, 42, 43, 44, 45, - -1, -1, -1, 49, -1, 51, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - 76, 77, 78, -1, -1, 79, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, -1, -1, - -1, -1, -1, 107, -1, 109, 110, 11, 12, 13, - 14, 15, -1, -1, 18, -1, 20, 21, 22, 23, + 14, -1, -1, -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, @@ -893,122 +977,34 @@ static const yytype_int16 yycheck[] = 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, 11, 12, - 13, 14, 15, 107, -1, 109, 110, 20, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, 11, - 12, 13, 14, 15, 107, 108, 109, 110, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + -1, 95, 96, -1, 98, -1, 100, 101, 10, 11, + 12, 13, 14, 107, -1, 109, 110, 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, + -1, -1, 54, -1, -1, -1, -1, -1, -1, 61, + 62, -1, -1, 95, 96, -1, 98, -1, 100, 101, + -1, -1, -1, -1, -1, 107, -1, 109, 110, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, -1, -1, -1, -1, 99, 54, -1, + 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, 106, 107, -1, 109, 110, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 95, 96, -1, 98, -1, 100, 101, - 11, 12, 13, 14, 15, 107, -1, 109, 110, 20, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, - -1, -1, -1, 54, -1, -1, -1, -1, -1, -1, - 61, 62, -1, -1, 95, 96, -1, 98, -1, 100, - 101, -1, -1, -1, -1, -1, 107, -1, 109, 110, - 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, -1, -1, -1, -1, 99, 54, - -1, 102, 103, 104, 105, -1, 61, 62, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 81, 82, -1, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - -1, -1, -1, -1, 99, 54, -1, 102, 103, 104, - 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, 82, -1, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, + -1, -1, -1, 99, 54, -1, 102, 103, 104, 105, + -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 82, -1, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, -1, -1, -1, -1, - 99, 54, -1, 102, 103, 104, 105, -1, 61, 62, + -1, -1, 82, -1, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, -1, -1, -1, -1, 99, + 54, -1, 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, -1, -1, -1, -1, 99, -1, -1, 102, - 103, 104, 105 + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, -1, -1, -1, -1, 99, -1, -1, 102, 103, + 104, 105 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1016,62 +1012,62 @@ static const yytype_int16 yycheck[] = static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 11, 12, - 13, 14, 15, 20, 21, 22, 23, 24, 25, 27, + 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, + 12, 13, 14, 19, 21, 22, 23, 24, 25, 27, 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 18, 121, 1, 33, 35, 36, 37, + 205, 206, 207, 17, 121, 1, 33, 35, 36, 37, 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, 126, 168, 169, 126, 188, 188, 21, 26, 121, 200, - 208, 208, 208, 10, 174, 208, 208, 189, 20, 107, + 208, 208, 208, 20, 174, 208, 208, 189, 19, 107, 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, - 208, 208, 76, 77, 78, 80, 18, 20, 107, 91, + 208, 208, 76, 77, 78, 80, 17, 19, 107, 91, 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 99, 102, 103, 104, 105, 107, 18, 20, 18, - 20, 18, 20, 18, 123, 153, 154, 154, 21, 151, + 94, 99, 102, 103, 104, 105, 107, 17, 19, 17, + 19, 17, 19, 17, 123, 153, 154, 154, 21, 151, 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 13, 14, 109, 159, 160, - 162, 163, 164, 165, 10, 192, 107, 73, 174, 106, + 49, 51, 129, 130, 128, 12, 13, 109, 159, 160, + 162, 163, 164, 165, 20, 192, 107, 73, 174, 106, 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, - 208, 175, 19, 108, 192, 107, 188, 191, 200, 201, - 202, 106, 174, 70, 157, 20, 106, 174, 174, 174, + 208, 175, 18, 108, 192, 107, 188, 191, 200, 201, + 202, 106, 174, 70, 157, 19, 106, 174, 174, 174, 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 13, 14, 15, 18, 20, 22, + 188, 188, 188, 188, 12, 13, 14, 17, 19, 22, 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, - 158, 158, 80, 193, 175, 10, 177, 156, 24, 123, - 173, 106, 74, 106, 174, 19, 106, 174, 157, 106, - 24, 174, 20, 108, 10, 106, 83, 110, 110, 110, + 158, 158, 80, 193, 175, 20, 177, 156, 24, 123, + 173, 106, 74, 106, 174, 18, 106, 174, 157, 106, + 24, 174, 19, 108, 20, 106, 83, 110, 110, 110, 174, 174, 110, 106, 174, 110, 110, 107, 106, 108, - 10, 108, 10, 108, 10, 108, 19, 16, 122, 131, - 132, 18, 108, 21, 146, 174, 147, 148, 174, 148, + 20, 108, 20, 108, 20, 108, 18, 15, 122, 131, + 132, 17, 108, 21, 146, 174, 147, 148, 174, 148, 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, - 123, 171, 107, 166, 167, 106, 106, 10, 174, 19, - 188, 108, 10, 106, 193, 19, 19, 19, 19, 123, + 123, 171, 107, 166, 167, 106, 106, 20, 174, 18, + 188, 108, 20, 106, 193, 18, 18, 18, 18, 123, 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, - 106, 108, 136, 148, 106, 106, 188, 174, 74, 18, - 168, 18, 10, 19, 106, 108, 156, 108, 172, 173, - 137, 192, 144, 144, 18, 124, 124, 148, 148, 124, + 106, 108, 136, 148, 106, 106, 188, 174, 74, 17, + 168, 17, 20, 18, 106, 108, 156, 108, 172, 173, + 137, 192, 144, 144, 17, 124, 124, 148, 148, 124, 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, - 142, 106, 106, 143, 146, 148, 124, 19, 19, 127, - 19, 143, 143, 126, 124, 107, 124, 124, 108, 106, - 143, 24, 108, 138, 19, 148, 143, 143, 135, 124, - 71, 139, 17, 106, 144, 143, 126, 124, 149, 72, + 142, 106, 106, 143, 146, 148, 124, 18, 18, 127, + 18, 143, 143, 126, 124, 107, 124, 124, 108, 106, + 143, 24, 108, 138, 18, 148, 143, 143, 135, 124, + 71, 139, 16, 106, 144, 143, 126, 124, 149, 72, 142, 106, 124 }; @@ -1154,28 +1150,28 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1188,6 +1184,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 883f6f1e0d3238970b1150357f43ffd314c4c0cf49d200ed974b8e8c8cc00430 perly.y + * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 56d2f321249e..c59836462d77 100644 --- a/perly.y +++ b/perly.y @@ -45,10 +45,11 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token ']' '-' '+' '@' '%' '&' '=' '.' +%token '-' '+' '@' '%' '&' '=' '.' %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN +%token PERLY_BRACKET_CLOSE %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -963,15 +964,15 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *mai /* In this and all the hash accessors, ';' is * provided by the tokeniser */ { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } - | scalar[array] PERLY_BRACKET_OPEN expr ']' /* $array[$element] */ + | scalar[array] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $array[$element] */ { $$ = newBINOP(OP_AELEM, 0, oopsAV($array), scalar($expr)); } - | term[array_reference] ARROW PERLY_BRACKET_OPEN expr ']' /* somearef->[$element] */ + | term[array_reference] ARROW PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* somearef->[$element] */ { $$ = newBINOP(OP_AELEM, 0, ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); } - | subscripted[array_reference] PERLY_BRACKET_OPEN expr ']' /* $foo->[$bar]->[$baz] */ + | subscripted[array_reference] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $foo->[$bar]->[$baz] */ { $$ = newBINOP(OP_AELEM, 0, ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); @@ -1014,11 +1015,11 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *mai if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | '(' expr[list] ')' PERLY_BRACKET_OPEN expr[slice] ']' /* list slice */ + | '(' expr[list] ')' PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ { $$ = newSLICEOP(0, $slice, $list); } - | QWLIST PERLY_BRACKET_OPEN expr ']' /* list literal slice */ + | QWLIST PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* list literal slice */ { $$ = newSLICEOP(0, $expr, $QWLIST); } - | '(' ')' PERLY_BRACKET_OPEN expr ']' /* empty list slice! */ + | '(' ')' PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ { $$ = newSLICEOP(0, $expr, NULL); } ; @@ -1125,9 +1126,9 @@ termunop : '-' term %prec UMINUS /* -$x */ ; /* Constructors for anonymous data */ -anonymous: PERLY_BRACKET_OPEN expr ']' +anonymous: PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE { $$ = newANONLIST($expr); } - | PERLY_BRACKET_OPEN ']' + | PERLY_BRACKET_OPEN PERLY_BRACKET_CLOSE { $$ = newANONLIST(NULL);} | HASHBRACK expr ';' PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($expr); } @@ -1180,7 +1181,7 @@ term[product] : termbinop { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} | subscripted { $$ = $subscripted; } - | sliceme PERLY_BRACKET_OPEN expr ']' /* array slice */ + | sliceme PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array slice */ { $$ = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1190,7 +1191,7 @@ term[product] : termbinop $$->op_private |= $sliceme->op_private & OPpSLICEWARNING; } - | kvslice PERLY_BRACKET_OPEN expr ']' /* array key/value slice */ + | kvslice PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* array key/value slice */ { $$ = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, diff --git a/toke.c b/toke.c index 944e9d306c4d..1f697d275a23 100644 --- a/toke.c +++ b/toke.c @@ -388,6 +388,7 @@ static struct debug_tokens { { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), + DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -6459,7 +6460,7 @@ yyl_rightsquare(pTHX_ char *s) PL_lex_state = LEX_INTERPEND; } } - TERM(']'); + TERM(PERLY_BRACKET_CLOSE); } static int From 5adeeefb95fca6c5e6fabf5929c025d5b432d4b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:02 +0100 Subject: [PATCH 328/503] Distinguish C- and perly- literals - PERLY_SEMICOLON --- perly.act | 540 +++++++++---------- perly.h | 163 +++--- perly.tab | 1488 +++++++++++++++++++++++++++-------------------------- perly.y | 39 +- toke.c | 15 +- 5 files changed, 1127 insertions(+), 1118 deletions(-) diff --git a/perly.act b/perly.act index 12096013b9c9..d8c3231acfed 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 126 "perly.y" +#line 127 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 131 "perly.y" +#line 132 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 137 "perly.y" +#line 138 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 142 "perly.y" +#line 143 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 147 "perly.y" +#line 148 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 152 "perly.y" +#line 153 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 160 "perly.y" +#line 161 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 165 "perly.y" +#line 166 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 173 "perly.y" +#line 174 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 178 "perly.y" +#line 179 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 186 "perly.y" +#line 187 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 191 "perly.y" +#line 192 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 196 "perly.y" +#line 197 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 201 "perly.y" +#line 202 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 209 "perly.y" +#line 210 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 217 "perly.y" +#line 218 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 224 "perly.y" +#line 225 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 229 "perly.y" +#line 230 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 236 "perly.y" +#line 237 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 242 "perly.y" +#line 243 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 244 "perly.y" +#line 245 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 253 "perly.y" +#line 254 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 255 "perly.y" +#line 256 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 264 "perly.y" +#line 265 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 268 "perly.y" +#line 269 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 272 "perly.y" +#line 273 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 279 "perly.y" +#line 280 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 289 "perly.y" +#line 290 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 291 "perly.y" +#line 292 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 303 "perly.y" +#line 304 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 309 "perly.y" +#line 310 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 324 "perly.y" +#line 325 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 330 "perly.y" +#line 331 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 341 "perly.y" +#line 342 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 348 "perly.y" +#line 349 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 350 "perly.y" +#line 351 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 357 "perly.y" +#line 358 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 363 "perly.y" +#line 364 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 369 "perly.y" +#line 370 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 374 "perly.y" +#line 375 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 376 "perly.y" +#line 377 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 378 "perly.y" +#line 379 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 385 "perly.y" +#line 386 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 392 "perly.y" +#line 393 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 394 "perly.y" +#line 395 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 397 "perly.y" +#line 398 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 412 "perly.y" +#line 413 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 417 "perly.y" +#line 418 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 423 "perly.y" +#line 424 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 425 "perly.y" +#line 426 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 438 "perly.y" +#line 439 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 446 "perly.y" +#line 447 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 452 "perly.y" +#line 453 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 458 "perly.y" +#line 459 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 465 "perly.y" +#line 466 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 473 "perly.y" +#line 474 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 477 "perly.y" +#line 478 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 482 "perly.y" +#line 483 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 490 "perly.y" +#line 491 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 507 "perly.y" +#line 508 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 509 "perly.y" +#line 510 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 519 "perly.y" +#line 520 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 521 "perly.y" +#line 522 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 537 "perly.y" +#line 538 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 539 "perly.y" +#line 540 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 544 "perly.y" +#line 545 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 554 "perly.y" +#line 555 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 556 "perly.y" +#line 557 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 561 "perly.y" +#line 562 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 567 "perly.y" +#line 568 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 573 "perly.y" +#line 574 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 581 "perly.y" +#line 582 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 586 "perly.y" +#line 587 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 590 "perly.y" +#line 591 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 593 "perly.y" +#line 594 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 594 "perly.y" +#line 595 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 598 "perly.y" +#line 599 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 604 "perly.y" +#line 605 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 609 "perly.y" +#line 610 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 620 "perly.y" +#line 621 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 626 "perly.y" +#line 627 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 628 "perly.y" +#line 629 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 630 "perly.y" +#line 631 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 635 "perly.y" +#line 636 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 637 "perly.y" +#line 638 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 648 "perly.y" +#line 649 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 650 "perly.y" +#line 651 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 655 "perly.y" +#line 656 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 657 "perly.y" +#line 658 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 661 "perly.y" +#line 662 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 680 "perly.y" +#line 681 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 682 "perly.y" +#line 683 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 684 "perly.y" +#line 685 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 690 "perly.y" +#line 691 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 755 "perly.y" +#line 756 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 757 "perly.y" +#line 758 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 763 "perly.y" +#line 764 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 765 "perly.y" +#line 766 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 769 "perly.y" +#line 770 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 774 "perly.y" +#line 775 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 776 "perly.y" +#line 777 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 780 "perly.y" +#line 781 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 782 "perly.y" +#line 783 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 786 "perly.y" +#line 787 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 789 "perly.y" +#line 790 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 800 "perly.y" +#line 801 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 857 "perly.y" +#line 858 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 858 "perly.y" - { (yyval.opval) = NULL; } +#line 859 "perly.y" + { (yyval.opval) = NULL; } break; case 122: -#line 864 "perly.y" +#line 865 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 874 "perly.y" +#line 875 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 875 "perly.y" - { (yyval.opval) = NULL; } +#line 876 "perly.y" + { (yyval.opval) = NULL; } break; case 125: -#line 879 "perly.y" +#line 880 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 890 "perly.y" +#line 891 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 892 "perly.y" +#line 893 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 894 "perly.y" +#line 895 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 900 "perly.y" +#line 901 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 902 "perly.y" +#line 903 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 911 "perly.y" +#line 912 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 915 "perly.y" +#line 916 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 919 "perly.y" +#line 920 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 925 "perly.y" +#line 926 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 930 "perly.y" +#line 931 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 936 "perly.y" +#line 937 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 942 "perly.y" +#line 943 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 944 "perly.y" +#line 945 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 946 "perly.y" +#line 947 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 948 "perly.y" +#line 949 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 951 "perly.y" +#line 952 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 966 "perly.y" +#line 967 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 968 "perly.y" +#line 969 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 971 "perly.y" +#line 972 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 976 "perly.y" +#line 977 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 981 "perly.y" +#line 982 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 984 "perly.y" +#line 985 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 988 "perly.y" +#line 989 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 992 "perly.y" +#line 993 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 998 "perly.y" +#line 999 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1006 "perly.y" +#line 1007 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1013 "perly.y" +#line 1014 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1019 "perly.y" +#line 1020 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1021 "perly.y" +#line 1022 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1023 "perly.y" +#line 1024 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1028 "perly.y" +#line 1029 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1030 "perly.y" +#line 1031 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1032 "perly.y" +#line 1033 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1037 "perly.y" +#line 1038 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1039 "perly.y" +#line 1040 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1041 "perly.y" +#line 1042 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1063 "perly.y" +#line 1064 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1065 "perly.y" +#line 1066 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1067 "perly.y" +#line 1068 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1071 "perly.y" +#line 1072 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1073 "perly.y" +#line 1074 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1077 "perly.y" +#line 1078 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1079 "perly.y" +#line 1080 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1081 "perly.y" +#line 1082 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1083 "perly.y" +#line 1084 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1087 "perly.y" +#line 1088 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1089 "perly.y" +#line 1090 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1094 "perly.y" +#line 1095 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1096 "perly.y" +#line 1097 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1101 "perly.y" +#line 1102 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1109 "perly.y" +#line 1110 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1120 "perly.y" +#line 1121 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1123 "perly.y" +#line 1124 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1130 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1132 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1134 "perly.y" +#line 1135 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1136 "perly.y" +#line 1137 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1138 "perly.y" +#line 1139 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1141 "perly.y" +#line 1142 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1147 "perly.y" +#line 1148 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1149 "perly.y" +#line 1150 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1157 "perly.y" +#line 1158 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1159 "perly.y" +#line 1160 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1161 "perly.y" +#line 1162 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1195 "perly.y" +#line 1196 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1205 "perly.y" +#line 1206 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1215 "perly.y" +#line 1216 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1225 "perly.y" +#line 1226 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1227 "perly.y" +#line 1228 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1229 "perly.y" +#line 1230 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1232 "perly.y" +#line 1233 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1237 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1241 "perly.y" +#line 1242 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1243 "perly.y" +#line 1244 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1245 "perly.y" +#line 1246 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1288 "perly.y" +#line 1289 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1290 "perly.y" +#line 1291 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1301 "perly.y" +#line 1302 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1309 "perly.y" +#line 1310 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1311 "perly.y" +#line 1312 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1313 "perly.y" +#line 1314 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1318 "perly.y" +#line 1319 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1320 "perly.y" +#line 1321 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1325 "perly.y" +#line 1326 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1327 "perly.y" +#line 1328 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1332 "perly.y" +#line 1333 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1334 "perly.y" +#line 1335 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1338 "perly.y" +#line 1339 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1340 "perly.y" +#line 1341 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1344 "perly.y" +#line 1345 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1346 "perly.y" +#line 1347 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1352 "perly.y" +#line 1353 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1369 "perly.y" +#line 1370 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1373 "perly.y" +#line 1374 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1377 "perly.y" +#line 1378 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1383 "perly.y" +#line 1384 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1389 "perly.y" +#line 1390 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1391 "perly.y" +#line 1392 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1395 "perly.y" +#line 1396 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1400 "perly.y" +#line 1401 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1405 "perly.y" +#line 1406 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1410 "perly.y" +#line 1411 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1415 "perly.y" +#line 1416 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1417 "perly.y" +#line 1418 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1419 "perly.y" +#line 1420 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1422 "perly.y" +#line 1423 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y + * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index cb653dfa1e0e..405a8879cbe6 100644 --- a/perly.h +++ b/perly.h @@ -67,86 +67,87 @@ extern int yydebug; PERLY_BRACE_CLOSE = 266, PERLY_BRACKET_OPEN = 267, PERLY_BRACKET_CLOSE = 268, - BAREWORD = 269, - METHOD = 270, - FUNCMETH = 271, - THING = 272, - PMFUNC = 273, - PRIVATEREF = 274, - QWLIST = 275, - FUNC0OP = 276, - FUNC0SUB = 277, - UNIOPSUB = 278, - LSTOPSUB = 279, - PLUGEXPR = 280, - PLUGSTMT = 281, - LABEL = 282, - FORMAT = 283, - SUB = 284, - SIGSUB = 285, - ANONSUB = 286, - ANON_SIGSUB = 287, - PACKAGE = 288, - USE = 289, - WHILE = 290, - UNTIL = 291, - IF = 292, - UNLESS = 293, - ELSE = 294, - ELSIF = 295, - CONTINUE = 296, - FOR = 297, - GIVEN = 298, - WHEN = 299, - DEFAULT = 300, - LOOPEX = 301, - DOTDOT = 302, - YADAYADA = 303, - FUNC0 = 304, - FUNC1 = 305, - FUNC = 306, - UNIOP = 307, - LSTOP = 308, - MULOP = 309, - ADDOP = 310, - DOLSHARP = 311, - DO = 312, - HASHBRACK = 313, - NOAMP = 314, - LOCAL = 315, - MY = 316, - REQUIRE = 317, - COLONATTR = 318, - FORMLBRACK = 319, - FORMRBRACK = 320, - SUBLEXSTART = 321, - SUBLEXEND = 322, - PREC_LOW = 323, - OROP = 324, - DOROP = 325, - ANDOP = 326, - NOTOP = 327, - ASSIGNOP = 328, - OROR = 329, - DORDOR = 330, - ANDAND = 331, - BITOROP = 332, - BITANDOP = 333, - CHEQOP = 334, - NCEQOP = 335, - CHRELOP = 336, - NCRELOP = 337, - SHIFTOP = 338, - MATCHOP = 339, - UMINUS = 340, - REFGEN = 341, - POWOP = 342, - PREINC = 343, - PREDEC = 344, - POSTINC = 345, - POSTDEC = 346, - POSTJOIN = 347, - ARROW = 348 + PERLY_SEMICOLON = 269, + BAREWORD = 270, + METHOD = 271, + FUNCMETH = 272, + THING = 273, + PMFUNC = 274, + PRIVATEREF = 275, + QWLIST = 276, + FUNC0OP = 277, + FUNC0SUB = 278, + UNIOPSUB = 279, + LSTOPSUB = 280, + PLUGEXPR = 281, + PLUGSTMT = 282, + LABEL = 283, + FORMAT = 284, + SUB = 285, + SIGSUB = 286, + ANONSUB = 287, + ANON_SIGSUB = 288, + PACKAGE = 289, + USE = 290, + WHILE = 291, + UNTIL = 292, + IF = 293, + UNLESS = 294, + ELSE = 295, + ELSIF = 296, + CONTINUE = 297, + FOR = 298, + GIVEN = 299, + WHEN = 300, + DEFAULT = 301, + LOOPEX = 302, + DOTDOT = 303, + YADAYADA = 304, + FUNC0 = 305, + FUNC1 = 306, + FUNC = 307, + UNIOP = 308, + LSTOP = 309, + MULOP = 310, + ADDOP = 311, + DOLSHARP = 312, + DO = 313, + HASHBRACK = 314, + NOAMP = 315, + LOCAL = 316, + MY = 317, + REQUIRE = 318, + COLONATTR = 319, + FORMLBRACK = 320, + FORMRBRACK = 321, + SUBLEXSTART = 322, + SUBLEXEND = 323, + PREC_LOW = 324, + OROP = 325, + DOROP = 326, + ANDOP = 327, + NOTOP = 328, + ASSIGNOP = 329, + OROR = 330, + DORDOR = 331, + ANDAND = 332, + BITOROP = 333, + BITANDOP = 334, + CHEQOP = 335, + NCEQOP = 336, + CHRELOP = 337, + NCRELOP = 338, + SHIFTOP = 339, + MATCHOP = 340, + UMINUS = 341, + REFGEN = 342, + POWOP = 343, + PREINC = 344, + PREDEC = 345, + POSTINC = 346, + POSTDEC = 347, + POSTJOIN = 348, + ARROW = 349 }; #endif @@ -198,6 +199,6 @@ int yyparse (void); /* Generated from: - * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y + * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index ff2a6f48f342..363a63f198aa 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3301 +#define YYLAST 3331 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 348 +#define YYMAXUTOK 349 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,16 +33,16 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 95, 2, 2, 109, 13, 14, 2, - 107, 106, 110, 11, 80, 10, 16, 111, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 83, 108, - 2, 15, 2, 82, 12, 2, 2, 2, 2, 2, + 2, 2, 2, 96, 2, 2, 109, 13, 14, 2, + 108, 107, 110, 11, 81, 10, 16, 111, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, + 2, 15, 2, 83, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 96, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 97, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -62,45 +62,45 @@ static const yytype_int8 yytranslate[] = 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, - 72, 73, 74, 75, 76, 77, 78, 79, 81, 84, + 72, 73, 74, 75, 76, 77, 78, 79, 80, 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 97, 98, 99, 100, 101, 102, 103, 104, 105 + 95, 98, 99, 100, 101, 102, 103, 104, 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 126, 126, 125, 137, 136, 147, 146, 160, 159, - 173, 172, 186, 185, 196, 195, 208, 216, 224, 228, - 236, 242, 243, 253, 254, 263, 267, 271, 278, 288, - 290, 303, 300, 324, 319, 340, 348, 347, 356, 362, - 368, 373, 375, 377, 384, 392, 394, 391, 411, 416, - 423, 422, 437, 445, 451, 458, 457, 472, 476, 481, - 489, 507, 508, 512, 516, 518, 520, 522, 524, 526, - 528, 531, 537, 538, 543, 554, 555, 561, 567, 568, - 573, 576, 580, 585, 589, 593, 594, 598, 604, 609, - 614, 615, 620, 621, 626, 627, 629, 634, 636, 648, - 649, 654, 656, 660, 680, 681, 683, 689, 754, 756, - 762, 764, 768, 774, 775, 780, 781, 785, 789, 789, - 857, 858, 863, 874, 875, 878, 889, 891, 893, 895, - 899, 901, 906, 910, 914, 918, 924, 929, 935, 941, - 943, 945, 948, 947, 958, 959, 963, 967, 970, 975, - 980, 983, 987, 991, 997, 1005, 1012, 1018, 1020, 1022, - 1027, 1029, 1031, 1036, 1038, 1040, 1042, 1044, 1046, 1048, - 1050, 1052, 1054, 1056, 1060, 1062, 1064, 1066, 1070, 1072, - 1076, 1078, 1080, 1082, 1086, 1088, 1093, 1095, 1098, 1100, - 1102, 1105, 1108, 1119, 1122, 1129, 1131, 1133, 1135, 1137, - 1140, 1146, 1148, 1152, 1153, 1154, 1155, 1156, 1158, 1160, - 1162, 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, - 1182, 1184, 1194, 1204, 1214, 1224, 1226, 1228, 1231, 1236, - 1240, 1242, 1244, 1246, 1249, 1251, 1254, 1256, 1258, 1260, - 1262, 1264, 1266, 1268, 1270, 1273, 1275, 1277, 1279, 1281, - 1283, 1287, 1290, 1289, 1302, 1303, 1304, 1308, 1310, 1312, - 1317, 1319, 1322, 1324, 1326, 1331, 1333, 1338, 1339, 1344, - 1345, 1351, 1355, 1356, 1357, 1360, 1361, 1364, 1365, 1368, - 1372, 1376, 1382, 1388, 1390, 1394, 1398, 1399, 1403, 1404, - 1408, 1409, 1414, 1416, 1418, 1421 + 0, 127, 127, 126, 138, 137, 148, 147, 161, 160, + 174, 173, 187, 186, 197, 196, 209, 217, 225, 229, + 237, 243, 244, 254, 255, 264, 268, 272, 279, 289, + 291, 304, 301, 325, 320, 341, 349, 348, 357, 363, + 369, 374, 376, 378, 385, 393, 395, 392, 412, 417, + 424, 423, 438, 446, 452, 459, 458, 473, 477, 482, + 490, 508, 509, 513, 517, 519, 521, 523, 525, 527, + 529, 532, 538, 539, 544, 555, 556, 562, 568, 569, + 574, 577, 581, 586, 590, 594, 595, 599, 605, 610, + 615, 616, 621, 622, 627, 628, 630, 635, 637, 649, + 650, 655, 657, 661, 681, 682, 684, 690, 755, 757, + 763, 765, 769, 775, 776, 781, 782, 786, 790, 790, + 858, 859, 864, 875, 876, 879, 890, 892, 894, 896, + 900, 902, 907, 911, 915, 919, 925, 930, 936, 942, + 944, 946, 949, 948, 959, 960, 964, 968, 971, 976, + 981, 984, 988, 992, 998, 1006, 1013, 1019, 1021, 1023, + 1028, 1030, 1032, 1037, 1039, 1041, 1043, 1045, 1047, 1049, + 1051, 1053, 1055, 1057, 1061, 1063, 1065, 1067, 1071, 1073, + 1077, 1079, 1081, 1083, 1087, 1089, 1094, 1096, 1099, 1101, + 1103, 1106, 1109, 1120, 1123, 1130, 1132, 1134, 1136, 1138, + 1141, 1147, 1149, 1153, 1154, 1155, 1156, 1157, 1159, 1161, + 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, + 1183, 1185, 1195, 1205, 1215, 1225, 1227, 1229, 1232, 1237, + 1241, 1243, 1245, 1247, 1250, 1252, 1255, 1257, 1259, 1261, + 1263, 1265, 1267, 1269, 1271, 1274, 1276, 1278, 1280, 1282, + 1284, 1288, 1291, 1290, 1303, 1304, 1305, 1309, 1311, 1313, + 1318, 1320, 1323, 1325, 1327, 1332, 1334, 1339, 1340, 1345, + 1346, 1352, 1356, 1357, 1358, 1361, 1362, 1365, 1366, 1369, + 1373, 1377, 1383, 1389, 1391, 1395, 1399, 1400, 1404, 1405, + 1409, 1410, 1415, 1417, 1419, 1422 }; #endif @@ -113,35 +113,35 @@ static const char *const yytname[] = "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", "'+'", "'@'", "'%'", "'&'", "'='", "'.'", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", - "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", - "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", - "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", - "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", - "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", - "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", - "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", - "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", - "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", - "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", - "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", - "POSTJOIN", "ARROW", "')'", "'('", "';'", "'$'", "'*'", "'/'", "$accept", - "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", - "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", - "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", - "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", - "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", - "formname", "startsub", "startanonsub", "startformsub", "subname", - "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", - "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", - "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", - "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", - "listexpr", "listop", "@16", "method", "subscripted", "termbinop", - "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", - "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", - "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", - "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", - "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", + "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", + "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", + "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", + "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", + "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", + "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", + "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", + "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", + "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", + "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", + "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", + "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", + "block", "formblock", "remember", "mblock", "mremember", "stmtseq", + "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", + "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", + "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", + "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", + "startformsub", "subname", "proto", "subattrlist", "myattrlist", + "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", + "sigscalarelem", "sigelem", "siglist", "siglistornull", + "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", + "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", + "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", + "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", + "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", + "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", + "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -158,14 +158,14 @@ static const yytype_int16 yytoknum[] = 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, - 44, 328, 63, 58, 329, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 33, 126, 340, 341, 342, - 343, 344, 345, 346, 347, 348, 41, 40, 59, 36, + 328, 44, 329, 63, 58, 330, 331, 332, 333, 334, + 335, 336, 337, 338, 339, 340, 33, 126, 341, 342, + 343, 344, 345, 346, 347, 348, 349, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-491) +#define YYPACT_NINF (-476) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -179,64 +179,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 724, -491, -491, -491, -491, -491, -491, -491, 7, -491, - 2936, 15, 1567, 1466, -491, -491, -491, -491, 2936, 2936, - 54, 54, 54, 1944, -491, 54, 54, -491, -491, 20, - -57, -491, 2936, -491, -491, -491, -491, 2936, -47, -43, - -20, 2045, 1852, 54, 2045, 2137, 83, 2936, -2, 2936, - 2936, 2936, 2936, 2936, 2936, 2936, 2229, 54, 54, 133, - -4, -491, 19, -491, -35, -19, 72, -10, -491, -491, - -491, 3104, -491, -491, -21, 154, 165, 241, -491, 86, - 263, 285, 95, -491, -491, -491, -491, -491, 83, 83, - 68, -491, -7, 8, 18, 26, 208, 29, 36, 15, - 38, -491, 109, -491, 42, 435, 1466, -491, -491, -491, - 657, -491, 5, 759, 141, 141, -491, -491, -491, -491, - -491, -491, -491, -491, 82, 2936, 60, 103, 2936, 79, - 426, 15, 218, 177, 3104, 147, 2330, 2936, 1852, -491, - 426, 548, -4, -491, 473, 2936, -491, -491, 426, 239, - 195, -491, -491, 2936, 426, 3028, 2431, 193, -491, -491, - -491, 426, -4, 141, 141, 141, 283, 283, 260, 352, - -491, -491, 2936, 2936, 2936, 2936, 2936, 2936, 2532, -491, - -491, 2936, -491, -491, 2936, 2936, 2936, 2936, 2936, 2936, - 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, 2936, - 2936, 2936, -491, -491, -491, 308, 2633, 2936, 2936, 2936, - 2936, 2936, 2936, 2936, -491, 262, -491, -491, 284, -491, - -491, -491, -491, -491, 210, 33, -491, -491, 217, -491, - -491, -491, -491, 15, -491, -491, 2936, 2936, 2936, 2936, - 2936, 2936, -491, -491, -491, -491, -491, 300, 300, -491, - -491, -491, 253, -491, -491, -491, 2936, 2936, 111, -491, - -491, -491, 177, 314, -491, -491, -491, 389, 281, 236, - 2936, -4, -491, 338, -491, 2734, 141, 193, 75, 237, - 242, -491, 430, 340, -491, 2936, 343, 290, 290, -491, - 3104, 268, 114, -491, 463, 426, 341, 3196, 395, 358, - 3104, 3058, 1643, 1643, 1734, 1834, 1925, 341, 341, 426, - 426, 509, 141, 141, 259, 264, 265, 2936, 2936, -491, - 272, 2835, 14, 273, 291, -491, -491, 468, 303, 118, - 313, 158, 330, 161, 373, 860, -491, 382, -491, -491, - 3, 379, 2936, 2936, 2936, 2936, -491, 292, -491, -491, - 297, -491, -491, -491, -491, 1659, 12, -491, 2936, 2936, - -491, -491, 133, -491, 133, -491, -491, -491, -491, -491, - 328, 328, 5, 304, -46, -491, 2936, -491, -491, 306, - -491, -491, -491, -491, 510, -491, 11, 542, -491, -491, - -491, 173, 2936, 396, -491, -491, 2936, -491, -491, -491, - 377, 188, -491, -491, 567, -491, -491, 2936, -491, 405, - -491, 408, -491, 419, -491, 423, -491, -491, -491, 218, - 177, -491, -491, 427, 353, 133, 362, 363, 133, 369, - 375, -491, -491, -491, -491, 370, 339, 316, -491, 2936, - 398, 399, 2936, -491, -491, -491, -491, 2936, 436, -491, - 484, -491, -491, 497, -491, -491, 23, -491, 192, -491, - 3150, 503, -491, -491, 417, -491, -491, -491, -491, 418, - 177, 424, -491, 2936, -491, -491, 516, 516, 2936, 2936, - 516, -491, 431, 446, 516, 516, 3104, 133, -491, -491, - 467, -491, -491, -491, -491, 508, 474, -491, -491, -491, - -491, 475, 516, 516, -491, 167, 167, 479, 483, 109, - 2936, 2936, 516, -491, -491, 961, -491, 1062, -491, -491, - -491, -491, 1163, -491, 109, 109, -491, 516, 487, -491, - -491, 516, 516, -491, 488, 489, 109, -491, -491, 9, - -491, -491, -491, 1264, -491, 2936, 109, 109, -491, 516, - -491, 527, 584, -491, -491, 495, -491, -491, -491, 109, - -491, -491, -491, 516, 1751, -491, 1365, 167, 511, -491, - -491, 516, -491 + 591, -476, -476, -476, -476, -476, -476, -476, 20, -476, + 2965, 50, 1591, 1489, -476, -476, -476, -476, 2965, 2965, + 53, 53, 53, 1971, -476, 53, 53, -476, -476, -7, + -75, -476, 2965, -476, -476, -476, -476, 2965, -19, -3, + -58, 2072, 1878, 53, 2072, 2165, 52, 2965, -2, 2965, + 2965, 2965, 2965, 2965, 2965, 2965, 2258, 53, 53, -39, + 31, -476, 64, -476, -32, 34, 55, 27, -476, -476, + -476, 3133, -476, -476, 42, 121, 144, 154, -476, 125, + 168, 171, 150, -476, -476, -476, -476, -476, -476, 52, + 52, 157, -476, 76, 83, 102, 105, 233, 126, 130, + 50, 245, 198, -476, 248, 2070, 1489, -476, -476, -476, + 672, -476, 5, 775, 153, 153, -476, -476, -476, -476, + -476, -476, -476, -476, 25, 2965, 146, 205, 2965, 173, + 1867, 50, 287, 250, 3133, 218, 2359, 2965, 1878, -476, + 1867, 564, 31, -476, 468, 2965, -476, -476, 1867, 315, + 239, -476, -476, 2965, 1867, 3058, 2460, 267, -476, -476, + -476, 1867, 31, 153, 153, 153, 225, 225, 324, 356, + -476, -476, 2965, 2965, 2965, 2965, 2965, 2965, 2561, -476, + -476, 2965, -476, -476, 2965, 2965, 2965, 2965, 2965, 2965, + 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, + 2965, 2965, -476, -476, -476, 251, 2662, 2965, 2965, 2965, + 2965, 2965, 2965, 2965, -476, 333, -476, -476, 334, -476, + -476, -476, -476, -476, 259, 22, -476, -476, 254, -476, + -476, -476, -476, 50, -476, -476, 2965, 2965, 2965, 2965, + 2965, 2965, -476, -476, -476, -476, -476, 336, 336, -476, + -476, -476, 283, -476, -476, -476, 2965, 2965, 46, -476, + -476, -476, 250, 343, -476, -476, -476, 366, 292, 263, + 2965, 31, -476, 353, -476, 2763, 153, 267, 140, 141, + 190, -476, 369, 350, -476, 2965, 360, 304, 304, -476, + 3133, 299, 115, -476, 400, 1867, 1950, 3225, 421, 395, + 3133, 3087, 1668, 1668, 1760, 1860, 530, 1950, 1950, 1867, + 1867, 355, 153, 153, 279, 280, 285, 2965, 2965, -476, + 290, 2864, 24, 291, 298, -476, -476, 403, 303, 158, + 319, 162, 325, 166, 332, 877, -476, 378, -476, -476, + 36, 385, 2965, 2965, 2965, 2965, -476, 306, -476, -476, + 300, -476, -476, -476, -476, 1684, 12, -476, 2965, 2965, + -476, -476, -39, -476, -39, -476, -476, -476, -476, -476, + 344, 344, 5, 318, -49, -476, 2965, -476, -476, 320, + -476, -476, -476, -476, 415, -476, 11, 427, -476, -476, + -476, 194, 2965, 414, -476, -476, 2965, -476, -476, -476, + 345, 226, -476, -476, 462, -476, -476, 2965, -476, 419, + -476, 420, -476, 422, -476, 424, -476, -476, -476, 287, + 250, -476, -476, 431, 347, -39, 349, 358, -39, 359, + 354, -476, -476, -476, -476, 362, 446, 342, -476, 2965, + 368, 377, 2965, -476, -476, -476, -476, 2965, 411, -476, + 480, -476, -476, 491, -476, -476, 28, -476, 229, -476, + 3179, 497, -476, -476, 410, -476, -476, -476, -476, 498, + 250, 507, -476, 2965, -476, -476, 512, 512, 2965, 2965, + 512, -476, 425, 428, 512, 512, 3133, -39, -476, -476, + 429, -476, -476, -476, -476, 459, 517, -476, -476, -476, + -476, 527, 512, 512, -476, 48, 48, 458, 460, 198, + 2965, 2965, 512, -476, -476, 979, -476, 1081, -476, -476, + -476, -476, 1183, -476, 198, 198, -476, 512, 469, -476, + -476, 512, 512, -476, 545, 463, 198, -476, -476, 90, + -476, -476, -476, 1285, -476, 2965, 198, 198, -476, 512, + -476, 560, 506, -476, -476, 473, -476, -476, -476, 198, + -476, -476, -476, 512, 1777, -476, 1387, 48, 474, -476, + -476, 512, -476 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -252,9 +252,9 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 268, 129, 255, 220, 203, 165, 174, 166, 180, 204, 205, 206, 132, 210, 5, 226, 215, 218, 217, 219, 216, - 0, 0, 0, 18, 7, 64, 29, 89, 0, 0, - 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 59, 75, 9, 0, 65, 0, 11, 26, 25, + 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, + 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, 0, 15, 113, 0, 186, 187, 292, 295, 294, 293, 281, 282, 279, 196, 0, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, @@ -299,24 +299,24 @@ static const yytype_int16 yydefact[] = 32, 120, 0, 37, 75, 75, 21, 0, 0, 38, 39, 0, 0, 53, 0, 0, 75, 122, 125, 0, 56, 43, 44, 0, 73, 0, 75, 75, 46, 0, - 49, 61, 0, 24, 19, 0, 48, 52, 77, 75, - 21, 60, 17, 0, 0, 51, 0, 72, 0, 62, + 49, 0, 61, 24, 19, 0, 48, 52, 77, 75, + 17, 21, 60, 0, 0, 51, 0, 72, 0, 62, 74, 0, 47 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -491, -491, -491, -491, -491, -491, -491, -491, -491, 41, - -491, -5, -107, -491, -17, -491, 602, 515, 16, -491, - -491, -491, -491, -491, -491, -491, -491, -491, 366, -341, - -490, -193, -463, -491, 113, 312, -304, 63, -491, 102, - 293, -491, 252, 227, -243, 372, 412, -491, -491, 294, - -491, 289, -491, -491, -491, -491, 211, -491, -491, 166, - -491, 201, -8, -37, -491, -491, -491, -491, -491, -491, - -491, -491, -491, -491, -491, -491, 100, -491, -491, 520, - -124, -129, -491, -491, 310, -491, -491, 439, 1, -45, - -42, -491, -491, -491, -491, -491, 48 + -476, -476, -476, -476, -476, -476, -476, -476, -476, 43, + -476, -5, -158, -476, -17, -476, 569, 477, 16, -476, + -476, -476, -476, -476, -476, -476, -476, -476, 348, -341, + -475, -95, -468, -476, 80, 258, -303, 38, -476, -21, + 215, -476, 193, 172, -243, 326, 357, -476, -476, 235, + -476, 232, -476, -476, -476, -476, 159, -476, -476, 116, + -476, 142, -8, -37, -476, -476, -476, -476, -476, -476, + -476, -476, -476, -476, -476, -476, 100, -476, -476, 476, + -124, -129, -476, -476, 261, -476, -476, 390, 1, -45, + -42, -476, -476, -476, -476, -476, 51 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -324,7 +324,7 @@ static const yytype_int16 yydefgoto[] = { -1, 8, 9, 10, 11, 12, 13, 14, 15, 102, 418, 379, 505, 526, 110, 539, 244, 108, 109, 419, - 420, 341, 510, 558, 482, 500, 553, 561, 361, 104, + 420, 341, 510, 558, 482, 500, 553, 562, 361, 104, 529, 234, 502, 434, 424, 363, 427, 436, 337, 219, 131, 215, 153, 262, 264, 284, 370, 248, 249, 443, 250, 251, 252, 253, 453, 454, 111, 112, 520, 451, @@ -339,231 +339,234 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 16, 268, 269, - 20, 21, 503, 162, 433, 124, 530, 245, 246, 377, - 421, 119, 119, 119, 20, 21, 119, 119, 103, 274, - 285, 83, 83, 551, 175, 116, 176, 150, 177, 128, - 117, 429, 392, 144, 119, 20, 21, 22, 169, 158, - 129, 435, 84, 137, 440, 441, 179, 180, 119, 119, - 135, 118, 118, 118, 136, 447, 118, 118, 120, 121, - 122, 83, 181, 125, 126, 116, 175, 570, 214, 184, - 117, -261, 139, 118, 118, 147, 206, 138, 142, 218, - 145, 146, 207, -260, 208, 564, 155, 228, 118, 118, - 220, 348, 254, -290, 151, 156, 171, 57, 271, 152, - 279, 422, 213, 280, 247, 221, 142, 552, 114, 115, - 258, 57, 243, 57, 405, 222, 178, 373, 267, 59, - 59, 375, 130, 223, 394, 483, 229, 134, 410, 144, - 231, 140, 57, 230, 148, -262, 232, 154, 282, 161, - 235, 163, 164, 165, 166, 167, 278, 233, 172, 173, - 174, 182, 183, 57, 287, 288, 289, 256, 291, 292, - 294, 207, 260, 208, 507, 508, 257, 471, 412, 118, - 353, 414, -286, 354, -286, 259, 270, 172, 173, 174, - 172, 173, 174, 457, 172, 173, 174, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 535, 462, 172, - 173, 174, 492, 527, 528, 342, 343, 344, 345, 347, + 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, + 20, 21, 128, 162, 433, 124, 137, 245, 246, 377, + 16, 119, 119, 119, 20, 21, 119, 119, 103, 274, + 285, 530, 175, 129, 20, 21, 22, 150, 172, 173, + 174, 83, 429, 144, 119, 254, 116, 392, 169, 158, + 138, 117, 435, 421, 84, 440, 441, 422, 119, 119, + 179, 180, 447, 118, 118, 118, 375, 83, 118, 118, + 83, 120, 121, 122, 151, 116, 125, 126, 214, 152, + 117, 176, -261, 177, 139, 118, 118, 147, 142, 135, + 564, 348, 570, 145, 146, 527, 528, 155, 228, -260, + 118, 118, 172, 173, 174, 136, 156, 57, 271, 171, + 279, 551, 175, 280, 247, 552, 142, 184, 114, 115, + 258, 57, 243, 172, 173, 174, 181, 373, 267, 59, + 59, 57, 130, 57, 405, 394, 483, 134, 207, 144, + 208, 140, -290, 231, 148, 182, 183, 154, 282, 161, + 206, 163, 164, 165, 166, 167, 278, 207, -286, 208, + -286, -286, 57, -286, 287, 288, 289, 213, 291, 292, + 294, -288, 178, -288, 260, 507, 508, 471, 410, 218, + 353, 118, 412, 354, 220, 209, 414, 210, 211, 270, + 212, 221, 172, 173, 174, 338, 339, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, -288, 535, -288, + 222, -262, -264, 223, 457, 342, 343, 344, 345, 347, 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, 172, 173, 174, 172, 173, 174, - 201, 555, 261, 202, 203, 204, 205, 263, 59, 172, - 173, 174, 449, 265, -286, 276, -286, 272, -288, -288, - -288, -288, 384, 283, 172, 173, 174, 387, 172, 173, - 174, 172, 173, 174, 360, 290, 224, 391, 464, 285, - 209, 295, 210, 336, 296, 297, 298, 299, 300, 301, + 362, 362, 362, 362, 229, 172, 173, 174, 230, 172, + 173, 174, 555, 172, 173, 174, 462, 233, 59, 492, + 132, 133, 449, 201, 256, 276, 202, 203, 204, 205, + 273, -263, 384, 314, 315, 316, 232, 387, 317, 235, + 318, 172, 173, 174, 319, 290, 360, 391, 464, 257, + 259, 295, 216, 217, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 211, 273, 212, 340, 225, -264, 346, 400, - 401, 353, -263, 404, 354, 226, 533, 57, 338, 339, - 314, 315, 316, 119, 357, 317, 369, 318, 132, 133, - 319, 541, 542, 372, 425, 364, 428, 428, 378, 142, - 216, 217, 383, 550, 172, 173, 174, 437, 431, 501, - 428, 428, 439, 556, 557, 382, 385, 352, 236, 237, - 238, 239, 392, 118, 390, 240, 565, 241, 174, 397, - 506, 320, 450, 509, 398, 399, 393, 513, 514, 172, - 173, 174, 402, 406, 458, -291, -291, -291, 205, 172, - 173, 174, 172, 173, 174, 524, 525, 417, 407, 59, - 423, 57, 186, 187, 432, 536, 172, 173, 174, 442, - 446, 409, 469, 452, 459, 321, 472, 322, 323, 186, - 544, 411, -83, 465, 546, 547, 466, 479, 172, 173, - 174, 428, 197, 198, 199, 200, 142, 467, 413, 487, - 201, 468, 559, 202, 203, 204, 205, 481, 473, 172, - 173, 174, 200, 172, 173, 174, 567, 201, 286, 474, - 202, 203, 204, 205, 572, 172, 173, 174, 475, 476, - 428, 428, 515, -215, 517, 477, 480, 236, 237, 238, - 239, 415, 478, 522, 240, 461, 241, 186, 187, 200, - 207, 450, 208, -215, 201, 381, 460, 202, 203, 204, - 205, 489, 425, 428, 484, 485, 172, 173, 174, 543, - 488, 172, 173, 174, 491, -215, -215, -215, -215, 199, - 200, 493, -215, 494, -215, 201, 495, -215, 202, 203, - 204, 205, 497, 504, -215, -215, 389, 428, 511, 172, - 173, 174, 486, 566, 172, 173, 174, -215, -254, -215, - -215, -215, 512, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -215, -254, 395, - 186, 187, -215, 516, 408, -215, -215, -215, -215, -215, - 518, -215, 519, 523, -215, 531, 172, 173, 174, 532, - -254, -254, -254, -254, 545, 549, 548, -254, 560, -254, - 562, 563, -254, 200, 365, 366, 367, 368, 201, -254, - -254, 202, 203, 204, 205, 107, 455, 571, 172, 173, - 174, 242, -254, 534, -254, -254, -254, 568, -254, -254, + 312, 313, 224, 172, 173, 174, 172, 173, 174, 400, + 401, 353, 261, 404, 354, 320, 172, 173, 174, 506, + 393, 263, 509, 119, 409, 265, 513, 514, -291, -291, + -291, 205, 225, 272, 425, 364, 428, 428, 283, 142, + 411, 226, 57, 285, 524, 525, 413, 437, 431, 501, + 428, 428, 439, 415, 536, 336, 340, 352, 346, 321, + 322, 323, 357, 369, 372, 118, 461, 382, 378, 544, + 383, 385, 450, 546, 547, 390, 172, 173, 174, 392, + 172, 173, 174, 174, 458, 236, 237, 238, 239, 397, + 398, 559, 240, 417, 241, 399, 172, 173, 174, 59, + 402, 406, 172, 173, 174, 567, 407, 423, 432, 172, + 173, 174, 469, 572, 533, 57, 472, 186, 187, 172, + 173, 174, 172, 173, 174, 446, 442, 479, 452, 541, + 542, 428, 459, 172, 173, 174, 142, 465, 466, 487, + 467, 550, 468, 172, 173, 174, 172, 173, 174, -83, + 200, 556, 557, 473, 474, 201, 475, 186, 202, 203, + 204, 205, 478, 286, 565, 476, 477, 481, -215, 480, + 428, 428, 515, 381, 517, 484, 389, 172, 173, 174, + 172, 173, 174, 522, 485, 207, 488, 208, -215, -215, + 200, 450, 172, 173, 174, 201, 460, 489, 202, 203, + 204, 205, 425, 428, 172, 173, 174, 395, 491, 543, + 408, -215, -215, -215, -215, 493, 200, 494, -215, 495, + -215, 201, 455, -215, 202, 203, 204, 205, 497, 504, + -215, -215, 518, 511, 456, 512, 516, 428, 519, 172, + 173, 174, 486, -215, 566, -215, -215, -215, 523, -215, + -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -254, 531, 548, 532, -215, 463, + 549, -215, -215, -215, -215, -215, 560, 545, 561, -215, + 563, 571, 107, 242, -254, -254, 365, 366, 367, 368, + 534, 470, 186, 187, 1, 2, 3, 4, 5, 6, + 7, 426, 568, 388, 445, 371, 444, -254, -254, -254, + -254, 490, 521, 499, -254, 351, -254, 438, 0, -254, + 195, 196, 197, 198, 199, 200, -254, -254, 0, 0, + 201, 277, 0, 202, 203, 204, 205, 0, 0, -254, + 0, -254, -254, -254, 0, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, 172, 173, 174, 470, -254, 456, 388, - -254, -254, -254, -254, -254, 426, -254, -13, 85, -254, - 371, 445, 521, 490, 351, 444, 438, 18, 19, 20, - 21, 22, 499, 463, 83, 277, 23, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 86, 106, 87, 88, 89, 35, 36, 90, 91, 92, - 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, - 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 1, 2, 3, - 4, 5, 6, 7, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, -254, 0, 0, -254, -254, -254, + -254, -254, -13, 85, 0, -254, 0, 0, 0, 0, + 0, 0, 18, 19, 20, 21, 22, 0, 0, 83, + 0, 23, 0, 86, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, + 56, 57, 58, 0, 0, 18, 19, 20, 21, 22, + 0, 0, 83, 0, 23, 0, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, -3, - 85, 0, 0, 0, 56, 101, 57, 58, 0, 18, - 19, 20, 21, 22, 0, 0, 83, 0, 23, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 86, 106, 87, 88, 89, 35, 36, 90, - 91, 92, 93, 94, 95, 0, 0, 0, 96, 97, - 98, 99, 37, 0, 100, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, + 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, + 21, 22, 0, 0, 83, 416, 23, 0, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 85, 0, 0, 0, 0, 56, 101, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 83, 416, 23, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 86, 106, 87, 88, 89, 35, 36, - 90, 91, 92, 93, 94, 95, 0, 0, 0, 96, - 97, 98, 99, 37, 0, 100, 38, 39, 40, 41, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, + 19, 20, 21, 22, 0, 0, 83, 537, 23, 0, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 85, 0, 0, 0, 0, 56, 101, 57, - 58, 18, 19, 20, 21, 22, 0, 0, 83, 537, - 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 86, 106, 87, 88, 89, 35, - 36, 90, 91, 92, 93, 94, 95, 0, 0, 0, - 96, 97, 98, 99, 37, 0, 100, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 85, 0, 0, 0, 0, 56, 101, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, - 538, 23, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 86, 106, 87, 88, 89, - 35, 36, 90, 91, 92, 93, 94, 95, 0, 0, - 0, 96, 97, 98, 99, 37, 0, 100, 38, 39, + 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, + 0, 18, 19, 20, 21, 22, 0, 0, 83, 538, + 23, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 101, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 83, 540, 23, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 86, 106, 87, 88, - 89, 35, 36, 90, 91, 92, 93, 94, 95, 0, - 0, 0, 96, 97, 98, 99, 37, 0, 100, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 101, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 83, 554, 23, 0, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 86, 106, 87, - 88, 89, 35, 36, 90, 91, 92, 93, 94, 95, - 0, 0, 0, 96, 97, 98, 99, 37, 0, 100, + 57, 58, 0, 18, 19, 20, 21, 22, 0, 0, + 83, 540, 23, 0, 86, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 101, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 83, 0, 23, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 86, 106, - 87, 88, 89, 35, 36, 90, 91, 92, 93, 94, - 95, 0, 0, 0, 96, 97, 98, 99, 37, 0, - 100, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 569, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 101, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 83, 0, 23, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 86, - 106, 87, 88, 89, 35, 36, 90, 91, 92, 93, - 94, 95, 0, 0, 0, 96, 97, 98, 99, 37, - 0, 100, 38, 39, 40, 41, 42, 0, 0, 43, + 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, + 0, 0, 83, 554, 23, 0, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 101, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 83, 0, 23, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 86, 0, 87, 88, 89, 35, 36, 90, 91, 92, - 93, 94, 95, 0, 0, 0, 96, 97, 98, 99, - 37, 0, 100, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, + 21, 22, 0, 0, 83, 0, 23, 0, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 20, 21, 22, 56, 101, 57, 58, 23, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, - 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, - 55, 18, 19, 20, 21, 22, 56, -78, 57, 58, - 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 186, 187, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 50, 0, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, -78, 56, 0, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, - 0, 23, 0, 141, 25, 26, 27, 28, 117, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 186, 187, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, + 19, 20, 21, 22, 0, 0, 83, 0, 23, 0, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, + 0, 18, 19, 20, 21, 22, 0, 0, 83, 0, + 23, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 50, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, 56, - 0, 57, 58, 23, 123, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 195, 196, 197, 198, 199, 200, - 0, 0, 0, 50, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 0, 56, 0, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 83, 0, 23, 0, 24, 25, 26, 27, + 57, 58, 0, 23, 0, -78, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 186, 187, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, 20, - 21, 22, 56, 0, 57, 58, 23, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 21, 22, 56, 57, 58, 0, 23, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 50, 0, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, -78, 56, 57, 58, 18, 19, + 20, 21, 22, 0, 0, 83, 0, 23, 0, 0, + 141, 25, 26, 27, 28, 117, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 186, 187, 0, 0, 0, 0, 0, 186, + 187, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 50, 0, + 201, 199, 200, 202, 203, 204, 205, 201, 0, 0, + 202, 203, 204, 205, 51, 52, 0, 53, 0, 54, + 55, 18, 19, 20, 21, 22, 56, 57, 58, 0, + 23, 123, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 197, 198, 199, 200, 0, 0, 0, 0, + 201, 50, 0, 202, 203, 204, 205, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, + 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 236, 237, 238, 239, 0, 0, 0, + 240, 0, 241, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 172, 173, 174, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, + 56, 57, 58, 0, 23, 0, 149, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 20, 21, 22, 56, 149, 57, 58, 23, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, + 20, 21, 22, 56, 57, 58, 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -572,8 +575,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 168, 56, 0, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 0, 0, 23, + 55, 0, 0, 0, 0, 168, 56, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -582,9 +585,9 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 266, 56, 0, 57, - 58, 18, 19, 20, 21, 22, 0, 0, 0, 0, - 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 54, 55, 0, 0, 0, 0, 266, 56, 57, 58, + 18, 19, 20, 21, 22, 0, 0, 0, 0, 23, + 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, @@ -592,9 +595,9 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 281, 56, 0, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 0, - 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, + 0, 54, 55, 0, 0, 0, 0, 281, 56, 57, + 58, 18, 19, 20, 21, 22, 0, 0, 0, 0, + 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, @@ -603,8 +606,8 @@ static const yytype_int16 yytable[] = 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, - 0, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 0, + 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -613,8 +616,8 @@ static const yytype_int16 yytable[] = 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, - 56, 0, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, + 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, + 0, 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -623,8 +626,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 386, 56, 0, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, + 386, 56, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 0, 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -633,8 +636,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 403, 56, 0, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, + 0, 403, 56, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 0, 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -643,16 +646,16 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 20, 21, 22, 56, 0, 57, 58, 23, 0, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 20, 21, 22, 56, 57, 58, 0, 23, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 0, 275, 0, 57, 58, 188, + 187, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 0, 275, 57, 58, 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, @@ -674,337 +677,340 @@ static const yytype_int16 yytable[] = static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 0, 137, 138, - 12, 13, 475, 50, 355, 23, 506, 12, 13, 262, - 17, 20, 21, 22, 12, 13, 25, 26, 12, 153, - 19, 17, 17, 24, 80, 21, 17, 45, 19, 19, - 26, 345, 19, 42, 43, 12, 13, 14, 56, 48, - 107, 355, 11, 73, 358, 359, 91, 92, 57, 58, - 107, 20, 21, 22, 107, 111, 25, 26, 20, 21, - 22, 17, 91, 25, 26, 21, 80, 567, 83, 89, - 26, 70, 41, 42, 43, 44, 107, 107, 125, 21, - 42, 43, 17, 70, 19, 558, 98, 96, 57, 58, - 107, 68, 20, 17, 21, 107, 58, 109, 145, 26, - 155, 108, 17, 155, 109, 107, 153, 108, 18, 19, - 128, 109, 106, 109, 110, 107, 107, 256, 136, 137, - 138, 20, 32, 107, 20, 439, 107, 37, 20, 138, - 99, 41, 109, 107, 44, 70, 108, 47, 156, 49, - 108, 51, 52, 53, 54, 55, 155, 48, 76, 77, - 78, 89, 90, 109, 172, 173, 174, 107, 176, 177, - 178, 17, 131, 19, 478, 479, 73, 420, 20, 138, - 225, 20, 17, 225, 19, 106, 138, 76, 77, 78, - 76, 77, 78, 20, 76, 77, 78, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 511, 20, 76, - 77, 78, 20, 46, 47, 220, 221, 222, 223, 224, + 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, + 12, 13, 19, 50, 355, 23, 74, 12, 13, 262, + 0, 20, 21, 22, 12, 13, 25, 26, 12, 153, + 19, 506, 81, 108, 12, 13, 14, 45, 77, 78, + 79, 17, 345, 42, 43, 20, 22, 19, 56, 48, + 108, 27, 355, 17, 11, 358, 359, 21, 57, 58, + 92, 93, 111, 20, 21, 22, 20, 17, 25, 26, + 17, 20, 21, 22, 22, 22, 25, 26, 83, 27, + 27, 17, 71, 19, 41, 42, 43, 44, 125, 108, + 558, 69, 567, 42, 43, 47, 48, 99, 97, 71, + 57, 58, 77, 78, 79, 108, 108, 109, 145, 58, + 155, 21, 81, 155, 109, 25, 153, 90, 18, 19, + 128, 109, 106, 77, 78, 79, 92, 256, 136, 137, + 138, 109, 32, 109, 110, 20, 439, 37, 17, 138, + 19, 41, 17, 100, 44, 90, 91, 47, 156, 49, + 108, 51, 52, 53, 54, 55, 155, 17, 17, 19, + 19, 17, 109, 19, 172, 173, 174, 17, 176, 177, + 178, 17, 108, 19, 131, 478, 479, 420, 20, 22, + 225, 138, 20, 225, 108, 17, 20, 19, 17, 138, + 19, 108, 77, 78, 79, 216, 217, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 17, 511, 19, + 108, 71, 71, 108, 20, 220, 221, 222, 223, 224, 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 76, 77, 78, 76, 77, 78, - 99, 545, 24, 102, 103, 104, 105, 70, 256, 76, - 77, 78, 376, 106, 17, 155, 19, 18, 17, 17, - 19, 19, 270, 70, 76, 77, 78, 275, 76, 77, - 78, 76, 77, 78, 233, 175, 68, 285, 407, 19, - 17, 181, 19, 21, 184, 185, 186, 187, 188, 189, + 238, 239, 240, 241, 108, 77, 78, 79, 108, 77, + 78, 79, 545, 77, 78, 79, 20, 49, 256, 20, + 35, 36, 376, 100, 108, 155, 103, 104, 105, 106, + 21, 71, 270, 12, 13, 14, 21, 275, 17, 21, + 19, 77, 78, 79, 23, 175, 233, 285, 407, 74, + 107, 181, 89, 90, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 17, 108, 19, 21, 98, 70, 98, 317, - 318, 356, 70, 321, 356, 107, 509, 109, 216, 217, - 12, 13, 14, 322, 107, 17, 26, 19, 35, 36, - 22, 524, 525, 80, 342, 343, 344, 345, 24, 376, - 88, 89, 106, 536, 76, 77, 78, 355, 347, 473, - 358, 359, 357, 546, 547, 74, 18, 356, 42, 43, - 44, 45, 19, 322, 24, 49, 559, 51, 78, 110, - 477, 63, 377, 480, 110, 110, 108, 484, 485, 76, - 77, 78, 110, 110, 392, 102, 103, 104, 105, 76, - 77, 78, 76, 77, 78, 502, 503, 15, 107, 407, - 21, 109, 61, 62, 107, 512, 76, 77, 78, 81, - 106, 108, 417, 107, 18, 107, 421, 109, 110, 61, - 527, 108, 106, 18, 531, 532, 18, 432, 76, 77, - 78, 439, 91, 92, 93, 94, 473, 18, 108, 447, - 99, 18, 549, 102, 103, 104, 105, 108, 21, 76, - 77, 78, 94, 76, 77, 78, 563, 99, 106, 106, - 102, 103, 104, 105, 571, 76, 77, 78, 106, 106, - 478, 479, 489, 0, 491, 106, 106, 42, 43, 44, - 45, 108, 107, 500, 49, 108, 51, 61, 62, 94, - 17, 496, 19, 20, 99, 106, 396, 102, 103, 104, - 105, 17, 510, 511, 106, 106, 76, 77, 78, 526, - 74, 76, 77, 78, 17, 42, 43, 44, 45, 93, - 94, 18, 49, 106, 51, 99, 108, 54, 102, 103, - 104, 105, 108, 17, 61, 62, 106, 545, 107, 76, - 77, 78, 442, 560, 76, 77, 78, 74, 0, 76, - 77, 78, 106, 80, 81, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 20, 106, - 61, 62, 99, 106, 106, 102, 103, 104, 105, 106, - 72, 108, 108, 108, 111, 106, 76, 77, 78, 106, - 42, 43, 44, 45, 107, 106, 108, 49, 71, 51, - 16, 106, 54, 94, 238, 239, 240, 241, 99, 61, - 62, 102, 103, 104, 105, 13, 106, 106, 76, 77, - 78, 106, 74, 510, 76, 77, 78, 564, 80, 81, + 200, 201, 69, 77, 78, 79, 77, 78, 79, 317, + 318, 356, 25, 321, 356, 64, 77, 78, 79, 477, + 21, 71, 480, 322, 21, 107, 484, 485, 103, 104, + 105, 106, 99, 18, 342, 343, 344, 345, 71, 376, + 21, 108, 109, 19, 502, 503, 21, 355, 347, 473, + 358, 359, 357, 21, 512, 22, 22, 356, 99, 108, + 109, 110, 108, 27, 81, 322, 21, 75, 25, 527, + 107, 18, 377, 531, 532, 25, 77, 78, 79, 19, + 77, 78, 79, 79, 392, 43, 44, 45, 46, 110, + 110, 549, 50, 15, 52, 110, 77, 78, 79, 407, + 110, 110, 77, 78, 79, 563, 108, 22, 108, 77, + 78, 79, 417, 571, 509, 109, 421, 62, 63, 77, + 78, 79, 77, 78, 79, 107, 82, 432, 108, 524, + 525, 439, 18, 77, 78, 79, 473, 18, 18, 447, + 18, 536, 18, 77, 78, 79, 77, 78, 79, 107, + 95, 546, 547, 22, 107, 100, 107, 62, 103, 104, + 105, 106, 108, 107, 559, 107, 107, 21, 0, 107, + 478, 479, 489, 107, 491, 107, 107, 77, 78, 79, + 77, 78, 79, 500, 107, 17, 75, 19, 20, 21, + 95, 496, 77, 78, 79, 100, 396, 17, 103, 104, + 105, 106, 510, 511, 77, 78, 79, 107, 17, 526, + 107, 43, 44, 45, 46, 18, 95, 107, 50, 21, + 52, 100, 107, 55, 103, 104, 105, 106, 21, 17, + 62, 63, 73, 108, 107, 107, 107, 545, 21, 77, + 78, 79, 442, 75, 561, 77, 78, 79, 21, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 76, 77, 78, 419, 99, 106, 277, - 102, 103, 104, 105, 106, 343, 108, 0, 1, 111, - 248, 372, 496, 452, 225, 371, 356, 10, 11, 12, - 13, 14, 471, 106, 17, 155, 19, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, + 92, 93, 94, 95, 0, 107, 21, 107, 100, 107, + 107, 103, 104, 105, 106, 107, 16, 108, 72, 111, + 107, 107, 13, 106, 20, 21, 238, 239, 240, 241, + 510, 419, 62, 63, 3, 4, 5, 6, 7, 8, + 9, 343, 564, 277, 372, 248, 371, 43, 44, 45, + 46, 452, 496, 471, 50, 225, 52, 356, -1, 55, + 90, 91, 92, 93, 94, 95, 62, 63, -1, -1, + 100, 155, -1, 103, 104, 105, 106, -1, -1, 75, + -1, 77, 78, 79, -1, 81, 82, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + -1, -1, -1, -1, 100, -1, -1, 103, 104, 105, + 106, 107, 0, 1, -1, 111, -1, -1, -1, -1, + -1, -1, 10, 11, 12, 13, 14, -1, -1, 17, + -1, 19, -1, 21, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, + -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, + 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, + 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 0, 1, -1, -1, -1, + 108, 109, 110, -1, -1, 10, 11, 12, 13, 14, + -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, + -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, + -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, + 13, 14, -1, -1, 17, 18, 19, -1, 21, 22, + 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, - 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, 3, 4, 5, - 6, 7, 8, 9, -1, -1, 79, -1, -1, -1, + 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, + 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, + -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, 0, - 1, -1, -1, -1, 107, 108, 109, 110, -1, 10, - 11, 12, 13, 14, -1, -1, 17, -1, 19, -1, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, + 11, 12, 13, 14, -1, -1, 17, 18, 19, -1, + 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, -1, -1, -1, 49, 50, - 51, 52, 53, -1, 55, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, + 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, + 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, - 101, 1, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, 13, 14, -1, -1, 17, 18, 19, - -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, -1, -1, -1, 49, - 50, 51, 52, 53, -1, 55, 56, 57, 58, 59, - 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, - 100, 101, 1, -1, -1, -1, -1, 107, 108, 109, - 110, 10, 11, 12, 13, 14, -1, -1, 17, 18, - 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, + -1, 10, 11, 12, 13, 14, -1, -1, 17, 18, + 19, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, -1, -1, -1, - 49, 50, 51, 52, 53, -1, 55, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, 1, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, - 18, 19, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, -1, -1, - -1, 49, 50, 51, 52, 53, -1, 55, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, 1, -1, -1, -1, -1, 107, - 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, - 17, 18, 19, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, -1, - -1, -1, 49, 50, 51, 52, 53, -1, 55, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, 1, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - -1, 17, 18, 19, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - -1, -1, -1, 49, 50, 51, 52, 53, -1, 55, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, 1, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, 33, 34, + 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, + -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, + 109, 110, -1, 10, 11, 12, 13, 14, -1, -1, + 17, 18, 19, -1, 21, 22, 23, 24, 25, 26, + -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, + 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, + 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, + -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, + -1, -1, 17, 18, 19, -1, 21, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, -1, -1, -1, 49, 50, 51, 52, 53, -1, - 55, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, 72, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, 1, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, - 14, -1, -1, 17, -1, 19, -1, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, -1, -1, -1, 49, 50, 51, 52, 53, - -1, 55, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, + 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, + -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, 1, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, + -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, + -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, -1, -1, 17, -1, 19, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - 33, -1, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, -1, -1, -1, 49, 50, 51, 52, - 53, -1, 55, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, + 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, + -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, + 73, -1, -1, -1, -1, -1, -1, 80, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, + 11, 12, 13, 14, -1, -1, 17, -1, 19, -1, + 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, + 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, + 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 1, -1, 95, 96, -1, 98, -1, 100, 101, 10, - 11, 12, 13, 14, 107, 108, 109, 110, 19, -1, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, - -1, -1, -1, -1, 61, 62, -1, -1, -1, -1, - -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 79, -1, - -1, -1, 99, -1, -1, 102, 103, 104, 105, -1, - -1, -1, 1, -1, 95, 96, -1, 98, -1, 100, - 101, 10, 11, 12, 13, 14, 107, 108, 109, 110, - 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, - 39, -1, -1, -1, -1, 61, 62, -1, -1, -1, - -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, 87, 88, 89, 90, 91, 92, 93, 94, -1, - 79, -1, -1, 99, -1, -1, 102, 103, 104, 105, - -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, + -1, 10, 11, 12, 13, 14, -1, -1, 17, -1, + 19, -1, 21, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, 34, -1, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, + -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 1, -1, 96, 97, -1, + 99, -1, 101, 102, 10, 11, 12, 13, 14, 108, + 109, 110, -1, 19, -1, 21, 22, 23, 24, 25, + 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, + -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, + 62, 63, -1, -1, -1, -1, -1, -1, 54, -1, + -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, + 66, 67, 68, 69, 70, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 80, -1, -1, -1, 100, -1, + -1, 103, 104, 105, 106, -1, -1, -1, 1, -1, + 96, 97, -1, 99, -1, 101, 102, 10, 11, 12, + 13, 14, 108, 109, 110, -1, 19, -1, -1, 22, + 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, + 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, + -1, -1, 62, 63, -1, -1, -1, -1, -1, -1, + -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, + -1, 64, 65, 66, 67, 68, 69, 70, 88, 89, + 90, 91, 92, 93, 94, 95, -1, 80, -1, -1, + 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, + 12, 13, 14, -1, -1, 17, -1, 19, -1, -1, + 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, + -1, -1, 62, 63, -1, -1, -1, -1, -1, 62, + 63, -1, 54, -1, -1, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, 89, + 90, 91, 92, 93, 94, 95, -1, -1, 80, -1, + 100, 94, 95, 103, 104, 105, 106, 100, -1, -1, + 103, 104, 105, 106, 96, 97, -1, 99, -1, 101, + 102, 10, 11, 12, 13, 14, 108, 109, 110, -1, + 19, 20, -1, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, + 39, 40, 62, 63, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, 92, 93, 94, 95, -1, -1, -1, -1, + 100, 80, -1, 103, 104, 105, 106, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, - -1, 19, -1, 21, 22, 23, 24, 25, 26, 27, - 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, - 38, 39, -1, -1, -1, 61, 62, -1, -1, -1, - -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, 88, 89, 90, 91, 92, 93, 94, -1, - -1, 79, -1, 99, -1, -1, 102, 103, 104, 105, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, 10, 11, 12, 13, 14, 107, - -1, 109, 110, 19, 20, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, 61, 62, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, 89, 90, 91, 92, 93, 94, - -1, -1, -1, 79, 99, -1, -1, 102, 103, 104, - 105, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - -1, 107, -1, 109, 110, 10, 11, 12, 13, 14, - -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + -1, 19, -1, -1, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, + -1, 39, 40, 43, 44, 45, 46, -1, -1, -1, + 50, -1, 52, -1, -1, -1, 54, -1, -1, 57, + 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, + 68, 69, 70, -1, -1, -1, -1, 77, 78, 79, + -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 10, 11, 12, 13, 14, + 108, 109, 110, -1, 19, -1, 21, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, + -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, + -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, 10, 11, 12, - 13, 14, 107, -1, 109, 110, 19, -1, 21, 22, - 23, 24, 25, -1, 27, 28, 29, 30, 31, 32, - -1, -1, -1, -1, -1, 38, 39, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, + 12, 13, 14, 108, 109, 110, -1, 19, -1, -1, + 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 53, -1, -1, 56, 57, 58, 59, 60, -1, -1, - 63, 64, 65, 66, 67, 68, 69, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 79, -1, -1, -1, + -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 95, 96, -1, 98, -1, 100, 101, 10, - 11, 12, 13, 14, 107, 108, 109, 110, 19, -1, - 21, 22, 23, 24, 25, -1, 27, 28, 29, 30, - 31, 32, -1, -1, -1, -1, -1, 38, 39, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, + 11, 12, 13, 14, -1, -1, -1, -1, 19, -1, + -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, + 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 53, -1, -1, 56, 57, 58, 59, 60, - -1, -1, 63, 64, 65, 66, 67, 68, 69, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 79, -1, + -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, + 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 95, 96, -1, 98, -1, 100, - 101, -1, -1, -1, -1, 106, 107, -1, 109, 110, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, -1, -1, 19, - -1, 21, 22, 23, 24, 25, -1, 27, 28, 29, - 30, 31, 32, -1, -1, -1, -1, -1, 38, 39, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 53, -1, -1, 56, 57, 58, 59, - 60, -1, -1, 63, 64, 65, 66, 67, 68, 69, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 79, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 95, 96, -1, 98, -1, - 100, 101, -1, -1, -1, -1, 106, 107, -1, 109, + -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, + 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, + 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, + 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, + 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, -1, -1, - 19, -1, 21, 22, 23, 24, 25, -1, 27, 28, - 29, 30, 31, 32, -1, -1, -1, -1, -1, 38, - 39, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 53, -1, -1, 56, 57, 58, - 59, 60, -1, -1, 63, 64, 65, 66, 67, 68, - 69, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 79, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 95, 96, -1, 98, - -1, 100, 101, -1, -1, -1, -1, 106, 107, -1, + 19, -1, -1, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, + 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, -1, - -1, 19, -1, 21, 22, 23, 24, 25, -1, 27, - 28, 29, 30, 31, 32, -1, -1, -1, -1, -1, - 38, 39, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 53, -1, -1, 56, 57, - 58, 59, 60, -1, -1, 63, 64, 65, 66, 67, - 68, 69, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 79, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 95, 96, -1, - 98, -1, 100, 101, -1, -1, -1, -1, 106, 107, - -1, 109, 110, 10, 11, 12, 13, 14, -1, -1, - -1, -1, 19, -1, 21, 22, 23, 24, 25, -1, - 27, 28, 29, 30, 31, 32, -1, -1, -1, -1, - -1, 38, 39, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 53, -1, -1, 56, - 57, 58, 59, 60, -1, -1, 63, 64, 65, 66, - 67, 68, 69, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 79, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 95, 96, - -1, 98, -1, 100, 101, -1, -1, -1, -1, 106, - 107, -1, 109, 110, 10, 11, 12, 13, 14, -1, - -1, -1, -1, 19, -1, 21, 22, 23, 24, 25, - -1, 27, 28, 29, 30, 31, 32, -1, -1, -1, - -1, -1, 38, 39, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 53, -1, -1, - 56, 57, 58, 59, 60, -1, -1, 63, 64, 65, - 66, 67, 68, 69, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 79, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 95, - 96, -1, 98, -1, 100, 101, -1, -1, -1, -1, - 106, 107, -1, 109, 110, 10, 11, 12, 13, 14, - -1, -1, -1, -1, 19, -1, 21, 22, 23, 24, - 25, -1, 27, 28, 29, 30, 31, 32, -1, -1, - -1, -1, -1, 38, 39, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 53, -1, - -1, 56, 57, 58, 59, 60, -1, -1, 63, 64, - 65, 66, 67, 68, 69, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 79, -1, -1, -1, -1, -1, + -1, 19, -1, -1, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, + -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, + 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, + 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, + 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, + -1, -1, 19, -1, -1, 22, 23, 24, 25, 26, + -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, + -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, + 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, + 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, + 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, + -1, -1, -1, 19, -1, -1, 22, 23, 24, 25, + 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, + -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, + -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, + 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 95, 96, -1, 98, -1, 100, 101, -1, -1, -1, - -1, 106, 107, -1, 109, 110, 10, 11, 12, 13, - 14, -1, -1, -1, -1, 19, -1, 21, 22, 23, - 24, 25, -1, 27, 28, 29, 30, 31, 32, -1, - -1, -1, -1, -1, 38, 39, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 53, - -1, -1, 56, 57, 58, 59, 60, -1, -1, 63, - 64, 65, 66, 67, 68, 69, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, -1, -1, -1, + 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, + -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, + -1, -1, -1, -1, 19, -1, -1, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, + -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, + -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 95, 96, -1, 98, -1, 100, 101, 10, 11, - 12, 13, 14, 107, -1, 109, 110, 19, -1, 21, - 22, 23, 24, 25, -1, 27, 28, 29, 30, 31, - 32, -1, -1, -1, -1, -1, 38, 39, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, + 12, 13, 14, 108, 109, 110, -1, 19, -1, -1, + 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 53, -1, -1, 56, 57, 58, 59, 60, -1, - -1, 63, 64, 65, 66, 67, 68, 69, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 79, -1, -1, - -1, -1, 54, -1, -1, -1, -1, -1, -1, 61, - 62, -1, -1, 95, 96, -1, 98, -1, 100, 101, - -1, -1, -1, -1, -1, 107, -1, 109, 110, 81, - 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, -1, -1, -1, -1, 99, 54, -1, - 102, 103, 104, 105, -1, 61, 62, -1, -1, -1, + -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, + -1, -1, 55, -1, -1, -1, -1, -1, -1, 62, + 63, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, -1, 108, 109, 110, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, -1, -1, -1, -1, 100, 55, -1, + 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, 82, -1, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, -1, - -1, -1, -1, 99, 54, -1, 102, 103, 104, 105, - -1, 61, 62, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 82, 83, -1, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, + -1, -1, -1, 100, 55, -1, 103, 104, 105, 106, + -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 82, -1, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, -1, -1, -1, -1, 99, - 54, -1, 102, 103, 104, 105, -1, 61, 62, -1, + -1, -1, 83, -1, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, -1, -1, -1, -1, 100, + 55, -1, 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, -1, -1, -1, -1, 99, -1, -1, 102, 103, - 104, 105 + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, + 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1013,62 +1019,62 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 14, 19, 21, 22, 23, 24, 25, 27, - 28, 29, 30, 31, 32, 38, 39, 53, 56, 57, - 58, 59, 60, 63, 64, 65, 66, 67, 68, 69, - 79, 95, 96, 98, 100, 101, 107, 109, 110, 174, + 12, 13, 14, 19, 22, 23, 24, 25, 26, 28, + 29, 30, 31, 32, 33, 39, 40, 54, 57, 58, + 59, 60, 61, 64, 65, 66, 67, 68, 69, 70, + 80, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 17, 121, 1, 33, 35, 36, 37, - 40, 41, 42, 43, 44, 45, 49, 50, 51, 52, - 55, 108, 121, 130, 141, 174, 34, 128, 129, 130, - 126, 168, 169, 126, 188, 188, 21, 26, 121, 200, - 208, 208, 208, 20, 174, 208, 208, 189, 19, 107, - 188, 152, 152, 152, 188, 107, 107, 73, 107, 121, - 188, 21, 175, 192, 200, 208, 208, 121, 188, 108, - 174, 21, 26, 154, 188, 98, 107, 191, 200, 201, - 202, 188, 175, 188, 188, 188, 188, 188, 106, 174, - 208, 208, 76, 77, 78, 80, 17, 19, 107, 91, - 92, 91, 89, 90, 89, 54, 61, 62, 81, 82, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 99, 102, 103, 104, 105, 107, 17, 19, 17, - 19, 17, 19, 17, 123, 153, 154, 154, 21, 151, - 107, 107, 107, 107, 68, 98, 107, 198, 200, 107, - 107, 121, 108, 48, 143, 108, 42, 43, 44, 45, - 49, 51, 129, 130, 128, 12, 13, 109, 159, 160, - 162, 163, 164, 165, 20, 192, 107, 73, 174, 106, - 121, 24, 155, 70, 156, 106, 106, 174, 193, 193, - 208, 175, 18, 108, 192, 107, 188, 191, 200, 201, - 202, 106, 174, 70, 157, 19, 106, 174, 174, 174, - 188, 174, 174, 106, 174, 188, 188, 188, 188, 188, + 205, 206, 207, 17, 121, 1, 21, 34, 36, 37, + 38, 41, 42, 43, 44, 45, 46, 50, 51, 52, + 53, 56, 121, 130, 141, 174, 35, 128, 129, 130, + 126, 168, 169, 126, 188, 188, 22, 27, 121, 200, + 208, 208, 208, 20, 174, 208, 208, 189, 19, 108, + 188, 152, 152, 152, 188, 108, 108, 74, 108, 121, + 188, 22, 175, 192, 200, 208, 208, 121, 188, 21, + 174, 22, 27, 154, 188, 99, 108, 191, 200, 201, + 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, + 208, 208, 77, 78, 79, 81, 17, 19, 108, 92, + 93, 92, 90, 91, 90, 55, 62, 63, 82, 83, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 100, 103, 104, 105, 106, 108, 17, 19, 17, + 19, 17, 19, 17, 123, 153, 154, 154, 22, 151, + 108, 108, 108, 108, 69, 99, 108, 198, 200, 108, + 108, 121, 21, 49, 143, 21, 43, 44, 45, 46, + 50, 52, 129, 130, 128, 12, 13, 109, 159, 160, + 162, 163, 164, 165, 20, 192, 108, 74, 174, 107, + 121, 25, 155, 71, 156, 107, 107, 174, 193, 193, + 208, 175, 18, 21, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 71, 157, 19, 107, 174, 174, 174, + 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 12, 13, 14, 17, 19, 22, - 63, 107, 109, 110, 178, 200, 106, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 21, 150, 151, 151, - 21, 133, 123, 123, 123, 123, 98, 123, 68, 196, - 197, 199, 200, 201, 202, 123, 123, 107, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 26, - 158, 158, 80, 193, 175, 20, 177, 156, 24, 123, - 173, 106, 74, 106, 174, 18, 106, 174, 157, 106, - 24, 174, 19, 108, 20, 106, 83, 110, 110, 110, - 174, 174, 110, 106, 174, 110, 110, 107, 106, 108, - 20, 108, 20, 108, 20, 108, 18, 15, 122, 131, - 132, 17, 108, 21, 146, 174, 147, 148, 174, 148, - 195, 200, 107, 141, 145, 148, 149, 174, 196, 123, - 148, 148, 81, 161, 161, 163, 106, 111, 194, 192, - 123, 171, 107, 166, 167, 106, 106, 20, 174, 18, - 188, 108, 20, 106, 193, 18, 18, 18, 18, 123, - 155, 156, 123, 21, 106, 106, 106, 106, 107, 123, - 106, 108, 136, 148, 106, 106, 188, 174, 74, 17, - 168, 17, 20, 18, 106, 108, 156, 108, 172, 173, + 188, 188, 188, 188, 12, 13, 14, 17, 19, 23, + 64, 108, 109, 110, 178, 200, 107, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 22, 150, 151, 151, + 22, 133, 123, 123, 123, 123, 99, 123, 69, 196, + 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 27, + 158, 158, 81, 193, 175, 20, 177, 156, 25, 123, + 173, 107, 75, 107, 174, 18, 107, 174, 157, 107, + 25, 174, 19, 21, 20, 107, 84, 110, 110, 110, + 174, 174, 110, 107, 174, 110, 110, 108, 107, 21, + 20, 21, 20, 21, 20, 21, 18, 15, 122, 131, + 132, 17, 21, 22, 146, 174, 147, 148, 174, 148, + 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, + 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, + 123, 171, 108, 166, 167, 107, 107, 20, 174, 18, + 188, 21, 20, 107, 193, 18, 18, 18, 18, 123, + 155, 156, 123, 22, 107, 107, 107, 107, 108, 123, + 107, 21, 136, 148, 107, 107, 188, 174, 75, 17, + 168, 17, 20, 18, 107, 21, 156, 21, 172, 173, 137, 192, 144, 144, 17, 124, 124, 148, 148, 124, - 134, 107, 106, 124, 124, 126, 106, 126, 72, 108, - 170, 171, 126, 108, 124, 124, 125, 46, 47, 142, - 142, 106, 106, 143, 146, 148, 124, 18, 18, 127, - 18, 143, 143, 126, 124, 107, 124, 124, 108, 106, - 143, 24, 108, 138, 18, 148, 143, 143, 135, 124, - 71, 139, 16, 106, 144, 143, 126, 124, 149, 72, - 142, 106, 124 + 134, 108, 107, 124, 124, 126, 107, 126, 73, 21, + 170, 171, 126, 21, 124, 124, 125, 47, 48, 142, + 142, 107, 107, 143, 146, 148, 124, 18, 18, 127, + 18, 143, 143, 126, 124, 108, 124, 124, 21, 107, + 143, 21, 25, 138, 18, 148, 143, 143, 135, 124, + 16, 72, 139, 107, 144, 143, 126, 124, 149, 73, + 142, 107, 124 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ @@ -1152,38 +1158,38 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 8b86223ae87e005d419190a1c6ad4bc042fc582487685399e9e3072f1a9fede5 perly.y + * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index c59836462d77..929a5a3b9777 100644 --- a/perly.y +++ b/perly.y @@ -50,6 +50,7 @@ %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN %token PERLY_BRACKET_CLOSE +%token PERLY_SEMICOLON %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -213,7 +214,7 @@ block : PERLY_BRACE_OPEN remember stmtseq PERLY_BRACE_CLOSE ; /* format body */ -formblock: '=' remember ';' FORMRBRACK formstmtseq ';' '.' +formblock: '=' remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON '.' { if (parser->copline > (line_t)$1) parser->copline = (line_t)$1; $$ = block_end($remember, $formstmtseq); @@ -337,7 +338,7 @@ barestmt: PLUGSTMT intro_my(); parser->parsed_sub = 1; } - | PACKAGE BAREWORD[version] BAREWORD[package] ';' + | PACKAGE BAREWORD[version] BAREWORD[package] PERLY_SEMICOLON { package($package); if ($version) @@ -346,7 +347,7 @@ barestmt: PLUGSTMT } | USE startsub { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } - BAREWORD[version] BAREWORD[module] optlistexpr ';' + BAREWORD[version] BAREWORD[module] optlistexpr PERLY_SEMICOLON { SvREFCNT_inc_simple_void(PL_compcv); utilize($USE, $startsub, $version, $module, $optlistexpr); @@ -388,9 +389,9 @@ barestmt: PLUGSTMT $iexpr, $mblock, $cont, $mintro)); parser->copline = (line_t)$UNTIL; } - | FOR '(' remember mnexpr[init_mnexpr] ';' + | FOR '(' remember mnexpr[init_mnexpr] PERLY_SEMICOLON { parser->expect = XTERM; } - texpr ';' + texpr PERLY_SEMICOLON { parser->expect = XTERM; } mintro mnexpr[iterate_mnexpr] ')' mblock @@ -469,16 +470,16 @@ barestmt: PLUGSTMT if (parser->copline > (line_t)$PERLY_BRACE_OPEN) parser->copline = (line_t)$PERLY_BRACE_OPEN; } - | sideff ';' + | sideff PERLY_SEMICOLON { $$ = $sideff; } - | YADAYADA ';' + | YADAYADA PERLY_SEMICOLON { $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); } - | ';' + | PERLY_SEMICOLON { $$ = NULL; parser->copline = NOLINE; @@ -855,7 +856,7 @@ subsigguts: /* Optional subroutine body (for named subroutine declaration) */ optsubbody: subbody { $$ = $subbody; } - | ';' { $$ = NULL; } + | PERLY_SEMICOLON { $$ = NULL; } ; @@ -872,7 +873,7 @@ subbody: remember PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE /* optional [ Subroutine body with optional signature ] (for named * subroutine declaration) */ optsigsubbody: sigsubbody { $$ = $sigsubbody; } - | ';' { $$ = NULL; } + | PERLY_SEMICOLON { $$ = NULL; } /* Subroutine body with optional signature */ sigsubbody: remember optsubsignature PERLY_BRACE_OPEN stmtseq PERLY_BRACE_CLOSE @@ -960,8 +961,8 @@ method : METHOD ; /* Some kind of subscripted expression */ -subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *main::{something} */ - /* In this and all the hash accessors, ';' is +subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* *main::{something} */ + /* In this and all the hash accessors, PERLY_SEMICOLON is * provided by the tokeniser */ { $$ = newBINOP(OP_GELEM, 0, $gelem, scalar($expr)); } | scalar[array] PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* $array[$element] */ @@ -977,14 +978,14 @@ subscripted: gelem PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* *mai ref(newAVREF($array_reference),OP_RV2AV), scalar($expr)); } - | scalar[hash] PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* $foo{bar();} */ + | scalar[hash] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo{bar();} */ { $$ = newBINOP(OP_HELEM, 0, oopsHV($hash), jmaybe($expr)); } - | term[hash_reference] ARROW PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* somehref->{bar();} */ + | term[hash_reference] ARROW PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* somehref->{bar();} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } - | subscripted[hash_reference] PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* $foo->[bar]->{baz;} */ + | subscripted[hash_reference] PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* $foo->[bar]->{baz;} */ { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } @@ -1130,9 +1131,9 @@ anonymous: PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE { $$ = newANONLIST($expr); } | PERLY_BRACKET_OPEN PERLY_BRACKET_CLOSE { $$ = newANONLIST(NULL);} - | HASHBRACK expr ';' PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ + | HASHBRACK expr PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ { $$ = newANONHASH($expr); } - | HASHBRACK ';' PERLY_BRACE_CLOSE %prec '(' /* { } (';' by tokener) */ + | HASHBRACK PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec '(' /* { } (PERLY_SEMICOLON by tokener) */ { $$ = newANONHASH(NULL); } | ANONSUB startanonsub proto subattrlist subbody %prec '(' { SvREFCNT_inc_simple_void(PL_compcv); @@ -1201,7 +1202,7 @@ term[product] : termbinop $$->op_private |= $kvslice->op_private & OPpSLICEWARNING; } - | sliceme PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* @hash{@keys} */ + | sliceme PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* @hash{@keys} */ { $$ = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1211,7 +1212,7 @@ term[product] : termbinop $$->op_private |= $sliceme->op_private & OPpSLICEWARNING; } - | kvslice PERLY_BRACE_OPEN expr ';' PERLY_BRACE_CLOSE /* %hash{@keys} */ + | kvslice PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE /* %hash{@keys} */ { $$ = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, diff --git a/toke.c b/toke.c index 1f697d275a23..ac33aac1c1ef 100644 --- a/toke.c +++ b/toke.c @@ -390,6 +390,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), + DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" }, @@ -6228,11 +6229,11 @@ yyl_rightcurly(pTHX_ char *s, const U8 formbrack) force_next(formbrack ? '.' : PERLY_BRACE_CLOSE); if (formbrack) LEAVE_with_name("lex_format"); if (formbrack == 2) { /* means . where arguments were expected */ - force_next(';'); + force_next(PERLY_SEMICOLON); TOKEN(FORMRBRACK); } - TOKEN(';'); + TOKEN(PERLY_SEMICOLON); } static int @@ -6969,7 +6970,7 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s) if (!lex_next_chunk(fake_eof)) { CopLINE_dec(PL_curcop); s = PL_bufptr; - TOKEN(';'); /* not infinite loop because rsfp is NULL now */ + TOKEN(PERLY_SEMICOLON); /* not infinite loop because rsfp is NULL now */ } CopLINE_dec(PL_curcop); s = PL_bufptr; @@ -7210,7 +7211,7 @@ yyl_fake_eof(pTHX_ U32 fake_eof, bool bof, char *s) if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) { PL_lex_state = LEX_FORMLINE; force_next(FORMRBRACK); - TOKEN(';'); + TOKEN(PERLY_SEMICOLON); } PL_bufptr = s; @@ -8783,7 +8784,7 @@ yyl_try(pTHX_ char *s) case '\n': { const bool needs_semicolon = yyl_eol_needs_semicolon(aTHX_ &s); if (needs_semicolon) - TOKEN(';'); + TOKEN(PERLY_SEMICOLON); else goto retry; } @@ -8828,7 +8829,7 @@ yyl_try(pTHX_ char *s) CLINE; s++; PL_expect = XSTATE; - TOKEN(';'); + TOKEN(PERLY_SEMICOLON); case ')': return yyl_rightparen(aTHX_ s); @@ -12266,7 +12267,7 @@ Perl_yyerror_pvn(pTHX_ const char *const s, STRLEN len, U32 flags) * processing unconditionally */ if (s != NULL) { - if (!yychar || (yychar == ';' && !PL_rsfp)) + if (!yychar || (yychar == PERLY_SEMICOLON && !PL_rsfp)) sv_catpvs(where_sv, "at EOF"); else if ( PL_oldoldbufptr && PL_bufptr > PL_oldoldbufptr From da4bce7d622f45b752d496660faa400b8d582c7f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:03 +0100 Subject: [PATCH 329/503] Distinguish C- and perly- literals - PERLY_DOT --- perly.act | 536 ++++++++++++------------ perly.h | 165 ++++---- perly.tab | 1195 ++++++++++++++++++++++++++--------------------------- perly.y | 5 +- toke.c | 3 +- 5 files changed, 952 insertions(+), 952 deletions(-) diff --git a/perly.act b/perly.act index d8c3231acfed..7b49d522e961 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 127 "perly.y" +#line 128 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 132 "perly.y" +#line 133 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 138 "perly.y" +#line 139 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 143 "perly.y" +#line 144 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 148 "perly.y" +#line 149 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 153 "perly.y" +#line 154 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 161 "perly.y" +#line 162 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 166 "perly.y" +#line 167 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 174 "perly.y" +#line 175 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 179 "perly.y" +#line 180 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 187 "perly.y" +#line 188 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 192 "perly.y" +#line 193 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 197 "perly.y" +#line 198 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 202 "perly.y" +#line 203 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 210 "perly.y" +#line 211 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 218 "perly.y" +#line 219 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 225 "perly.y" +#line 226 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 230 "perly.y" +#line 231 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 237 "perly.y" +#line 238 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 243 "perly.y" +#line 244 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 245 "perly.y" +#line 246 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 254 "perly.y" +#line 255 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 256 "perly.y" +#line 257 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 265 "perly.y" +#line 266 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 269 "perly.y" +#line 270 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 273 "perly.y" +#line 274 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 280 "perly.y" +#line 281 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 290 "perly.y" +#line 291 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 292 "perly.y" +#line 293 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 304 "perly.y" +#line 305 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 310 "perly.y" +#line 311 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 325 "perly.y" +#line 326 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 331 "perly.y" +#line 332 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 342 "perly.y" +#line 343 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 349 "perly.y" +#line 350 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 351 "perly.y" +#line 352 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 358 "perly.y" +#line 359 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 364 "perly.y" +#line 365 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 370 "perly.y" +#line 371 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 375 "perly.y" +#line 376 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 377 "perly.y" +#line 378 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 379 "perly.y" +#line 380 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 386 "perly.y" +#line 387 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 393 "perly.y" +#line 394 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 395 "perly.y" +#line 396 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 398 "perly.y" +#line 399 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 413 "perly.y" +#line 414 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 418 "perly.y" +#line 419 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 424 "perly.y" +#line 425 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 426 "perly.y" +#line 427 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 439 "perly.y" +#line 440 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 447 "perly.y" +#line 448 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 453 "perly.y" +#line 454 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 459 "perly.y" +#line 460 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 466 "perly.y" +#line 467 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 474 "perly.y" +#line 475 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 478 "perly.y" +#line 479 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 483 "perly.y" +#line 484 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 491 "perly.y" +#line 492 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 508 "perly.y" +#line 509 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 510 "perly.y" +#line 511 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 518 "perly.y" +#line 519 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 520 "perly.y" +#line 521 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 522 "perly.y" +#line 523 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 538 "perly.y" +#line 539 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 540 "perly.y" +#line 541 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 545 "perly.y" +#line 546 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 555 "perly.y" +#line 556 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 557 "perly.y" +#line 558 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 562 "perly.y" +#line 563 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 568 "perly.y" +#line 569 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 574 "perly.y" +#line 575 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 582 "perly.y" +#line 583 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 587 "perly.y" +#line 588 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 591 "perly.y" +#line 592 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 594 "perly.y" +#line 595 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 595 "perly.y" +#line 596 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 599 "perly.y" +#line 600 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 605 "perly.y" +#line 606 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 610 "perly.y" +#line 611 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 621 "perly.y" +#line 622 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 627 "perly.y" +#line 628 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 629 "perly.y" +#line 630 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 631 "perly.y" +#line 632 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 638 "perly.y" +#line 639 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 649 "perly.y" +#line 650 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 651 "perly.y" +#line 652 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 656 "perly.y" +#line 657 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 658 "perly.y" +#line 659 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 662 "perly.y" +#line 663 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 681 "perly.y" +#line 682 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 683 "perly.y" +#line 684 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 685 "perly.y" +#line 686 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 691 "perly.y" +#line 692 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 756 "perly.y" +#line 757 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 758 "perly.y" +#line 759 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 764 "perly.y" +#line 765 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 766 "perly.y" +#line 767 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 770 "perly.y" +#line 771 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 775 "perly.y" +#line 776 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 777 "perly.y" +#line 778 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 781 "perly.y" +#line 782 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 783 "perly.y" +#line 784 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 787 "perly.y" +#line 788 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 790 "perly.y" +#line 791 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 801 "perly.y" +#line 802 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 858 "perly.y" +#line 859 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 859 "perly.y" +#line 860 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 865 "perly.y" +#line 866 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 875 "perly.y" +#line 876 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 876 "perly.y" +#line 877 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 880 "perly.y" +#line 881 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 891 "perly.y" +#line 892 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 893 "perly.y" +#line 894 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 895 "perly.y" +#line 896 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 901 "perly.y" +#line 902 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 903 "perly.y" +#line 904 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 912 "perly.y" +#line 913 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 916 "perly.y" +#line 917 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 920 "perly.y" +#line 921 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 926 "perly.y" +#line 927 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 931 "perly.y" +#line 932 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 937 "perly.y" +#line 938 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 943 "perly.y" +#line 944 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 945 "perly.y" +#line 946 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 947 "perly.y" +#line 948 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 949 "perly.y" +#line 950 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 952 "perly.y" +#line 953 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 967 "perly.y" +#line 968 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 969 "perly.y" +#line 970 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 972 "perly.y" +#line 973 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 977 "perly.y" +#line 978 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 982 "perly.y" +#line 983 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 985 "perly.y" +#line 986 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 989 "perly.y" +#line 990 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 993 "perly.y" +#line 994 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 999 "perly.y" +#line 1000 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1007 "perly.y" +#line 1008 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1014 "perly.y" +#line 1015 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1020 "perly.y" +#line 1021 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1022 "perly.y" +#line 1023 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1024 "perly.y" +#line 1025 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1029 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1031 "perly.y" +#line 1032 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1033 "perly.y" +#line 1034 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1038 "perly.y" +#line 1039 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1040 "perly.y" +#line 1041 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1042 "perly.y" +#line 1043 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1062 "perly.y" +#line 1063 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1064 "perly.y" +#line 1065 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1066 "perly.y" +#line 1067 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1068 "perly.y" +#line 1069 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1072 "perly.y" +#line 1073 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1074 "perly.y" +#line 1075 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1078 "perly.y" +#line 1079 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1080 "perly.y" +#line 1081 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1082 "perly.y" +#line 1083 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1084 "perly.y" +#line 1085 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1088 "perly.y" +#line 1089 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1090 "perly.y" +#line 1091 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1095 "perly.y" +#line 1096 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1100 "perly.y" +#line 1101 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1107 "perly.y" +#line 1108 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1110 "perly.y" +#line 1111 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1121 "perly.y" +#line 1122 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1124 "perly.y" +#line 1125 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1131 "perly.y" +#line 1132 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1133 "perly.y" +#line 1134 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1135 "perly.y" +#line 1136 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1137 "perly.y" +#line 1138 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1139 "perly.y" +#line 1140 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1142 "perly.y" +#line 1143 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1148 "perly.y" +#line 1149 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1150 "perly.y" +#line 1151 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1158 "perly.y" +#line 1159 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1160 "perly.y" +#line 1161 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1162 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1186 "perly.y" +#line 1187 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1196 "perly.y" +#line 1197 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1206 "perly.y" +#line 1207 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1216 "perly.y" +#line 1217 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1226 "perly.y" +#line 1227 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1228 "perly.y" +#line 1229 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1230 "perly.y" +#line 1231 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1233 "perly.y" +#line 1234 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1238 "perly.y" +#line 1239 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1242 "perly.y" +#line 1243 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1244 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1289 "perly.y" +#line 1290 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1291 "perly.y" +#line 1292 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1302 "perly.y" +#line 1303 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1310 "perly.y" +#line 1311 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1312 "perly.y" +#line 1313 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1314 "perly.y" +#line 1315 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1324 "perly.y" +#line 1325 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1326 "perly.y" +#line 1327 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1333 "perly.y" +#line 1334 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1335 "perly.y" +#line 1336 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1339 "perly.y" +#line 1340 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1341 "perly.y" +#line 1342 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1345 "perly.y" +#line 1346 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1347 "perly.y" +#line 1348 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1353 "perly.y" +#line 1354 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1370 "perly.y" +#line 1371 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1374 "perly.y" +#line 1375 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1378 "perly.y" +#line 1379 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1384 "perly.y" +#line 1385 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1390 "perly.y" +#line 1391 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1392 "perly.y" +#line 1393 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1396 "perly.y" +#line 1397 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1401 "perly.y" +#line 1402 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1406 "perly.y" +#line 1407 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1411 "perly.y" +#line 1412 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1416 "perly.y" +#line 1417 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1418 "perly.y" +#line 1419 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1420 "perly.y" +#line 1421 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1423 "perly.y" +#line 1424 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y + * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 405a8879cbe6..8351e92092f3 100644 --- a/perly.h +++ b/perly.h @@ -67,87 +67,88 @@ extern int yydebug; PERLY_BRACE_CLOSE = 266, PERLY_BRACKET_OPEN = 267, PERLY_BRACKET_CLOSE = 268, - PERLY_SEMICOLON = 269, - BAREWORD = 270, - METHOD = 271, - FUNCMETH = 272, - THING = 273, - PMFUNC = 274, - PRIVATEREF = 275, - QWLIST = 276, - FUNC0OP = 277, - FUNC0SUB = 278, - UNIOPSUB = 279, - LSTOPSUB = 280, - PLUGEXPR = 281, - PLUGSTMT = 282, - LABEL = 283, - FORMAT = 284, - SUB = 285, - SIGSUB = 286, - ANONSUB = 287, - ANON_SIGSUB = 288, - PACKAGE = 289, - USE = 290, - WHILE = 291, - UNTIL = 292, - IF = 293, - UNLESS = 294, - ELSE = 295, - ELSIF = 296, - CONTINUE = 297, - FOR = 298, - GIVEN = 299, - WHEN = 300, - DEFAULT = 301, - LOOPEX = 302, - DOTDOT = 303, - YADAYADA = 304, - FUNC0 = 305, - FUNC1 = 306, - FUNC = 307, - UNIOP = 308, - LSTOP = 309, - MULOP = 310, - ADDOP = 311, - DOLSHARP = 312, - DO = 313, - HASHBRACK = 314, - NOAMP = 315, - LOCAL = 316, - MY = 317, - REQUIRE = 318, - COLONATTR = 319, - FORMLBRACK = 320, - FORMRBRACK = 321, - SUBLEXSTART = 322, - SUBLEXEND = 323, - PREC_LOW = 324, - OROP = 325, - DOROP = 326, - ANDOP = 327, - NOTOP = 328, - ASSIGNOP = 329, - OROR = 330, - DORDOR = 331, - ANDAND = 332, - BITOROP = 333, - BITANDOP = 334, - CHEQOP = 335, - NCEQOP = 336, - CHRELOP = 337, - NCRELOP = 338, - SHIFTOP = 339, - MATCHOP = 340, - UMINUS = 341, - REFGEN = 342, - POWOP = 343, - PREINC = 344, - PREDEC = 345, - POSTINC = 346, - POSTDEC = 347, - POSTJOIN = 348, - ARROW = 349 + PERLY_DOT = 269, + PERLY_SEMICOLON = 270, + BAREWORD = 271, + METHOD = 272, + FUNCMETH = 273, + THING = 274, + PMFUNC = 275, + PRIVATEREF = 276, + QWLIST = 277, + FUNC0OP = 278, + FUNC0SUB = 279, + UNIOPSUB = 280, + LSTOPSUB = 281, + PLUGEXPR = 282, + PLUGSTMT = 283, + LABEL = 284, + FORMAT = 285, + SUB = 286, + SIGSUB = 287, + ANONSUB = 288, + ANON_SIGSUB = 289, + PACKAGE = 290, + USE = 291, + WHILE = 292, + UNTIL = 293, + IF = 294, + UNLESS = 295, + ELSE = 296, + ELSIF = 297, + CONTINUE = 298, + FOR = 299, + GIVEN = 300, + WHEN = 301, + DEFAULT = 302, + LOOPEX = 303, + DOTDOT = 304, + YADAYADA = 305, + FUNC0 = 306, + FUNC1 = 307, + FUNC = 308, + UNIOP = 309, + LSTOP = 310, + MULOP = 311, + ADDOP = 312, + DOLSHARP = 313, + DO = 314, + HASHBRACK = 315, + NOAMP = 316, + LOCAL = 317, + MY = 318, + REQUIRE = 319, + COLONATTR = 320, + FORMLBRACK = 321, + FORMRBRACK = 322, + SUBLEXSTART = 323, + SUBLEXEND = 324, + PREC_LOW = 325, + OROP = 326, + DOROP = 327, + ANDOP = 328, + NOTOP = 329, + ASSIGNOP = 330, + OROR = 331, + DORDOR = 332, + ANDAND = 333, + BITOROP = 334, + BITANDOP = 335, + CHEQOP = 336, + NCEQOP = 337, + CHRELOP = 338, + NCRELOP = 339, + SHIFTOP = 340, + MATCHOP = 341, + UMINUS = 342, + REFGEN = 343, + POWOP = 344, + PREINC = 345, + PREDEC = 346, + POSTINC = 347, + POSTDEC = 348, + POSTJOIN = 349, + ARROW = 350 }; #endif @@ -199,6 +200,6 @@ int yyparse (void); /* Generated from: - * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y + * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 363a63f198aa..479637a35762 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3331 +#define YYLAST 3315 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 349 +#define YYMAXUTOK 350 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -34,7 +34,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 96, 2, 2, 109, 13, 14, 2, - 108, 107, 110, 11, 81, 10, 16, 111, 2, 2, + 108, 107, 110, 11, 81, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, 2, 15, 2, 83, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,51 +56,52 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 17, 18, 19, 20, 21, - 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, - 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, - 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, - 72, 73, 74, 75, 76, 77, 78, 79, 80, 82, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 98, 99, 100, 101, 102, 103, 104, 105, 106 + 5, 6, 7, 8, 9, 16, 17, 18, 19, 20, + 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, + 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, + 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, + 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, + 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 98, 99, 100, 101, 102, 103, 104, 105, + 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 127, 127, 126, 138, 137, 148, 147, 161, 160, - 174, 173, 187, 186, 197, 196, 209, 217, 225, 229, - 237, 243, 244, 254, 255, 264, 268, 272, 279, 289, - 291, 304, 301, 325, 320, 341, 349, 348, 357, 363, - 369, 374, 376, 378, 385, 393, 395, 392, 412, 417, - 424, 423, 438, 446, 452, 459, 458, 473, 477, 482, - 490, 508, 509, 513, 517, 519, 521, 523, 525, 527, - 529, 532, 538, 539, 544, 555, 556, 562, 568, 569, - 574, 577, 581, 586, 590, 594, 595, 599, 605, 610, - 615, 616, 621, 622, 627, 628, 630, 635, 637, 649, - 650, 655, 657, 661, 681, 682, 684, 690, 755, 757, - 763, 765, 769, 775, 776, 781, 782, 786, 790, 790, - 858, 859, 864, 875, 876, 879, 890, 892, 894, 896, - 900, 902, 907, 911, 915, 919, 925, 930, 936, 942, - 944, 946, 949, 948, 959, 960, 964, 968, 971, 976, - 981, 984, 988, 992, 998, 1006, 1013, 1019, 1021, 1023, - 1028, 1030, 1032, 1037, 1039, 1041, 1043, 1045, 1047, 1049, - 1051, 1053, 1055, 1057, 1061, 1063, 1065, 1067, 1071, 1073, - 1077, 1079, 1081, 1083, 1087, 1089, 1094, 1096, 1099, 1101, - 1103, 1106, 1109, 1120, 1123, 1130, 1132, 1134, 1136, 1138, - 1141, 1147, 1149, 1153, 1154, 1155, 1156, 1157, 1159, 1161, - 1163, 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, - 1183, 1185, 1195, 1205, 1215, 1225, 1227, 1229, 1232, 1237, - 1241, 1243, 1245, 1247, 1250, 1252, 1255, 1257, 1259, 1261, - 1263, 1265, 1267, 1269, 1271, 1274, 1276, 1278, 1280, 1282, - 1284, 1288, 1291, 1290, 1303, 1304, 1305, 1309, 1311, 1313, - 1318, 1320, 1323, 1325, 1327, 1332, 1334, 1339, 1340, 1345, - 1346, 1352, 1356, 1357, 1358, 1361, 1362, 1365, 1366, 1369, - 1373, 1377, 1383, 1389, 1391, 1395, 1399, 1400, 1404, 1405, - 1409, 1410, 1415, 1417, 1419, 1422 + 0, 128, 128, 127, 139, 138, 149, 148, 162, 161, + 175, 174, 188, 187, 198, 197, 210, 218, 226, 230, + 238, 244, 245, 255, 256, 265, 269, 273, 280, 290, + 292, 305, 302, 326, 321, 342, 350, 349, 358, 364, + 370, 375, 377, 379, 386, 394, 396, 393, 413, 418, + 425, 424, 439, 447, 453, 460, 459, 474, 478, 483, + 491, 509, 510, 514, 518, 520, 522, 524, 526, 528, + 530, 533, 539, 540, 545, 556, 557, 563, 569, 570, + 575, 578, 582, 587, 591, 595, 596, 600, 606, 611, + 616, 617, 622, 623, 628, 629, 631, 636, 638, 650, + 651, 656, 658, 662, 682, 683, 685, 691, 756, 758, + 764, 766, 770, 776, 777, 782, 783, 787, 791, 791, + 859, 860, 865, 876, 877, 880, 891, 893, 895, 897, + 901, 903, 908, 912, 916, 920, 926, 931, 937, 943, + 945, 947, 950, 949, 960, 961, 965, 969, 972, 977, + 982, 985, 989, 993, 999, 1007, 1014, 1020, 1022, 1024, + 1029, 1031, 1033, 1038, 1040, 1042, 1044, 1046, 1048, 1050, + 1052, 1054, 1056, 1058, 1062, 1064, 1066, 1068, 1072, 1074, + 1078, 1080, 1082, 1084, 1088, 1090, 1095, 1097, 1100, 1102, + 1104, 1107, 1110, 1121, 1124, 1131, 1133, 1135, 1137, 1139, + 1142, 1148, 1150, 1154, 1155, 1156, 1157, 1158, 1160, 1162, + 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, + 1184, 1186, 1196, 1206, 1216, 1226, 1228, 1230, 1233, 1238, + 1242, 1244, 1246, 1248, 1251, 1253, 1256, 1258, 1260, 1262, + 1264, 1266, 1268, 1270, 1272, 1275, 1277, 1279, 1281, 1283, + 1285, 1289, 1292, 1291, 1304, 1305, 1306, 1310, 1312, 1314, + 1319, 1321, 1324, 1326, 1328, 1333, 1335, 1340, 1341, 1346, + 1347, 1353, 1357, 1358, 1359, 1362, 1363, 1366, 1367, 1370, + 1374, 1378, 1384, 1390, 1392, 1396, 1400, 1401, 1405, 1406, + 1410, 1411, 1416, 1418, 1420, 1423 }; #endif @@ -111,30 +112,30 @@ static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", - "'+'", "'@'", "'%'", "'&'", "'='", "'.'", "PERLY_BRACE_OPEN", + "'+'", "'@'", "'%'", "'&'", "'='", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", - "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", - "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", - "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", - "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", - "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", - "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", - "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", - "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", - "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "','", - "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", - "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", - "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", - "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", - "block", "formblock", "remember", "mblock", "mremember", "stmtseq", - "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", - "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", - "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", - "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", - "startformsub", "subname", "proto", "subattrlist", "myattrlist", - "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", - "sigscalarelem", "sigelem", "siglist", "siglistornull", + "PERLY_DOT", "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", + "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", + "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", + "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", + "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", + "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", + "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", + "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", + "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", + "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", + "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", + "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", + "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", + "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", + "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", "mblock", + "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", + "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", + "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", + "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", + "startanonsub", "startformsub", "subname", "proto", "subattrlist", + "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", + "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", @@ -151,21 +152,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 45, 43, 64, 37, 38, 61, 46, 265, 266, 267, - 268, 269, 270, 271, 272, 273, 274, 275, 276, 277, - 278, 279, 280, 281, 282, 283, 284, 285, 286, 287, - 288, 289, 290, 291, 292, 293, 294, 295, 296, 297, - 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, - 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, - 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, - 328, 44, 329, 63, 58, 330, 331, 332, 333, 334, - 335, 336, 337, 338, 339, 340, 33, 126, 341, 342, - 343, 344, 345, 346, 347, 348, 349, 41, 40, 36, + 45, 43, 64, 37, 38, 61, 265, 266, 267, 268, + 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, + 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, + 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, + 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, + 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, + 329, 44, 330, 63, 58, 331, 332, 333, 334, 335, + 336, 337, 338, 339, 340, 341, 33, 126, 342, 343, + 344, 345, 346, 347, 348, 349, 350, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-476) +#define YYPACT_NINF (-487) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -179,64 +180,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 591, -476, -476, -476, -476, -476, -476, -476, 20, -476, - 2965, 50, 1591, 1489, -476, -476, -476, -476, 2965, 2965, - 53, 53, 53, 1971, -476, 53, 53, -476, -476, -7, - -75, -476, 2965, -476, -476, -476, -476, 2965, -19, -3, - -58, 2072, 1878, 53, 2072, 2165, 52, 2965, -2, 2965, - 2965, 2965, 2965, 2965, 2965, 2965, 2258, 53, 53, -39, - 31, -476, 64, -476, -32, 34, 55, 27, -476, -476, - -476, 3133, -476, -476, 42, 121, 144, 154, -476, 125, - 168, 171, 150, -476, -476, -476, -476, -476, -476, 52, - 52, 157, -476, 76, 83, 102, 105, 233, 126, 130, - 50, 245, 198, -476, 248, 2070, 1489, -476, -476, -476, - 672, -476, 5, 775, 153, 153, -476, -476, -476, -476, - -476, -476, -476, -476, 25, 2965, 146, 205, 2965, 173, - 1867, 50, 287, 250, 3133, 218, 2359, 2965, 1878, -476, - 1867, 564, 31, -476, 468, 2965, -476, -476, 1867, 315, - 239, -476, -476, 2965, 1867, 3058, 2460, 267, -476, -476, - -476, 1867, 31, 153, 153, 153, 225, 225, 324, 356, - -476, -476, 2965, 2965, 2965, 2965, 2965, 2965, 2561, -476, - -476, 2965, -476, -476, 2965, 2965, 2965, 2965, 2965, 2965, - 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, 2965, - 2965, 2965, -476, -476, -476, 251, 2662, 2965, 2965, 2965, - 2965, 2965, 2965, 2965, -476, 333, -476, -476, 334, -476, - -476, -476, -476, -476, 259, 22, -476, -476, 254, -476, - -476, -476, -476, 50, -476, -476, 2965, 2965, 2965, 2965, - 2965, 2965, -476, -476, -476, -476, -476, 336, 336, -476, - -476, -476, 283, -476, -476, -476, 2965, 2965, 46, -476, - -476, -476, 250, 343, -476, -476, -476, 366, 292, 263, - 2965, 31, -476, 353, -476, 2763, 153, 267, 140, 141, - 190, -476, 369, 350, -476, 2965, 360, 304, 304, -476, - 3133, 299, 115, -476, 400, 1867, 1950, 3225, 421, 395, - 3133, 3087, 1668, 1668, 1760, 1860, 530, 1950, 1950, 1867, - 1867, 355, 153, 153, 279, 280, 285, 2965, 2965, -476, - 290, 2864, 24, 291, 298, -476, -476, 403, 303, 158, - 319, 162, 325, 166, 332, 877, -476, 378, -476, -476, - 36, 385, 2965, 2965, 2965, 2965, -476, 306, -476, -476, - 300, -476, -476, -476, -476, 1684, 12, -476, 2965, 2965, - -476, -476, -39, -476, -39, -476, -476, -476, -476, -476, - 344, 344, 5, 318, -49, -476, 2965, -476, -476, 320, - -476, -476, -476, -476, 415, -476, 11, 427, -476, -476, - -476, 194, 2965, 414, -476, -476, 2965, -476, -476, -476, - 345, 226, -476, -476, 462, -476, -476, 2965, -476, 419, - -476, 420, -476, 422, -476, 424, -476, -476, -476, 287, - 250, -476, -476, 431, 347, -39, 349, 358, -39, 359, - 354, -476, -476, -476, -476, 362, 446, 342, -476, 2965, - 368, 377, 2965, -476, -476, -476, -476, 2965, 411, -476, - 480, -476, -476, 491, -476, -476, 28, -476, 229, -476, - 3179, 497, -476, -476, 410, -476, -476, -476, -476, 498, - 250, 507, -476, 2965, -476, -476, 512, 512, 2965, 2965, - 512, -476, 425, 428, 512, 512, 3133, -39, -476, -476, - 429, -476, -476, -476, -476, 459, 517, -476, -476, -476, - -476, 527, 512, 512, -476, 48, 48, 458, 460, 198, - 2965, 2965, 512, -476, -476, 979, -476, 1081, -476, -476, - -476, -476, 1183, -476, 198, 198, -476, 512, 469, -476, - -476, 512, 512, -476, 545, 463, 198, -476, -476, 90, - -476, -476, -476, 1285, -476, 2965, 198, 198, -476, 512, - -476, 560, 506, -476, -476, 473, -476, -476, -476, 198, - -476, -476, -476, 512, 1777, -476, 1387, 48, 474, -476, - -476, 512, -476 + 577, -487, -487, -487, -487, -487, -487, -487, 38, -487, + 2949, -4, 1575, 1473, -487, -487, -487, -487, 2949, 2949, + 145, 145, 145, 1955, -487, 145, 145, -487, -487, 23, + -61, -487, 2949, -487, -487, -487, -487, 2949, -41, -6, + -58, 2056, 1862, 145, 2056, 2149, 48, 2949, -2, 2949, + 2949, 2949, 2949, 2949, 2949, 2949, 2242, 145, 145, 376, + 69, -487, 15, -487, 3, 25, 55, 73, -487, -487, + -487, 3117, -487, -487, 84, 14, 64, 122, -487, 163, + 144, 155, 174, -487, -487, -487, -487, -487, -487, 48, + 48, 187, -487, 88, 148, 153, 158, 284, 175, 199, + -4, 232, 222, -487, 261, 1998, 1473, -487, -487, -487, + 656, -487, 5, 759, 558, 558, -487, -487, -487, -487, + -487, -487, -487, -487, 26, 2949, 200, 229, 2949, 214, + 1851, -4, 300, 255, 3117, 225, 2343, 2949, 1862, -487, + 1851, 548, 69, -487, 468, 2949, -487, -487, 1851, 328, + 157, -487, -487, 2949, 1851, 3042, 2444, 275, -487, -487, + -487, 1851, 69, 558, 558, 558, 82, 82, 336, 264, + -487, -487, 2949, 2949, 2949, 2949, 2949, 2949, 2545, -487, + -487, 2949, -487, -487, 2949, 2949, 2949, 2949, 2949, 2949, + 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, + 2949, 2949, -487, -487, -487, 315, 2646, 2949, 2949, 2949, + 2949, 2949, 2949, 2949, -487, 333, -487, -487, 338, -487, + -487, -487, -487, -487, 259, 22, -487, -487, 254, -487, + -487, -487, -487, -4, -487, -487, 2949, 2949, 2949, 2949, + 2949, 2949, -487, -487, -487, -487, -487, 339, 339, -487, + -487, -487, 286, -487, -487, -487, 2949, 2949, 47, -487, + -487, -487, 255, 351, -487, -487, -487, 296, 303, 273, + 2949, 69, -487, 368, -487, 2747, 558, 275, 44, 166, + 306, -487, 330, 364, -487, 2949, 372, 316, 316, -487, + 3117, 186, 80, -487, 355, 1851, 1934, 3209, 421, 343, + 3117, 3071, 1652, 1652, 1744, 1844, 514, 1934, 1934, 1851, + 1851, 395, 558, 558, 294, 305, 310, 2949, 2949, -487, + 311, 2848, 24, 312, 318, -487, -487, 398, 291, 116, + 309, 172, 319, 191, 323, 861, -487, 379, -487, -487, + 58, 391, 2949, 2949, 2949, 2949, -487, 326, -487, -487, + 332, -487, -487, -487, -487, 1668, 12, -487, 2949, 2949, + -487, -487, 376, -487, 376, -487, -487, -487, -487, -487, + 362, 362, 5, 349, -28, -487, 2949, -487, -487, 337, + -487, -487, -487, -487, 401, -487, 21, 415, -487, -487, + -487, 227, 2949, 442, -487, -487, 2949, -487, -487, -487, + 340, 238, -487, -487, 457, -487, -487, 2949, -487, 443, + -487, 444, -487, 446, -487, 448, -487, -487, -487, 300, + 255, -487, -487, 445, 359, 376, 366, 374, 376, 375, + 361, -487, -487, -487, -487, 378, 467, 195, -487, 2949, + 390, 397, 2949, -487, -487, -487, -487, 2949, 431, -487, + 491, -487, -487, 494, -487, -487, 71, -487, 241, -487, + 3163, 498, -487, -487, 410, -487, -487, -487, -487, 507, + 255, 508, -487, 2949, -487, -487, 503, 503, 2949, 2949, + 503, -487, 424, 426, 503, 503, 3117, 376, -487, -487, + 432, -487, -487, -487, -487, 465, 519, -487, -487, -487, + -487, 520, 503, 503, -487, 196, 196, 458, 459, 222, + 2949, 2949, 503, -487, -487, 963, -487, 1065, -487, -487, + -487, -487, 1167, -487, 222, 222, -487, 503, 462, -487, + -487, 503, 503, -487, 557, 480, 222, -487, -487, 36, + -487, -487, -487, 1269, -487, 2949, 222, 222, -487, 503, + -487, 568, 517, -487, -487, 483, -487, -487, -487, 222, + -487, -487, -487, 503, 1761, -487, 1371, 196, 488, -487, + -487, 503, -487 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -307,16 +308,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -476, -476, -476, -476, -476, -476, -476, -476, -476, 43, - -476, -5, -158, -476, -17, -476, 569, 477, 16, -476, - -476, -476, -476, -476, -476, -476, -476, -476, 348, -341, - -475, -95, -468, -476, 80, 258, -303, 38, -476, -21, - 215, -476, 193, 172, -243, 326, 357, -476, -476, 235, - -476, 232, -476, -476, -476, -476, 159, -476, -476, 116, - -476, 142, -8, -37, -476, -476, -476, -476, -476, -476, - -476, -476, -476, -476, -476, -476, 100, -476, -476, 476, - -124, -129, -476, -476, 261, -476, -476, 390, 1, -45, - -42, -476, -476, -476, -476, -476, 51 + -487, -487, -487, -487, -487, -487, -487, -487, -487, 43, + -487, -5, -121, -487, -17, -487, 583, 493, 16, -487, + -487, -487, -487, -487, -487, -487, -487, -487, -27, -341, + -486, -95, -468, -487, 87, 258, -303, 49, -487, -105, + 223, -487, 190, 183, -243, 335, 367, -487, -487, 245, + -487, 249, -487, -487, -487, -487, 170, -487, -487, 128, + -487, 173, -8, -37, -487, -487, -487, -487, -487, -487, + -487, -487, -487, -487, -487, -487, 100, -487, -487, 473, + -124, -129, -487, -487, 289, -487, -487, 422, 1, -45, + -42, -487, -487, -487, -487, -487, 51 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -340,105 +341,83 @@ static const yytype_int16 yydefgoto[] = static const yytype_int16 yytable[] = { 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, - 20, 21, 128, 162, 433, 124, 137, 245, 246, 377, - 16, 119, 119, 119, 20, 21, 119, 119, 103, 274, - 285, 530, 175, 129, 20, 21, 22, 150, 172, 173, - 174, 83, 429, 144, 119, 254, 116, 392, 169, 158, - 138, 117, 435, 421, 84, 440, 441, 422, 119, 119, - 179, 180, 447, 118, 118, 118, 375, 83, 118, 118, - 83, 120, 121, 122, 151, 116, 125, 126, 214, 152, - 117, 176, -261, 177, 139, 118, 118, 147, 142, 135, - 564, 348, 570, 145, 146, 527, 528, 155, 228, -260, - 118, 118, 172, 173, 174, 136, 156, 57, 271, 171, - 279, 551, 175, 280, 247, 552, 142, 184, 114, 115, - 258, 57, 243, 172, 173, 174, 181, 373, 267, 59, - 59, 57, 130, 57, 405, 394, 483, 134, 207, 144, - 208, 140, -290, 231, 148, 182, 183, 154, 282, 161, - 206, 163, 164, 165, 166, 167, 278, 207, -286, 208, - -286, -286, 57, -286, 287, 288, 289, 213, 291, 292, - 294, -288, 178, -288, 260, 507, 508, 471, 410, 218, - 353, 118, 412, 354, 220, 209, 414, 210, 211, 270, - 212, 221, 172, 173, 174, 338, 339, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, -288, 535, -288, - 222, -262, -264, 223, 457, 342, 343, 344, 345, 347, + 20, 21, 83, 162, 433, 124, 137, 245, 246, 377, + 530, 119, 119, 119, 20, 21, 119, 119, 103, 274, + 207, 176, 208, 177, 20, 21, 22, 150, 16, 285, + 83, 128, 429, 144, 119, 254, 116, 129, 169, 158, + 138, 117, 435, 175, 84, 440, 441, 551, 119, 119, + 207, 552, 208, 118, 118, 118, 375, 135, 118, 118, + 151, 120, 121, 122, 421, 152, 125, 126, 214, 422, + -286, 570, -286, 447, 139, 118, 118, 147, 142, 392, + 564, 348, -261, 145, 146, 179, 180, 155, 228, 394, + 118, 118, 136, 172, 173, 174, 156, 57, 271, 171, + 279, 338, 339, 280, 247, -262, 142, 181, 114, 115, + 258, 57, 243, 178, 172, 173, 174, 373, 267, 59, + 59, 57, 130, 57, 405, 410, 483, 134, -288, 144, + -288, 140, -260, 231, 148, 182, 183, 154, 282, 161, + 175, 163, 164, 165, 166, 167, 278, 172, 173, 174, + 209, 83, 210, 184, 287, 288, 289, 116, 291, 292, + 294, 211, 117, 212, 260, 507, 508, 471, 273, -290, + 353, 118, -286, 354, -286, -291, -291, -291, 205, 270, + 213, 412, 206, 172, 173, 174, 220, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 393, 535, 218, + 414, 365, 366, 367, 368, 342, 343, 344, 345, 347, 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, 229, 172, 173, 174, 230, 172, - 173, 174, 555, 172, 173, 174, 462, 233, 59, 492, - 132, 133, 449, 201, 256, 276, 202, 203, 204, 205, - 273, -263, 384, 314, 315, 316, 232, 387, 317, 235, - 318, 172, 173, 174, 319, 290, 360, 391, 464, 257, - 259, 295, 216, 217, 296, 297, 298, 299, 300, 301, + 362, 362, 362, 362, 172, 173, 174, -264, 236, 237, + 238, 239, 555, 527, 528, 240, 457, 241, 59, 172, + 173, 174, 449, 232, 57, 276, 221, 462, 132, 133, + 492, 222, 384, 172, 173, 174, 223, 387, 172, 173, + 174, 233, 172, 173, 174, 290, 360, 391, 464, 216, + 217, 295, 235, 229, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 224, 172, 173, 174, 172, 173, 174, 400, - 401, 353, 261, 404, 354, 320, 172, 173, 174, 506, - 393, 263, 509, 119, 409, 265, 513, 514, -291, -291, - -291, 205, 225, 272, 425, 364, 428, 428, 283, 142, - 411, 226, 57, 285, 524, 525, 413, 437, 431, 501, - 428, 428, 439, 415, 536, 336, 340, 352, 346, 321, - 322, 323, 357, 369, 372, 118, 461, 382, 378, 544, - 383, 385, 450, 546, 547, 390, 172, 173, 174, 392, - 172, 173, 174, 174, 458, 236, 237, 238, 239, 397, - 398, 559, 240, 417, 241, 399, 172, 173, 174, 59, - 402, 406, 172, 173, 174, 567, 407, 423, 432, 172, - 173, 174, 469, 572, 533, 57, 472, 186, 187, 172, - 173, 174, 172, 173, 174, 446, 442, 479, 452, 541, - 542, 428, 459, 172, 173, 174, 142, 465, 466, 487, - 467, 550, 468, 172, 173, 174, 172, 173, 174, -83, - 200, 556, 557, 473, 474, 201, 475, 186, 202, 203, - 204, 205, 478, 286, 565, 476, 477, 481, -215, 480, - 428, 428, 515, 381, 517, 484, 389, 172, 173, 174, - 172, 173, 174, 522, 485, 207, 488, 208, -215, -215, - 200, 450, 172, 173, 174, 201, 460, 489, 202, 203, - 204, 205, 425, 428, 172, 173, 174, 395, 491, 543, - 408, -215, -215, -215, -215, 493, 200, 494, -215, 495, - -215, 201, 455, -215, 202, 203, 204, 205, 497, 504, - -215, -215, 518, 511, 456, 512, 516, 428, 519, 172, - 173, 174, 486, -215, 566, -215, -215, -215, 523, -215, + 312, 313, -83, 257, 172, 173, 174, 230, 256, 400, + 401, 353, 409, 404, 354, 172, 173, 174, 172, 173, + 174, 259, -288, 119, -288, 261, 263, 314, 315, 316, + 411, 317, 265, 318, 425, 364, 428, 428, 319, 142, + 413, 172, 173, 174, 415, 272, 283, 437, 431, 501, + 428, 428, 439, 224, 285, 336, 506, 352, 346, 509, + 340, 461, 357, 513, 514, 118, 369, 372, 172, 173, + 174, 286, 450, 172, 173, 174, 378, -263, 382, 320, + 383, 524, 525, 225, 458, 385, 172, 173, 174, 390, + 392, 536, 226, 57, 417, 174, 172, 173, 174, 59, + 172, 173, 174, 381, 397, 186, 544, 172, 173, 174, + 546, 547, 469, 423, 533, 398, 472, 172, 173, 174, + 399, 402, 406, 321, 322, 323, 407, 479, 559, 541, + 542, 428, 172, 173, 174, 57, 142, 389, 200, 487, + 432, 550, 567, 201, 442, 452, 202, 203, 204, 205, + 572, 556, 557, 172, 173, 174, 446, 186, 187, 459, + 465, 466, 395, 467, 565, 468, 474, 473, -215, 478, + 428, 428, 515, 475, 517, 172, 173, 174, 172, 173, + 174, 476, 477, 522, 207, 480, 208, -215, 481, -215, + 200, 450, 172, 173, 174, 201, 460, 484, 202, 203, + 204, 205, 425, 428, 485, 408, 488, 489, 455, 543, + 491, -215, -215, -215, -215, 493, 200, 494, -215, 504, + -215, 201, 456, -215, 202, 203, 204, 205, 495, 497, + -215, -215, 511, 512, 172, 173, 174, 428, 518, 516, + 519, 523, 486, -215, 566, -215, -215, -215, -254, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -254, 531, 548, 532, -215, 463, - 549, -215, -215, -215, -215, -215, 560, 545, 561, -215, - 563, 571, 107, 242, -254, -254, 365, 366, 367, 368, - 534, 470, 186, 187, 1, 2, 3, 4, 5, 6, - 7, 426, 568, 388, 445, 371, 444, -254, -254, -254, - -254, 490, 521, 499, -254, 351, -254, 438, 0, -254, - 195, 196, 197, 198, 199, 200, -254, -254, 0, 0, - 201, 277, 0, 202, 203, 204, 205, 0, 0, -254, - 0, -254, -254, -254, 0, -254, -254, -254, -254, -254, + -215, -215, -215, -215, 463, 531, 532, -254, -215, -254, + 545, -215, -215, -215, -215, -215, 186, 187, 548, -215, + 1, 2, 3, 4, 5, 6, 7, 549, 560, 561, + 563, -254, -254, -254, -254, 571, 107, 534, -254, 242, + -254, 426, 470, -254, 195, 196, 197, 198, 199, 200, + -254, -254, 388, 568, 201, 371, 444, 202, 203, 204, + 205, 445, 490, -254, 521, -254, -254, -254, 277, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - 0, 0, 0, 0, -254, 0, 0, -254, -254, -254, - -254, -254, -13, 85, 0, -254, 0, 0, 0, 0, - 0, 0, 18, 19, 20, 21, 22, 0, 0, 83, - 0, 23, 0, 86, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, - 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, -3, 85, 0, 0, 0, - 56, 57, 58, 0, 0, 18, 19, 20, 21, 22, - 0, 0, 83, 0, 23, 0, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, - 21, 22, 0, 0, 83, 416, 23, 0, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + -254, -254, -254, -254, 499, 438, 0, 351, -254, 0, + 0, -254, -254, -254, -254, -254, -13, 85, 201, -254, + 0, 202, 203, 204, 205, 0, 18, 19, 20, 21, + 22, 0, 83, 0, 23, 0, 0, 86, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, + 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, - 19, 20, 21, 22, 0, 0, 83, 537, 23, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, -3, + 85, 0, 0, 0, 56, 57, 58, 0, 0, 18, + 19, 20, 21, 22, 0, 83, 0, 23, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, @@ -448,8 +427,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 22, 0, 0, 83, 538, - 23, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 0, 18, 19, 20, 21, 22, 0, 83, 416, 23, + 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, @@ -458,8 +437,8 @@ static const yytype_int16 yytable[] = 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 57, 58, 0, 18, 19, 20, 21, 22, 0, 0, - 83, 540, 23, 0, 86, 24, 25, 26, 27, 28, + 57, 58, 0, 18, 19, 20, 21, 22, 0, 83, + 537, 23, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, @@ -469,7 +448,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, - 0, 0, 83, 554, 23, 0, 86, 24, 25, 26, + 0, 83, 538, 23, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, @@ -479,17 +458,17 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, - 21, 22, 0, 0, 83, 0, 23, 0, 86, 24, + 21, 22, 0, 83, 540, 23, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, - 19, 20, 21, 22, 0, 0, 83, 0, 23, 0, + 19, 20, 21, 22, 0, 83, 554, 23, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, @@ -499,85 +478,86 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 22, 0, 0, 83, 0, - 23, 0, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, + 0, 18, 19, 20, 21, 22, 0, 83, 0, 23, + 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 48, 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 85, 0, 51, 52, 0, - 53, 0, 54, 55, 18, 19, 20, 21, 22, 56, - 57, 58, 0, 23, 0, -78, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 186, 187, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 85, 0, - 51, 52, 0, 53, 0, 54, 55, 18, 19, 20, - 21, 22, 56, 57, 58, 0, 23, 0, 0, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 50, 0, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, -78, 56, 57, 58, 18, 19, - 20, 21, 22, 0, 0, 83, 0, 23, 0, 0, - 141, 25, 26, 27, 28, 117, 29, 30, 31, 32, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, + 57, 58, 0, 18, 19, 20, 21, 22, 0, 83, + 0, 23, 0, 0, 86, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, + 0, 83, 0, 23, 0, 0, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 0, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, + 20, 21, 22, 56, 57, 58, 23, 0, 0, -78, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 186, 187, 0, 0, 0, 0, 0, 186, - 187, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 50, 0, - 201, 199, 200, 202, 203, 204, 205, 201, 0, 0, - 202, 203, 204, 205, 51, 52, 0, 53, 0, 54, - 55, 18, 19, 20, 21, 22, 56, 57, 58, 0, - 23, 123, 0, 24, 25, 26, 27, 28, 0, 29, + 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, + 55, 18, 19, 20, 21, 22, 56, 57, 58, 23, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 186, 187, 0, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 50, 0, 202, 203, 204, 205, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 83, - 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, + 48, 49, 193, 194, 195, 196, 197, 198, 199, 200, + 0, 50, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, -78, 56, + 57, 58, 18, 19, 20, 21, 22, 0, 83, 0, + 23, 0, 0, 0, 141, 25, 26, 27, 28, 117, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 236, 237, 238, 239, 0, 0, 0, - 240, 0, 241, 0, 0, 0, 37, 0, 0, 38, + 0, 35, 36, 0, 0, 0, 186, 187, 0, 0, + 0, 0, 0, 186, 187, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 172, 173, 174, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 47, 48, 49, 194, 195, 196, 197, 198, 199, 200, + 0, 0, 50, 0, 201, 199, 200, 202, 203, 204, + 205, 201, 0, 0, 202, 203, 204, 205, 51, 52, 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, - 56, 57, 58, 0, 23, 0, 149, 24, 25, 26, + 56, 57, 58, 23, 123, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 35, 36, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 197, 198, 199, 200, + 0, 0, 0, 0, 201, 50, 0, 202, 203, 204, + 205, 236, 237, 238, 239, 0, 0, 0, 240, 0, + 241, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, + 22, 0, 83, 0, 23, 172, 173, 174, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 20, 21, 22, 56, 57, 58, 0, 23, 0, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 168, 56, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 0, 23, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 20, 21, 22, 56, 57, 58, 23, 0, 0, + 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, @@ -585,29 +565,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 266, 56, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 0, 0, 23, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 281, 56, 57, - 58, 18, 19, 20, 21, 22, 0, 0, 0, 0, - 23, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 0, - 0, 23, 0, 0, 24, 25, 26, 27, 28, 0, + 54, 55, 18, 19, 20, 21, 22, 56, 57, 58, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -615,9 +574,9 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 168, 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 0, 0, 23, 0, 0, 24, 25, 26, 27, 28, + 0, 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -626,8 +585,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 386, 56, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 0, 0, 23, 0, 0, 24, 25, 26, 27, + 266, 56, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 0, 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -636,8 +595,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 403, 56, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 0, 0, 23, 0, 0, 24, 25, 26, + 0, 281, 56, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 0, 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -645,138 +604,156 @@ static const yytype_int16 yytable[] = 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 20, 21, 22, 56, 57, 58, 0, 23, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 293, 56, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 0, 23, 0, 0, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 326, 56, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 0, 23, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 386, 56, 57, 58, 18, 19, + 20, 21, 22, 0, 0, 0, 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 275, 57, 58, 188, - 189, 396, 190, 191, 192, 193, 194, 195, 196, 197, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 403, 56, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 0, 23, 0, 0, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 18, 19, 20, 21, 22, 56, 57, 58, + 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 185, 0, 0, 0, + 0, 0, 0, 186, 187, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, + 275, 57, 58, 188, 189, 396, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 188, + 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, + 0, 0, 0, 0, 0, 0, 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, + 0, 0, 0, 201, -291, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 189, 0, 190, 191, 192, 193, 194, 195, + 0, 0, 0, 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, - -291, 0, 202, 203, 204, 205, 0, 186, 187, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205 + 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, - 12, 13, 19, 50, 355, 23, 74, 12, 13, 262, - 0, 20, 21, 22, 12, 13, 25, 26, 12, 153, - 19, 506, 81, 108, 12, 13, 14, 45, 77, 78, - 79, 17, 345, 42, 43, 20, 22, 19, 56, 48, - 108, 27, 355, 17, 11, 358, 359, 21, 57, 58, - 92, 93, 111, 20, 21, 22, 20, 17, 25, 26, - 17, 20, 21, 22, 22, 22, 25, 26, 83, 27, - 27, 17, 71, 19, 41, 42, 43, 44, 125, 108, - 558, 69, 567, 42, 43, 47, 48, 99, 97, 71, - 57, 58, 77, 78, 79, 108, 108, 109, 145, 58, - 155, 21, 81, 155, 109, 25, 153, 90, 18, 19, - 128, 109, 106, 77, 78, 79, 92, 256, 136, 137, - 138, 109, 32, 109, 110, 20, 439, 37, 17, 138, - 19, 41, 17, 100, 44, 90, 91, 47, 156, 49, - 108, 51, 52, 53, 54, 55, 155, 17, 17, 19, - 19, 17, 109, 19, 172, 173, 174, 17, 176, 177, - 178, 17, 108, 19, 131, 478, 479, 420, 20, 22, - 225, 138, 20, 225, 108, 17, 20, 19, 17, 138, - 19, 108, 77, 78, 79, 216, 217, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 17, 511, 19, - 108, 71, 71, 108, 20, 220, 221, 222, 223, 224, + 12, 13, 16, 50, 355, 23, 74, 12, 13, 262, + 506, 20, 21, 22, 12, 13, 25, 26, 12, 153, + 16, 16, 18, 18, 12, 13, 14, 45, 0, 18, + 16, 18, 345, 42, 43, 19, 22, 108, 56, 48, + 108, 27, 355, 81, 11, 358, 359, 21, 57, 58, + 16, 25, 18, 20, 21, 22, 19, 108, 25, 26, + 22, 20, 21, 22, 16, 27, 25, 26, 83, 21, + 16, 567, 18, 111, 41, 42, 43, 44, 125, 18, + 558, 69, 71, 42, 43, 92, 93, 99, 97, 19, + 57, 58, 108, 77, 78, 79, 108, 109, 145, 58, + 155, 216, 217, 155, 109, 71, 153, 92, 18, 19, + 128, 109, 106, 108, 77, 78, 79, 256, 136, 137, + 138, 109, 32, 109, 110, 19, 439, 37, 16, 138, + 18, 41, 71, 100, 44, 90, 91, 47, 156, 49, + 81, 51, 52, 53, 54, 55, 155, 77, 78, 79, + 16, 16, 18, 90, 172, 173, 174, 22, 176, 177, + 178, 16, 27, 18, 131, 478, 479, 420, 21, 16, + 225, 138, 16, 225, 18, 103, 104, 105, 106, 138, + 16, 19, 108, 77, 78, 79, 108, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 21, 511, 22, + 19, 238, 239, 240, 241, 220, 221, 222, 223, 224, 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 108, 77, 78, 79, 108, 77, - 78, 79, 545, 77, 78, 79, 20, 49, 256, 20, - 35, 36, 376, 100, 108, 155, 103, 104, 105, 106, - 21, 71, 270, 12, 13, 14, 21, 275, 17, 21, - 19, 77, 78, 79, 23, 175, 233, 285, 407, 74, - 107, 181, 89, 90, 184, 185, 186, 187, 188, 189, + 238, 239, 240, 241, 77, 78, 79, 71, 43, 44, + 45, 46, 545, 47, 48, 50, 19, 52, 256, 77, + 78, 79, 376, 21, 109, 155, 108, 19, 35, 36, + 19, 108, 270, 77, 78, 79, 108, 275, 77, 78, + 79, 49, 77, 78, 79, 175, 233, 285, 407, 89, + 90, 181, 21, 108, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 69, 77, 78, 79, 77, 78, 79, 317, - 318, 356, 25, 321, 356, 64, 77, 78, 79, 477, - 21, 71, 480, 322, 21, 107, 484, 485, 103, 104, - 105, 106, 99, 18, 342, 343, 344, 345, 71, 376, - 21, 108, 109, 19, 502, 503, 21, 355, 347, 473, - 358, 359, 357, 21, 512, 22, 22, 356, 99, 108, - 109, 110, 108, 27, 81, 322, 21, 75, 25, 527, - 107, 18, 377, 531, 532, 25, 77, 78, 79, 19, - 77, 78, 79, 79, 392, 43, 44, 45, 46, 110, - 110, 549, 50, 15, 52, 110, 77, 78, 79, 407, - 110, 110, 77, 78, 79, 563, 108, 22, 108, 77, - 78, 79, 417, 571, 509, 109, 421, 62, 63, 77, - 78, 79, 77, 78, 79, 107, 82, 432, 108, 524, - 525, 439, 18, 77, 78, 79, 473, 18, 18, 447, - 18, 536, 18, 77, 78, 79, 77, 78, 79, 107, - 95, 546, 547, 22, 107, 100, 107, 62, 103, 104, - 105, 106, 108, 107, 559, 107, 107, 21, 0, 107, - 478, 479, 489, 107, 491, 107, 107, 77, 78, 79, - 77, 78, 79, 500, 107, 17, 75, 19, 20, 21, - 95, 496, 77, 78, 79, 100, 396, 17, 103, 104, - 105, 106, 510, 511, 77, 78, 79, 107, 17, 526, - 107, 43, 44, 45, 46, 18, 95, 107, 50, 21, - 52, 100, 107, 55, 103, 104, 105, 106, 21, 17, - 62, 63, 73, 108, 107, 107, 107, 545, 21, 77, - 78, 79, 442, 75, 561, 77, 78, 79, 21, 81, + 200, 201, 107, 74, 77, 78, 79, 108, 108, 317, + 318, 356, 21, 321, 356, 77, 78, 79, 77, 78, + 79, 107, 16, 322, 18, 25, 71, 12, 13, 14, + 21, 16, 107, 18, 342, 343, 344, 345, 23, 376, + 21, 77, 78, 79, 21, 17, 71, 355, 347, 473, + 358, 359, 357, 69, 18, 22, 477, 356, 99, 480, + 22, 21, 108, 484, 485, 322, 27, 81, 77, 78, + 79, 107, 377, 77, 78, 79, 25, 71, 75, 64, + 107, 502, 503, 99, 392, 17, 77, 78, 79, 25, + 18, 512, 108, 109, 15, 79, 77, 78, 79, 407, + 77, 78, 79, 107, 110, 62, 527, 77, 78, 79, + 531, 532, 417, 22, 509, 110, 421, 77, 78, 79, + 110, 110, 110, 108, 109, 110, 108, 432, 549, 524, + 525, 439, 77, 78, 79, 109, 473, 107, 95, 447, + 108, 536, 563, 100, 82, 108, 103, 104, 105, 106, + 571, 546, 547, 77, 78, 79, 107, 62, 63, 17, + 17, 17, 107, 17, 559, 17, 107, 22, 0, 108, + 478, 479, 489, 107, 491, 77, 78, 79, 77, 78, + 79, 107, 107, 500, 16, 107, 18, 19, 21, 21, + 95, 496, 77, 78, 79, 100, 396, 107, 103, 104, + 105, 106, 510, 511, 107, 107, 75, 16, 107, 526, + 16, 43, 44, 45, 46, 17, 95, 107, 50, 16, + 52, 100, 107, 55, 103, 104, 105, 106, 21, 21, + 62, 63, 108, 107, 77, 78, 79, 545, 73, 107, + 21, 21, 442, 75, 561, 77, 78, 79, 0, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 0, 107, 21, 107, 100, 107, - 107, 103, 104, 105, 106, 107, 16, 108, 72, 111, - 107, 107, 13, 106, 20, 21, 238, 239, 240, 241, - 510, 419, 62, 63, 3, 4, 5, 6, 7, 8, - 9, 343, 564, 277, 372, 248, 371, 43, 44, 45, - 46, 452, 496, 471, 50, 225, 52, 356, -1, 55, - 90, 91, 92, 93, 94, 95, 62, 63, -1, -1, - 100, 155, -1, 103, 104, 105, 106, -1, -1, 75, - -1, 77, 78, 79, -1, 81, 82, 83, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, - -1, -1, -1, -1, 100, -1, -1, 103, 104, 105, - 106, 107, 0, 1, -1, 111, -1, -1, -1, -1, - -1, -1, 10, 11, 12, 13, 14, -1, -1, 17, - -1, 19, -1, 21, 22, 23, 24, 25, 26, -1, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, - -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, - 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 0, 1, -1, -1, -1, - 108, 109, 110, -1, -1, 10, 11, 12, 13, 14, - -1, -1, 17, -1, 19, -1, 21, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, - -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, - -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, - 13, 14, -1, -1, 17, 18, 19, -1, 21, 22, - 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, - 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, - -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, + 92, 93, 94, 95, 107, 107, 107, 19, 100, 21, + 108, 103, 104, 105, 106, 107, 62, 63, 21, 111, + 3, 4, 5, 6, 7, 8, 9, 107, 20, 72, + 107, 43, 44, 45, 46, 107, 13, 510, 50, 106, + 52, 343, 419, 55, 90, 91, 92, 93, 94, 95, + 62, 63, 277, 564, 100, 248, 371, 103, 104, 105, + 106, 372, 452, 75, 496, 77, 78, 79, 155, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 471, 356, -1, 225, 100, -1, + -1, 103, 104, 105, 106, 107, 0, 1, 100, 111, + -1, 103, 104, 105, 106, -1, 10, 11, 12, 13, + 14, -1, 16, -1, 18, -1, -1, 21, 22, 23, + 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, + 54, -1, 56, 57, 58, 59, 60, 61, -1, -1, + 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, - 11, 12, 13, 14, -1, -1, 17, 18, 19, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 0, + 1, -1, -1, -1, 108, 109, 110, -1, -1, 10, + 11, 12, 13, 14, -1, 16, -1, 18, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, @@ -786,8 +763,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, 14, -1, -1, 17, 18, - 19, -1, 21, 22, 23, 24, 25, 26, -1, 28, + -1, 10, 11, 12, 13, 14, -1, 16, 17, 18, + -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, @@ -796,8 +773,8 @@ static const yytype_int16 yycheck[] = -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, - 109, 110, -1, 10, 11, 12, 13, 14, -1, -1, - 17, 18, 19, -1, 21, 22, 23, 24, 25, 26, + 109, 110, -1, 10, 11, 12, 13, 14, -1, 16, + 17, 18, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, @@ -807,7 +784,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, - -1, -1, 17, 18, 19, -1, 21, 22, 23, 24, + -1, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, @@ -817,17 +794,17 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, - 13, 14, -1, -1, 17, -1, 19, -1, 21, 22, + 13, 14, -1, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, - 73, -1, -1, -1, -1, -1, -1, 80, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, - 11, 12, 13, 14, -1, -1, 17, -1, 19, -1, + 11, 12, 13, 14, -1, 16, 17, 18, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, @@ -837,85 +814,86 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, 14, -1, -1, 17, -1, - 19, -1, 21, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, 34, -1, 36, 37, 38, + -1, 10, 11, 12, 13, 14, -1, 16, -1, 18, + -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + 69, 70, -1, -1, 73, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 1, -1, 96, 97, -1, - 99, -1, 101, 102, 10, 11, 12, 13, 14, 108, - 109, 110, -1, 19, -1, 21, 22, 23, 24, 25, - 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, - -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, - 62, 63, -1, -1, -1, -1, -1, -1, 54, -1, - -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, - 66, 67, 68, 69, 70, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 80, -1, -1, -1, 100, -1, - -1, 103, 104, 105, 106, -1, -1, -1, 1, -1, - 96, 97, -1, 99, -1, 101, 102, 10, 11, 12, - 13, 14, 108, 109, 110, -1, 19, -1, -1, 22, - 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, - 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, - -1, -1, 62, 63, -1, -1, -1, -1, -1, -1, - -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, - -1, 64, 65, 66, 67, 68, 69, 70, 88, 89, - 90, 91, 92, 93, 94, 95, -1, 80, -1, -1, - 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - 12, 13, 14, -1, -1, 17, -1, 19, -1, -1, - 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, + 109, 110, -1, 10, 11, 12, 13, 14, -1, 16, + -1, 18, -1, -1, 21, 22, 23, 24, 25, 26, + -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, + 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, + 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, + -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, + -1, 16, -1, 18, -1, -1, 21, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, + -1, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, + -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, + 12, 13, 14, 108, 109, 110, 18, -1, -1, 21, + 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, - -1, -1, 62, 63, -1, -1, -1, -1, -1, 62, - 63, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, 89, - 90, 91, 92, 93, 94, 95, -1, -1, 80, -1, - 100, 94, 95, 103, 104, 105, 106, 100, -1, -1, - 103, 104, 105, 106, 96, 97, -1, 99, -1, 101, - 102, 10, 11, 12, 13, 14, 108, 109, 110, -1, - 19, 20, -1, 22, 23, 24, 25, 26, -1, 28, + -1, -1, -1, -1, 62, 63, -1, -1, -1, -1, + -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 80, -1, + -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, + -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, + 102, 10, 11, 12, 13, 14, 108, 109, 110, 18, + -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, - 39, 40, 62, 63, -1, -1, -1, -1, -1, -1, + 39, 40, -1, -1, -1, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, 92, 93, 94, 95, -1, -1, -1, -1, - 100, 80, -1, 103, 104, 105, 106, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, - 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, - -1, 19, -1, -1, 22, 23, 24, 25, 26, -1, + 69, 70, 88, 89, 90, 91, 92, 93, 94, 95, + -1, 80, -1, -1, 100, -1, -1, 103, 104, 105, + 106, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, + 109, 110, 10, 11, 12, 13, 14, -1, 16, -1, + 18, -1, -1, -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, - -1, 39, 40, 43, 44, 45, 46, -1, -1, -1, - 50, -1, 52, -1, -1, -1, 54, -1, -1, 57, + -1, 39, 40, -1, -1, -1, 62, 63, -1, -1, + -1, -1, -1, 62, 63, -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, 77, 78, 79, - -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + 68, 69, 70, 89, 90, 91, 92, 93, 94, 95, + -1, -1, 80, -1, 100, 94, 95, 103, 104, 105, + 106, 100, -1, -1, 103, 104, 105, 106, 96, 97, -1, 99, -1, 101, 102, 10, 11, 12, 13, 14, - 108, 109, 110, -1, 19, -1, 21, 22, 23, 24, + 108, 109, 110, 18, 19, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, - -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, + -1, -1, -1, -1, 39, 40, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, - 12, 13, 14, 108, 109, 110, -1, 19, -1, -1, - 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, - 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, + 65, 66, 67, 68, 69, 70, 92, 93, 94, 95, + -1, -1, -1, -1, 100, 80, -1, 103, 104, 105, + 106, 43, 44, 45, 46, -1, -1, -1, 50, -1, + 52, 96, 97, -1, 99, -1, 101, 102, -1, -1, + -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, + 14, -1, 16, -1, 18, 77, 78, 79, 22, 23, + 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, + -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, + 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, + 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, 13, 14, -1, -1, -1, -1, 19, -1, - -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, 12, 13, 14, 108, 109, 110, 18, -1, -1, + 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, @@ -923,29 +901,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, 13, 14, -1, -1, -1, -1, 19, - -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, - 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, - 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, - 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, - 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, - 110, 10, 11, 12, 13, 14, -1, -1, -1, -1, - 19, -1, -1, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, - 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, 13, 14, -1, -1, -1, - -1, 19, -1, -1, 22, 23, 24, 25, 26, -1, + 101, 102, 10, 11, 12, 13, 14, 108, 109, 110, + 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, @@ -955,7 +912,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, - -1, -1, 19, -1, -1, 22, 23, 24, 25, 26, + -1, 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, @@ -965,7 +922,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - -1, -1, -1, 19, -1, -1, 22, 23, 24, 25, + -1, -1, 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, @@ -975,7 +932,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - -1, -1, -1, -1, 19, -1, -1, 22, 23, 24, + -1, -1, -1, 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, @@ -983,34 +940,74 @@ static const yytype_int16 yycheck[] = 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, - 12, 13, 14, 108, 109, 110, -1, 19, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, + -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, + 14, -1, -1, -1, 18, -1, -1, -1, 22, 23, + 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, + -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, + 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, + -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, + 13, 14, -1, -1, -1, 18, -1, -1, -1, 22, + 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, + 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, + -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, + 12, 13, 14, -1, -1, -1, 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, - -1, -1, 55, -1, -1, -1, -1, -1, -1, 62, - 63, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, -1, 108, 109, 110, 82, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, + 11, 12, 13, 14, -1, -1, -1, 18, -1, -1, + -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, + 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, + 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, 10, 11, 12, 13, 14, 108, 109, 110, + 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, + -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, + 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, + 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 80, -1, -1, -1, 55, -1, -1, -1, + -1, -1, -1, 62, 63, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, + 108, 109, 110, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, + -1, 100, 55, -1, 103, 104, 105, 106, -1, 62, + 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, + 83, -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, 100, 55, -1, 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 82, 83, -1, 85, 86, + -1, -1, -1, -1, -1, -1, 83, -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, 100, 55, -1, 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 83, -1, 85, 86, 87, 88, 89, 90, + -1, -1, -1, -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, 100, - 55, -1, 103, 104, 105, 106, -1, 62, 63, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106 + -1, -1, 103, 104, 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1019,61 +1016,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 14, 19, 22, 23, 24, 25, 26, 28, + 12, 13, 14, 18, 22, 23, 24, 25, 26, 28, 29, 30, 31, 32, 33, 39, 40, 54, 57, 58, 59, 60, 61, 64, 65, 66, 67, 68, 69, 70, 80, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 17, 121, 1, 21, 34, 36, 37, + 205, 206, 207, 16, 121, 1, 21, 34, 36, 37, 38, 41, 42, 43, 44, 45, 46, 50, 51, 52, 53, 56, 121, 130, 141, 174, 35, 128, 129, 130, 126, 168, 169, 126, 188, 188, 22, 27, 121, 200, - 208, 208, 208, 20, 174, 208, 208, 189, 19, 108, + 208, 208, 208, 19, 174, 208, 208, 189, 18, 108, 188, 152, 152, 152, 188, 108, 108, 74, 108, 121, 188, 22, 175, 192, 200, 208, 208, 121, 188, 21, 174, 22, 27, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 77, 78, 79, 81, 17, 19, 108, 92, + 208, 208, 77, 78, 79, 81, 16, 18, 108, 92, 93, 92, 90, 91, 90, 55, 62, 63, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 17, 19, 17, - 19, 17, 19, 17, 123, 153, 154, 154, 22, 151, + 95, 100, 103, 104, 105, 106, 108, 16, 18, 16, + 18, 16, 18, 16, 123, 153, 154, 154, 22, 151, 108, 108, 108, 108, 69, 99, 108, 198, 200, 108, 108, 121, 21, 49, 143, 21, 43, 44, 45, 46, 50, 52, 129, 130, 128, 12, 13, 109, 159, 160, - 162, 163, 164, 165, 20, 192, 108, 74, 174, 107, + 162, 163, 164, 165, 19, 192, 108, 74, 174, 107, 121, 25, 155, 71, 156, 107, 107, 174, 193, 193, - 208, 175, 18, 21, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 71, 157, 19, 107, 174, 174, 174, + 208, 175, 17, 21, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 71, 157, 18, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 12, 13, 14, 17, 19, 23, + 188, 188, 188, 188, 12, 13, 14, 16, 18, 23, 64, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 22, 150, 151, 151, 22, 133, 123, 123, 123, 123, 99, 123, 69, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 27, - 158, 158, 81, 193, 175, 20, 177, 156, 25, 123, - 173, 107, 75, 107, 174, 18, 107, 174, 157, 107, - 25, 174, 19, 21, 20, 107, 84, 110, 110, 110, + 158, 158, 81, 193, 175, 19, 177, 156, 25, 123, + 173, 107, 75, 107, 174, 17, 107, 174, 157, 107, + 25, 174, 18, 21, 19, 107, 84, 110, 110, 110, 174, 174, 110, 107, 174, 110, 110, 108, 107, 21, - 20, 21, 20, 21, 20, 21, 18, 15, 122, 131, - 132, 17, 21, 22, 146, 174, 147, 148, 174, 148, + 19, 21, 19, 21, 19, 21, 17, 15, 122, 131, + 132, 16, 21, 22, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 20, 174, 18, - 188, 21, 20, 107, 193, 18, 18, 18, 18, 123, + 123, 171, 108, 166, 167, 107, 107, 19, 174, 17, + 188, 21, 19, 107, 193, 17, 17, 17, 17, 123, 155, 156, 123, 22, 107, 107, 107, 107, 108, 123, - 107, 21, 136, 148, 107, 107, 188, 174, 75, 17, - 168, 17, 20, 18, 107, 21, 156, 21, 172, 173, - 137, 192, 144, 144, 17, 124, 124, 148, 148, 124, + 107, 21, 136, 148, 107, 107, 188, 174, 75, 16, + 168, 16, 19, 17, 107, 21, 156, 21, 172, 173, + 137, 192, 144, 144, 16, 124, 124, 148, 148, 124, 134, 108, 107, 124, 124, 126, 107, 126, 73, 21, 170, 171, 126, 21, 124, 124, 125, 47, 48, 142, - 142, 107, 107, 143, 146, 148, 124, 18, 18, 127, - 18, 143, 143, 126, 124, 108, 124, 124, 21, 107, - 143, 21, 25, 138, 18, 148, 143, 143, 135, 124, - 16, 72, 139, 107, 144, 143, 126, 124, 149, 73, + 142, 107, 107, 143, 146, 148, 124, 17, 17, 127, + 17, 143, 143, 126, 124, 108, 124, 124, 21, 107, + 143, 21, 25, 138, 17, 148, 143, 143, 135, 124, + 20, 72, 139, 107, 144, 143, 126, 124, 149, 73, 142, 107, 124 }; @@ -1156,30 +1153,30 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1190,6 +1187,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * cb9061f72cc55b8def37b0c0d116182e39ace529272a11fdb5617fc35f969d29 perly.y + * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 929a5a3b9777..eb4ab38d587e 100644 --- a/perly.y +++ b/perly.y @@ -45,11 +45,12 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '-' '+' '@' '%' '&' '=' '.' +%token '-' '+' '@' '%' '&' '=' %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN %token PERLY_BRACKET_CLOSE +%token PERLY_DOT %token PERLY_SEMICOLON %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST @@ -214,7 +215,7 @@ block : PERLY_BRACE_OPEN remember stmtseq PERLY_BRACE_CLOSE ; /* format body */ -formblock: '=' remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON '.' +formblock: '=' remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON PERLY_DOT { if (parser->copline > (line_t)$1) parser->copline = (line_t)$1; $$ = block_end($remember, $formstmtseq); diff --git a/toke.c b/toke.c index ac33aac1c1ef..c14777785de5 100644 --- a/toke.c +++ b/toke.c @@ -390,6 +390,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), + DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -6226,7 +6227,7 @@ yyl_rightcurly(pTHX_ char *s, const U8 formbrack) return yylex(); /* ignore fake brackets */ } - force_next(formbrack ? '.' : PERLY_BRACE_CLOSE); + force_next(formbrack ? PERLY_DOT : PERLY_BRACE_CLOSE); if (formbrack) LEAVE_with_name("lex_format"); if (formbrack == 2) { /* means . where arguments were expected */ force_next(PERLY_SEMICOLON); From db83e45c10af8c06705fef1c3bd933ffa6a5e3f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:04 +0100 Subject: [PATCH 330/503] Distinguish C- and perly- literals - PERLY_EQUAL_SIGN --- perly.act | 536 +++++++++++------------ perly.h | 165 +++---- perly.tab | 1260 +++++++++++++++++++++++++++-------------------------- perly.y | 9 +- toke.c | 3 +- 5 files changed, 994 insertions(+), 979 deletions(-) diff --git a/perly.act b/perly.act index 7b49d522e961..e9246e243c30 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 128 "perly.y" +#line 129 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 133 "perly.y" +#line 134 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 139 "perly.y" +#line 140 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 144 "perly.y" +#line 145 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 149 "perly.y" +#line 150 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 154 "perly.y" +#line 155 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 162 "perly.y" +#line 163 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 167 "perly.y" +#line 168 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 175 "perly.y" +#line 176 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 180 "perly.y" +#line 181 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 188 "perly.y" +#line 189 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 193 "perly.y" +#line 194 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 198 "perly.y" +#line 199 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 203 "perly.y" +#line 204 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 211 "perly.y" +#line 212 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 219 "perly.y" +#line 220 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 226 "perly.y" +#line 227 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 231 "perly.y" +#line 232 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 238 "perly.y" +#line 239 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 244 "perly.y" +#line 245 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 246 "perly.y" +#line 247 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 255 "perly.y" +#line 256 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 257 "perly.y" +#line 258 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 266 "perly.y" +#line 267 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 270 "perly.y" +#line 271 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 274 "perly.y" +#line 275 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 281 "perly.y" +#line 282 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 291 "perly.y" +#line 292 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 293 "perly.y" +#line 294 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 305 "perly.y" +#line 306 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 311 "perly.y" +#line 312 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 326 "perly.y" +#line 327 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 332 "perly.y" +#line 333 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 343 "perly.y" +#line 344 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 350 "perly.y" +#line 351 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 352 "perly.y" +#line 353 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 359 "perly.y" +#line 360 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 365 "perly.y" +#line 366 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 371 "perly.y" +#line 372 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 376 "perly.y" +#line 377 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 378 "perly.y" +#line 379 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 380 "perly.y" +#line 381 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 387 "perly.y" +#line 388 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 394 "perly.y" +#line 395 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 396 "perly.y" +#line 397 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 399 "perly.y" +#line 400 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 414 "perly.y" +#line 415 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 419 "perly.y" +#line 420 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 425 "perly.y" +#line 426 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 427 "perly.y" +#line 428 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 440 "perly.y" +#line 441 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 448 "perly.y" +#line 449 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 454 "perly.y" +#line 455 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 460 "perly.y" +#line 461 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 467 "perly.y" +#line 468 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 475 "perly.y" +#line 476 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 479 "perly.y" +#line 480 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 484 "perly.y" +#line 485 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 492 "perly.y" +#line 493 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 509 "perly.y" +#line 510 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 511 "perly.y" +#line 512 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 519 "perly.y" +#line 520 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 521 "perly.y" +#line 522 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 539 "perly.y" +#line 540 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 541 "perly.y" +#line 542 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 546 "perly.y" +#line 547 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 556 "perly.y" +#line 557 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 558 "perly.y" +#line 559 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 563 "perly.y" +#line 564 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 569 "perly.y" +#line 570 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 575 "perly.y" +#line 576 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 583 "perly.y" +#line 584 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 588 "perly.y" +#line 589 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 592 "perly.y" +#line 593 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 595 "perly.y" +#line 596 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 606 "perly.y" +#line 607 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 611 "perly.y" +#line 612 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 622 "perly.y" +#line 623 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 628 "perly.y" +#line 629 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 630 "perly.y" +#line 631 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 632 "perly.y" +#line 633 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 637 "perly.y" +#line 638 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 639 "perly.y" +#line 640 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 650 "perly.y" +#line 651 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 652 "perly.y" +#line 653 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 657 "perly.y" +#line 658 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 659 "perly.y" +#line 660 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 663 "perly.y" +#line 664 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 682 "perly.y" +#line 683 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 684 "perly.y" +#line 685 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 686 "perly.y" +#line 687 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 692 "perly.y" +#line 693 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 757 "perly.y" +#line 758 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 759 "perly.y" +#line 760 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 765 "perly.y" +#line 766 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 767 "perly.y" +#line 768 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 771 "perly.y" +#line 772 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 776 "perly.y" +#line 777 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 778 "perly.y" +#line 779 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 782 "perly.y" +#line 783 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 788 "perly.y" +#line 789 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 791 "perly.y" +#line 792 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 802 "perly.y" +#line 803 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 859 "perly.y" +#line 860 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 860 "perly.y" +#line 861 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 866 "perly.y" +#line 867 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 876 "perly.y" +#line 877 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 877 "perly.y" +#line 878 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 881 "perly.y" +#line 882 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 892 "perly.y" +#line 893 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 894 "perly.y" +#line 895 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 896 "perly.y" +#line 897 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 902 "perly.y" +#line 903 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 904 "perly.y" +#line 905 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 913 "perly.y" +#line 914 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 917 "perly.y" +#line 918 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 921 "perly.y" +#line 922 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 927 "perly.y" +#line 928 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 932 "perly.y" +#line 933 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 938 "perly.y" +#line 939 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 944 "perly.y" +#line 945 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 946 "perly.y" +#line 947 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 948 "perly.y" +#line 949 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 950 "perly.y" +#line 951 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 953 "perly.y" +#line 954 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 968 "perly.y" +#line 969 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 970 "perly.y" +#line 971 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 973 "perly.y" +#line 974 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 978 "perly.y" +#line 979 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 983 "perly.y" +#line 984 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 986 "perly.y" +#line 987 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 990 "perly.y" +#line 991 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 994 "perly.y" +#line 995 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1000 "perly.y" +#line 1001 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1008 "perly.y" +#line 1009 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1015 "perly.y" +#line 1016 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1021 "perly.y" +#line 1022 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1023 "perly.y" +#line 1024 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1025 "perly.y" +#line 1026 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1030 "perly.y" +#line 1031 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1032 "perly.y" +#line 1033 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1034 "perly.y" +#line 1035 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1039 "perly.y" +#line 1040 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1041 "perly.y" +#line 1042 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1063 "perly.y" +#line 1064 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1065 "perly.y" +#line 1066 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1067 "perly.y" +#line 1068 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1069 "perly.y" +#line 1070 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1073 "perly.y" +#line 1074 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1075 "perly.y" +#line 1076 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1079 "perly.y" +#line 1080 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1081 "perly.y" +#line 1082 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1083 "perly.y" +#line 1084 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1085 "perly.y" +#line 1086 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1089 "perly.y" +#line 1090 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1091 "perly.y" +#line 1092 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1096 "perly.y" +#line 1097 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1098 "perly.y" +#line 1099 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1101 "perly.y" +#line 1102 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1108 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1111 "perly.y" +#line 1112 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1122 "perly.y" +#line 1123 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1125 "perly.y" +#line 1126 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1132 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1134 "perly.y" +#line 1135 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1136 "perly.y" +#line 1137 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1138 "perly.y" +#line 1139 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1140 "perly.y" +#line 1141 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1143 "perly.y" +#line 1144 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1149 "perly.y" +#line 1150 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1151 "perly.y" +#line 1152 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1159 "perly.y" +#line 1160 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1161 "perly.y" +#line 1162 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1187 "perly.y" +#line 1188 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1197 "perly.y" +#line 1198 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1207 "perly.y" +#line 1208 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1217 "perly.y" +#line 1218 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1227 "perly.y" +#line 1228 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1229 "perly.y" +#line 1230 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1231 "perly.y" +#line 1232 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1234 "perly.y" +#line 1235 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1239 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1243 "perly.y" +#line 1244 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1245 "perly.y" +#line 1246 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1290 "perly.y" +#line 1291 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1292 "perly.y" +#line 1293 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1303 "perly.y" +#line 1304 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1311 "perly.y" +#line 1312 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1313 "perly.y" +#line 1314 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1315 "perly.y" +#line 1316 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1320 "perly.y" +#line 1321 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1322 "perly.y" +#line 1323 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1325 "perly.y" +#line 1326 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1327 "perly.y" +#line 1328 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1329 "perly.y" +#line 1330 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1334 "perly.y" +#line 1335 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1336 "perly.y" +#line 1337 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1340 "perly.y" +#line 1341 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1346 "perly.y" +#line 1347 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1348 "perly.y" +#line 1349 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1354 "perly.y" +#line 1355 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1371 "perly.y" +#line 1372 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1375 "perly.y" +#line 1376 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1379 "perly.y" +#line 1380 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1385 "perly.y" +#line 1386 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1391 "perly.y" +#line 1392 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1393 "perly.y" +#line 1394 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1397 "perly.y" +#line 1398 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1402 "perly.y" +#line 1403 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1407 "perly.y" +#line 1408 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1412 "perly.y" +#line 1413 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1417 "perly.y" +#line 1418 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1419 "perly.y" +#line 1420 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1421 "perly.y" +#line 1422 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1424 "perly.y" +#line 1425 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y + * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 8351e92092f3..2dd1e0c4b6b1 100644 --- a/perly.h +++ b/perly.h @@ -68,87 +68,88 @@ extern int yydebug; PERLY_BRACKET_OPEN = 267, PERLY_BRACKET_CLOSE = 268, PERLY_DOT = 269, - PERLY_SEMICOLON = 270, - BAREWORD = 271, - METHOD = 272, - FUNCMETH = 273, - THING = 274, - PMFUNC = 275, - PRIVATEREF = 276, - QWLIST = 277, - FUNC0OP = 278, - FUNC0SUB = 279, - UNIOPSUB = 280, - LSTOPSUB = 281, - PLUGEXPR = 282, - PLUGSTMT = 283, - LABEL = 284, - FORMAT = 285, - SUB = 286, - SIGSUB = 287, - ANONSUB = 288, - ANON_SIGSUB = 289, - PACKAGE = 290, - USE = 291, - WHILE = 292, - UNTIL = 293, - IF = 294, - UNLESS = 295, - ELSE = 296, - ELSIF = 297, - CONTINUE = 298, - FOR = 299, - GIVEN = 300, - WHEN = 301, - DEFAULT = 302, - LOOPEX = 303, - DOTDOT = 304, - YADAYADA = 305, - FUNC0 = 306, - FUNC1 = 307, - FUNC = 308, - UNIOP = 309, - LSTOP = 310, - MULOP = 311, - ADDOP = 312, - DOLSHARP = 313, - DO = 314, - HASHBRACK = 315, - NOAMP = 316, - LOCAL = 317, - MY = 318, - REQUIRE = 319, - COLONATTR = 320, - FORMLBRACK = 321, - FORMRBRACK = 322, - SUBLEXSTART = 323, - SUBLEXEND = 324, - PREC_LOW = 325, - OROP = 326, - DOROP = 327, - ANDOP = 328, - NOTOP = 329, - ASSIGNOP = 330, - OROR = 331, - DORDOR = 332, - ANDAND = 333, - BITOROP = 334, - BITANDOP = 335, - CHEQOP = 336, - NCEQOP = 337, - CHRELOP = 338, - NCRELOP = 339, - SHIFTOP = 340, - MATCHOP = 341, - UMINUS = 342, - REFGEN = 343, - POWOP = 344, - PREINC = 345, - PREDEC = 346, - POSTINC = 347, - POSTDEC = 348, - POSTJOIN = 349, - ARROW = 350 + PERLY_EQUAL_SIGN = 270, + PERLY_SEMICOLON = 271, + BAREWORD = 272, + METHOD = 273, + FUNCMETH = 274, + THING = 275, + PMFUNC = 276, + PRIVATEREF = 277, + QWLIST = 278, + FUNC0OP = 279, + FUNC0SUB = 280, + UNIOPSUB = 281, + LSTOPSUB = 282, + PLUGEXPR = 283, + PLUGSTMT = 284, + LABEL = 285, + FORMAT = 286, + SUB = 287, + SIGSUB = 288, + ANONSUB = 289, + ANON_SIGSUB = 290, + PACKAGE = 291, + USE = 292, + WHILE = 293, + UNTIL = 294, + IF = 295, + UNLESS = 296, + ELSE = 297, + ELSIF = 298, + CONTINUE = 299, + FOR = 300, + GIVEN = 301, + WHEN = 302, + DEFAULT = 303, + LOOPEX = 304, + DOTDOT = 305, + YADAYADA = 306, + FUNC0 = 307, + FUNC1 = 308, + FUNC = 309, + UNIOP = 310, + LSTOP = 311, + MULOP = 312, + ADDOP = 313, + DOLSHARP = 314, + DO = 315, + HASHBRACK = 316, + NOAMP = 317, + LOCAL = 318, + MY = 319, + REQUIRE = 320, + COLONATTR = 321, + FORMLBRACK = 322, + FORMRBRACK = 323, + SUBLEXSTART = 324, + SUBLEXEND = 325, + PREC_LOW = 326, + OROP = 327, + DOROP = 328, + ANDOP = 329, + NOTOP = 330, + ASSIGNOP = 331, + OROR = 332, + DORDOR = 333, + ANDAND = 334, + BITOROP = 335, + BITANDOP = 336, + CHEQOP = 337, + NCEQOP = 338, + CHRELOP = 339, + NCRELOP = 340, + SHIFTOP = 341, + MATCHOP = 342, + UMINUS = 343, + REFGEN = 344, + POWOP = 345, + PREINC = 346, + PREDEC = 347, + POSTINC = 348, + POSTDEC = 349, + POSTJOIN = 350, + ARROW = 351 }; #endif @@ -200,6 +201,6 @@ int yyparse (void); /* Generated from: - * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y + * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 479637a35762..c4b9f0f6531a 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3315 +#define YYLAST 3374 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 350 +#define YYMAXUTOK 351 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -36,7 +36,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 96, 2, 2, 109, 13, 14, 2, 108, 107, 110, 11, 81, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, - 2, 15, 2, 83, 12, 2, 2, 2, 2, 2, + 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,52 +56,52 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 16, 17, 18, 19, 20, - 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, - 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, - 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, - 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, - 82, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, 98, 99, 100, 101, 102, 103, 104, 105, - 106 + 5, 6, 7, 8, 9, 15, 16, 17, 18, 19, + 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, + 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, + 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, + 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, + 80, 82, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 98, 99, 100, 101, 102, 103, 104, + 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 128, 128, 127, 139, 138, 149, 148, 162, 161, - 175, 174, 188, 187, 198, 197, 210, 218, 226, 230, - 238, 244, 245, 255, 256, 265, 269, 273, 280, 290, - 292, 305, 302, 326, 321, 342, 350, 349, 358, 364, - 370, 375, 377, 379, 386, 394, 396, 393, 413, 418, - 425, 424, 439, 447, 453, 460, 459, 474, 478, 483, - 491, 509, 510, 514, 518, 520, 522, 524, 526, 528, - 530, 533, 539, 540, 545, 556, 557, 563, 569, 570, - 575, 578, 582, 587, 591, 595, 596, 600, 606, 611, - 616, 617, 622, 623, 628, 629, 631, 636, 638, 650, - 651, 656, 658, 662, 682, 683, 685, 691, 756, 758, - 764, 766, 770, 776, 777, 782, 783, 787, 791, 791, - 859, 860, 865, 876, 877, 880, 891, 893, 895, 897, - 901, 903, 908, 912, 916, 920, 926, 931, 937, 943, - 945, 947, 950, 949, 960, 961, 965, 969, 972, 977, - 982, 985, 989, 993, 999, 1007, 1014, 1020, 1022, 1024, - 1029, 1031, 1033, 1038, 1040, 1042, 1044, 1046, 1048, 1050, - 1052, 1054, 1056, 1058, 1062, 1064, 1066, 1068, 1072, 1074, - 1078, 1080, 1082, 1084, 1088, 1090, 1095, 1097, 1100, 1102, - 1104, 1107, 1110, 1121, 1124, 1131, 1133, 1135, 1137, 1139, - 1142, 1148, 1150, 1154, 1155, 1156, 1157, 1158, 1160, 1162, - 1164, 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, - 1184, 1186, 1196, 1206, 1216, 1226, 1228, 1230, 1233, 1238, - 1242, 1244, 1246, 1248, 1251, 1253, 1256, 1258, 1260, 1262, - 1264, 1266, 1268, 1270, 1272, 1275, 1277, 1279, 1281, 1283, - 1285, 1289, 1292, 1291, 1304, 1305, 1306, 1310, 1312, 1314, - 1319, 1321, 1324, 1326, 1328, 1333, 1335, 1340, 1341, 1346, - 1347, 1353, 1357, 1358, 1359, 1362, 1363, 1366, 1367, 1370, - 1374, 1378, 1384, 1390, 1392, 1396, 1400, 1401, 1405, 1406, - 1410, 1411, 1416, 1418, 1420, 1423 + 0, 129, 129, 128, 140, 139, 150, 149, 163, 162, + 176, 175, 189, 188, 199, 198, 211, 219, 227, 231, + 239, 245, 246, 256, 257, 266, 270, 274, 281, 291, + 293, 306, 303, 327, 322, 343, 351, 350, 359, 365, + 371, 376, 378, 380, 387, 395, 397, 394, 414, 419, + 426, 425, 440, 448, 454, 461, 460, 475, 479, 484, + 492, 510, 511, 515, 519, 521, 523, 525, 527, 529, + 531, 534, 540, 541, 546, 557, 558, 564, 570, 571, + 576, 579, 583, 588, 592, 596, 597, 601, 607, 612, + 617, 618, 623, 624, 629, 630, 632, 637, 639, 651, + 652, 657, 659, 663, 683, 684, 686, 692, 757, 759, + 765, 767, 771, 777, 778, 783, 784, 788, 792, 792, + 860, 861, 866, 877, 878, 881, 892, 894, 896, 898, + 902, 904, 909, 913, 917, 921, 927, 932, 938, 944, + 946, 948, 951, 950, 961, 962, 966, 970, 973, 978, + 983, 986, 990, 994, 1000, 1008, 1015, 1021, 1023, 1025, + 1030, 1032, 1034, 1039, 1041, 1043, 1045, 1047, 1049, 1051, + 1053, 1055, 1057, 1059, 1063, 1065, 1067, 1069, 1073, 1075, + 1079, 1081, 1083, 1085, 1089, 1091, 1096, 1098, 1101, 1103, + 1105, 1108, 1111, 1122, 1125, 1132, 1134, 1136, 1138, 1140, + 1143, 1149, 1151, 1155, 1156, 1157, 1158, 1159, 1161, 1163, + 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, + 1185, 1187, 1197, 1207, 1217, 1227, 1229, 1231, 1234, 1239, + 1243, 1245, 1247, 1249, 1252, 1254, 1257, 1259, 1261, 1263, + 1265, 1267, 1269, 1271, 1273, 1276, 1278, 1280, 1282, 1284, + 1286, 1290, 1293, 1292, 1305, 1306, 1307, 1311, 1313, 1315, + 1320, 1322, 1325, 1327, 1329, 1334, 1336, 1341, 1342, 1347, + 1348, 1354, 1358, 1359, 1360, 1363, 1364, 1367, 1368, 1371, + 1375, 1379, 1385, 1391, 1393, 1397, 1401, 1402, 1406, 1407, + 1411, 1412, 1417, 1419, 1421, 1424 }; #endif @@ -112,9 +112,9 @@ static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", - "'+'", "'@'", "'%'", "'&'", "'='", "PERLY_BRACE_OPEN", - "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", - "PERLY_DOT", "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", + "'+'", "'@'", "'%'", "'&'", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", + "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_DOT", + "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", @@ -152,16 +152,16 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 45, 43, 64, 37, 38, 61, 265, 266, 267, 268, - 269, 270, 271, 272, 273, 274, 275, 276, 277, 278, - 279, 280, 281, 282, 283, 284, 285, 286, 287, 288, - 289, 290, 291, 292, 293, 294, 295, 296, 297, 298, - 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, - 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, - 329, 44, 330, 63, 58, 331, 332, 333, 334, 335, - 336, 337, 338, 339, 340, 341, 33, 126, 342, 343, - 344, 345, 346, 347, 348, 349, 350, 41, 40, 36, + 45, 43, 64, 37, 38, 265, 266, 267, 268, 269, + 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, + 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, + 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, + 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, + 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, + 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, + 330, 44, 331, 63, 58, 332, 333, 334, 335, 336, + 337, 338, 339, 340, 341, 342, 33, 126, 343, 344, + 345, 346, 347, 348, 349, 350, 351, 41, 40, 36, 42, 47 }; # endif @@ -180,64 +180,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 577, -487, -487, -487, -487, -487, -487, -487, 38, -487, - 2949, -4, 1575, 1473, -487, -487, -487, -487, 2949, 2949, - 145, 145, 145, 1955, -487, 145, 145, -487, -487, 23, - -61, -487, 2949, -487, -487, -487, -487, 2949, -41, -6, - -58, 2056, 1862, 145, 2056, 2149, 48, 2949, -2, 2949, - 2949, 2949, 2949, 2949, 2949, 2949, 2242, 145, 145, 376, - 69, -487, 15, -487, 3, 25, 55, 73, -487, -487, - -487, 3117, -487, -487, 84, 14, 64, 122, -487, 163, - 144, 155, 174, -487, -487, -487, -487, -487, -487, 48, - 48, 187, -487, 88, 148, 153, 158, 284, 175, 199, - -4, 232, 222, -487, 261, 1998, 1473, -487, -487, -487, - 656, -487, 5, 759, 558, 558, -487, -487, -487, -487, - -487, -487, -487, -487, 26, 2949, 200, 229, 2949, 214, - 1851, -4, 300, 255, 3117, 225, 2343, 2949, 1862, -487, - 1851, 548, 69, -487, 468, 2949, -487, -487, 1851, 328, - 157, -487, -487, 2949, 1851, 3042, 2444, 275, -487, -487, - -487, 1851, 69, 558, 558, 558, 82, 82, 336, 264, - -487, -487, 2949, 2949, 2949, 2949, 2949, 2949, 2545, -487, - -487, 2949, -487, -487, 2949, 2949, 2949, 2949, 2949, 2949, - 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, 2949, - 2949, 2949, -487, -487, -487, 315, 2646, 2949, 2949, 2949, - 2949, 2949, 2949, 2949, -487, 333, -487, -487, 338, -487, - -487, -487, -487, -487, 259, 22, -487, -487, 254, -487, - -487, -487, -487, -4, -487, -487, 2949, 2949, 2949, 2949, - 2949, 2949, -487, -487, -487, -487, -487, 339, 339, -487, - -487, -487, 286, -487, -487, -487, 2949, 2949, 47, -487, - -487, -487, 255, 351, -487, -487, -487, 296, 303, 273, - 2949, 69, -487, 368, -487, 2747, 558, 275, 44, 166, - 306, -487, 330, 364, -487, 2949, 372, 316, 316, -487, - 3117, 186, 80, -487, 355, 1851, 1934, 3209, 421, 343, - 3117, 3071, 1652, 1652, 1744, 1844, 514, 1934, 1934, 1851, - 1851, 395, 558, 558, 294, 305, 310, 2949, 2949, -487, - 311, 2848, 24, 312, 318, -487, -487, 398, 291, 116, - 309, 172, 319, 191, 323, 861, -487, 379, -487, -487, - 58, 391, 2949, 2949, 2949, 2949, -487, 326, -487, -487, - 332, -487, -487, -487, -487, 1668, 12, -487, 2949, 2949, - -487, -487, 376, -487, 376, -487, -487, -487, -487, -487, - 362, 362, 5, 349, -28, -487, 2949, -487, -487, 337, - -487, -487, -487, -487, 401, -487, 21, 415, -487, -487, - -487, 227, 2949, 442, -487, -487, 2949, -487, -487, -487, - 340, 238, -487, -487, 457, -487, -487, 2949, -487, 443, - -487, 444, -487, 446, -487, 448, -487, -487, -487, 300, - 255, -487, -487, 445, 359, 376, 366, 374, 376, 375, - 361, -487, -487, -487, -487, 378, 467, 195, -487, 2949, - 390, 397, 2949, -487, -487, -487, -487, 2949, 431, -487, - 491, -487, -487, 494, -487, -487, 71, -487, 241, -487, - 3163, 498, -487, -487, 410, -487, -487, -487, -487, 507, - 255, 508, -487, 2949, -487, -487, 503, 503, 2949, 2949, - 503, -487, 424, 426, 503, 503, 3117, 376, -487, -487, - 432, -487, -487, -487, -487, 465, 519, -487, -487, -487, - -487, 520, 503, 503, -487, 196, 196, 458, 459, 222, - 2949, 2949, 503, -487, -487, 963, -487, 1065, -487, -487, - -487, -487, 1167, -487, 222, 222, -487, 503, 462, -487, - -487, 503, 503, -487, 557, 480, 222, -487, -487, 36, - -487, -487, -487, 1269, -487, 2949, 222, 222, -487, 503, - -487, 568, 517, -487, -487, 483, -487, -487, -487, 222, - -487, -487, -487, 503, 1761, -487, 1371, 196, 488, -487, - -487, 503, -487 + 733, -487, -487, -487, -487, -487, -487, -487, 33, -487, + 3000, 35, 1584, 1482, -487, -487, -487, -487, 3000, 3000, + 52, 52, 52, 1990, -487, 52, 52, -487, -487, 66, + -96, -487, 3000, -487, -487, -487, -487, 3000, -46, -19, + -33, 2091, 1889, 52, 2091, 2192, 18, 3000, -2, 3000, + 3000, 3000, 3000, 3000, 3000, 3000, 2293, 52, 52, 157, + 30, -487, 15, -487, 3, 10, 55, 25, -487, -487, + -487, 3176, -487, -487, 9, 65, 109, 123, -487, 127, + 242, 290, 142, -487, -487, -487, -487, -487, -487, 18, + 18, 145, -487, 71, 74, 79, 84, 171, 99, 133, + 35, 240, 220, -487, 287, 913, 1482, -487, -487, -487, + 665, -487, 5, 768, 337, 337, -487, -487, -487, -487, + -487, -487, -487, -487, 81, 3000, 213, 254, 3000, 231, + 384, 35, 300, 262, 3176, 249, 2394, 3000, 1889, -487, + 384, 557, 30, -487, 477, 3000, -487, -487, 384, 330, + 26, -487, -487, 3000, 384, 3101, 2495, 295, -487, -487, + -487, 384, 30, 337, 337, 337, 226, 226, 341, 264, + -487, -487, 3000, 3000, 3000, 3000, 3000, 3000, 2596, -487, + -487, 3000, -487, -487, 3000, 3000, 3000, 3000, 3000, 3000, + 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, + 3000, 3000, -487, -487, -487, 251, 2697, 3000, 3000, 3000, + 3000, 3000, 3000, 3000, -487, 345, -487, -487, 346, -487, + -487, -487, -487, -487, 271, 22, -487, -487, 267, -487, + -487, -487, -487, 35, -487, -487, 3000, 3000, 3000, 3000, + 3000, 3000, -487, -487, -487, -487, -487, 352, 352, -487, + -487, -487, 302, -487, -487, -487, 3000, 3000, 94, -487, + -487, -487, 262, 364, -487, -487, -487, 323, 315, 286, + 3000, 30, -487, 387, -487, 2798, 337, 295, 176, 241, + 338, -487, 403, 379, -487, 3000, 389, 328, 328, -487, + 3176, 167, 107, -487, 469, 384, 413, 3268, 430, 754, + 3176, 3130, 363, 363, 1669, 1770, 523, 413, 413, 384, + 384, 651, 337, 337, 298, 304, 305, 3000, 3000, -487, + 307, 2899, 24, 308, 316, -487, -487, 472, 239, 117, + 285, 132, 299, 160, 303, 870, -487, 408, -487, -487, + 45, 401, 3000, 3000, 3000, 3000, -487, 320, -487, -487, + 326, -487, -487, -487, -487, 1686, 12, -487, 3000, 3000, + -487, -487, 157, -487, 157, -487, -487, -487, -487, -487, + 353, 353, 5, 331, -50, -487, 3000, -487, -487, 336, + -487, -487, -487, -487, 514, -487, -1, 517, -487, -487, + -487, 172, 3000, 432, -487, -487, 3000, -487, -487, -487, + 319, 194, -487, -487, 576, -487, -487, 3000, -487, 448, + -487, 449, -487, 457, -487, 470, -487, -487, -487, 300, + 262, -487, -487, 463, 386, 157, 390, 392, 157, 393, + 396, -487, -487, -487, -487, 394, 490, 342, -487, 3000, + 405, 407, 3000, -487, -487, -487, -487, 3000, 440, -487, + 509, -487, -487, 511, -487, -487, 21, -487, 225, -487, + 3222, 512, -487, -487, 424, -487, -487, -487, -487, 520, + 262, 522, -487, 3000, -487, -487, 530, 530, 3000, 3000, + 530, -487, 445, 431, 530, 530, 3176, 157, -487, -487, + 466, -487, -487, -487, -487, 501, 566, -487, -487, -487, + -487, 568, 530, 530, -487, 115, 115, 483, 491, 220, + 3000, 3000, 530, -487, -487, 972, -487, 1074, -487, -487, + -487, -487, 1176, -487, 220, 220, -487, 530, 489, -487, + -487, 530, 530, -487, 578, 497, 220, -487, -487, 32, + -487, -487, -487, 1278, -487, 3000, 220, 220, -487, 530, + -487, 586, 534, -487, -487, 503, -487, -487, -487, 220, + -487, -487, -487, 530, 1788, -487, 1380, 115, 504, -487, + -487, 530, -487 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -309,14 +309,14 @@ static const yytype_int16 yydefact[] = static const yytype_int16 yypgoto[] = { -487, -487, -487, -487, -487, -487, -487, -487, -487, 43, - -487, -5, -121, -487, -17, -487, 583, 493, 16, -487, - -487, -487, -487, -487, -487, -487, -487, -487, -27, -341, - -486, -95, -468, -487, 87, 258, -303, 49, -487, -105, - 223, -487, 190, 183, -243, 335, 367, -487, -487, 245, - -487, 249, -487, -487, -487, -487, 170, -487, -487, 128, - -487, 173, -8, -37, -487, -487, -487, -487, -487, -487, - -487, -487, -487, -487, -487, -487, 100, -487, -487, 473, - -124, -129, -487, -487, 289, -487, -487, 422, 1, -45, + -487, -5, -158, -487, -17, -487, 595, 516, 16, -487, + -487, -487, -487, -487, -487, -487, -487, -487, 221, -341, + -486, -114, -468, -487, 120, 282, -303, 67, -487, -3, + 218, -487, 193, 214, -243, 360, 410, -487, -487, 288, + -487, 284, -487, -487, -487, -487, 215, -487, -487, 173, + -487, 199, -8, -37, -487, -487, -487, -487, -487, -487, + -487, -487, -487, -487, -487, -487, 100, -487, -487, 518, + -124, -129, -487, -487, 318, -487, -487, 446, 1, -45, -42, -487, -487, -487, -487, -487, 51 }; @@ -341,73 +341,125 @@ static const yytype_int16 yydefgoto[] = static const yytype_int16 yytable[] = { 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, - 20, 21, 83, 162, 433, 124, 137, 245, 246, 377, + 20, 21, 129, 162, 433, 124, 285, 245, 246, 377, 530, 119, 119, 119, 20, 21, 119, 119, 103, 274, - 207, 176, 208, 177, 20, 21, 22, 150, 16, 285, - 83, 128, 429, 144, 119, 254, 116, 129, 169, 158, - 138, 117, 435, 175, 84, 440, 441, 551, 119, 119, - 207, 552, 208, 118, 118, 118, 375, 135, 118, 118, - 151, 120, 121, 122, 421, 152, 125, 126, 214, 422, - -286, 570, -286, 447, 139, 118, 118, 147, 142, 392, - 564, 348, -261, 145, 146, 179, 180, 155, 228, 394, - 118, 118, 136, 172, 173, 174, 156, 57, 271, 171, - 279, 338, 339, 280, 247, -262, 142, 181, 114, 115, - 258, 57, 243, 178, 172, 173, 174, 373, 267, 59, + 176, 175, 177, 16, 20, 21, 22, 150, 392, 83, + 151, 137, 429, 144, 119, 152, 116, 273, 169, 158, + 83, 117, 435, 551, 84, 440, 441, 552, 119, 119, + 421, 447, 135, 118, 118, 118, 422, 83, 118, 118, + -261, 120, 121, 122, 116, 138, 125, 126, 214, 117, + 207, 570, 208, 128, 139, 118, 118, 147, 142, 136, + 564, 348, -260, 145, 146, 179, 180, 155, 228, 254, + 118, 118, 181, 172, 173, 174, 156, 57, 271, 171, + 279, 175, 375, 280, 247, 184, 142, 206, 114, 115, + 258, 57, 243, 178, -286, 394, -286, 373, 267, 59, 59, 57, 130, 57, 405, 410, 483, 134, -288, 144, - -288, 140, -260, 231, 148, 182, 183, 154, 282, 161, - 175, 163, 164, 165, 166, 167, 278, 172, 173, 174, - 209, 83, 210, 184, 287, 288, 289, 116, 291, 292, - 294, 211, 117, 212, 260, 507, 508, 471, 273, -290, - 353, 118, -286, 354, -286, -291, -291, -291, 205, 270, - 213, 412, 206, 172, 173, 174, 220, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 393, 535, 218, - 414, 365, 366, 367, 368, 342, 343, 344, 345, 347, + -288, 140, -290, 231, 148, 182, 183, 154, 282, 161, + 412, 163, 164, 165, 166, 167, 278, 213, 172, 173, + 174, 57, 527, 528, 287, 288, 289, 218, 291, 292, + 294, 172, 173, 174, 260, 507, 508, 471, 414, 220, + 353, 118, 221, 354, 172, 173, 174, 222, 393, 270, + 457, 207, 223, 208, 172, 173, 174, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 229, 535, 172, + 173, 174, 462, 338, 339, 342, 343, 344, 345, 347, 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, 172, 173, 174, -264, 236, 237, - 238, 239, 555, 527, 528, 240, 457, 241, 59, 172, - 173, 174, 449, 232, 57, 276, 221, 462, 132, 133, - 492, 222, 384, 172, 173, 174, 223, 387, 172, 173, - 174, 233, 172, 173, 174, 290, 360, 391, 464, 216, - 217, 295, 235, 229, 296, 297, 298, 299, 300, 301, + 362, 362, 362, 362, 172, 173, 174, 172, 173, 174, + 224, 230, 555, 492, 172, 173, 174, -262, 59, 172, + 173, 174, 449, 132, 133, 276, -286, 209, -286, 210, + 409, 232, 384, 314, 315, 316, 317, 387, 318, 233, + 225, 172, 173, 174, 319, 290, 360, 391, 464, 226, + 57, 295, 216, 217, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, -83, 257, 172, 173, 174, 230, 256, 400, - 401, 353, 409, 404, 354, 172, 173, 174, 172, 173, - 174, 259, -288, 119, -288, 261, 263, 314, 315, 316, - 411, 317, 265, 318, 425, 364, 428, 428, 319, 142, - 413, 172, 173, 174, 415, 272, 283, 437, 431, 501, - 428, 428, 439, 224, 285, 336, 506, 352, 346, 509, - 340, 461, 357, 513, 514, 118, 369, 372, 172, 173, - 174, 286, 450, 172, 173, 174, 378, -263, 382, 320, - 383, 524, 525, 225, 458, 385, 172, 173, 174, 390, - 392, 536, 226, 57, 417, 174, 172, 173, 174, 59, - 172, 173, 174, 381, 397, 186, 544, 172, 173, 174, - 546, 547, 469, 423, 533, 398, 472, 172, 173, 174, - 399, 402, 406, 321, 322, 323, 407, 479, 559, 541, - 542, 428, 172, 173, 174, 57, 142, 389, 200, 487, - 432, 550, 567, 201, 442, 452, 202, 203, 204, 205, - 572, 556, 557, 172, 173, 174, 446, 186, 187, 459, - 465, 466, 395, 467, 565, 468, 474, 473, -215, 478, - 428, 428, 515, 475, 517, 172, 173, 174, 172, 173, - 174, 476, 477, 522, 207, 480, 208, -215, 481, -215, - 200, 450, 172, 173, 174, 201, 460, 484, 202, 203, - 204, 205, 425, 428, 485, 408, 488, 489, 455, 543, - 491, -215, -215, -215, -215, 493, 200, 494, -215, 504, - -215, 201, 456, -215, 202, 203, 204, 205, 495, 497, - -215, -215, 511, 512, 172, 173, 174, 428, 518, 516, - 519, 523, 486, -215, 566, -215, -215, -215, -254, -215, + 312, 313, 172, 173, 174, 211, 411, 212, 235, 400, + 401, 353, -264, 404, 354, 320, 172, 173, 174, 506, + 413, 256, 509, 119, 415, 261, 513, 514, 257, -291, + -291, -291, 205, 263, 425, 364, 428, 428, 259, 142, + 461, 172, 173, 174, 524, 525, 272, 437, 431, 501, + 428, 428, 439, -288, 536, -288, 265, 352, 285, 321, + 322, 323, 172, 173, 174, 118, 283, 336, 340, 544, + 346, 286, 450, 546, 547, 357, 172, 173, 174, 369, + 172, 173, 174, 372, 458, 236, 237, 238, 239, 378, + 382, 559, 240, 383, 241, 533, 172, 173, 174, 59, + 172, 173, 174, 385, 390, 567, 392, 174, 397, -263, + 541, 542, 469, 572, 398, 399, 472, 402, 406, 172, + 173, 174, 550, 423, 407, 186, 187, 479, 417, 57, + 381, 428, 556, 557, 432, 442, 142, 201, 446, 487, + 202, 203, 204, 205, 452, 565, 186, 187, 459, -83, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 365, + 366, 367, 368, 201, 465, 466, 202, 203, 204, 205, + 428, 428, 515, 467, 517, 186, 187, -215, 199, 200, + 172, 173, 174, 522, 201, 473, 468, 202, 203, 204, + 205, 450, 207, 474, 208, -215, 460, 475, -215, 476, + 477, 480, 425, 428, 478, 197, 198, 199, 200, 543, + 389, 481, 484, 201, 485, 488, 202, 203, 204, 205, + -215, -215, -215, -215, 489, 200, 491, -215, 493, -215, + 201, 494, -215, 202, 203, 204, 205, 428, 512, -215, + -215, 495, 486, 497, 566, 504, 172, 173, 174, 172, + 173, 174, -215, 511, -215, -215, -215, -254, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, 463, 531, 532, -254, -215, -254, - 545, -215, -215, -215, -215, -215, 186, 187, 548, -215, - 1, 2, 3, 4, 5, 6, 7, 549, 560, 561, - 563, -254, -254, -254, -254, 571, 107, 534, -254, 242, - -254, 426, 470, -254, 195, 196, 197, 198, 199, 200, - -254, -254, 388, 568, 201, 371, 444, 202, 203, 204, - 205, 445, 490, -254, 521, -254, -254, -254, 277, -254, + -215, -215, -215, 516, 518, -254, 395, -215, -254, 408, + -215, -215, -215, -215, -215, 186, 187, 519, -215, 523, + 531, 172, 173, 174, 172, 173, 174, 545, 532, 548, + -254, -254, -254, -254, 549, 560, 561, -254, 107, -254, + 563, 571, -254, 195, 196, 197, 198, 199, 200, -254, + -254, 455, 242, 201, 456, 426, 202, 203, 204, 205, + 534, 568, -254, 470, -254, -254, -254, 388, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, 499, 438, 0, 351, -254, 0, - 0, -254, -254, -254, -254, -254, -13, 85, 201, -254, - 0, 202, 203, 204, 205, 0, 18, 19, 20, 21, - 22, 0, 83, 0, 23, 0, 0, 86, 24, 25, + -254, -254, -254, 172, 173, 174, 445, -254, 371, 444, + -254, -254, -254, -254, -254, -13, 85, 490, -254, 521, + 499, 351, 0, 277, 438, 18, 19, 20, 21, 22, + 83, 0, 23, 463, 0, 0, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 186, 187, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 1, 2, 3, 4, + 5, 6, 7, 0, 0, 50, 200, 0, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, -3, 85, + 0, 0, 0, 56, 57, 58, 0, 0, 18, 19, + 20, 21, 22, 83, 0, 23, 0, 0, 0, 86, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, + 92, 93, 94, 95, 96, 0, 186, 0, 97, 98, + 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 200, + 0, 0, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, + 18, 19, 20, 21, 22, 83, 416, 23, 0, 0, + 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 236, 237, 238, 239, + 0, 0, 0, 240, 0, 241, 51, 52, 0, 53, + 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, + 58, 0, 18, 19, 20, 21, 22, 83, 537, 23, + 172, 173, 174, 86, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, + 538, 23, 0, 0, 0, 86, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, + 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, + 22, 83, 540, 23, 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, @@ -415,149 +467,71 @@ static const yytype_int16 yytable[] = 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, -3, - 85, 0, 0, 0, 56, 57, 58, 0, 0, 18, - 19, 20, 21, 22, 0, 83, 0, 23, 0, 0, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, - 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 22, 0, 83, 416, 23, - 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 57, 58, 0, 18, 19, 20, 21, 22, 0, 83, - 537, 23, 0, 0, 86, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, - 0, 83, 538, 23, 0, 0, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, - 21, 22, 0, 83, 540, 23, 0, 0, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, - 19, 20, 21, 22, 0, 83, 554, 23, 0, 0, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, - 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 22, 0, 83, 0, 23, - 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 569, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 57, 58, 0, 18, 19, 20, 21, 22, 0, 83, - 0, 23, 0, 0, 86, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, - 0, 83, 0, 23, 0, 0, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 0, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 20, 21, 22, 56, 57, 58, 23, 0, 0, -78, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, + 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, + 20, 21, 22, 83, 554, 23, 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 186, 187, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, - 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, - 55, 18, 19, 20, 21, 22, 56, 57, 58, 23, - 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 193, 194, 195, 196, 197, 198, 199, 200, - 0, 50, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, -78, 56, - 57, 58, 18, 19, 20, 21, 22, 0, 83, 0, - 23, 0, 0, 0, 141, 25, 26, 27, 28, 117, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 186, 187, 0, 0, - 0, 0, 0, 186, 187, 0, 37, 0, 0, 38, + 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, + 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, + 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, + 18, 19, 20, 21, 22, 83, 0, 23, 0, 0, + 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, + 58, 0, 18, 19, 20, 21, 22, 83, 0, 23, + 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 194, 195, 196, 197, 198, 199, 200, - 0, 0, 50, 0, 201, 199, 200, 202, 203, 204, - 205, 201, 0, 0, 202, 203, 204, 205, 51, 52, - 0, 53, 0, 54, 55, 18, 19, 20, 21, 22, - 56, 57, 58, 23, 123, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 186, 187, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 197, 198, 199, 200, - 0, 0, 0, 0, 201, 50, 0, 202, 203, 204, - 205, 236, 237, 238, 239, 0, 0, 0, 240, 0, - 241, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, - 22, 0, 83, 0, 23, 172, 173, 174, 24, 25, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, + 0, 23, 0, 0, 0, 86, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 87, 0, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, + 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, + 22, 0, 0, 23, 0, 0, 0, -78, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 20, 21, 22, 56, 57, 58, 23, 0, 0, - 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 43, 44, 45, 46, 47, 48, 49, 193, 194, 195, + 196, 197, 198, 199, 200, 0, 50, 0, 0, 201, + 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, + 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, + 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 50, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, -78, 56, 57, 58, 18, + 19, 20, 21, 22, 83, 0, 23, 0, 0, 0, + 0, 141, 25, 26, 27, 28, 117, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, @@ -565,8 +539,29 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 19, 20, 21, 22, 56, 57, 58, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, + 18, 19, 20, 21, 22, 0, 0, 23, 123, 0, + 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, + 58, 18, 19, 20, 21, 22, 83, 0, 23, 0, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 23, + 0, 0, 0, 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -574,9 +569,9 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 168, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 0, 23, 0, 0, 0, 24, 25, 26, 27, 28, + 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -585,8 +580,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 266, 56, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 0, 23, 0, 0, 0, 24, 25, 26, 27, + 168, 56, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -595,8 +590,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 281, 56, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 0, 23, 0, 0, 0, 24, 25, 26, + 0, 266, 56, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -605,8 +600,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 293, 56, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 0, 23, 0, 0, 0, 24, 25, + 0, 0, 281, 56, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -615,8 +610,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 326, 56, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 0, 23, 0, 0, 0, 24, + 0, 0, 0, 293, 56, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -625,8 +620,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 386, 56, 57, 58, 18, 19, - 20, 21, 22, 0, 0, 0, 23, 0, 0, 0, + 0, 0, 0, 0, 326, 56, 57, 58, 18, 19, + 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -635,8 +630,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 403, 56, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 0, 23, 0, 0, + 55, 0, 0, 0, 0, 386, 56, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -645,105 +640,168 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 19, 20, 21, 22, 56, 57, 58, - 23, 0, 0, 0, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 185, 0, 0, 0, - 0, 0, 0, 186, 187, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 275, 57, 58, 188, 189, 396, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 188, - 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, - 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, + 54, 55, 0, 0, 0, 0, 403, 56, 57, 58, + 18, 19, 20, 21, 22, 0, 0, 23, 0, 0, + 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, + 58, 18, 19, 20, 21, 22, 0, 0, 23, 0, + 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 185, 0, 0, 0, 0, + 0, 0, 186, 187, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 0, 275, + 57, 58, 188, 189, 396, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 189, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, -291, 0, 202, 203, 204, 205, - 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 188, 189, + 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, + 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 189, 0, 190, 191, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, + 0, 0, 201, -291, 0, 202, 203, 204, 205, 0, + 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 190, 191, 192, 193, 194, 195, - 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, - 0, 0, 202, 203, 204, 205 + 0, 0, 0, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, 0, + 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, - 12, 13, 16, 50, 355, 23, 74, 12, 13, 262, + 12, 13, 108, 50, 355, 23, 17, 12, 13, 262, 506, 20, 21, 22, 12, 13, 25, 26, 12, 153, - 16, 16, 18, 18, 12, 13, 14, 45, 0, 18, - 16, 18, 345, 42, 43, 19, 22, 108, 56, 48, - 108, 27, 355, 81, 11, 358, 359, 21, 57, 58, - 16, 25, 18, 20, 21, 22, 19, 108, 25, 26, - 22, 20, 21, 22, 16, 27, 25, 26, 83, 21, - 16, 567, 18, 111, 41, 42, 43, 44, 125, 18, - 558, 69, 71, 42, 43, 92, 93, 99, 97, 19, - 57, 58, 108, 77, 78, 79, 108, 109, 145, 58, - 155, 216, 217, 155, 109, 71, 153, 92, 18, 19, - 128, 109, 106, 108, 77, 78, 79, 256, 136, 137, - 138, 109, 32, 109, 110, 19, 439, 37, 16, 138, - 18, 41, 71, 100, 44, 90, 91, 47, 156, 49, - 81, 51, 52, 53, 54, 55, 155, 77, 78, 79, - 16, 16, 18, 90, 172, 173, 174, 22, 176, 177, - 178, 16, 27, 18, 131, 478, 479, 420, 21, 16, - 225, 138, 16, 225, 18, 103, 104, 105, 106, 138, - 16, 19, 108, 77, 78, 79, 108, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 21, 511, 22, - 19, 238, 239, 240, 241, 220, 221, 222, 223, 224, + 15, 81, 17, 0, 12, 13, 14, 45, 17, 15, + 22, 74, 345, 42, 43, 27, 22, 21, 56, 48, + 15, 27, 355, 21, 11, 358, 359, 25, 57, 58, + 15, 111, 108, 20, 21, 22, 21, 15, 25, 26, + 71, 20, 21, 22, 22, 108, 25, 26, 83, 27, + 15, 567, 17, 17, 41, 42, 43, 44, 125, 108, + 558, 69, 71, 42, 43, 92, 93, 99, 97, 18, + 57, 58, 92, 77, 78, 79, 108, 109, 145, 58, + 155, 81, 18, 155, 109, 90, 153, 108, 18, 19, + 128, 109, 106, 108, 15, 18, 17, 256, 136, 137, + 138, 109, 32, 109, 110, 18, 439, 37, 15, 138, + 17, 41, 15, 100, 44, 90, 91, 47, 156, 49, + 18, 51, 52, 53, 54, 55, 155, 15, 77, 78, + 79, 109, 47, 48, 172, 173, 174, 22, 176, 177, + 178, 77, 78, 79, 131, 478, 479, 420, 18, 108, + 225, 138, 108, 225, 77, 78, 79, 108, 21, 138, + 18, 15, 108, 17, 77, 78, 79, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 108, 511, 77, + 78, 79, 18, 216, 217, 220, 221, 222, 223, 224, 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 77, 78, 79, 71, 43, 44, - 45, 46, 545, 47, 48, 50, 19, 52, 256, 77, - 78, 79, 376, 21, 109, 155, 108, 19, 35, 36, - 19, 108, 270, 77, 78, 79, 108, 275, 77, 78, - 79, 49, 77, 78, 79, 175, 233, 285, 407, 89, - 90, 181, 21, 108, 184, 185, 186, 187, 188, 189, + 238, 239, 240, 241, 77, 78, 79, 77, 78, 79, + 69, 108, 545, 18, 77, 78, 79, 71, 256, 77, + 78, 79, 376, 35, 36, 155, 15, 15, 17, 17, + 21, 21, 270, 12, 13, 14, 15, 275, 17, 49, + 99, 77, 78, 79, 23, 175, 233, 285, 407, 108, + 109, 181, 89, 90, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 107, 74, 77, 78, 79, 108, 108, 317, - 318, 356, 21, 321, 356, 77, 78, 79, 77, 78, - 79, 107, 16, 322, 18, 25, 71, 12, 13, 14, - 21, 16, 107, 18, 342, 343, 344, 345, 23, 376, - 21, 77, 78, 79, 21, 17, 71, 355, 347, 473, - 358, 359, 357, 69, 18, 22, 477, 356, 99, 480, - 22, 21, 108, 484, 485, 322, 27, 81, 77, 78, - 79, 107, 377, 77, 78, 79, 25, 71, 75, 64, - 107, 502, 503, 99, 392, 17, 77, 78, 79, 25, - 18, 512, 108, 109, 15, 79, 77, 78, 79, 407, - 77, 78, 79, 107, 110, 62, 527, 77, 78, 79, - 531, 532, 417, 22, 509, 110, 421, 77, 78, 79, - 110, 110, 110, 108, 109, 110, 108, 432, 549, 524, - 525, 439, 77, 78, 79, 109, 473, 107, 95, 447, - 108, 536, 563, 100, 82, 108, 103, 104, 105, 106, - 571, 546, 547, 77, 78, 79, 107, 62, 63, 17, - 17, 17, 107, 17, 559, 17, 107, 22, 0, 108, - 478, 479, 489, 107, 491, 77, 78, 79, 77, 78, - 79, 107, 107, 500, 16, 107, 18, 19, 21, 21, - 95, 496, 77, 78, 79, 100, 396, 107, 103, 104, - 105, 106, 510, 511, 107, 107, 75, 16, 107, 526, - 16, 43, 44, 45, 46, 17, 95, 107, 50, 16, - 52, 100, 107, 55, 103, 104, 105, 106, 21, 21, - 62, 63, 108, 107, 77, 78, 79, 545, 73, 107, - 21, 21, 442, 75, 561, 77, 78, 79, 0, 81, - 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 107, 107, 107, 19, 100, 21, - 108, 103, 104, 105, 106, 107, 62, 63, 21, 111, - 3, 4, 5, 6, 7, 8, 9, 107, 20, 72, - 107, 43, 44, 45, 46, 107, 13, 510, 50, 106, - 52, 343, 419, 55, 90, 91, 92, 93, 94, 95, - 62, 63, 277, 564, 100, 248, 371, 103, 104, 105, - 106, 372, 452, 75, 496, 77, 78, 79, 155, 81, - 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 471, 356, -1, 225, 100, -1, - -1, 103, 104, 105, 106, 107, 0, 1, 100, 111, - -1, 103, 104, 105, 106, -1, 10, 11, 12, 13, - 14, -1, 16, -1, 18, -1, -1, 21, 22, 23, + 200, 201, 77, 78, 79, 15, 21, 17, 21, 317, + 318, 356, 71, 321, 356, 64, 77, 78, 79, 477, + 21, 108, 480, 322, 21, 25, 484, 485, 74, 103, + 104, 105, 106, 71, 342, 343, 344, 345, 107, 376, + 21, 77, 78, 79, 502, 503, 16, 355, 347, 473, + 358, 359, 357, 15, 512, 17, 107, 356, 17, 108, + 109, 110, 77, 78, 79, 322, 71, 22, 22, 527, + 99, 107, 377, 531, 532, 108, 77, 78, 79, 27, + 77, 78, 79, 81, 392, 43, 44, 45, 46, 25, + 75, 549, 50, 107, 52, 509, 77, 78, 79, 407, + 77, 78, 79, 16, 25, 563, 17, 79, 110, 71, + 524, 525, 417, 571, 110, 110, 421, 110, 110, 77, + 78, 79, 536, 22, 108, 62, 63, 432, 20, 109, + 107, 439, 546, 547, 108, 82, 473, 100, 107, 447, + 103, 104, 105, 106, 108, 559, 62, 63, 16, 107, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 238, + 239, 240, 241, 100, 16, 16, 103, 104, 105, 106, + 478, 479, 489, 16, 491, 62, 63, 0, 94, 95, + 77, 78, 79, 500, 100, 22, 16, 103, 104, 105, + 106, 496, 15, 107, 17, 18, 396, 107, 21, 107, + 107, 107, 510, 511, 108, 92, 93, 94, 95, 526, + 107, 21, 107, 100, 107, 75, 103, 104, 105, 106, + 43, 44, 45, 46, 15, 95, 15, 50, 16, 52, + 100, 107, 55, 103, 104, 105, 106, 545, 107, 62, + 63, 21, 442, 21, 561, 15, 77, 78, 79, 77, + 78, 79, 75, 108, 77, 78, 79, 0, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 107, 73, 18, 107, 100, 21, 107, + 103, 104, 105, 106, 107, 62, 63, 21, 111, 21, + 107, 77, 78, 79, 77, 78, 79, 108, 107, 21, + 43, 44, 45, 46, 107, 19, 72, 50, 13, 52, + 107, 107, 55, 90, 91, 92, 93, 94, 95, 62, + 63, 107, 106, 100, 107, 343, 103, 104, 105, 106, + 510, 564, 75, 419, 77, 78, 79, 277, 81, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 77, 78, 79, 372, 100, 248, 371, + 103, 104, 105, 106, 107, 0, 1, 452, 111, 496, + 471, 225, -1, 155, 356, 10, 11, 12, 13, 14, + 15, -1, 17, 107, -1, -1, 21, 22, 23, 24, + 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, -1, 62, 63, 50, 51, 52, 53, 54, + -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, + 65, 66, 67, 68, 69, 70, 3, 4, 5, 6, + 7, 8, 9, -1, -1, 80, 95, -1, -1, -1, + -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 0, 1, + -1, -1, -1, 108, 109, 110, -1, -1, 10, 11, + 12, 13, 14, 15, -1, 17, -1, -1, -1, 21, + 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, -1, 62, -1, 50, 51, + 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 80, 95, + -1, -1, -1, -1, 100, -1, -1, 103, 104, 105, + 106, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, + 10, 11, 12, 13, 14, 15, 16, 17, -1, -1, + -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, + 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, + 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, + 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 80, -1, -1, -1, -1, -1, 43, 44, 45, 46, + -1, -1, -1, 50, -1, 52, 96, 97, -1, 99, + -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, + 110, -1, 10, 11, 12, 13, 14, 15, 16, 17, + 77, 78, 79, 21, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, + -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, + 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, + 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, + 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, + 16, 17, -1, -1, -1, 21, 22, 23, 24, 25, + 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, + 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, + 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, + -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, + 14, 15, 16, 17, -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, @@ -751,149 +809,71 @@ static const yytype_int16 yycheck[] = 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 0, - 1, -1, -1, -1, 108, 109, 110, -1, -1, 10, - 11, 12, 13, 14, -1, 16, -1, 18, -1, -1, - 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, - 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, - 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, 14, -1, 16, 17, 18, - -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, - -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, - 109, 110, -1, 10, 11, 12, 13, 14, -1, 16, - 17, 18, -1, -1, 21, 22, 23, 24, 25, 26, - -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, - 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, - 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, - -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, - -1, 16, 17, 18, -1, -1, 21, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, - -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, - -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, - 13, 14, -1, 16, 17, 18, -1, -1, 21, 22, - 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, -1, -1, -1, 50, 51, 52, - 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, - -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, - 11, 12, 13, 14, -1, 16, 17, 18, -1, -1, - 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, -1, -1, -1, 50, - 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, - 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, 14, -1, 16, -1, 18, - -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, -1, -1, - -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, 73, -1, -1, -1, -1, -1, - -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, - 109, 110, -1, 10, 11, 12, 13, 14, -1, 16, - -1, 18, -1, -1, 21, 22, 23, 24, 25, 26, - -1, 28, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - -1, -1, -1, 50, 51, 52, 53, 54, -1, 56, - 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, - 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, - -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, - -1, 16, -1, 18, -1, -1, 21, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, - -1, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, -1, -1, -1, 50, 51, 52, 53, 54, - -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, - 12, 13, 14, 108, 109, 110, 18, -1, -1, 21, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, + -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 12, 13, 14, 15, 16, 17, -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, - 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, - -1, -1, -1, -1, 62, 63, -1, -1, -1, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 80, -1, - -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, - -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, - 102, 10, 11, 12, 13, 14, 108, 109, 110, 18, - -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, - 39, 40, -1, -1, -1, -1, 62, 63, -1, -1, - -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, 88, 89, 90, 91, 92, 93, 94, 95, - -1, 80, -1, -1, 100, -1, -1, 103, 104, 105, - 106, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, 13, 14, -1, 16, -1, - 18, -1, -1, -1, 22, 23, 24, 25, 26, 27, - 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, - -1, 39, 40, -1, -1, -1, 62, 63, -1, -1, - -1, -1, -1, 62, 63, -1, 54, -1, -1, 57, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, + 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, + 10, 11, 12, 13, 14, 15, -1, 17, -1, -1, + -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, + 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, + 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, + 70, -1, -1, 73, -1, -1, -1, -1, -1, -1, + 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, + 110, -1, 10, 11, 12, 13, 14, 15, -1, 17, + -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, + -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, 89, 90, 91, 92, 93, 94, 95, - -1, -1, 80, -1, 100, 94, 95, 103, 104, 105, - 106, 100, -1, -1, 103, 104, 105, 106, 96, 97, - -1, 99, -1, 101, 102, 10, 11, 12, 13, 14, - 108, 109, 110, 18, 19, -1, -1, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, - -1, -1, -1, -1, 39, 40, 62, 63, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, - -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, 92, 93, 94, 95, - -1, -1, -1, -1, 100, 80, -1, 103, 104, 105, - 106, 43, 44, 45, 46, -1, -1, -1, 50, -1, - 52, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, - 14, -1, 16, -1, 18, 77, 78, 79, 22, 23, + 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, + 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, + -1, 17, -1, -1, -1, 21, 22, 23, 24, 25, + 26, -1, 28, 29, 30, 31, 32, 33, 34, -1, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, + 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, + 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, + -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, + 14, -1, -1, 17, -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, - 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, 12, 13, 14, 108, 109, 110, 18, -1, -1, - 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, + 64, 65, 66, 67, 68, 69, 70, 88, 89, 90, + 91, 92, 93, 94, 95, -1, 80, -1, -1, 100, + -1, -1, 103, 104, 105, 106, -1, -1, -1, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, + -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, + 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, + -1, -1, 62, 63, -1, -1, -1, -1, -1, -1, + -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, + -1, -1, 64, 65, 66, 67, 68, 69, 70, 89, + 90, 91, 92, 93, 94, 95, -1, -1, 80, -1, + 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, + 11, 12, 13, 14, 15, -1, 17, -1, -1, -1, + -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, @@ -901,8 +881,29 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, 11, 12, 13, 14, 108, 109, 110, - 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, + 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, + 10, 11, 12, 13, 14, -1, -1, 17, 18, -1, + -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, + 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, + 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, + 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, + 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, + 110, 10, 11, 12, 13, 14, 15, -1, 17, -1, + -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, + 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, + 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, + -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, @@ -910,9 +911,9 @@ static const yytype_int16 yycheck[] = 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, + -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, - -1, 18, -1, -1, -1, 22, 23, 24, 25, 26, + 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, @@ -922,7 +923,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - -1, -1, 18, -1, -1, -1, 22, 23, 24, 25, + -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, @@ -932,7 +933,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - -1, -1, -1, 18, -1, -1, -1, 22, 23, 24, + -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, @@ -942,7 +943,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, - 14, -1, -1, -1, 18, -1, -1, -1, 22, 23, + 14, -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -952,7 +953,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, - 13, 14, -1, -1, -1, 18, -1, -1, -1, 22, + 13, 14, -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -962,7 +963,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - 12, 13, 14, -1, -1, -1, 18, -1, -1, -1, + 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -972,7 +973,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, 13, 14, -1, -1, -1, 18, -1, -1, + 11, 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -981,33 +982,44 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, 11, 12, 13, 14, 108, 109, 110, - 18, -1, -1, -1, 22, 23, 24, 25, 26, -1, - 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, - -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, - 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 80, -1, -1, -1, 55, -1, -1, -1, - -1, -1, -1, 62, 63, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, - 108, 109, 110, 82, 83, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, - -1, 100, 55, -1, 103, 104, 105, 106, -1, 62, - 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, - 83, -1, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, -1, -1, -1, -1, 100, 55, -1, - 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, + 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, + 10, 11, 12, 13, 14, -1, -1, 17, -1, -1, + -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, + 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, + 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, + 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, + 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, + 110, 10, 11, 12, 13, 14, -1, -1, 17, -1, + -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, + 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, + 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, + 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, + 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 80, -1, -1, -1, 55, -1, -1, -1, -1, + -1, -1, 62, 63, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, + 109, 110, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, + 100, 55, -1, 103, 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 83, -1, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, - -1, -1, -1, 100, 55, -1, 103, 104, 105, 106, - -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 82, 83, + -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, -1, -1, -1, -1, 100, 55, -1, 103, + 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, + -1, -1, 100, 55, -1, 103, 104, 105, 106, -1, + 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, -1, -1, -1, -1, 100, - -1, -1, 103, 104, 105, 106 + -1, -1, -1, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, -1, -1, -1, -1, 100, -1, + -1, 103, 104, 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1016,61 +1028,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 14, 18, 22, 23, 24, 25, 26, 28, + 12, 13, 14, 17, 22, 23, 24, 25, 26, 28, 29, 30, 31, 32, 33, 39, 40, 54, 57, 58, 59, 60, 61, 64, 65, 66, 67, 68, 69, 70, 80, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 16, 121, 1, 21, 34, 36, 37, + 205, 206, 207, 15, 121, 1, 21, 34, 36, 37, 38, 41, 42, 43, 44, 45, 46, 50, 51, 52, 53, 56, 121, 130, 141, 174, 35, 128, 129, 130, 126, 168, 169, 126, 188, 188, 22, 27, 121, 200, - 208, 208, 208, 19, 174, 208, 208, 189, 18, 108, + 208, 208, 208, 18, 174, 208, 208, 189, 17, 108, 188, 152, 152, 152, 188, 108, 108, 74, 108, 121, 188, 22, 175, 192, 200, 208, 208, 121, 188, 21, 174, 22, 27, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 77, 78, 79, 81, 16, 18, 108, 92, + 208, 208, 77, 78, 79, 81, 15, 17, 108, 92, 93, 92, 90, 91, 90, 55, 62, 63, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 16, 18, 16, - 18, 16, 18, 16, 123, 153, 154, 154, 22, 151, + 95, 100, 103, 104, 105, 106, 108, 15, 17, 15, + 17, 15, 17, 15, 123, 153, 154, 154, 22, 151, 108, 108, 108, 108, 69, 99, 108, 198, 200, 108, 108, 121, 21, 49, 143, 21, 43, 44, 45, 46, 50, 52, 129, 130, 128, 12, 13, 109, 159, 160, - 162, 163, 164, 165, 19, 192, 108, 74, 174, 107, + 162, 163, 164, 165, 18, 192, 108, 74, 174, 107, 121, 25, 155, 71, 156, 107, 107, 174, 193, 193, - 208, 175, 17, 21, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 71, 157, 18, 107, 174, 174, 174, + 208, 175, 16, 21, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 71, 157, 17, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 12, 13, 14, 16, 18, 23, + 188, 188, 188, 188, 12, 13, 14, 15, 17, 23, 64, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 22, 150, 151, 151, 22, 133, 123, 123, 123, 123, 99, 123, 69, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 27, - 158, 158, 81, 193, 175, 19, 177, 156, 25, 123, - 173, 107, 75, 107, 174, 17, 107, 174, 157, 107, - 25, 174, 18, 21, 19, 107, 84, 110, 110, 110, + 158, 158, 81, 193, 175, 18, 177, 156, 25, 123, + 173, 107, 75, 107, 174, 16, 107, 174, 157, 107, + 25, 174, 17, 21, 18, 107, 84, 110, 110, 110, 174, 174, 110, 107, 174, 110, 110, 108, 107, 21, - 19, 21, 19, 21, 19, 21, 17, 15, 122, 131, - 132, 16, 21, 22, 146, 174, 147, 148, 174, 148, + 18, 21, 18, 21, 18, 21, 16, 20, 122, 131, + 132, 15, 21, 22, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 19, 174, 17, - 188, 21, 19, 107, 193, 17, 17, 17, 17, 123, + 123, 171, 108, 166, 167, 107, 107, 18, 174, 16, + 188, 21, 18, 107, 193, 16, 16, 16, 16, 123, 155, 156, 123, 22, 107, 107, 107, 107, 108, 123, - 107, 21, 136, 148, 107, 107, 188, 174, 75, 16, - 168, 16, 19, 17, 107, 21, 156, 21, 172, 173, - 137, 192, 144, 144, 16, 124, 124, 148, 148, 124, + 107, 21, 136, 148, 107, 107, 188, 174, 75, 15, + 168, 15, 18, 16, 107, 21, 156, 21, 172, 173, + 137, 192, 144, 144, 15, 124, 124, 148, 148, 124, 134, 108, 107, 124, 124, 126, 107, 126, 73, 21, 170, 171, 126, 21, 124, 124, 125, 47, 48, 142, - 142, 107, 107, 143, 146, 148, 124, 17, 17, 127, - 17, 143, 143, 126, 124, 108, 124, 124, 21, 107, - 143, 21, 25, 138, 17, 148, 143, 143, 135, 124, - 20, 72, 139, 107, 144, 143, 126, 124, 149, 73, + 142, 107, 107, 143, 146, 148, 124, 16, 16, 127, + 16, 143, 143, 126, 124, 108, 124, 124, 21, 107, + 143, 21, 25, 138, 16, 148, 143, 143, 135, 124, + 19, 72, 139, 107, 144, 143, 126, 124, 149, 73, 142, 107, 124 }; @@ -1187,6 +1199,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 9855563392f7569db61b034a5d41c2c70f8b2501c8536bda9bf3455ffdbda53e perly.y + * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index eb4ab38d587e..517758f9df43 100644 --- a/perly.y +++ b/perly.y @@ -45,12 +45,13 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '-' '+' '@' '%' '&' '=' +%token '-' '+' '@' '%' '&' %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN %token PERLY_BRACKET_CLOSE %token PERLY_DOT +%token PERLY_EQUAL_SIGN %token PERLY_SEMICOLON %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST @@ -215,9 +216,9 @@ block : PERLY_BRACE_OPEN remember stmtseq PERLY_BRACE_CLOSE ; /* format body */ -formblock: '=' remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON PERLY_DOT - { if (parser->copline > (line_t)$1) - parser->copline = (line_t)$1; +formblock: PERLY_EQUAL_SIGN remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERLY_SEMICOLON PERLY_DOT + { if (parser->copline > (line_t)$PERLY_EQUAL_SIGN) + parser->copline = (line_t)$PERLY_EQUAL_SIGN; $$ = block_end($remember, $formstmtseq); } ; diff --git a/toke.c b/toke.c index c14777785de5..bec8f4d822e0 100644 --- a/toke.c +++ b/toke.c @@ -391,6 +391,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), DEBUG_TOKEN (IVAL, PERLY_DOT), + DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -6186,7 +6187,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) pl_yylval.ival = CopLINE(PL_curcop); PL_copline = NOLINE; /* invalidate current command line number */ - TOKEN(formbrack ? '=' : PERLY_BRACE_OPEN); + TOKEN(formbrack ? PERLY_EQUAL_SIGN : PERLY_BRACE_OPEN); } static int From 25a505006bae8916ab7e2625092a90ef093fac01 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:05 +0100 Subject: [PATCH 331/503] Distinguish C- and perly- literals - PERLY_AMPERSAND --- perly.act | 536 +++++++++++++++++++++++++++--------------------------- perly.h | 177 +++++++++--------- perly.tab | 208 ++++++++++----------- perly.y | 11 +- toke.c | 11 +- 5 files changed, 474 insertions(+), 469 deletions(-) diff --git a/perly.act b/perly.act index e9246e243c30..317009e22508 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 129 "perly.y" +#line 130 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 134 "perly.y" +#line 135 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 140 "perly.y" +#line 141 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 145 "perly.y" +#line 146 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 150 "perly.y" +#line 151 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 155 "perly.y" +#line 156 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 163 "perly.y" +#line 164 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 168 "perly.y" +#line 169 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 176 "perly.y" +#line 177 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 181 "perly.y" +#line 182 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 189 "perly.y" +#line 190 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 194 "perly.y" +#line 195 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 199 "perly.y" +#line 200 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 204 "perly.y" +#line 205 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 212 "perly.y" +#line 213 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 220 "perly.y" +#line 221 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 227 "perly.y" +#line 228 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 232 "perly.y" +#line 233 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 239 "perly.y" +#line 240 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 245 "perly.y" +#line 246 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 247 "perly.y" +#line 248 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 256 "perly.y" +#line 257 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 258 "perly.y" +#line 259 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 267 "perly.y" +#line 268 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 271 "perly.y" +#line 272 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 275 "perly.y" +#line 276 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 282 "perly.y" +#line 283 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 292 "perly.y" +#line 293 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 294 "perly.y" +#line 295 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 306 "perly.y" +#line 307 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 312 "perly.y" +#line 313 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 327 "perly.y" +#line 328 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 333 "perly.y" +#line 334 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 344 "perly.y" +#line 345 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 351 "perly.y" +#line 352 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 353 "perly.y" +#line 354 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 360 "perly.y" +#line 361 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 366 "perly.y" +#line 367 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 372 "perly.y" +#line 373 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 377 "perly.y" +#line 378 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 379 "perly.y" +#line 380 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 381 "perly.y" +#line 382 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 388 "perly.y" +#line 389 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 395 "perly.y" +#line 396 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 397 "perly.y" +#line 398 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 400 "perly.y" +#line 401 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 415 "perly.y" +#line 416 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 420 "perly.y" +#line 421 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 426 "perly.y" +#line 427 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 428 "perly.y" +#line 429 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 441 "perly.y" +#line 442 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 449 "perly.y" +#line 450 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 455 "perly.y" +#line 456 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 461 "perly.y" +#line 462 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 468 "perly.y" +#line 469 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 476 "perly.y" +#line 477 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 480 "perly.y" +#line 481 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 485 "perly.y" +#line 486 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 493 "perly.y" +#line 494 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 510 "perly.y" +#line 511 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 512 "perly.y" +#line 513 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 520 "perly.y" +#line 521 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 522 "perly.y" +#line 523 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 535 "perly.y" +#line 536 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 540 "perly.y" +#line 541 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 542 "perly.y" +#line 543 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 547 "perly.y" +#line 548 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 557 "perly.y" +#line 558 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 559 "perly.y" +#line 560 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 564 "perly.y" +#line 565 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 570 "perly.y" +#line 571 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 576 "perly.y" +#line 577 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 584 "perly.y" +#line 585 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 589 "perly.y" +#line 590 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 593 "perly.y" +#line 594 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 597 "perly.y" +#line 598 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 601 "perly.y" +#line 602 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 607 "perly.y" +#line 608 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 612 "perly.y" +#line 613 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 623 "perly.y" +#line 624 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 629 "perly.y" +#line 630 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 631 "perly.y" +#line 632 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 633 "perly.y" +#line 634 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 638 "perly.y" +#line 639 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 640 "perly.y" +#line 641 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 651 "perly.y" +#line 652 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 653 "perly.y" +#line 654 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 658 "perly.y" +#line 659 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 660 "perly.y" +#line 661 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 664 "perly.y" +#line 665 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 683 "perly.y" +#line 684 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 685 "perly.y" +#line 686 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 687 "perly.y" +#line 688 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 693 "perly.y" +#line 694 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 758 "perly.y" +#line 759 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 760 "perly.y" +#line 761 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 766 "perly.y" +#line 767 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 768 "perly.y" +#line 769 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 772 "perly.y" +#line 773 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 777 "perly.y" +#line 778 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 779 "perly.y" +#line 780 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 783 "perly.y" +#line 784 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 785 "perly.y" +#line 786 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 789 "perly.y" +#line 790 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 792 "perly.y" +#line 793 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 803 "perly.y" +#line 804 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 860 "perly.y" +#line 861 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 861 "perly.y" +#line 862 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 867 "perly.y" +#line 868 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 877 "perly.y" +#line 878 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 878 "perly.y" +#line 879 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 882 "perly.y" +#line 883 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 893 "perly.y" +#line 894 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 895 "perly.y" +#line 896 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 897 "perly.y" +#line 898 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 903 "perly.y" +#line 904 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 905 "perly.y" +#line 906 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 914 "perly.y" +#line 915 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 918 "perly.y" +#line 919 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 922 "perly.y" +#line 923 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 928 "perly.y" +#line 929 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 933 "perly.y" +#line 934 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 939 "perly.y" +#line 940 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 945 "perly.y" +#line 946 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 947 "perly.y" +#line 948 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 949 "perly.y" +#line 950 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 951 "perly.y" +#line 952 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 954 "perly.y" +#line 955 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 969 "perly.y" +#line 970 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 971 "perly.y" +#line 972 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 974 "perly.y" +#line 975 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 979 "perly.y" +#line 980 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 984 "perly.y" +#line 985 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 987 "perly.y" +#line 988 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 991 "perly.y" +#line 992 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 995 "perly.y" +#line 996 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1001 "perly.y" +#line 1002 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1009 "perly.y" +#line 1010 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1016 "perly.y" +#line 1017 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1022 "perly.y" +#line 1023 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1024 "perly.y" +#line 1025 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1026 "perly.y" +#line 1027 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1031 "perly.y" +#line 1032 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1033 "perly.y" +#line 1034 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1035 "perly.y" +#line 1036 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1040 "perly.y" +#line 1041 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1042 "perly.y" +#line 1043 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1064 "perly.y" +#line 1065 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1066 "perly.y" +#line 1067 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1068 "perly.y" +#line 1069 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1070 "perly.y" +#line 1071 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1074 "perly.y" +#line 1075 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1076 "perly.y" +#line 1077 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1080 "perly.y" +#line 1081 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1082 "perly.y" +#line 1083 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1084 "perly.y" +#line 1085 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1086 "perly.y" +#line 1087 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1090 "perly.y" +#line 1091 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1092 "perly.y" +#line 1093 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1109 "perly.y" +#line 1110 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1112 "perly.y" +#line 1113 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1123 "perly.y" +#line 1124 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1126 "perly.y" +#line 1127 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1133 "perly.y" +#line 1134 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1135 "perly.y" +#line 1136 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1137 "perly.y" +#line 1138 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1139 "perly.y" +#line 1140 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1141 "perly.y" +#line 1142 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1144 "perly.y" +#line 1145 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1150 "perly.y" +#line 1151 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1152 "perly.y" +#line 1153 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1160 "perly.y" +#line 1161 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1162 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1186 "perly.y" +#line 1187 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1188 "perly.y" +#line 1189 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1198 "perly.y" +#line 1199 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1208 "perly.y" +#line 1209 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1218 "perly.y" +#line 1219 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1228 "perly.y" +#line 1229 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1230 "perly.y" +#line 1231 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1232 "perly.y" +#line 1233 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1235 "perly.y" +#line 1236 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1240 "perly.y" +#line 1241 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1244 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1287 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1291 "perly.y" +#line 1292 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1293 "perly.y" +#line 1294 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1304 "perly.y" +#line 1305 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1312 "perly.y" +#line 1313 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1314 "perly.y" +#line 1315 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1316 "perly.y" +#line 1317 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1326 "perly.y" +#line 1327 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1335 "perly.y" +#line 1336 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1337 "perly.y" +#line 1338 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1341 "perly.y" +#line 1342 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1343 "perly.y" +#line 1344 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1347 "perly.y" +#line 1348 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1349 "perly.y" +#line 1350 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1355 "perly.y" +#line 1356 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1372 "perly.y" +#line 1373 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1376 "perly.y" +#line 1377 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1380 "perly.y" +#line 1381 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1386 "perly.y" +#line 1387 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1392 "perly.y" +#line 1393 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1394 "perly.y" +#line 1395 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1398 "perly.y" +#line 1399 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1403 "perly.y" +#line 1404 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1408 "perly.y" +#line 1409 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1413 "perly.y" +#line 1414 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1418 "perly.y" +#line 1419 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1420 "perly.y" +#line 1421 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1422 "perly.y" +#line 1423 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1425 "perly.y" +#line 1426 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y + * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 2dd1e0c4b6b1..91dbedd2738d 100644 --- a/perly.h +++ b/perly.h @@ -63,93 +63,94 @@ extern int yydebug; GRAMFULLSTMT = 262, GRAMSTMTSEQ = 263, GRAMSUBSIGNATURE = 264, - PERLY_BRACE_OPEN = 265, - PERLY_BRACE_CLOSE = 266, - PERLY_BRACKET_OPEN = 267, - PERLY_BRACKET_CLOSE = 268, - PERLY_DOT = 269, - PERLY_EQUAL_SIGN = 270, - PERLY_SEMICOLON = 271, - BAREWORD = 272, - METHOD = 273, - FUNCMETH = 274, - THING = 275, - PMFUNC = 276, - PRIVATEREF = 277, - QWLIST = 278, - FUNC0OP = 279, - FUNC0SUB = 280, - UNIOPSUB = 281, - LSTOPSUB = 282, - PLUGEXPR = 283, - PLUGSTMT = 284, - LABEL = 285, - FORMAT = 286, - SUB = 287, - SIGSUB = 288, - ANONSUB = 289, - ANON_SIGSUB = 290, - PACKAGE = 291, - USE = 292, - WHILE = 293, - UNTIL = 294, - IF = 295, - UNLESS = 296, - ELSE = 297, - ELSIF = 298, - CONTINUE = 299, - FOR = 300, - GIVEN = 301, - WHEN = 302, - DEFAULT = 303, - LOOPEX = 304, - DOTDOT = 305, - YADAYADA = 306, - FUNC0 = 307, - FUNC1 = 308, - FUNC = 309, - UNIOP = 310, - LSTOP = 311, - MULOP = 312, - ADDOP = 313, - DOLSHARP = 314, - DO = 315, - HASHBRACK = 316, - NOAMP = 317, - LOCAL = 318, - MY = 319, - REQUIRE = 320, - COLONATTR = 321, - FORMLBRACK = 322, - FORMRBRACK = 323, - SUBLEXSTART = 324, - SUBLEXEND = 325, - PREC_LOW = 326, - OROP = 327, - DOROP = 328, - ANDOP = 329, - NOTOP = 330, - ASSIGNOP = 331, - OROR = 332, - DORDOR = 333, - ANDAND = 334, - BITOROP = 335, - BITANDOP = 336, - CHEQOP = 337, - NCEQOP = 338, - CHRELOP = 339, - NCRELOP = 340, - SHIFTOP = 341, - MATCHOP = 342, - UMINUS = 343, - REFGEN = 344, - POWOP = 345, - PREINC = 346, - PREDEC = 347, - POSTINC = 348, - POSTDEC = 349, - POSTJOIN = 350, - ARROW = 351 + PERLY_AMPERSAND = 265, + PERLY_BRACE_OPEN = 266, + PERLY_BRACE_CLOSE = 267, + PERLY_BRACKET_OPEN = 268, + PERLY_BRACKET_CLOSE = 269, + PERLY_DOT = 270, + PERLY_EQUAL_SIGN = 271, + PERLY_SEMICOLON = 272, + BAREWORD = 273, + METHOD = 274, + FUNCMETH = 275, + THING = 276, + PMFUNC = 277, + PRIVATEREF = 278, + QWLIST = 279, + FUNC0OP = 280, + FUNC0SUB = 281, + UNIOPSUB = 282, + LSTOPSUB = 283, + PLUGEXPR = 284, + PLUGSTMT = 285, + LABEL = 286, + FORMAT = 287, + SUB = 288, + SIGSUB = 289, + ANONSUB = 290, + ANON_SIGSUB = 291, + PACKAGE = 292, + USE = 293, + WHILE = 294, + UNTIL = 295, + IF = 296, + UNLESS = 297, + ELSE = 298, + ELSIF = 299, + CONTINUE = 300, + FOR = 301, + GIVEN = 302, + WHEN = 303, + DEFAULT = 304, + LOOPEX = 305, + DOTDOT = 306, + YADAYADA = 307, + FUNC0 = 308, + FUNC1 = 309, + FUNC = 310, + UNIOP = 311, + LSTOP = 312, + MULOP = 313, + ADDOP = 314, + DOLSHARP = 315, + DO = 316, + HASHBRACK = 317, + NOAMP = 318, + LOCAL = 319, + MY = 320, + REQUIRE = 321, + COLONATTR = 322, + FORMLBRACK = 323, + FORMRBRACK = 324, + SUBLEXSTART = 325, + SUBLEXEND = 326, + PREC_LOW = 327, + OROP = 328, + DOROP = 329, + ANDOP = 330, + NOTOP = 331, + ASSIGNOP = 332, + OROR = 333, + DORDOR = 334, + ANDAND = 335, + BITOROP = 336, + BITANDOP = 337, + CHEQOP = 338, + NCEQOP = 339, + CHRELOP = 340, + NCRELOP = 341, + SHIFTOP = 342, + MATCHOP = 343, + UMINUS = 344, + REFGEN = 345, + POWOP = 346, + PREINC = 347, + PREDEC = 348, + POSTINC = 349, + POSTDEC = 350, + POSTJOIN = 351, + ARROW = 352 }; #endif @@ -201,6 +202,6 @@ int yyparse (void); /* Generated from: - * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y + * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index c4b9f0f6531a..c5dcd1e454cd 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 351 +#define YYMAXUTOK 352 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,7 +33,7 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 96, 2, 2, 109, 13, 14, 2, + 2, 2, 2, 96, 2, 2, 109, 13, 2, 2, 108, 107, 110, 11, 81, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, @@ -56,52 +56,52 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 15, 16, 17, 18, 19, - 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, - 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, - 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, - 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, - 80, 82, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 98, 99, 100, 101, 102, 103, 104, - 105, 106 + 5, 6, 7, 8, 9, 14, 15, 16, 17, 18, + 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, + 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, + 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, + 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, + 79, 80, 82, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 98, 99, 100, 101, 102, 103, + 104, 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 129, 129, 128, 140, 139, 150, 149, 163, 162, - 176, 175, 189, 188, 199, 198, 211, 219, 227, 231, - 239, 245, 246, 256, 257, 266, 270, 274, 281, 291, - 293, 306, 303, 327, 322, 343, 351, 350, 359, 365, - 371, 376, 378, 380, 387, 395, 397, 394, 414, 419, - 426, 425, 440, 448, 454, 461, 460, 475, 479, 484, - 492, 510, 511, 515, 519, 521, 523, 525, 527, 529, - 531, 534, 540, 541, 546, 557, 558, 564, 570, 571, - 576, 579, 583, 588, 592, 596, 597, 601, 607, 612, - 617, 618, 623, 624, 629, 630, 632, 637, 639, 651, - 652, 657, 659, 663, 683, 684, 686, 692, 757, 759, - 765, 767, 771, 777, 778, 783, 784, 788, 792, 792, - 860, 861, 866, 877, 878, 881, 892, 894, 896, 898, - 902, 904, 909, 913, 917, 921, 927, 932, 938, 944, - 946, 948, 951, 950, 961, 962, 966, 970, 973, 978, - 983, 986, 990, 994, 1000, 1008, 1015, 1021, 1023, 1025, - 1030, 1032, 1034, 1039, 1041, 1043, 1045, 1047, 1049, 1051, - 1053, 1055, 1057, 1059, 1063, 1065, 1067, 1069, 1073, 1075, - 1079, 1081, 1083, 1085, 1089, 1091, 1096, 1098, 1101, 1103, - 1105, 1108, 1111, 1122, 1125, 1132, 1134, 1136, 1138, 1140, - 1143, 1149, 1151, 1155, 1156, 1157, 1158, 1159, 1161, 1163, - 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, - 1185, 1187, 1197, 1207, 1217, 1227, 1229, 1231, 1234, 1239, - 1243, 1245, 1247, 1249, 1252, 1254, 1257, 1259, 1261, 1263, - 1265, 1267, 1269, 1271, 1273, 1276, 1278, 1280, 1282, 1284, - 1286, 1290, 1293, 1292, 1305, 1306, 1307, 1311, 1313, 1315, - 1320, 1322, 1325, 1327, 1329, 1334, 1336, 1341, 1342, 1347, - 1348, 1354, 1358, 1359, 1360, 1363, 1364, 1367, 1368, 1371, - 1375, 1379, 1385, 1391, 1393, 1397, 1401, 1402, 1406, 1407, - 1411, 1412, 1417, 1419, 1421, 1424 + 0, 130, 130, 129, 141, 140, 151, 150, 164, 163, + 177, 176, 190, 189, 200, 199, 212, 220, 228, 232, + 240, 246, 247, 257, 258, 267, 271, 275, 282, 292, + 294, 307, 304, 328, 323, 344, 352, 351, 360, 366, + 372, 377, 379, 381, 388, 396, 398, 395, 415, 420, + 427, 426, 441, 449, 455, 462, 461, 476, 480, 485, + 493, 511, 512, 516, 520, 522, 524, 526, 528, 530, + 532, 535, 541, 542, 547, 558, 559, 565, 571, 572, + 577, 580, 584, 589, 593, 597, 598, 602, 608, 613, + 618, 619, 624, 625, 630, 631, 633, 638, 640, 652, + 653, 658, 660, 664, 684, 685, 687, 693, 758, 760, + 766, 768, 772, 778, 779, 784, 785, 789, 793, 793, + 861, 862, 867, 878, 879, 882, 893, 895, 897, 899, + 903, 905, 910, 914, 918, 922, 928, 933, 939, 945, + 947, 949, 952, 951, 962, 963, 967, 971, 974, 979, + 984, 987, 991, 995, 1001, 1009, 1016, 1022, 1024, 1026, + 1031, 1033, 1035, 1040, 1042, 1044, 1046, 1048, 1050, 1052, + 1054, 1056, 1058, 1060, 1064, 1066, 1068, 1070, 1074, 1076, + 1080, 1082, 1084, 1086, 1090, 1092, 1097, 1099, 1102, 1104, + 1106, 1109, 1112, 1123, 1126, 1133, 1135, 1137, 1139, 1141, + 1144, 1150, 1152, 1156, 1157, 1158, 1159, 1160, 1162, 1164, + 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, + 1186, 1188, 1198, 1208, 1218, 1228, 1230, 1232, 1235, 1240, + 1244, 1246, 1248, 1250, 1253, 1255, 1258, 1260, 1262, 1264, + 1266, 1268, 1270, 1272, 1274, 1277, 1279, 1281, 1283, 1285, + 1287, 1291, 1294, 1293, 1306, 1307, 1308, 1312, 1314, 1316, + 1321, 1323, 1326, 1328, 1330, 1335, 1337, 1342, 1343, 1348, + 1349, 1355, 1359, 1360, 1361, 1364, 1365, 1368, 1369, 1372, + 1376, 1380, 1386, 1392, 1394, 1398, 1402, 1403, 1407, 1408, + 1412, 1413, 1418, 1420, 1422, 1425 }; #endif @@ -112,37 +112,38 @@ static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", - "'+'", "'@'", "'%'", "'&'", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", - "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_DOT", - "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", "BAREWORD", "METHOD", "FUNCMETH", - "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", - "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", - "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", - "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", - "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", - "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", - "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", - "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", - "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", - "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", - "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", - "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", - "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", - "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", "mblock", - "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", - "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", - "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", - "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", - "startanonsub", "startformsub", "subname", "proto", "subattrlist", - "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", - "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", - "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", - "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", - "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", - "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", - "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", - "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", - "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "'+'", "'@'", "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", + "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", + "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", "BAREWORD", "METHOD", + "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", + "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", + "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", + "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", + "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", + "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", + "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", + "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", + "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", + "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", + "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", + "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", + "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", + "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", + "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", + "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", + "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", + "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", + "startsub", "startanonsub", "startformsub", "subname", "proto", + "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", + "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", + "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", + "listexpr", "listop", "@16", "method", "subscripted", "termbinop", + "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", + "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", + "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", + "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", + "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -152,16 +153,16 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 45, 43, 64, 37, 38, 265, 266, 267, 268, 269, - 270, 271, 272, 273, 274, 275, 276, 277, 278, 279, - 280, 281, 282, 283, 284, 285, 286, 287, 288, 289, - 290, 291, 292, 293, 294, 295, 296, 297, 298, 299, - 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, - 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, - 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, - 330, 44, 331, 63, 58, 332, 333, 334, 335, 336, - 337, 338, 339, 340, 341, 342, 33, 126, 343, 344, - 345, 346, 347, 348, 349, 350, 351, 41, 40, 36, + 45, 43, 64, 37, 265, 266, 267, 268, 269, 270, + 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, + 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, + 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, + 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, + 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, + 331, 44, 332, 63, 58, 333, 334, 335, 336, 337, + 338, 339, 340, 341, 342, 343, 33, 126, 344, 345, + 346, 347, 348, 349, 350, 351, 352, 41, 40, 36, 42, 47 }; # endif @@ -1165,40 +1166,41 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 73ee434ba96b92f48b5072443bb2c4bcd9bdf40ef9685a6c1ec4a8ea8a0ebe8b perly.y + * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 517758f9df43..3d1a09e9187d 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,8 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '-' '+' '@' '%' '&' +%token '-' '+' '@' '%' +%token PERLY_AMPERSAND %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN @@ -1246,9 +1247,9 @@ term[product] : termbinop { $$ = newAVREF($operand); } | term[operand] ARROW '%' '*' { $$ = newHVREF($operand); } - | term[operand] ARROW '&' '*' + | term[operand] ARROW PERLY_AMPERSAND '*' { $$ = newUNOP(OP_ENTERSUB, 0, - scalar(newCVREF($3,$operand))); } + scalar(newCVREF($PERLY_AMPERSAND,$operand))); } | term[operand] ARROW '*' '*' %prec '(' { $$ = newGVREF(0,$operand); } | LOOPEX /* loop exiting command (goto, last, dump, etc) */ @@ -1368,8 +1369,8 @@ my_refgen: MY REFGEN | REFGEN MY ; -amper : '&' indirob - { $$ = newCVREF($1,$indirob); } +amper : PERLY_AMPERSAND indirob + { $$ = newCVREF($PERLY_AMPERSAND,$indirob); } ; scalar : '$' indirob diff --git a/toke.c b/toke.c index bec8f4d822e0..39da4651f0b6 100644 --- a/toke.c +++ b/toke.c @@ -386,6 +386,7 @@ static struct debug_tokens { { OROP, TOKENTYPE_IVAL, "OROP" }, { OROR, TOKENTYPE_NONE, "OROR" }, { PACKAGE, TOKENTYPE_NONE, "PACKAGE" }, + DEBUG_TOKEN (IVAL, PERLY_AMPERSAND), DEBUG_TOKEN (IVAL, PERLY_BRACE_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), @@ -2039,7 +2040,7 @@ S_force_next(pTHX_ I32 type) static int S_postderef(pTHX_ int const funny, char const next) { - assert(funny == DOLSHARP || memCHRs("$@%&*", funny)); + assert(funny == DOLSHARP || memCHRs("$@%&*", funny) || funny == PERLY_AMPERSAND); if (next == '*') { PL_expect = XOPERATOR; if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) { @@ -6242,7 +6243,7 @@ static int yyl_ampersand(pTHX_ char *s) { if (PL_expect == XPOSTDEREF) - POSTDEREF('&'); + POSTDEREF(PERLY_AMPERSAND); s++; if (*s++ == '&') { @@ -6288,9 +6289,9 @@ yyl_ampersand(pTHX_ char *s) if (PL_tokenbuf[1]) force_ident_maybe_lex('&'); else - PREREF('&'); + PREREF(PERLY_AMPERSAND); - TERM('&'); + TERM(PERLY_AMPERSAND); } static int @@ -7514,7 +7515,7 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) op_free(pl_yylval.opval), force_next(PRIVATEREF); else op_free(c.rv2cv_op), force_next(BAREWORD); pl_yylval.ival = 0; - TOKEN('&'); + TOKEN(PERLY_AMPERSAND); } /* If followed by var or block, call it a method (unless sub) */ From 581f9a7a8ac03dde592c9c645423bcb369116e24 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:06 +0100 Subject: [PATCH 332/503] Distinguish C- and perly- literals - PERLY_COMMA --- perly.act | 536 ++++++++++----------- perly.h | 169 +++---- perly.tab | 1362 ++++++++++++++++++++++++++--------------------------- perly.y | 11 +- toke.c | 20 +- 5 files changed, 1052 insertions(+), 1046 deletions(-) diff --git a/perly.act b/perly.act index 317009e22508..178328adbe06 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 130 "perly.y" +#line 131 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 135 "perly.y" +#line 136 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 141 "perly.y" +#line 142 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 146 "perly.y" +#line 147 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 151 "perly.y" +#line 152 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 156 "perly.y" +#line 157 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 164 "perly.y" +#line 165 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 169 "perly.y" +#line 170 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 177 "perly.y" +#line 178 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 182 "perly.y" +#line 183 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 190 "perly.y" +#line 191 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 195 "perly.y" +#line 196 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 200 "perly.y" +#line 201 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 205 "perly.y" +#line 206 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 213 "perly.y" +#line 214 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 221 "perly.y" +#line 222 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 228 "perly.y" +#line 229 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 233 "perly.y" +#line 234 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 240 "perly.y" +#line 241 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 246 "perly.y" +#line 247 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 248 "perly.y" +#line 249 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 257 "perly.y" +#line 258 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 259 "perly.y" +#line 260 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 268 "perly.y" +#line 269 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 272 "perly.y" +#line 273 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 276 "perly.y" +#line 277 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 283 "perly.y" +#line 284 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 293 "perly.y" +#line 294 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 295 "perly.y" +#line 296 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 307 "perly.y" +#line 308 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 313 "perly.y" +#line 314 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 328 "perly.y" +#line 329 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 334 "perly.y" +#line 335 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 345 "perly.y" +#line 346 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 352 "perly.y" +#line 353 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 354 "perly.y" +#line 355 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 361 "perly.y" +#line 362 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 367 "perly.y" +#line 368 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 373 "perly.y" +#line 374 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 378 "perly.y" +#line 379 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 380 "perly.y" +#line 381 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 382 "perly.y" +#line 383 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 389 "perly.y" +#line 390 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 396 "perly.y" +#line 397 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 398 "perly.y" +#line 399 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 401 "perly.y" +#line 402 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 416 "perly.y" +#line 417 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 421 "perly.y" +#line 422 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 427 "perly.y" +#line 428 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 429 "perly.y" +#line 430 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 442 "perly.y" +#line 443 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 450 "perly.y" +#line 451 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 456 "perly.y" +#line 457 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 462 "perly.y" +#line 463 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 469 "perly.y" +#line 470 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 477 "perly.y" +#line 478 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 481 "perly.y" +#line 482 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 486 "perly.y" +#line 487 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 494 "perly.y" +#line 495 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 511 "perly.y" +#line 512 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 513 "perly.y" +#line 514 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 521 "perly.y" +#line 522 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 536 "perly.y" +#line 537 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 541 "perly.y" +#line 542 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 543 "perly.y" +#line 544 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 548 "perly.y" +#line 549 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 558 "perly.y" +#line 559 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 560 "perly.y" +#line 561 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 565 "perly.y" +#line 566 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 571 "perly.y" +#line 572 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 577 "perly.y" +#line 578 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 585 "perly.y" +#line 586 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 590 "perly.y" +#line 591 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 594 "perly.y" +#line 595 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 597 "perly.y" +#line 598 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 598 "perly.y" +#line 599 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 602 "perly.y" +#line 603 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 608 "perly.y" +#line 609 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 613 "perly.y" +#line 614 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 624 "perly.y" +#line 625 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 630 "perly.y" +#line 631 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 632 "perly.y" +#line 633 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 634 "perly.y" +#line 635 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 639 "perly.y" +#line 640 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 641 "perly.y" +#line 642 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 652 "perly.y" +#line 653 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 654 "perly.y" +#line 655 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 659 "perly.y" +#line 660 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 661 "perly.y" +#line 662 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 665 "perly.y" +#line 666 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 684 "perly.y" +#line 685 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 686 "perly.y" +#line 687 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 688 "perly.y" +#line 689 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 694 "perly.y" +#line 695 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 759 "perly.y" +#line 760 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 761 "perly.y" +#line 762 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 767 "perly.y" +#line 768 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 769 "perly.y" +#line 770 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 773 "perly.y" +#line 774 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 778 "perly.y" +#line 779 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 780 "perly.y" +#line 781 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 786 "perly.y" +#line 787 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 790 "perly.y" +#line 791 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 793 "perly.y" +#line 794 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 804 "perly.y" +#line 805 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 861 "perly.y" +#line 862 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 862 "perly.y" +#line 863 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 868 "perly.y" +#line 869 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 878 "perly.y" +#line 879 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 879 "perly.y" +#line 880 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 883 "perly.y" +#line 884 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 894 "perly.y" +#line 895 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 896 "perly.y" +#line 897 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 898 "perly.y" +#line 899 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 904 "perly.y" +#line 905 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 906 "perly.y" +#line 907 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 915 "perly.y" +#line 916 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 919 "perly.y" +#line 920 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 923 "perly.y" +#line 924 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 929 "perly.y" +#line 930 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 934 "perly.y" +#line 935 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 940 "perly.y" +#line 941 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 946 "perly.y" +#line 947 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 948 "perly.y" +#line 949 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 950 "perly.y" +#line 951 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 952 "perly.y" +#line 953 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 955 "perly.y" +#line 956 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 970 "perly.y" +#line 971 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 972 "perly.y" +#line 973 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 975 "perly.y" +#line 976 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 980 "perly.y" +#line 981 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 985 "perly.y" +#line 986 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 988 "perly.y" +#line 989 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 992 "perly.y" +#line 993 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 996 "perly.y" +#line 997 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1002 "perly.y" +#line 1003 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1010 "perly.y" +#line 1011 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1017 "perly.y" +#line 1018 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1023 "perly.y" +#line 1024 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1025 "perly.y" +#line 1026 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1027 "perly.y" +#line 1028 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1032 "perly.y" +#line 1033 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1034 "perly.y" +#line 1035 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1036 "perly.y" +#line 1037 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1041 "perly.y" +#line 1042 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1065 "perly.y" +#line 1066 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1067 "perly.y" +#line 1068 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1069 "perly.y" +#line 1070 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1071 "perly.y" +#line 1072 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1075 "perly.y" +#line 1076 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1077 "perly.y" +#line 1078 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1081 "perly.y" +#line 1082 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1083 "perly.y" +#line 1084 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1085 "perly.y" +#line 1086 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1087 "perly.y" +#line 1088 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1091 "perly.y" +#line 1092 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1093 "perly.y" +#line 1094 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1098 "perly.y" +#line 1099 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1100 "perly.y" +#line 1101 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1107 "perly.y" +#line 1108 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1110 "perly.y" +#line 1111 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1113 "perly.y" +#line 1114 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1124 "perly.y" +#line 1125 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1127 "perly.y" +#line 1128 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1134 "perly.y" +#line 1135 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1136 "perly.y" +#line 1137 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1138 "perly.y" +#line 1139 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1140 "perly.y" +#line 1141 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1142 "perly.y" +#line 1143 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1145 "perly.y" +#line 1146 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1151 "perly.y" +#line 1152 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1153 "perly.y" +#line 1154 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1161 "perly.y" +#line 1162 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1187 "perly.y" +#line 1188 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1189 "perly.y" +#line 1190 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1199 "perly.y" +#line 1200 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1209 "perly.y" +#line 1210 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1219 "perly.y" +#line 1220 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1229 "perly.y" +#line 1230 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1231 "perly.y" +#line 1232 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1233 "perly.y" +#line 1234 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1236 "perly.y" +#line 1237 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1241 "perly.y" +#line 1242 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1245 "perly.y" +#line 1246 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1288 "perly.y" +#line 1289 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1292 "perly.y" +#line 1293 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1294 "perly.y" +#line 1295 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1305 "perly.y" +#line 1306 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1313 "perly.y" +#line 1314 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1315 "perly.y" +#line 1316 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1317 "perly.y" +#line 1318 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1322 "perly.y" +#line 1323 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1324 "perly.y" +#line 1325 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1327 "perly.y" +#line 1328 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1329 "perly.y" +#line 1330 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1331 "perly.y" +#line 1332 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1336 "perly.y" +#line 1337 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1338 "perly.y" +#line 1339 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1344 "perly.y" +#line 1345 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1348 "perly.y" +#line 1349 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1350 "perly.y" +#line 1351 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1356 "perly.y" +#line 1357 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1373 "perly.y" +#line 1374 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1377 "perly.y" +#line 1378 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1381 "perly.y" +#line 1382 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1387 "perly.y" +#line 1388 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1393 "perly.y" +#line 1394 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1395 "perly.y" +#line 1396 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1399 "perly.y" +#line 1400 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1404 "perly.y" +#line 1405 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1409 "perly.y" +#line 1410 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1414 "perly.y" +#line 1415 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1419 "perly.y" +#line 1420 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1421 "perly.y" +#line 1422 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1423 "perly.y" +#line 1424 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1426 "perly.y" +#line 1427 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y + * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 91dbedd2738d..e39f8cbb1bce 100644 --- a/perly.h +++ b/perly.h @@ -68,89 +68,90 @@ extern int yydebug; PERLY_BRACE_CLOSE = 267, PERLY_BRACKET_OPEN = 268, PERLY_BRACKET_CLOSE = 269, - PERLY_DOT = 270, - PERLY_EQUAL_SIGN = 271, - PERLY_SEMICOLON = 272, - BAREWORD = 273, - METHOD = 274, - FUNCMETH = 275, - THING = 276, - PMFUNC = 277, - PRIVATEREF = 278, - QWLIST = 279, - FUNC0OP = 280, - FUNC0SUB = 281, - UNIOPSUB = 282, - LSTOPSUB = 283, - PLUGEXPR = 284, - PLUGSTMT = 285, - LABEL = 286, - FORMAT = 287, - SUB = 288, - SIGSUB = 289, - ANONSUB = 290, - ANON_SIGSUB = 291, - PACKAGE = 292, - USE = 293, - WHILE = 294, - UNTIL = 295, - IF = 296, - UNLESS = 297, - ELSE = 298, - ELSIF = 299, - CONTINUE = 300, - FOR = 301, - GIVEN = 302, - WHEN = 303, - DEFAULT = 304, - LOOPEX = 305, - DOTDOT = 306, - YADAYADA = 307, - FUNC0 = 308, - FUNC1 = 309, - FUNC = 310, - UNIOP = 311, - LSTOP = 312, - MULOP = 313, - ADDOP = 314, - DOLSHARP = 315, - DO = 316, - HASHBRACK = 317, - NOAMP = 318, - LOCAL = 319, - MY = 320, - REQUIRE = 321, - COLONATTR = 322, - FORMLBRACK = 323, - FORMRBRACK = 324, - SUBLEXSTART = 325, - SUBLEXEND = 326, - PREC_LOW = 327, - OROP = 328, - DOROP = 329, - ANDOP = 330, - NOTOP = 331, - ASSIGNOP = 332, - OROR = 333, - DORDOR = 334, - ANDAND = 335, - BITOROP = 336, - BITANDOP = 337, - CHEQOP = 338, - NCEQOP = 339, - CHRELOP = 340, - NCRELOP = 341, - SHIFTOP = 342, - MATCHOP = 343, - UMINUS = 344, - REFGEN = 345, - POWOP = 346, - PREINC = 347, - PREDEC = 348, - POSTINC = 349, - POSTDEC = 350, - POSTJOIN = 351, - ARROW = 352 + PERLY_COMMA = 270, + PERLY_DOT = 271, + PERLY_EQUAL_SIGN = 272, + PERLY_SEMICOLON = 273, + BAREWORD = 274, + METHOD = 275, + FUNCMETH = 276, + THING = 277, + PMFUNC = 278, + PRIVATEREF = 279, + QWLIST = 280, + FUNC0OP = 281, + FUNC0SUB = 282, + UNIOPSUB = 283, + LSTOPSUB = 284, + PLUGEXPR = 285, + PLUGSTMT = 286, + LABEL = 287, + FORMAT = 288, + SUB = 289, + SIGSUB = 290, + ANONSUB = 291, + ANON_SIGSUB = 292, + PACKAGE = 293, + USE = 294, + WHILE = 295, + UNTIL = 296, + IF = 297, + UNLESS = 298, + ELSE = 299, + ELSIF = 300, + CONTINUE = 301, + FOR = 302, + GIVEN = 303, + WHEN = 304, + DEFAULT = 305, + LOOPEX = 306, + DOTDOT = 307, + YADAYADA = 308, + FUNC0 = 309, + FUNC1 = 310, + FUNC = 311, + UNIOP = 312, + LSTOP = 313, + MULOP = 314, + ADDOP = 315, + DOLSHARP = 316, + DO = 317, + HASHBRACK = 318, + NOAMP = 319, + LOCAL = 320, + MY = 321, + REQUIRE = 322, + COLONATTR = 323, + FORMLBRACK = 324, + FORMRBRACK = 325, + SUBLEXSTART = 326, + SUBLEXEND = 327, + PREC_LOW = 328, + OROP = 329, + DOROP = 330, + ANDOP = 331, + NOTOP = 332, + ASSIGNOP = 333, + OROR = 334, + DORDOR = 335, + ANDAND = 336, + BITOROP = 337, + BITANDOP = 338, + CHEQOP = 339, + NCEQOP = 340, + CHRELOP = 341, + NCRELOP = 342, + SHIFTOP = 343, + MATCHOP = 344, + UMINUS = 345, + REFGEN = 346, + POWOP = 347, + PREINC = 348, + PREDEC = 349, + POSTINC = 350, + POSTDEC = 351, + POSTJOIN = 352, + ARROW = 353 }; #endif @@ -202,6 +203,6 @@ int yyparse (void); /* Generated from: - * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y + * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index c5dcd1e454cd..f84afd22f878 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3374 +#define YYLAST 3377 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 352 +#define YYMAXUTOK 353 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -34,7 +34,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 96, 2, 2, 109, 13, 2, 2, - 108, 107, 110, 11, 81, 10, 2, 111, 2, 2, + 108, 107, 110, 11, 2, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -63,45 +63,45 @@ static const yytype_int8 yytranslate[] = 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, - 79, 80, 82, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 98, 99, 100, 101, 102, 103, - 104, 105, 106 + 79, 80, 81, 82, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 98, 99, 100, 101, 102, + 103, 104, 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 130, 130, 129, 141, 140, 151, 150, 164, 163, - 177, 176, 190, 189, 200, 199, 212, 220, 228, 232, - 240, 246, 247, 257, 258, 267, 271, 275, 282, 292, - 294, 307, 304, 328, 323, 344, 352, 351, 360, 366, - 372, 377, 379, 381, 388, 396, 398, 395, 415, 420, - 427, 426, 441, 449, 455, 462, 461, 476, 480, 485, - 493, 511, 512, 516, 520, 522, 524, 526, 528, 530, - 532, 535, 541, 542, 547, 558, 559, 565, 571, 572, - 577, 580, 584, 589, 593, 597, 598, 602, 608, 613, - 618, 619, 624, 625, 630, 631, 633, 638, 640, 652, - 653, 658, 660, 664, 684, 685, 687, 693, 758, 760, - 766, 768, 772, 778, 779, 784, 785, 789, 793, 793, - 861, 862, 867, 878, 879, 882, 893, 895, 897, 899, - 903, 905, 910, 914, 918, 922, 928, 933, 939, 945, - 947, 949, 952, 951, 962, 963, 967, 971, 974, 979, - 984, 987, 991, 995, 1001, 1009, 1016, 1022, 1024, 1026, - 1031, 1033, 1035, 1040, 1042, 1044, 1046, 1048, 1050, 1052, - 1054, 1056, 1058, 1060, 1064, 1066, 1068, 1070, 1074, 1076, - 1080, 1082, 1084, 1086, 1090, 1092, 1097, 1099, 1102, 1104, - 1106, 1109, 1112, 1123, 1126, 1133, 1135, 1137, 1139, 1141, - 1144, 1150, 1152, 1156, 1157, 1158, 1159, 1160, 1162, 1164, - 1166, 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, - 1186, 1188, 1198, 1208, 1218, 1228, 1230, 1232, 1235, 1240, - 1244, 1246, 1248, 1250, 1253, 1255, 1258, 1260, 1262, 1264, - 1266, 1268, 1270, 1272, 1274, 1277, 1279, 1281, 1283, 1285, - 1287, 1291, 1294, 1293, 1306, 1307, 1308, 1312, 1314, 1316, - 1321, 1323, 1326, 1328, 1330, 1335, 1337, 1342, 1343, 1348, - 1349, 1355, 1359, 1360, 1361, 1364, 1365, 1368, 1369, 1372, - 1376, 1380, 1386, 1392, 1394, 1398, 1402, 1403, 1407, 1408, - 1412, 1413, 1418, 1420, 1422, 1425 + 0, 131, 131, 130, 142, 141, 152, 151, 165, 164, + 178, 177, 191, 190, 201, 200, 213, 221, 229, 233, + 241, 247, 248, 258, 259, 268, 272, 276, 283, 293, + 295, 308, 305, 329, 324, 345, 353, 352, 361, 367, + 373, 378, 380, 382, 389, 397, 399, 396, 416, 421, + 428, 427, 442, 450, 456, 463, 462, 477, 481, 486, + 494, 512, 513, 517, 521, 523, 525, 527, 529, 531, + 533, 536, 542, 543, 548, 559, 560, 566, 572, 573, + 578, 581, 585, 590, 594, 598, 599, 603, 609, 614, + 619, 620, 625, 626, 631, 632, 634, 639, 641, 653, + 654, 659, 661, 665, 685, 686, 688, 694, 759, 761, + 767, 769, 773, 779, 780, 785, 786, 790, 794, 794, + 862, 863, 868, 879, 880, 883, 894, 896, 898, 900, + 904, 906, 911, 915, 919, 923, 929, 934, 940, 946, + 948, 950, 953, 952, 963, 964, 968, 972, 975, 980, + 985, 988, 992, 996, 1002, 1010, 1017, 1023, 1025, 1027, + 1032, 1034, 1036, 1041, 1043, 1045, 1047, 1049, 1051, 1053, + 1055, 1057, 1059, 1061, 1065, 1067, 1069, 1071, 1075, 1077, + 1081, 1083, 1085, 1087, 1091, 1093, 1098, 1100, 1103, 1105, + 1107, 1110, 1113, 1124, 1127, 1134, 1136, 1138, 1140, 1142, + 1145, 1151, 1153, 1157, 1158, 1159, 1160, 1161, 1163, 1165, + 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, + 1187, 1189, 1199, 1209, 1219, 1229, 1231, 1233, 1236, 1241, + 1245, 1247, 1249, 1251, 1254, 1256, 1259, 1261, 1263, 1265, + 1267, 1269, 1271, 1273, 1275, 1278, 1280, 1282, 1284, 1286, + 1288, 1292, 1295, 1294, 1307, 1308, 1309, 1313, 1315, 1317, + 1322, 1324, 1327, 1329, 1331, 1336, 1338, 1343, 1344, 1349, + 1350, 1356, 1360, 1361, 1362, 1365, 1366, 1369, 1370, 1373, + 1377, 1381, 1387, 1393, 1395, 1399, 1403, 1404, 1408, 1409, + 1413, 1414, 1419, 1421, 1423, 1426 }; #endif @@ -114,16 +114,16 @@ static const char *const yytname[] = "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", "'+'", "'@'", "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", - "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", "BAREWORD", "METHOD", - "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", - "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", - "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", - "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", - "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", - "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", - "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", - "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", - "OROP", "DOROP", "ANDOP", "NOTOP", "','", "ASSIGNOP", "'?'", "':'", + "PERLY_COMMA", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", + "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", + "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", + "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", + "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", + "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", + "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", + "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", + "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", @@ -160,14 +160,14 @@ static const yytype_int16 yytoknum[] = 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, - 331, 44, 332, 63, 58, 333, 334, 335, 336, 337, - 338, 339, 340, 341, 342, 343, 33, 126, 344, 345, - 346, 347, 348, 349, 350, 351, 352, 41, 40, 36, + 331, 332, 333, 63, 58, 334, 335, 336, 337, 338, + 339, 340, 341, 342, 343, 344, 33, 126, 345, 346, + 347, 348, 349, 350, 351, 352, 353, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-487) +#define YYPACT_NINF (-477) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -181,64 +181,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 733, -487, -487, -487, -487, -487, -487, -487, 33, -487, - 3000, 35, 1584, 1482, -487, -487, -487, -487, 3000, 3000, - 52, 52, 52, 1990, -487, 52, 52, -487, -487, 66, - -96, -487, 3000, -487, -487, -487, -487, 3000, -46, -19, - -33, 2091, 1889, 52, 2091, 2192, 18, 3000, -2, 3000, - 3000, 3000, 3000, 3000, 3000, 3000, 2293, 52, 52, 157, - 30, -487, 15, -487, 3, 10, 55, 25, -487, -487, - -487, 3176, -487, -487, 9, 65, 109, 123, -487, 127, - 242, 290, 142, -487, -487, -487, -487, -487, -487, 18, - 18, 145, -487, 71, 74, 79, 84, 171, 99, 133, - 35, 240, 220, -487, 287, 913, 1482, -487, -487, -487, - 665, -487, 5, 768, 337, 337, -487, -487, -487, -487, - -487, -487, -487, -487, 81, 3000, 213, 254, 3000, 231, - 384, 35, 300, 262, 3176, 249, 2394, 3000, 1889, -487, - 384, 557, 30, -487, 477, 3000, -487, -487, 384, 330, - 26, -487, -487, 3000, 384, 3101, 2495, 295, -487, -487, - -487, 384, 30, 337, 337, 337, 226, 226, 341, 264, - -487, -487, 3000, 3000, 3000, 3000, 3000, 3000, 2596, -487, - -487, 3000, -487, -487, 3000, 3000, 3000, 3000, 3000, 3000, - 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, 3000, - 3000, 3000, -487, -487, -487, 251, 2697, 3000, 3000, 3000, - 3000, 3000, 3000, 3000, -487, 345, -487, -487, 346, -487, - -487, -487, -487, -487, 271, 22, -487, -487, 267, -487, - -487, -487, -487, 35, -487, -487, 3000, 3000, 3000, 3000, - 3000, 3000, -487, -487, -487, -487, -487, 352, 352, -487, - -487, -487, 302, -487, -487, -487, 3000, 3000, 94, -487, - -487, -487, 262, 364, -487, -487, -487, 323, 315, 286, - 3000, 30, -487, 387, -487, 2798, 337, 295, 176, 241, - 338, -487, 403, 379, -487, 3000, 389, 328, 328, -487, - 3176, 167, 107, -487, 469, 384, 413, 3268, 430, 754, - 3176, 3130, 363, 363, 1669, 1770, 523, 413, 413, 384, - 384, 651, 337, 337, 298, 304, 305, 3000, 3000, -487, - 307, 2899, 24, 308, 316, -487, -487, 472, 239, 117, - 285, 132, 299, 160, 303, 870, -487, 408, -487, -487, - 45, 401, 3000, 3000, 3000, 3000, -487, 320, -487, -487, - 326, -487, -487, -487, -487, 1686, 12, -487, 3000, 3000, - -487, -487, 157, -487, 157, -487, -487, -487, -487, -487, - 353, 353, 5, 331, -50, -487, 3000, -487, -487, 336, - -487, -487, -487, -487, 514, -487, -1, 517, -487, -487, - -487, 172, 3000, 432, -487, -487, 3000, -487, -487, -487, - 319, 194, -487, -487, 576, -487, -487, 3000, -487, 448, - -487, 449, -487, 457, -487, 470, -487, -487, -487, 300, - 262, -487, -487, 463, 386, 157, 390, 392, 157, 393, - 396, -487, -487, -487, -487, 394, 490, 342, -487, 3000, - 405, 407, 3000, -487, -487, -487, -487, 3000, 440, -487, - 509, -487, -487, 511, -487, -487, 21, -487, 225, -487, - 3222, 512, -487, -487, 424, -487, -487, -487, -487, 520, - 262, 522, -487, 3000, -487, -487, 530, 530, 3000, 3000, - 530, -487, 445, 431, 530, 530, 3176, 157, -487, -487, - 466, -487, -487, -487, -487, 501, 566, -487, -487, -487, - -487, 568, 530, 530, -487, 115, 115, 483, 491, 220, - 3000, 3000, 530, -487, -487, 972, -487, 1074, -487, -487, - -487, -487, 1176, -487, 220, 220, -487, 530, 489, -487, - -487, 530, 530, -487, 578, 497, 220, -487, -487, 32, - -487, -487, -487, 1278, -487, 3000, 220, 220, -487, 530, - -487, 586, 534, -487, -487, 503, -487, -487, -487, 220, - -487, -487, -487, 530, 1788, -487, 1380, 115, 504, -487, - -487, 530, -487 + 583, -477, -477, -477, -477, -477, -477, -477, 31, -477, + 3006, 26, 1590, 1488, -477, -477, -477, -477, 3006, 3006, + 17, 17, 17, 1996, -477, 17, 17, -477, -477, -1, + -69, -477, 3006, -477, -477, -477, -477, 3006, -47, -38, + -55, 2097, 1895, 17, 2097, 2198, 10, 3006, -2, 3006, + 3006, 3006, 3006, 3006, 3006, 3006, 2299, 17, 17, 171, + 47, -477, 64, -477, 53, -18, 97, -7, -477, -477, + -477, 3181, -477, -477, 3, 108, 123, 143, -477, 75, + 156, 244, 81, -477, -477, -477, -477, -477, -477, 10, + 10, 92, -477, 27, 34, 55, 59, 286, 74, 105, + 26, 212, 194, -477, 219, 1122, 1488, -477, -477, -477, + 671, -477, 5, 774, 495, 495, -477, -477, -477, -477, + -477, -477, -477, -477, 106, 3006, 152, 193, 3006, 159, + 963, 26, 248, 211, 3181, 208, 2400, 3006, 1895, -477, + 963, 563, 47, -477, 467, 3006, -477, -477, 963, 296, + 24, -477, -477, 3006, 963, 3107, 2501, 256, -477, -477, + -477, 963, 47, 495, 495, 495, 350, 350, 313, 322, + -477, -477, 3006, 3006, 3006, 3006, 3006, 3006, 2602, -477, + -477, 3006, -477, -477, 3006, 3006, 3006, 3006, 3006, 3006, + 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, + 3006, 3006, -477, -477, -477, 305, 2703, 3006, 3006, 3006, + 3006, 3006, 3006, 3006, -477, 293, -477, -477, 309, -477, + -477, -477, -477, -477, 263, 22, -477, -477, 258, -477, + -477, -477, -477, 26, -477, -477, 3006, 3006, 3006, 3006, + 3006, 3006, -477, -477, -477, -477, -477, 343, 343, -477, + -477, -477, 348, -477, -477, -477, 3006, 3006, 115, -477, + -477, -477, 211, 349, -477, -477, -477, 326, 298, 269, + 3006, 47, -477, 365, -477, 2804, 495, 256, 45, 142, + 230, -477, 362, 356, -477, 3006, 366, 306, 306, -477, + 3181, 112, 132, -477, 386, 963, 861, 3271, 422, 429, + 3181, 3136, 357, 357, 656, 759, 530, 861, 861, 963, + 963, 395, 495, 495, 279, 297, 301, 3006, 3006, -477, + 312, 2905, 52, 315, 300, -477, -477, 397, 157, 160, + 185, 178, 299, 191, 318, 876, -477, 388, -477, -477, + 67, 403, 3006, 3006, 3006, 3006, -477, 314, -477, -477, + 320, -477, -477, -477, -477, 1692, 12, -477, 3006, 3006, + -477, -477, 171, -477, 171, -477, -477, -477, -477, -477, + 352, 352, 5, 323, -12, -477, 3006, -477, -477, 327, + -477, -477, -477, -477, 400, -477, 33, 461, -477, -477, + -477, 225, 3006, 427, -477, -477, 3006, -477, -477, -477, + 339, 228, -477, -477, 497, -477, -477, 3006, -477, 452, + -477, 457, -477, 465, -477, 471, -477, -477, -477, 248, + 211, -477, -477, 414, 331, 171, 381, 387, 171, 390, + 398, -477, -477, -477, -477, 401, 483, 280, -477, 3006, + 408, 409, 3006, -477, -477, -477, -477, 3006, 434, -477, + 504, -477, -477, 506, -477, -477, 40, -477, 264, -477, + 3226, 520, -477, -477, 431, -477, -477, -477, -477, 526, + 211, 542, -477, 3006, -477, -477, 550, 550, 3006, 3006, + 550, -477, 458, 462, 550, 550, 3181, 171, -477, -477, + 472, -477, -477, -477, -477, 509, 558, -477, -477, -477, + -477, 562, 550, 550, -477, 205, 205, 489, 490, 194, + 3006, 3006, 550, -477, -477, 978, -477, 1080, -477, -477, + -477, -477, 1182, -477, 194, 194, -477, 550, 494, -477, + -477, 550, 550, -477, 581, 498, 194, -477, -477, 25, + -477, -477, -477, 1284, -477, 3006, 194, 194, -477, 550, + -477, 586, 538, -477, -477, 505, -477, -477, -477, 194, + -477, -477, -477, 550, 1794, -477, 1386, 205, 508, -477, + -477, 550, -477 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -309,16 +309,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -487, -487, -487, -487, -487, -487, -487, -487, -487, 43, - -487, -5, -158, -487, -17, -487, 595, 516, 16, -487, - -487, -487, -487, -487, -487, -487, -487, -487, 221, -341, - -486, -114, -468, -487, 120, 282, -303, 67, -487, -3, - 218, -487, 193, 214, -243, 360, 410, -487, -487, 288, - -487, 284, -487, -487, -487, -487, 215, -487, -487, 173, - -487, 199, -8, -37, -487, -487, -487, -487, -487, -487, - -487, -487, -487, -487, -487, -487, 100, -487, -487, 518, - -124, -129, -487, -487, 318, -487, -487, 446, 1, -45, - -42, -487, -487, -487, -487, -487, 51 + -477, -477, -477, -477, -477, -477, -477, -477, -477, 43, + -477, -5, -139, -477, -17, -477, 600, 511, 16, -477, + -477, -477, -477, -477, -477, -477, -477, -477, 421, -341, + -476, -156, -463, -477, 118, 275, -303, 65, -477, 56, + 319, -477, 190, 213, -243, 354, 389, -477, -477, 267, + -477, 268, -477, -477, -477, -477, 192, -477, -477, 168, + -477, 202, -8, -37, -477, -477, -477, -477, -477, -477, + -477, -477, -477, -477, -477, -477, 100, -477, -477, 510, + -124, -129, -477, -477, 321, -477, -477, 450, 1, -45, + -42, -477, -477, -477, -477, -477, 51 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -341,207 +341,238 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, - 20, 21, 129, 162, 433, 124, 285, 245, 246, 377, - 530, 119, 119, 119, 20, 21, 119, 119, 103, 274, - 176, 175, 177, 16, 20, 21, 22, 150, 392, 83, - 151, 137, 429, 144, 119, 152, 116, 273, 169, 158, - 83, 117, 435, 551, 84, 440, 441, 552, 119, 119, - 421, 447, 135, 118, 118, 118, 422, 83, 118, 118, - -261, 120, 121, 122, 116, 138, 125, 126, 214, 117, - 207, 570, 208, 128, 139, 118, 118, 147, 142, 136, - 564, 348, -260, 145, 146, 179, 180, 155, 228, 254, - 118, 118, 181, 172, 173, 174, 156, 57, 271, 171, - 279, 175, 375, 280, 247, 184, 142, 206, 114, 115, - 258, 57, 243, 178, -286, 394, -286, 373, 267, 59, - 59, 57, 130, 57, 405, 410, 483, 134, -288, 144, - -288, 140, -290, 231, 148, 182, 183, 154, 282, 161, - 412, 163, 164, 165, 166, 167, 278, 213, 172, 173, - 174, 57, 527, 528, 287, 288, 289, 218, 291, 292, - 294, 172, 173, 174, 260, 507, 508, 471, 414, 220, - 353, 118, 221, 354, 172, 173, 174, 222, 393, 270, - 457, 207, 223, 208, 172, 173, 174, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 229, 535, 172, - 173, 174, 462, 338, 339, 342, 343, 344, 345, 347, + 113, 255, 59, 159, 17, 142, 160, 175, 268, 269, + 20, 21, 503, 162, 433, 124, 128, 245, 246, 377, + 137, 119, 119, 119, 20, 21, 119, 119, 103, 274, + 530, 16, 83, 151, 20, 21, 22, 150, 152, 129, + 116, 83, 429, 144, 119, 117, 273, 551, 169, 158, + 285, 552, 435, 138, 84, 440, 441, 392, 119, 119, + 207, 135, 208, 118, 118, 118, 175, 83, 118, 118, + 136, 120, 121, 122, 181, 116, 125, 126, 214, 176, + 117, 177, 421, 184, 139, 118, 118, 147, 142, 422, + -290, 570, 348, 145, 146, 564, 213, 155, 228, 447, + 118, 118, 172, 173, 174, -261, 156, 57, 271, 171, + 279, 206, -260, 280, 247, 218, 142, -262, 114, 115, + 258, 57, 243, 207, 254, 208, 57, 373, 267, 59, + 59, 57, 130, 375, 393, 220, 483, 134, -286, 144, + -286, 140, 221, 231, 148, 179, 180, 154, 282, 161, + 394, 163, 164, 165, 166, 167, 278, -286, -288, -286, + -288, 57, 405, 222, 287, 288, 289, 223, 291, 292, + 294, 209, 178, 210, 260, 507, 508, 471, 410, 409, + 353, 118, 229, 354, 172, 173, 174, 182, 183, 270, + 172, 173, 174, 172, 173, 174, 412, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 411, 535, 414, + 172, 173, 174, 230, -264, 342, 343, 344, 345, 347, 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, 172, 173, 174, 172, 173, 174, - 224, 230, 555, 492, 172, 173, 174, -262, 59, 172, - 173, 174, 449, 132, 133, 276, -286, 209, -286, 210, - 409, 232, 384, 314, 315, 316, 317, 387, 318, 233, - 225, 172, 173, 174, 319, 290, 360, 391, 464, 226, - 57, 295, 216, 217, 296, 297, 298, 299, 300, 301, + 362, 362, 362, 362, 232, 172, 173, 174, 172, 173, + 174, 235, 555, 457, 233, -288, 462, -288, 59, 172, + 173, 174, 449, 527, 528, 276, 172, 173, 174, 211, + 256, 212, 384, 172, 173, 174, 259, 387, 257, 172, + 173, 174, 338, 339, 261, 290, 360, 391, 464, 216, + 217, 295, 492, 263, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, 211, 411, 212, 235, 400, - 401, 353, -264, 404, 354, 320, 172, 173, 174, 506, - 413, 256, 509, 119, 415, 261, 513, 514, 257, -291, - -291, -291, 205, 263, 425, 364, 428, 428, 259, 142, - 461, 172, 173, 174, 524, 525, 272, 437, 431, 501, - 428, 428, 439, -288, 536, -288, 265, 352, 285, 321, - 322, 323, 172, 173, 174, 118, 283, 336, 340, 544, - 346, 286, 450, 546, 547, 357, 172, 173, 174, 369, - 172, 173, 174, 372, 458, 236, 237, 238, 239, 378, - 382, 559, 240, 383, 241, 533, 172, 173, 174, 59, - 172, 173, 174, 385, 390, 567, 392, 174, 397, -263, - 541, 542, 469, 572, 398, 399, 472, 402, 406, 172, - 173, 174, 550, 423, 407, 186, 187, 479, 417, 57, - 381, 428, 556, 557, 432, 442, 142, 201, 446, 487, - 202, 203, 204, 205, 452, 565, 186, 187, 459, -83, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 365, - 366, 367, 368, 201, 465, 466, 202, 203, 204, 205, - 428, 428, 515, 467, 517, 186, 187, -215, 199, 200, - 172, 173, 174, 522, 201, 473, 468, 202, 203, 204, - 205, 450, 207, 474, 208, -215, 460, 475, -215, 476, - 477, 480, 425, 428, 478, 197, 198, 199, 200, 543, - 389, 481, 484, 201, 485, 488, 202, 203, 204, 205, - -215, -215, -215, -215, 489, 200, 491, -215, 493, -215, - 201, 494, -215, 202, 203, 204, 205, 428, 512, -215, - -215, 495, 486, 497, 566, 504, 172, 173, 174, 172, - 173, 174, -215, 511, -215, -215, -215, -254, -215, -215, + 312, 313, -263, 172, 173, 174, 172, 173, 174, 400, + 401, 353, 272, 404, 354, 265, 336, 314, 315, 316, + 317, 413, 318, 119, 236, 237, 238, 239, 283, 319, + 285, 240, 340, 241, 425, 364, 428, 428, 506, 142, + 415, 509, 172, 173, 174, 513, 514, 437, 431, 501, + 428, 428, 439, 533, 132, 133, 224, 352, 172, 173, + 174, 461, 346, 524, 525, 118, 357, 372, 541, 542, + 320, 369, 450, 536, 382, 378, 383, 172, 173, 174, + 550, 385, 390, 392, 458, 225, 174, -83, 544, 397, + 556, 557, 546, 547, 226, 57, 172, 173, 174, 59, + 172, 173, 174, 565, 172, 173, 174, 398, 407, 417, + 559, 399, 469, 321, 322, 323, 472, 172, 173, 174, + 186, 187, 402, 57, 567, 406, 423, 479, 432, 286, + 446, 428, 572, 381, 442, 452, 142, 473, 474, 487, + 172, 173, 174, 459, 192, 193, 194, 195, 196, 197, + 198, 199, 200, -291, -291, -291, 205, 201, 186, 187, + 202, 203, 204, 205, 172, 173, 174, -215, 465, 389, + 428, 428, 515, 466, 517, 172, 173, 174, 172, 173, + 174, 467, 207, 522, 208, -215, -215, 468, 475, -215, + 200, 450, 186, 395, 476, 201, 460, 477, 202, 203, + 204, 205, 425, 428, 408, 481, 478, 455, 480, 543, + 488, -215, -215, -215, -215, 484, 485, 200, -215, 489, + -215, 491, 201, -215, 200, 202, 203, 204, 205, 201, + -215, -215, 202, 203, 204, 205, 493, 428, 494, 172, + 173, 174, 486, -215, 566, -215, -215, -215, 495, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, 516, 518, -254, 395, -215, -254, 408, - -215, -215, -215, -215, -215, 186, 187, 519, -215, 523, - 531, 172, 173, 174, 172, 173, 174, 545, 532, 548, - -254, -254, -254, -254, 549, 560, 561, -254, 107, -254, - 563, 571, -254, 195, 196, 197, 198, 199, 200, -254, - -254, 455, 242, 201, 456, 426, 202, 203, 204, 205, - 534, 568, -254, 470, -254, -254, -254, 388, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, 172, 173, 174, 445, -254, 371, 444, - -254, -254, -254, -254, -254, -13, 85, 490, -254, 521, - 499, 351, 0, 277, 438, 18, 19, 20, 21, 22, - 83, 0, 23, 463, 0, 0, 86, 24, 25, 26, + -215, -215, -215, -254, 497, 504, 511, -215, 456, 512, + -215, -215, -215, -215, -215, 172, 173, 174, -215, 516, + 519, -254, -254, 518, 523, -254, 1, 2, 3, 4, + 5, 6, 7, 186, 187, 201, 531, 532, 202, 203, + 204, 205, 545, 548, 463, 549, 560, -254, -254, -254, + -254, 561, 563, 107, -254, 571, -254, 242, 426, -254, + 195, 196, 197, 198, 199, 200, -254, -254, 534, 568, + 201, 388, 470, 202, 203, 204, 205, 371, 444, -254, + 445, -254, -254, -254, 490, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, -254, 365, + 366, 367, 368, -254, 521, 277, -254, -254, -254, -254, + -254, -13, 85, 499, -254, 351, 0, 438, 0, 0, + 0, 18, 19, 20, 21, 22, 83, 0, 23, 0, + 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, + 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 193, 194, 195, 196, 197, 198, + 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, + 203, 204, 205, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, -3, 85, 0, 0, 0, 56, + 57, 58, 0, 0, 18, 19, 20, 21, 22, 83, + 0, 23, 0, 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 186, 187, 97, 98, 99, 100, 37, + 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 1, 2, 3, 4, - 5, 6, 7, 0, 0, 50, 200, 0, 0, 0, + 44, 45, 46, 47, 48, 49, 0, 0, 194, 195, + 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, + 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, + 22, 83, 416, 23, 0, 0, 0, 0, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, -3, 85, - 0, 0, 0, 56, 57, 58, 0, 0, 18, 19, - 20, 21, 22, 83, 0, 23, 0, 0, 0, 86, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 0, 186, 0, 97, 98, - 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 200, - 0, 0, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, + 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, + 20, 21, 22, 83, 537, 23, 0, 0, 0, 0, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 199, 200, 50, + 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, - 18, 19, 20, 21, 22, 83, 416, 23, 0, 0, - 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 236, 237, 238, 239, + 18, 19, 20, 21, 22, 83, 538, 23, 0, 0, + 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 236, 237, 238, 239, 0, 0, 0, 240, 0, 241, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 21, 22, 83, 537, 23, - 172, 173, 174, 86, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, - 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 58, 0, 18, 19, 20, 21, 22, 83, 540, 23, + 172, 173, 174, 0, 86, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, - 538, 23, 0, 0, 0, 86, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, - 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 554, 23, 0, 0, 0, 0, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, - 22, 83, 540, 23, 0, 0, 0, 86, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, - 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 22, 83, 0, 23, 0, 0, 0, 0, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 21, 22, 83, 554, 23, 0, 0, 0, 86, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, - 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 20, 21, 22, 83, 0, 23, 0, 0, 0, 0, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, 0, 23, 0, 0, - 0, 86, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 569, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 21, 22, 83, 0, 23, - 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, - 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 58, 0, 18, 19, 20, 21, 22, 0, 0, 23, + 0, 0, 0, 0, -78, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, - 0, 23, 0, 0, 0, 86, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 87, 0, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, - 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 56, 57, 58, 0, 18, 19, 20, 21, 22, 0, + 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, - 22, 0, 0, 23, 0, 0, 0, -78, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, + 0, -78, 56, 57, 58, 18, 19, 20, 21, 22, + 83, 0, 23, 0, 0, 0, 0, 0, 141, 25, + 26, 27, 28, 117, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, - 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 193, 194, 195, - 196, 197, 198, 199, 200, 0, 50, 0, 0, 201, - 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 23, 123, 0, 0, 0, 0, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, + 21, 22, 83, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 186, 187, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 50, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, -78, 56, 57, 58, 18, - 19, 20, 21, 22, 83, 0, 23, 0, 0, 0, - 0, 141, 25, 26, 27, 28, 117, 29, 30, 31, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, + 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, + 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 23, 123, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, + 19, 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -549,9 +580,9 @@ static const yytype_int16 yytable[] = 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, - 58, 18, 19, 20, 21, 22, 83, 0, 23, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 0, 0, 0, 0, 168, 56, 57, 58, + 18, 19, 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, @@ -559,40 +590,40 @@ static const yytype_int16 yytable[] = 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 23, - 0, 0, 0, 149, 24, 25, 26, 27, 28, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 0, 0, 0, 0, 266, 56, 57, + 58, 18, 19, 20, 21, 22, 0, 0, 23, 0, + 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, - 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 23, 0, 0, 0, 0, 24, 25, 26, 27, 28, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, + 57, 58, 18, 19, 20, 21, 22, 0, 0, 23, + 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 168, 56, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 23, 0, 0, 0, 0, 24, 25, 26, 27, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, + 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, + 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 266, 56, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 23, 0, 0, 0, 0, 24, 25, 26, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, + 326, 56, 57, 58, 18, 19, 20, 21, 22, 0, + 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -600,9 +631,9 @@ static const yytype_int16 yytable[] = 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 281, 56, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 23, 0, 0, 0, 0, 24, 25, + 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, + 0, 386, 56, 57, 58, 18, 19, 20, 21, 22, + 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -610,9 +641,9 @@ static const yytype_int16 yytable[] = 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 293, 56, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 23, 0, 0, 0, 0, 24, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, + 0, 0, 403, 56, 57, 58, 18, 19, 20, 21, + 22, 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -620,407 +651,376 @@ static const yytype_int16 yytable[] = 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 326, 56, 57, 58, 18, 19, - 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, + 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, + 21, 22, 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 386, 56, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 23, 0, 0, 0, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 403, 56, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 23, 0, 0, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, - 58, 18, 19, 20, 21, 22, 0, 0, 23, 0, - 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 185, 0, 0, 0, 0, - 0, 0, 186, 187, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 0, 275, - 57, 58, 188, 189, 396, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 188, 189, - 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 0, 275, 57, 58, 188, 189, + 396, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 189, 0, 190, 191, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, - 0, 0, 201, -291, 0, 202, 203, 204, 205, 0, - 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 188, 189, 0, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, + 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 199, 200, 0, 0, 0, 0, 201, -291, 0, 202, + 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, 0, - 0, 202, 203, 204, 205 + 0, 0, 0, 0, 0, 0, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, - 12, 13, 108, 50, 355, 23, 17, 12, 13, 262, - 506, 20, 21, 22, 12, 13, 25, 26, 12, 153, - 15, 81, 17, 0, 12, 13, 14, 45, 17, 15, - 22, 74, 345, 42, 43, 27, 22, 21, 56, 48, - 15, 27, 355, 21, 11, 358, 359, 25, 57, 58, - 15, 111, 108, 20, 21, 22, 21, 15, 25, 26, - 71, 20, 21, 22, 22, 108, 25, 26, 83, 27, - 15, 567, 17, 17, 41, 42, 43, 44, 125, 108, - 558, 69, 71, 42, 43, 92, 93, 99, 97, 18, - 57, 58, 92, 77, 78, 79, 108, 109, 145, 58, - 155, 81, 18, 155, 109, 90, 153, 108, 18, 19, - 128, 109, 106, 108, 15, 18, 17, 256, 136, 137, - 138, 109, 32, 109, 110, 18, 439, 37, 15, 138, - 17, 41, 15, 100, 44, 90, 91, 47, 156, 49, - 18, 51, 52, 53, 54, 55, 155, 15, 77, 78, - 79, 109, 47, 48, 172, 173, 174, 22, 176, 177, - 178, 77, 78, 79, 131, 478, 479, 420, 18, 108, - 225, 138, 108, 225, 77, 78, 79, 108, 21, 138, - 18, 15, 108, 17, 77, 78, 79, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 108, 511, 77, - 78, 79, 18, 216, 217, 220, 221, 222, 223, 224, + 17, 125, 10, 48, 9, 42, 48, 19, 137, 138, + 12, 13, 475, 50, 355, 23, 17, 12, 13, 262, + 75, 20, 21, 22, 12, 13, 25, 26, 12, 153, + 506, 0, 15, 23, 12, 13, 14, 45, 28, 108, + 23, 15, 345, 42, 43, 28, 22, 22, 56, 48, + 17, 26, 355, 108, 11, 358, 359, 17, 57, 58, + 15, 108, 17, 20, 21, 22, 19, 15, 25, 26, + 108, 20, 21, 22, 92, 23, 25, 26, 83, 15, + 28, 17, 15, 90, 41, 42, 43, 44, 125, 22, + 15, 567, 70, 42, 43, 558, 15, 99, 97, 111, + 57, 58, 78, 79, 80, 72, 108, 109, 145, 58, + 155, 108, 72, 155, 109, 23, 153, 72, 18, 19, + 128, 109, 106, 15, 18, 17, 109, 256, 136, 137, + 138, 109, 32, 18, 22, 108, 439, 37, 15, 138, + 17, 41, 108, 100, 44, 92, 93, 47, 156, 49, + 18, 51, 52, 53, 54, 55, 155, 15, 15, 17, + 17, 109, 110, 108, 172, 173, 174, 108, 176, 177, + 178, 15, 108, 17, 131, 478, 479, 420, 18, 22, + 225, 138, 108, 225, 78, 79, 80, 90, 91, 138, + 78, 79, 80, 78, 79, 80, 18, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 22, 511, 18, + 78, 79, 80, 108, 72, 220, 221, 222, 223, 224, 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 77, 78, 79, 77, 78, 79, - 69, 108, 545, 18, 77, 78, 79, 71, 256, 77, - 78, 79, 376, 35, 36, 155, 15, 15, 17, 17, - 21, 21, 270, 12, 13, 14, 15, 275, 17, 49, - 99, 77, 78, 79, 23, 175, 233, 285, 407, 108, - 109, 181, 89, 90, 184, 185, 186, 187, 188, 189, + 238, 239, 240, 241, 22, 78, 79, 80, 78, 79, + 80, 22, 545, 18, 50, 15, 18, 17, 256, 78, + 79, 80, 376, 48, 49, 155, 78, 79, 80, 15, + 108, 17, 270, 78, 79, 80, 107, 275, 75, 78, + 79, 80, 216, 217, 26, 175, 233, 285, 407, 89, + 90, 181, 18, 72, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 77, 78, 79, 15, 21, 17, 21, 317, - 318, 356, 71, 321, 356, 64, 77, 78, 79, 477, - 21, 108, 480, 322, 21, 25, 484, 485, 74, 103, - 104, 105, 106, 71, 342, 343, 344, 345, 107, 376, - 21, 77, 78, 79, 502, 503, 16, 355, 347, 473, - 358, 359, 357, 15, 512, 17, 107, 356, 17, 108, - 109, 110, 77, 78, 79, 322, 71, 22, 22, 527, - 99, 107, 377, 531, 532, 108, 77, 78, 79, 27, - 77, 78, 79, 81, 392, 43, 44, 45, 46, 25, - 75, 549, 50, 107, 52, 509, 77, 78, 79, 407, - 77, 78, 79, 16, 25, 563, 17, 79, 110, 71, - 524, 525, 417, 571, 110, 110, 421, 110, 110, 77, - 78, 79, 536, 22, 108, 62, 63, 432, 20, 109, - 107, 439, 546, 547, 108, 82, 473, 100, 107, 447, - 103, 104, 105, 106, 108, 559, 62, 63, 16, 107, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 238, - 239, 240, 241, 100, 16, 16, 103, 104, 105, 106, - 478, 479, 489, 16, 491, 62, 63, 0, 94, 95, - 77, 78, 79, 500, 100, 22, 16, 103, 104, 105, - 106, 496, 15, 107, 17, 18, 396, 107, 21, 107, - 107, 107, 510, 511, 108, 92, 93, 94, 95, 526, - 107, 21, 107, 100, 107, 75, 103, 104, 105, 106, - 43, 44, 45, 46, 15, 95, 15, 50, 16, 52, - 100, 107, 55, 103, 104, 105, 106, 545, 107, 62, - 63, 21, 442, 21, 561, 15, 77, 78, 79, 77, - 78, 79, 75, 108, 77, 78, 79, 0, 81, 82, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 107, 73, 18, 107, 100, 21, 107, - 103, 104, 105, 106, 107, 62, 63, 21, 111, 21, - 107, 77, 78, 79, 77, 78, 79, 108, 107, 21, - 43, 44, 45, 46, 107, 19, 72, 50, 13, 52, - 107, 107, 55, 90, 91, 92, 93, 94, 95, 62, - 63, 107, 106, 100, 107, 343, 103, 104, 105, 106, - 510, 564, 75, 419, 77, 78, 79, 277, 81, 82, + 200, 201, 72, 78, 79, 80, 78, 79, 80, 317, + 318, 356, 16, 321, 356, 107, 23, 12, 13, 14, + 15, 22, 17, 322, 44, 45, 46, 47, 72, 24, + 17, 51, 23, 53, 342, 343, 344, 345, 477, 376, + 22, 480, 78, 79, 80, 484, 485, 355, 347, 473, + 358, 359, 357, 509, 35, 36, 70, 356, 78, 79, + 80, 22, 99, 502, 503, 322, 108, 19, 524, 525, + 65, 28, 377, 512, 76, 26, 107, 78, 79, 80, + 536, 16, 26, 17, 392, 99, 80, 107, 527, 110, + 546, 547, 531, 532, 108, 109, 78, 79, 80, 407, + 78, 79, 80, 559, 78, 79, 80, 110, 108, 21, + 549, 110, 417, 108, 109, 110, 421, 78, 79, 80, + 63, 64, 110, 109, 563, 110, 23, 432, 108, 107, + 107, 439, 571, 107, 82, 108, 473, 23, 107, 447, + 78, 79, 80, 16, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 103, 104, 105, 106, 100, 63, 64, + 103, 104, 105, 106, 78, 79, 80, 0, 16, 107, + 478, 479, 489, 16, 491, 78, 79, 80, 78, 79, + 80, 16, 15, 500, 17, 18, 19, 16, 107, 22, + 95, 496, 63, 107, 107, 100, 396, 107, 103, 104, + 105, 106, 510, 511, 107, 22, 108, 107, 107, 526, + 76, 44, 45, 46, 47, 107, 107, 95, 51, 15, + 53, 15, 100, 56, 95, 103, 104, 105, 106, 100, + 63, 64, 103, 104, 105, 106, 16, 545, 107, 78, + 79, 80, 442, 76, 561, 78, 79, 80, 22, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 77, 78, 79, 372, 100, 248, 371, - 103, 104, 105, 106, 107, 0, 1, 452, 111, 496, - 471, 225, -1, 155, 356, 10, 11, 12, 13, 14, - 15, -1, 17, 107, -1, -1, 21, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, -1, 62, 63, 50, 51, 52, 53, 54, - -1, 56, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, 3, 4, 5, 6, - 7, 8, 9, -1, -1, 80, 95, -1, -1, -1, + 93, 94, 95, 0, 22, 15, 108, 100, 107, 107, + 103, 104, 105, 106, 107, 78, 79, 80, 111, 107, + 22, 18, 19, 74, 22, 22, 3, 4, 5, 6, + 7, 8, 9, 63, 64, 100, 107, 107, 103, 104, + 105, 106, 108, 22, 107, 107, 20, 44, 45, 46, + 47, 73, 107, 13, 51, 107, 53, 106, 343, 56, + 90, 91, 92, 93, 94, 95, 63, 64, 510, 564, + 100, 277, 419, 103, 104, 105, 106, 248, 371, 76, + 372, 78, 79, 80, 452, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 238, + 239, 240, 241, 100, 496, 155, 103, 104, 105, 106, + 107, 0, 1, 471, 111, 225, -1, 356, -1, -1, + -1, 10, 11, 12, 13, 14, 15, -1, 17, -1, + -1, -1, -1, 22, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, + 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, 88, 89, 90, 91, 92, 93, + 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, + 104, 105, 106, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 0, 1, -1, -1, -1, 108, + 109, 110, -1, -1, 10, 11, 12, 13, 14, 15, + -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, + -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, 89, 90, + 91, 92, 93, 94, 95, 81, -1, -1, -1, 100, + -1, -1, 103, 104, 105, 106, -1, -1, -1, -1, + 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, + -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, + 14, 15, 16, 17, -1, -1, -1, -1, 22, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, + 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + -1, -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 0, 1, - -1, -1, -1, 108, 109, 110, -1, -1, 10, 11, - 12, 13, 14, 15, -1, 17, -1, -1, -1, 21, - 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, + -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 12, 13, 14, 15, 16, 17, -1, -1, -1, -1, + 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, -1, 62, -1, 50, 51, - 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 80, 95, - -1, -1, -1, -1, 100, -1, -1, 103, 104, 105, - 106, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, + 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, -1, -1, -1, -1, -1, 94, 95, 81, + -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, 16, 17, -1, -1, - -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, + -1, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, - 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, - 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, - 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 80, -1, -1, -1, -1, -1, 43, 44, 45, 46, - -1, -1, -1, 50, -1, 52, 96, 97, -1, 99, + 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, + -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, + 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, + 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 81, -1, -1, -1, -1, 44, 45, 46, 47, + -1, -1, -1, 51, -1, 53, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, 16, 17, - 77, 78, 79, 21, 22, 23, 24, 25, 26, -1, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, - -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, - 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + 78, 79, 80, -1, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, - 16, 17, -1, -1, -1, 21, 22, 23, 24, 25, - 26, -1, 28, 29, 30, 31, 32, 33, 34, 35, + 16, 17, -1, -1, -1, -1, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, - 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, - 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, + -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, - 14, 15, 16, 17, -1, -1, -1, 21, 22, 23, - 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, + 14, 15, -1, 17, -1, -1, -1, -1, 22, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, -1, -1, -1, 50, 51, 52, 53, - 54, -1, 56, 57, 58, 59, 60, 61, -1, -1, - 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, + 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, + 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + 74, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, - 12, 13, 14, 15, 16, 17, -1, -1, -1, 21, - 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, + 12, 13, 14, 15, -1, 17, -1, -1, -1, -1, + 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, -1, -1, -1, 50, 51, - 52, 53, 54, -1, 56, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, + 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, + 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, -1, 17, -1, -1, - -1, 21, 22, 23, 24, 25, 26, -1, 28, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, -1, -1, -1, - 50, 51, 52, 53, 54, -1, 56, 57, 58, 59, - 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, - 70, -1, -1, 73, -1, -1, -1, -1, -1, -1, - 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 22, 23, 24, 25, 26, 27, -1, 29, + 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, + -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, + 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, + 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, - 110, -1, 10, 11, 12, 13, 14, 15, -1, 17, - -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, -1, - -1, -1, 50, 51, 52, 53, 54, -1, 56, 57, - 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + 110, -1, 10, 11, 12, 13, 14, -1, -1, 17, + -1, -1, -1, -1, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, + -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, - 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, - -1, 17, -1, -1, -1, 21, 22, 23, 24, 25, - 26, -1, 28, 29, 30, 31, 32, 33, 34, -1, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, -1, -1, -1, 50, 51, 52, 53, 54, -1, - 56, 57, 58, 59, 60, 61, -1, -1, 64, 65, - 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + 108, 109, 110, -1, 10, 11, 12, 13, 14, -1, + -1, 17, -1, -1, -1, -1, -1, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, + -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, + -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, - -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, - 14, -1, -1, 17, -1, -1, -1, 21, 22, 23, - 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, - -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, - -1, 62, 63, -1, -1, -1, -1, -1, -1, -1, - 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, - 64, 65, 66, 67, 68, 69, 70, 88, 89, 90, - 91, 92, 93, 94, 95, -1, 80, -1, -1, 100, - -1, -1, 103, 104, 105, 106, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, - -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, + -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, + 15, -1, 17, -1, -1, -1, -1, -1, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, + -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, + 14, -1, -1, 17, 18, -1, -1, -1, -1, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, + -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, + 13, 14, 15, -1, 17, -1, -1, -1, -1, -1, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, - 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, - 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, - -1, -1, 62, 63, -1, -1, -1, -1, -1, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, 89, - 90, 91, 92, 93, 94, 95, -1, -1, 80, -1, - 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, 13, 14, 15, -1, 17, -1, -1, -1, - -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, - 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, + 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, + 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, - 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, + -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, + 11, 12, 13, 14, -1, -1, 17, -1, -1, -1, + -1, -1, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, + 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, - 10, 11, 12, 13, 14, -1, -1, 17, 18, -1, - -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, - 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, - 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, - 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, - 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, + 10, 11, 12, 13, 14, -1, -1, 17, -1, -1, + -1, -1, -1, 23, 24, 25, 26, 27, -1, 29, + 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, + 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, + 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, + 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, - 110, 10, 11, 12, 13, 14, 15, -1, 17, -1, - -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, - 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 80, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, + 110, 10, 11, 12, 13, 14, -1, -1, 17, -1, + -1, -1, -1, -1, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, + -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, + 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, - -1, -1, -1, 21, 22, 23, 24, 25, 26, -1, - 28, 29, 30, 31, 32, 33, -1, -1, -1, -1, - -1, 39, 40, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 54, -1, -1, 57, - 58, 59, 60, 61, -1, -1, 64, 65, 66, 67, - 68, 69, 70, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 80, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, + -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, + -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, - 17, -1, -1, -1, -1, 22, 23, 24, 25, 26, - -1, 28, 29, 30, 31, 32, 33, -1, -1, -1, - -1, -1, 39, 40, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 54, -1, -1, - 57, 58, 59, 60, 61, -1, -1, 64, 65, 66, - 67, 68, 69, 70, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 80, -1, -1, -1, -1, -1, -1, + 17, -1, -1, -1, -1, -1, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, + -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, + -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, - 26, -1, 28, 29, 30, 31, 32, 33, -1, -1, - -1, -1, -1, 39, 40, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 54, -1, - -1, 57, 58, 59, 60, 61, -1, -1, 64, 65, - 66, 67, 68, 69, 70, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 80, -1, -1, -1, -1, -1, + -1, 17, -1, -1, -1, -1, -1, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, + -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, + -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - -1, -1, 17, -1, -1, -1, -1, 22, 23, 24, - 25, 26, -1, 28, 29, 30, 31, 32, 33, -1, - -1, -1, -1, -1, 39, 40, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 54, - -1, -1, 57, 58, 59, 60, 61, -1, -1, 64, - 65, 66, 67, 68, 69, 70, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 80, -1, -1, -1, -1, + -1, -1, 17, -1, -1, -1, -1, -1, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, + -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, - 14, -1, -1, 17, -1, -1, -1, -1, 22, 23, - 24, 25, 26, -1, 28, 29, 30, 31, 32, 33, - -1, -1, -1, -1, -1, 39, 40, -1, -1, -1, + 14, -1, -1, 17, -1, -1, -1, -1, -1, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 54, -1, -1, 57, 58, 59, 60, 61, -1, -1, - 64, 65, 66, 67, 68, 69, 70, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 80, -1, -1, -1, + -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, - 13, 14, -1, -1, 17, -1, -1, -1, -1, 22, - 23, 24, 25, 26, -1, 28, 29, 30, 31, 32, - 33, -1, -1, -1, -1, -1, 39, 40, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 54, -1, -1, 57, 58, 59, 60, 61, -1, - -1, 64, 65, 66, 67, 68, 69, 70, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 80, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, - 22, 23, 24, 25, 26, -1, 28, 29, 30, 31, - 32, 33, -1, -1, -1, -1, -1, 39, 40, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 54, -1, -1, 57, 58, 59, 60, 61, - -1, -1, 64, 65, 66, 67, 68, 69, 70, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 80, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, 13, 14, -1, -1, 17, -1, -1, -1, - -1, 22, 23, 24, 25, 26, -1, 28, 29, 30, - 31, 32, 33, -1, -1, -1, -1, -1, 39, 40, + -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, + 13, 14, -1, -1, 17, -1, -1, -1, -1, -1, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 54, -1, -1, 57, 58, 59, 60, - 61, -1, -1, 64, 65, 66, 67, 68, 69, 70, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 80, + -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + -1, -1, 56, -1, -1, -1, -1, -1, -1, 63, + 64, -1, -1, 96, 97, -1, 99, -1, 101, 102, + -1, -1, -1, -1, -1, 108, 109, 110, 82, 83, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, -1, -1, -1, -1, 100, 56, -1, 103, + 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, 13, 14, -1, -1, 17, -1, -1, - -1, -1, 22, 23, 24, 25, 26, -1, 28, 29, - 30, 31, 32, 33, -1, -1, -1, -1, -1, 39, - 40, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 54, -1, -1, 57, 58, 59, - 60, 61, -1, -1, 64, 65, 66, 67, 68, 69, - 70, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 80, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, - 110, 10, 11, 12, 13, 14, -1, -1, 17, -1, - -1, -1, -1, 22, 23, 24, 25, 26, -1, 28, - 29, 30, 31, 32, 33, -1, -1, -1, -1, -1, - 39, 40, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 54, -1, -1, 57, 58, - 59, 60, 61, -1, -1, 64, 65, 66, 67, 68, - 69, 70, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 80, -1, -1, -1, 55, -1, -1, -1, -1, - -1, -1, 62, 63, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, - 109, 110, 82, 83, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, - 100, 55, -1, 103, 104, 105, 106, -1, 62, 63, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 82, 83, + -1, -1, -1, 82, 83, -1, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, + -1, 100, 56, -1, 103, 104, 105, 106, -1, 63, + 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, -1, -1, -1, -1, 100, 55, -1, 103, - 104, 105, 106, -1, 62, 63, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, - -1, -1, 100, 55, -1, 103, 104, 105, 106, -1, - 62, 63, -1, -1, -1, -1, -1, -1, -1, -1, + 94, 95, -1, -1, -1, -1, 100, 56, -1, 103, + 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, -1, -1, -1, -1, 100, -1, - -1, 103, 104, 105, 106 + -1, -1, -1, -1, -1, -1, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, + -1, 100, -1, -1, 103, 104, 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1029,61 +1029,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 14, 17, 22, 23, 24, 25, 26, 28, - 29, 30, 31, 32, 33, 39, 40, 54, 57, 58, - 59, 60, 61, 64, 65, 66, 67, 68, 69, 70, - 80, 96, 97, 99, 101, 102, 108, 109, 110, 174, + 12, 13, 14, 17, 23, 24, 25, 26, 27, 29, + 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, + 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, + 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 15, 121, 1, 21, 34, 36, 37, - 38, 41, 42, 43, 44, 45, 46, 50, 51, 52, - 53, 56, 121, 130, 141, 174, 35, 128, 129, 130, - 126, 168, 169, 126, 188, 188, 22, 27, 121, 200, + 205, 206, 207, 15, 121, 1, 22, 35, 37, 38, + 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, + 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, + 126, 168, 169, 126, 188, 188, 23, 28, 121, 200, 208, 208, 208, 18, 174, 208, 208, 189, 17, 108, - 188, 152, 152, 152, 188, 108, 108, 74, 108, 121, - 188, 22, 175, 192, 200, 208, 208, 121, 188, 21, - 174, 22, 27, 154, 188, 99, 108, 191, 200, 201, + 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, + 188, 23, 175, 192, 200, 208, 208, 121, 188, 22, + 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 77, 78, 79, 81, 15, 17, 108, 92, - 93, 92, 90, 91, 90, 55, 62, 63, 82, 83, + 208, 208, 78, 79, 80, 19, 15, 17, 108, 92, + 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 100, 103, 104, 105, 106, 108, 15, 17, 15, - 17, 15, 17, 15, 123, 153, 154, 154, 22, 151, - 108, 108, 108, 108, 69, 99, 108, 198, 200, 108, - 108, 121, 21, 49, 143, 21, 43, 44, 45, 46, - 50, 52, 129, 130, 128, 12, 13, 109, 159, 160, - 162, 163, 164, 165, 18, 192, 108, 74, 174, 107, - 121, 25, 155, 71, 156, 107, 107, 174, 193, 193, - 208, 175, 16, 21, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 71, 157, 17, 107, 174, 174, 174, + 17, 15, 17, 15, 123, 153, 154, 154, 23, 151, + 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, + 108, 121, 22, 50, 143, 22, 44, 45, 46, 47, + 51, 53, 129, 130, 128, 12, 13, 109, 159, 160, + 162, 163, 164, 165, 18, 192, 108, 75, 174, 107, + 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, + 208, 175, 16, 22, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 72, 157, 17, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 12, 13, 14, 15, 17, 23, - 64, 108, 109, 110, 178, 200, 107, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 22, 150, 151, 151, - 22, 133, 123, 123, 123, 123, 99, 123, 69, 196, + 188, 188, 188, 188, 12, 13, 14, 15, 17, 24, + 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, + 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 27, - 158, 158, 81, 193, 175, 18, 177, 156, 25, 123, - 173, 107, 75, 107, 174, 16, 107, 174, 157, 107, - 25, 174, 17, 21, 18, 107, 84, 110, 110, 110, - 174, 174, 110, 107, 174, 110, 110, 108, 107, 21, - 18, 21, 18, 21, 18, 21, 16, 20, 122, 131, - 132, 15, 21, 22, 146, 174, 147, 148, 174, 148, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, + 158, 158, 19, 193, 175, 18, 177, 156, 26, 123, + 173, 107, 76, 107, 174, 16, 107, 174, 157, 107, + 26, 174, 17, 22, 18, 107, 84, 110, 110, 110, + 174, 174, 110, 107, 174, 110, 110, 108, 107, 22, + 18, 22, 18, 22, 18, 22, 16, 21, 122, 131, + 132, 15, 22, 23, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, 123, 171, 108, 166, 167, 107, 107, 18, 174, 16, - 188, 21, 18, 107, 193, 16, 16, 16, 16, 123, - 155, 156, 123, 22, 107, 107, 107, 107, 108, 123, - 107, 21, 136, 148, 107, 107, 188, 174, 75, 15, - 168, 15, 18, 16, 107, 21, 156, 21, 172, 173, + 188, 22, 18, 107, 193, 16, 16, 16, 16, 123, + 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, + 107, 22, 136, 148, 107, 107, 188, 174, 76, 15, + 168, 15, 18, 16, 107, 22, 156, 22, 172, 173, 137, 192, 144, 144, 15, 124, 124, 148, 148, 124, - 134, 108, 107, 124, 124, 126, 107, 126, 73, 21, - 170, 171, 126, 21, 124, 124, 125, 47, 48, 142, + 134, 108, 107, 124, 124, 126, 107, 126, 74, 22, + 170, 171, 126, 22, 124, 124, 125, 48, 49, 142, 142, 107, 107, 143, 146, 148, 124, 16, 16, 127, - 16, 143, 143, 126, 124, 108, 124, 124, 21, 107, - 143, 21, 25, 138, 16, 148, 143, 143, 135, 124, - 19, 72, 139, 107, 144, 143, 126, 124, 149, 73, + 16, 143, 143, 126, 124, 108, 124, 124, 22, 107, + 143, 22, 26, 138, 16, 148, 143, 143, 135, 124, + 20, 73, 139, 107, 144, 143, 126, 124, 149, 74, 142, 107, 124 }; @@ -1168,14 +1168,14 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, @@ -1201,6 +1201,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 2e61cf01f0e14707d220536eb9865fe226c153c967f8aa51eea0786f6a56feb9 perly.y + * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 3d1a09e9187d..9f01052bbc4e 100644 --- a/perly.y +++ b/perly.y @@ -51,6 +51,7 @@ %token PERLY_BRACE_CLOSE %token PERLY_BRACKET_OPEN %token PERLY_BRACKET_CLOSE +%token PERLY_COMMA %token PERLY_DOT %token PERLY_EQUAL_SIGN %token PERLY_SEMICOLON @@ -99,7 +100,7 @@ %left ANDOP %right NOTOP %nonassoc LSTOP LSTOPSUB -%left ',' +%left PERLY_COMMA %right ASSIGNOP %right '?' ':' %nonassoc DOTDOT @@ -763,9 +764,9 @@ sigelem: sigscalarelem /* list of subroutine signature elements */ siglist: - siglist[list] ',' + siglist[list] PERLY_COMMA { $$ = $list; } - | siglist[list] ',' sigelem[element] + | siglist[list] PERLY_COMMA sigelem[element] { $$ = op_append_list(OP_LINESEQ, $list, $element); } @@ -900,9 +901,9 @@ expr : expr[lhs] ANDOP expr[rhs] ; /* Expressions are a list of terms joined by commas */ -listexpr: listexpr[list] ',' +listexpr: listexpr[list] PERLY_COMMA { $$ = $list; } - | listexpr[list] ',' term + | listexpr[list] PERLY_COMMA term { OP* term = $term; $$ = op_append_elem(OP_LIST, $list, term); diff --git a/toke.c b/toke.c index 39da4651f0b6..dee103ddf335 100644 --- a/toke.c +++ b/toke.c @@ -391,6 +391,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), + DEBUG_TOKEN (IVAL, PERLY_COMMA), DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), @@ -4991,7 +4992,10 @@ yyl_sigvar(pTHX_ char *s) break; } - TOKEN(sigil); + switch (sigil) { + case ',': TOKEN (PERLY_COMMA); + default: TOKEN (sigil); + } } static int @@ -5400,7 +5404,7 @@ yyl_interpcasemod(pTHX_ char *s) PL_lex_starts = 0; /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ if (PL_lex_casemods == 1 && PL_lex_inpat) - TOKEN(','); + TOKEN(PERLY_COMMA); else AopNOASSIGN(OP_CONCAT); } @@ -8817,7 +8821,7 @@ yyl_try(pTHX_ char *s) if (!PL_lex_allbrackets && PL_lex_fakeeof >= LEX_FAKEEOF_COMMA) TOKEN(0); s++; - OPERATOR(','); + OPERATOR(PERLY_COMMA); case ':': if (s[1] == ':') return yyl_just_a_word(aTHX_ s, 0, 0, no_code); @@ -8881,7 +8885,7 @@ yyl_try(pTHX_ char *s) s -= 2; TOKEN(0); } - OPERATOR(','); + OPERATOR(PERLY_COMMA); } if (tmp == '~') PMop(OP_MATCH); @@ -9267,7 +9271,7 @@ Perl_yylex(pTHX) PL_lex_state = LEX_INTERPNORMAL; if (PL_lex_dojoin) { NEXTVAL_NEXTTOKE.ival = 0; - force_next(','); + force_next(PERLY_COMMA); force_ident("\"", '$'); NEXTVAL_NEXTTOKE.ival = 0; force_next('$'); @@ -9290,7 +9294,7 @@ Perl_yylex(pTHX) s = PL_bufptr; /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ if (!PL_lex_casemods && PL_lex_inpat) - TOKEN(','); + TOKEN(PERLY_COMMA); else AopNOASSIGN(OP_CONCAT); } @@ -9345,7 +9349,7 @@ Perl_yylex(pTHX) force_next(THING); PL_parser->lex_shared->re_eval_start = NULL; PL_expect = XTERM; - return REPORT(','); + return REPORT(PERLY_COMMA); } /* FALLTHROUGH */ @@ -9389,7 +9393,7 @@ Perl_yylex(pTHX) if (PL_lex_starts++) { /* commas only at base level: /$a\Ub$c/ => ($a,uc(b.$c)) */ if (!PL_lex_casemods && PL_lex_inpat) - TOKEN(','); + TOKEN(PERLY_COMMA); else AopNOASSIGN(OP_CONCAT); } From 1c2e9449254ebd07b473cb641d8568dffc1ecbb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:07 +0100 Subject: [PATCH 333/503] Distinguish C- and perly- literals - PERLY_EXCLAMATION_MARK --- perly.act | 2 +- perly.h | 21 +++++++++++---------- perly.tab | 52 ++++++++++++++++++++++++++-------------------------- perly.y | 4 ++-- toke.c | 5 +++-- 5 files changed, 43 insertions(+), 41 deletions(-) diff --git a/perly.act b/perly.act index 178328adbe06..86691ff18254 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y + * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index e39f8cbb1bce..2549f31dd458 100644 --- a/perly.h +++ b/perly.h @@ -143,15 +143,16 @@ extern int yydebug; NCRELOP = 342, SHIFTOP = 343, MATCHOP = 344, - UMINUS = 345, - REFGEN = 346, - POWOP = 347, - PREINC = 348, - PREDEC = 349, - POSTINC = 350, - POSTDEC = 351, - POSTJOIN = 352, - ARROW = 353 + PERLY_EXCLAMATION_MARK = 345, + UMINUS = 346, + REFGEN = 347, + POWOP = 348, + PREINC = 349, + PREDEC = 350, + POSTINC = 351, + POSTDEC = 352, + POSTJOIN = 353, + ARROW = 354 }; #endif @@ -203,6 +204,6 @@ int yyparse (void); /* Generated from: - * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y + * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index f84afd22f878..dc57a07d33d2 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 353 +#define YYMAXUTOK 354 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,7 +33,7 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 96, 2, 2, 109, 13, 2, 2, + 2, 2, 2, 2, 2, 2, 109, 13, 2, 2, 108, 107, 110, 11, 2, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, @@ -64,8 +64,8 @@ static const yytype_int8 yytranslate[] = 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, 98, 99, 100, 101, 102, - 103, 104, 105, 106 + 91, 92, 93, 94, 95, 96, 98, 99, 100, 101, + 102, 103, 104, 105, 106 }; #if YYDEBUG @@ -125,16 +125,16 @@ static const char *const yytname[] = "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", - "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "'!'", "'~'", "UMINUS", - "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", - "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", - "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", - "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", - "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", - "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", + "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", + "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", "'/'", + "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", + "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", + "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", + "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", + "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", + "formname", "startsub", "startanonsub", "startformsub", "subname", + "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", @@ -161,8 +161,8 @@ static const yytype_int16 yytoknum[] = 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, 63, 58, 334, 335, 336, 337, 338, - 339, 340, 341, 342, 343, 344, 33, 126, 345, 346, - 347, 348, 349, 350, 351, 352, 353, 41, 40, 36, + 339, 340, 341, 342, 343, 344, 345, 126, 346, 347, + 348, 349, 350, 351, 352, 353, 354, 41, 40, 36, 42, 47 }; # endif @@ -1179,16 +1179,16 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1201,6 +1201,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * dc3a381751f2897cbaa6dc2f792cd125a225072206d399dd4981603f81f78a24 perly.y + * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 9f01052bbc4e..4998d660c90a 100644 --- a/perly.y +++ b/perly.y @@ -116,7 +116,7 @@ %left ADDOP %left MULOP %left MATCHOP -%right '!' '~' UMINUS REFGEN +%right PERLY_EXCLAMATION_MARK '~' UMINUS REFGEN %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC POSTJOIN %left ARROW @@ -1100,7 +1100,7 @@ termunop : '-' term %prec UMINUS /* -$x */ | '+' term %prec UMINUS /* +$x */ { $$ = $term; } - | '!' term /* !$x */ + | PERLY_EXCLAMATION_MARK term /* !$x */ { $$ = newUNOP(OP_NOT, 0, scalar($term)); } | '~' term /* ~$x */ { $$ = newUNOP($1, 0, scalar($term)); } diff --git a/toke.c b/toke.c index dee103ddf335..6b3c1beff13e 100644 --- a/toke.c +++ b/toke.c @@ -394,6 +394,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_COMMA), DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), + DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -6362,7 +6363,7 @@ yyl_bang(pTHX_ char *s) PMop(OP_NOT); s--; - OPERATOR('!'); + OPERATOR(PERLY_EXCLAMATION_MARK); } static int @@ -8949,7 +8950,7 @@ yyl_try(pTHX_ char *s) pl_yylval.ival = 0; OPERATOR(ASSIGNOP); - case '!': + case '!': return yyl_bang(aTHX_ s + 1); case '<': From 3d92c6b8aa91a3ee216dd4aafedacd8b6e129803 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:08 +0100 Subject: [PATCH 334/503] Distinguish C- and perly- literals - PERLY_TILDE --- perly.act | 2 +- perly.h | 21 +++++++------- perly.tab | 82 +++++++++++++++++++++++++++---------------------------- perly.y | 6 ++-- toke.c | 3 +- 5 files changed, 58 insertions(+), 56 deletions(-) diff --git a/perly.act b/perly.act index 86691ff18254..e4b1237d0a81 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y + * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 2549f31dd458..4e54401a56c3 100644 --- a/perly.h +++ b/perly.h @@ -144,15 +144,16 @@ extern int yydebug; SHIFTOP = 343, MATCHOP = 344, PERLY_EXCLAMATION_MARK = 345, - UMINUS = 346, - REFGEN = 347, - POWOP = 348, - PREINC = 349, - PREDEC = 350, - POSTINC = 351, - POSTDEC = 352, - POSTJOIN = 353, - ARROW = 354 + PERLY_TILDE = 346, + UMINUS = 347, + REFGEN = 348, + POWOP = 349, + PREINC = 350, + PREDEC = 351, + POSTINC = 352, + POSTDEC = 353, + POSTJOIN = 354, + ARROW = 355 }; #endif @@ -204,6 +205,6 @@ int yyparse (void); /* Generated from: - * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y + * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index dc57a07d33d2..3f20fa3ee92f 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 354 +#define YYMAXUTOK 355 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -42,7 +42,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 97, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -64,8 +64,8 @@ static const yytype_int8 yytranslate[] = 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, 82, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, 96, 98, 99, 100, 101, - 102, 103, 104, 105, 106 + 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, + 101, 102, 103, 104, 105, 106 }; #if YYDEBUG @@ -126,24 +126,24 @@ static const char *const yytname[] = "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", "':'", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", - "'~'", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", - "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", "'/'", - "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", - "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", - "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", - "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", - "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", - "formname", "startsub", "startanonsub", "startformsub", "subname", - "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", - "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", - "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", - "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", - "listexpr", "listop", "@16", "method", "subscripted", "termbinop", - "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", - "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", - "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", - "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", - "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", + "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", + "block", "formblock", "remember", "mblock", "mremember", "stmtseq", + "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", + "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", + "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", + "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", + "startformsub", "subname", "proto", "subattrlist", "myattrlist", + "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", + "sigscalarelem", "sigelem", "siglist", "siglistornull", + "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", + "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", + "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", + "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", + "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", + "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", + "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -161,8 +161,8 @@ static const yytype_int16 yytoknum[] = 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, 63, 58, 334, 335, 336, 337, 338, - 339, 340, 341, 342, 343, 344, 345, 126, 346, 347, - 348, 349, 350, 351, 352, 353, 354, 41, 40, 36, + 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, + 349, 350, 351, 352, 353, 354, 355, 41, 40, 36, 42, 47 }; # endif @@ -1180,27 +1180,27 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 3cfd0c6b00a7252ca445af346f4fab4fedfd3065533813882639354d90371d9d perly.y + * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 4998d660c90a..67bbda88ecab 100644 --- a/perly.y +++ b/perly.y @@ -116,7 +116,7 @@ %left ADDOP %left MULOP %left MATCHOP -%right PERLY_EXCLAMATION_MARK '~' UMINUS REFGEN +%right PERLY_EXCLAMATION_MARK PERLY_TILDE UMINUS REFGEN %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC POSTJOIN %left ARROW @@ -1102,8 +1102,8 @@ termunop : '-' term %prec UMINUS /* -$x */ | PERLY_EXCLAMATION_MARK term /* !$x */ { $$ = newUNOP(OP_NOT, 0, scalar($term)); } - | '~' term /* ~$x */ - { $$ = newUNOP($1, 0, scalar($term)); } + | PERLY_TILDE term /* ~$x */ + { $$ = newUNOP($PERLY_TILDE, 0, scalar($term)); } | term POSTINC /* $x++ */ { $$ = newUNOP(OP_POSTINC, 0, op_lvalue(scalar($term), OP_POSTINC)); } diff --git a/toke.c b/toke.c index 6b3c1beff13e..71b36e437a49 100644 --- a/toke.c +++ b/toke.c @@ -238,7 +238,7 @@ static const char* const lex_state_names[] = { #define BOop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITOROP)) #define BAop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)BITANDOP)) #define BCop(f) return pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr = s, \ - REPORT('~') + REPORT(PERLY_TILDE) #define SHop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)SHIFTOP)) #define PWop(f) return ao((pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, (int)POWOP)) #define PMop(f) return(pl_yylval.ival=f, PL_expect=XTERM, PL_bufptr=s, REPORT((int)MATCHOP)) @@ -396,6 +396,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), + DEBUG_TOKEN (IVAL, PERLY_TILDE), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, { PMFUNC, TOKENTYPE_OPVAL, "PMFUNC" }, From 3d9ccdfc9c042f91d022df1227f4b05ddeca831c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:09 +0100 Subject: [PATCH 335/503] Distinguish C- and perly- literals - PERLY_COLON --- perly.act | 2 +- perly.h | 47 ++++++++++++++++++++------------------- perly.tab | 66 +++++++++++++++++++++++++++---------------------------- perly.y | 4 ++-- toke.c | 5 +++-- 5 files changed, 63 insertions(+), 61 deletions(-) diff --git a/perly.act b/perly.act index e4b1237d0a81..35d711971640 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y + * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 4e54401a56c3..7fbcd2fb5b16 100644 --- a/perly.h +++ b/perly.h @@ -132,28 +132,29 @@ extern int yydebug; ANDOP = 331, NOTOP = 332, ASSIGNOP = 333, - OROR = 334, - DORDOR = 335, - ANDAND = 336, - BITOROP = 337, - BITANDOP = 338, - CHEQOP = 339, - NCEQOP = 340, - CHRELOP = 341, - NCRELOP = 342, - SHIFTOP = 343, - MATCHOP = 344, - PERLY_EXCLAMATION_MARK = 345, - PERLY_TILDE = 346, - UMINUS = 347, - REFGEN = 348, - POWOP = 349, - PREINC = 350, - PREDEC = 351, - POSTINC = 352, - POSTDEC = 353, - POSTJOIN = 354, - ARROW = 355 + PERLY_COLON = 334, + OROR = 335, + DORDOR = 336, + ANDAND = 337, + BITOROP = 338, + BITANDOP = 339, + CHEQOP = 340, + NCEQOP = 341, + CHRELOP = 342, + NCRELOP = 343, + SHIFTOP = 344, + MATCHOP = 345, + PERLY_EXCLAMATION_MARK = 346, + PERLY_TILDE = 347, + UMINUS = 348, + REFGEN = 349, + POWOP = 350, + PREINC = 351, + PREDEC = 352, + POSTINC = 353, + POSTDEC = 354, + POSTJOIN = 355, + ARROW = 356 }; #endif @@ -205,6 +206,6 @@ int yyparse (void); /* Generated from: - * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y + * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 3f20fa3ee92f..50e2a9bf6893 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 355 +#define YYMAXUTOK 356 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -35,7 +35,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 109, 13, 2, 2, 108, 107, 110, 11, 2, 10, 2, 111, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 2, 84, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -63,9 +63,9 @@ static const yytype_int8 yytranslate[] = 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, - 79, 80, 81, 82, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, - 101, 102, 103, 104, 105, 106 + 79, 80, 81, 82, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, + 100, 101, 102, 103, 104, 105, 106 }; #if YYDEBUG @@ -123,20 +123,20 @@ static const char *const yytname[] = "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", "':'", - "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", - "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", - "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", - "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", - "block", "formblock", "remember", "mblock", "mremember", "stmtseq", - "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", - "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", - "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", - "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", - "startformsub", "subname", "proto", "subattrlist", "myattrlist", - "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", - "sigscalarelem", "sigelem", "siglist", "siglistornull", + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", + "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", + "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", + "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", + "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", + "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", + "@5", "@6", "@7", "block", "formblock", "remember", "mblock", + "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", + "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", + "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", + "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", + "startanonsub", "startformsub", "subname", "proto", "subattrlist", + "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", + "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", @@ -160,9 +160,9 @@ static const yytype_int16 yytoknum[] = 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, - 331, 332, 333, 63, 58, 334, 335, 336, 337, 338, - 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, - 349, 350, 351, 352, 353, 354, 355, 41, 40, 36, + 331, 332, 333, 63, 334, 335, 336, 337, 338, 339, + 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, + 350, 351, 352, 353, 354, 355, 356, 41, 40, 36, 42, 47 }; # endif @@ -1177,20 +1177,20 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1201,6 +1201,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 3b37f5e99c3211f5a689f0b84d2f93ccb2d9dcee38cf8543545147c2f3232e4d perly.y + * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 67bbda88ecab..b05536b23a27 100644 --- a/perly.y +++ b/perly.y @@ -102,7 +102,7 @@ %nonassoc LSTOP LSTOPSUB %left PERLY_COMMA %right ASSIGNOP -%right '?' ':' +%right '?' PERLY_COLON %nonassoc DOTDOT %left OROR DORDOR %left ANDAND @@ -1158,7 +1158,7 @@ term[product] : termbinop | termunop | anonymous | termdo - | term[condition] '?' term[then] ':' term[else] + | term[condition] '?' term[then] PERLY_COLON term[else] { $$ = newCONDOP(0, $condition, $then, $else); } | REFGEN term[operand] /* \$x, \@y, \%z */ { $$ = newUNOP(OP_REFGEN, 0, $operand); } diff --git a/toke.c b/toke.c index 71b36e437a49..a0c9c479701f 100644 --- a/toke.c +++ b/toke.c @@ -391,6 +391,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_BRACE_OPEN), DEBUG_TOKEN (IVAL, PERLY_BRACKET_CLOSE), DEBUG_TOKEN (IVAL, PERLY_BRACKET_OPEN), + DEBUG_TOKEN (IVAL, PERLY_COLON), DEBUG_TOKEN (IVAL, PERLY_COMMA), DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), @@ -5910,7 +5911,7 @@ yyl_colon(pTHX_ char *s) : "Unterminated attribute list" ) ); if (attrs) op_free(attrs); - OPERATOR(':'); + OPERATOR(PERLY_COLON); } got_attrs: @@ -5935,7 +5936,7 @@ yyl_colon(pTHX_ char *s) } PL_lex_allbrackets--; - OPERATOR(':'); + OPERATOR(PERLY_COLON); } static int From a1ad62bfea2492db90c01a1b1dfe6612521d7c3a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:10 +0100 Subject: [PATCH 336/503] Distinguish C- and perly- literals - PERLY_QUESTION_MARK --- perly.act | 2 +- perly.h | 49 ++++++++++++++--------------- perly.tab | 92 ++++++++++++++++++++++++++++--------------------------- perly.y | 4 +-- toke.c | 3 +- 5 files changed, 77 insertions(+), 73 deletions(-) diff --git a/perly.act b/perly.act index 35d711971640..2a59215c8098 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y + * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 7fbcd2fb5b16..8cea4a40dc0f 100644 --- a/perly.h +++ b/perly.h @@ -132,29 +132,30 @@ extern int yydebug; ANDOP = 331, NOTOP = 332, ASSIGNOP = 333, - PERLY_COLON = 334, - OROR = 335, - DORDOR = 336, - ANDAND = 337, - BITOROP = 338, - BITANDOP = 339, - CHEQOP = 340, - NCEQOP = 341, - CHRELOP = 342, - NCRELOP = 343, - SHIFTOP = 344, - MATCHOP = 345, - PERLY_EXCLAMATION_MARK = 346, - PERLY_TILDE = 347, - UMINUS = 348, - REFGEN = 349, - POWOP = 350, - PREINC = 351, - PREDEC = 352, - POSTINC = 353, - POSTDEC = 354, - POSTJOIN = 355, - ARROW = 356 + PERLY_QUESTION_MARK = 334, + PERLY_COLON = 335, + OROR = 336, + DORDOR = 337, + ANDAND = 338, + BITOROP = 339, + BITANDOP = 340, + CHEQOP = 341, + NCEQOP = 342, + CHRELOP = 343, + NCRELOP = 344, + SHIFTOP = 345, + MATCHOP = 346, + PERLY_EXCLAMATION_MARK = 347, + PERLY_TILDE = 348, + UMINUS = 349, + REFGEN = 350, + POWOP = 351, + PREINC = 352, + PREDEC = 353, + POSTINC = 354, + POSTDEC = 355, + POSTJOIN = 356, + ARROW = 357 }; #endif @@ -206,6 +207,6 @@ int yyparse (void); /* Generated from: - * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y + * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 50e2a9bf6893..129809083005 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 356 +#define YYMAXUTOK 357 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -36,7 +36,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 109, 13, 2, 2, 108, 107, 110, 11, 2, 10, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 83, 12, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 12, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -63,9 +63,9 @@ static const yytype_int8 yytranslate[] = 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, - 79, 80, 81, 82, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, - 100, 101, 102, 103, 104, 105, 106 + 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, + 99, 100, 101, 102, 103, 104, 105, 106 }; #if YYDEBUG @@ -123,27 +123,28 @@ static const char *const yytname[] = "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "'?'", - "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", - "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", - "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", - "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", - "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", - "@5", "@6", "@7", "block", "formblock", "remember", "mblock", - "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", - "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", - "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", - "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", - "startanonsub", "startformsub", "subname", "proto", "subattrlist", - "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", - "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", - "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", - "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", - "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", - "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", - "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", - "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", - "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", + "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", + "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", + "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", + "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", + "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", + "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", + "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", + "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", + "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", + "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", + "startsub", "startanonsub", "startformsub", "subname", "proto", + "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", + "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", + "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", + "listexpr", "listop", "@16", "method", "subscripted", "termbinop", + "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", + "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", + "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", + "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", + "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -160,9 +161,9 @@ static const yytype_int16 yytoknum[] = 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, - 331, 332, 333, 63, 334, 335, 336, 337, 338, 339, - 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, - 350, 351, 352, 353, 354, 355, 356, 41, 40, 36, + 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, + 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, + 351, 352, 353, 354, 355, 356, 357, 41, 40, 36, 42, 47 }; # endif @@ -1177,30 +1178,31 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 4254f7a193750fc5d4d9a58ee880004d69cfaecdf245c298f9f6357f963e5f42 perly.y + * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index b05536b23a27..7f1158857e49 100644 --- a/perly.y +++ b/perly.y @@ -102,7 +102,7 @@ %nonassoc LSTOP LSTOPSUB %left PERLY_COMMA %right ASSIGNOP -%right '?' PERLY_COLON +%right PERLY_QUESTION_MARK PERLY_COLON %nonassoc DOTDOT %left OROR DORDOR %left ANDAND @@ -1158,7 +1158,7 @@ term[product] : termbinop | termunop | anonymous | termdo - | term[condition] '?' term[then] PERLY_COLON term[else] + | term[condition] PERLY_QUESTION_MARK term[then] PERLY_COLON term[else] { $$ = newCONDOP(0, $condition, $then, $else); } | REFGEN term[operand] /* \$x, \@y, \%z */ { $$ = newUNOP(OP_REFGEN, 0, $operand); } diff --git a/toke.c b/toke.c index a0c9c479701f..0535e8f9d013 100644 --- a/toke.c +++ b/toke.c @@ -396,6 +396,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), + DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), DEBUG_TOKEN (IVAL, PERLY_TILDE), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, @@ -8991,7 +8992,7 @@ yyl_try(pTHX_ char *s) TOKEN(0); } PL_lex_allbrackets++; - OPERATOR('?'); + OPERATOR(PERLY_QUESTION_MARK); case '.': if (PL_lex_formbrack && PL_lex_brackets == PL_lex_formbrack From 68a66a8beadf6521143536cc70b76b1127b141e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:11 +0100 Subject: [PATCH 337/503] Distinguish C- and perly- literals - PERLY_MINUS --- perly.act | 536 +++++++++++----------- perly.h | 173 +++---- perly.tab | 1314 ++++++++++++++++++++++++++--------------------------- perly.y | 5 +- toke.c | 7 +- 5 files changed, 1019 insertions(+), 1016 deletions(-) diff --git a/perly.act b/perly.act index 2a59215c8098..042f857f6250 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 131 "perly.y" +#line 132 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 136 "perly.y" +#line 137 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 142 "perly.y" +#line 143 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 147 "perly.y" +#line 148 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 152 "perly.y" +#line 153 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 157 "perly.y" +#line 158 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 165 "perly.y" +#line 166 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 170 "perly.y" +#line 171 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 178 "perly.y" +#line 179 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 183 "perly.y" +#line 184 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 191 "perly.y" +#line 192 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 196 "perly.y" +#line 197 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 201 "perly.y" +#line 202 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 206 "perly.y" +#line 207 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 214 "perly.y" +#line 215 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 222 "perly.y" +#line 223 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 229 "perly.y" +#line 230 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 234 "perly.y" +#line 235 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 241 "perly.y" +#line 242 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 247 "perly.y" +#line 248 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 249 "perly.y" +#line 250 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 258 "perly.y" +#line 259 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 260 "perly.y" +#line 261 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 269 "perly.y" +#line 270 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 273 "perly.y" +#line 274 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 277 "perly.y" +#line 278 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 284 "perly.y" +#line 285 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 294 "perly.y" +#line 295 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 296 "perly.y" +#line 297 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 308 "perly.y" +#line 309 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 314 "perly.y" +#line 315 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 329 "perly.y" +#line 330 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 335 "perly.y" +#line 336 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 346 "perly.y" +#line 347 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 353 "perly.y" +#line 354 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 355 "perly.y" +#line 356 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 362 "perly.y" +#line 363 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 368 "perly.y" +#line 369 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 374 "perly.y" +#line 375 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 379 "perly.y" +#line 380 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 381 "perly.y" +#line 382 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 383 "perly.y" +#line 384 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 390 "perly.y" +#line 391 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 397 "perly.y" +#line 398 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 399 "perly.y" +#line 400 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 402 "perly.y" +#line 403 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 417 "perly.y" +#line 418 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 422 "perly.y" +#line 423 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 428 "perly.y" +#line 429 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 430 "perly.y" +#line 431 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 443 "perly.y" +#line 444 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 451 "perly.y" +#line 452 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 457 "perly.y" +#line 458 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 463 "perly.y" +#line 464 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 470 "perly.y" +#line 471 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 478 "perly.y" +#line 479 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 482 "perly.y" +#line 483 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 487 "perly.y" +#line 488 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 495 "perly.y" +#line 496 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 512 "perly.y" +#line 513 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 514 "perly.y" +#line 515 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 522 "perly.y" +#line 523 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 537 "perly.y" +#line 538 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 542 "perly.y" +#line 543 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 544 "perly.y" +#line 545 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 549 "perly.y" +#line 550 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 559 "perly.y" +#line 560 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 561 "perly.y" +#line 562 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 566 "perly.y" +#line 567 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 572 "perly.y" +#line 573 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 578 "perly.y" +#line 579 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 586 "perly.y" +#line 587 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 591 "perly.y" +#line 592 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 595 "perly.y" +#line 596 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 598 "perly.y" +#line 599 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 599 "perly.y" +#line 600 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 603 "perly.y" +#line 604 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 609 "perly.y" +#line 610 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 614 "perly.y" +#line 615 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 625 "perly.y" +#line 626 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 631 "perly.y" +#line 632 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 633 "perly.y" +#line 634 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 635 "perly.y" +#line 636 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 640 "perly.y" +#line 641 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 642 "perly.y" +#line 643 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 653 "perly.y" +#line 654 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 655 "perly.y" +#line 656 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 660 "perly.y" +#line 661 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 662 "perly.y" +#line 663 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 666 "perly.y" +#line 667 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 685 "perly.y" +#line 686 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 687 "perly.y" +#line 688 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 689 "perly.y" +#line 690 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 695 "perly.y" +#line 696 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 760 "perly.y" +#line 761 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 762 "perly.y" +#line 763 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 768 "perly.y" +#line 769 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 770 "perly.y" +#line 771 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 774 "perly.y" +#line 775 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 779 "perly.y" +#line 780 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 781 "perly.y" +#line 782 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 785 "perly.y" +#line 786 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 787 "perly.y" +#line 788 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 791 "perly.y" +#line 792 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 794 "perly.y" +#line 795 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 805 "perly.y" +#line 806 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 862 "perly.y" +#line 863 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 863 "perly.y" +#line 864 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 869 "perly.y" +#line 870 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 879 "perly.y" +#line 880 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 880 "perly.y" +#line 881 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 884 "perly.y" +#line 885 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 895 "perly.y" +#line 896 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 897 "perly.y" +#line 898 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 899 "perly.y" +#line 900 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 905 "perly.y" +#line 906 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 907 "perly.y" +#line 908 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 916 "perly.y" +#line 917 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 920 "perly.y" +#line 921 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 924 "perly.y" +#line 925 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 930 "perly.y" +#line 931 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 935 "perly.y" +#line 936 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 941 "perly.y" +#line 942 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 947 "perly.y" +#line 948 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 949 "perly.y" +#line 950 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 951 "perly.y" +#line 952 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 953 "perly.y" +#line 954 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 956 "perly.y" +#line 957 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 971 "perly.y" +#line 972 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 973 "perly.y" +#line 974 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 976 "perly.y" +#line 977 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 981 "perly.y" +#line 982 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 986 "perly.y" +#line 987 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 989 "perly.y" +#line 990 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 993 "perly.y" +#line 994 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 997 "perly.y" +#line 998 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1003 "perly.y" +#line 1004 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1011 "perly.y" +#line 1012 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1018 "perly.y" +#line 1019 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1024 "perly.y" +#line 1025 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1026 "perly.y" +#line 1027 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1028 "perly.y" +#line 1029 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1033 "perly.y" +#line 1034 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1035 "perly.y" +#line 1036 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1037 "perly.y" +#line 1038 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1042 "perly.y" +#line 1043 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1062 "perly.y" +#line 1063 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1066 "perly.y" +#line 1067 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1068 "perly.y" +#line 1069 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1070 "perly.y" +#line 1071 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1072 "perly.y" +#line 1073 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1076 "perly.y" +#line 1077 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1078 "perly.y" +#line 1079 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1082 "perly.y" +#line 1083 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1084 "perly.y" +#line 1085 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1086 "perly.y" +#line 1087 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1088 "perly.y" +#line 1089 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1092 "perly.y" +#line 1093 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1094 "perly.y" +#line 1095 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1101 "perly.y" +#line 1102 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1108 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1111 "perly.y" +#line 1112 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1114 "perly.y" +#line 1115 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1125 "perly.y" +#line 1126 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1128 "perly.y" +#line 1129 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1135 "perly.y" +#line 1136 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1137 "perly.y" +#line 1138 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1139 "perly.y" +#line 1140 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1141 "perly.y" +#line 1142 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1143 "perly.y" +#line 1144 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1146 "perly.y" +#line 1147 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1152 "perly.y" +#line 1153 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1154 "perly.y" +#line 1155 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1162 "perly.y" +#line 1163 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1186 "perly.y" +#line 1187 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1188 "perly.y" +#line 1189 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1190 "perly.y" +#line 1191 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1200 "perly.y" +#line 1201 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1210 "perly.y" +#line 1211 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1220 "perly.y" +#line 1221 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1230 "perly.y" +#line 1231 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1232 "perly.y" +#line 1233 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1234 "perly.y" +#line 1235 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1237 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1242 "perly.y" +#line 1243 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1287 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1289 "perly.y" +#line 1290 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1293 "perly.y" +#line 1294 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1295 "perly.y" +#line 1296 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1306 "perly.y" +#line 1307 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1314 "perly.y" +#line 1315 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1316 "perly.y" +#line 1317 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1318 "perly.y" +#line 1319 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1325 "perly.y" +#line 1326 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1332 "perly.y" +#line 1333 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1337 "perly.y" +#line 1338 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1339 "perly.y" +#line 1340 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1343 "perly.y" +#line 1344 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1345 "perly.y" +#line 1346 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1349 "perly.y" +#line 1350 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1351 "perly.y" +#line 1352 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1357 "perly.y" +#line 1358 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1374 "perly.y" +#line 1375 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1378 "perly.y" +#line 1379 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1382 "perly.y" +#line 1383 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1388 "perly.y" +#line 1389 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1394 "perly.y" +#line 1395 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1396 "perly.y" +#line 1397 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1400 "perly.y" +#line 1401 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1405 "perly.y" +#line 1406 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1410 "perly.y" +#line 1411 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1415 "perly.y" +#line 1416 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1420 "perly.y" +#line 1421 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1422 "perly.y" +#line 1423 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1424 "perly.y" +#line 1425 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1427 "perly.y" +#line 1428 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y + * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 8cea4a40dc0f..713b4619a485 100644 --- a/perly.h +++ b/perly.h @@ -71,91 +71,92 @@ extern int yydebug; PERLY_COMMA = 270, PERLY_DOT = 271, PERLY_EQUAL_SIGN = 272, - PERLY_SEMICOLON = 273, - BAREWORD = 274, - METHOD = 275, - FUNCMETH = 276, - THING = 277, - PMFUNC = 278, - PRIVATEREF = 279, - QWLIST = 280, - FUNC0OP = 281, - FUNC0SUB = 282, - UNIOPSUB = 283, - LSTOPSUB = 284, - PLUGEXPR = 285, - PLUGSTMT = 286, - LABEL = 287, - FORMAT = 288, - SUB = 289, - SIGSUB = 290, - ANONSUB = 291, - ANON_SIGSUB = 292, - PACKAGE = 293, - USE = 294, - WHILE = 295, - UNTIL = 296, - IF = 297, - UNLESS = 298, - ELSE = 299, - ELSIF = 300, - CONTINUE = 301, - FOR = 302, - GIVEN = 303, - WHEN = 304, - DEFAULT = 305, - LOOPEX = 306, - DOTDOT = 307, - YADAYADA = 308, - FUNC0 = 309, - FUNC1 = 310, - FUNC = 311, - UNIOP = 312, - LSTOP = 313, - MULOP = 314, - ADDOP = 315, - DOLSHARP = 316, - DO = 317, - HASHBRACK = 318, - NOAMP = 319, - LOCAL = 320, - MY = 321, - REQUIRE = 322, - COLONATTR = 323, - FORMLBRACK = 324, - FORMRBRACK = 325, - SUBLEXSTART = 326, - SUBLEXEND = 327, - PREC_LOW = 328, - OROP = 329, - DOROP = 330, - ANDOP = 331, - NOTOP = 332, - ASSIGNOP = 333, - PERLY_QUESTION_MARK = 334, - PERLY_COLON = 335, - OROR = 336, - DORDOR = 337, - ANDAND = 338, - BITOROP = 339, - BITANDOP = 340, - CHEQOP = 341, - NCEQOP = 342, - CHRELOP = 343, - NCRELOP = 344, - SHIFTOP = 345, - MATCHOP = 346, - PERLY_EXCLAMATION_MARK = 347, - PERLY_TILDE = 348, - UMINUS = 349, - REFGEN = 350, - POWOP = 351, - PREINC = 352, - PREDEC = 353, - POSTINC = 354, - POSTDEC = 355, - POSTJOIN = 356, - ARROW = 357 + PERLY_MINUS = 273, + PERLY_SEMICOLON = 274, + BAREWORD = 275, + METHOD = 276, + FUNCMETH = 277, + THING = 278, + PMFUNC = 279, + PRIVATEREF = 280, + QWLIST = 281, + FUNC0OP = 282, + FUNC0SUB = 283, + UNIOPSUB = 284, + LSTOPSUB = 285, + PLUGEXPR = 286, + PLUGSTMT = 287, + LABEL = 288, + FORMAT = 289, + SUB = 290, + SIGSUB = 291, + ANONSUB = 292, + ANON_SIGSUB = 293, + PACKAGE = 294, + USE = 295, + WHILE = 296, + UNTIL = 297, + IF = 298, + UNLESS = 299, + ELSE = 300, + ELSIF = 301, + CONTINUE = 302, + FOR = 303, + GIVEN = 304, + WHEN = 305, + DEFAULT = 306, + LOOPEX = 307, + DOTDOT = 308, + YADAYADA = 309, + FUNC0 = 310, + FUNC1 = 311, + FUNC = 312, + UNIOP = 313, + LSTOP = 314, + MULOP = 315, + ADDOP = 316, + DOLSHARP = 317, + DO = 318, + HASHBRACK = 319, + NOAMP = 320, + LOCAL = 321, + MY = 322, + REQUIRE = 323, + COLONATTR = 324, + FORMLBRACK = 325, + FORMRBRACK = 326, + SUBLEXSTART = 327, + SUBLEXEND = 328, + PREC_LOW = 329, + OROP = 330, + DOROP = 331, + ANDOP = 332, + NOTOP = 333, + ASSIGNOP = 334, + PERLY_QUESTION_MARK = 335, + PERLY_COLON = 336, + OROR = 337, + DORDOR = 338, + ANDAND = 339, + BITOROP = 340, + BITANDOP = 341, + CHEQOP = 342, + NCEQOP = 343, + CHRELOP = 344, + NCRELOP = 345, + SHIFTOP = 346, + MATCHOP = 347, + PERLY_EXCLAMATION_MARK = 348, + PERLY_TILDE = 349, + UMINUS = 350, + REFGEN = 351, + POWOP = 352, + PREINC = 353, + PREDEC = 354, + POSTINC = 355, + POSTDEC = 356, + POSTJOIN = 357, + ARROW = 358 }; #endif @@ -207,6 +208,6 @@ int yyparse (void); /* Generated from: - * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y + * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 129809083005..516dc3079a17 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3377 +#define YYLAST 3386 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 357 +#define YYMAXUTOK 358 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,10 +33,10 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 109, 13, 2, 2, - 108, 107, 110, 11, 2, 10, 2, 111, 2, 2, + 2, 2, 2, 2, 2, 2, 109, 12, 2, 2, + 108, 107, 110, 10, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 12, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 11, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,52 +56,52 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 14, 15, 16, 17, 18, - 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, - 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, - 59, 60, 61, 62, 63, 64, 65, 66, 67, 68, - 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, - 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, - 99, 100, 101, 102, 103, 104, 105, 106 + 5, 6, 7, 8, 9, 13, 14, 15, 16, 17, + 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, + 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, + 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, + 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, + 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, + 98, 99, 100, 101, 102, 103, 104, 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 131, 131, 130, 142, 141, 152, 151, 165, 164, - 178, 177, 191, 190, 201, 200, 213, 221, 229, 233, - 241, 247, 248, 258, 259, 268, 272, 276, 283, 293, - 295, 308, 305, 329, 324, 345, 353, 352, 361, 367, - 373, 378, 380, 382, 389, 397, 399, 396, 416, 421, - 428, 427, 442, 450, 456, 463, 462, 477, 481, 486, - 494, 512, 513, 517, 521, 523, 525, 527, 529, 531, - 533, 536, 542, 543, 548, 559, 560, 566, 572, 573, - 578, 581, 585, 590, 594, 598, 599, 603, 609, 614, - 619, 620, 625, 626, 631, 632, 634, 639, 641, 653, - 654, 659, 661, 665, 685, 686, 688, 694, 759, 761, - 767, 769, 773, 779, 780, 785, 786, 790, 794, 794, - 862, 863, 868, 879, 880, 883, 894, 896, 898, 900, - 904, 906, 911, 915, 919, 923, 929, 934, 940, 946, - 948, 950, 953, 952, 963, 964, 968, 972, 975, 980, - 985, 988, 992, 996, 1002, 1010, 1017, 1023, 1025, 1027, - 1032, 1034, 1036, 1041, 1043, 1045, 1047, 1049, 1051, 1053, - 1055, 1057, 1059, 1061, 1065, 1067, 1069, 1071, 1075, 1077, - 1081, 1083, 1085, 1087, 1091, 1093, 1098, 1100, 1103, 1105, - 1107, 1110, 1113, 1124, 1127, 1134, 1136, 1138, 1140, 1142, - 1145, 1151, 1153, 1157, 1158, 1159, 1160, 1161, 1163, 1165, - 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, - 1187, 1189, 1199, 1209, 1219, 1229, 1231, 1233, 1236, 1241, - 1245, 1247, 1249, 1251, 1254, 1256, 1259, 1261, 1263, 1265, - 1267, 1269, 1271, 1273, 1275, 1278, 1280, 1282, 1284, 1286, - 1288, 1292, 1295, 1294, 1307, 1308, 1309, 1313, 1315, 1317, - 1322, 1324, 1327, 1329, 1331, 1336, 1338, 1343, 1344, 1349, - 1350, 1356, 1360, 1361, 1362, 1365, 1366, 1369, 1370, 1373, - 1377, 1381, 1387, 1393, 1395, 1399, 1403, 1404, 1408, 1409, - 1413, 1414, 1419, 1421, 1423, 1426 + 0, 132, 132, 131, 143, 142, 153, 152, 166, 165, + 179, 178, 192, 191, 202, 201, 214, 222, 230, 234, + 242, 248, 249, 259, 260, 269, 273, 277, 284, 294, + 296, 309, 306, 330, 325, 346, 354, 353, 362, 368, + 374, 379, 381, 383, 390, 398, 400, 397, 417, 422, + 429, 428, 443, 451, 457, 464, 463, 478, 482, 487, + 495, 513, 514, 518, 522, 524, 526, 528, 530, 532, + 534, 537, 543, 544, 549, 560, 561, 567, 573, 574, + 579, 582, 586, 591, 595, 599, 600, 604, 610, 615, + 620, 621, 626, 627, 632, 633, 635, 640, 642, 654, + 655, 660, 662, 666, 686, 687, 689, 695, 760, 762, + 768, 770, 774, 780, 781, 786, 787, 791, 795, 795, + 863, 864, 869, 880, 881, 884, 895, 897, 899, 901, + 905, 907, 912, 916, 920, 924, 930, 935, 941, 947, + 949, 951, 954, 953, 964, 965, 969, 973, 976, 981, + 986, 989, 993, 997, 1003, 1011, 1018, 1024, 1026, 1028, + 1033, 1035, 1037, 1042, 1044, 1046, 1048, 1050, 1052, 1054, + 1056, 1058, 1060, 1062, 1066, 1068, 1070, 1072, 1076, 1078, + 1082, 1084, 1086, 1088, 1092, 1094, 1099, 1101, 1104, 1106, + 1108, 1111, 1114, 1125, 1128, 1135, 1137, 1139, 1141, 1143, + 1146, 1152, 1154, 1158, 1159, 1160, 1161, 1162, 1164, 1166, + 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, + 1188, 1190, 1200, 1210, 1220, 1230, 1232, 1234, 1237, 1242, + 1246, 1248, 1250, 1252, 1255, 1257, 1260, 1262, 1264, 1266, + 1268, 1270, 1272, 1274, 1276, 1279, 1281, 1283, 1285, 1287, + 1289, 1293, 1296, 1295, 1308, 1309, 1310, 1314, 1316, 1318, + 1323, 1325, 1328, 1330, 1332, 1337, 1339, 1344, 1345, 1350, + 1351, 1357, 1361, 1362, 1363, 1366, 1367, 1370, 1371, 1374, + 1378, 1382, 1388, 1394, 1396, 1400, 1404, 1405, 1409, 1410, + 1414, 1415, 1420, 1422, 1424, 1427 }; #endif @@ -111,40 +111,39 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'-'", - "'+'", "'@'", "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", - "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", - "PERLY_COMMA", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_SEMICOLON", - "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", - "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", - "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", - "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", - "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", - "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", - "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", - "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", - "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", - "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", - "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", - "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", - "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", - "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", - "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", - "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", - "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", - "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", - "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", - "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", - "listexpr", "listop", "@16", "method", "subscripted", "termbinop", - "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", - "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", - "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", - "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", - "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'+'", + "'@'", "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", + "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", + "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_SEMICOLON", "BAREWORD", + "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", + "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", + "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", + "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", + "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", + "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", + "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", + "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", + "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", + "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", + "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", + "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", + "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", + "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", + "@5", "@6", "@7", "block", "formblock", "remember", "mblock", + "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", + "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", + "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", + "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", + "startanonsub", "startformsub", "subname", "proto", "subattrlist", + "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", + "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", + "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", + "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", + "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", + "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", + "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", + "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", + "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -154,21 +153,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 45, 43, 64, 37, 265, 266, 267, 268, 269, 270, - 271, 272, 273, 274, 275, 276, 277, 278, 279, 280, - 281, 282, 283, 284, 285, 286, 287, 288, 289, 290, - 291, 292, 293, 294, 295, 296, 297, 298, 299, 300, - 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, - 311, 312, 313, 314, 315, 316, 317, 318, 319, 320, - 321, 322, 323, 324, 325, 326, 327, 328, 329, 330, - 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, - 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, - 351, 352, 353, 354, 355, 356, 357, 41, 40, 36, + 43, 64, 37, 265, 266, 267, 268, 269, 270, 271, + 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, + 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, + 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, + 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, + 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, + 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, + 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, + 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, + 352, 353, 354, 355, 356, 357, 358, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-477) +#define YYPACT_NINF (-479) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -182,64 +181,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 583, -477, -477, -477, -477, -477, -477, -477, 31, -477, - 3006, 26, 1590, 1488, -477, -477, -477, -477, 3006, 3006, - 17, 17, 17, 1996, -477, 17, 17, -477, -477, -1, - -69, -477, 3006, -477, -477, -477, -477, 3006, -47, -38, - -55, 2097, 1895, 17, 2097, 2198, 10, 3006, -2, 3006, - 3006, 3006, 3006, 3006, 3006, 3006, 2299, 17, 17, 171, - 47, -477, 64, -477, 53, -18, 97, -7, -477, -477, - -477, 3181, -477, -477, 3, 108, 123, 143, -477, 75, - 156, 244, 81, -477, -477, -477, -477, -477, -477, 10, - 10, 92, -477, 27, 34, 55, 59, 286, 74, 105, - 26, 212, 194, -477, 219, 1122, 1488, -477, -477, -477, - 671, -477, 5, 774, 495, 495, -477, -477, -477, -477, - -477, -477, -477, -477, 106, 3006, 152, 193, 3006, 159, - 963, 26, 248, 211, 3181, 208, 2400, 3006, 1895, -477, - 963, 563, 47, -477, 467, 3006, -477, -477, 963, 296, - 24, -477, -477, 3006, 963, 3107, 2501, 256, -477, -477, - -477, 963, 47, 495, 495, 495, 350, 350, 313, 322, - -477, -477, 3006, 3006, 3006, 3006, 3006, 3006, 2602, -477, - -477, 3006, -477, -477, 3006, 3006, 3006, 3006, 3006, 3006, - 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, 3006, - 3006, 3006, -477, -477, -477, 305, 2703, 3006, 3006, 3006, - 3006, 3006, 3006, 3006, -477, 293, -477, -477, 309, -477, - -477, -477, -477, -477, 263, 22, -477, -477, 258, -477, - -477, -477, -477, 26, -477, -477, 3006, 3006, 3006, 3006, - 3006, 3006, -477, -477, -477, -477, -477, 343, 343, -477, - -477, -477, 348, -477, -477, -477, 3006, 3006, 115, -477, - -477, -477, 211, 349, -477, -477, -477, 326, 298, 269, - 3006, 47, -477, 365, -477, 2804, 495, 256, 45, 142, - 230, -477, 362, 356, -477, 3006, 366, 306, 306, -477, - 3181, 112, 132, -477, 386, 963, 861, 3271, 422, 429, - 3181, 3136, 357, 357, 656, 759, 530, 861, 861, 963, - 963, 395, 495, 495, 279, 297, 301, 3006, 3006, -477, - 312, 2905, 52, 315, 300, -477, -477, 397, 157, 160, - 185, 178, 299, 191, 318, 876, -477, 388, -477, -477, - 67, 403, 3006, 3006, 3006, 3006, -477, 314, -477, -477, - 320, -477, -477, -477, -477, 1692, 12, -477, 3006, 3006, - -477, -477, 171, -477, 171, -477, -477, -477, -477, -477, - 352, 352, 5, 323, -12, -477, 3006, -477, -477, 327, - -477, -477, -477, -477, 400, -477, 33, 461, -477, -477, - -477, 225, 3006, 427, -477, -477, 3006, -477, -477, -477, - 339, 228, -477, -477, 497, -477, -477, 3006, -477, 452, - -477, 457, -477, 465, -477, 471, -477, -477, -477, 248, - 211, -477, -477, 414, 331, 171, 381, 387, 171, 390, - 398, -477, -477, -477, -477, 401, 483, 280, -477, 3006, - 408, 409, 3006, -477, -477, -477, -477, 3006, 434, -477, - 504, -477, -477, 506, -477, -477, 40, -477, 264, -477, - 3226, 520, -477, -477, 431, -477, -477, -477, -477, 526, - 211, 542, -477, 3006, -477, -477, 550, 550, 3006, 3006, - 550, -477, 458, 462, 550, 550, 3181, 171, -477, -477, - 472, -477, -477, -477, -477, 509, 558, -477, -477, -477, - -477, 562, 550, 550, -477, 205, 205, 489, 490, 194, - 3006, 3006, 550, -477, -477, 978, -477, 1080, -477, -477, - -477, -477, 1182, -477, 194, 194, -477, 550, 494, -477, - -477, 550, 550, -477, 581, 498, 194, -477, -477, 25, - -477, -477, -477, 1284, -477, 3006, 194, 194, -477, 550, - -477, 586, 538, -477, -477, 505, -477, -477, -477, 194, - -477, -477, -477, 550, 1794, -477, 1386, 205, 508, -477, - -477, 550, -477 + 601, -479, -479, -479, -479, -479, -479, -479, 19, -479, + 3015, 32, 1599, 1497, -479, -479, -479, -479, 3015, 37, + 37, 37, 2005, 3015, -479, 37, 37, -479, -479, 75, + -55, -479, 3015, -479, -479, -479, -479, 3015, -41, -6, + -25, 2106, 1904, 37, 2106, 2207, 8, 3015, 13, 3015, + 3015, 3015, 3015, 3015, 3015, 3015, 2308, 37, 37, 303, + 93, -479, -4, -479, -19, 27, -9, 36, -479, -479, + -479, 3190, -479, -479, 55, 83, 101, 126, -479, 121, + 244, 266, 131, -479, -479, -479, -479, -479, -479, 8, + 8, 137, -479, 59, 71, 76, 85, 286, 106, 129, + 32, 187, 191, -479, 225, 1130, 1497, -479, -479, -479, + 680, -479, 5, 783, 430, -479, -479, -479, -479, -479, + -479, -479, -479, 79, 430, 3015, 145, 186, 3015, 167, + 972, 32, 257, 207, 3190, 215, 2409, 3015, 1904, -479, + 972, 572, 93, -479, 476, 3015, -479, -479, 972, 313, + 112, -479, -479, 3015, 972, 3116, 2510, 258, -479, -479, + -479, 972, 93, 430, 430, 430, 202, 202, 316, 326, + -479, -479, 3015, 3015, 3015, 3015, 3015, 3015, 2611, -479, + -479, 3015, -479, -479, 3015, 3015, 3015, 3015, 3015, 3015, + 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, + 3015, 3015, -479, -479, -479, 305, 2712, 3015, 3015, 3015, + 3015, 3015, 3015, 3015, -479, 343, -479, -479, 344, -479, + -479, -479, -479, -479, 263, 22, -479, -479, 267, -479, + -479, -479, -479, 32, -479, -479, 3015, 3015, 3015, 3015, + 3015, 3015, -479, -479, -479, -479, -479, 346, 346, -479, + -479, -479, 353, -479, -479, -479, 3015, 3015, 107, -479, + -479, -479, 207, 360, -479, -479, -479, 362, 331, 272, + 3015, 93, -479, 374, -479, 2813, 430, 258, 31, 240, + 243, -479, 375, 382, -479, 3015, 393, 342, 342, -479, + 3190, 156, 116, -479, 388, 972, 870, 3280, 493, 410, + 3190, 3145, 357, 357, 665, 768, 539, 870, 870, 972, + 972, 443, 430, 430, 301, 315, 319, 3015, 3015, -479, + 320, 2914, 52, 324, 327, -479, -479, 401, 224, 133, + 298, 160, 318, 165, 322, 885, -479, 403, -479, -479, + 16, 405, 3015, 3015, 3015, 3015, -479, 317, -479, -479, + 329, -479, -479, -479, -479, 1701, 29, -479, 3015, 3015, + -479, -479, 303, -479, 303, -479, -479, -479, -479, -479, + 356, 356, 5, 336, 14, -479, 3015, -479, -479, 348, + -479, -479, -479, -479, 421, -479, 7, 446, -479, -479, + -479, 171, 3015, 444, -479, -479, 3015, -479, -479, -479, + 339, 190, -479, -479, 506, -479, -479, 3015, -479, 449, + -479, 450, -479, 460, -479, 462, -479, -479, -479, 257, + 207, -479, -479, 435, 371, 303, 377, 378, 303, 379, + 380, -479, -479, -479, -479, 390, 465, 280, -479, 3015, + 397, 404, 3015, -479, -479, -479, -479, 3015, 413, -479, + 498, -479, -479, 503, -479, -479, 23, -479, 193, -479, + 3235, 504, -479, -479, 411, -479, -479, -479, -479, 509, + 207, 519, -479, 3015, -479, -479, 531, 531, 3015, 3015, + 531, -479, 442, 466, 531, 531, 3190, 303, -479, -479, + 467, -479, -479, -479, -479, 477, 535, -479, -479, -479, + -479, 553, 531, 531, -479, 58, 58, 470, 471, 191, + 3015, 3015, 531, -479, -479, 987, -479, 1089, -479, -479, + -479, -479, 1191, -479, 191, 191, -479, 531, 483, -479, + -479, 531, 531, -479, 570, 488, 191, -479, -479, 35, + -479, -479, -479, 1293, -479, 3015, 191, 191, -479, 531, + -479, 581, 528, -479, -479, 505, -479, -479, -479, 191, + -479, -479, -479, 531, 1803, -479, 1395, 58, 507, -479, + -479, 531, -479 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -258,8 +257,8 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 186, 187, 292, 295, 294, 293, - 281, 282, 279, 196, 0, 265, 0, 0, 0, 0, + 0, 15, 113, 0, 187, 292, 295, 294, 293, 281, + 282, 279, 196, 0, 186, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, @@ -310,16 +309,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -477, -477, -477, -477, -477, -477, -477, -477, -477, 43, - -477, -5, -139, -477, -17, -477, 600, 511, 16, -477, - -477, -477, -477, -477, -477, -477, -477, -477, 421, -341, - -476, -156, -463, -477, 118, 275, -303, 65, -477, 56, - 319, -477, 190, 213, -243, 354, 389, -477, -477, 267, - -477, 268, -477, -477, -477, -477, 192, -477, -477, 168, - -477, 202, -8, -37, -477, -477, -477, -477, -477, -477, - -477, -477, -477, -477, -477, -477, 100, -477, -477, 510, - -124, -129, -477, -477, 321, -477, -477, 450, 1, -45, - -42, -477, -477, -477, -477, -477, 51 + -479, -479, -479, -479, -479, -479, -479, -479, -479, 43, + -479, -5, -139, -479, -17, -479, 598, 514, -1, -479, + -479, -479, -479, -479, -479, -479, -479, -479, 25, -337, + -478, -156, -468, -479, 105, 278, -303, 60, -479, 138, + 136, -479, 253, 203, -247, 349, 389, -479, -479, 256, + -479, 268, -479, -479, -479, -479, 189, -479, -479, 142, + -479, 175, -8, -37, -479, -479, -479, -479, -479, -479, + -479, -479, -479, -479, -479, -479, 100, -479, -479, 492, + -124, -129, -479, -479, 293, -479, -479, 428, 1, -45, + -42, -479, -479, -479, -479, -479, 51 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -342,189 +341,200 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 175, 268, 269, - 20, 21, 503, 162, 433, 124, 128, 245, 246, 377, - 137, 119, 119, 119, 20, 21, 119, 119, 103, 274, - 530, 16, 83, 151, 20, 21, 22, 150, 152, 129, - 116, 83, 429, 144, 119, 117, 273, 551, 169, 158, - 285, 552, 435, 138, 84, 440, 441, 392, 119, 119, - 207, 135, 208, 118, 118, 118, 175, 83, 118, 118, - 136, 120, 121, 122, 181, 116, 125, 126, 214, 176, - 117, 177, 421, 184, 139, 118, 118, 147, 142, 422, - -290, 570, 348, 145, 146, 564, 213, 155, 228, 447, - 118, 118, 172, 173, 174, -261, 156, 57, 271, 171, - 279, 206, -260, 280, 247, 218, 142, -262, 114, 115, - 258, 57, 243, 207, 254, 208, 57, 373, 267, 59, - 59, 57, 130, 375, 393, 220, 483, 134, -286, 144, - -286, 140, 221, 231, 148, 179, 180, 154, 282, 161, - 394, 163, 164, 165, 166, 167, 278, -286, -288, -286, - -288, 57, 405, 222, 287, 288, 289, 223, 291, 292, - 294, 209, 178, 210, 260, 507, 508, 471, 410, 409, - 353, 118, 229, 354, 172, 173, 174, 182, 183, 270, - 172, 173, 174, 172, 173, 174, 412, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 411, 535, 414, - 172, 173, 174, 230, -264, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 352, 496, 362, 364, - 362, 362, 362, 362, 232, 172, 173, 174, 172, 173, - 174, 235, 555, 457, 233, -288, 462, -288, 59, 172, - 173, 174, 449, 527, 528, 276, 172, 173, 174, 211, - 256, 212, 384, 172, 173, 174, 259, 387, 257, 172, - 173, 174, 338, 339, 261, 290, 360, 391, 464, 216, - 217, 295, 492, 263, 296, 297, 298, 299, 300, 301, + 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, + 176, 103, 177, 162, 123, 377, 245, 246, 433, 16, + 118, 118, 118, 285, 19, 20, 118, 118, 530, 274, + 421, 151, 175, 19, 20, 21, 152, 150, 422, 392, + 19, 20, 429, 144, 118, 207, 83, 208, 169, 158, + 137, 83, 435, 129, 84, 440, 441, 551, 118, 118, + 115, 552, 117, 117, 117, 116, 83, 135, 117, 117, + 119, 120, 121, 179, 180, 115, 125, 126, 214, -261, + 116, 182, 183, 138, 139, 117, 117, 147, 142, 570, + 564, 128, 348, 145, 146, -260, 254, 207, 228, 208, + 117, 117, 136, -262, 178, 243, 527, 528, 271, 171, + 279, 175, 155, 280, 247, -286, 142, -286, 114, 181, + 258, 156, 57, 124, 375, 447, 184, 373, 267, 59, + 59, 57, 130, 394, 273, -290, 483, 134, 57, 144, + -288, 140, -288, 231, 148, 213, 57, 154, 282, 161, + 410, 163, 164, 165, 166, 167, 278, 172, 173, 174, + 218, 57, 405, 206, 287, 288, 289, 220, 291, 292, + 294, 132, 133, 471, 260, 507, 508, 412, 393, 221, + 353, 117, 414, 354, 222, 172, 173, 174, 457, 270, + 172, 173, 174, 223, 172, 173, 174, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 462, 535, 232, + 492, 172, 173, 174, 229, 342, 343, 344, 345, 347, + 374, 355, 356, 496, 358, 359, 352, 433, 362, 364, + 362, 362, 362, 362, 172, 173, 174, 230, 172, 173, + 174, 233, 555, 172, 173, 174, 409, 235, 59, 172, + 173, 174, 449, 256, -286, 276, -286, -288, 209, -288, + 210, 257, 384, 365, 366, 367, 368, 387, 172, 173, + 174, 172, 173, 174, 259, 290, 360, 391, 464, 263, + 211, 295, 212, 261, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, -263, 172, 173, 174, 172, 173, 174, 400, - 401, 353, 272, 404, 354, 265, 336, 314, 315, 316, - 317, 413, 318, 119, 236, 237, 238, 239, 283, 319, - 285, 240, 340, 241, 425, 364, 428, 428, 506, 142, - 415, 509, 172, 173, 174, 513, 514, 437, 431, 501, - 428, 428, 439, 533, 132, 133, 224, 352, 172, 173, - 174, 461, 346, 524, 525, 118, 357, 372, 541, 542, - 320, 369, 450, 536, 382, 378, 383, 172, 173, 174, - 550, 385, 390, 392, 458, 225, 174, -83, 544, 397, + 312, 313, 172, 173, 174, -291, -291, -291, 205, 400, + 401, 353, -264, 404, 354, -263, 314, 315, 316, 317, + 411, 318, 265, 118, 236, 237, 238, 239, 272, 319, + 283, 240, 285, 241, 425, 364, 428, 428, 506, 142, + 413, 509, 216, 217, 415, 513, 514, 437, 431, 501, + 428, 428, 439, 533, 338, 339, 224, 352, 172, 173, + 174, 461, 346, 524, 525, 117, 336, 340, 541, 542, + 320, 372, 450, 536, 369, 357, 172, 173, 174, 383, + 550, 172, 173, 174, 458, 225, 378, -83, 544, 385, 556, 557, 546, 547, 226, 57, 172, 173, 174, 59, - 172, 173, 174, 565, 172, 173, 174, 398, 407, 417, - 559, 399, 469, 321, 322, 323, 472, 172, 173, 174, - 186, 187, 402, 57, 567, 406, 423, 479, 432, 286, - 446, 428, 572, 381, 442, 452, 142, 473, 474, 487, - 172, 173, 174, 459, 192, 193, 194, 195, 196, 197, - 198, 199, 200, -291, -291, -291, 205, 201, 186, 187, - 202, 203, 204, 205, 172, 173, 174, -215, 465, 389, - 428, 428, 515, 466, 517, 172, 173, 174, 172, 173, - 174, 467, 207, 522, 208, -215, -215, 468, 475, -215, - 200, 450, 186, 395, 476, 201, 460, 477, 202, 203, - 204, 205, 425, 428, 408, 481, 478, 455, 480, 543, - 488, -215, -215, -215, -215, 484, 485, 200, -215, 489, - -215, 491, 201, -215, 200, 202, 203, 204, 205, 201, - -215, -215, 202, 203, 204, 205, 493, 428, 494, 172, - 173, 174, 486, -215, 566, -215, -215, -215, 495, -215, + 172, 173, 174, 565, 172, 173, 174, 382, 390, 392, + 559, 397, 469, 321, 322, 323, 472, 172, 173, 174, + 186, 187, 174, 417, 567, 398, 57, 479, 423, 399, + 402, 428, 572, 286, 406, 407, 142, 432, 442, 487, + 172, 173, 174, 446, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 172, 173, 174, 452, 201, 473, 459, + 202, 203, 204, 205, 465, 466, 172, 173, 174, 381, + 428, 428, 515, 186, 517, 467, -215, 468, 474, 172, + 173, 174, 389, 522, 475, 476, 477, 481, 478, 488, + 207, 450, 208, -215, -215, 395, 460, 480, -215, 172, + 173, 174, 425, 428, 484, 200, 186, 187, 408, 543, + 201, 485, 489, 202, 203, 204, 205, 491, 494, 493, + -215, -215, -215, -215, 172, 173, 174, -215, 455, -215, + 201, 495, -215, 202, 203, 204, 205, 428, 200, -215, + -215, 497, 486, 201, 566, 504, 202, 203, 204, 205, + 511, 518, -215, 456, -215, -215, -215, 519, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -254, 497, 504, 511, -215, 456, 512, - -215, -215, -215, -215, -215, 172, 173, 174, -215, 516, - 519, -254, -254, 518, 523, -254, 1, 2, 3, 4, - 5, 6, 7, 186, 187, 201, 531, 532, 202, 203, - 204, 205, 545, 548, 463, 549, 560, -254, -254, -254, - -254, 561, 563, 107, -254, 571, -254, 242, 426, -254, - 195, 196, 197, 198, 199, 200, -254, -254, 534, 568, - 201, 388, 470, 202, 203, 204, 205, 371, 444, -254, - 445, -254, -254, -254, 490, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, -254, 365, - 366, 367, 368, -254, 521, 277, -254, -254, -254, -254, - -254, -13, 85, 499, -254, 351, 0, 438, 0, 0, - 0, 18, 19, 20, 21, 22, 83, 0, 23, 0, - 0, 0, 0, 86, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, - 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 193, 194, 195, 196, 197, 198, - 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, -3, 85, 0, 0, 0, 56, - 57, 58, 0, 0, 18, 19, 20, 21, 22, 83, - 0, 23, 0, 0, 0, 0, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 194, 195, - 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, - 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, - 22, 83, 416, 23, 0, 0, 0, 0, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 197, 198, 199, 200, 50, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 21, 22, 83, 537, 23, 0, 0, 0, 0, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, - 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 199, 200, 50, - 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, - 18, 19, 20, 21, 22, 83, 538, 23, 0, 0, - 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, + -215, -215, -254, 512, 516, 523, -215, 531, 532, -215, + -215, -215, -215, -215, 172, 173, 174, -215, 200, -254, + -254, 545, 548, 201, -254, 549, 202, 203, 204, 205, + 560, 561, 186, 187, 1, 2, 3, 4, 5, 6, + 7, 107, 563, 463, 571, 534, -254, -254, -254, -254, + 242, 426, 470, -254, 568, -254, 388, 444, -254, 195, + 196, 197, 198, 199, 200, -254, -254, 371, 521, 201, + 445, 490, 202, 203, 204, 205, 499, 277, -254, 438, + -254, -254, -254, 351, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, 0, 0, + 0, 0, -254, 0, 0, -254, -254, -254, -254, -254, + -13, 85, 0, -254, 0, 0, 0, 0, 0, 0, + 18, 19, 20, 21, 83, 0, 22, 0, 0, 0, + 0, 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 236, 237, 238, 239, - 0, 0, 0, 240, 0, 241, 51, 52, 0, 53, - 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 21, 22, 83, 540, 23, - 172, 173, 174, 0, 86, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 57, 58, 0, 18, 19, 20, 21, 22, 83, - 554, 23, 0, 0, 0, 0, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 57, 58, 0, 18, 19, 20, 21, - 22, 83, 0, 23, 0, 0, 0, 0, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 569, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 48, 49, 0, 193, 194, 195, 196, 197, 198, 199, + 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, -3, 85, 0, 0, 0, 56, 57, + 58, 0, 0, 18, 19, 20, 21, 83, 0, 22, + 0, 0, 0, 0, 23, 86, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, + 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 194, 195, 196, + 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, 57, 58, 0, 18, 19, 20, 21, 83, + 416, 22, 0, 0, 0, 0, 23, 86, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, + 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, + 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, + 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, + 21, 83, 537, 22, 0, 0, 0, 0, 23, 86, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, + 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, + 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 199, 200, 50, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, + 19, 20, 21, 83, 538, 22, 0, 0, 0, 0, + 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 236, 237, 238, 239, 0, 0, + 0, 240, 0, 241, 0, 51, 52, 0, 53, 0, + 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, + 0, 18, 19, 20, 21, 83, 540, 22, 172, 173, + 174, 0, 23, 86, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, + 57, 58, 0, 18, 19, 20, 21, 83, 554, 22, + 0, 0, 0, 0, 23, 86, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, + 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, + 0, 56, 57, 58, 0, 18, 19, 20, 21, 83, + 0, 22, 0, 0, 0, 0, 23, 86, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, + 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 569, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 21, 22, 83, 0, 23, 0, 0, 0, 0, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, - 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, + 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, + 21, 83, 0, 22, 0, 0, 0, 0, 23, 86, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, + 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, + 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, - 18, 19, 20, 21, 22, 83, 0, 23, 0, 0, - 0, 0, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 21, 22, 0, 0, 23, - 0, 0, 0, 0, -78, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 57, 58, 0, 18, 19, 20, 21, 22, 0, - 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, + 19, 20, 21, 83, 0, 22, 0, 0, 0, 0, + 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 0, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, + 0, 18, 19, 20, 21, 0, 0, 22, 0, 0, + 0, 0, 23, -78, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, + 57, 58, 0, 18, 19, 20, 21, 0, 0, 22, + 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, + -78, 56, 57, 58, 18, 19, 20, 21, 83, 0, + 22, 0, 0, 0, 0, 23, 0, 141, 25, 26, + 27, 28, 116, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, @@ -532,9 +542,9 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, -78, 56, 57, 58, 18, 19, 20, 21, 22, - 83, 0, 23, 0, 0, 0, 0, 0, 141, 25, - 26, 27, 28, 117, 29, 30, 31, 32, 33, 34, + 0, 0, 56, 57, 58, 18, 19, 20, 21, 0, + 0, 22, 122, 0, 0, 0, 23, 0, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, @@ -543,7 +553,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 23, 123, 0, 0, 0, 0, 24, + 83, 0, 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -553,7 +563,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, - 21, 22, 83, 0, 23, 0, 0, 0, 0, 0, + 21, 0, 0, 22, 0, 0, 0, 0, 23, 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -563,8 +573,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, - 20, 21, 22, 0, 0, 23, 0, 0, 0, 0, - 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 20, 21, 0, 0, 22, 0, 0, 0, 0, 23, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, @@ -572,9 +582,9 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, - 19, 20, 21, 22, 0, 0, 23, 0, 0, 0, - 0, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 55, 0, 0, 0, 0, 168, 56, 57, 58, 18, + 19, 20, 21, 0, 0, 22, 0, 0, 0, 0, + 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, @@ -582,9 +592,9 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 168, 56, 57, 58, - 18, 19, 20, 21, 22, 0, 0, 23, 0, 0, - 0, 0, 0, 24, 25, 26, 27, 28, 0, 29, + 54, 55, 0, 0, 0, 0, 266, 56, 57, 58, + 18, 19, 20, 21, 0, 0, 22, 0, 0, 0, + 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, @@ -592,9 +602,9 @@ static const yytype_int16 yytable[] = 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 266, 56, 57, - 58, 18, 19, 20, 21, 22, 0, 0, 23, 0, - 0, 0, 0, 0, 24, 25, 26, 27, 28, 0, + 0, 54, 55, 0, 0, 0, 0, 281, 56, 57, + 58, 18, 19, 20, 21, 0, 0, 22, 0, 0, + 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -602,9 +612,9 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, - 57, 58, 18, 19, 20, 21, 22, 0, 0, 23, - 0, 0, 0, 0, 0, 24, 25, 26, 27, 28, + 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, + 57, 58, 18, 19, 20, 21, 0, 0, 22, 0, + 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -612,9 +622,9 @@ static const yytype_int16 yytable[] = 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, - 56, 57, 58, 18, 19, 20, 21, 22, 0, 0, - 23, 0, 0, 0, 0, 0, 24, 25, 26, 27, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, + 56, 57, 58, 18, 19, 20, 21, 0, 0, 22, + 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -623,8 +633,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 326, 56, 57, 58, 18, 19, 20, 21, 22, 0, - 0, 23, 0, 0, 0, 0, 0, 24, 25, 26, + 386, 56, 57, 58, 18, 19, 20, 21, 0, 0, + 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -633,8 +643,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 386, 56, 57, 58, 18, 19, 20, 21, 22, - 0, 0, 23, 0, 0, 0, 0, 0, 24, 25, + 0, 403, 56, 57, 58, 18, 19, 20, 21, 0, + 0, 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -643,230 +653,231 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 403, 56, 57, 58, 18, 19, 20, 21, - 22, 0, 0, 23, 0, 0, 0, 0, 0, 24, + 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, + 0, 0, 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 185, 0, 0, 0, 0, 0, 0, 186, 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, - 21, 22, 0, 0, 23, 0, 0, 0, 0, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 275, 57, 58, 188, 189, 396, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, + 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 185, 0, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 0, 275, 57, 58, 188, 189, - 396, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, - 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 188, 189, 0, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 188, 189, 0, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, - 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, -291, 0, 202, - 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 189, 0, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, -291, 0, 202, 203, + 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205 + 0, 0, 0, 0, 0, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 19, 137, 138, - 12, 13, 475, 50, 355, 23, 17, 12, 13, 262, - 75, 20, 21, 22, 12, 13, 25, 26, 12, 153, - 506, 0, 15, 23, 12, 13, 14, 45, 28, 108, - 23, 15, 345, 42, 43, 28, 22, 22, 56, 48, - 17, 26, 355, 108, 11, 358, 359, 17, 57, 58, - 15, 108, 17, 20, 21, 22, 19, 15, 25, 26, - 108, 20, 21, 22, 92, 23, 25, 26, 83, 15, - 28, 17, 15, 90, 41, 42, 43, 44, 125, 22, - 15, 567, 70, 42, 43, 558, 15, 99, 97, 111, - 57, 58, 78, 79, 80, 72, 108, 109, 145, 58, - 155, 108, 72, 155, 109, 23, 153, 72, 18, 19, - 128, 109, 106, 15, 18, 17, 109, 256, 136, 137, - 138, 109, 32, 18, 22, 108, 439, 37, 15, 138, - 17, 41, 108, 100, 44, 92, 93, 47, 156, 49, - 18, 51, 52, 53, 54, 55, 155, 15, 15, 17, - 17, 109, 110, 108, 172, 173, 174, 108, 176, 177, - 178, 15, 108, 17, 131, 478, 479, 420, 18, 22, - 225, 138, 108, 225, 78, 79, 80, 90, 91, 138, - 78, 79, 80, 78, 79, 80, 18, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 22, 511, 18, - 78, 79, 80, 108, 72, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 225, 470, 236, 237, - 238, 239, 240, 241, 22, 78, 79, 80, 78, 79, - 80, 22, 545, 18, 50, 15, 18, 17, 256, 78, - 79, 80, 376, 48, 49, 155, 78, 79, 80, 15, - 108, 17, 270, 78, 79, 80, 107, 275, 75, 78, - 79, 80, 216, 217, 26, 175, 233, 285, 407, 89, - 90, 181, 18, 72, 184, 185, 186, 187, 188, 189, + 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, + 14, 12, 16, 50, 22, 262, 11, 12, 355, 0, + 19, 20, 21, 16, 11, 12, 25, 26, 506, 153, + 14, 23, 18, 11, 12, 13, 28, 45, 22, 16, + 11, 12, 345, 42, 43, 14, 14, 16, 56, 48, + 75, 14, 355, 108, 11, 358, 359, 22, 57, 58, + 23, 26, 19, 20, 21, 28, 14, 108, 25, 26, + 19, 20, 21, 92, 93, 23, 25, 26, 83, 72, + 28, 90, 91, 108, 41, 42, 43, 44, 125, 567, + 558, 16, 70, 42, 43, 72, 17, 14, 97, 16, + 57, 58, 108, 72, 108, 106, 48, 49, 145, 58, + 155, 18, 99, 155, 109, 14, 153, 16, 18, 92, + 128, 108, 109, 23, 17, 111, 90, 256, 136, 137, + 138, 109, 32, 17, 22, 14, 439, 37, 109, 138, + 14, 41, 16, 100, 44, 14, 109, 47, 156, 49, + 17, 51, 52, 53, 54, 55, 155, 78, 79, 80, + 23, 109, 110, 108, 172, 173, 174, 108, 176, 177, + 178, 35, 36, 420, 131, 478, 479, 17, 22, 108, + 225, 138, 17, 225, 108, 78, 79, 80, 17, 138, + 78, 79, 80, 108, 78, 79, 80, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 17, 511, 22, + 17, 78, 79, 80, 108, 220, 221, 222, 223, 224, + 257, 226, 227, 470, 229, 230, 225, 564, 236, 237, + 238, 239, 240, 241, 78, 79, 80, 108, 78, 79, + 80, 50, 545, 78, 79, 80, 22, 22, 256, 78, + 79, 80, 376, 108, 14, 155, 16, 14, 14, 16, + 16, 75, 270, 238, 239, 240, 241, 275, 78, 79, + 80, 78, 79, 80, 107, 175, 233, 285, 407, 72, + 14, 181, 16, 26, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 72, 78, 79, 80, 78, 79, 80, 317, - 318, 356, 16, 321, 356, 107, 23, 12, 13, 14, - 15, 22, 17, 322, 44, 45, 46, 47, 72, 24, - 17, 51, 23, 53, 342, 343, 344, 345, 477, 376, - 22, 480, 78, 79, 80, 484, 485, 355, 347, 473, - 358, 359, 357, 509, 35, 36, 70, 356, 78, 79, - 80, 22, 99, 502, 503, 322, 108, 19, 524, 525, - 65, 28, 377, 512, 76, 26, 107, 78, 79, 80, - 536, 16, 26, 17, 392, 99, 80, 107, 527, 110, + 200, 201, 78, 79, 80, 103, 104, 105, 106, 317, + 318, 356, 72, 321, 356, 72, 11, 12, 13, 14, + 22, 16, 107, 322, 44, 45, 46, 47, 15, 24, + 72, 51, 16, 53, 342, 343, 344, 345, 477, 376, + 22, 480, 89, 90, 22, 484, 485, 355, 347, 473, + 358, 359, 357, 509, 216, 217, 70, 356, 78, 79, + 80, 22, 99, 502, 503, 322, 23, 23, 524, 525, + 65, 18, 377, 512, 28, 108, 78, 79, 80, 107, + 536, 78, 79, 80, 392, 99, 26, 107, 527, 15, 546, 547, 531, 532, 108, 109, 78, 79, 80, 407, - 78, 79, 80, 559, 78, 79, 80, 110, 108, 21, + 78, 79, 80, 559, 78, 79, 80, 76, 26, 16, 549, 110, 417, 108, 109, 110, 421, 78, 79, 80, - 63, 64, 110, 109, 563, 110, 23, 432, 108, 107, - 107, 439, 571, 107, 82, 108, 473, 23, 107, 447, - 78, 79, 80, 16, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 103, 104, 105, 106, 100, 63, 64, - 103, 104, 105, 106, 78, 79, 80, 0, 16, 107, - 478, 479, 489, 16, 491, 78, 79, 80, 78, 79, - 80, 16, 15, 500, 17, 18, 19, 16, 107, 22, - 95, 496, 63, 107, 107, 100, 396, 107, 103, 104, - 105, 106, 510, 511, 107, 22, 108, 107, 107, 526, - 76, 44, 45, 46, 47, 107, 107, 95, 51, 15, - 53, 15, 100, 56, 95, 103, 104, 105, 106, 100, - 63, 64, 103, 104, 105, 106, 16, 545, 107, 78, - 79, 80, 442, 76, 561, 78, 79, 80, 22, 82, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 0, 22, 15, 108, 100, 107, 107, - 103, 104, 105, 106, 107, 78, 79, 80, 111, 107, - 22, 18, 19, 74, 22, 22, 3, 4, 5, 6, - 7, 8, 9, 63, 64, 100, 107, 107, 103, 104, - 105, 106, 108, 22, 107, 107, 20, 44, 45, 46, - 47, 73, 107, 13, 51, 107, 53, 106, 343, 56, - 90, 91, 92, 93, 94, 95, 63, 64, 510, 564, - 100, 277, 419, 103, 104, 105, 106, 248, 371, 76, - 372, 78, 79, 80, 452, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 238, - 239, 240, 241, 100, 496, 155, 103, 104, 105, 106, - 107, 0, 1, 471, 111, 225, -1, 356, -1, -1, - -1, 10, 11, 12, 13, 14, 15, -1, 17, -1, - -1, -1, -1, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, - 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, 88, 89, 90, 91, 92, 93, - 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, - 104, 105, 106, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 0, 1, -1, -1, -1, 108, - 109, 110, -1, -1, 10, 11, 12, 13, 14, 15, - -1, 17, -1, -1, -1, -1, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, - -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, 89, 90, - 91, 92, 93, 94, 95, 81, -1, -1, -1, 100, - -1, -1, 103, 104, 105, 106, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, - -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, - 14, 15, 16, 17, -1, -1, -1, -1, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, - 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - -1, -1, -1, 92, 93, 94, 95, 81, -1, -1, - -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, - -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, - 12, 13, 14, 15, 16, 17, -1, -1, -1, -1, - 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, - 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, -1, -1, -1, -1, -1, 94, 95, 81, - -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, - 10, 11, 12, 13, 14, 15, 16, 17, -1, -1, - -1, -1, 22, 23, 24, 25, 26, 27, -1, 29, + 63, 64, 80, 20, 563, 110, 109, 432, 23, 110, + 110, 439, 571, 107, 110, 108, 473, 108, 82, 447, + 78, 79, 80, 107, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 78, 79, 80, 108, 100, 23, 15, + 103, 104, 105, 106, 15, 15, 78, 79, 80, 107, + 478, 479, 489, 63, 491, 15, 0, 15, 107, 78, + 79, 80, 107, 500, 107, 107, 107, 22, 108, 76, + 14, 496, 16, 17, 18, 107, 396, 107, 22, 78, + 79, 80, 510, 511, 107, 95, 63, 64, 107, 526, + 100, 107, 14, 103, 104, 105, 106, 14, 107, 15, + 44, 45, 46, 47, 78, 79, 80, 51, 107, 53, + 100, 22, 56, 103, 104, 105, 106, 545, 95, 63, + 64, 22, 442, 100, 561, 14, 103, 104, 105, 106, + 108, 74, 76, 107, 78, 79, 80, 22, 82, 83, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 0, 107, 107, 22, 100, 107, 107, 103, + 104, 105, 106, 107, 78, 79, 80, 111, 95, 17, + 18, 108, 22, 100, 22, 107, 103, 104, 105, 106, + 19, 73, 63, 64, 3, 4, 5, 6, 7, 8, + 9, 13, 107, 107, 107, 510, 44, 45, 46, 47, + 106, 343, 419, 51, 564, 53, 277, 371, 56, 90, + 91, 92, 93, 94, 95, 63, 64, 248, 496, 100, + 372, 452, 103, 104, 105, 106, 471, 155, 76, 356, + 78, 79, 80, 225, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, + -1, -1, 100, -1, -1, 103, 104, 105, 106, 107, + 0, 1, -1, 111, -1, -1, -1, -1, -1, -1, + 10, 11, 12, 13, 14, -1, 16, -1, -1, -1, + -1, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, + 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 81, -1, -1, -1, -1, 44, 45, 46, 47, - -1, -1, -1, 51, -1, 53, 96, 97, -1, 99, - -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, - 110, -1, 10, 11, 12, 13, 14, 15, 16, 17, - 78, 79, 80, -1, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, - 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, - 16, 17, -1, -1, -1, -1, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, - -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, - -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, - 14, 15, -1, 17, -1, -1, -1, -1, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, - 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - 74, -1, -1, -1, -1, -1, -1, 81, -1, -1, + 70, 71, -1, 88, 89, 90, 91, 92, 93, 94, + 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, + 105, 106, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, 0, 1, -1, -1, -1, 108, 109, + 110, -1, -1, 10, 11, 12, 13, 14, -1, 16, + -1, -1, -1, -1, 21, 22, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, + 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, 89, 90, 91, + 92, 93, 94, 95, 81, -1, -1, -1, 100, -1, + -1, 103, 104, 105, 106, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, + -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, + 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, + 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, + -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, + 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, + -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, + 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, + 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, 94, 95, 81, -1, + -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, + 11, 12, 13, 14, 15, 16, -1, -1, -1, -1, + 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, + 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, 44, 45, 46, 47, -1, -1, + -1, 51, -1, 53, -1, 96, 97, -1, 99, -1, + 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, + -1, 10, 11, 12, 13, 14, 15, 16, 78, 79, + 80, -1, 21, 22, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, -1, + -1, -1, 51, 52, 53, 54, 55, -1, 57, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, + 109, 110, -1, 10, 11, 12, 13, 14, 15, 16, + -1, -1, -1, -1, 21, 22, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, -1, -1, -1, 51, 52, 53, 54, 55, -1, + 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, + -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, + -1, 16, -1, -1, -1, -1, 21, 22, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, -1, -1, -1, 51, 52, 53, 54, + 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, 74, + -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, - -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, - 12, 13, 14, 15, -1, 17, -1, -1, -1, -1, - 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, - 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, + -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, + -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, + 13, 14, -1, 16, -1, -1, -1, -1, 21, 22, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, + 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, - 10, 11, 12, 13, 14, 15, -1, 17, -1, -1, - -1, -1, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, - -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, - 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, - 110, -1, 10, 11, 12, 13, 14, -1, -1, 17, - -1, -1, -1, -1, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, - -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, - 108, 109, 110, -1, 10, 11, 12, 13, 14, -1, - -1, 17, -1, -1, -1, -1, -1, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, + 11, 12, 13, 14, -1, 16, -1, -1, -1, -1, + 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, 35, -1, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, + 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, + -1, 10, 11, 12, 13, -1, -1, 16, -1, -1, + -1, -1, 21, 22, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, + -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, + 109, 110, -1, 10, 11, 12, 13, -1, -1, 16, + -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, + -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, + -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, + 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, + 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, + 26, 27, 28, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, @@ -874,9 +885,9 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - 15, -1, 17, -1, -1, -1, -1, -1, 23, 24, - 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + -1, -1, 108, 109, 110, 10, 11, 12, 13, -1, + -1, 16, 17, -1, -1, -1, 21, -1, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, @@ -885,7 +896,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, - 14, -1, -1, 17, 18, -1, -1, -1, -1, 23, + 14, -1, 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -895,7 +906,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, - 13, 14, 15, -1, 17, -1, -1, -1, -1, -1, + 13, -1, -1, 16, -1, -1, -1, -1, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -905,8 +916,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, - 12, 13, 14, -1, -1, 17, -1, -1, -1, -1, - 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, + 12, 13, -1, -1, 16, -1, -1, -1, -1, 21, + -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, @@ -914,9 +925,9 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, - 11, 12, 13, 14, -1, -1, 17, -1, -1, -1, - -1, -1, 23, 24, 25, 26, 27, -1, 29, 30, + 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, + 11, 12, 13, -1, -1, 16, -1, -1, -1, -1, + 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, @@ -925,8 +936,8 @@ static const yytype_int16 yycheck[] = 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, 13, 14, -1, -1, 17, -1, -1, - -1, -1, -1, 23, 24, 25, 26, 27, -1, 29, + 10, 11, 12, 13, -1, -1, 16, -1, -1, -1, + -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, @@ -935,8 +946,8 @@ static const yytype_int16 yycheck[] = -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, - 110, 10, 11, 12, 13, 14, -1, -1, 17, -1, - -1, -1, -1, -1, 23, 24, 25, 26, 27, -1, + 110, 10, 11, 12, 13, -1, -1, 16, -1, -1, + -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, @@ -945,8 +956,8 @@ static const yytype_int16 yycheck[] = -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, 13, 14, -1, -1, 17, - -1, -1, -1, -1, -1, 23, 24, 25, 26, 27, + 109, 110, 10, 11, 12, 13, -1, -1, 16, -1, + -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, @@ -955,8 +966,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, - 108, 109, 110, 10, 11, 12, 13, 14, -1, -1, - 17, -1, -1, -1, -1, -1, 23, 24, 25, 26, + 108, 109, 110, 10, 11, 12, 13, -1, -1, 16, + -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, @@ -965,8 +976,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - -1, 17, -1, -1, -1, -1, -1, 23, 24, 25, + 107, 108, 109, 110, 10, 11, 12, 13, -1, -1, + 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, @@ -975,8 +986,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, 13, 14, - -1, -1, 17, -1, -1, -1, -1, -1, 23, 24, + -1, 107, 108, 109, 110, 10, 11, 12, 13, -1, + -1, 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -985,43 +996,33 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, 12, 13, - 14, -1, -1, 17, -1, -1, -1, -1, -1, 23, + -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, + -1, -1, 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 56, -1, -1, -1, -1, -1, -1, 63, 64, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, - 13, 14, -1, -1, 17, -1, -1, -1, -1, -1, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, - 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, + -1, -1, -1, -1, 108, 109, 110, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, + 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, - -1, -1, 56, -1, -1, -1, -1, -1, -1, 63, - 64, -1, -1, 96, 97, -1, 99, -1, 101, 102, - -1, -1, -1, -1, -1, 108, 109, 110, 82, 83, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, -1, -1, -1, -1, 100, 56, -1, 103, - 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, + -1, -1, 82, 83, -1, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, + 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 82, 83, -1, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, - -1, 100, 56, -1, 103, 104, 105, 106, -1, 63, - 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 83, - -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, -1, -1, -1, -1, 100, 56, -1, 103, - 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, + 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 85, 86, 87, 88, - 89, 90, 91, 92, 93, 94, 95, -1, -1, -1, - -1, 100, -1, -1, 103, 104, 105, 106 + -1, -1, -1, -1, -1, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, + 100, -1, -1, 103, 104, 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1030,61 +1031,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 14, 17, 23, 24, 25, 26, 27, 29, + 12, 13, 16, 21, 23, 24, 25, 26, 27, 29, 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 15, 121, 1, 22, 35, 37, 38, + 205, 206, 207, 14, 121, 1, 22, 35, 37, 38, 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, - 126, 168, 169, 126, 188, 188, 23, 28, 121, 200, - 208, 208, 208, 18, 174, 208, 208, 189, 17, 108, + 126, 168, 169, 126, 188, 23, 28, 121, 200, 208, + 208, 208, 17, 174, 188, 208, 208, 189, 16, 108, 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, 188, 23, 175, 192, 200, 208, 208, 121, 188, 22, 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 78, 79, 80, 19, 15, 17, 108, 92, + 208, 208, 78, 79, 80, 18, 14, 16, 108, 92, 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 15, 17, 15, - 17, 15, 17, 15, 123, 153, 154, 154, 23, 151, + 95, 100, 103, 104, 105, 106, 108, 14, 16, 14, + 16, 14, 16, 14, 123, 153, 154, 154, 23, 151, 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, 108, 121, 22, 50, 143, 22, 44, 45, 46, 47, - 51, 53, 129, 130, 128, 12, 13, 109, 159, 160, - 162, 163, 164, 165, 18, 192, 108, 75, 174, 107, + 51, 53, 129, 130, 128, 11, 12, 109, 159, 160, + 162, 163, 164, 165, 17, 192, 108, 75, 174, 107, 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, - 208, 175, 16, 22, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 72, 157, 17, 107, 174, 174, 174, + 208, 175, 15, 22, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 72, 157, 16, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 12, 13, 14, 15, 17, 24, + 188, 188, 188, 188, 11, 12, 13, 14, 16, 24, 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, - 158, 158, 19, 193, 175, 18, 177, 156, 26, 123, - 173, 107, 76, 107, 174, 16, 107, 174, 157, 107, - 26, 174, 17, 22, 18, 107, 84, 110, 110, 110, + 158, 158, 18, 193, 175, 17, 177, 156, 26, 123, + 173, 107, 76, 107, 174, 15, 107, 174, 157, 107, + 26, 174, 16, 22, 17, 107, 84, 110, 110, 110, 174, 174, 110, 107, 174, 110, 110, 108, 107, 22, - 18, 22, 18, 22, 18, 22, 16, 21, 122, 131, - 132, 15, 22, 23, 146, 174, 147, 148, 174, 148, + 17, 22, 17, 22, 17, 22, 15, 20, 122, 131, + 132, 14, 22, 23, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 18, 174, 16, - 188, 22, 18, 107, 193, 16, 16, 16, 16, 123, + 123, 171, 108, 166, 167, 107, 107, 17, 174, 15, + 188, 22, 17, 107, 193, 15, 15, 15, 15, 123, 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, - 107, 22, 136, 148, 107, 107, 188, 174, 76, 15, - 168, 15, 18, 16, 107, 22, 156, 22, 172, 173, - 137, 192, 144, 144, 15, 124, 124, 148, 148, 124, + 107, 22, 136, 148, 107, 107, 188, 174, 76, 14, + 168, 14, 17, 15, 107, 22, 156, 22, 172, 173, + 137, 192, 144, 144, 14, 124, 124, 148, 148, 124, 134, 108, 107, 124, 124, 126, 107, 126, 74, 22, 170, 171, 126, 22, 124, 124, 125, 48, 49, 142, - 142, 107, 107, 143, 146, 148, 124, 16, 16, 127, - 16, 143, 143, 126, 124, 108, 124, 124, 22, 107, - 143, 22, 26, 138, 16, 148, 143, 143, 135, 124, - 20, 73, 139, 107, 144, 143, 126, 124, 149, 74, + 142, 107, 107, 143, 146, 148, 124, 15, 15, 127, + 15, 143, 143, 126, 124, 108, 124, 124, 22, 107, + 143, 22, 26, 138, 15, 148, 143, 143, 135, 124, + 19, 73, 139, 107, 144, 143, 126, 124, 149, 74, 142, 107, 124 }; @@ -1168,41 +1169,40 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 6ae29de007d736f59463d634fd5d8ca5929a88e3038442ff8d802b6f1c8e602c perly.y + * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 7f1158857e49..2a32ef1d6b51 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,7 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '-' '+' '@' '%' +%token '+' '@' '%' %token PERLY_AMPERSAND %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE @@ -54,6 +54,7 @@ %token PERLY_COMMA %token PERLY_DOT %token PERLY_EQUAL_SIGN +%token PERLY_MINUS %token PERLY_SEMICOLON %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST @@ -1095,7 +1096,7 @@ eqopchain: term[lhs] CHEQOP term[rhs] ; /* Unary operators and terms */ -termunop : '-' term %prec UMINUS /* -$x */ +termunop : PERLY_MINUS term %prec UMINUS /* -$x */ { $$ = newUNOP(OP_NEGATE, 0, scalar($term)); } | '+' term %prec UMINUS /* +$x */ { $$ = $term; } diff --git a/toke.c b/toke.c index 0535e8f9d013..65ed54058b86 100644 --- a/toke.c +++ b/toke.c @@ -396,6 +396,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_DOT), DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), + DEBUG_TOKEN (IVAL, PERLY_MINUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), DEBUG_TOKEN (IVAL, PERLY_TILDE), @@ -5549,7 +5550,7 @@ yyl_hyphen(pTHX_ char *s) if (memBEGINs(s, (STRLEN) (PL_bufend - s), "=>")) { s = force_word(PL_bufptr,BAREWORD,FALSE,FALSE); DEBUG_T( { printbuf("### Saw unary minus before =>, forcing word %s\n", s); } ); - OPERATOR('-'); /* unary minus */ + OPERATOR(PERLY_MINUS); /* unary minus */ } switch (tmp) { case 'r': ftst = OP_FTEREAD; break; @@ -5650,7 +5651,7 @@ yyl_hyphen(pTHX_ char *s) else { if (isSPACE(*s) || !isSPACE(*PL_bufptr)) check_uni(); - OPERATOR('-'); /* unary minus */ + OPERATOR(PERLY_MINUS); /* unary minus */ } } } @@ -6030,7 +6031,7 @@ yyl_leftcurly(pTHX_ char *s, const U8 formbrack) const char minus = (PL_tokenbuf[0] == '-'); s = force_word(s + minus, BAREWORD, FALSE, TRUE); if (minus) - force_next('-'); + force_next(PERLY_MINUS); } } /* FALLTHROUGH */ From 5776f3e52dc3d9bddaadfc7c058c4e18589018b3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:12 +0100 Subject: [PATCH 338/503] Distinguish C- and perly- literals - PERLY_PLUS --- perly.act | 536 ++++++++++----------- perly.h | 173 +++---- perly.tab | 1356 +++++++++++++++++++++++++++-------------------------- perly.y | 5 +- toke.c | 3 +- 5 files changed, 1039 insertions(+), 1034 deletions(-) diff --git a/perly.act b/perly.act index 042f857f6250..756f04295f15 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 132 "perly.y" +#line 133 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 137 "perly.y" +#line 138 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 143 "perly.y" +#line 144 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 148 "perly.y" +#line 149 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 153 "perly.y" +#line 154 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 158 "perly.y" +#line 159 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 166 "perly.y" +#line 167 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 171 "perly.y" +#line 172 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 179 "perly.y" +#line 180 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 184 "perly.y" +#line 185 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 192 "perly.y" +#line 193 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 197 "perly.y" +#line 198 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 202 "perly.y" +#line 203 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 207 "perly.y" +#line 208 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 215 "perly.y" +#line 216 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 223 "perly.y" +#line 224 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 230 "perly.y" +#line 231 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 235 "perly.y" +#line 236 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 242 "perly.y" +#line 243 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 248 "perly.y" +#line 249 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 250 "perly.y" +#line 251 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 259 "perly.y" +#line 260 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 261 "perly.y" +#line 262 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 270 "perly.y" +#line 271 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 274 "perly.y" +#line 275 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 278 "perly.y" +#line 279 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 285 "perly.y" +#line 286 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 295 "perly.y" +#line 296 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 297 "perly.y" +#line 298 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 309 "perly.y" +#line 310 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 315 "perly.y" +#line 316 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 330 "perly.y" +#line 331 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 336 "perly.y" +#line 337 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 347 "perly.y" +#line 348 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 354 "perly.y" +#line 355 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 356 "perly.y" +#line 357 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 363 "perly.y" +#line 364 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 369 "perly.y" +#line 370 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 375 "perly.y" +#line 376 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 380 "perly.y" +#line 381 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 382 "perly.y" +#line 383 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 384 "perly.y" +#line 385 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 391 "perly.y" +#line 392 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 398 "perly.y" +#line 399 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 400 "perly.y" +#line 401 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 403 "perly.y" +#line 404 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 418 "perly.y" +#line 419 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 423 "perly.y" +#line 424 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 429 "perly.y" +#line 430 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 431 "perly.y" +#line 432 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 444 "perly.y" +#line 445 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 452 "perly.y" +#line 453 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 458 "perly.y" +#line 459 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 464 "perly.y" +#line 465 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 471 "perly.y" +#line 472 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 479 "perly.y" +#line 480 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 483 "perly.y" +#line 484 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 488 "perly.y" +#line 489 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 496 "perly.y" +#line 497 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 513 "perly.y" +#line 514 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 515 "perly.y" +#line 516 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 523 "perly.y" +#line 524 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 535 "perly.y" +#line 536 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 538 "perly.y" +#line 539 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 543 "perly.y" +#line 544 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 545 "perly.y" +#line 546 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 550 "perly.y" +#line 551 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 560 "perly.y" +#line 561 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 562 "perly.y" +#line 563 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 567 "perly.y" +#line 568 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 573 "perly.y" +#line 574 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 579 "perly.y" +#line 580 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 587 "perly.y" +#line 588 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 592 "perly.y" +#line 593 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 599 "perly.y" +#line 600 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 604 "perly.y" +#line 605 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 610 "perly.y" +#line 611 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 615 "perly.y" +#line 616 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 626 "perly.y" +#line 627 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 632 "perly.y" +#line 633 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 634 "perly.y" +#line 635 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 641 "perly.y" +#line 642 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 643 "perly.y" +#line 644 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 654 "perly.y" +#line 655 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 656 "perly.y" +#line 657 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 661 "perly.y" +#line 662 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 663 "perly.y" +#line 664 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 667 "perly.y" +#line 668 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 686 "perly.y" +#line 687 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 688 "perly.y" +#line 689 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 690 "perly.y" +#line 691 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 696 "perly.y" +#line 697 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 761 "perly.y" +#line 762 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 763 "perly.y" +#line 764 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 769 "perly.y" +#line 770 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 771 "perly.y" +#line 772 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 775 "perly.y" +#line 776 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 780 "perly.y" +#line 781 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 782 "perly.y" +#line 783 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 786 "perly.y" +#line 787 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 788 "perly.y" +#line 789 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 792 "perly.y" +#line 793 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 795 "perly.y" +#line 796 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 806 "perly.y" +#line 807 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 863 "perly.y" +#line 864 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 864 "perly.y" +#line 865 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 870 "perly.y" +#line 871 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 880 "perly.y" +#line 881 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 881 "perly.y" +#line 882 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 885 "perly.y" +#line 886 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 896 "perly.y" +#line 897 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 898 "perly.y" +#line 899 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 900 "perly.y" +#line 901 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 906 "perly.y" +#line 907 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 908 "perly.y" +#line 909 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 917 "perly.y" +#line 918 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 921 "perly.y" +#line 922 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 925 "perly.y" +#line 926 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 931 "perly.y" +#line 932 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 936 "perly.y" +#line 937 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 942 "perly.y" +#line 943 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 948 "perly.y" +#line 949 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 950 "perly.y" +#line 951 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 952 "perly.y" +#line 953 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 954 "perly.y" +#line 955 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 957 "perly.y" +#line 958 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 972 "perly.y" +#line 973 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 974 "perly.y" +#line 975 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 977 "perly.y" +#line 978 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 982 "perly.y" +#line 983 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 987 "perly.y" +#line 988 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 990 "perly.y" +#line 991 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 994 "perly.y" +#line 995 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 998 "perly.y" +#line 999 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1004 "perly.y" +#line 1005 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1012 "perly.y" +#line 1013 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1019 "perly.y" +#line 1020 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1025 "perly.y" +#line 1026 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1027 "perly.y" +#line 1028 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1029 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1034 "perly.y" +#line 1035 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1036 "perly.y" +#line 1037 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1038 "perly.y" +#line 1039 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1043 "perly.y" +#line 1044 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1063 "perly.y" +#line 1064 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1067 "perly.y" +#line 1068 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1069 "perly.y" +#line 1070 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1071 "perly.y" +#line 1072 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1073 "perly.y" +#line 1074 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1077 "perly.y" +#line 1078 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1079 "perly.y" +#line 1080 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1083 "perly.y" +#line 1084 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1085 "perly.y" +#line 1086 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1087 "perly.y" +#line 1088 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1089 "perly.y" +#line 1090 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1093 "perly.y" +#line 1094 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1095 "perly.y" +#line 1096 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1100 "perly.y" +#line 1101 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1107 "perly.y" +#line 1108 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1109 "perly.y" +#line 1110 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1112 "perly.y" +#line 1113 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1115 "perly.y" +#line 1116 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1126 "perly.y" +#line 1127 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1129 "perly.y" +#line 1130 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1136 "perly.y" +#line 1137 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1138 "perly.y" +#line 1139 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1140 "perly.y" +#line 1141 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1142 "perly.y" +#line 1143 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1144 "perly.y" +#line 1145 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1147 "perly.y" +#line 1148 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1153 "perly.y" +#line 1154 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1155 "perly.y" +#line 1156 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1163 "perly.y" +#line 1164 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1187 "perly.y" +#line 1188 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1189 "perly.y" +#line 1190 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1191 "perly.y" +#line 1192 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1201 "perly.y" +#line 1202 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1211 "perly.y" +#line 1212 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1221 "perly.y" +#line 1222 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1231 "perly.y" +#line 1232 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1233 "perly.y" +#line 1234 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1235 "perly.y" +#line 1236 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1238 "perly.y" +#line 1239 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1243 "perly.y" +#line 1244 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1288 "perly.y" +#line 1289 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1290 "perly.y" +#line 1291 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1294 "perly.y" +#line 1295 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1296 "perly.y" +#line 1297 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1307 "perly.y" +#line 1308 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1315 "perly.y" +#line 1316 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1317 "perly.y" +#line 1318 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1324 "perly.y" +#line 1325 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1326 "perly.y" +#line 1327 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1329 "perly.y" +#line 1330 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1331 "perly.y" +#line 1332 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1333 "perly.y" +#line 1334 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1338 "perly.y" +#line 1339 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1340 "perly.y" +#line 1341 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1344 "perly.y" +#line 1345 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1346 "perly.y" +#line 1347 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1350 "perly.y" +#line 1351 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1352 "perly.y" +#line 1353 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1358 "perly.y" +#line 1359 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1375 "perly.y" +#line 1376 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1379 "perly.y" +#line 1380 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1383 "perly.y" +#line 1384 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1389 "perly.y" +#line 1390 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1395 "perly.y" +#line 1396 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1397 "perly.y" +#line 1398 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1401 "perly.y" +#line 1402 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1406 "perly.y" +#line 1407 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1411 "perly.y" +#line 1412 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1416 "perly.y" +#line 1417 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1421 "perly.y" +#line 1422 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1423 "perly.y" +#line 1424 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1425 "perly.y" +#line 1426 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1428 "perly.y" +#line 1429 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y + * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 713b4619a485..ac50b3ad3b7c 100644 --- a/perly.h +++ b/perly.h @@ -72,91 +72,92 @@ extern int yydebug; PERLY_DOT = 271, PERLY_EQUAL_SIGN = 272, PERLY_MINUS = 273, - PERLY_SEMICOLON = 274, - BAREWORD = 275, - METHOD = 276, - FUNCMETH = 277, - THING = 278, - PMFUNC = 279, - PRIVATEREF = 280, - QWLIST = 281, - FUNC0OP = 282, - FUNC0SUB = 283, - UNIOPSUB = 284, - LSTOPSUB = 285, - PLUGEXPR = 286, - PLUGSTMT = 287, - LABEL = 288, - FORMAT = 289, - SUB = 290, - SIGSUB = 291, - ANONSUB = 292, - ANON_SIGSUB = 293, - PACKAGE = 294, - USE = 295, - WHILE = 296, - UNTIL = 297, - IF = 298, - UNLESS = 299, - ELSE = 300, - ELSIF = 301, - CONTINUE = 302, - FOR = 303, - GIVEN = 304, - WHEN = 305, - DEFAULT = 306, - LOOPEX = 307, - DOTDOT = 308, - YADAYADA = 309, - FUNC0 = 310, - FUNC1 = 311, - FUNC = 312, - UNIOP = 313, - LSTOP = 314, - MULOP = 315, - ADDOP = 316, - DOLSHARP = 317, - DO = 318, - HASHBRACK = 319, - NOAMP = 320, - LOCAL = 321, - MY = 322, - REQUIRE = 323, - COLONATTR = 324, - FORMLBRACK = 325, - FORMRBRACK = 326, - SUBLEXSTART = 327, - SUBLEXEND = 328, - PREC_LOW = 329, - OROP = 330, - DOROP = 331, - ANDOP = 332, - NOTOP = 333, - ASSIGNOP = 334, - PERLY_QUESTION_MARK = 335, - PERLY_COLON = 336, - OROR = 337, - DORDOR = 338, - ANDAND = 339, - BITOROP = 340, - BITANDOP = 341, - CHEQOP = 342, - NCEQOP = 343, - CHRELOP = 344, - NCRELOP = 345, - SHIFTOP = 346, - MATCHOP = 347, - PERLY_EXCLAMATION_MARK = 348, - PERLY_TILDE = 349, - UMINUS = 350, - REFGEN = 351, - POWOP = 352, - PREINC = 353, - PREDEC = 354, - POSTINC = 355, - POSTDEC = 356, - POSTJOIN = 357, - ARROW = 358 + PERLY_PLUS = 274, + PERLY_SEMICOLON = 275, + BAREWORD = 276, + METHOD = 277, + FUNCMETH = 278, + THING = 279, + PMFUNC = 280, + PRIVATEREF = 281, + QWLIST = 282, + FUNC0OP = 283, + FUNC0SUB = 284, + UNIOPSUB = 285, + LSTOPSUB = 286, + PLUGEXPR = 287, + PLUGSTMT = 288, + LABEL = 289, + FORMAT = 290, + SUB = 291, + SIGSUB = 292, + ANONSUB = 293, + ANON_SIGSUB = 294, + PACKAGE = 295, + USE = 296, + WHILE = 297, + UNTIL = 298, + IF = 299, + UNLESS = 300, + ELSE = 301, + ELSIF = 302, + CONTINUE = 303, + FOR = 304, + GIVEN = 305, + WHEN = 306, + DEFAULT = 307, + LOOPEX = 308, + DOTDOT = 309, + YADAYADA = 310, + FUNC0 = 311, + FUNC1 = 312, + FUNC = 313, + UNIOP = 314, + LSTOP = 315, + MULOP = 316, + ADDOP = 317, + DOLSHARP = 318, + DO = 319, + HASHBRACK = 320, + NOAMP = 321, + LOCAL = 322, + MY = 323, + REQUIRE = 324, + COLONATTR = 325, + FORMLBRACK = 326, + FORMRBRACK = 327, + SUBLEXSTART = 328, + SUBLEXEND = 329, + PREC_LOW = 330, + OROP = 331, + DOROP = 332, + ANDOP = 333, + NOTOP = 334, + ASSIGNOP = 335, + PERLY_QUESTION_MARK = 336, + PERLY_COLON = 337, + OROR = 338, + DORDOR = 339, + ANDAND = 340, + BITOROP = 341, + BITANDOP = 342, + CHEQOP = 343, + NCEQOP = 344, + CHRELOP = 345, + NCRELOP = 346, + SHIFTOP = 347, + MATCHOP = 348, + PERLY_EXCLAMATION_MARK = 349, + PERLY_TILDE = 350, + UMINUS = 351, + REFGEN = 352, + POWOP = 353, + PREINC = 354, + PREDEC = 355, + POSTINC = 356, + POSTDEC = 357, + POSTJOIN = 358, + ARROW = 359 }; #endif @@ -208,6 +209,6 @@ int yyparse (void); /* Generated from: - * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y + * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 516dc3079a17..03143718dc23 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3386 +#define YYLAST 3389 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 358 +#define YYMAXUTOK 359 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,10 +33,10 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 109, 12, 2, 2, - 108, 107, 110, 10, 2, 2, 2, 111, 2, 2, + 2, 2, 2, 2, 2, 2, 109, 11, 2, 2, + 108, 107, 110, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 11, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 10, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,52 +56,52 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 13, 14, 15, 16, 17, - 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, - 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, - 58, 59, 60, 61, 62, 63, 64, 65, 66, 67, - 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, - 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, - 98, 99, 100, 101, 102, 103, 104, 105, 106 + 5, 6, 7, 8, 9, 12, 13, 14, 15, 16, + 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, + 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, + 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 97, 98, 99, 100, 101, 102, 103, 104, 105, 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 132, 132, 131, 143, 142, 153, 152, 166, 165, - 179, 178, 192, 191, 202, 201, 214, 222, 230, 234, - 242, 248, 249, 259, 260, 269, 273, 277, 284, 294, - 296, 309, 306, 330, 325, 346, 354, 353, 362, 368, - 374, 379, 381, 383, 390, 398, 400, 397, 417, 422, - 429, 428, 443, 451, 457, 464, 463, 478, 482, 487, - 495, 513, 514, 518, 522, 524, 526, 528, 530, 532, - 534, 537, 543, 544, 549, 560, 561, 567, 573, 574, - 579, 582, 586, 591, 595, 599, 600, 604, 610, 615, - 620, 621, 626, 627, 632, 633, 635, 640, 642, 654, - 655, 660, 662, 666, 686, 687, 689, 695, 760, 762, - 768, 770, 774, 780, 781, 786, 787, 791, 795, 795, - 863, 864, 869, 880, 881, 884, 895, 897, 899, 901, - 905, 907, 912, 916, 920, 924, 930, 935, 941, 947, - 949, 951, 954, 953, 964, 965, 969, 973, 976, 981, - 986, 989, 993, 997, 1003, 1011, 1018, 1024, 1026, 1028, - 1033, 1035, 1037, 1042, 1044, 1046, 1048, 1050, 1052, 1054, - 1056, 1058, 1060, 1062, 1066, 1068, 1070, 1072, 1076, 1078, - 1082, 1084, 1086, 1088, 1092, 1094, 1099, 1101, 1104, 1106, - 1108, 1111, 1114, 1125, 1128, 1135, 1137, 1139, 1141, 1143, - 1146, 1152, 1154, 1158, 1159, 1160, 1161, 1162, 1164, 1166, - 1168, 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, - 1188, 1190, 1200, 1210, 1220, 1230, 1232, 1234, 1237, 1242, - 1246, 1248, 1250, 1252, 1255, 1257, 1260, 1262, 1264, 1266, - 1268, 1270, 1272, 1274, 1276, 1279, 1281, 1283, 1285, 1287, - 1289, 1293, 1296, 1295, 1308, 1309, 1310, 1314, 1316, 1318, - 1323, 1325, 1328, 1330, 1332, 1337, 1339, 1344, 1345, 1350, - 1351, 1357, 1361, 1362, 1363, 1366, 1367, 1370, 1371, 1374, - 1378, 1382, 1388, 1394, 1396, 1400, 1404, 1405, 1409, 1410, - 1414, 1415, 1420, 1422, 1424, 1427 + 0, 133, 133, 132, 144, 143, 154, 153, 167, 166, + 180, 179, 193, 192, 203, 202, 215, 223, 231, 235, + 243, 249, 250, 260, 261, 270, 274, 278, 285, 295, + 297, 310, 307, 331, 326, 347, 355, 354, 363, 369, + 375, 380, 382, 384, 391, 399, 401, 398, 418, 423, + 430, 429, 444, 452, 458, 465, 464, 479, 483, 488, + 496, 514, 515, 519, 523, 525, 527, 529, 531, 533, + 535, 538, 544, 545, 550, 561, 562, 568, 574, 575, + 580, 583, 587, 592, 596, 600, 601, 605, 611, 616, + 621, 622, 627, 628, 633, 634, 636, 641, 643, 655, + 656, 661, 663, 667, 687, 688, 690, 696, 761, 763, + 769, 771, 775, 781, 782, 787, 788, 792, 796, 796, + 864, 865, 870, 881, 882, 885, 896, 898, 900, 902, + 906, 908, 913, 917, 921, 925, 931, 936, 942, 948, + 950, 952, 955, 954, 965, 966, 970, 974, 977, 982, + 987, 990, 994, 998, 1004, 1012, 1019, 1025, 1027, 1029, + 1034, 1036, 1038, 1043, 1045, 1047, 1049, 1051, 1053, 1055, + 1057, 1059, 1061, 1063, 1067, 1069, 1071, 1073, 1077, 1079, + 1083, 1085, 1087, 1089, 1093, 1095, 1100, 1102, 1105, 1107, + 1109, 1112, 1115, 1126, 1129, 1136, 1138, 1140, 1142, 1144, + 1147, 1153, 1155, 1159, 1160, 1161, 1162, 1163, 1165, 1167, + 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, + 1189, 1191, 1201, 1211, 1221, 1231, 1233, 1235, 1238, 1243, + 1247, 1249, 1251, 1253, 1256, 1258, 1261, 1263, 1265, 1267, + 1269, 1271, 1273, 1275, 1277, 1280, 1282, 1284, 1286, 1288, + 1290, 1294, 1297, 1296, 1309, 1310, 1311, 1315, 1317, 1319, + 1324, 1326, 1329, 1331, 1333, 1338, 1340, 1345, 1346, 1351, + 1352, 1358, 1362, 1363, 1364, 1367, 1368, 1371, 1372, 1375, + 1379, 1383, 1389, 1395, 1397, 1401, 1405, 1406, 1410, 1411, + 1415, 1416, 1421, 1423, 1425, 1428 }; #endif @@ -111,39 +111,40 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'+'", - "'@'", "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'@'", + "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", - "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_SEMICOLON", "BAREWORD", - "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", - "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", - "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", - "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", - "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", - "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", - "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", - "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", - "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", - "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", - "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", - "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", - "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", - "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", - "@5", "@6", "@7", "block", "formblock", "remember", "mblock", - "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", - "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", "$@14", - "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", - "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", - "startanonsub", "startformsub", "subname", "proto", "subattrlist", - "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", - "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", - "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", - "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", - "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", - "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", - "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", - "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", - "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PLUS", "PERLY_SEMICOLON", + "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", + "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", + "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", + "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", + "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", + "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", + "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", + "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", + "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", + "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", + "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", + "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", + "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", + "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", + "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", + "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", + "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", + "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", + "startsub", "startanonsub", "startformsub", "subname", "proto", + "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", + "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", + "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", + "listexpr", "listop", "@16", "method", "subscripted", "termbinop", + "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", + "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", + "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", + "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", + "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -153,21 +154,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 43, 64, 37, 265, 266, 267, 268, 269, 270, 271, - 272, 273, 274, 275, 276, 277, 278, 279, 280, 281, - 282, 283, 284, 285, 286, 287, 288, 289, 290, 291, - 292, 293, 294, 295, 296, 297, 298, 299, 300, 301, - 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 314, 315, 316, 317, 318, 319, 320, 321, - 322, 323, 324, 325, 326, 327, 328, 329, 330, 331, - 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, - 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, - 352, 353, 354, 355, 356, 357, 358, 41, 40, 36, + 64, 37, 265, 266, 267, 268, 269, 270, 271, 272, + 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, + 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, + 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, + 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, + 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, + 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, + 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, + 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, + 353, 354, 355, 356, 357, 358, 359, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-479) +#define YYPACT_NINF (-475) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -181,64 +182,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 601, -479, -479, -479, -479, -479, -479, -479, 19, -479, - 3015, 32, 1599, 1497, -479, -479, -479, -479, 3015, 37, - 37, 37, 2005, 3015, -479, 37, 37, -479, -479, 75, - -55, -479, 3015, -479, -479, -479, -479, 3015, -41, -6, - -25, 2106, 1904, 37, 2106, 2207, 8, 3015, 13, 3015, - 3015, 3015, 3015, 3015, 3015, 3015, 2308, 37, 37, 303, - 93, -479, -4, -479, -19, 27, -9, 36, -479, -479, - -479, 3190, -479, -479, 55, 83, 101, 126, -479, 121, - 244, 266, 131, -479, -479, -479, -479, -479, -479, 8, - 8, 137, -479, 59, 71, 76, 85, 286, 106, 129, - 32, 187, 191, -479, 225, 1130, 1497, -479, -479, -479, - 680, -479, 5, 783, 430, -479, -479, -479, -479, -479, - -479, -479, -479, 79, 430, 3015, 145, 186, 3015, 167, - 972, 32, 257, 207, 3190, 215, 2409, 3015, 1904, -479, - 972, 572, 93, -479, 476, 3015, -479, -479, 972, 313, - 112, -479, -479, 3015, 972, 3116, 2510, 258, -479, -479, - -479, 972, 93, 430, 430, 430, 202, 202, 316, 326, - -479, -479, 3015, 3015, 3015, 3015, 3015, 3015, 2611, -479, - -479, 3015, -479, -479, 3015, 3015, 3015, 3015, 3015, 3015, - 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, 3015, - 3015, 3015, -479, -479, -479, 305, 2712, 3015, 3015, 3015, - 3015, 3015, 3015, 3015, -479, 343, -479, -479, 344, -479, - -479, -479, -479, -479, 263, 22, -479, -479, 267, -479, - -479, -479, -479, 32, -479, -479, 3015, 3015, 3015, 3015, - 3015, 3015, -479, -479, -479, -479, -479, 346, 346, -479, - -479, -479, 353, -479, -479, -479, 3015, 3015, 107, -479, - -479, -479, 207, 360, -479, -479, -479, 362, 331, 272, - 3015, 93, -479, 374, -479, 2813, 430, 258, 31, 240, - 243, -479, 375, 382, -479, 3015, 393, 342, 342, -479, - 3190, 156, 116, -479, 388, 972, 870, 3280, 493, 410, - 3190, 3145, 357, 357, 665, 768, 539, 870, 870, 972, - 972, 443, 430, 430, 301, 315, 319, 3015, 3015, -479, - 320, 2914, 52, 324, 327, -479, -479, 401, 224, 133, - 298, 160, 318, 165, 322, 885, -479, 403, -479, -479, - 16, 405, 3015, 3015, 3015, 3015, -479, 317, -479, -479, - 329, -479, -479, -479, -479, 1701, 29, -479, 3015, 3015, - -479, -479, 303, -479, 303, -479, -479, -479, -479, -479, - 356, 356, 5, 336, 14, -479, 3015, -479, -479, 348, - -479, -479, -479, -479, 421, -479, 7, 446, -479, -479, - -479, 171, 3015, 444, -479, -479, 3015, -479, -479, -479, - 339, 190, -479, -479, 506, -479, -479, 3015, -479, 449, - -479, 450, -479, 460, -479, 462, -479, -479, -479, 257, - 207, -479, -479, 435, 371, 303, 377, 378, 303, 379, - 380, -479, -479, -479, -479, 390, 465, 280, -479, 3015, - 397, 404, 3015, -479, -479, -479, -479, 3015, 413, -479, - 498, -479, -479, 503, -479, -479, 23, -479, 193, -479, - 3235, 504, -479, -479, 411, -479, -479, -479, -479, 509, - 207, 519, -479, 3015, -479, -479, 531, 531, 3015, 3015, - 531, -479, 442, 466, 531, 531, 3190, 303, -479, -479, - 467, -479, -479, -479, -479, 477, 535, -479, -479, -479, - -479, 553, 531, 531, -479, 58, 58, 470, 471, 191, - 3015, 3015, 531, -479, -479, 987, -479, 1089, -479, -479, - -479, -479, 1191, -479, 191, 191, -479, 531, 483, -479, - -479, 531, 531, -479, 570, 488, 191, -479, -479, 35, - -479, -479, -479, 1293, -479, 3015, 191, 191, -479, 531, - -479, 581, 528, -479, -479, 505, -479, -479, -479, 191, - -479, -479, -479, 531, 1803, -479, 1395, 58, 507, -479, - -479, 531, -479 + 604, -475, -475, -475, -475, -475, -475, -475, 47, -475, + 3018, 10, 1602, 1500, -475, -475, -475, -475, 18, 18, + 18, 2008, 3018, 3018, -475, 18, 18, -475, -475, 59, + -59, -475, 3018, -475, -475, -475, -475, 3018, -22, -12, + -39, 2109, 1907, 18, 2109, 2210, 72, 3018, -1, 3018, + 3018, 3018, 3018, 3018, 3018, 3018, 2311, 18, 18, 460, + 94, -475, 43, -475, -30, 26, 85, 49, -475, -475, + -475, 3193, -475, -475, 45, 60, 106, 130, -475, 102, + 158, 181, 120, -475, -475, -475, -475, -475, -475, 72, + 72, 144, -475, 71, 74, 112, 115, 167, 119, 126, + 10, 171, 160, -475, 214, 1132, 1500, -475, -475, -475, + 683, -475, 23, 786, -475, -475, -475, -475, -475, -475, + -475, -475, 1, 355, 355, 3018, 143, 163, 3018, 154, + 975, 10, 260, 233, 3193, 205, 2412, 3018, 1907, -475, + 975, 575, 94, -475, 479, 3018, -475, -475, 975, 307, + 185, -475, -475, 3018, 975, 3119, 2513, 247, -475, -475, + -475, 975, 94, 355, 355, 355, 56, 56, 310, 248, + -475, -475, 3018, 3018, 3018, 3018, 3018, 3018, 2614, -475, + -475, 3018, -475, -475, 3018, 3018, 3018, 3018, 3018, 3018, + 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, + 3018, 3018, -475, -475, -475, 305, 2715, 3018, 3018, 3018, + 3018, 3018, 3018, 3018, -475, 330, -475, -475, 346, -475, + -475, -475, -475, -475, 234, 14, -475, -475, 259, -475, + -475, -475, -475, 10, -475, -475, 3018, 3018, 3018, 3018, + 3018, 3018, -475, -475, -475, -475, -475, 343, 343, -475, + -475, -475, 360, -475, -475, -475, 3018, 3018, 108, -475, + -475, -475, 233, 352, -475, -475, -475, 280, 306, 276, + 3018, 94, -475, 372, -475, 2816, 355, 247, 27, 123, + 177, -475, 357, 359, -475, 3018, 373, 312, 312, -475, + 3193, 228, 133, -475, 371, 975, 412, 3283, 498, 362, + 3193, 3148, 668, 668, 771, 873, 542, 412, 412, 975, + 975, 382, 355, 355, 283, 287, 288, 3018, 3018, -475, + 290, 2917, 7, 291, 297, -475, -475, 374, 252, 162, + 316, 165, 341, 175, 344, 888, -475, 384, -475, -475, + 48, 387, 3018, 3018, 3018, 3018, -475, 302, -475, -475, + 309, -475, -475, -475, -475, 1704, 28, -475, 3018, 3018, + -475, -475, 460, -475, 460, -475, -475, -475, -475, -475, + 348, 348, 23, 331, -10, -475, 3018, -475, -475, 335, + -475, -475, -475, -475, 441, -475, 13, 449, -475, -475, + -475, 190, 3018, 430, -475, -475, 3018, -475, -475, -475, + 354, 193, -475, -475, 471, -475, -475, 3018, -475, 433, + -475, 442, -475, 455, -475, 459, -475, -475, -475, 260, + 233, -475, -475, 440, 377, 460, 383, 386, 460, 390, + 381, -475, -475, -475, -475, 391, 458, 295, -475, 3018, + 393, 401, 3018, -475, -475, -475, -475, 3018, 434, -475, + 500, -475, -475, 501, -475, -475, 40, -475, 244, -475, + 3238, 497, -475, -475, 415, -475, -475, -475, -475, 509, + 233, 511, -475, 3018, -475, -475, 521, 521, 3018, 3018, + 521, -475, 428, 439, 521, 521, 3193, 460, -475, -475, + 445, -475, -475, -475, -475, 467, 525, -475, -475, -475, + -475, 531, 521, 521, -475, 198, 198, 447, 453, 160, + 3018, 3018, 521, -475, -475, 990, -475, 1092, -475, -475, + -475, -475, 1194, -475, 160, 160, -475, 521, 468, -475, + -475, 521, 521, -475, 555, 473, 160, -475, -475, 83, + -475, -475, -475, 1296, -475, 3018, 160, 160, -475, 521, + -475, 563, 514, -475, -475, 481, -475, -475, -475, 160, + -475, -475, -475, 521, 1806, -475, 1398, 198, 482, -475, + -475, 521, -475 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -257,8 +258,8 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 187, 292, 295, 294, 293, 281, - 282, 279, 196, 0, 186, 265, 0, 0, 0, 0, + 0, 15, 113, 0, 292, 295, 294, 293, 281, 282, + 279, 196, 0, 186, 187, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, @@ -309,16 +310,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -479, -479, -479, -479, -479, -479, -479, -479, -479, 43, - -479, -5, -139, -479, -17, -479, 598, 514, -1, -479, - -479, -479, -479, -479, -479, -479, -479, -479, 25, -337, - -478, -156, -468, -479, 105, 278, -303, 60, -479, 138, - 136, -479, 253, 203, -247, 349, 389, -479, -479, 256, - -479, 268, -479, -479, -479, -479, 189, -479, -479, 142, - -479, 175, -8, -37, -479, -479, -479, -479, -479, -479, - -479, -479, -479, -479, -479, -479, 100, -479, -479, 492, - -124, -129, -479, -479, 293, -479, -479, 428, 1, -45, - -42, -479, -479, -479, -479, -479, 51 + -475, -475, -475, -475, -475, -475, -475, -475, -475, 46, + -475, -5, -123, -475, -17, -475, 581, 489, 0, -475, + -475, -475, -475, -475, -475, -475, -475, -475, 42, -350, + -474, -118, -461, -475, 86, 256, -337, 36, -475, 127, + 221, -475, 275, 195, -235, 338, 368, -475, -475, 246, + -475, 251, -475, -475, -475, -475, 166, -475, -475, 128, + -475, 156, -8, -31, -475, -475, -475, -475, -475, -475, + -475, -475, -475, -475, -475, -475, 103, -475, -475, 470, + -124, -122, -475, -475, 273, -475, -475, 405, 34, -45, + -42, -475, -475, -475, -475, -475, 25 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -341,219 +342,189 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 503, 268, 269, - 176, 103, 177, 162, 123, 377, 245, 246, 433, 16, - 118, 118, 118, 285, 19, 20, 118, 118, 530, 274, - 421, 151, 175, 19, 20, 21, 152, 150, 422, 392, - 19, 20, 429, 144, 118, 207, 83, 208, 169, 158, - 137, 83, 435, 129, 84, 440, 441, 551, 118, 118, - 115, 552, 117, 117, 117, 116, 83, 135, 117, 117, - 119, 120, 121, 179, 180, 115, 125, 126, 214, -261, - 116, 182, 183, 138, 139, 117, 117, 147, 142, 570, - 564, 128, 348, 145, 146, -260, 254, 207, 228, 208, - 117, 117, 136, -262, 178, 243, 527, 528, 271, 171, - 279, 175, 155, 280, 247, -286, 142, -286, 114, 181, - 258, 156, 57, 124, 375, 447, 184, 373, 267, 59, - 59, 57, 130, 394, 273, -290, 483, 134, 57, 144, - -288, 140, -288, 231, 148, 213, 57, 154, 282, 161, - 410, 163, 164, 165, 166, 167, 278, 172, 173, 174, - 218, 57, 405, 206, 287, 288, 289, 220, 291, 292, - 294, 132, 133, 471, 260, 507, 508, 412, 393, 221, - 353, 117, 414, 354, 222, 172, 173, 174, 457, 270, - 172, 173, 174, 223, 172, 173, 174, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 462, 535, 232, - 492, 172, 173, 174, 229, 342, 343, 344, 345, 347, - 374, 355, 356, 496, 358, 359, 352, 433, 362, 364, - 362, 362, 362, 362, 172, 173, 174, 230, 172, 173, - 174, 233, 555, 172, 173, 174, 409, 235, 59, 172, - 173, 174, 449, 256, -286, 276, -286, -288, 209, -288, - 210, 257, 384, 365, 366, 367, 368, 387, 172, 173, - 174, 172, 173, 174, 259, 290, 360, 391, 464, 263, - 211, 295, 212, 261, 296, 297, 298, 299, 300, 301, - 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, -291, -291, -291, 205, 400, - 401, 353, -264, 404, 354, -263, 314, 315, 316, 317, - 411, 318, 265, 118, 236, 237, 238, 239, 272, 319, - 283, 240, 285, 241, 425, 364, 428, 428, 506, 142, - 413, 509, 216, 217, 415, 513, 514, 437, 431, 501, - 428, 428, 439, 533, 338, 339, 224, 352, 172, 173, - 174, 461, 346, 524, 525, 117, 336, 340, 541, 542, - 320, 372, 450, 536, 369, 357, 172, 173, 174, 383, - 550, 172, 173, 174, 458, 225, 378, -83, 544, 385, - 556, 557, 546, 547, 226, 57, 172, 173, 174, 59, - 172, 173, 174, 565, 172, 173, 174, 382, 390, 392, - 559, 397, 469, 321, 322, 323, 472, 172, 173, 174, - 186, 187, 174, 417, 567, 398, 57, 479, 423, 399, - 402, 428, 572, 286, 406, 407, 142, 432, 442, 487, - 172, 173, 174, 446, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 172, 173, 174, 452, 201, 473, 459, - 202, 203, 204, 205, 465, 466, 172, 173, 174, 381, - 428, 428, 515, 186, 517, 467, -215, 468, 474, 172, - 173, 174, 389, 522, 475, 476, 477, 481, 478, 488, - 207, 450, 208, -215, -215, 395, 460, 480, -215, 172, - 173, 174, 425, 428, 484, 200, 186, 187, 408, 543, - 201, 485, 489, 202, 203, 204, 205, 491, 494, 493, - -215, -215, -215, -215, 172, 173, 174, -215, 455, -215, - 201, 495, -215, 202, 203, 204, 205, 428, 200, -215, - -215, 497, 486, 201, 566, 504, 202, 203, 204, 205, - 511, 518, -215, 456, -215, -215, -215, 519, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -254, 512, 516, 523, -215, 531, 532, -215, - -215, -215, -215, -215, 172, 173, 174, -215, 200, -254, - -254, 545, 548, 201, -254, 549, 202, 203, 204, 205, - 560, 561, 186, 187, 1, 2, 3, 4, 5, 6, - 7, 107, 563, 463, 571, 534, -254, -254, -254, -254, - 242, 426, 470, -254, 568, -254, 388, 444, -254, 195, - 196, 197, 198, 199, 200, -254, -254, 371, 521, 201, - 445, 490, 202, 203, 204, 205, 499, 277, -254, 438, - -254, -254, -254, 351, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, 0, 0, - 0, 0, -254, 0, 0, -254, -254, -254, -254, -254, - -13, 85, 0, -254, 0, 0, 0, 0, 0, 0, - 18, 19, 20, 21, 83, 0, 22, 0, 0, 0, - 0, 23, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 193, 194, 195, 196, 197, 198, 199, - 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, -3, 85, 0, 0, 0, 56, 57, - 58, 0, 0, 18, 19, 20, 21, 83, 0, 22, - 0, 0, 0, 0, 23, 86, 24, 25, 26, 27, + 113, 255, 59, 159, 17, 433, 160, 175, 429, 18, + 19, 142, 103, 122, 503, 268, 269, 254, 435, 162, + 83, 440, 441, 83, 18, 19, 20, 377, 285, 274, + 114, 83, 530, 245, 246, 115, 137, 150, 18, 19, + 207, 114, 208, 118, 119, 120, 115, 16, 169, 129, + 125, 126, 117, 117, 117, 392, 176, 84, 177, 117, + 117, 421, 179, 180, 116, 116, 116, 145, 146, 138, + 422, 116, 116, 207, 128, 208, 144, 117, 214, 172, + 173, 174, 158, 171, 348, -261, 135, 139, 116, 116, + 147, 117, 117, 570, 142, 151, 136, 564, 155, -262, + 152, 447, 483, 116, 116, 551, 243, 156, 57, 552, + 279, 175, -260, 280, 271, -290, 57, 405, 181, -286, + 258, -286, 142, 57, 375, 123, 124, 57, 267, 59, + 59, 228, 247, 213, 373, 130, -286, 57, -286, 184, + 134, 507, 508, -288, 140, -288, 231, 148, 282, 394, + 154, 178, 161, 206, 163, 164, 165, 166, 167, -291, + -291, -291, 205, 270, 287, 288, 289, 218, 291, 292, + 294, 209, 144, 210, 535, 182, 183, 260, 410, 220, + 353, 412, 221, 354, 116, 471, 172, 173, 174, 278, + -288, 414, -288, 232, 211, -264, 212, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 457, 273, 555, 462, + 233, 172, 173, 174, 433, 342, 343, 344, 345, 347, + 222, 355, 356, 223, 358, 359, 374, 229, 362, 364, + 362, 362, 362, 362, 230, 496, 235, 224, 257, 325, + 172, 173, 174, 172, 173, 174, 527, 528, 59, -263, + 393, 256, 449, 172, 173, 174, 132, 133, 276, 352, + 492, 259, 384, 172, 173, 174, 225, 387, 172, 173, + 174, 172, 173, 174, 409, 226, 57, 391, 290, 360, + 365, 366, 367, 368, 295, 464, 261, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, + 309, 310, 311, 312, 313, 263, 172, 173, 174, 400, + 401, 353, 265, 404, 354, 314, 315, 316, 317, 283, + 318, 272, 172, 173, 174, 285, 172, 173, 174, 319, + 172, 173, 174, 346, 425, 364, 428, 428, 411, 236, + 237, 238, 239, 338, 339, 142, 240, 437, 241, 501, + 428, 428, 439, 336, 506, 286, 117, 509, 172, 173, + 174, 513, 514, 413, 216, 217, 415, 357, 116, 340, + 320, 369, 450, 172, 173, 174, 461, 372, 378, 524, + 525, 431, 382, 383, 458, 390, 385, 381, 392, 536, + 352, 533, 174, 397, 172, 173, 174, 398, 399, 59, + 402, 406, -83, 417, 544, 407, 541, 542, 546, 547, + 423, 57, 469, 321, 322, 323, 472, 432, 550, 172, + 173, 174, 172, 173, 174, 186, 559, 479, 556, 557, + 442, 428, 172, 173, 174, 172, 173, 174, 446, 487, + 567, 565, 142, 452, 459, 186, 187, 465, 572, 172, + 173, 174, 172, 173, 174, 201, 466, 200, 202, 203, + 204, 205, 201, 473, 389, 202, 203, 204, 205, 467, + 428, 428, 515, 468, 517, 186, 187, 200, 395, -215, + 481, 408, 201, 522, 474, 202, 203, 204, 205, 478, + 475, 450, 207, 476, 208, -215, -215, 477, 480, 460, + 484, -215, 425, 428, 197, 198, 199, 200, 485, 543, + 488, 493, 201, 489, 491, 202, 203, 204, 205, 172, + 173, 174, 494, -215, -215, -215, -215, 172, 173, 174, + -215, 495, -215, 497, 504, -215, 511, 428, 172, 173, + 174, 518, -215, -215, 566, 486, 512, 519, 455, 172, + 173, 174, 516, 523, 531, -215, 456, -215, -215, -215, + 532, -215, -215, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -215, -254, 545, 548, 463, -215, + 549, 560, -215, -215, -215, -215, -215, 561, 563, 571, + -215, -254, -254, 200, 107, 242, 534, -254, 201, 426, + 568, 202, 203, 204, 205, 186, 187, 1, 2, 3, + 4, 5, 6, 7, 470, 388, 371, 444, 490, -254, + -254, -254, -254, 445, 521, 277, -254, 499, -254, 438, + 351, -254, 195, 196, 197, 198, 199, 200, -254, -254, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, -254, 0, -254, -254, -254, 0, -254, -254, -254, + -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, + -254, 0, 0, 0, 0, -254, 0, 0, -254, -254, + -254, -254, -254, -13, 85, 0, -254, 0, 0, 0, + 0, 0, 0, 18, 19, 20, 83, 0, 21, 0, + 0, 0, 0, 22, 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 194, 195, 196, + 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 57, 58, 0, 18, 19, 20, 21, 83, - 416, 22, 0, 0, 0, 0, 23, 86, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, - 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, - 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, - 21, 83, 537, 22, 0, 0, 0, 0, 23, 86, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, - 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 199, 200, 50, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, - 19, 20, 21, 83, 538, 22, 0, 0, 0, 0, - 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 236, 237, 238, 239, 0, 0, - 0, 240, 0, 241, 0, 51, 52, 0, 53, 0, - 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 83, 540, 22, 172, 173, - 174, 0, 23, 86, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, - 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 57, 58, 0, 18, 19, 20, 21, 83, 554, 22, - 0, 0, 0, 0, 23, 86, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, - 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 85, 0, 0, 0, - 0, 56, 57, 58, 0, 18, 19, 20, 21, 83, - 0, 22, 0, 0, 0, 0, 23, 86, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, - 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 569, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 52, 0, 53, 0, 54, 55, -3, 85, 0, 0, + 0, 56, 57, 58, 0, 0, 18, 19, 20, 83, + 0, 21, 0, 0, 0, 0, 22, 23, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 193, + 194, 195, 196, 197, 198, 199, 200, 50, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, + 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, + 20, 83, 416, 21, 0, 0, 0, 0, 22, 23, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 194, 195, 196, 197, 198, 199, 200, 50, + 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, + 18, 19, 20, 83, 537, 21, 0, 0, 0, 0, + 22, 23, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 199, + 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, + 58, 0, 18, 19, 20, 83, 538, 21, 0, 0, + 0, 0, 22, 23, 86, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 236, 237, 238, 239, + 0, 0, 0, 240, 0, 241, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 57, 58, 0, 18, 19, 20, 83, 540, 21, + 172, 173, 174, 0, 22, 23, 86, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 85, 0, - 0, 0, 0, 56, 57, 58, 0, 18, 19, 20, - 21, 83, 0, 22, 0, 0, 0, 0, 23, 86, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, - 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 57, 58, 0, 18, 19, 20, 83, + 554, 21, 0, 0, 0, 0, 22, 23, 86, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 85, 0, 0, 0, 0, 56, 57, 58, 0, 18, - 19, 20, 21, 83, 0, 22, 0, 0, 0, 0, - 23, 86, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 0, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 85, 0, 0, 0, 0, 56, 57, 58, - 0, 18, 19, 20, 21, 0, 0, 22, 0, 0, - 0, 0, 23, -78, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 85, 0, 0, 0, 0, 56, - 57, 58, 0, 18, 19, 20, 21, 0, 0, 22, - 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - -78, 56, 57, 58, 18, 19, 20, 21, 83, 0, - 22, 0, 0, 0, 0, 23, 0, 141, 25, 26, - 27, 28, 116, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, + 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, + 20, 83, 0, 21, 0, 0, 0, 0, 22, 23, + 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, + 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 569, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, + 18, 19, 20, 83, 0, 21, 0, 0, 0, 0, + 22, 23, 86, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, + 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, + 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, + 58, 0, 18, 19, 20, 83, 0, 21, 0, 0, + 0, 0, 22, 23, 86, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 0, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, + 56, 57, 58, 0, 18, 19, 20, 0, 0, 21, + 0, 0, 0, 0, 22, 23, -78, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 0, 56, 57, 58, 18, 19, 20, 21, 0, - 0, 22, 122, 0, 0, 0, 23, 0, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, - 83, 0, 22, 0, 0, 0, 0, 23, 0, 24, + 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, + 0, 0, 56, 57, 58, 0, 18, 19, 20, 0, + 0, 21, 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -562,9 +533,9 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 56, 57, 58, 18, 19, 20, - 21, 0, 0, 22, 0, 0, 0, 0, 23, 149, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 0, 0, 0, -78, 56, 57, 58, 18, 19, 20, + 83, 0, 21, 0, 0, 0, 0, 22, 23, 0, + 141, 25, 26, 27, 28, 115, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, @@ -573,7 +544,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, - 20, 21, 0, 0, 22, 0, 0, 0, 0, 23, + 20, 0, 0, 21, 121, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -582,8 +553,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 168, 56, 57, 58, 18, - 19, 20, 21, 0, 0, 22, 0, 0, 0, 0, + 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, + 19, 20, 83, 0, 21, 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -592,9 +563,9 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 266, 56, 57, 58, - 18, 19, 20, 21, 0, 0, 22, 0, 0, 0, - 0, 23, 0, 24, 25, 26, 27, 28, 0, 29, + 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, + 18, 19, 20, 0, 0, 21, 0, 0, 0, 0, + 22, 23, 149, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, @@ -602,9 +573,9 @@ static const yytype_int16 yytable[] = 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 281, 56, 57, - 58, 18, 19, 20, 21, 0, 0, 22, 0, 0, - 0, 0, 23, 0, 24, 25, 26, 27, 28, 0, + 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, + 58, 18, 19, 20, 0, 0, 21, 0, 0, 0, + 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -612,9 +583,9 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 293, 56, - 57, 58, 18, 19, 20, 21, 0, 0, 22, 0, - 0, 0, 0, 23, 0, 24, 25, 26, 27, 28, + 53, 0, 54, 55, 0, 0, 0, 0, 168, 56, + 57, 58, 18, 19, 20, 0, 0, 21, 0, 0, + 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -622,9 +593,9 @@ static const yytype_int16 yytable[] = 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 326, - 56, 57, 58, 18, 19, 20, 21, 0, 0, 22, - 0, 0, 0, 0, 23, 0, 24, 25, 26, 27, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 266, + 56, 57, 58, 18, 19, 20, 0, 0, 21, 0, + 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -633,8 +604,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 386, 56, 57, 58, 18, 19, 20, 21, 0, 0, - 22, 0, 0, 0, 0, 23, 0, 24, 25, 26, + 281, 56, 57, 58, 18, 19, 20, 0, 0, 21, + 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -643,8 +614,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 403, 56, 57, 58, 18, 19, 20, 21, 0, - 0, 22, 0, 0, 0, 0, 23, 0, 24, 25, + 0, 293, 56, 57, 58, 18, 19, 20, 0, 0, + 21, 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -653,250 +624,250 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 0, 56, 57, 58, 18, 19, 20, 21, - 0, 0, 22, 0, 0, 0, 0, 23, 0, 24, + 0, 0, 326, 56, 57, 58, 18, 19, 20, 0, + 0, 21, 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 185, 0, 0, 0, 0, 0, 0, 186, 187, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 0, 275, 57, 58, 188, 189, 396, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, - 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, + 0, 0, 0, 386, 56, 57, 58, 18, 19, 20, + 0, 0, 21, 0, 0, 0, 0, 22, 23, 0, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 0, 0, 0, 0, 403, 56, 57, 58, 18, 19, + 20, 0, 0, 21, 0, 0, 0, 0, 22, 23, + 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, + 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 188, 189, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, + 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, + 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, + 19, 20, 0, 0, 21, 0, 0, 0, 0, 22, + 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 185, 0, 0, 0, 0, 0, + 0, 186, 187, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 0, 0, 0, 0, 0, 275, 57, 58, + 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, + 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 189, 0, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, -291, 0, 202, 203, - 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, + 0, 189, 0, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, -291, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205 + 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 475, 137, 138, - 14, 12, 16, 50, 22, 262, 11, 12, 355, 0, - 19, 20, 21, 16, 11, 12, 25, 26, 506, 153, - 14, 23, 18, 11, 12, 13, 28, 45, 22, 16, - 11, 12, 345, 42, 43, 14, 14, 16, 56, 48, - 75, 14, 355, 108, 11, 358, 359, 22, 57, 58, - 23, 26, 19, 20, 21, 28, 14, 108, 25, 26, - 19, 20, 21, 92, 93, 23, 25, 26, 83, 72, - 28, 90, 91, 108, 41, 42, 43, 44, 125, 567, - 558, 16, 70, 42, 43, 72, 17, 14, 97, 16, - 57, 58, 108, 72, 108, 106, 48, 49, 145, 58, - 155, 18, 99, 155, 109, 14, 153, 16, 18, 92, - 128, 108, 109, 23, 17, 111, 90, 256, 136, 137, - 138, 109, 32, 17, 22, 14, 439, 37, 109, 138, - 14, 41, 16, 100, 44, 14, 109, 47, 156, 49, - 17, 51, 52, 53, 54, 55, 155, 78, 79, 80, - 23, 109, 110, 108, 172, 173, 174, 108, 176, 177, - 178, 35, 36, 420, 131, 478, 479, 17, 22, 108, - 225, 138, 17, 225, 108, 78, 79, 80, 17, 138, - 78, 79, 80, 108, 78, 79, 80, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 17, 511, 22, - 17, 78, 79, 80, 108, 220, 221, 222, 223, 224, - 257, 226, 227, 470, 229, 230, 225, 564, 236, 237, - 238, 239, 240, 241, 78, 79, 80, 108, 78, 79, - 80, 50, 545, 78, 79, 80, 22, 22, 256, 78, - 79, 80, 376, 108, 14, 155, 16, 14, 14, 16, - 16, 75, 270, 238, 239, 240, 241, 275, 78, 79, - 80, 78, 79, 80, 107, 175, 233, 285, 407, 72, - 14, 181, 16, 26, 184, 185, 186, 187, 188, 189, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 78, 79, 80, 103, 104, 105, 106, 317, - 318, 356, 72, 321, 356, 72, 11, 12, 13, 14, - 22, 16, 107, 322, 44, 45, 46, 47, 15, 24, - 72, 51, 16, 53, 342, 343, 344, 345, 477, 376, - 22, 480, 89, 90, 22, 484, 485, 355, 347, 473, - 358, 359, 357, 509, 216, 217, 70, 356, 78, 79, - 80, 22, 99, 502, 503, 322, 23, 23, 524, 525, - 65, 18, 377, 512, 28, 108, 78, 79, 80, 107, - 536, 78, 79, 80, 392, 99, 26, 107, 527, 15, - 546, 547, 531, 532, 108, 109, 78, 79, 80, 407, - 78, 79, 80, 559, 78, 79, 80, 76, 26, 16, - 549, 110, 417, 108, 109, 110, 421, 78, 79, 80, - 63, 64, 80, 20, 563, 110, 109, 432, 23, 110, - 110, 439, 571, 107, 110, 108, 473, 108, 82, 447, - 78, 79, 80, 107, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 78, 79, 80, 108, 100, 23, 15, - 103, 104, 105, 106, 15, 15, 78, 79, 80, 107, - 478, 479, 489, 63, 491, 15, 0, 15, 107, 78, - 79, 80, 107, 500, 107, 107, 107, 22, 108, 76, - 14, 496, 16, 17, 18, 107, 396, 107, 22, 78, - 79, 80, 510, 511, 107, 95, 63, 64, 107, 526, - 100, 107, 14, 103, 104, 105, 106, 14, 107, 15, - 44, 45, 46, 47, 78, 79, 80, 51, 107, 53, - 100, 22, 56, 103, 104, 105, 106, 545, 95, 63, - 64, 22, 442, 100, 561, 14, 103, 104, 105, 106, - 108, 74, 76, 107, 78, 79, 80, 22, 82, 83, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, 0, 107, 107, 22, 100, 107, 107, 103, - 104, 105, 106, 107, 78, 79, 80, 111, 95, 17, - 18, 108, 22, 100, 22, 107, 103, 104, 105, 106, - 19, 73, 63, 64, 3, 4, 5, 6, 7, 8, - 9, 13, 107, 107, 107, 510, 44, 45, 46, 47, - 106, 343, 419, 51, 564, 53, 277, 371, 56, 90, - 91, 92, 93, 94, 95, 63, 64, 248, 496, 100, - 372, 452, 103, 104, 105, 106, 471, 155, 76, 356, - 78, 79, 80, 225, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, -1, -1, - -1, -1, 100, -1, -1, 103, 104, 105, 106, 107, - 0, 1, -1, 111, -1, -1, -1, -1, -1, -1, - 10, 11, 12, 13, 14, -1, 16, -1, -1, -1, - -1, 21, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, - -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, - 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, 88, 89, 90, 91, 92, 93, 94, - 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 0, 1, -1, -1, -1, 108, 109, - 110, -1, -1, 10, 11, 12, 13, 14, -1, 16, - -1, -1, -1, -1, 21, 22, 23, 24, 25, 26, + 17, 125, 10, 48, 9, 355, 48, 17, 345, 10, + 11, 42, 12, 21, 475, 137, 138, 16, 355, 50, + 13, 358, 359, 13, 10, 11, 12, 262, 15, 153, + 23, 13, 506, 10, 11, 28, 75, 45, 10, 11, + 13, 23, 15, 18, 19, 20, 28, 0, 56, 108, + 25, 26, 18, 19, 20, 15, 13, 11, 15, 25, + 26, 13, 92, 93, 18, 19, 20, 42, 43, 108, + 22, 25, 26, 13, 15, 15, 42, 43, 83, 78, + 79, 80, 48, 58, 70, 72, 108, 41, 42, 43, + 44, 57, 58, 567, 125, 23, 108, 558, 99, 72, + 28, 111, 439, 57, 58, 22, 106, 108, 109, 26, + 155, 17, 72, 155, 145, 13, 109, 110, 92, 13, + 128, 15, 153, 109, 16, 22, 23, 109, 136, 137, + 138, 97, 109, 13, 256, 32, 13, 109, 15, 90, + 37, 478, 479, 13, 41, 15, 100, 44, 156, 16, + 47, 108, 49, 108, 51, 52, 53, 54, 55, 103, + 104, 105, 106, 138, 172, 173, 174, 23, 176, 177, + 178, 13, 138, 15, 511, 90, 91, 131, 16, 108, + 225, 16, 108, 225, 138, 420, 78, 79, 80, 155, + 13, 16, 15, 22, 13, 72, 15, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 16, 22, 545, 16, + 50, 78, 79, 80, 564, 220, 221, 222, 223, 224, + 108, 226, 227, 108, 229, 230, 257, 108, 236, 237, + 238, 239, 240, 241, 108, 470, 22, 70, 75, 205, + 78, 79, 80, 78, 79, 80, 48, 49, 256, 72, + 22, 108, 376, 78, 79, 80, 35, 36, 155, 225, + 16, 107, 270, 78, 79, 80, 99, 275, 78, 79, + 80, 78, 79, 80, 22, 108, 109, 285, 175, 233, + 238, 239, 240, 241, 181, 407, 26, 184, 185, 186, + 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 201, 72, 78, 79, 80, 317, + 318, 356, 107, 321, 356, 10, 11, 12, 13, 72, + 15, 14, 78, 79, 80, 15, 78, 79, 80, 24, + 78, 79, 80, 99, 342, 343, 344, 345, 22, 44, + 45, 46, 47, 216, 217, 376, 51, 355, 53, 473, + 358, 359, 357, 23, 477, 107, 322, 480, 78, 79, + 80, 484, 485, 22, 89, 90, 22, 108, 322, 23, + 65, 28, 377, 78, 79, 80, 22, 17, 26, 502, + 503, 347, 76, 107, 392, 26, 14, 107, 15, 512, + 356, 509, 80, 110, 78, 79, 80, 110, 110, 407, + 110, 110, 107, 19, 527, 108, 524, 525, 531, 532, + 23, 109, 417, 108, 109, 110, 421, 108, 536, 78, + 79, 80, 78, 79, 80, 63, 549, 432, 546, 547, + 82, 439, 78, 79, 80, 78, 79, 80, 107, 447, + 563, 559, 473, 108, 14, 63, 64, 14, 571, 78, + 79, 80, 78, 79, 80, 100, 14, 95, 103, 104, + 105, 106, 100, 23, 107, 103, 104, 105, 106, 14, + 478, 479, 489, 14, 491, 63, 64, 95, 107, 0, + 22, 107, 100, 500, 107, 103, 104, 105, 106, 108, + 107, 496, 13, 107, 15, 16, 17, 107, 107, 396, + 107, 22, 510, 511, 92, 93, 94, 95, 107, 526, + 76, 14, 100, 13, 13, 103, 104, 105, 106, 78, + 79, 80, 107, 44, 45, 46, 47, 78, 79, 80, + 51, 22, 53, 22, 13, 56, 108, 545, 78, 79, + 80, 74, 63, 64, 561, 442, 107, 22, 107, 78, + 79, 80, 107, 22, 107, 76, 107, 78, 79, 80, + 107, 82, 83, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 0, 108, 22, 107, 100, + 107, 18, 103, 104, 105, 106, 107, 73, 107, 107, + 111, 16, 17, 95, 13, 106, 510, 22, 100, 343, + 564, 103, 104, 105, 106, 63, 64, 3, 4, 5, + 6, 7, 8, 9, 419, 277, 248, 371, 452, 44, + 45, 46, 47, 372, 496, 155, 51, 471, 53, 356, + 225, 56, 90, 91, 92, 93, 94, 95, 63, 64, + -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, + -1, 76, -1, 78, 79, 80, -1, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, + 105, 106, 107, 0, 1, -1, 111, -1, -1, -1, + -1, -1, -1, 10, 11, 12, 13, -1, 15, -1, + -1, -1, -1, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, 89, 90, 91, + 67, 68, 69, 70, 71, 87, 88, 89, 90, 91, 92, 93, 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, - -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, - 15, 16, -1, -1, -1, -1, 21, 22, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, - 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, - 100, -1, -1, 103, 104, 105, 106, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, - -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, - 13, 14, 15, 16, -1, -1, -1, -1, 21, 22, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, - 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, 94, 95, 81, -1, - -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, - 11, 12, 13, 14, 15, 16, -1, -1, -1, -1, - 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, - 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, 44, 45, 46, 47, -1, -1, - -1, 51, -1, 53, -1, 96, 97, -1, 99, -1, - 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, 14, 15, 16, 78, 79, - 80, -1, 21, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, -1, - -1, -1, 51, 52, 53, 54, 55, -1, 57, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, - 109, 110, -1, 10, 11, 12, 13, 14, 15, 16, - -1, -1, -1, -1, 21, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, -1, -1, -1, 51, 52, 53, 54, 55, -1, - 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 1, -1, -1, -1, - -1, 108, 109, 110, -1, 10, 11, 12, 13, 14, - -1, 16, -1, -1, -1, -1, 21, 22, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, -1, -1, -1, 51, 52, 53, 54, - 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, 74, - -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, + 97, -1, 99, -1, 101, 102, 0, 1, -1, -1, + -1, 108, 109, 110, -1, -1, 10, 11, 12, 13, + -1, 15, -1, -1, -1, -1, 20, 21, 22, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, + 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, 88, + 89, 90, 91, 92, 93, 94, 95, 81, -1, -1, + -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, + -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, + 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, 89, 90, 91, 92, 93, 94, 95, 81, + -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, + 10, 11, 12, 13, 14, 15, -1, -1, -1, -1, + 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, + -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, + 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, + 70, 71, -1, -1, -1, -1, -1, -1, -1, 94, + 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, + 105, 106, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, + 110, -1, 10, 11, 12, 13, 14, 15, -1, -1, + -1, -1, 20, 21, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 81, -1, -1, 44, 45, 46, 47, + -1, -1, -1, 51, -1, 53, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, + 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, + 78, 79, 80, -1, 20, 21, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, + -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 1, -1, - -1, -1, -1, 108, 109, 110, -1, 10, 11, 12, - 13, 14, -1, 16, -1, -1, -1, -1, 21, 22, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, - 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, + -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, + 14, 15, -1, -1, -1, -1, 20, 21, 22, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, + 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - 1, -1, -1, -1, -1, 108, 109, 110, -1, 10, - 11, 12, 13, 14, -1, 16, -1, -1, -1, -1, - 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, 35, -1, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, - 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 1, -1, -1, -1, -1, 108, 109, 110, - -1, 10, 11, 12, 13, -1, -1, 16, -1, -1, - -1, -1, 21, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, - -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 1, -1, -1, -1, -1, 108, - 109, 110, -1, 10, 11, 12, 13, -1, -1, 16, - -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, - -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, - -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, 12, 13, 14, -1, - 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, - 26, 27, 28, 29, 30, 31, 32, 33, 34, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, + -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, + 12, 13, -1, 15, -1, -1, -1, -1, 20, 21, + 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, + 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, 74, -1, -1, -1, -1, -1, -1, 81, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, + 10, 11, 12, 13, -1, 15, -1, -1, -1, -1, + 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, + 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, + -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, + 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, + 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, + -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, + 110, -1, 10, 11, 12, 13, -1, 15, -1, -1, + -1, -1, 20, 21, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, 35, -1, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, + 108, 109, 110, -1, 10, 11, 12, -1, -1, 15, + -1, -1, -1, -1, 20, 21, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, -1, 108, 109, 110, 10, 11, 12, 13, -1, - -1, 16, 17, -1, -1, -1, 21, -1, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, - 14, -1, 16, -1, -1, -1, -1, 21, -1, 23, + 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, + -1, -1, 108, 109, 110, -1, 10, 11, 12, -1, + -1, 15, -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -905,9 +876,9 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, -1, 108, 109, 110, 10, 11, 12, - 13, -1, -1, 16, -1, -1, -1, -1, 21, 22, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, + 13, -1, 15, -1, -1, -1, -1, 20, 21, -1, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, @@ -916,7 +887,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, - 12, 13, -1, -1, 16, -1, -1, -1, -1, 21, + 12, -1, -1, 15, 16, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -925,8 +896,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, 13, -1, -1, 16, -1, -1, -1, -1, + 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, + 11, 12, 13, -1, 15, -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -935,9 +906,9 @@ static const yytype_int16 yycheck[] = 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, 12, 13, -1, -1, 16, -1, -1, -1, - -1, 21, -1, 23, 24, 25, 26, 27, -1, 29, + 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, + 10, 11, 12, -1, -1, 15, -1, -1, -1, -1, + 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, @@ -945,9 +916,9 @@ static const yytype_int16 yycheck[] = 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, - 110, 10, 11, 12, 13, -1, -1, 16, -1, -1, - -1, -1, 21, -1, 23, 24, 25, 26, 27, -1, + -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, + 110, 10, 11, 12, -1, -1, 15, -1, -1, -1, + -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, @@ -956,8 +927,8 @@ static const yytype_int16 yycheck[] = -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, 13, -1, -1, 16, -1, - -1, -1, -1, 21, -1, 23, 24, 25, 26, 27, + 109, 110, 10, 11, 12, -1, -1, 15, -1, -1, + -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, @@ -966,8 +937,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, - 108, 109, 110, 10, 11, 12, 13, -1, -1, 16, - -1, -1, -1, -1, 21, -1, 23, 24, 25, 26, + 108, 109, 110, 10, 11, 12, -1, -1, 15, -1, + -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, @@ -976,8 +947,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, 12, 13, -1, -1, - 16, -1, -1, -1, -1, 21, -1, 23, 24, 25, + 107, 108, 109, 110, 10, 11, 12, -1, -1, 15, + -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, @@ -986,8 +957,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, 13, -1, - -1, 16, -1, -1, -1, -1, 21, -1, 23, 24, + -1, 107, 108, 109, 110, 10, 11, 12, -1, -1, + 15, -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -996,33 +967,63 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, -1, 108, 109, 110, 10, 11, 12, 13, - -1, -1, 16, -1, -1, -1, -1, 21, -1, 23, + -1, -1, 107, 108, 109, 110, 10, 11, 12, -1, + -1, 15, -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, - -1, 56, -1, -1, -1, -1, -1, -1, 63, 64, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, -1, 108, 109, 110, 82, 83, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, - 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, + -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, + -1, -1, 15, -1, -1, -1, -1, 20, 21, -1, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 82, 83, -1, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, - 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, + 12, -1, -1, 15, -1, -1, -1, -1, 20, 21, + -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, + 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, - 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, + -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, + 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, + 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, + 11, 12, -1, -1, 15, -1, -1, -1, -1, 20, + 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, + 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, 56, -1, -1, -1, -1, -1, + -1, 63, 64, -1, -1, 96, 97, -1, 99, -1, + 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, + 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, -1, -1, -1, -1, 100, 56, + -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 82, 83, -1, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, + -1, -1, -1, 100, 56, -1, 103, 104, 105, 106, + -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, - 100, -1, -1, 103, 104, 105, 106 + -1, 83, -1, 85, 86, 87, 88, 89, 90, 91, + 92, 93, 94, 95, -1, -1, -1, -1, 100, 56, + -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, + -1, -1, -1, 100, -1, -1, 103, 104, 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1031,61 +1032,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 13, 16, 21, 23, 24, 25, 26, 27, 29, + 12, 15, 20, 21, 23, 24, 25, 26, 27, 29, 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 14, 121, 1, 22, 35, 37, 38, + 205, 206, 207, 13, 121, 1, 22, 35, 37, 38, 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, - 126, 168, 169, 126, 188, 23, 28, 121, 200, 208, - 208, 208, 17, 174, 188, 208, 208, 189, 16, 108, + 126, 168, 169, 126, 23, 28, 121, 200, 208, 208, + 208, 16, 174, 188, 188, 208, 208, 189, 15, 108, 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, 188, 23, 175, 192, 200, 208, 208, 121, 188, 22, 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 78, 79, 80, 18, 14, 16, 108, 92, + 208, 208, 78, 79, 80, 17, 13, 15, 108, 92, 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 14, 16, 14, - 16, 14, 16, 14, 123, 153, 154, 154, 23, 151, + 95, 100, 103, 104, 105, 106, 108, 13, 15, 13, + 15, 13, 15, 13, 123, 153, 154, 154, 23, 151, 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, 108, 121, 22, 50, 143, 22, 44, 45, 46, 47, - 51, 53, 129, 130, 128, 11, 12, 109, 159, 160, - 162, 163, 164, 165, 17, 192, 108, 75, 174, 107, + 51, 53, 129, 130, 128, 10, 11, 109, 159, 160, + 162, 163, 164, 165, 16, 192, 108, 75, 174, 107, 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, - 208, 175, 15, 22, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 72, 157, 16, 107, 174, 174, 174, + 208, 175, 14, 22, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 72, 157, 15, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 11, 12, 13, 14, 16, 24, + 188, 188, 188, 188, 10, 11, 12, 13, 15, 24, 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, - 158, 158, 18, 193, 175, 17, 177, 156, 26, 123, - 173, 107, 76, 107, 174, 15, 107, 174, 157, 107, - 26, 174, 16, 22, 17, 107, 84, 110, 110, 110, + 158, 158, 17, 193, 175, 16, 177, 156, 26, 123, + 173, 107, 76, 107, 174, 14, 107, 174, 157, 107, + 26, 174, 15, 22, 16, 107, 84, 110, 110, 110, 174, 174, 110, 107, 174, 110, 110, 108, 107, 22, - 17, 22, 17, 22, 17, 22, 15, 20, 122, 131, - 132, 14, 22, 23, 146, 174, 147, 148, 174, 148, + 16, 22, 16, 22, 16, 22, 14, 19, 122, 131, + 132, 13, 22, 23, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 17, 174, 15, - 188, 22, 17, 107, 193, 15, 15, 15, 15, 123, + 123, 171, 108, 166, 167, 107, 107, 16, 174, 14, + 188, 22, 16, 107, 193, 14, 14, 14, 14, 123, 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, - 107, 22, 136, 148, 107, 107, 188, 174, 76, 14, - 168, 14, 17, 15, 107, 22, 156, 22, 172, 173, - 137, 192, 144, 144, 14, 124, 124, 148, 148, 124, + 107, 22, 136, 148, 107, 107, 188, 174, 76, 13, + 168, 13, 16, 14, 107, 22, 156, 22, 172, 173, + 137, 192, 144, 144, 13, 124, 124, 148, 148, 124, 134, 108, 107, 124, 124, 126, 107, 126, 74, 22, 170, 171, 126, 22, 124, 124, 125, 48, 49, 142, - 142, 107, 107, 143, 146, 148, 124, 15, 15, 127, - 15, 143, 143, 126, 124, 108, 124, 124, 22, 107, - 143, 22, 26, 138, 15, 148, 143, 143, 135, 124, - 19, 73, 139, 107, 144, 143, 126, 124, 149, 74, + 142, 107, 107, 143, 146, 148, 124, 14, 14, 127, + 14, 143, 143, 126, 124, 108, 124, 124, 22, 107, + 143, 22, 26, 138, 14, 148, 143, 143, 135, 124, + 18, 73, 139, 107, 144, 143, 126, 124, 149, 74, 142, 107, 124 }; @@ -1168,41 +1169,42 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * f8e48ae0c2a747213bac2f61eaabae56b419a76c401dcd20b128fda84f4786a6 perly.y + * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 2a32ef1d6b51..c5e79c8d4f35 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,7 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '+' '@' '%' +%token '@' '%' %token PERLY_AMPERSAND %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE @@ -55,6 +55,7 @@ %token PERLY_DOT %token PERLY_EQUAL_SIGN %token PERLY_MINUS +%token PERLY_PLUS %token PERLY_SEMICOLON %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST @@ -1098,7 +1099,7 @@ eqopchain: term[lhs] CHEQOP term[rhs] /* Unary operators and terms */ termunop : PERLY_MINUS term %prec UMINUS /* -$x */ { $$ = newUNOP(OP_NEGATE, 0, scalar($term)); } - | '+' term %prec UMINUS /* +$x */ + | PERLY_PLUS term %prec UMINUS /* +$x */ { $$ = $term; } | PERLY_EXCLAMATION_MARK term /* !$x */ diff --git a/toke.c b/toke.c index 65ed54058b86..594672de8178 100644 --- a/toke.c +++ b/toke.c @@ -397,6 +397,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), DEBUG_TOKEN (IVAL, PERLY_MINUS), + DEBUG_TOKEN (IVAL, PERLY_PLUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), DEBUG_TOKEN (IVAL, PERLY_TILDE), @@ -5680,7 +5681,7 @@ yyl_plus(pTHX_ char *s) else { if (isSPACE(*s) || !isSPACE(*PL_bufptr)) check_uni(); - OPERATOR('+'); + OPERATOR(PERLY_PLUS); } } From 9086c946d76e67c28eff104482c6bc204f32ff68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:14 +0100 Subject: [PATCH 339/503] Distinguish C- and perly- literals - PERLY_SNAIL --- perly.act | 536 ++++++++++++------------ perly.h | 171 ++++---- perly.tab | 1205 +++++++++++++++++++++++++---------------------------- perly.y | 13 +- toke.c | 22 +- 5 files changed, 954 insertions(+), 993 deletions(-) diff --git a/perly.act b/perly.act index 756f04295f15..3fede6368226 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 133 "perly.y" +#line 134 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 138 "perly.y" +#line 139 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 144 "perly.y" +#line 145 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 149 "perly.y" +#line 150 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 154 "perly.y" +#line 155 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 159 "perly.y" +#line 160 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 167 "perly.y" +#line 168 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 172 "perly.y" +#line 173 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 180 "perly.y" +#line 181 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 185 "perly.y" +#line 186 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 193 "perly.y" +#line 194 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 198 "perly.y" +#line 199 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 203 "perly.y" +#line 204 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 208 "perly.y" +#line 209 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 216 "perly.y" +#line 217 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 224 "perly.y" +#line 225 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 231 "perly.y" +#line 232 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 236 "perly.y" +#line 237 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 243 "perly.y" +#line 244 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 249 "perly.y" +#line 250 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 251 "perly.y" +#line 252 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 260 "perly.y" +#line 261 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 262 "perly.y" +#line 263 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 271 "perly.y" +#line 272 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 275 "perly.y" +#line 276 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 279 "perly.y" +#line 280 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 286 "perly.y" +#line 287 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 296 "perly.y" +#line 297 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 298 "perly.y" +#line 299 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 310 "perly.y" +#line 311 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 316 "perly.y" +#line 317 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 331 "perly.y" +#line 332 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 337 "perly.y" +#line 338 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 348 "perly.y" +#line 349 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 355 "perly.y" +#line 356 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 357 "perly.y" +#line 358 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 364 "perly.y" +#line 365 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 370 "perly.y" +#line 371 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 376 "perly.y" +#line 377 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 381 "perly.y" +#line 382 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 383 "perly.y" +#line 384 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 385 "perly.y" +#line 386 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 392 "perly.y" +#line 393 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 399 "perly.y" +#line 400 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 401 "perly.y" +#line 402 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 404 "perly.y" +#line 405 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 419 "perly.y" +#line 420 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 424 "perly.y" +#line 425 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 430 "perly.y" +#line 431 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 432 "perly.y" +#line 433 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 445 "perly.y" +#line 446 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 453 "perly.y" +#line 454 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 459 "perly.y" +#line 460 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 465 "perly.y" +#line 466 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 472 "perly.y" +#line 473 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 480 "perly.y" +#line 481 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 484 "perly.y" +#line 485 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 489 "perly.y" +#line 490 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 497 "perly.y" +#line 498 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 514 "perly.y" +#line 515 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 516 "perly.y" +#line 517 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 524 "perly.y" +#line 525 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 536 "perly.y" +#line 537 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 539 "perly.y" +#line 540 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 544 "perly.y" +#line 545 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 546 "perly.y" +#line 547 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 551 "perly.y" +#line 552 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 561 "perly.y" +#line 562 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 563 "perly.y" +#line 564 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 568 "perly.y" +#line 569 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 574 "perly.y" +#line 575 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 580 "perly.y" +#line 581 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 588 "perly.y" +#line 589 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 593 "perly.y" +#line 594 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 597 "perly.y" +#line 598 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 601 "perly.y" +#line 602 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 605 "perly.y" +#line 606 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 611 "perly.y" +#line 612 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 616 "perly.y" +#line 617 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 627 "perly.y" +#line 628 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 633 "perly.y" +#line 634 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 635 "perly.y" +#line 636 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 637 "perly.y" +#line 638 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 642 "perly.y" +#line 643 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 644 "perly.y" +#line 645 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 655 "perly.y" +#line 656 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 657 "perly.y" +#line 658 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 662 "perly.y" +#line 663 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 664 "perly.y" +#line 665 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 668 "perly.y" +#line 669 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 687 "perly.y" +#line 688 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 689 "perly.y" +#line 690 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 691 "perly.y" +#line 692 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 697 "perly.y" +#line 698 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 762 "perly.y" +#line 763 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 764 "perly.y" +#line 765 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 770 "perly.y" +#line 771 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 772 "perly.y" +#line 773 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 776 "perly.y" +#line 777 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 781 "perly.y" +#line 782 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 783 "perly.y" +#line 784 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 787 "perly.y" +#line 788 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 789 "perly.y" +#line 790 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 793 "perly.y" +#line 794 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 796 "perly.y" +#line 797 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 807 "perly.y" +#line 808 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 864 "perly.y" +#line 865 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 865 "perly.y" +#line 866 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 871 "perly.y" +#line 872 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 881 "perly.y" +#line 882 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 882 "perly.y" +#line 883 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 886 "perly.y" +#line 887 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 897 "perly.y" +#line 898 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 899 "perly.y" +#line 900 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 901 "perly.y" +#line 902 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 907 "perly.y" +#line 908 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 909 "perly.y" +#line 910 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 918 "perly.y" +#line 919 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 922 "perly.y" +#line 923 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 926 "perly.y" +#line 927 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 932 "perly.y" +#line 933 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 937 "perly.y" +#line 938 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 943 "perly.y" +#line 944 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 949 "perly.y" +#line 950 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 951 "perly.y" +#line 952 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 953 "perly.y" +#line 954 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 955 "perly.y" +#line 956 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 958 "perly.y" +#line 959 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 973 "perly.y" +#line 974 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 975 "perly.y" +#line 976 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 978 "perly.y" +#line 979 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 983 "perly.y" +#line 984 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 988 "perly.y" +#line 989 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 991 "perly.y" +#line 992 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 995 "perly.y" +#line 996 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 999 "perly.y" +#line 1000 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1005 "perly.y" +#line 1006 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1013 "perly.y" +#line 1014 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1020 "perly.y" +#line 1021 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1026 "perly.y" +#line 1027 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1028 "perly.y" +#line 1029 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1030 "perly.y" +#line 1031 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1035 "perly.y" +#line 1036 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1037 "perly.y" +#line 1038 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1039 "perly.y" +#line 1040 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1044 "perly.y" +#line 1045 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1062 "perly.y" +#line 1063 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1064 "perly.y" +#line 1065 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1068 "perly.y" +#line 1069 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1070 "perly.y" +#line 1071 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1072 "perly.y" +#line 1073 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1074 "perly.y" +#line 1075 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1078 "perly.y" +#line 1079 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1080 "perly.y" +#line 1081 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1084 "perly.y" +#line 1085 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1086 "perly.y" +#line 1087 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1088 "perly.y" +#line 1089 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1090 "perly.y" +#line 1091 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1094 "perly.y" +#line 1095 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1096 "perly.y" +#line 1097 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1101 "perly.y" +#line 1102 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1108 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1110 "perly.y" +#line 1111 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1113 "perly.y" +#line 1114 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1116 "perly.y" +#line 1117 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1127 "perly.y" +#line 1128 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1130 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1137 "perly.y" +#line 1138 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1139 "perly.y" +#line 1140 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1141 "perly.y" +#line 1142 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1143 "perly.y" +#line 1144 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1145 "perly.y" +#line 1146 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1148 "perly.y" +#line 1149 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1154 "perly.y" +#line 1155 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1156 "perly.y" +#line 1157 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1164 "perly.y" +#line 1165 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1186 "perly.y" +#line 1187 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1188 "perly.y" +#line 1189 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1190 "perly.y" +#line 1191 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1192 "perly.y" +#line 1193 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1202 "perly.y" +#line 1203 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1212 "perly.y" +#line 1213 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1222 "perly.y" +#line 1223 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1232 "perly.y" +#line 1233 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1234 "perly.y" +#line 1235 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1236 "perly.y" +#line 1237 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1239 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1244 "perly.y" +#line 1245 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1248 "perly.y" +#line 1249 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1287 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1289 "perly.y" +#line 1290 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1291 "perly.y" +#line 1292 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1295 "perly.y" +#line 1296 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1297 "perly.y" +#line 1298 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1308 "perly.y" +#line 1309 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1316 "perly.y" +#line 1317 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1318 "perly.y" +#line 1319 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1320 "perly.y" +#line 1321 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1325 "perly.y" +#line 1326 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1327 "perly.y" +#line 1328 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1332 "perly.y" +#line 1333 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1334 "perly.y" +#line 1335 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1339 "perly.y" +#line 1340 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1341 "perly.y" +#line 1342 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1345 "perly.y" +#line 1346 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1347 "perly.y" +#line 1348 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1351 "perly.y" +#line 1352 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1353 "perly.y" +#line 1354 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1359 "perly.y" +#line 1360 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1376 "perly.y" +#line 1377 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1380 "perly.y" +#line 1381 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1384 "perly.y" +#line 1385 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1390 "perly.y" +#line 1391 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1396 "perly.y" +#line 1397 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1398 "perly.y" +#line 1399 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1402 "perly.y" +#line 1403 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1407 "perly.y" +#line 1408 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1412 "perly.y" +#line 1413 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1417 "perly.y" +#line 1418 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1422 "perly.y" +#line 1423 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1424 "perly.y" +#line 1425 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1426 "perly.y" +#line 1427 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1429 "perly.y" +#line 1430 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y + * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index ac50b3ad3b7c..902e40655c91 100644 --- a/perly.h +++ b/perly.h @@ -74,90 +74,91 @@ extern int yydebug; PERLY_MINUS = 273, PERLY_PLUS = 274, PERLY_SEMICOLON = 275, - BAREWORD = 276, - METHOD = 277, - FUNCMETH = 278, - THING = 279, - PMFUNC = 280, - PRIVATEREF = 281, - QWLIST = 282, - FUNC0OP = 283, - FUNC0SUB = 284, - UNIOPSUB = 285, - LSTOPSUB = 286, - PLUGEXPR = 287, - PLUGSTMT = 288, - LABEL = 289, - FORMAT = 290, - SUB = 291, - SIGSUB = 292, - ANONSUB = 293, - ANON_SIGSUB = 294, - PACKAGE = 295, - USE = 296, - WHILE = 297, - UNTIL = 298, - IF = 299, - UNLESS = 300, - ELSE = 301, - ELSIF = 302, - CONTINUE = 303, - FOR = 304, - GIVEN = 305, - WHEN = 306, - DEFAULT = 307, - LOOPEX = 308, - DOTDOT = 309, - YADAYADA = 310, - FUNC0 = 311, - FUNC1 = 312, - FUNC = 313, - UNIOP = 314, - LSTOP = 315, - MULOP = 316, - ADDOP = 317, - DOLSHARP = 318, - DO = 319, - HASHBRACK = 320, - NOAMP = 321, - LOCAL = 322, - MY = 323, - REQUIRE = 324, - COLONATTR = 325, - FORMLBRACK = 326, - FORMRBRACK = 327, - SUBLEXSTART = 328, - SUBLEXEND = 329, - PREC_LOW = 330, - OROP = 331, - DOROP = 332, - ANDOP = 333, - NOTOP = 334, - ASSIGNOP = 335, - PERLY_QUESTION_MARK = 336, - PERLY_COLON = 337, - OROR = 338, - DORDOR = 339, - ANDAND = 340, - BITOROP = 341, - BITANDOP = 342, - CHEQOP = 343, - NCEQOP = 344, - CHRELOP = 345, - NCRELOP = 346, - SHIFTOP = 347, - MATCHOP = 348, - PERLY_EXCLAMATION_MARK = 349, - PERLY_TILDE = 350, - UMINUS = 351, - REFGEN = 352, - POWOP = 353, - PREINC = 354, - PREDEC = 355, - POSTINC = 356, - POSTDEC = 357, - POSTJOIN = 358, - ARROW = 359 + PERLY_SNAIL = 276, + BAREWORD = 277, + METHOD = 278, + FUNCMETH = 279, + THING = 280, + PMFUNC = 281, + PRIVATEREF = 282, + QWLIST = 283, + FUNC0OP = 284, + FUNC0SUB = 285, + UNIOPSUB = 286, + LSTOPSUB = 287, + PLUGEXPR = 288, + PLUGSTMT = 289, + LABEL = 290, + FORMAT = 291, + SUB = 292, + SIGSUB = 293, + ANONSUB = 294, + ANON_SIGSUB = 295, + PACKAGE = 296, + USE = 297, + WHILE = 298, + UNTIL = 299, + IF = 300, + UNLESS = 301, + ELSE = 302, + ELSIF = 303, + CONTINUE = 304, + FOR = 305, + GIVEN = 306, + WHEN = 307, + DEFAULT = 308, + LOOPEX = 309, + DOTDOT = 310, + YADAYADA = 311, + FUNC0 = 312, + FUNC1 = 313, + FUNC = 314, + UNIOP = 315, + LSTOP = 316, + MULOP = 317, + ADDOP = 318, + DOLSHARP = 319, + DO = 320, + HASHBRACK = 321, + NOAMP = 322, + LOCAL = 323, + MY = 324, + REQUIRE = 325, + COLONATTR = 326, + FORMLBRACK = 327, + FORMRBRACK = 328, + SUBLEXSTART = 329, + SUBLEXEND = 330, + PREC_LOW = 331, + OROP = 332, + DOROP = 333, + ANDOP = 334, + NOTOP = 335, + ASSIGNOP = 336, + PERLY_QUESTION_MARK = 337, + PERLY_COLON = 338, + OROR = 339, + DORDOR = 340, + ANDAND = 341, + BITOROP = 342, + BITANDOP = 343, + CHEQOP = 344, + NCEQOP = 345, + CHRELOP = 346, + NCRELOP = 347, + SHIFTOP = 348, + MATCHOP = 349, + PERLY_EXCLAMATION_MARK = 350, + PERLY_TILDE = 351, + UMINUS = 352, + REFGEN = 353, + POWOP = 354, + PREINC = 355, + PREDEC = 356, + POSTINC = 357, + POSTDEC = 358, + POSTJOIN = 359, + ARROW = 360 }; #endif @@ -209,6 +210,6 @@ int yyparse (void); /* Generated from: - * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y + * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 03143718dc23..e0fa362f6792 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3389 +#define YYLAST 3149 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 359 +#define YYMAXUTOK 360 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,10 +33,10 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 109, 11, 2, 2, + 2, 2, 2, 2, 2, 2, 109, 10, 2, 2, 108, 107, 110, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 10, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,52 +56,53 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 12, 13, 14, 15, 16, - 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, - 57, 58, 59, 60, 61, 62, 63, 64, 65, 66, - 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, - 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, - 97, 98, 99, 100, 101, 102, 103, 104, 105, 106 + 5, 6, 7, 8, 9, 11, 12, 13, 14, 15, + 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, + 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, + 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, + 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, + 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, + 106 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 133, 133, 132, 144, 143, 154, 153, 167, 166, - 180, 179, 193, 192, 203, 202, 215, 223, 231, 235, - 243, 249, 250, 260, 261, 270, 274, 278, 285, 295, - 297, 310, 307, 331, 326, 347, 355, 354, 363, 369, - 375, 380, 382, 384, 391, 399, 401, 398, 418, 423, - 430, 429, 444, 452, 458, 465, 464, 479, 483, 488, - 496, 514, 515, 519, 523, 525, 527, 529, 531, 533, - 535, 538, 544, 545, 550, 561, 562, 568, 574, 575, - 580, 583, 587, 592, 596, 600, 601, 605, 611, 616, - 621, 622, 627, 628, 633, 634, 636, 641, 643, 655, - 656, 661, 663, 667, 687, 688, 690, 696, 761, 763, - 769, 771, 775, 781, 782, 787, 788, 792, 796, 796, - 864, 865, 870, 881, 882, 885, 896, 898, 900, 902, - 906, 908, 913, 917, 921, 925, 931, 936, 942, 948, - 950, 952, 955, 954, 965, 966, 970, 974, 977, 982, - 987, 990, 994, 998, 1004, 1012, 1019, 1025, 1027, 1029, - 1034, 1036, 1038, 1043, 1045, 1047, 1049, 1051, 1053, 1055, - 1057, 1059, 1061, 1063, 1067, 1069, 1071, 1073, 1077, 1079, - 1083, 1085, 1087, 1089, 1093, 1095, 1100, 1102, 1105, 1107, - 1109, 1112, 1115, 1126, 1129, 1136, 1138, 1140, 1142, 1144, - 1147, 1153, 1155, 1159, 1160, 1161, 1162, 1163, 1165, 1167, - 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, - 1189, 1191, 1201, 1211, 1221, 1231, 1233, 1235, 1238, 1243, - 1247, 1249, 1251, 1253, 1256, 1258, 1261, 1263, 1265, 1267, - 1269, 1271, 1273, 1275, 1277, 1280, 1282, 1284, 1286, 1288, - 1290, 1294, 1297, 1296, 1309, 1310, 1311, 1315, 1317, 1319, - 1324, 1326, 1329, 1331, 1333, 1338, 1340, 1345, 1346, 1351, - 1352, 1358, 1362, 1363, 1364, 1367, 1368, 1371, 1372, 1375, - 1379, 1383, 1389, 1395, 1397, 1401, 1405, 1406, 1410, 1411, - 1415, 1416, 1421, 1423, 1425, 1428 + 0, 134, 134, 133, 145, 144, 155, 154, 168, 167, + 181, 180, 194, 193, 204, 203, 216, 224, 232, 236, + 244, 250, 251, 261, 262, 271, 275, 279, 286, 296, + 298, 311, 308, 332, 327, 348, 356, 355, 364, 370, + 376, 381, 383, 385, 392, 400, 402, 399, 419, 424, + 431, 430, 445, 453, 459, 466, 465, 480, 484, 489, + 497, 515, 516, 520, 524, 526, 528, 530, 532, 534, + 536, 539, 545, 546, 551, 562, 563, 569, 575, 576, + 581, 584, 588, 593, 597, 601, 602, 606, 612, 617, + 622, 623, 628, 629, 634, 635, 637, 642, 644, 656, + 657, 662, 664, 668, 688, 689, 691, 697, 762, 764, + 770, 772, 776, 782, 783, 788, 789, 793, 797, 797, + 865, 866, 871, 882, 883, 886, 897, 899, 901, 903, + 907, 909, 914, 918, 922, 926, 932, 937, 943, 949, + 951, 953, 956, 955, 966, 967, 971, 975, 978, 983, + 988, 991, 995, 999, 1005, 1013, 1020, 1026, 1028, 1030, + 1035, 1037, 1039, 1044, 1046, 1048, 1050, 1052, 1054, 1056, + 1058, 1060, 1062, 1064, 1068, 1070, 1072, 1074, 1078, 1080, + 1084, 1086, 1088, 1090, 1094, 1096, 1101, 1103, 1106, 1108, + 1110, 1113, 1116, 1127, 1130, 1137, 1139, 1141, 1143, 1145, + 1148, 1154, 1156, 1160, 1161, 1162, 1163, 1164, 1166, 1168, + 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, 1188, + 1190, 1192, 1202, 1212, 1222, 1232, 1234, 1236, 1239, 1244, + 1248, 1250, 1252, 1254, 1257, 1259, 1262, 1264, 1266, 1268, + 1270, 1272, 1274, 1276, 1278, 1281, 1283, 1285, 1287, 1289, + 1291, 1295, 1298, 1297, 1310, 1311, 1312, 1316, 1318, 1320, + 1325, 1327, 1330, 1332, 1334, 1339, 1341, 1346, 1347, 1352, + 1353, 1359, 1363, 1364, 1365, 1368, 1369, 1372, 1373, 1376, + 1380, 1384, 1390, 1396, 1398, 1402, 1406, 1407, 1411, 1412, + 1416, 1417, 1422, 1424, 1426, 1429 }; #endif @@ -111,19 +112,19 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'@'", - "'%'", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'%'", + "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PLUS", "PERLY_SEMICOLON", - "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", - "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", - "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", - "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", - "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", - "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", - "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", - "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", + "PERLY_SNAIL", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", + "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", + "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", + "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", + "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", + "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", + "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", + "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", + "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", @@ -154,16 +155,16 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 64, 37, 265, 266, 267, 268, 269, 270, 271, 272, - 273, 274, 275, 276, 277, 278, 279, 280, 281, 282, - 283, 284, 285, 286, 287, 288, 289, 290, 291, 292, - 293, 294, 295, 296, 297, 298, 299, 300, 301, 302, - 303, 304, 305, 306, 307, 308, 309, 310, 311, 312, - 313, 314, 315, 316, 317, 318, 319, 320, 321, 322, - 323, 324, 325, 326, 327, 328, 329, 330, 331, 332, - 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, - 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, - 353, 354, 355, 356, 357, 358, 359, 41, 40, 36, + 37, 265, 266, 267, 268, 269, 270, 271, 272, 273, + 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, + 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, + 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, + 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, + 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, + 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, + 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, + 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, + 354, 355, 356, 357, 358, 359, 360, 41, 40, 36, 42, 47 }; # endif @@ -182,64 +183,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 604, -475, -475, -475, -475, -475, -475, -475, 47, -475, - 3018, 10, 1602, 1500, -475, -475, -475, -475, 18, 18, - 18, 2008, 3018, 3018, -475, 18, 18, -475, -475, 59, - -59, -475, 3018, -475, -475, -475, -475, 3018, -22, -12, - -39, 2109, 1907, 18, 2109, 2210, 72, 3018, -1, 3018, - 3018, 3018, 3018, 3018, 3018, 3018, 2311, 18, 18, 460, - 94, -475, 43, -475, -30, 26, 85, 49, -475, -475, - -475, 3193, -475, -475, 45, 60, 106, 130, -475, 102, - 158, 181, 120, -475, -475, -475, -475, -475, -475, 72, - 72, 144, -475, 71, 74, 112, 115, 167, 119, 126, - 10, 171, 160, -475, 214, 1132, 1500, -475, -475, -475, - 683, -475, 23, 786, -475, -475, -475, -475, -475, -475, - -475, -475, 1, 355, 355, 3018, 143, 163, 3018, 154, - 975, 10, 260, 233, 3193, 205, 2412, 3018, 1907, -475, - 975, 575, 94, -475, 479, 3018, -475, -475, 975, 307, - 185, -475, -475, 3018, 975, 3119, 2513, 247, -475, -475, - -475, 975, 94, 355, 355, 355, 56, 56, 310, 248, - -475, -475, 3018, 3018, 3018, 3018, 3018, 3018, 2614, -475, - -475, 3018, -475, -475, 3018, 3018, 3018, 3018, 3018, 3018, - 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, 3018, - 3018, 3018, -475, -475, -475, 305, 2715, 3018, 3018, 3018, - 3018, 3018, 3018, 3018, -475, 330, -475, -475, 346, -475, - -475, -475, -475, -475, 234, 14, -475, -475, 259, -475, - -475, -475, -475, 10, -475, -475, 3018, 3018, 3018, 3018, - 3018, 3018, -475, -475, -475, -475, -475, 343, 343, -475, - -475, -475, 360, -475, -475, -475, 3018, 3018, 108, -475, - -475, -475, 233, 352, -475, -475, -475, 280, 306, 276, - 3018, 94, -475, 372, -475, 2816, 355, 247, 27, 123, - 177, -475, 357, 359, -475, 3018, 373, 312, 312, -475, - 3193, 228, 133, -475, 371, 975, 412, 3283, 498, 362, - 3193, 3148, 668, 668, 771, 873, 542, 412, 412, 975, - 975, 382, 355, 355, 283, 287, 288, 3018, 3018, -475, - 290, 2917, 7, 291, 297, -475, -475, 374, 252, 162, - 316, 165, 341, 175, 344, 888, -475, 384, -475, -475, - 48, 387, 3018, 3018, 3018, 3018, -475, 302, -475, -475, - 309, -475, -475, -475, -475, 1704, 28, -475, 3018, 3018, - -475, -475, 460, -475, 460, -475, -475, -475, -475, -475, - 348, 348, 23, 331, -10, -475, 3018, -475, -475, 335, - -475, -475, -475, -475, 441, -475, 13, 449, -475, -475, - -475, 190, 3018, 430, -475, -475, 3018, -475, -475, -475, - 354, 193, -475, -475, 471, -475, -475, 3018, -475, 433, - -475, 442, -475, 455, -475, 459, -475, -475, -475, 260, - 233, -475, -475, 440, 377, 460, 383, 386, 460, 390, - 381, -475, -475, -475, -475, 391, 458, 295, -475, 3018, - 393, 401, 3018, -475, -475, -475, -475, 3018, 434, -475, - 500, -475, -475, 501, -475, -475, 40, -475, 244, -475, - 3238, 497, -475, -475, 415, -475, -475, -475, -475, 509, - 233, 511, -475, 3018, -475, -475, 521, 521, 3018, 3018, - 521, -475, 428, 439, 521, 521, 3193, 460, -475, -475, - 445, -475, -475, -475, -475, 467, 525, -475, -475, -475, - -475, 531, 521, 521, -475, 198, 198, 447, 453, 160, - 3018, 3018, 521, -475, -475, 990, -475, 1092, -475, -475, - -475, -475, 1194, -475, 160, 160, -475, 521, 468, -475, - -475, 521, 521, -475, 555, 473, 160, -475, -475, 83, - -475, -475, -475, 1296, -475, 3018, 160, 160, -475, 521, - -475, 563, 514, -475, -475, 481, -475, -475, -475, 160, - -475, -475, -475, 521, 1806, -475, 1398, 198, 482, -475, - -475, 521, -475 + 1202, -475, -475, -475, -475, -475, -475, -475, 46, -475, + 2786, 41, 1412, 1319, -475, -475, -475, -475, 22, 22, + 1800, 2786, 2786, 22, -475, 22, 22, -475, -475, 50, + -51, -475, 2786, -475, -475, -475, -475, 2786, -41, -13, + -68, 1893, 1699, 22, 1893, 1986, 10, 2786, 25, 2786, + 2786, 2786, 2786, 2786, 2786, 2786, 2079, 22, 22, 82, + 103, -475, 3, -475, -18, 75, -9, 45, -475, -475, + -475, 2953, -475, -475, 64, 128, 159, 173, -475, 172, + 223, 226, 179, -475, -475, -475, -475, -475, -475, 10, + 10, 190, -475, 106, 119, 126, 141, 142, 146, 157, + 41, 247, 219, -475, 258, 1503, 1319, -475, -475, -475, + 575, -475, 8, 668, -475, -475, -475, -475, -475, -475, + -475, 99, 1198, 1198, -475, 2786, 165, 205, 2786, 175, + 291, 41, 257, 233, 2953, 199, 2180, 2786, 1699, -475, + 291, 477, 103, -475, 362, 2786, -475, -475, 291, 294, + 253, -475, -475, 2786, 291, 2879, 2281, 240, -475, -475, + -475, 291, 103, 1198, 1198, 1198, 487, 487, 305, 280, + -475, -475, 2786, 2786, 2786, 2786, 2786, 2786, 2382, -475, + -475, 2786, -475, -475, 2786, 2786, 2786, 2786, 2786, 2786, + 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, + 2786, 2786, -475, -475, -475, 80, 2483, 2786, 2786, 2786, + 2786, 2786, 2786, 2786, -475, 292, -475, -475, 297, -475, + -475, -475, -475, -475, 222, 0, -475, -475, 217, -475, + -475, -475, -475, 41, -475, -475, 2786, 2786, 2786, 2786, + 2786, 2786, -475, -475, -475, -475, -475, 302, 302, -475, + -475, -475, 313, -475, -475, -475, 2786, 2786, 131, -475, + -475, -475, 233, 314, -475, -475, -475, 381, 266, 237, + 2786, 103, -475, 340, -475, 2584, 1198, 240, 51, 91, + 252, -475, 427, 330, -475, 2786, 347, 286, 286, -475, + 2953, 289, 167, -475, 447, 291, 1025, 3043, 1298, 1211, + 2953, 2908, 653, 653, 746, 839, 932, 1025, 1025, 291, + 291, 1118, 1198, 1198, 260, 265, 2786, 2786, 272, -475, + 279, 2685, 48, 288, 282, -475, -475, 471, 301, 178, + 322, 181, 350, 192, 400, 761, -475, 385, -475, -475, + 138, 382, 2786, 2786, 2786, 2786, -475, 295, -475, -475, + 303, -475, -475, -475, -475, 1505, 29, -475, 2786, 2786, + -475, -475, 82, -475, 82, -475, -475, -475, -475, -475, + 332, 332, 8, 310, 7, -475, 2786, -475, -475, 311, + -475, -475, -475, -475, 574, -475, 11, 579, -475, -475, + -475, 224, 2786, 407, -475, -475, 2786, -475, -475, 437, + 238, -475, -475, -475, 672, -475, -475, 2786, -475, 409, + -475, 410, -475, 420, -475, 421, -475, -475, -475, 257, + 233, -475, -475, 412, 336, 82, 356, 357, 82, 368, + 329, -475, -475, -475, -475, 369, 460, 467, -475, 2786, + 375, 383, 2786, -475, -475, -475, -475, 2786, 413, -475, + 482, -475, -475, 483, -475, -475, 17, -475, 248, -475, + 2998, 484, -475, -475, 392, -475, -475, -475, -475, 479, + 233, 480, -475, 2786, -475, -475, 492, 492, 2786, 2786, + 492, -475, 402, 401, 492, 492, 2953, 82, -475, -475, + 422, -475, -475, -475, -475, 445, 510, -475, -475, -475, + -475, 511, 492, 492, -475, 58, 58, 428, 429, 219, + 2786, 2786, 492, -475, -475, 854, -475, 947, -475, -475, + -475, -475, 1040, -475, 219, 219, -475, 492, 430, -475, + -475, 492, 492, -475, 518, 436, 219, -475, -475, 15, + -475, -475, -475, 1133, -475, 2786, 219, 219, -475, 492, + -475, 531, 485, -475, -475, 466, -475, -475, -475, 219, + -475, -475, -475, 492, 1598, -475, 1226, 58, 472, -475, + -475, 492, -475 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -258,8 +259,8 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 292, 295, 294, 293, 281, 282, - 279, 196, 0, 186, 187, 265, 0, 0, 0, 0, + 0, 15, 113, 0, 292, 295, 294, 293, 282, 279, + 196, 0, 186, 187, 281, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, @@ -271,14 +272,14 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 0, 21, 86, 87, 87, 0, 36, 18, 18, 18, 18, 18, 0, 18, 18, 0, 18, 18, 42, 58, 0, 54, 57, 0, 0, 0, 0, - 0, 0, 28, 27, 22, 101, 102, 99, 99, 109, + 0, 0, 28, 27, 22, 102, 101, 99, 99, 109, 108, 112, 114, 119, 195, 137, 267, 0, 0, 248, 142, 93, 94, 96, 18, 246, 250, 0, 0, 0, 0, 133, 198, 0, 229, 0, 209, 0, 215, 218, 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 287, 289, 0, 0, 0, 144, + 175, 164, 173, 161, 289, 0, 0, 0, 287, 144, 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, @@ -286,8 +287,8 @@ static const yytype_int16 yydefact[] = 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, - 97, 0, 0, 0, 149, 155, 0, 231, 232, 233, - 0, 0, 284, 153, 0, 230, 234, 267, 228, 0, + 97, 0, 0, 0, 149, 155, 0, 232, 233, 0, + 0, 231, 284, 153, 0, 230, 234, 267, 228, 0, 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, @@ -310,16 +311,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -475, -475, -475, -475, -475, -475, -475, -475, -475, 46, - -475, -5, -123, -475, -17, -475, 581, 489, 0, -475, - -475, -475, -475, -475, -475, -475, -475, -475, 42, -350, - -474, -118, -461, -475, 86, 256, -337, 36, -475, 127, - 221, -475, 275, 195, -235, 338, 368, -475, -475, 246, - -475, 251, -475, -475, -475, -475, 166, -475, -475, 128, - -475, 156, -8, -31, -475, -475, -475, -475, -475, -475, - -475, -475, -475, -475, -475, -475, 103, -475, -475, 470, - -124, -122, -475, -475, 273, -475, -475, 405, 34, -45, - -42, -475, -475, -475, -475, -475, 25 + -475, -475, -475, -475, -475, -475, -475, -475, -475, 43, + -475, -5, -139, -475, -17, -475, 539, 497, 9, -475, + -475, -475, -475, -475, -475, -475, -475, -475, 246, -341, + -474, 114, -459, -475, 115, 281, -303, 67, -475, -91, + 208, -475, 105, 228, -234, 371, 403, -475, -475, 278, + -475, 283, -475, -475, -475, -475, 210, -475, -475, 168, + -475, 194, -8, -37, -475, -475, -475, -475, -475, -475, + -475, -475, -475, -475, -475, -475, 100, -475, -475, 508, + -124, -129, -475, -475, 319, -475, -475, 441, 1, -45, + -42, -475, -475, -475, -475, -475, 54 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -342,189 +343,207 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 433, 160, 175, 429, 18, - 19, 142, 103, 122, 503, 268, 269, 254, 435, 162, - 83, 440, 441, 83, 18, 19, 20, 377, 285, 274, - 114, 83, 530, 245, 246, 115, 137, 150, 18, 19, - 207, 114, 208, 118, 119, 120, 115, 16, 169, 129, - 125, 126, 117, 117, 117, 392, 176, 84, 177, 117, - 117, 421, 179, 180, 116, 116, 116, 145, 146, 138, - 422, 116, 116, 207, 128, 208, 144, 117, 214, 172, - 173, 174, 158, 171, 348, -261, 135, 139, 116, 116, - 147, 117, 117, 570, 142, 151, 136, 564, 155, -262, - 152, 447, 483, 116, 116, 551, 243, 156, 57, 552, - 279, 175, -260, 280, 271, -290, 57, 405, 181, -286, - 258, -286, 142, 57, 375, 123, 124, 57, 267, 59, - 59, 228, 247, 213, 373, 130, -286, 57, -286, 184, - 134, 507, 508, -288, 140, -288, 231, 148, 282, 394, - 154, 178, 161, 206, 163, 164, 165, 166, 167, -291, - -291, -291, 205, 270, 287, 288, 289, 218, 291, 292, - 294, 209, 144, 210, 535, 182, 183, 260, 410, 220, - 353, 412, 221, 354, 116, 471, 172, 173, 174, 278, - -288, 414, -288, 232, 211, -264, 212, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 457, 273, 555, 462, - 233, 172, 173, 174, 433, 342, 343, 344, 345, 347, - 222, 355, 356, 223, 358, 359, 374, 229, 362, 364, - 362, 362, 362, 362, 230, 496, 235, 224, 257, 325, - 172, 173, 174, 172, 173, 174, 527, 528, 59, -263, - 393, 256, 449, 172, 173, 174, 132, 133, 276, 352, - 492, 259, 384, 172, 173, 174, 225, 387, 172, 173, - 174, 172, 173, 174, 409, 226, 57, 391, 290, 360, - 365, 366, 367, 368, 295, 464, 261, 296, 297, 298, - 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 263, 172, 173, 174, 400, - 401, 353, 265, 404, 354, 314, 315, 316, 317, 283, - 318, 272, 172, 173, 174, 285, 172, 173, 174, 319, - 172, 173, 174, 346, 425, 364, 428, 428, 411, 236, - 237, 238, 239, 338, 339, 142, 240, 437, 241, 501, - 428, 428, 439, 336, 506, 286, 117, 509, 172, 173, - 174, 513, 514, 413, 216, 217, 415, 357, 116, 340, - 320, 369, 450, 172, 173, 174, 461, 372, 378, 524, - 525, 431, 382, 383, 458, 390, 385, 381, 392, 536, - 352, 533, 174, 397, 172, 173, 174, 398, 399, 59, - 402, 406, -83, 417, 544, 407, 541, 542, 546, 547, - 423, 57, 469, 321, 322, 323, 472, 432, 550, 172, - 173, 174, 172, 173, 174, 186, 559, 479, 556, 557, - 442, 428, 172, 173, 174, 172, 173, 174, 446, 487, - 567, 565, 142, 452, 459, 186, 187, 465, 572, 172, - 173, 174, 172, 173, 174, 201, 466, 200, 202, 203, - 204, 205, 201, 473, 389, 202, 203, 204, 205, 467, - 428, 428, 515, 468, 517, 186, 187, 200, 395, -215, - 481, 408, 201, 522, 474, 202, 203, 204, 205, 478, - 475, 450, 207, 476, 208, -215, -215, 477, 480, 460, - 484, -215, 425, 428, 197, 198, 199, 200, 485, 543, - 488, 493, 201, 489, 491, 202, 203, 204, 205, 172, - 173, 174, 494, -215, -215, -215, -215, 172, 173, 174, - -215, 495, -215, 497, 504, -215, 511, 428, 172, 173, - 174, 518, -215, -215, 566, 486, 512, 519, 455, 172, - 173, 174, 516, 523, 531, -215, 456, -215, -215, -215, - 532, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -215, -254, 545, 548, 463, -215, - 549, 560, -215, -215, -215, -215, -215, 561, 563, 571, - -215, -254, -254, 200, 107, 242, 534, -254, 201, 426, - 568, 202, 203, 204, 205, 186, 187, 1, 2, 3, - 4, 5, 6, 7, 470, 388, 371, 444, 490, -254, - -254, -254, -254, 445, 521, 277, -254, 499, -254, 438, - 351, -254, 195, 196, 197, 198, 199, 200, -254, -254, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, - 0, -254, 0, -254, -254, -254, 0, -254, -254, -254, + 113, 255, 59, 159, 17, 142, 160, 137, 268, 269, + 18, 19, 121, 162, 433, 176, 503, 177, 245, 117, + 117, 103, 23, 175, 117, 285, 117, 117, 377, 274, + 246, 392, 530, 151, 83, 18, 551, 150, 152, 18, + 138, 552, 429, 144, 117, 114, 16, 23, 169, 158, + 115, 23, 435, 83, 84, 440, 441, 129, 117, 117, + 83, 116, 116, 207, 128, 208, 116, 135, 116, 116, + 348, 114, 118, 119, 179, 180, 115, 124, 214, 125, + 126, 182, 183, -261, 139, 116, 116, 147, 142, -260, + 314, 315, 316, 570, 317, 136, 145, 146, 228, 564, + 116, 116, 318, -286, 319, -286, 527, 528, 271, 57, + 279, 178, 171, 280, 254, 243, 142, 247, 447, 175, + 258, 122, 123, -262, 155, 338, 339, 373, 267, 59, + 59, 57, 130, 156, 57, 184, 483, 134, 57, 144, + 207, 140, 208, 231, 148, 320, 375, 154, 282, 161, + 421, 163, 164, 165, 166, 167, 278, 57, 405, 422, + 172, 173, 174, -264, 287, 288, 289, 181, 291, 292, + 294, -286, 206, -286, 260, 507, 508, 172, 173, 174, + 353, 116, 394, 354, -290, -288, 471, -288, 321, 322, + 323, 213, 270, 410, 216, 217, 412, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 414, 535, 172, + 173, 174, 224, 218, 220, 342, 343, 344, 345, 347, + 374, 355, 356, 433, 358, 359, 352, 221, 362, 364, + 362, 362, 362, 362, 222, 209, 496, 210, 211, 457, + 212, 225, 555, 132, 133, 172, 173, 174, 59, 223, + 226, 57, 449, 462, 229, 276, 172, 173, 174, 172, + 173, 174, 384, 492, -288, 230, -288, 387, 232, 233, + 172, 173, 174, 256, 273, 290, 360, 391, 464, 235, + 257, 295, 259, 261, 296, 297, 298, 299, 300, 301, + 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, + 312, 313, 172, 173, 174, 263, 265, 272, 399, 400, + 393, 353, 283, 404, 354, 336, 172, 173, 174, 285, + 340, 346, 409, 117, -263, 357, 172, 173, 174, 372, + 369, 172, 173, 174, 425, 364, 428, 428, 506, 142, + 378, 509, 382, 411, 383, 513, 514, 437, 431, 501, + 428, 428, 439, 385, 186, 187, 390, 352, 172, 173, + 174, 392, -215, 524, 525, 116, 174, 172, 173, 174, + 397, 413, 450, 536, 207, 398, 208, -215, -215, 172, + 173, 174, 401, -215, 458, 199, 200, 286, 544, 402, + 407, 201, 546, 547, 202, 203, 204, 205, 406, 59, + 172, 173, 174, 417, 57, 423, -215, -215, -215, -215, + 559, 432, 469, -215, 442, -215, 472, 446, -215, 452, + 459, 415, 465, 466, 567, -215, -215, 479, 172, 173, + 174, 428, 572, 467, 468, 473, 142, 478, -215, 487, + -215, -215, -215, 474, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -215, -215, -215, -215, 461, 172, + 173, 174, -215, 475, 476, -215, -215, -215, -215, -215, + 428, 428, 515, -215, 517, 477, 480, -254, 172, 173, + 174, 481, 484, 522, 365, 366, 367, 368, 381, 488, + 485, 450, -254, -254, 489, 491, 460, 493, -254, 494, + 495, 497, 425, 428, 504, 172, 173, 174, 512, 543, + 511, 236, 237, 238, 239, 172, 173, 174, 240, 518, + 241, -254, -254, -254, -254, 172, 173, 174, -254, 516, + -254, 519, 523, -254, 389, 531, 532, 428, 545, 548, + -254, -254, 486, 549, 566, 172, 173, 174, 560, 172, + 173, 174, 107, -254, 395, -254, -254, -254, 561, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, 0, 0, 0, 0, -254, 0, 0, -254, -254, - -254, -254, -254, -13, 85, 0, -254, 0, 0, 0, - 0, 0, 0, 18, 19, 20, 83, 0, 21, 0, - 0, 0, 0, 22, 23, 86, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, - 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, -3, 85, 0, 0, - 0, 56, 57, 58, 0, 0, 18, 19, 20, 83, - 0, 21, 0, 0, 0, 0, 22, 23, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 193, - 194, 195, 196, 197, 198, 199, 200, 50, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 83, 416, 21, 0, 0, 0, 0, 22, 23, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, + -254, -254, -254, 563, -83, -13, 85, -254, 408, 571, + -254, -254, -254, -254, -254, 18, 19, 83, -254, 20, + -291, -291, -291, 205, 21, 22, 86, 23, 24, 25, + 26, 27, 28, 242, 29, 30, 31, 32, 33, 34, + 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, + 94, 95, 96, 533, 426, 534, 97, 98, 99, 100, + 37, 568, 101, 38, 39, 40, 41, 42, 541, 542, + 43, 44, 45, 46, 47, 48, 49, 470, 388, 444, + 550, 371, 172, 173, 174, 445, 50, 172, 173, 174, + 556, 557, 490, 277, 521, 499, 351, 0, -3, 85, + 0, 51, 52, 565, 53, 438, 54, 55, 18, 19, + 83, 455, 20, 56, 57, 58, 456, 21, 22, 86, + 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 194, 195, 196, 197, 198, 199, 200, 50, - 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, - 18, 19, 20, 83, 537, 21, 0, 0, 0, 0, - 22, 23, 86, 24, 25, 26, 27, 28, 0, 29, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 50, + 172, 173, 174, 201, 0, 0, 202, 203, 204, 205, + 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, + 55, 18, 19, 83, 416, 20, 56, 57, 58, 463, + 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, + 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 193, 194, 195, 196, 197, 198, + 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, + 203, 204, 205, 0, 0, 85, 0, 51, 52, 0, + 53, 0, 54, 55, 18, 19, 83, 537, 20, 56, + 57, 58, 0, 21, 22, 86, 23, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, + 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, + 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, + 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 194, 195, + 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, + 0, 0, 202, 203, 204, 205, 0, 0, 85, 0, + 51, 52, 0, 53, 0, 54, 55, 18, 19, 83, + 538, 20, 56, 57, 58, 0, 21, 22, 86, 23, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, + 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, + 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 195, 196, 197, 198, 199, 200, 50, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 85, 0, 51, 52, 0, 53, 0, 54, 55, + 18, 19, 83, 540, 20, 56, 57, 58, 0, 21, + 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 199, + 48, 49, 0, 0, 0, 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 83, 538, 21, 0, 0, - 0, 0, 22, 23, 86, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 204, 205, 0, 0, 85, 0, 51, 52, 0, 53, + 0, 54, 55, 18, 19, 83, 554, 20, 56, 57, + 58, 0, 21, 22, 86, 23, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, + 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, + 6, 7, 0, 200, 50, 0, 0, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 85, 0, 51, + 52, 0, 53, 0, 54, 55, 18, 19, 83, 0, + 20, 56, 57, 58, 0, 21, 22, 86, 23, 24, + 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 186, 0, 0, 97, 98, 99, + 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 201, 0, + 569, 202, 203, 204, 205, 0, 200, 50, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, + 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 83, 0, 20, 56, 57, 58, 0, 21, 22, + 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 200, 0, 0, 0, 0, 201, 0, + 50, 202, 203, 204, 205, 0, 0, 0, 0, 0, + 0, 0, 0, 85, 0, 51, 52, 0, 53, 0, + 54, 55, 18, 19, 83, 0, 20, 56, 57, 58, + 0, 21, 22, 86, 23, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 236, 237, 238, 239, - 0, 0, 0, 240, 0, 241, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 57, 58, 0, 18, 19, 20, 83, 540, 21, - 172, 173, 174, 0, 22, 23, 86, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 57, 58, 0, 18, 19, 20, 83, - 554, 21, 0, 0, 0, 0, 22, 23, 86, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 85, 0, 51, 52, + 0, 53, 0, 54, 55, 18, 19, 0, 0, 20, + 56, 57, 58, 0, 21, 22, -78, 23, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, + 0, 0, 0, 0, 0, 35, 36, 236, 237, 238, + 239, 0, 0, 0, 240, 0, 241, 0, 0, 0, + 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 172, 173, 174, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, + 0, 0, 20, 56, 57, 58, 0, 21, 22, 0, + 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, + 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 85, - 0, 0, 0, 0, 56, 57, 58, 0, 18, 19, - 20, 83, 0, 21, 0, 0, 0, 0, 22, 23, - 86, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, - 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, + 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 569, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 85, 0, 0, 0, 0, 56, 57, 58, 0, - 18, 19, 20, 83, 0, 21, 0, 0, 0, 0, - 22, 23, 86, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, + 55, 0, 0, 0, 0, -78, 56, 57, 58, 18, + 19, 83, 0, 20, 0, 0, 0, 0, 21, 22, + 0, 23, 141, 25, 26, 27, 28, 115, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, + 18, 19, 0, 0, 20, 120, 0, 0, 0, 21, + 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, + 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, + 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 85, 0, 0, 0, 0, 56, 57, - 58, 0, 18, 19, 20, 83, 0, 21, 0, 0, - 0, 0, 22, 23, 86, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 0, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 85, 0, 0, 0, 0, - 56, 57, 58, 0, 18, 19, 20, 0, 0, 21, - 0, 0, 0, 0, 22, 23, -78, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 85, 0, 0, - 0, 0, 56, 57, 58, 0, 18, 19, 20, 0, - 0, 21, 0, 0, 0, 0, 22, 23, 0, 24, + 0, 54, 55, 18, 19, 83, 0, 20, 56, 57, + 58, 0, 21, 22, 0, 23, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 0, 53, 0, 54, 55, 18, 19, 0, 0, + 20, 56, 57, 58, 0, 21, 22, 149, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -532,30 +551,9 @@ static const yytype_int16 yytable[] = 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, -78, 56, 57, 58, 18, 19, 20, - 83, 0, 21, 0, 0, 0, 0, 22, 23, 0, - 141, 25, 26, 27, 28, 115, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 0, 56, 57, 58, 18, 19, - 20, 0, 0, 21, 121, 0, 0, 0, 22, 23, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, - 19, 20, 83, 0, 21, 0, 0, 0, 0, 22, - 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 0, 0, 20, 56, 57, 58, 0, 21, 22, + 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, @@ -563,9 +561,9 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, - 18, 19, 20, 0, 0, 21, 0, 0, 0, 0, - 22, 23, 149, 24, 25, 26, 27, 28, 0, 29, + 54, 55, 0, 0, 0, 0, 168, 56, 57, 58, + 18, 19, 0, 0, 20, 0, 0, 0, 0, 21, + 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, @@ -573,9 +571,9 @@ static const yytype_int16 yytable[] = 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 0, 56, 57, - 58, 18, 19, 20, 0, 0, 21, 0, 0, 0, - 0, 22, 23, 0, 24, 25, 26, 27, 28, 0, + 0, 54, 55, 0, 0, 0, 0, 266, 56, 57, + 58, 18, 19, 0, 0, 20, 0, 0, 0, 0, + 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, @@ -583,9 +581,9 @@ static const yytype_int16 yytable[] = 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 168, 56, - 57, 58, 18, 19, 20, 0, 0, 21, 0, 0, - 0, 0, 22, 23, 0, 24, 25, 26, 27, 28, + 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, + 57, 58, 18, 19, 0, 0, 20, 0, 0, 0, + 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -593,9 +591,9 @@ static const yytype_int16 yytable[] = 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 266, - 56, 57, 58, 18, 19, 20, 0, 0, 21, 0, - 0, 0, 0, 22, 23, 0, 24, 25, 26, 27, + 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, + 56, 57, 58, 18, 19, 0, 0, 20, 0, 0, + 0, 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -604,8 +602,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 281, 56, 57, 58, 18, 19, 20, 0, 0, 21, - 0, 0, 0, 0, 22, 23, 0, 24, 25, 26, + 326, 56, 57, 58, 18, 19, 0, 0, 20, 0, + 0, 0, 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, @@ -614,8 +612,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 293, 56, 57, 58, 18, 19, 20, 0, 0, - 21, 0, 0, 0, 0, 22, 23, 0, 24, 25, + 0, 386, 56, 57, 58, 18, 19, 0, 0, 20, + 0, 0, 0, 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -624,8 +622,8 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 326, 56, 57, 58, 18, 19, 20, 0, - 0, 21, 0, 0, 0, 0, 22, 23, 0, 24, + 0, 0, 403, 56, 57, 58, 18, 19, 0, 0, + 20, 0, 0, 0, 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -633,30 +631,9 @@ static const yytype_int16 yytable[] = 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 0, - 0, 0, 0, 386, 56, 57, 58, 18, 19, 20, - 0, 0, 21, 0, 0, 0, 0, 22, 23, 0, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 0, 0, 0, 0, 403, 56, 57, 58, 18, 19, - 20, 0, 0, 21, 0, 0, 0, 0, 22, 23, - 0, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, 0, 56, 57, 58, 18, - 19, 20, 0, 0, 21, 0, 0, 0, 0, 22, - 23, 0, 24, 25, 26, 27, 28, 0, 29, 30, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 19, 0, 0, 20, 56, 57, 58, 0, 21, 22, + 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, @@ -685,189 +662,207 @@ static const yytype_int16 yytable[] = static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 355, 48, 17, 345, 10, - 11, 42, 12, 21, 475, 137, 138, 16, 355, 50, - 13, 358, 359, 13, 10, 11, 12, 262, 15, 153, - 23, 13, 506, 10, 11, 28, 75, 45, 10, 11, - 13, 23, 15, 18, 19, 20, 28, 0, 56, 108, - 25, 26, 18, 19, 20, 15, 13, 11, 15, 25, - 26, 13, 92, 93, 18, 19, 20, 42, 43, 108, - 22, 25, 26, 13, 15, 15, 42, 43, 83, 78, - 79, 80, 48, 58, 70, 72, 108, 41, 42, 43, - 44, 57, 58, 567, 125, 23, 108, 558, 99, 72, - 28, 111, 439, 57, 58, 22, 106, 108, 109, 26, - 155, 17, 72, 155, 145, 13, 109, 110, 92, 13, - 128, 15, 153, 109, 16, 22, 23, 109, 136, 137, - 138, 97, 109, 13, 256, 32, 13, 109, 15, 90, - 37, 478, 479, 13, 41, 15, 100, 44, 156, 16, - 47, 108, 49, 108, 51, 52, 53, 54, 55, 103, - 104, 105, 106, 138, 172, 173, 174, 23, 176, 177, - 178, 13, 138, 15, 511, 90, 91, 131, 16, 108, - 225, 16, 108, 225, 138, 420, 78, 79, 80, 155, - 13, 16, 15, 22, 13, 72, 15, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 16, 22, 545, 16, - 50, 78, 79, 80, 564, 220, 221, 222, 223, 224, - 108, 226, 227, 108, 229, 230, 257, 108, 236, 237, - 238, 239, 240, 241, 108, 470, 22, 70, 75, 205, - 78, 79, 80, 78, 79, 80, 48, 49, 256, 72, - 22, 108, 376, 78, 79, 80, 35, 36, 155, 225, - 16, 107, 270, 78, 79, 80, 99, 275, 78, 79, - 80, 78, 79, 80, 22, 108, 109, 285, 175, 233, - 238, 239, 240, 241, 181, 407, 26, 184, 185, 186, - 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 72, 78, 79, 80, 317, - 318, 356, 107, 321, 356, 10, 11, 12, 13, 72, - 15, 14, 78, 79, 80, 15, 78, 79, 80, 24, - 78, 79, 80, 99, 342, 343, 344, 345, 22, 44, - 45, 46, 47, 216, 217, 376, 51, 355, 53, 473, - 358, 359, 357, 23, 477, 107, 322, 480, 78, 79, - 80, 484, 485, 22, 89, 90, 22, 108, 322, 23, - 65, 28, 377, 78, 79, 80, 22, 17, 26, 502, - 503, 347, 76, 107, 392, 26, 14, 107, 15, 512, - 356, 509, 80, 110, 78, 79, 80, 110, 110, 407, - 110, 110, 107, 19, 527, 108, 524, 525, 531, 532, - 23, 109, 417, 108, 109, 110, 421, 108, 536, 78, - 79, 80, 78, 79, 80, 63, 549, 432, 546, 547, - 82, 439, 78, 79, 80, 78, 79, 80, 107, 447, - 563, 559, 473, 108, 14, 63, 64, 14, 571, 78, - 79, 80, 78, 79, 80, 100, 14, 95, 103, 104, - 105, 106, 100, 23, 107, 103, 104, 105, 106, 14, - 478, 479, 489, 14, 491, 63, 64, 95, 107, 0, - 22, 107, 100, 500, 107, 103, 104, 105, 106, 108, - 107, 496, 13, 107, 15, 16, 17, 107, 107, 396, - 107, 22, 510, 511, 92, 93, 94, 95, 107, 526, - 76, 14, 100, 13, 13, 103, 104, 105, 106, 78, - 79, 80, 107, 44, 45, 46, 47, 78, 79, 80, - 51, 22, 53, 22, 13, 56, 108, 545, 78, 79, - 80, 74, 63, 64, 561, 442, 107, 22, 107, 78, - 79, 80, 107, 22, 107, 76, 107, 78, 79, 80, - 107, 82, 83, 84, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, 0, 108, 22, 107, 100, - 107, 18, 103, 104, 105, 106, 107, 73, 107, 107, - 111, 16, 17, 95, 13, 106, 510, 22, 100, 343, - 564, 103, 104, 105, 106, 63, 64, 3, 4, 5, - 6, 7, 8, 9, 419, 277, 248, 371, 452, 44, - 45, 46, 47, 372, 496, 155, 51, 471, 53, 356, - 225, 56, 90, 91, 92, 93, 94, 95, 63, 64, - -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, - -1, 76, -1, 78, 79, 80, -1, 82, 83, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106, 107, 0, 1, -1, 111, -1, -1, -1, - -1, -1, -1, 10, 11, 12, 13, -1, 15, -1, - -1, -1, -1, 20, 21, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, - 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 81, -1, -1, -1, 100, -1, - -1, 103, 104, 105, 106, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 0, 1, -1, -1, - -1, 108, 109, 110, -1, -1, 10, 11, 12, 13, - -1, 15, -1, -1, -1, -1, 20, 21, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, - 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, 88, - 89, 90, 91, 92, 93, 94, 95, 81, -1, -1, - -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, - -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, - 12, 13, 14, 15, -1, -1, -1, -1, 20, 21, + 17, 125, 10, 48, 9, 42, 48, 75, 137, 138, + 10, 11, 20, 50, 355, 12, 475, 14, 10, 18, + 19, 12, 22, 16, 23, 14, 25, 26, 262, 153, + 22, 14, 506, 23, 12, 10, 21, 45, 28, 10, + 108, 26, 345, 42, 43, 23, 0, 22, 56, 48, + 28, 22, 355, 12, 11, 358, 359, 108, 57, 58, + 12, 18, 19, 12, 14, 14, 23, 108, 25, 26, + 70, 23, 18, 19, 92, 93, 28, 23, 83, 25, + 26, 90, 91, 72, 41, 42, 43, 44, 125, 72, + 10, 11, 12, 567, 14, 108, 42, 43, 97, 558, + 57, 58, 22, 12, 24, 14, 48, 49, 145, 109, + 155, 108, 58, 155, 15, 106, 153, 109, 111, 16, + 128, 21, 22, 72, 99, 216, 217, 256, 136, 137, + 138, 109, 32, 108, 109, 90, 439, 37, 109, 138, + 12, 41, 14, 100, 44, 65, 15, 47, 156, 49, + 12, 51, 52, 53, 54, 55, 155, 109, 110, 21, + 78, 79, 80, 72, 172, 173, 174, 92, 176, 177, + 178, 12, 108, 14, 131, 478, 479, 78, 79, 80, + 225, 138, 15, 225, 12, 12, 420, 14, 108, 109, + 110, 12, 138, 15, 89, 90, 15, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 15, 511, 78, + 79, 80, 70, 23, 108, 220, 221, 222, 223, 224, + 257, 226, 227, 564, 229, 230, 225, 108, 236, 237, + 238, 239, 240, 241, 108, 12, 470, 14, 12, 15, + 14, 99, 545, 35, 36, 78, 79, 80, 256, 108, + 108, 109, 376, 15, 108, 155, 78, 79, 80, 78, + 79, 80, 270, 15, 12, 108, 14, 275, 21, 50, + 78, 79, 80, 108, 21, 175, 233, 285, 407, 21, + 75, 181, 107, 26, 184, 185, 186, 187, 188, 189, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 78, 79, 80, 72, 107, 13, 316, 317, + 21, 356, 72, 321, 356, 23, 78, 79, 80, 14, + 23, 99, 21, 322, 72, 108, 78, 79, 80, 16, + 28, 78, 79, 80, 342, 343, 344, 345, 477, 376, + 26, 480, 76, 21, 107, 484, 485, 355, 347, 473, + 358, 359, 357, 13, 63, 64, 26, 356, 78, 79, + 80, 14, 0, 502, 503, 322, 80, 78, 79, 80, + 110, 21, 377, 512, 12, 110, 14, 15, 16, 78, + 79, 80, 110, 21, 392, 94, 95, 107, 527, 110, + 108, 100, 531, 532, 103, 104, 105, 106, 110, 407, + 78, 79, 80, 18, 109, 23, 44, 45, 46, 47, + 549, 108, 417, 51, 82, 53, 421, 107, 56, 108, + 13, 21, 13, 13, 563, 63, 64, 432, 78, 79, + 80, 439, 571, 13, 13, 23, 473, 108, 76, 447, + 78, 79, 80, 107, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 21, 78, + 79, 80, 100, 107, 107, 103, 104, 105, 106, 107, + 478, 479, 489, 111, 491, 107, 107, 0, 78, 79, + 80, 21, 107, 500, 238, 239, 240, 241, 107, 76, + 107, 496, 15, 16, 12, 12, 396, 13, 21, 107, + 21, 21, 510, 511, 12, 78, 79, 80, 107, 526, + 108, 44, 45, 46, 47, 78, 79, 80, 51, 74, + 53, 44, 45, 46, 47, 78, 79, 80, 51, 107, + 53, 21, 21, 56, 107, 107, 107, 545, 108, 21, + 63, 64, 442, 107, 561, 78, 79, 80, 17, 78, + 79, 80, 13, 76, 107, 78, 79, 80, 73, 82, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 107, 107, 0, 1, 100, 107, 107, + 103, 104, 105, 106, 107, 10, 11, 12, 111, 14, + 103, 104, 105, 106, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 106, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 509, 343, 510, 51, 52, 53, 54, + 55, 564, 57, 58, 59, 60, 61, 62, 524, 525, + 65, 66, 67, 68, 69, 70, 71, 419, 277, 371, + 536, 248, 78, 79, 80, 372, 81, 78, 79, 80, + 546, 547, 452, 155, 496, 471, 225, -1, 0, 1, + -1, 96, 97, 559, 99, 356, 101, 102, 10, 11, + 12, 107, 14, 108, 109, 110, 107, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, 89, 90, 91, 92, 93, 94, 95, 81, - -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, - 10, 11, 12, 13, 14, 15, -1, -1, -1, -1, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 81, + 78, 79, 80, 100, -1, -1, 103, 104, 105, 106, + -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, + 102, 10, 11, 12, 13, 14, 108, 109, 110, 107, + 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, + 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, 88, 89, 90, 91, 92, 93, + 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, + 104, 105, 106, -1, -1, 1, -1, 96, 97, -1, + 99, -1, 101, 102, 10, 11, 12, 13, 14, 108, + 109, 110, -1, 19, 20, 21, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, + -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, 89, 90, + 91, 92, 93, 94, 95, 81, -1, -1, -1, 100, + -1, -1, 103, 104, 105, 106, -1, -1, 1, -1, + 96, 97, -1, 99, -1, 101, 102, 10, 11, 12, + 13, 14, 108, 109, 110, -1, 19, 20, 21, 22, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, + 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, 90, 91, 92, 93, 94, 95, 81, -1, + -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, + -1, 1, -1, 96, 97, -1, 99, -1, 101, 102, + 10, 11, 12, 13, 14, 108, 109, 110, -1, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, 94, + 70, 71, -1, -1, -1, -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, - 110, -1, 10, 11, 12, 13, 14, 15, -1, -1, - -1, -1, 20, 21, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 105, 106, -1, -1, 1, -1, 96, 97, -1, 99, + -1, 101, 102, 10, 11, 12, 13, 14, 108, 109, + 110, -1, 19, 20, 21, 22, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, + 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, 3, 4, 5, 6, 7, + 8, 9, -1, 95, 81, -1, -1, -1, 100, -1, + -1, 103, 104, 105, 106, -1, -1, 1, -1, 96, + 97, -1, 99, -1, 101, 102, 10, 11, 12, -1, + 14, 108, 109, 110, -1, 19, 20, 21, 22, 23, + 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 63, -1, -1, 51, 52, 53, + 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, 100, -1, + 74, 103, 104, 105, 106, -1, 95, 81, -1, -1, + -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, + 1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, 12, -1, 14, 108, 109, 110, -1, 19, 20, + 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, + 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, 95, -1, -1, -1, -1, 100, -1, + 81, 103, 104, 105, 106, -1, -1, -1, -1, -1, + -1, -1, -1, 1, -1, 96, 97, -1, 99, -1, + 101, 102, 10, 11, 12, -1, 14, 108, 109, 110, + -1, 19, 20, 21, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, 44, 45, 46, 47, - -1, -1, -1, 51, -1, 53, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, - 108, 109, 110, -1, 10, 11, 12, 13, 14, 15, - 78, 79, 80, -1, 20, 21, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, - -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, - -1, -1, 108, 109, 110, -1, 10, 11, 12, 13, - 14, 15, -1, -1, -1, -1, 20, 21, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, - 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 1, - -1, -1, -1, -1, 108, 109, 110, -1, 10, 11, - 12, 13, -1, 15, -1, -1, -1, -1, 20, 21, + -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 1, -1, 96, 97, + -1, 99, -1, 101, 102, 10, 11, -1, -1, 14, + 108, 109, 110, -1, 19, 20, 21, 22, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, + -1, -1, -1, -1, -1, 40, 41, 44, 45, 46, + 47, -1, -1, -1, 51, -1, 53, -1, -1, -1, + 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, + -1, 78, 79, 80, -1, -1, 81, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, + -1, -1, 14, 108, 109, 110, -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, - 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, + 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, 74, -1, -1, -1, -1, -1, -1, 81, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, 1, -1, -1, -1, -1, 108, 109, 110, -1, - 10, 11, 12, 13, -1, 15, -1, -1, -1, -1, - 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, - -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, + 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, + 11, 12, -1, 14, -1, -1, -1, -1, 19, 20, + -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, + 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, + 10, 11, -1, -1, 14, 15, -1, -1, -1, 19, + 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, + 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, + 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 1, -1, -1, -1, -1, 108, 109, - 110, -1, 10, 11, 12, 13, -1, 15, -1, -1, - -1, -1, 20, 21, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, 35, -1, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 1, -1, -1, -1, -1, - 108, 109, 110, -1, 10, 11, 12, -1, -1, 15, - -1, -1, -1, -1, 20, 21, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, - -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, - -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 1, -1, -1, - -1, -1, 108, 109, 110, -1, 10, 11, 12, -1, - -1, 15, -1, -1, -1, -1, 20, 21, -1, 23, + -1, 101, 102, 10, 11, 12, -1, 14, 108, 109, + 110, -1, 19, 20, -1, 22, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, + -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, + -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, + 97, -1, 99, -1, 101, 102, 10, 11, -1, -1, + 14, 108, 109, 110, -1, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -875,30 +870,9 @@ static const yytype_int16 yycheck[] = -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, - 13, -1, 15, -1, -1, -1, -1, 20, 21, -1, - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, - 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - -1, -1, -1, -1, -1, 108, 109, 110, 10, 11, - 12, -1, -1, 15, 16, -1, -1, -1, 20, 21, - -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, - 11, 12, 13, -1, 15, -1, -1, -1, -1, 20, - 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, -1, -1, 14, 108, 109, 110, -1, 19, 20, + -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, @@ -906,9 +880,9 @@ static const yytype_int16 yycheck[] = 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, - 10, 11, 12, -1, -1, 15, -1, -1, -1, -1, - 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, + 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, + 10, 11, -1, -1, 14, -1, -1, -1, -1, 19, + 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, @@ -916,9 +890,9 @@ static const yytype_int16 yycheck[] = 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, -1, 108, 109, - 110, 10, 11, 12, -1, -1, 15, -1, -1, -1, - -1, 20, 21, -1, 23, 24, 25, 26, 27, -1, + -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, + 110, 10, 11, -1, -1, 14, -1, -1, -1, -1, + 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, @@ -927,8 +901,8 @@ static const yytype_int16 yycheck[] = -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, 12, -1, -1, 15, -1, -1, - -1, -1, 20, 21, -1, 23, 24, 25, 26, 27, + 109, 110, 10, 11, -1, -1, 14, -1, -1, -1, + -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, @@ -937,8 +911,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, - 108, 109, 110, 10, 11, 12, -1, -1, 15, -1, - -1, -1, -1, 20, 21, -1, 23, 24, 25, 26, + 108, 109, 110, 10, 11, -1, -1, 14, -1, -1, + -1, -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, @@ -947,8 +921,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, 12, -1, -1, 15, - -1, -1, -1, -1, 20, 21, -1, 23, 24, 25, + 107, 108, 109, 110, 10, 11, -1, -1, 14, -1, + -1, -1, -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, @@ -957,8 +931,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, 12, -1, -1, - 15, -1, -1, -1, -1, 20, 21, -1, 23, 24, + -1, 107, 108, 109, 110, 10, 11, -1, -1, 14, + -1, -1, -1, -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -967,8 +941,8 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, 12, -1, - -1, 15, -1, -1, -1, -1, 20, 21, -1, 23, + -1, -1, 107, 108, 109, 110, 10, 11, -1, -1, + 14, -1, -1, -1, -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -976,30 +950,9 @@ static const yytype_int16 yycheck[] = -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, -1, - -1, -1, -1, 107, 108, 109, 110, 10, 11, 12, - -1, -1, 15, -1, -1, -1, -1, 20, 21, -1, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, - 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - -1, -1, -1, -1, 107, 108, 109, 110, 10, 11, - 12, -1, -1, 15, -1, -1, -1, -1, 20, 21, - -1, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, -1, 108, 109, 110, 10, - 11, 12, -1, -1, 15, -1, -1, -1, -1, 20, - 21, -1, 23, 24, 25, 26, 27, -1, 29, 30, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, -1, -1, 14, 108, 109, 110, -1, 19, 20, + -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, @@ -1032,61 +985,61 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 12, 15, 20, 21, 23, 24, 25, 26, 27, 29, + 14, 19, 20, 22, 23, 24, 25, 26, 27, 29, 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 13, 121, 1, 22, 35, 37, 38, + 205, 206, 207, 12, 121, 1, 21, 35, 37, 38, 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, 126, 168, 169, 126, 23, 28, 121, 200, 208, 208, - 208, 16, 174, 188, 188, 208, 208, 189, 15, 108, + 15, 174, 188, 188, 208, 208, 208, 189, 14, 108, 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, - 188, 23, 175, 192, 200, 208, 208, 121, 188, 22, + 188, 23, 175, 192, 200, 208, 208, 121, 188, 21, 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 78, 79, 80, 17, 13, 15, 108, 92, + 208, 208, 78, 79, 80, 16, 12, 14, 108, 92, 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 13, 15, 13, - 15, 13, 15, 13, 123, 153, 154, 154, 23, 151, + 95, 100, 103, 104, 105, 106, 108, 12, 14, 12, + 14, 12, 14, 12, 123, 153, 154, 154, 23, 151, 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, - 108, 121, 22, 50, 143, 22, 44, 45, 46, 47, - 51, 53, 129, 130, 128, 10, 11, 109, 159, 160, - 162, 163, 164, 165, 16, 192, 108, 75, 174, 107, + 108, 121, 21, 50, 143, 21, 44, 45, 46, 47, + 51, 53, 129, 130, 128, 10, 22, 109, 159, 160, + 162, 163, 164, 165, 15, 192, 108, 75, 174, 107, 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, - 208, 175, 14, 22, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 72, 157, 15, 107, 174, 174, 174, + 208, 175, 13, 21, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 72, 157, 14, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 12, 13, 15, 24, + 188, 188, 188, 188, 10, 11, 12, 14, 22, 24, 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, - 158, 158, 17, 193, 175, 16, 177, 156, 26, 123, - 173, 107, 76, 107, 174, 14, 107, 174, 157, 107, - 26, 174, 15, 22, 16, 107, 84, 110, 110, 110, - 174, 174, 110, 107, 174, 110, 110, 108, 107, 22, - 16, 22, 16, 22, 16, 22, 14, 19, 122, 131, - 132, 13, 22, 23, 146, 174, 147, 148, 174, 148, + 158, 158, 16, 193, 175, 15, 177, 156, 26, 123, + 173, 107, 76, 107, 174, 13, 107, 174, 157, 107, + 26, 174, 14, 21, 15, 107, 84, 110, 110, 174, + 174, 110, 110, 107, 174, 110, 110, 108, 107, 21, + 15, 21, 15, 21, 15, 21, 13, 18, 122, 131, + 132, 12, 21, 23, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 16, 174, 14, - 188, 22, 16, 107, 193, 14, 14, 14, 14, 123, + 123, 171, 108, 166, 167, 107, 107, 15, 174, 13, + 188, 21, 15, 107, 193, 13, 13, 13, 13, 123, 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, - 107, 22, 136, 148, 107, 107, 188, 174, 76, 13, - 168, 13, 16, 14, 107, 22, 156, 22, 172, 173, - 137, 192, 144, 144, 13, 124, 124, 148, 148, 124, - 134, 108, 107, 124, 124, 126, 107, 126, 74, 22, - 170, 171, 126, 22, 124, 124, 125, 48, 49, 142, - 142, 107, 107, 143, 146, 148, 124, 14, 14, 127, - 14, 143, 143, 126, 124, 108, 124, 124, 22, 107, - 143, 22, 26, 138, 14, 148, 143, 143, 135, 124, - 18, 73, 139, 107, 144, 143, 126, 124, 149, 74, + 107, 21, 136, 148, 107, 107, 188, 174, 76, 12, + 168, 12, 15, 13, 107, 21, 156, 21, 172, 173, + 137, 192, 144, 144, 12, 124, 124, 148, 148, 124, + 134, 108, 107, 124, 124, 126, 107, 126, 74, 21, + 170, 171, 126, 21, 124, 124, 125, 48, 49, 142, + 142, 107, 107, 143, 146, 148, 124, 13, 13, 127, + 13, 143, 143, 126, 124, 108, 124, 124, 21, 107, + 143, 21, 26, 138, 13, 148, 143, 143, 135, 124, + 17, 73, 139, 107, 144, 143, 126, 124, 149, 74, 142, 107, 124 }; @@ -1169,18 +1122,18 @@ static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, @@ -1205,6 +1158,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 2550a0eab718927598f66703dd2d4df3e0f498629a90f95861ac9d9110d995c7 perly.y + * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index c5e79c8d4f35..21cb35c727b8 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,7 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '@' '%' +%token '%' %token PERLY_AMPERSAND %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE @@ -57,6 +57,7 @@ %token PERLY_MINUS %token PERLY_PLUS %token PERLY_SEMICOLON +%token PERLY_SNAIL %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -658,7 +659,7 @@ sigvarname: /* NULL */ ; sigslurpsigil: - '@' + PERLY_SNAIL { $$ = '@'; } | '%' { $$ = '%'; } @@ -1246,7 +1247,7 @@ term[product] : termbinop } | term[operand] ARROW '$' '*' { $$ = newSVREF($operand); } - | term[operand] ARROW '@' '*' + | term[operand] ARROW PERLY_SNAIL '*' { $$ = newAVREF($operand); } | term[operand] ARROW '%' '*' { $$ = newHVREF($operand); } @@ -1380,9 +1381,9 @@ scalar : '$' indirob { $$ = newSVREF($indirob); } ; -ary : '@' indirob +ary : PERLY_SNAIL indirob { $$ = newAVREF($indirob); - if ($$) $$->op_private |= $1; + if ($$) $$->op_private |= $PERLY_SNAIL; } ; @@ -1403,7 +1404,7 @@ star : '*' indirob ; sliceme : ary - | term ARROW '@' + | term ARROW PERLY_SNAIL { $$ = newAVREF($term); } ; diff --git a/toke.c b/toke.c index 594672de8178..f95c47bc5e4f 100644 --- a/toke.c +++ b/toke.c @@ -400,6 +400,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_PLUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), + DEBUG_TOKEN (IVAL, PERLY_SNAIL), DEBUG_TOKEN (IVAL, PERLY_TILDE), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -2047,20 +2048,24 @@ S_force_next(pTHX_ I32 type) static int S_postderef(pTHX_ int const funny, char const next) { - assert(funny == DOLSHARP || memCHRs("$@%&*", funny) || funny == PERLY_AMPERSAND); + assert(funny == DOLSHARP + || memCHRs("$@%&*", funny) + || funny == PERLY_SNAIL + || funny == PERLY_AMPERSAND + ); if (next == '*') { PL_expect = XOPERATOR; if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) { - assert('@' == funny || '$' == funny || DOLSHARP == funny); + assert(PERLY_SNAIL == funny || '$' == funny || DOLSHARP == funny); PL_lex_state = LEX_INTERPEND; - if ('@' == funny) + if (PERLY_SNAIL == funny) force_next(POSTJOIN); } force_next(next); PL_bufptr+=2; } else { - if ('@' == funny && PL_lex_state == LEX_INTERPNORMAL + if (PERLY_SNAIL == funny && PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) PL_lex_dojoin = 2; PL_expect = XOPERATOR; @@ -2188,7 +2193,7 @@ S_force_ident(pTHX_ const char *s, int kind) (PL_in_eval ? GV_ADDMULTI : GV_ADD) | ( UTF ? SVf_UTF8 : 0 ), kind == '$' ? SVt_PV : - kind == '@' ? SVt_PVAV : + kind == PERLY_SNAIL ? SVt_PVAV : kind == '%' ? SVt_PVHV : SVt_PVGV ); @@ -5000,6 +5005,7 @@ yyl_sigvar(pTHX_ char *s) switch (sigil) { case ',': TOKEN (PERLY_COMMA); + case '@': TOKEN (PERLY_SNAIL); default: TOKEN (sigil); } } @@ -6375,7 +6381,7 @@ static int yyl_snail(pTHX_ char *s) { if (PL_expect == XPOSTDEREF) - POSTDEREF('@'); + POSTDEREF(PERLY_SNAIL); PL_tokenbuf[0] = '@'; s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); if (PL_expect == XOPERATOR) { @@ -6388,7 +6394,7 @@ yyl_snail(pTHX_ char *s) } pl_yylval.ival = 0; if (!PL_tokenbuf[1]) { - PREREF('@'); + PREREF(PERLY_SNAIL); } if (PL_lex_state == LEX_NORMAL || PL_lex_brackets) s = skipspace(s); @@ -6407,7 +6413,7 @@ yyl_snail(pTHX_ char *s) } PL_expect = XOPERATOR; force_ident_maybe_lex('@'); - TERM('@'); + TERM(PERLY_SNAIL); } static int From 0ba95c59b78e1c0733f9a491f242d4ab31128108 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:15 +0100 Subject: [PATCH 340/503] Distinguish C- and perly- literals - PERLY_PERCENT_SIGN --- perly.act | 2 +- perly.h | 177 ++++---- perly.tab | 1282 ++++++++++++++++++++++++++--------------------------- perly.y | 12 +- toke.c | 11 +- 5 files changed, 741 insertions(+), 743 deletions(-) diff --git a/perly.act b/perly.act index 3fede6368226..c0dfdfcf14ee 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y + * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 902e40655c91..4f6273df5c7c 100644 --- a/perly.h +++ b/perly.h @@ -72,93 +72,94 @@ extern int yydebug; PERLY_DOT = 271, PERLY_EQUAL_SIGN = 272, PERLY_MINUS = 273, - PERLY_PLUS = 274, - PERLY_SEMICOLON = 275, - PERLY_SNAIL = 276, - BAREWORD = 277, - METHOD = 278, - FUNCMETH = 279, - THING = 280, - PMFUNC = 281, - PRIVATEREF = 282, - QWLIST = 283, - FUNC0OP = 284, - FUNC0SUB = 285, - UNIOPSUB = 286, - LSTOPSUB = 287, - PLUGEXPR = 288, - PLUGSTMT = 289, - LABEL = 290, - FORMAT = 291, - SUB = 292, - SIGSUB = 293, - ANONSUB = 294, - ANON_SIGSUB = 295, - PACKAGE = 296, - USE = 297, - WHILE = 298, - UNTIL = 299, - IF = 300, - UNLESS = 301, - ELSE = 302, - ELSIF = 303, - CONTINUE = 304, - FOR = 305, - GIVEN = 306, - WHEN = 307, - DEFAULT = 308, - LOOPEX = 309, - DOTDOT = 310, - YADAYADA = 311, - FUNC0 = 312, - FUNC1 = 313, - FUNC = 314, - UNIOP = 315, - LSTOP = 316, - MULOP = 317, - ADDOP = 318, - DOLSHARP = 319, - DO = 320, - HASHBRACK = 321, - NOAMP = 322, - LOCAL = 323, - MY = 324, - REQUIRE = 325, - COLONATTR = 326, - FORMLBRACK = 327, - FORMRBRACK = 328, - SUBLEXSTART = 329, - SUBLEXEND = 330, - PREC_LOW = 331, - OROP = 332, - DOROP = 333, - ANDOP = 334, - NOTOP = 335, - ASSIGNOP = 336, - PERLY_QUESTION_MARK = 337, - PERLY_COLON = 338, - OROR = 339, - DORDOR = 340, - ANDAND = 341, - BITOROP = 342, - BITANDOP = 343, - CHEQOP = 344, - NCEQOP = 345, - CHRELOP = 346, - NCRELOP = 347, - SHIFTOP = 348, - MATCHOP = 349, - PERLY_EXCLAMATION_MARK = 350, - PERLY_TILDE = 351, - UMINUS = 352, - REFGEN = 353, - POWOP = 354, - PREINC = 355, - PREDEC = 356, - POSTINC = 357, - POSTDEC = 358, - POSTJOIN = 359, - ARROW = 360 + PERLY_PERCENT_SIGN = 274, + PERLY_PLUS = 275, + PERLY_SEMICOLON = 276, + PERLY_SNAIL = 277, + BAREWORD = 278, + METHOD = 279, + FUNCMETH = 280, + THING = 281, + PMFUNC = 282, + PRIVATEREF = 283, + QWLIST = 284, + FUNC0OP = 285, + FUNC0SUB = 286, + UNIOPSUB = 287, + LSTOPSUB = 288, + PLUGEXPR = 289, + PLUGSTMT = 290, + LABEL = 291, + FORMAT = 292, + SUB = 293, + SIGSUB = 294, + ANONSUB = 295, + ANON_SIGSUB = 296, + PACKAGE = 297, + USE = 298, + WHILE = 299, + UNTIL = 300, + IF = 301, + UNLESS = 302, + ELSE = 303, + ELSIF = 304, + CONTINUE = 305, + FOR = 306, + GIVEN = 307, + WHEN = 308, + DEFAULT = 309, + LOOPEX = 310, + DOTDOT = 311, + YADAYADA = 312, + FUNC0 = 313, + FUNC1 = 314, + FUNC = 315, + UNIOP = 316, + LSTOP = 317, + MULOP = 318, + ADDOP = 319, + DOLSHARP = 320, + DO = 321, + HASHBRACK = 322, + NOAMP = 323, + LOCAL = 324, + MY = 325, + REQUIRE = 326, + COLONATTR = 327, + FORMLBRACK = 328, + FORMRBRACK = 329, + SUBLEXSTART = 330, + SUBLEXEND = 331, + PREC_LOW = 332, + OROP = 333, + DOROP = 334, + ANDOP = 335, + NOTOP = 336, + ASSIGNOP = 337, + PERLY_QUESTION_MARK = 338, + PERLY_COLON = 339, + OROR = 340, + DORDOR = 341, + ANDAND = 342, + BITOROP = 343, + BITANDOP = 344, + CHEQOP = 345, + NCEQOP = 346, + CHRELOP = 347, + NCRELOP = 348, + SHIFTOP = 349, + MATCHOP = 350, + PERLY_EXCLAMATION_MARK = 351, + PERLY_TILDE = 352, + UMINUS = 353, + REFGEN = 354, + POWOP = 355, + PREINC = 356, + PREDEC = 357, + POSTINC = 358, + POSTDEC = 359, + POSTJOIN = 360, + ARROW = 361 }; #endif @@ -210,6 +211,6 @@ int yyparse (void); /* Generated from: - * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y + * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index e0fa362f6792..e2acb0a82545 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3149 +#define YYLAST 3111 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 360 +#define YYMAXUTOK 361 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,7 +33,7 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 109, 10, 2, 2, + 2, 2, 2, 2, 2, 2, 109, 2, 2, 2, 108, 107, 110, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -56,17 +56,17 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 3, 4, - 5, 6, 7, 8, 9, 11, 12, 13, 14, 15, - 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, - 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, - 56, 57, 58, 59, 60, 61, 62, 63, 64, 65, - 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, - 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, - 96, 97, 98, 99, 100, 101, 102, 103, 104, 105, - 106 + 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, + 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, + 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, + 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, + 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, + 105, 106 }; #if YYDEBUG @@ -112,40 +112,40 @@ static const yytype_int16 yyrline[] = static const char *const yytname[] = { "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", - "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "'%'", + "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", - "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PLUS", "PERLY_SEMICOLON", - "PERLY_SNAIL", "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", - "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", - "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", - "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", - "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", - "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", - "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", - "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", - "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", - "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", - "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", - "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", - "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", - "ARROW", "')'", "'('", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", - "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", - "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", - "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", - "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", - "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", - "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", - "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", - "listexpr", "listop", "@16", "method", "subscripted", "termbinop", - "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", - "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", - "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", - "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", - "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PERCENT_SIGN", "PERLY_PLUS", + "PERLY_SEMICOLON", "PERLY_SNAIL", "BAREWORD", "METHOD", "FUNCMETH", + "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", + "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", + "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", + "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", + "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", + "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", + "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", + "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", + "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", + "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", + "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", + "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", + "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", + "block", "formblock", "remember", "mblock", "mremember", "stmtseq", + "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", + "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", + "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", + "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", + "startformsub", "subname", "proto", "subattrlist", "myattrlist", + "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", + "sigscalarelem", "sigelem", "siglist", "siglistornull", + "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", + "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", + "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", + "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", + "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", + "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", + "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -155,21 +155,21 @@ static const char *const yytname[] = static const yytype_int16 yytoknum[] = { 0, 256, 257, 258, 259, 260, 261, 262, 263, 264, - 37, 265, 266, 267, 268, 269, 270, 271, 272, 273, - 274, 275, 276, 277, 278, 279, 280, 281, 282, 283, - 284, 285, 286, 287, 288, 289, 290, 291, 292, 293, - 294, 295, 296, 297, 298, 299, 300, 301, 302, 303, - 304, 305, 306, 307, 308, 309, 310, 311, 312, 313, - 314, 315, 316, 317, 318, 319, 320, 321, 322, 323, - 324, 325, 326, 327, 328, 329, 330, 331, 332, 333, - 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, - 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, - 354, 355, 356, 357, 358, 359, 360, 41, 40, 36, + 265, 266, 267, 268, 269, 270, 271, 272, 273, 274, + 275, 276, 277, 278, 279, 280, 281, 282, 283, 284, + 285, 286, 287, 288, 289, 290, 291, 292, 293, 294, + 295, 296, 297, 298, 299, 300, 301, 302, 303, 304, + 305, 306, 307, 308, 309, 310, 311, 312, 313, 314, + 315, 316, 317, 318, 319, 320, 321, 322, 323, 324, + 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, + 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, + 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, + 355, 356, 357, 358, 359, 360, 361, 41, 40, 36, 42, 47 }; # endif -#define YYPACT_NINF (-475) +#define YYPACT_NINF (-487) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -183,64 +183,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 1202, -475, -475, -475, -475, -475, -475, -475, 46, -475, - 2786, 41, 1412, 1319, -475, -475, -475, -475, 22, 22, - 1800, 2786, 2786, 22, -475, 22, 22, -475, -475, 50, - -51, -475, 2786, -475, -475, -475, -475, 2786, -41, -13, - -68, 1893, 1699, 22, 1893, 1986, 10, 2786, 25, 2786, - 2786, 2786, 2786, 2786, 2786, 2786, 2079, 22, 22, 82, - 103, -475, 3, -475, -18, 75, -9, 45, -475, -475, - -475, 2953, -475, -475, 64, 128, 159, 173, -475, 172, - 223, 226, 179, -475, -475, -475, -475, -475, -475, 10, - 10, 190, -475, 106, 119, 126, 141, 142, 146, 157, - 41, 247, 219, -475, 258, 1503, 1319, -475, -475, -475, - 575, -475, 8, 668, -475, -475, -475, -475, -475, -475, - -475, 99, 1198, 1198, -475, 2786, 165, 205, 2786, 175, - 291, 41, 257, 233, 2953, 199, 2180, 2786, 1699, -475, - 291, 477, 103, -475, 362, 2786, -475, -475, 291, 294, - 253, -475, -475, 2786, 291, 2879, 2281, 240, -475, -475, - -475, 291, 103, 1198, 1198, 1198, 487, 487, 305, 280, - -475, -475, 2786, 2786, 2786, 2786, 2786, 2786, 2382, -475, - -475, 2786, -475, -475, 2786, 2786, 2786, 2786, 2786, 2786, - 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, 2786, - 2786, 2786, -475, -475, -475, 80, 2483, 2786, 2786, 2786, - 2786, 2786, 2786, 2786, -475, 292, -475, -475, 297, -475, - -475, -475, -475, -475, 222, 0, -475, -475, 217, -475, - -475, -475, -475, 41, -475, -475, 2786, 2786, 2786, 2786, - 2786, 2786, -475, -475, -475, -475, -475, 302, 302, -475, - -475, -475, 313, -475, -475, -475, 2786, 2786, 131, -475, - -475, -475, 233, 314, -475, -475, -475, 381, 266, 237, - 2786, 103, -475, 340, -475, 2584, 1198, 240, 51, 91, - 252, -475, 427, 330, -475, 2786, 347, 286, 286, -475, - 2953, 289, 167, -475, 447, 291, 1025, 3043, 1298, 1211, - 2953, 2908, 653, 653, 746, 839, 932, 1025, 1025, 291, - 291, 1118, 1198, 1198, 260, 265, 2786, 2786, 272, -475, - 279, 2685, 48, 288, 282, -475, -475, 471, 301, 178, - 322, 181, 350, 192, 400, 761, -475, 385, -475, -475, - 138, 382, 2786, 2786, 2786, 2786, -475, 295, -475, -475, - 303, -475, -475, -475, -475, 1505, 29, -475, 2786, 2786, - -475, -475, 82, -475, 82, -475, -475, -475, -475, -475, - 332, 332, 8, 310, 7, -475, 2786, -475, -475, 311, - -475, -475, -475, -475, 574, -475, 11, 579, -475, -475, - -475, 224, 2786, 407, -475, -475, 2786, -475, -475, 437, - 238, -475, -475, -475, 672, -475, -475, 2786, -475, 409, - -475, 410, -475, 420, -475, 421, -475, -475, -475, 257, - 233, -475, -475, 412, 336, 82, 356, 357, 82, 368, - 329, -475, -475, -475, -475, 369, 460, 467, -475, 2786, - 375, 383, 2786, -475, -475, -475, -475, 2786, 413, -475, - 482, -475, -475, 483, -475, -475, 17, -475, 248, -475, - 2998, 484, -475, -475, 392, -475, -475, -475, -475, 479, - 233, 480, -475, 2786, -475, -475, 492, 492, 2786, 2786, - 492, -475, 402, 401, 492, 492, 2953, 82, -475, -475, - 422, -475, -475, -475, -475, 445, 510, -475, -475, -475, - -475, 511, 492, 492, -475, 58, 58, 428, 429, 219, - 2786, 2786, 492, -475, -475, 854, -475, 947, -475, -475, - -475, -475, 1040, -475, 219, 219, -475, 492, 430, -475, - -475, 492, 492, -475, 518, 436, 219, -475, -475, 15, - -475, -475, -475, 1133, -475, 2786, 219, 219, -475, 492, - -475, 531, 485, -475, -475, 466, -475, -475, -475, 219, - -475, -475, -475, 492, 1598, -475, 1226, 58, 472, -475, - -475, 492, -475 + 1117, -487, -487, -487, -487, -487, -487, -487, 27, -487, + 2722, 38, 1420, 1327, -487, -487, -487, -487, 10, 1792, + 2722, 10, 2722, 10, -487, 10, 10, -487, -487, 26, + -46, -487, 2722, -487, -487, -487, -487, 2722, -33, -18, + -41, 1885, 1699, 10, 1885, 1978, 13, 2722, 28, 2722, + 2722, 2722, 2722, 2722, 2722, 2722, 2071, 10, 10, 108, + 56, -487, -4, -487, 22, 7, 48, 19, -487, -487, + -487, 2915, -487, -487, 33, 94, 138, 162, -487, 91, + 171, 234, 156, -487, -487, -487, -487, -487, -487, 13, + 13, 169, -487, 71, 119, 126, 132, 324, 136, 142, + 38, 243, 218, -487, 252, 433, 1327, -487, -487, -487, + 583, -487, 23, 676, -487, -487, -487, -487, -487, -487, + -6, 401, -487, 401, -487, 2722, 167, 237, 2722, 211, + 429, 38, 301, 260, 2915, 226, 2164, 2722, 1699, -487, + 429, 475, 56, -487, 362, 2722, -487, -487, 429, 336, + 245, -487, -487, 2722, 429, 2815, 2257, 285, -487, -487, + -487, 429, 56, 401, 401, 401, 282, 282, 348, 131, + -487, -487, 2722, 2722, 2722, 2722, 2722, 2722, 2350, -487, + -487, 2722, -487, -487, 2722, 2722, 2722, 2722, 2722, 2722, + 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, + 2722, 2722, -487, -487, -487, 250, 2443, 2722, 2722, 2722, + 2722, 2722, 2722, 2722, -487, 347, -487, -487, 351, -487, + -487, -487, -487, -487, 279, 9, -487, -487, 281, -487, + -487, -487, -487, 38, -487, -487, 2722, 2722, 2722, 2722, + 2722, 2722, -487, -487, -487, -487, -487, 364, 364, -487, + -487, -487, 378, -487, -487, -487, 2722, 2722, 18, -487, + -487, -487, 260, 372, -487, -487, -487, 202, 334, 293, + 2722, 56, -487, 399, -487, 2536, 401, 285, 40, 45, + 52, -487, 380, 391, -487, 2722, 406, 344, 344, -487, + 2915, 262, 81, -487, 436, 429, 940, 3005, 1120, 90, + 2915, 2870, 568, 568, 661, 754, 847, 940, 940, 429, + 429, 1033, 401, 401, 327, 2722, 2722, 333, 353, -487, + 354, 2629, 12, 366, 326, -487, -487, 469, 289, 128, + 317, 157, 325, 163, 342, 769, -487, 418, -487, -487, + 59, 438, 2722, 2722, 2722, 2722, -487, 373, -487, -487, + 377, -487, -487, -487, -487, 1513, 24, -487, 2722, 2722, + -487, -487, 108, -487, 108, -487, -487, -487, -487, -487, + 412, 412, 23, 374, 15, -487, 2722, -487, -487, 387, + -487, -487, -487, -487, 493, -487, 11, 1111, -487, -487, + -487, 177, 2722, 476, -487, -487, 2722, -487, 350, 251, + -487, -487, -487, -487, 1204, -487, -487, 2722, -487, 485, + -487, 486, -487, 488, -487, 496, -487, -487, -487, 301, + 260, -487, -487, 487, 410, 108, 411, 420, 108, 423, + 417, -487, -487, -487, -487, 434, 515, 275, -487, 2722, + 435, 439, 2722, -487, -487, -487, -487, 2722, 464, -487, + 539, -487, -487, 541, -487, -487, 31, -487, 265, -487, + 2960, 544, -487, -487, 467, -487, -487, -487, -487, 556, + 260, 564, -487, 2722, -487, -487, 580, 580, 2722, 2722, + 580, -487, 484, 490, 580, 580, 2915, 108, -487, -487, + 491, -487, -487, -487, -487, 521, 578, -487, -487, -487, + -487, 590, 580, 580, -487, 114, 114, 526, 532, 218, + 2722, 2722, 580, -487, -487, 862, -487, 955, -487, -487, + -487, -487, 1048, -487, 218, 218, -487, 580, 538, -487, + -487, 580, 580, -487, 626, 558, 218, -487, -487, 68, + -487, -487, -487, 1141, -487, 2722, 218, 218, -487, 580, + -487, 650, 594, -487, -487, 562, -487, -487, -487, 218, + -487, -487, -487, 580, 1606, -487, 1234, 114, 563, -487, + -487, 580, -487 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -259,8 +259,8 @@ static const yytype_int16 yydefact[] = 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 292, 295, 294, 293, 282, 279, - 196, 0, 186, 187, 281, 265, 0, 0, 0, 0, + 0, 15, 113, 0, 292, 295, 294, 293, 279, 196, + 0, 186, 282, 187, 281, 265, 0, 0, 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, @@ -279,7 +279,7 @@ static const yytype_int16 yydefact[] = 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 289, 0, 0, 0, 287, 144, + 175, 164, 173, 161, 0, 0, 0, 289, 287, 144, 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, @@ -287,8 +287,8 @@ static const yytype_int16 yydefact[] = 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, - 97, 0, 0, 0, 149, 155, 0, 232, 233, 0, - 0, 231, 284, 153, 0, 230, 234, 267, 228, 0, + 97, 0, 0, 0, 149, 155, 0, 233, 0, 0, + 232, 231, 284, 153, 0, 230, 234, 267, 228, 0, 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, @@ -311,16 +311,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -475, -475, -475, -475, -475, -475, -475, -475, -475, 43, - -475, -5, -139, -475, -17, -475, 539, 497, 9, -475, - -475, -475, -475, -475, -475, -475, -475, -475, 246, -341, - -474, 114, -459, -475, 115, 281, -303, 67, -475, -91, - 208, -475, 105, 228, -234, 371, 403, -475, -475, 278, - -475, 283, -475, -475, -475, -475, 210, -475, -475, 168, - -475, 194, -8, -37, -475, -475, -475, -475, -475, -475, - -475, -475, -475, -475, -475, -475, 100, -475, -475, 508, - -124, -129, -475, -475, 319, -475, -475, 441, 1, -45, - -42, -475, -475, -475, -475, -475, 54 + -487, -487, -487, -487, -487, -487, -487, -487, -487, 43, + -487, -5, 2417, -487, -17, -487, 662, 572, 5, -487, + -487, -487, -487, -487, -487, -487, -487, -487, 349, -341, + -486, -145, -465, -487, 173, 338, -333, 124, -487, -3, + 270, -487, 227, 271, -244, 427, 478, -487, -487, 361, + -487, 367, -487, -487, -487, -487, 288, -487, -487, 263, + -487, 277, -8, -37, -487, -487, -487, -487, -487, -487, + -487, -487, -487, -487, -487, -487, 103, -487, -487, 603, + -124, -122, -487, -487, 404, -487, -487, 537, 34, -45, + -42, -487, -487, -487, -487, -487, 228 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -343,168 +343,206 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 137, 268, 269, - 18, 19, 121, 162, 433, 176, 503, 177, 245, 117, - 117, 103, 23, 175, 117, 285, 117, 117, 377, 274, - 246, 392, 530, 151, 83, 18, 551, 150, 152, 18, - 138, 552, 429, 144, 117, 114, 16, 23, 169, 158, - 115, 23, 435, 83, 84, 440, 441, 129, 117, 117, - 83, 116, 116, 207, 128, 208, 116, 135, 116, 116, - 348, 114, 118, 119, 179, 180, 115, 124, 214, 125, - 126, 182, 183, -261, 139, 116, 116, 147, 142, -260, - 314, 315, 316, 570, 317, 136, 145, 146, 228, 564, - 116, 116, 318, -286, 319, -286, 527, 528, 271, 57, - 279, 178, 171, 280, 254, 243, 142, 247, 447, 175, - 258, 122, 123, -262, 155, 338, 339, 373, 267, 59, - 59, 57, 130, 156, 57, 184, 483, 134, 57, 144, - 207, 140, 208, 231, 148, 320, 375, 154, 282, 161, - 421, 163, 164, 165, 166, 167, 278, 57, 405, 422, - 172, 173, 174, -264, 287, 288, 289, 181, 291, 292, - 294, -286, 206, -286, 260, 507, 508, 172, 173, 174, - 353, 116, 394, 354, -290, -288, 471, -288, 321, 322, - 323, 213, 270, 410, 216, 217, 412, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 414, 535, 172, - 173, 174, 224, 218, 220, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 352, 221, 362, 364, - 362, 362, 362, 362, 222, 209, 496, 210, 211, 457, - 212, 225, 555, 132, 133, 172, 173, 174, 59, 223, - 226, 57, 449, 462, 229, 276, 172, 173, 174, 172, - 173, 174, 384, 492, -288, 230, -288, 387, 232, 233, - 172, 173, 174, 256, 273, 290, 360, 391, 464, 235, - 257, 295, 259, 261, 296, 297, 298, 299, 300, 301, - 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, 263, 265, 272, 399, 400, - 393, 353, 283, 404, 354, 336, 172, 173, 174, 285, - 340, 346, 409, 117, -263, 357, 172, 173, 174, 372, - 369, 172, 173, 174, 425, 364, 428, 428, 506, 142, - 378, 509, 382, 411, 383, 513, 514, 437, 431, 501, - 428, 428, 439, 385, 186, 187, 390, 352, 172, 173, - 174, 392, -215, 524, 525, 116, 174, 172, 173, 174, - 397, 413, 450, 536, 207, 398, 208, -215, -215, 172, - 173, 174, 401, -215, 458, 199, 200, 286, 544, 402, - 407, 201, 546, 547, 202, 203, 204, 205, 406, 59, - 172, 173, 174, 417, 57, 423, -215, -215, -215, -215, - 559, 432, 469, -215, 442, -215, 472, 446, -215, 452, - 459, 415, 465, 466, 567, -215, -215, 479, 172, 173, - 174, 428, 572, 467, 468, 473, 142, 478, -215, 487, - -215, -215, -215, 474, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -215, 461, 172, - 173, 174, -215, 475, 476, -215, -215, -215, -215, -215, - 428, 428, 515, -215, 517, 477, 480, -254, 172, 173, - 174, 481, 484, 522, 365, 366, 367, 368, 381, 488, - 485, 450, -254, -254, 489, 491, 460, 493, -254, 494, - 495, 497, 425, 428, 504, 172, 173, 174, 512, 543, - 511, 236, 237, 238, 239, 172, 173, 174, 240, 518, - 241, -254, -254, -254, -254, 172, 173, 174, -254, 516, - -254, 519, 523, -254, 389, 531, 532, 428, 545, 548, - -254, -254, 486, 549, 566, 172, 173, 174, 560, 172, - 173, 174, 107, -254, 395, -254, -254, -254, 561, -254, + 113, 255, 59, 159, 17, 142, 160, 176, 254, 177, + 503, 120, 429, 162, 433, 268, 269, 103, 377, 18, + 530, 83, 435, 83, 285, 440, 441, 16, 21, 274, + 175, 23, 375, 114, 137, 114, 151, 150, 115, 128, + 115, 152, 245, 21, 392, 246, 23, 21, 169, 83, + 23, 207, 117, 208, 84, 117, -286, 117, -286, 117, + 117, 116, 129, -288, 116, -288, 116, 138, 116, 116, + 421, 175, 172, 173, 174, 135, 144, 117, 214, 348, + 422, 570, 158, -261, 139, 116, 116, 147, 142, 551, + 136, 117, 117, 564, 552, 394, 172, 173, 174, 181, + 116, 116, -290, -260, 178, 207, 483, 208, 271, 184, + 279, 243, -262, 280, 179, 180, 142, -264, 57, 57, + 258, 57, 405, 121, -263, 123, 447, 155, 267, 59, + 59, 228, 247, 57, 373, 130, 156, 57, 182, 183, + 134, 206, 410, 231, 140, 507, 508, 148, 282, -286, + 154, -286, 161, 186, 163, 164, 165, 166, 167, 172, + 173, 174, 527, 528, 287, 288, 289, 213, 291, 292, + 294, 412, 144, -288, 260, -288, 471, 414, 535, 220, + 353, 116, 209, 354, 210, 200, 172, 173, 174, 278, + 201, 457, 218, 202, 203, 204, 205, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 172, 173, 174, 172, + 173, 174, 555, 338, 339, 342, 343, 344, 345, 347, + 374, 355, 356, 433, 358, 359, 496, 221, 362, 364, + 362, 362, 362, 362, 222, 172, 173, 174, 286, 325, + 223, 172, 173, 174, 229, 211, 118, 212, 59, 122, + 230, 124, 449, 125, 126, 172, 173, 174, 276, 352, + 314, 315, 384, 316, 232, 462, 273, 387, 233, 317, + 145, 146, 318, 235, 319, 256, 360, 391, 290, 492, + 172, 173, 174, 393, 295, 464, 171, 296, 297, 298, + 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, + 309, 310, 311, 312, 313, 132, 133, 398, 399, 381, + 409, 353, 257, 404, 354, 320, 216, 217, 259, 236, + 237, 238, 239, 172, 173, 174, 240, 261, 241, 172, + 173, 174, 263, 265, 425, 364, 428, 428, 411, 142, + 172, 173, 174, 172, 173, 174, 413, 437, 272, 501, + 428, 428, 439, 172, 173, 174, 117, 283, 321, 322, + 323, 285, -215, 415, 533, 116, 270, 172, 173, 174, + 336, 461, 450, 207, 340, 208, -215, -215, 346, 541, + 542, 431, -83, -215, 458, -291, -291, -291, 205, 357, + 352, 550, 369, 372, 224, 172, 173, 174, 378, 59, + 383, 556, 557, 172, 173, 174, -215, -215, -215, -215, + 382, 385, 469, -215, 565, -215, 472, 390, -215, 392, + 172, 173, 174, 225, 174, -215, -215, 479, 172, 173, + 174, 428, 226, 57, 407, 417, 142, 397, -215, 487, + -215, -215, -215, 400, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -215, -215, -215, -215, 172, 173, + 174, 423, -215, 401, 402, -215, -215, -215, -215, -215, + 428, 428, 515, -215, 517, -254, 406, 236, 237, 238, + 239, 446, 57, 522, 240, 432, 241, 389, 459, -254, + -254, 450, 186, 187, 442, 452, -254, 465, 466, 460, + 467, 201, 425, 428, 202, 203, 204, 205, 468, 543, + 473, 172, 173, 174, 172, 173, 174, 474, 475, -254, + -254, -254, -254, 199, 200, 478, -254, 476, -254, 201, + 477, -254, 202, 203, 204, 205, 481, 428, -254, -254, + 488, 480, 484, 395, 566, 486, 485, 172, 173, 174, + 489, -254, 491, -254, -254, -254, 493, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, 563, -83, -13, 85, -254, 408, 571, - -254, -254, -254, -254, -254, 18, 19, 83, -254, 20, - -291, -291, -291, 205, 21, 22, 86, 23, 24, 25, - 26, 27, 28, 242, 29, 30, 31, 32, 33, 34, + -254, 172, 173, 174, 494, -254, 408, 495, -254, -254, + -254, -254, -254, -13, 85, 497, -254, 365, 366, 367, + 368, 504, 511, 18, 83, 518, 19, 512, 516, 519, + 455, 20, 21, 22, 86, 23, 24, 25, 26, 27, + 28, 523, 29, 30, 31, 32, 33, 34, 87, 106, + 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, + 96, 186, 187, 531, 97, 98, 99, 100, 37, 532, + 101, 38, 39, 40, 41, 42, 545, 548, 43, 44, + 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 50, 549, 560, 561, 201, 563, + 571, 202, 203, 204, 205, 107, -3, 85, 242, 51, + 52, 426, 53, 534, 54, 55, 18, 83, 568, 19, + 470, 56, 57, 58, 20, 21, 22, 86, 23, 24, + 25, 26, 27, 28, 388, 29, 30, 31, 32, 33, + 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, + 93, 94, 95, 96, 186, 187, 371, 97, 98, 99, + 100, 37, 444, 101, 38, 39, 40, 41, 42, 445, + 490, 43, 44, 45, 46, 47, 48, 49, 499, 193, + 194, 195, 196, 197, 198, 199, 200, 50, 277, 521, + 438, 201, 351, 0, 202, 203, 204, 205, 0, 0, + 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 83, 416, 19, 0, 56, 57, 58, 20, 21, 22, + 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, + 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, + 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, + 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, + 49, 0, 0, 194, 195, 196, 197, 198, 199, 200, + 50, 0, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 85, 0, 51, 52, 0, 53, 0, + 54, 55, 18, 83, 537, 19, 0, 56, 57, 58, + 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, + 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, + 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, + 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, + 46, 47, 48, 49, 0, 0, 0, 195, 196, 197, + 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 85, 0, 51, 52, + 0, 53, 0, 54, 55, 18, 83, 538, 19, 0, + 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, + 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, - 94, 95, 96, 533, 426, 534, 97, 98, 99, 100, - 37, 568, 101, 38, 39, 40, 41, 42, 541, 542, - 43, 44, 45, 46, 47, 48, 49, 470, 388, 444, - 550, 371, 172, 173, 174, 445, 50, 172, 173, 174, - 556, 557, 490, 277, 521, 499, 351, 0, -3, 85, - 0, 51, 52, 565, 53, 438, 54, 55, 18, 19, - 83, 455, 20, 56, 57, 58, 456, 21, 22, 86, + 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, + 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, + 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, + 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 83, + 540, 19, 0, 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 50, - 172, 173, 174, 201, 0, 0, 202, 203, 204, 205, + 1, 2, 3, 4, 5, 6, 7, 0, 200, 50, + 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, - 55, 18, 19, 83, 416, 20, 56, 57, 58, 463, + 55, 18, 83, 554, 19, 0, 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 186, - 187, 0, 97, 98, 99, 100, 37, 0, 101, 38, + 90, 35, 36, 91, 92, 93, 94, 95, 96, 172, + 173, 174, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 193, 194, 195, 196, 197, 198, - 199, 200, 50, 0, 0, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 85, 0, 51, 52, 0, - 53, 0, 54, 55, 18, 19, 83, 537, 20, 56, - 57, 58, 0, 21, 22, 86, 23, 24, 25, 26, + 47, 48, 49, 0, 0, 200, 0, 0, 456, 0, + 201, 0, 50, 202, 203, 204, 205, 0, 0, 0, + 0, 0, 0, 0, 0, 85, 0, 51, 52, 0, + 53, 0, 54, 55, 18, 83, 0, 19, 0, 56, + 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 186, 187, 0, 97, 98, 99, 100, 37, + 95, 96, 172, 173, 174, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 194, 195, - 196, 197, 198, 199, 200, 50, 0, 0, 0, 201, - 0, 0, 202, 203, 204, 205, 0, 0, 85, 0, - 51, 52, 0, 53, 0, 54, 55, 18, 19, 83, - 538, 20, 56, 57, 58, 0, 21, 22, 86, 23, + 44, 45, 46, 47, 48, 49, 0, 0, 569, 0, + 0, 463, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, + 51, 52, 0, 53, 0, 54, 55, 18, 83, 0, + 19, 0, 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, + 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 195, 196, 197, 198, 199, 200, 50, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, 55, - 18, 19, 83, 540, 20, 56, 57, 58, 0, 21, + 18, 83, 0, 19, 0, 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 106, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 186, 187, + 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, + 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 197, 198, 199, - 200, 50, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205, 0, 0, 85, 0, 51, 52, 0, 53, - 0, 54, 55, 18, 19, 83, 554, 20, 56, 57, - 58, 0, 21, 22, 86, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 87, 106, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 186, 187, 0, 97, 98, 99, 100, 37, 0, - 101, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 1, 2, 3, 4, 5, - 6, 7, 0, 200, 50, 0, 0, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 85, 0, 51, - 52, 0, 53, 0, 54, 55, 18, 19, 83, 0, - 20, 56, 57, 58, 0, 21, 22, 86, 23, 24, + 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 51, 52, 0, 53, + 0, 54, 55, 18, 0, 0, 19, 0, 56, 57, + 58, 20, 21, 22, -78, 23, 24, 25, 26, 27, + 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, + 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, + 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, + 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 85, 0, 51, + 52, 0, 53, 0, 54, 55, 18, 0, 0, 19, + 0, 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 186, 0, 0, 97, 98, 99, - 100, 37, 0, 101, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 201, 0, - 569, 202, 203, 204, 205, 0, 200, 50, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, - 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 83, 0, 20, 56, 57, 58, 0, 21, 22, - 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 0, 0, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, + 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, + 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, + 83, 0, 19, -78, 56, 57, 58, 20, 21, 22, + 0, 23, 141, 25, 26, 27, 28, 115, 29, 30, + 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, + 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 200, 0, 0, 0, 0, 201, 0, - 50, 202, 203, 204, 205, 0, 0, 0, 0, 0, - 0, 0, 0, 85, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 19, 83, 0, 20, 56, 57, 58, - 0, 21, 22, 86, 23, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 0, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 37, 0, 101, + 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, + 54, 55, 18, 0, 0, 19, 119, 56, 57, 58, + 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, + 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, + 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 85, 0, 51, 52, - 0, 53, 0, 54, 55, 18, 19, 0, 0, 20, - 56, 57, 58, 0, 21, 22, -78, 23, 24, 25, + 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, + 0, 53, 0, 54, 55, 18, 83, 0, 19, 0, + 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 236, 237, 238, - 239, 0, 0, 0, 240, 0, 241, 0, 0, 0, + 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 172, 173, 174, 0, 0, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 19, - 0, 0, 20, 56, 57, 58, 0, 21, 22, 0, + 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 18, 0, + 0, 19, 0, 56, 57, 58, 20, 21, 22, 149, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -513,18 +551,35 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 0, 0, 0, 0, -78, 56, 57, 58, 18, - 19, 83, 0, 20, 0, 0, 0, 0, 21, 22, - 0, 23, 141, 25, 26, 27, 28, 115, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 0, 56, 57, 58, - 18, 19, 0, 0, 20, 120, 0, 0, 0, 21, + 55, 18, 0, 0, 19, 0, 56, 57, 58, 20, + 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, + 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, + 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, + 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, + 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, + 53, 0, 54, 55, 18, 0, 0, 19, 168, 56, + 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, + 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, + 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, + 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, + 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 52, 0, 53, 0, 54, 55, 18, 0, 0, + 19, 266, 56, 57, 58, 20, 21, 22, 0, 23, + 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, + 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, + 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, + 18, 0, 0, 19, 281, 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, @@ -533,8 +588,8 @@ static const yytype_int16 yytable[] = 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 18, 19, 83, 0, 20, 56, 57, - 58, 0, 21, 22, 0, 23, 24, 25, 26, 27, + 0, 54, 55, 18, 0, 0, 19, 293, 56, 57, + 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, @@ -542,8 +597,8 @@ static const yytype_int16 yytable[] = 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 18, 19, 0, 0, - 20, 56, 57, 58, 0, 21, 22, 149, 23, 24, + 52, 0, 53, 0, 54, 55, 18, 0, 0, 19, + 326, 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -552,7 +607,7 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 0, 0, 20, 56, 57, 58, 0, 21, 22, + 0, 0, 19, 386, 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, @@ -561,29 +616,8 @@ static const yytype_int16 yytable[] = 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 168, 56, 57, 58, - 18, 19, 0, 0, 20, 0, 0, 0, 0, 21, - 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 0, 0, 0, 0, 266, 56, 57, - 58, 18, 19, 0, 0, 20, 0, 0, 0, 0, - 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 0, 0, 0, 0, 281, 56, - 57, 58, 18, 19, 0, 0, 20, 0, 0, 0, - 0, 21, 22, 0, 23, 24, 25, 26, 27, 28, + 54, 55, 18, 0, 0, 19, 403, 56, 57, 58, + 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, @@ -591,239 +625,240 @@ static const yytype_int16 yytable[] = 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 0, 0, 0, 0, 293, - 56, 57, 58, 18, 19, 0, 0, 20, 0, 0, - 0, 0, 21, 22, 0, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 0, 0, 0, 0, - 326, 56, 57, 58, 18, 19, 0, 0, 20, 0, - 0, 0, 0, 21, 22, 0, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 0, 0, 0, - 0, 386, 56, 57, 58, 18, 19, 0, 0, 20, - 0, 0, 0, 0, 21, 22, 0, 23, 24, 25, + 0, 53, 0, 54, 55, 18, 0, 0, 19, 0, + 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 0, - 0, 0, 403, 56, 57, 58, 18, 19, 0, 0, - 20, 0, 0, 0, 0, 21, 22, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 19, 0, 0, 20, 56, 57, 58, 0, 21, 22, - 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 185, 0, 0, 0, 0, 0, - 0, 186, 187, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 0, 0, 0, 0, 0, 275, 57, 58, - 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 0, 0, 0, 0, 506, 0, 50, 509, 0, 0, + 0, 513, 514, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 52, 0, 53, 0, 54, 55, 0, 524, + 525, 0, 0, 275, 57, 58, 185, 0, 0, 536, + 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 544, 0, 0, 0, 546, 547, + 0, 0, 188, 189, 396, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 559, 0, 0, 0, + 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, + 567, 0, 0, 0, 0, 0, 0, 0, 572, 0, + 0, 0, 0, 0, 0, 0, 0, 188, 189, 0, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, + 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, - 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 189, 0, 190, 191, 192, 193, 194, + 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, + 201, -291, 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 189, 0, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, -291, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, 0, 0, 202, 203, 204, 205 + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 0, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 75, 137, 138, - 10, 11, 20, 50, 355, 12, 475, 14, 10, 18, - 19, 12, 22, 16, 23, 14, 25, 26, 262, 153, - 22, 14, 506, 23, 12, 10, 21, 45, 28, 10, - 108, 26, 345, 42, 43, 23, 0, 22, 56, 48, - 28, 22, 355, 12, 11, 358, 359, 108, 57, 58, - 12, 18, 19, 12, 14, 14, 23, 108, 25, 26, - 70, 23, 18, 19, 92, 93, 28, 23, 83, 25, - 26, 90, 91, 72, 41, 42, 43, 44, 125, 72, - 10, 11, 12, 567, 14, 108, 42, 43, 97, 558, - 57, 58, 22, 12, 24, 14, 48, 49, 145, 109, - 155, 108, 58, 155, 15, 106, 153, 109, 111, 16, - 128, 21, 22, 72, 99, 216, 217, 256, 136, 137, - 138, 109, 32, 108, 109, 90, 439, 37, 109, 138, - 12, 41, 14, 100, 44, 65, 15, 47, 156, 49, - 12, 51, 52, 53, 54, 55, 155, 109, 110, 21, - 78, 79, 80, 72, 172, 173, 174, 92, 176, 177, - 178, 12, 108, 14, 131, 478, 479, 78, 79, 80, - 225, 138, 15, 225, 12, 12, 420, 14, 108, 109, - 110, 12, 138, 15, 89, 90, 15, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 15, 511, 78, - 79, 80, 70, 23, 108, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 225, 108, 236, 237, - 238, 239, 240, 241, 108, 12, 470, 14, 12, 15, - 14, 99, 545, 35, 36, 78, 79, 80, 256, 108, - 108, 109, 376, 15, 108, 155, 78, 79, 80, 78, - 79, 80, 270, 15, 12, 108, 14, 275, 21, 50, - 78, 79, 80, 108, 21, 175, 233, 285, 407, 21, - 75, 181, 107, 26, 184, 185, 186, 187, 188, 189, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 78, 79, 80, 72, 107, 13, 316, 317, - 21, 356, 72, 321, 356, 23, 78, 79, 80, 14, - 23, 99, 21, 322, 72, 108, 78, 79, 80, 16, - 28, 78, 79, 80, 342, 343, 344, 345, 477, 376, - 26, 480, 76, 21, 107, 484, 485, 355, 347, 473, - 358, 359, 357, 13, 63, 64, 26, 356, 78, 79, - 80, 14, 0, 502, 503, 322, 80, 78, 79, 80, - 110, 21, 377, 512, 12, 110, 14, 15, 16, 78, - 79, 80, 110, 21, 392, 94, 95, 107, 527, 110, - 108, 100, 531, 532, 103, 104, 105, 106, 110, 407, - 78, 79, 80, 18, 109, 23, 44, 45, 46, 47, - 549, 108, 417, 51, 82, 53, 421, 107, 56, 108, - 13, 21, 13, 13, 563, 63, 64, 432, 78, 79, - 80, 439, 571, 13, 13, 23, 473, 108, 76, 447, - 78, 79, 80, 107, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 21, 78, - 79, 80, 100, 107, 107, 103, 104, 105, 106, 107, - 478, 479, 489, 111, 491, 107, 107, 0, 78, 79, - 80, 21, 107, 500, 238, 239, 240, 241, 107, 76, - 107, 496, 15, 16, 12, 12, 396, 13, 21, 107, - 21, 21, 510, 511, 12, 78, 79, 80, 107, 526, - 108, 44, 45, 46, 47, 78, 79, 80, 51, 74, - 53, 44, 45, 46, 47, 78, 79, 80, 51, 107, - 53, 21, 21, 56, 107, 107, 107, 545, 108, 21, - 63, 64, 442, 107, 561, 78, 79, 80, 17, 78, - 79, 80, 13, 76, 107, 78, 79, 80, 73, 82, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 107, 107, 0, 1, 100, 107, 107, - 103, 104, 105, 106, 107, 10, 11, 12, 111, 14, - 103, 104, 105, 106, 19, 20, 21, 22, 23, 24, - 25, 26, 27, 106, 29, 30, 31, 32, 33, 34, + 17, 125, 10, 48, 9, 42, 48, 11, 14, 13, + 475, 19, 345, 50, 355, 137, 138, 12, 262, 10, + 506, 11, 355, 11, 13, 358, 359, 0, 19, 153, + 15, 22, 14, 23, 75, 23, 23, 45, 28, 13, + 28, 28, 19, 19, 13, 22, 22, 19, 56, 11, + 22, 11, 18, 13, 11, 21, 11, 23, 13, 25, + 26, 18, 108, 11, 21, 13, 23, 108, 25, 26, + 11, 15, 78, 79, 80, 108, 42, 43, 83, 70, + 21, 567, 48, 72, 41, 42, 43, 44, 125, 21, + 108, 57, 58, 558, 26, 14, 78, 79, 80, 92, + 57, 58, 11, 72, 108, 11, 439, 13, 145, 90, + 155, 106, 72, 155, 92, 93, 153, 72, 109, 109, + 128, 109, 110, 20, 72, 22, 111, 99, 136, 137, + 138, 97, 109, 109, 256, 32, 108, 109, 90, 91, + 37, 108, 14, 100, 41, 478, 479, 44, 156, 11, + 47, 13, 49, 63, 51, 52, 53, 54, 55, 78, + 79, 80, 48, 49, 172, 173, 174, 11, 176, 177, + 178, 14, 138, 11, 131, 13, 420, 14, 511, 108, + 225, 138, 11, 225, 13, 95, 78, 79, 80, 155, + 100, 14, 23, 103, 104, 105, 106, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 78, 79, 80, 78, + 79, 80, 545, 216, 217, 220, 221, 222, 223, 224, + 257, 226, 227, 564, 229, 230, 470, 108, 236, 237, + 238, 239, 240, 241, 108, 78, 79, 80, 107, 205, + 108, 78, 79, 80, 108, 11, 18, 13, 256, 21, + 108, 23, 376, 25, 26, 78, 79, 80, 155, 225, + 10, 11, 270, 13, 21, 14, 21, 275, 50, 19, + 42, 43, 22, 21, 24, 108, 233, 285, 175, 14, + 78, 79, 80, 21, 181, 407, 58, 184, 185, 186, + 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 201, 35, 36, 315, 316, 107, + 21, 356, 75, 321, 356, 65, 89, 90, 107, 44, + 45, 46, 47, 78, 79, 80, 51, 26, 53, 78, + 79, 80, 72, 107, 342, 343, 344, 345, 21, 376, + 78, 79, 80, 78, 79, 80, 21, 355, 12, 473, + 358, 359, 357, 78, 79, 80, 322, 72, 108, 109, + 110, 13, 0, 21, 509, 322, 138, 78, 79, 80, + 23, 21, 377, 11, 23, 13, 14, 15, 99, 524, + 525, 347, 107, 21, 392, 103, 104, 105, 106, 108, + 356, 536, 28, 15, 70, 78, 79, 80, 26, 407, + 107, 546, 547, 78, 79, 80, 44, 45, 46, 47, + 76, 12, 417, 51, 559, 53, 421, 26, 56, 13, + 78, 79, 80, 99, 80, 63, 64, 432, 78, 79, + 80, 439, 108, 109, 108, 17, 473, 110, 76, 447, + 78, 79, 80, 110, 82, 83, 84, 85, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 78, 79, + 80, 23, 100, 110, 110, 103, 104, 105, 106, 107, + 478, 479, 489, 111, 491, 0, 110, 44, 45, 46, + 47, 107, 109, 500, 51, 108, 53, 107, 12, 14, + 15, 496, 63, 64, 82, 108, 21, 12, 12, 396, + 12, 100, 510, 511, 103, 104, 105, 106, 12, 526, + 23, 78, 79, 80, 78, 79, 80, 107, 107, 44, + 45, 46, 47, 94, 95, 108, 51, 107, 53, 100, + 107, 56, 103, 104, 105, 106, 21, 545, 63, 64, + 76, 107, 107, 107, 561, 442, 107, 78, 79, 80, + 11, 76, 11, 78, 79, 80, 12, 82, 83, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 78, 79, 80, 107, 100, 107, 21, 103, 104, + 105, 106, 107, 0, 1, 21, 111, 238, 239, 240, + 241, 11, 108, 10, 11, 74, 13, 107, 107, 21, + 107, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 21, 29, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 63, 64, 107, 51, 52, 53, 54, 55, 107, + 57, 58, 59, 60, 61, 62, 108, 21, 65, 66, + 67, 68, 69, 70, 71, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 81, 107, 16, 73, 100, 107, + 107, 103, 104, 105, 106, 13, 0, 1, 106, 96, + 97, 343, 99, 510, 101, 102, 10, 11, 564, 13, + 419, 108, 109, 110, 18, 19, 20, 21, 22, 23, + 24, 25, 26, 27, 277, 29, 30, 31, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 63, 64, 248, 51, 52, 53, + 54, 55, 371, 57, 58, 59, 60, 61, 62, 372, + 452, 65, 66, 67, 68, 69, 70, 71, 471, 88, + 89, 90, 91, 92, 93, 94, 95, 81, 155, 496, + 356, 100, 225, -1, 103, 104, 105, 106, -1, -1, + 1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, 12, 13, -1, 108, 109, 110, 18, 19, 20, + 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, + 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, + 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, + 71, -1, -1, 89, 90, 91, 92, 93, 94, 95, + 81, -1, -1, -1, 100, -1, -1, 103, 104, 105, + 106, -1, -1, 1, -1, 96, 97, -1, 99, -1, + 101, 102, 10, 11, 12, 13, -1, 108, 109, 110, + 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, + 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, + 68, 69, 70, 71, -1, -1, -1, 90, 91, 92, + 93, 94, 95, 81, -1, -1, -1, 100, -1, -1, + 103, 104, 105, 106, -1, -1, 1, -1, 96, 97, + -1, 99, -1, 101, 102, 10, 11, 12, 13, -1, + 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 509, 343, 510, 51, 52, 53, 54, - 55, 564, 57, 58, 59, 60, 61, 62, 524, 525, - 65, 66, 67, 68, 69, 70, 71, 419, 277, 371, - 536, 248, 78, 79, 80, 372, 81, 78, 79, 80, - 546, 547, 452, 155, 496, 471, 225, -1, 0, 1, - -1, 96, 97, 559, 99, 356, 101, 102, 10, 11, - 12, 107, 14, 108, 109, 110, 107, 19, 20, 21, + 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, + 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, + 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, + -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, + 100, -1, -1, 103, 104, 105, 106, -1, -1, 1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, + 12, 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 81, - 78, 79, 80, 100, -1, -1, 103, 104, 105, 106, + 3, 4, 5, 6, 7, 8, 9, -1, 95, 81, + -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, - 102, 10, 11, 12, 13, 14, 108, 109, 110, 107, + 102, 10, 11, 12, 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 63, - 64, -1, 51, 52, 53, 54, 55, -1, 57, 58, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 78, + 79, 80, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, 88, 89, 90, 91, 92, 93, - 94, 95, 81, -1, -1, -1, 100, -1, -1, 103, - 104, 105, 106, -1, -1, 1, -1, 96, 97, -1, - 99, -1, 101, 102, 10, 11, 12, 13, 14, 108, - 109, 110, -1, 19, 20, 21, 22, 23, 24, 25, + 69, 70, 71, -1, -1, 95, -1, -1, 107, -1, + 100, -1, 81, 103, 104, 105, 106, -1, -1, -1, + -1, -1, -1, -1, -1, 1, -1, 96, 97, -1, + 99, -1, 101, 102, 10, 11, -1, 13, -1, 108, + 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 63, 64, -1, 51, 52, 53, 54, 55, + 46, 47, 78, 79, 80, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, 89, 90, - 91, 92, 93, 94, 95, 81, -1, -1, -1, 100, - -1, -1, 103, 104, 105, 106, -1, -1, 1, -1, - 96, 97, -1, 99, -1, 101, 102, 10, 11, 12, - 13, 14, 108, 109, 110, -1, 19, 20, 21, 22, + 66, 67, 68, 69, 70, 71, -1, -1, 74, -1, + -1, 107, -1, -1, -1, 81, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, + 96, 97, -1, 99, -1, 101, 102, 10, 11, -1, + 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, 63, 64, -1, 51, 52, + 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, 90, 91, 92, 93, 94, 95, 81, -1, - -1, -1, 100, -1, -1, 103, 104, 105, 106, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, 102, - 10, 11, 12, 13, 14, 108, 109, 110, -1, 19, + 10, 11, -1, 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, 63, 64, + 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, 92, 93, 94, - 95, 81, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106, -1, -1, 1, -1, 96, 97, -1, 99, - -1, 101, 102, 10, 11, 12, 13, 14, 108, 109, - 110, -1, 19, 20, 21, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 63, 64, -1, 51, 52, 53, 54, 55, -1, - 57, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, 3, 4, 5, 6, 7, - 8, 9, -1, 95, 81, -1, -1, -1, 100, -1, - -1, 103, 104, 105, 106, -1, -1, 1, -1, 96, - 97, -1, 99, -1, 101, 102, 10, 11, 12, -1, - 14, 108, 109, 110, -1, 19, 20, 21, 22, 23, + 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 96, 97, -1, 99, + -1, 101, 102, 10, -1, -1, 13, -1, 108, 109, + 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, + -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, + -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, + 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 1, -1, 96, + 97, -1, 99, -1, 101, 102, 10, -1, -1, 13, + -1, 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 63, -1, -1, 51, 52, 53, - 54, 55, -1, 57, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, 100, -1, - 74, 103, 104, 105, 106, -1, 95, 81, -1, -1, - -1, 100, -1, -1, 103, 104, 105, 106, -1, -1, - 1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, 12, -1, 14, 108, 109, 110, -1, 19, 20, - 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, -1, -1, -1, - 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, + 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, + -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, + 11, -1, 13, 107, 108, 109, 110, 18, 19, 20, + -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, + 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, + 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, 95, -1, -1, -1, -1, 100, -1, - 81, 103, 104, 105, 106, -1, -1, -1, -1, -1, - -1, -1, -1, 1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, 11, 12, -1, 14, 108, 109, 110, - -1, 19, 20, 21, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, 35, -1, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - -1, -1, -1, 51, 52, 53, 54, 55, -1, 57, + 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, + 101, 102, 10, -1, -1, 13, 14, 108, 109, 110, + 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, + -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, + -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 1, -1, 96, 97, - -1, 99, -1, 101, 102, 10, 11, -1, -1, 14, - 108, 109, 110, -1, 19, 20, 21, 22, 23, 24, + -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, + -1, 99, -1, 101, 102, 10, 11, -1, 13, -1, + 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - -1, -1, -1, -1, -1, 40, 41, 44, 45, 46, - 47, -1, -1, -1, 51, -1, 53, -1, -1, -1, + -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, 78, 79, 80, -1, -1, 81, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, - -1, -1, 14, 108, 109, 110, -1, 19, 20, -1, + -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, 10, -1, + -1, 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -832,18 +867,35 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, -1, -1, -1, -1, 107, 108, 109, 110, 10, - 11, 12, -1, 14, -1, -1, -1, -1, 19, 20, - -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, - 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, - 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, - 10, 11, -1, -1, 14, 15, -1, -1, -1, 19, + 102, 10, -1, -1, 13, -1, 108, 109, 110, 18, + 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, + 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, + -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, + 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, + 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, + 99, -1, 101, 102, 10, -1, -1, 13, 107, 108, + 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, + 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, + -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, + -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, + 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 96, 97, -1, 99, -1, 101, 102, 10, -1, -1, + 13, 107, 108, 109, 110, 18, 19, 20, -1, 22, + 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, + -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, + 10, -1, -1, 13, 107, 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, @@ -852,8 +904,8 @@ static const yytype_int16 yycheck[] = 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 10, 11, 12, -1, 14, 108, 109, - 110, -1, 19, 20, -1, 22, 23, 24, 25, 26, + -1, 101, 102, 10, -1, -1, 13, 107, 108, 109, + 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, @@ -861,8 +913,8 @@ static const yytype_int16 yycheck[] = 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 10, 11, -1, -1, - 14, 108, 109, 110, -1, 19, 20, 21, 22, 23, + 97, -1, 99, -1, 101, 102, 10, -1, -1, 13, + 107, 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -871,7 +923,7 @@ static const yytype_int16 yycheck[] = -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, -1, -1, 14, 108, 109, 110, -1, 19, 20, + -1, -1, 13, 107, 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, @@ -880,29 +932,8 @@ static const yytype_int16 yycheck[] = 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, 107, 108, 109, 110, - 10, 11, -1, -1, 14, -1, -1, -1, -1, 19, - 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, - 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, - 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, -1, -1, -1, -1, 107, 108, 109, - 110, 10, 11, -1, -1, 14, -1, -1, -1, -1, - 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, - -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, -1, -1, -1, -1, 107, 108, - 109, 110, 10, 11, -1, -1, 14, -1, -1, -1, - -1, 19, 20, -1, 22, 23, 24, 25, 26, 27, + 101, 102, 10, -1, -1, 13, 107, 108, 109, 110, + 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, @@ -910,73 +941,36 @@ static const yytype_int16 yycheck[] = 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, -1, -1, -1, -1, 107, - 108, 109, 110, 10, 11, -1, -1, 14, -1, -1, - -1, -1, 19, 20, -1, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, - -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, - -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, -1, -1, -1, -1, - 107, 108, 109, 110, 10, 11, -1, -1, 14, -1, - -1, -1, -1, 19, 20, -1, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, - -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, - -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, -1, -1, -1, - -1, 107, 108, 109, 110, 10, 11, -1, -1, 14, - -1, -1, -1, -1, 19, 20, -1, 22, 23, 24, + -1, 99, -1, 101, 102, 10, -1, -1, 13, -1, + 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, -1, -1, - -1, -1, 107, 108, 109, 110, 10, 11, -1, -1, - 14, -1, -1, -1, -1, 19, 20, -1, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, -1, -1, 14, 108, 109, 110, -1, 19, 20, - -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, - 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, 56, -1, -1, -1, -1, -1, - -1, 63, 64, -1, -1, 96, 97, -1, 99, -1, - 101, 102, -1, -1, -1, -1, -1, 108, 109, 110, - 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, -1, -1, -1, -1, 100, 56, - -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, + -1, -1, -1, -1, 477, -1, 81, 480, -1, -1, + -1, 484, 485, -1, -1, -1, -1, -1, -1, -1, + -1, 96, 97, -1, 99, -1, 101, 102, -1, 502, + 503, -1, -1, 108, 109, 110, 56, -1, -1, 512, + -1, -1, -1, 63, 64, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 527, -1, -1, -1, 531, 532, + -1, -1, 82, 83, 84, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 549, -1, -1, -1, + 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, + 563, -1, -1, -1, -1, -1, -1, -1, 571, -1, + -1, -1, -1, -1, -1, -1, -1, 82, 83, -1, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, + 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 82, 83, -1, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, - -1, -1, -1, 100, 56, -1, 103, 104, 105, 106, - -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 83, -1, 85, 86, 87, 88, 89, + 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, + 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 83, -1, 85, 86, 87, 88, 89, 90, 91, - 92, 93, 94, 95, -1, -1, -1, -1, 100, 56, - -1, 103, 104, 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, -1, - -1, -1, -1, 100, -1, -1, 103, 104, 105, 106 + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, + 105, 106 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -984,62 +978,62 @@ static const yytype_int16 yycheck[] = static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 10, 11, - 14, 19, 20, 22, 23, 24, 25, 26, 27, 29, + 115, 116, 117, 118, 119, 120, 0, 123, 10, 13, + 18, 19, 20, 22, 23, 24, 25, 26, 27, 29, 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 12, 121, 1, 21, 35, 37, 38, + 205, 206, 207, 11, 121, 1, 21, 35, 37, 38, 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, - 126, 168, 169, 126, 23, 28, 121, 200, 208, 208, - 15, 174, 188, 188, 208, 208, 208, 189, 14, 108, + 126, 168, 169, 126, 23, 28, 121, 200, 208, 14, + 174, 188, 208, 188, 208, 208, 208, 189, 13, 108, 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, 188, 23, 175, 192, 200, 208, 208, 121, 188, 21, 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 78, 79, 80, 16, 12, 14, 108, 92, + 208, 208, 78, 79, 80, 15, 11, 13, 108, 92, 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 12, 14, 12, - 14, 12, 14, 12, 123, 153, 154, 154, 23, 151, + 95, 100, 103, 104, 105, 106, 108, 11, 13, 11, + 13, 11, 13, 11, 123, 153, 154, 154, 23, 151, 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, 108, 121, 21, 50, 143, 21, 44, 45, 46, 47, - 51, 53, 129, 130, 128, 10, 22, 109, 159, 160, - 162, 163, 164, 165, 15, 192, 108, 75, 174, 107, + 51, 53, 129, 130, 128, 19, 22, 109, 159, 160, + 162, 163, 164, 165, 14, 192, 108, 75, 174, 107, 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, - 208, 175, 13, 21, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 72, 157, 14, 107, 174, 174, 174, + 208, 175, 12, 21, 192, 108, 188, 191, 200, 201, + 202, 107, 174, 72, 157, 13, 107, 174, 174, 174, 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 12, 14, 22, 24, + 188, 188, 188, 188, 10, 11, 13, 19, 22, 24, 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, - 158, 158, 16, 193, 175, 15, 177, 156, 26, 123, - 173, 107, 76, 107, 174, 13, 107, 174, 157, 107, - 26, 174, 14, 21, 15, 107, 84, 110, 110, 174, - 174, 110, 110, 107, 174, 110, 110, 108, 107, 21, - 15, 21, 15, 21, 15, 21, 13, 18, 122, 131, - 132, 12, 21, 23, 146, 174, 147, 148, 174, 148, + 158, 158, 15, 193, 175, 14, 177, 156, 26, 123, + 173, 107, 76, 107, 174, 12, 107, 174, 157, 107, + 26, 174, 13, 21, 14, 107, 84, 110, 174, 174, + 110, 110, 110, 107, 174, 110, 110, 108, 107, 21, + 14, 21, 14, 21, 14, 21, 12, 17, 122, 131, + 132, 11, 21, 23, 146, 174, 147, 148, 174, 148, 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 15, 174, 13, - 188, 21, 15, 107, 193, 13, 13, 13, 13, 123, + 123, 171, 108, 166, 167, 107, 107, 14, 174, 12, + 188, 21, 14, 107, 193, 12, 12, 12, 12, 123, 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, - 107, 21, 136, 148, 107, 107, 188, 174, 76, 12, - 168, 12, 15, 13, 107, 21, 156, 21, 172, 173, - 137, 192, 144, 144, 12, 124, 124, 148, 148, 124, + 107, 21, 136, 148, 107, 107, 188, 174, 76, 11, + 168, 11, 14, 12, 107, 21, 156, 21, 172, 173, + 137, 192, 144, 144, 11, 124, 124, 148, 148, 124, 134, 108, 107, 124, 124, 126, 107, 126, 74, 21, 170, 171, 126, 21, 124, 124, 125, 48, 49, 142, - 142, 107, 107, 143, 146, 148, 124, 13, 13, 127, - 13, 143, 143, 126, 124, 108, 124, 124, 21, 107, - 143, 21, 26, 138, 13, 148, 143, 143, 135, 124, - 17, 73, 139, 107, 144, 143, 126, 124, 149, 74, + 142, 107, 107, 143, 146, 148, 124, 12, 12, 127, + 12, 143, 143, 126, 124, 108, 124, 124, 21, 107, + 143, 21, 26, 138, 12, 148, 143, 143, 135, 124, + 16, 73, 139, 107, 144, 143, 126, 124, 149, 74, 142, 107, 124 }; @@ -1121,43 +1115,43 @@ typedef enum { static const toketypes yy_type_tab[] = { toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 6987c13ecfd48ba93b1c8e7ab230ecce7e10a59e60fe854504796b6792e1c2cc perly.y + * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 21cb35c727b8..7d83819ad2b0 100644 --- a/perly.y +++ b/perly.y @@ -45,7 +45,6 @@ %token GRAMPROG GRAMEXPR GRAMBLOCK GRAMBARESTMT GRAMFULLSTMT GRAMSTMTSEQ GRAMSUBSIGNATURE -%token '%' %token PERLY_AMPERSAND %token PERLY_BRACE_OPEN %token PERLY_BRACE_CLOSE @@ -55,6 +54,7 @@ %token PERLY_DOT %token PERLY_EQUAL_SIGN %token PERLY_MINUS +%token PERLY_PERCENT_SIGN %token PERLY_PLUS %token PERLY_SEMICOLON %token PERLY_SNAIL @@ -661,7 +661,7 @@ sigvarname: /* NULL */ sigslurpsigil: PERLY_SNAIL { $$ = '@'; } - | '%' + | PERLY_PERCENT_SIGN { $$ = '%'; } /* @, %, @foo, %foo */ @@ -1249,7 +1249,7 @@ term[product] : termbinop { $$ = newSVREF($operand); } | term[operand] ARROW PERLY_SNAIL '*' { $$ = newAVREF($operand); } - | term[operand] ARROW '%' '*' + | term[operand] ARROW PERLY_PERCENT_SIGN '*' { $$ = newHVREF($operand); } | term[operand] ARROW PERLY_AMPERSAND '*' { $$ = newUNOP(OP_ENTERSUB, 0, @@ -1387,9 +1387,9 @@ ary : PERLY_SNAIL indirob } ; -hsh : '%' indirob +hsh : PERLY_PERCENT_SIGN indirob { $$ = newHVREF($indirob); - if ($$) $$->op_private |= $1; + if ($$) $$->op_private |= $PERLY_PERCENT_SIGN; } ; @@ -1409,7 +1409,7 @@ sliceme : ary ; kvslice : hsh - | term ARROW '%' + | term ARROW PERLY_PERCENT_SIGN { $$ = newHVREF($term); } ; diff --git a/toke.c b/toke.c index f95c47bc5e4f..26f763fd9e45 100644 --- a/toke.c +++ b/toke.c @@ -397,6 +397,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), DEBUG_TOKEN (IVAL, PERLY_MINUS), + DEBUG_TOKEN (IVAL, PERLY_PERCENT_SIGN), DEBUG_TOKEN (IVAL, PERLY_PLUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), @@ -2051,6 +2052,7 @@ S_postderef(pTHX_ int const funny, char const next) assert(funny == DOLSHARP || memCHRs("$@%&*", funny) || funny == PERLY_SNAIL + || funny == PERLY_PERCENT_SIGN || funny == PERLY_AMPERSAND ); if (next == '*') { @@ -2194,7 +2196,7 @@ S_force_ident(pTHX_ const char *s, int kind) : GV_ADD) | ( UTF ? SVf_UTF8 : 0 ), kind == '$' ? SVt_PV : kind == PERLY_SNAIL ? SVt_PVAV : - kind == '%' ? SVt_PVHV : + kind == PERLY_PERCENT_SIGN ? SVt_PVHV : SVt_PVGV ); } @@ -5006,6 +5008,7 @@ yyl_sigvar(pTHX_ char *s) switch (sigil) { case ',': TOKEN (PERLY_COMMA); case '@': TOKEN (PERLY_SNAIL); + case '%': TOKEN (PERLY_PERCENT_SIGN); default: TOKEN (sigil); } } @@ -5743,13 +5746,13 @@ yyl_percent(pTHX_ char *s) Mop(OP_MODULO); } else if (PL_expect == XPOSTDEREF) - POSTDEREF('%'); + POSTDEREF(PERLY_PERCENT_SIGN); PL_tokenbuf[0] = '%'; s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); pl_yylval.ival = 0; if (!PL_tokenbuf[1]) { - PREREF('%'); + PREREF(PERLY_PERCENT_SIGN); } if ( (PL_expect != XREF || PL_oldoldbufptr == PL_last_lop) && intuit_more(s, PL_bufend)) { @@ -5758,7 +5761,7 @@ yyl_percent(pTHX_ char *s) } PL_expect = XOPERATOR; force_ident_maybe_lex('%'); - TERM('%'); + TERM(PERLY_PERCENT_SIGN); } static int From ee67f2540868d78287befae45cd503f1cf44911a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:16 +0100 Subject: [PATCH 341/503] Distinguish C- and perly- literals - PERLY_PAREN_OPEN --- perly.act | 2 +- perly.h | 5 +-- perly.tab | 28 +++++++-------- perly.y | 100 +++++++++++++++++++++++++++--------------------------- toke.c | 9 ++--- 5 files changed, 73 insertions(+), 71 deletions(-) diff --git a/perly.act b/perly.act index c0dfdfcf14ee..0b4ef65084e3 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y + * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 4f6273df5c7c..8d33ddbe5feb 100644 --- a/perly.h +++ b/perly.h @@ -159,7 +159,8 @@ extern int yydebug; POSTINC = 358, POSTDEC = 359, POSTJOIN = 360, - ARROW = 361 + ARROW = 361, + PERLY_PAREN_OPEN = 362 }; #endif @@ -211,6 +212,6 @@ int yyparse (void); /* Generated from: - * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y + * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index e2acb0a82545..0585d58e6a93 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 361 +#define YYMAXUTOK 362 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -34,7 +34,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 109, 2, 2, 2, - 108, 107, 110, 2, 2, 2, 2, 111, 2, 2, + 2, 107, 110, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -66,7 +66,7 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106 + 105, 106, 108 }; #if YYDEBUG @@ -129,11 +129,11 @@ static const char *const yytname[] = "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "'('", "'$'", "'*'", - "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", - "block", "formblock", "remember", "mblock", "mremember", "stmtseq", - "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", - "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "PERLY_PAREN_OPEN", + "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", + "@6", "@7", "block", "formblock", "remember", "mblock", "mremember", + "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", + "$@9", "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", "startformsub", "subname", "proto", "subattrlist", "myattrlist", @@ -164,7 +164,7 @@ static const yytype_int16 yytoknum[] = 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, - 355, 356, 357, 358, 359, 360, 361, 41, 40, 36, + 355, 356, 357, 358, 359, 360, 361, 41, 362, 36, 42, 47 }; # endif @@ -1132,11 +1132,11 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1152,6 +1152,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * cdd9001d6b66b4ea7b642553e0efe64c82100abee9dfc3bb31d25c3d622e14ff perly.y + * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 7d83819ad2b0..5fa7f9ffee68 100644 --- a/perly.y +++ b/perly.y @@ -124,7 +124,7 @@ %nonassoc PREINC PREDEC POSTINC POSTDEC POSTJOIN %left ARROW %nonassoc ')' -%left '(' +%left PERLY_PAREN_OPEN %left PERLY_BRACKET_OPEN PERLY_BRACE_OPEN %% /* RULES */ @@ -361,42 +361,42 @@ barestmt: PLUGSTMT parser->parsed_sub = 1; $$ = NULL; } - | IF '(' remember mexpr ')' mblock else + | IF PERLY_PAREN_OPEN remember mexpr ')' mblock else { $$ = block_end($remember, newCONDOP(0, $mexpr, op_scope($mblock), $else)); parser->copline = (line_t)$IF; } - | UNLESS '(' remember mexpr ')' mblock else + | UNLESS PERLY_PAREN_OPEN remember mexpr ')' mblock else { $$ = block_end($remember, newCONDOP(0, $mexpr, $else, op_scope($mblock))); parser->copline = (line_t)$UNLESS; } - | GIVEN '(' remember mexpr ')' mblock + | GIVEN PERLY_PAREN_OPEN remember mexpr ')' mblock { $$ = block_end($remember, newGIVENOP($mexpr, op_scope($mblock), 0)); parser->copline = (line_t)$GIVEN; } - | WHEN '(' remember mexpr ')' mblock + | WHEN PERLY_PAREN_OPEN remember mexpr ')' mblock { $$ = block_end($remember, newWHENOP($mexpr, op_scope($mblock))); } | DEFAULT block { $$ = newWHENOP(0, op_scope($block)); } - | WHILE '(' remember texpr ')' mintro mblock cont + | WHILE PERLY_PAREN_OPEN remember texpr ')' mintro mblock cont { $$ = block_end($remember, newWHILEOP(0, 1, NULL, $texpr, $mblock, $cont, $mintro)); parser->copline = (line_t)$WHILE; } - | UNTIL '(' remember iexpr ')' mintro mblock cont + | UNTIL PERLY_PAREN_OPEN remember iexpr ')' mintro mblock cont { $$ = block_end($remember, newWHILEOP(0, 1, NULL, $iexpr, $mblock, $cont, $mintro)); parser->copline = (line_t)$UNTIL; } - | FOR '(' remember mnexpr[init_mnexpr] PERLY_SEMICOLON + | FOR PERLY_PAREN_OPEN remember mnexpr[init_mnexpr] PERLY_SEMICOLON { parser->expect = XTERM; } texpr PERLY_SEMICOLON { parser->expect = XTERM; } @@ -416,12 +416,12 @@ barestmt: PLUGSTMT $$ = block_end($remember, forop); parser->copline = (line_t)$FOR; } - | FOR MY remember my_scalar '(' mexpr ')' mblock cont + | FOR MY remember my_scalar PERLY_PAREN_OPEN mexpr ')' mblock cont { $$ = block_end($remember, newFOROP(0, $my_scalar, $mexpr, $mblock, $cont)); parser->copline = (line_t)$FOR; } - | FOR scalar '(' remember mexpr ')' mblock cont + | FOR scalar PERLY_PAREN_OPEN remember mexpr ')' mblock cont { $$ = block_end($remember, newFOROP(0, op_lvalue($scalar, OP_ENTERLOOP), $mexpr, $mblock, $cont)); @@ -429,7 +429,7 @@ barestmt: PLUGSTMT } | FOR my_refgen remember my_var { parser->in_my = 0; $$ = my($my_var); }[variable] - '(' mexpr ')' mblock cont + PERLY_PAREN_OPEN mexpr ')' mblock cont { $$ = block_end( $remember, @@ -442,7 +442,7 @@ barestmt: PLUGSTMT ); parser->copline = (line_t)$FOR; } - | FOR REFGEN refgen_topic '(' remember mexpr ')' mblock cont + | FOR REFGEN refgen_topic PERLY_PAREN_OPEN remember mexpr ')' mblock cont { $$ = block_end($remember, newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -450,7 +450,7 @@ barestmt: PLUGSTMT OP_ENTERLOOP), $mexpr, $mblock, $cont)); parser->copline = (line_t)$FOR; } - | FOR '(' remember mexpr ')' mblock cont + | FOR PERLY_PAREN_OPEN remember mexpr ')' mblock cont { $$ = block_end($remember, newFOROP(0, NULL, $mexpr, $mblock, $cont)); @@ -548,7 +548,7 @@ else : /* NULL */ ($mblock)->op_flags |= OPf_PARENS; $$ = op_scope($mblock); } - | ELSIF '(' mexpr ')' mblock else[else.recurse] + | ELSIF PERLY_PAREN_OPEN mexpr ')' mblock else[else.recurse] { parser->copline = (line_t)$ELSIF; $$ = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,$mexpr), @@ -790,7 +790,7 @@ optsubsignature: /* NULL */ { $$ = $subsignature; } /* Subroutine signature */ -subsignature: '(' subsigguts ')' +subsignature: PERLY_PAREN_OPEN subsigguts ')' { $$ = $subsigguts; } subsigguts: @@ -919,11 +919,11 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ { $$ = op_convert_list($LSTOP, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($LSTOP,$indirob), $listexpr) ); } - | FUNC '(' indirob expr ')' /* print ($fh @args */ + | FUNC PERLY_PAREN_OPEN indirob expr ')' /* print ($fh @args */ { $$ = op_convert_list($FUNC, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($FUNC,$indirob), $expr) ); } - | term ARROW method '(' optexpr ')' /* $foo->bar(list) */ + | term ARROW method PERLY_PAREN_OPEN optexpr ')' /* $foo->bar(list) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar($term), $optexpr), @@ -940,7 +940,7 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ op_prepend_elem(OP_LIST, $indirob, $optlistexpr), newMETHOP(OP_METHOD, 0, $METHOD))); } - | FUNCMETH indirob '(' optexpr ')' /* method $object (@args) */ + | FUNCMETH indirob PERLY_PAREN_OPEN optexpr ')' /* method $object (@args) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, $indirob, $optexpr), @@ -948,7 +948,7 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ } | LSTOP optlistexpr /* print @args */ { $$ = op_convert_list($LSTOP, 0, $optlistexpr); } - | FUNC '(' optexpr ')' /* print (@args) */ + | FUNC PERLY_PAREN_OPEN optexpr ')' /* print (@args) */ { $$ = op_convert_list($FUNC, 0, $optexpr); } | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ { $$ = op_convert_list($FUNC, 0, $optexpr); } @@ -996,13 +996,13 @@ subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } - | term[code_reference] ARROW '(' ')' /* $subref->() */ + | term[code_reference] ARROW PERLY_PAREN_OPEN ')' /* $subref->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | term[code_reference] ARROW '(' expr ')' /* $subref->(@args) */ + | term[code_reference] ARROW PERLY_PAREN_OPEN expr ')' /* $subref->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, newCVREF(0, scalar($code_reference)))); @@ -1010,24 +1010,24 @@ subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE parser->expect = XOPERATOR; } - | subscripted[code_reference] '(' expr ')' /* $foo->{bar}->(@args) */ + | subscripted[code_reference] PERLY_PAREN_OPEN expr ')' /* $foo->{bar}->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, newCVREF(0, scalar($code_reference)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | subscripted[code_reference] '(' ')' /* $foo->{bar}->() */ + | subscripted[code_reference] PERLY_PAREN_OPEN ')' /* $foo->{bar}->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | '(' expr[list] ')' PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ + | PERLY_PAREN_OPEN expr[list] ')' PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ { $$ = newSLICEOP(0, $slice, $list); } | QWLIST PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* list literal slice */ { $$ = newSLICEOP(0, $expr, $QWLIST); } - | '(' ')' PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ + | PERLY_PAREN_OPEN ')' PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ { $$ = newSLICEOP(0, $expr, NULL); } ; @@ -1138,14 +1138,14 @@ anonymous: PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE { $$ = newANONLIST($expr); } | PERLY_BRACKET_OPEN PERLY_BRACKET_CLOSE { $$ = newANONLIST(NULL);} - | HASHBRACK expr PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec '(' /* { foo => "Bar" } */ + | HASHBRACK expr PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec PERLY_PAREN_OPEN /* { foo => "Bar" } */ { $$ = newANONHASH($expr); } - | HASHBRACK PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec '(' /* { } (PERLY_SEMICOLON by tokener) */ + | HASHBRACK PERLY_SEMICOLON PERLY_BRACE_CLOSE %prec PERLY_PAREN_OPEN /* { } (PERLY_SEMICOLON by tokener) */ { $$ = newANONHASH(NULL); } - | ANONSUB startanonsub proto subattrlist subbody %prec '(' + | ANONSUB startanonsub proto subattrlist subbody %prec PERLY_PAREN_OPEN { SvREFCNT_inc_simple_void(PL_compcv); $$ = newANONATTRSUB($startanonsub, $proto, $subattrlist, $subbody); } - | ANON_SIGSUB startanonsub subattrlist sigsubbody %prec '(' + | ANON_SIGSUB startanonsub subattrlist sigsubbody %prec PERLY_PAREN_OPEN { SvREFCNT_inc_simple_void(PL_compcv); $$ = newANONATTRSUB($startanonsub, NULL, $subattrlist, $sigsubbody); } ; @@ -1153,7 +1153,7 @@ anonymous: PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* Things called with "do" */ termdo : DO term %prec UNIOP /* do $filename */ { $$ = dofile($term, $DO);} - | DO block %prec '(' /* do { code */ + | DO block %prec PERLY_PAREN_OPEN /* do { code */ { $$ = newUNOP(OP_NULL, OPf_SPECIAL, op_scope($block));} ; @@ -1171,21 +1171,21 @@ term[product] : termbinop { $$ = $myattrterm; } | LOCAL term[operand] %prec UNIOP { $$ = localize($operand,0); } - | '(' expr ')' + | PERLY_PAREN_OPEN expr ')' { $$ = sawparens($expr); } | QWLIST { $$ = $QWLIST; } - | '(' ')' + | PERLY_PAREN_OPEN ')' { $$ = sawparens(newNULLLIST()); } - | scalar %prec '(' + | scalar %prec PERLY_PAREN_OPEN { $$ = $scalar; } - | star %prec '(' + | star %prec PERLY_PAREN_OPEN { $$ = $star; } - | hsh %prec '(' + | hsh %prec PERLY_PAREN_OPEN { $$ = $hsh; } - | ary %prec '(' + | ary %prec PERLY_PAREN_OPEN { $$ = $ary; } - | arylen %prec '(' /* $#x, $#{ something } */ + | arylen %prec PERLY_PAREN_OPEN /* $#x, $#{ something } */ { $$ = newUNOP(OP_AV2ARYLEN, 0, ref($arylen, OP_AV2ARYLEN));} | subscripted { $$ = $subscripted; } @@ -1229,14 +1229,14 @@ term[product] : termbinop $$->op_private |= $kvslice->op_private & OPpSLICEWARNING; } - | THING %prec '(' + | THING %prec PERLY_PAREN_OPEN { $$ = $THING; } | amper /* &foo; */ { $$ = newUNOP(OP_ENTERSUB, 0, scalar($amper)); } - | amper '(' ')' /* &foo() or foo() */ + | amper PERLY_PAREN_OPEN ')' /* &foo() or foo() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($amper)); } - | amper '(' expr ')' /* &foo(@args) or foo(@args) */ + | amper PERLY_PAREN_OPEN expr ')' /* &foo(@args) or foo(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, scalar($amper))); @@ -1254,7 +1254,7 @@ term[product] : termbinop | term[operand] ARROW PERLY_AMPERSAND '*' { $$ = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF($PERLY_AMPERSAND,$operand))); } - | term[operand] ARROW '*' '*' %prec '(' + | term[operand] ARROW '*' '*' %prec PERLY_PAREN_OPEN { $$ = newGVREF(0,$operand); } | LOOPEX /* loop exiting command (goto, last, dump, etc) */ { $$ = newOP($LOOPEX, OPf_SPECIAL); @@ -1280,19 +1280,19 @@ term[product] : termbinop op_append_elem(OP_LIST, $operand, scalar($UNIOPSUB))); } | FUNC0 /* Nullary operator */ { $$ = newOP($FUNC0, 0); } - | FUNC0 '(' ')' + | FUNC0 PERLY_PAREN_OPEN ')' { $$ = newOP($FUNC0, 0);} | FUNC0OP /* Same as above, but op created in toke.c */ { $$ = $FUNC0OP; } - | FUNC0OP '(' ')' + | FUNC0OP PERLY_PAREN_OPEN ')' { $$ = $FUNC0OP; } | FUNC0SUB /* Sub treated as nullop */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($FUNC0SUB)); } - | FUNC1 '(' ')' /* not () */ + | FUNC1 PERLY_PAREN_OPEN ')' /* not () */ { $$ = ($FUNC1 == OP_NOT) ? newUNOP($FUNC1, 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP($FUNC1, OPf_SPECIAL); } - | FUNC1 '(' expr ')' /* not($foo) */ + | FUNC1 PERLY_PAREN_OPEN expr ')' /* not($foo) */ { $$ = newUNOP($FUNC1, 0, $expr); } | PMFUNC /* m//, s///, qr//, tr/// */ { @@ -1322,16 +1322,16 @@ myattrterm: MY myterm myattrlist ; /* Things that can be "my"'d */ -myterm : '(' expr ')' +myterm : PERLY_PAREN_OPEN expr ')' { $$ = sawparens($expr); } - | '(' ')' + | PERLY_PAREN_OPEN ')' { $$ = sawparens(newNULLLIST()); } - | scalar %prec '(' + | scalar %prec PERLY_PAREN_OPEN { $$ = $scalar; } - | hsh %prec '(' + | hsh %prec PERLY_PAREN_OPEN { $$ = $hsh; } - | ary %prec '(' + | ary %prec PERLY_PAREN_OPEN { $$ = $ary; } ; diff --git a/toke.c b/toke.c index 26f763fd9e45..4fcc45a1fff4 100644 --- a/toke.c +++ b/toke.c @@ -397,6 +397,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_EQUAL_SIGN), DEBUG_TOKEN (IVAL, PERLY_EXCLAMATION_MARK), DEBUG_TOKEN (IVAL, PERLY_MINUS), + DEBUG_TOKEN (IVAL, PERLY_PAREN_OPEN), DEBUG_TOKEN (IVAL, PERLY_PERCENT_SIGN), DEBUG_TOKEN (IVAL, PERLY_PLUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), @@ -2087,7 +2088,7 @@ Perl_yyunlex(pTHX) PL_lex_allbrackets--; PL_lex_brackets--; yyc |= (3<<24) | (PL_lex_brackstack[PL_lex_brackets] << 16); - } else if (yyc == '('/*)*/) { + } else if (yyc == PERLY_PAREN_OPEN) { PL_lex_allbrackets--; yyc |= (2<<24); } @@ -5396,7 +5397,7 @@ yyl_interpcasemod(pTHX_ char *s) PL_lex_casestack[PL_lex_casemods] = '\0'; PL_lex_state = LEX_INTERPCONCAT; NEXTVAL_NEXTTOKE.ival = 0; - force_next((2<<24)|'('); + force_next((2<<24)|PERLY_PAREN_OPEN); if (*s == 'l') NEXTVAL_NEXTTOKE.ival = OP_LCFIRST; else if (*s == 'u') @@ -6516,7 +6517,7 @@ yyl_leftparen(pTHX_ char *s) PL_expect = XTERM; s = skipspace(s); PL_lex_allbrackets++; - TOKEN('('); + TOKEN(PERLY_PAREN_OPEN); } static int @@ -9291,7 +9292,7 @@ Perl_yylex(pTHX) NEXTVAL_NEXTTOKE.ival = 0; force_next('$'); NEXTVAL_NEXTTOKE.ival = 0; - force_next((2<<24)|'('); + force_next((2<<24)|PERLY_PAREN_OPEN); NEXTVAL_NEXTTOKE.ival = OP_JOIN; /* emulate join($", ...) */ force_next(FUNC); } From 04884b684761ed5aea5bf4bb362f56cf963b41f5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:17 +0100 Subject: [PATCH 342/503] Distinguish C- and perly- literals - PERLY_PAREN_CLOSE --- perly.act | 2 +- perly.h | 5 ++-- perly.tab | 78 ++++++++++++++++++++++++++++--------------------------- perly.y | 70 ++++++++++++++++++++++++------------------------- toke.c | 11 ++++---- 5 files changed, 85 insertions(+), 81 deletions(-) diff --git a/perly.act b/perly.act index 0b4ef65084e3..afec8b500d65 100644 --- a/perly.act +++ b/perly.act @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y + * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 8d33ddbe5feb..75678f7d983f 100644 --- a/perly.h +++ b/perly.h @@ -160,7 +160,8 @@ extern int yydebug; POSTDEC = 359, POSTJOIN = 360, ARROW = 361, - PERLY_PAREN_OPEN = 362 + PERLY_PAREN_CLOSE = 362, + PERLY_PAREN_OPEN = 363 }; #endif @@ -212,6 +213,6 @@ int yyparse (void); /* Generated from: - * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y + * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 0585d58e6a93..462580cb7842 100644 --- a/perly.tab +++ b/perly.tab @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 362 +#define YYMAXUTOK 363 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -34,7 +34,7 @@ static const yytype_int8 yytranslate[] = 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 109, 2, 2, 2, - 2, 107, 110, 2, 2, 2, 2, 111, 2, 2, + 2, 2, 110, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -66,7 +66,7 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 108 + 105, 106, 107, 108 }; #if YYDEBUG @@ -129,23 +129,24 @@ static const char *const yytname[] = "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "')'", "PERLY_PAREN_OPEN", - "'$'", "'*'", "'/'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", - "@6", "@7", "block", "formblock", "remember", "mblock", "mremember", - "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", - "$@9", "$@10", "$@11", "$@12", "@13", "$@14", "formline", "formarg", - "condition", "sideff", "else", "cont", "mintro", "nexpr", "texpr", - "iexpr", "mexpr", "mnexpr", "formname", "startsub", "startanonsub", - "startformsub", "subname", "proto", "subattrlist", "myattrlist", - "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", - "sigscalarelem", "sigelem", "siglist", "siglistornull", - "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", - "subbody", "optsigsubbody", "sigsubbody", "expr", "listexpr", "listop", - "@16", "method", "subscripted", "termbinop", "termrelop", "relopchain", - "termeqop", "eqopchain", "termunop", "anonymous", "termdo", "term", - "@17", "myattrterm", "myterm", "optlistexpr", "optexpr", "optrepl", - "my_scalar", "my_var", "refgen_topic", "my_refgen", "amper", "scalar", - "ary", "hsh", "arylen", "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR + "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "PERLY_PAREN_CLOSE", + "PERLY_PAREN_OPEN", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", + "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", + "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", + "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", + "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", + "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", + "startsub", "startanonsub", "startformsub", "subname", "proto", + "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", + "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", + "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", + "listexpr", "listop", "@16", "method", "subscripted", "termbinop", + "termrelop", "relopchain", "termeqop", "eqopchain", "termunop", + "anonymous", "termdo", "term", "@17", "myattrterm", "myterm", + "optlistexpr", "optexpr", "optrepl", "my_scalar", "my_var", + "refgen_topic", "my_refgen", "amper", "scalar", "ary", "hsh", "arylen", + "star", "sliceme", "kvslice", "gelem", "indirob", YY_NULLPTR }; #endif @@ -164,7 +165,7 @@ static const yytype_int16 yytoknum[] = 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, - 355, 356, 357, 358, 359, 360, 361, 41, 362, 36, + 355, 356, 357, 358, 359, 360, 361, 362, 363, 36, 42, 47 }; # endif @@ -1132,26 +1133,27 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval }; /* Generated from: - * 8e3bd7759e3e39aabe8c75614ea5d1a9188a7196abaee7d2164e9b3b14fb38d6 perly.y + * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 5fa7f9ffee68..ab6f3958da15 100644 --- a/perly.y +++ b/perly.y @@ -123,7 +123,7 @@ %right POWOP %nonassoc PREINC PREDEC POSTINC POSTDEC POSTJOIN %left ARROW -%nonassoc ')' +%nonassoc PERLY_PAREN_CLOSE %left PERLY_PAREN_OPEN %left PERLY_BRACKET_OPEN PERLY_BRACE_OPEN @@ -361,35 +361,35 @@ barestmt: PLUGSTMT parser->parsed_sub = 1; $$ = NULL; } - | IF PERLY_PAREN_OPEN remember mexpr ')' mblock else + | IF PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock else { $$ = block_end($remember, newCONDOP(0, $mexpr, op_scope($mblock), $else)); parser->copline = (line_t)$IF; } - | UNLESS PERLY_PAREN_OPEN remember mexpr ')' mblock else + | UNLESS PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock else { $$ = block_end($remember, newCONDOP(0, $mexpr, $else, op_scope($mblock))); parser->copline = (line_t)$UNLESS; } - | GIVEN PERLY_PAREN_OPEN remember mexpr ')' mblock + | GIVEN PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock { $$ = block_end($remember, newGIVENOP($mexpr, op_scope($mblock), 0)); parser->copline = (line_t)$GIVEN; } - | WHEN PERLY_PAREN_OPEN remember mexpr ')' mblock + | WHEN PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock { $$ = block_end($remember, newWHENOP($mexpr, op_scope($mblock))); } | DEFAULT block { $$ = newWHENOP(0, op_scope($block)); } - | WHILE PERLY_PAREN_OPEN remember texpr ')' mintro mblock cont + | WHILE PERLY_PAREN_OPEN remember texpr PERLY_PAREN_CLOSE mintro mblock cont { $$ = block_end($remember, newWHILEOP(0, 1, NULL, $texpr, $mblock, $cont, $mintro)); parser->copline = (line_t)$WHILE; } - | UNTIL PERLY_PAREN_OPEN remember iexpr ')' mintro mblock cont + | UNTIL PERLY_PAREN_OPEN remember iexpr PERLY_PAREN_CLOSE mintro mblock cont { $$ = block_end($remember, newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ barestmt: PLUGSTMT { parser->expect = XTERM; } texpr PERLY_SEMICOLON { parser->expect = XTERM; } - mintro mnexpr[iterate_mnexpr] ')' + mintro mnexpr[iterate_mnexpr] PERLY_PAREN_CLOSE mblock { OP *initop = $init_mnexpr; @@ -416,12 +416,12 @@ barestmt: PLUGSTMT $$ = block_end($remember, forop); parser->copline = (line_t)$FOR; } - | FOR MY remember my_scalar PERLY_PAREN_OPEN mexpr ')' mblock cont + | FOR MY remember my_scalar PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont { $$ = block_end($remember, newFOROP(0, $my_scalar, $mexpr, $mblock, $cont)); parser->copline = (line_t)$FOR; } - | FOR scalar PERLY_PAREN_OPEN remember mexpr ')' mblock cont + | FOR scalar PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont { $$ = block_end($remember, newFOROP(0, op_lvalue($scalar, OP_ENTERLOOP), $mexpr, $mblock, $cont)); @@ -429,7 +429,7 @@ barestmt: PLUGSTMT } | FOR my_refgen remember my_var { parser->in_my = 0; $$ = my($my_var); }[variable] - PERLY_PAREN_OPEN mexpr ')' mblock cont + PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock cont { $$ = block_end( $remember, @@ -442,7 +442,7 @@ barestmt: PLUGSTMT ); parser->copline = (line_t)$FOR; } - | FOR REFGEN refgen_topic PERLY_PAREN_OPEN remember mexpr ')' mblock cont + | FOR REFGEN refgen_topic PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont { $$ = block_end($remember, newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -450,7 +450,7 @@ barestmt: PLUGSTMT OP_ENTERLOOP), $mexpr, $mblock, $cont)); parser->copline = (line_t)$FOR; } - | FOR PERLY_PAREN_OPEN remember mexpr ')' mblock cont + | FOR PERLY_PAREN_OPEN remember mexpr PERLY_PAREN_CLOSE mblock cont { $$ = block_end($remember, newFOROP(0, NULL, $mexpr, $mblock, $cont)); @@ -548,7 +548,7 @@ else : /* NULL */ ($mblock)->op_flags |= OPf_PARENS; $$ = op_scope($mblock); } - | ELSIF PERLY_PAREN_OPEN mexpr ')' mblock else[else.recurse] + | ELSIF PERLY_PAREN_OPEN mexpr PERLY_PAREN_CLOSE mblock else[else.recurse] { parser->copline = (line_t)$ELSIF; $$ = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,$mexpr), @@ -790,7 +790,7 @@ optsubsignature: /* NULL */ { $$ = $subsignature; } /* Subroutine signature */ -subsignature: PERLY_PAREN_OPEN subsigguts ')' +subsignature: PERLY_PAREN_OPEN subsigguts PERLY_PAREN_CLOSE { $$ = $subsigguts; } subsigguts: @@ -919,11 +919,11 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ { $$ = op_convert_list($LSTOP, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($LSTOP,$indirob), $listexpr) ); } - | FUNC PERLY_PAREN_OPEN indirob expr ')' /* print ($fh @args */ + | FUNC PERLY_PAREN_OPEN indirob expr PERLY_PAREN_CLOSE /* print ($fh @args */ { $$ = op_convert_list($FUNC, OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF($FUNC,$indirob), $expr) ); } - | term ARROW method PERLY_PAREN_OPEN optexpr ')' /* $foo->bar(list) */ + | term ARROW method PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* $foo->bar(list) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar($term), $optexpr), @@ -940,7 +940,7 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ op_prepend_elem(OP_LIST, $indirob, $optlistexpr), newMETHOP(OP_METHOD, 0, $METHOD))); } - | FUNCMETH indirob PERLY_PAREN_OPEN optexpr ')' /* method $object (@args) */ + | FUNCMETH indirob PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* method $object (@args) */ { $$ = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, $indirob, $optexpr), @@ -948,7 +948,7 @@ listop : LSTOP indirob listexpr /* map {...} @args or print $fh @args */ } | LSTOP optlistexpr /* print @args */ { $$ = op_convert_list($LSTOP, 0, $optlistexpr); } - | FUNC PERLY_PAREN_OPEN optexpr ')' /* print (@args) */ + | FUNC PERLY_PAREN_OPEN optexpr PERLY_PAREN_CLOSE /* print (@args) */ { $$ = op_convert_list($FUNC, 0, $optexpr); } | FUNC SUBLEXSTART optexpr SUBLEXEND /* uc($arg) from "\U..." */ { $$ = op_convert_list($FUNC, 0, $optexpr); } @@ -996,13 +996,13 @@ subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE { $$ = newBINOP(OP_HELEM, 0, ref(newHVREF($hash_reference),OP_RV2HV), jmaybe($expr)); } - | term[code_reference] ARROW PERLY_PAREN_OPEN ')' /* $subref->() */ + | term[code_reference] ARROW PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $subref->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | term[code_reference] ARROW PERLY_PAREN_OPEN expr ')' /* $subref->(@args) */ + | term[code_reference] ARROW PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $subref->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, newCVREF(0, scalar($code_reference)))); @@ -1010,24 +1010,24 @@ subscripted: gelem PERLY_BRACE_OPEN expr PERLY_SEMICOLON PERLY_BRACE_CLOSE parser->expect = XOPERATOR; } - | subscripted[code_reference] PERLY_PAREN_OPEN expr ')' /* $foo->{bar}->(@args) */ + | subscripted[code_reference] PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* $foo->{bar}->(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, newCVREF(0, scalar($code_reference)))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | subscripted[code_reference] PERLY_PAREN_OPEN ')' /* $foo->{bar}->() */ + | subscripted[code_reference] PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* $foo->{bar}->() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar($code_reference))); if (parser->expect == XBLOCK) parser->expect = XOPERATOR; } - | PERLY_PAREN_OPEN expr[list] ')' PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ + | PERLY_PAREN_OPEN expr[list] PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr[slice] PERLY_BRACKET_CLOSE /* list slice */ { $$ = newSLICEOP(0, $slice, $list); } | QWLIST PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* list literal slice */ { $$ = newSLICEOP(0, $expr, $QWLIST); } - | PERLY_PAREN_OPEN ')' PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ + | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE PERLY_BRACKET_OPEN expr PERLY_BRACKET_CLOSE /* empty list slice! */ { $$ = newSLICEOP(0, $expr, NULL); } ; @@ -1171,11 +1171,11 @@ term[product] : termbinop { $$ = $myattrterm; } | LOCAL term[operand] %prec UNIOP { $$ = localize($operand,0); } - | PERLY_PAREN_OPEN expr ')' + | PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE { $$ = sawparens($expr); } | QWLIST { $$ = $QWLIST; } - | PERLY_PAREN_OPEN ')' + | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE { $$ = sawparens(newNULLLIST()); } | scalar %prec PERLY_PAREN_OPEN { $$ = $scalar; } @@ -1233,10 +1233,10 @@ term[product] : termbinop { $$ = $THING; } | amper /* &foo; */ { $$ = newUNOP(OP_ENTERSUB, 0, scalar($amper)); } - | amper PERLY_PAREN_OPEN ')' /* &foo() or foo() */ + | amper PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* &foo() or foo() */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($amper)); } - | amper PERLY_PAREN_OPEN expr ')' /* &foo(@args) or foo(@args) */ + | amper PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* &foo(@args) or foo(@args) */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $expr, scalar($amper))); @@ -1280,19 +1280,19 @@ term[product] : termbinop op_append_elem(OP_LIST, $operand, scalar($UNIOPSUB))); } | FUNC0 /* Nullary operator */ { $$ = newOP($FUNC0, 0); } - | FUNC0 PERLY_PAREN_OPEN ')' + | FUNC0 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE { $$ = newOP($FUNC0, 0);} | FUNC0OP /* Same as above, but op created in toke.c */ { $$ = $FUNC0OP; } - | FUNC0OP PERLY_PAREN_OPEN ')' + | FUNC0OP PERLY_PAREN_OPEN PERLY_PAREN_CLOSE { $$ = $FUNC0OP; } | FUNC0SUB /* Sub treated as nullop */ { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar($FUNC0SUB)); } - | FUNC1 PERLY_PAREN_OPEN ')' /* not () */ + | FUNC1 PERLY_PAREN_OPEN PERLY_PAREN_CLOSE /* not () */ { $$ = ($FUNC1 == OP_NOT) ? newUNOP($FUNC1, 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP($FUNC1, OPf_SPECIAL); } - | FUNC1 PERLY_PAREN_OPEN expr ')' /* not($foo) */ + | FUNC1 PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE /* not($foo) */ { $$ = newUNOP($FUNC1, 0, $expr); } | PMFUNC /* m//, s///, qr//, tr/// */ { @@ -1322,9 +1322,9 @@ myattrterm: MY myterm myattrlist ; /* Things that can be "my"'d */ -myterm : PERLY_PAREN_OPEN expr ')' +myterm : PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE { $$ = sawparens($expr); } - | PERLY_PAREN_OPEN ')' + | PERLY_PAREN_OPEN PERLY_PAREN_CLOSE { $$ = sawparens(newNULLLIST()); } | scalar %prec PERLY_PAREN_OPEN diff --git a/toke.c b/toke.c index 4fcc45a1fff4..fe0a8be08bbb 100644 --- a/toke.c +++ b/toke.c @@ -5010,6 +5010,7 @@ yyl_sigvar(pTHX_ char *s) case ',': TOKEN (PERLY_COMMA); case '@': TOKEN (PERLY_SNAIL); case '%': TOKEN (PERLY_PERCENT_SIGN); + case ')': TOKEN (PERLY_PAREN_CLOSE); default: TOKEN (sigil); } } @@ -5355,7 +5356,7 @@ yyl_interpcasemod(pTHX_ char *s) PL_lex_state = LEX_INTERPCONCAT; } PL_lex_allbrackets--; - return REPORT(')'); + return REPORT(PERLY_PAREN_CLOSE); } else if ( PL_bufptr != PL_bufend && PL_bufptr[1] == 'E' ) { /* Got an unpaired \E */ @@ -5389,7 +5390,7 @@ yyl_interpcasemod(pTHX_ char *s) { PL_lex_casestack[--PL_lex_casemods] = '\0'; PL_lex_allbrackets--; - return REPORT(')'); + return REPORT(PERLY_PAREN_CLOSE); } if (PL_lex_casemods > 10) Renew(PL_lex_casestack, PL_lex_casemods + 2, char); @@ -6529,8 +6530,8 @@ yyl_rightparen(pTHX_ char *s) PL_lex_allbrackets--; s = skipspace(s); if (*s == '{') - PREBLOCK(')'); - TERM(')'); + PREBLOCK(PERLY_PAREN_CLOSE); + TERM(PERLY_PAREN_CLOSE); } static int @@ -9329,7 +9330,7 @@ Perl_yylex(pTHX) PL_lex_dojoin = FALSE; PL_lex_state = LEX_INTERPCONCAT; PL_lex_allbrackets--; - return REPORT(dojoin_was == 1 ? (int)')' : (int)POSTJOIN); + return REPORT(dojoin_was == 1 ? (int)PERLY_PAREN_CLOSE : (int)POSTJOIN); } if (PL_lex_inwhat == OP_SUBST && PL_linestr == PL_lex_repl && SvEVALED(PL_lex_repl)) From d02b2fbf99fe056004dcc6ba704fd2846d208bb0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:18 +0100 Subject: [PATCH 343/503] Distinguish C- and perly- literals - PERLY_STAR --- perly.act | 536 +++++++++--------- perly.h | 175 +++--- perly.tab | 1600 +++++++++++++++++++++++++++-------------------------- perly.y | 17 +- toke.c | 12 +- 5 files changed, 1179 insertions(+), 1161 deletions(-) diff --git a/perly.act b/perly.act index afec8b500d65..265af5c0d255 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 134 "perly.y" +#line 135 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 139 "perly.y" +#line 140 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 145 "perly.y" +#line 146 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 150 "perly.y" +#line 151 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 155 "perly.y" +#line 156 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 160 "perly.y" +#line 161 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 168 "perly.y" +#line 169 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 173 "perly.y" +#line 174 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 181 "perly.y" +#line 182 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 186 "perly.y" +#line 187 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 194 "perly.y" +#line 195 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 199 "perly.y" +#line 200 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 204 "perly.y" +#line 205 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 209 "perly.y" +#line 210 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 217 "perly.y" +#line 218 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 225 "perly.y" +#line 226 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 232 "perly.y" +#line 233 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 237 "perly.y" +#line 238 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 244 "perly.y" +#line 245 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 250 "perly.y" +#line 251 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 252 "perly.y" +#line 253 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 261 "perly.y" +#line 262 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 263 "perly.y" +#line 264 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 272 "perly.y" +#line 273 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 276 "perly.y" +#line 277 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 280 "perly.y" +#line 281 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 287 "perly.y" +#line 288 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 297 "perly.y" +#line 298 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 299 "perly.y" +#line 300 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 311 "perly.y" +#line 312 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 317 "perly.y" +#line 318 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 332 "perly.y" +#line 333 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 338 "perly.y" +#line 339 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 349 "perly.y" +#line 350 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 356 "perly.y" +#line 357 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 358 "perly.y" +#line 359 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 365 "perly.y" +#line 366 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 371 "perly.y" +#line 372 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 377 "perly.y" +#line 378 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 382 "perly.y" +#line 383 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 384 "perly.y" +#line 385 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 386 "perly.y" +#line 387 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 393 "perly.y" +#line 394 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 400 "perly.y" +#line 401 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 402 "perly.y" +#line 403 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 405 "perly.y" +#line 406 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 420 "perly.y" +#line 421 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 425 "perly.y" +#line 426 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 431 "perly.y" +#line 432 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 433 "perly.y" +#line 434 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 446 "perly.y" +#line 447 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 454 "perly.y" +#line 455 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 460 "perly.y" +#line 461 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 466 "perly.y" +#line 467 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 473 "perly.y" +#line 474 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 481 "perly.y" +#line 482 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 485 "perly.y" +#line 486 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 490 "perly.y" +#line 491 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 498 "perly.y" +#line 499 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 515 "perly.y" +#line 516 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 525 "perly.y" +#line 526 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 535 "perly.y" +#line 536 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 537 "perly.y" +#line 538 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 540 "perly.y" +#line 541 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 545 "perly.y" +#line 546 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 547 "perly.y" +#line 548 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 552 "perly.y" +#line 553 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 562 "perly.y" +#line 563 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 564 "perly.y" +#line 565 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 569 "perly.y" +#line 570 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 575 "perly.y" +#line 576 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 581 "perly.y" +#line 582 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 589 "perly.y" +#line 590 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 594 "perly.y" +#line 595 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 598 "perly.y" +#line 599 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 601 "perly.y" +#line 602 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 602 "perly.y" +#line 603 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 606 "perly.y" +#line 607 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 612 "perly.y" +#line 613 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 617 "perly.y" +#line 618 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 628 "perly.y" +#line 629 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 634 "perly.y" +#line 635 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 638 "perly.y" +#line 639 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 643 "perly.y" +#line 644 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 645 "perly.y" +#line 646 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 656 "perly.y" +#line 657 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 658 "perly.y" +#line 659 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 663 "perly.y" +#line 664 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 665 "perly.y" +#line 666 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 669 "perly.y" +#line 670 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 688 "perly.y" +#line 689 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 690 "perly.y" +#line 691 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 692 "perly.y" +#line 693 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 698 "perly.y" +#line 699 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 763 "perly.y" +#line 764 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 765 "perly.y" +#line 766 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 771 "perly.y" +#line 772 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 773 "perly.y" +#line 774 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 777 "perly.y" +#line 778 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 782 "perly.y" +#line 783 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 788 "perly.y" +#line 789 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 790 "perly.y" +#line 791 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 794 "perly.y" +#line 795 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 797 "perly.y" +#line 798 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 808 "perly.y" +#line 809 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 865 "perly.y" +#line 866 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 866 "perly.y" +#line 867 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 872 "perly.y" +#line 873 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 882 "perly.y" +#line 883 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 883 "perly.y" +#line 884 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 887 "perly.y" +#line 888 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 898 "perly.y" +#line 899 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 900 "perly.y" +#line 901 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 902 "perly.y" +#line 903 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 908 "perly.y" +#line 909 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 910 "perly.y" +#line 911 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 919 "perly.y" +#line 920 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 923 "perly.y" +#line 924 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 927 "perly.y" +#line 928 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 933 "perly.y" +#line 934 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 938 "perly.y" +#line 939 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 944 "perly.y" +#line 945 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 950 "perly.y" +#line 951 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 952 "perly.y" +#line 953 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 954 "perly.y" +#line 955 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 956 "perly.y" +#line 957 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 959 "perly.y" +#line 960 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 974 "perly.y" +#line 975 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 976 "perly.y" +#line 977 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 979 "perly.y" +#line 980 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 984 "perly.y" +#line 985 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 989 "perly.y" +#line 990 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 992 "perly.y" +#line 993 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 996 "perly.y" +#line 997 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 1000 "perly.y" +#line 1001 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1006 "perly.y" +#line 1007 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1014 "perly.y" +#line 1015 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1021 "perly.y" +#line 1022 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1027 "perly.y" +#line 1028 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1029 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1031 "perly.y" +#line 1032 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1036 "perly.y" +#line 1037 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1038 "perly.y" +#line 1039 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1040 "perly.y" +#line 1041 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1045 "perly.y" +#line 1046 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1063 "perly.y" +#line 1064 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1065 "perly.y" +#line 1066 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1069 "perly.y" +#line 1070 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1071 "perly.y" +#line 1072 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1073 "perly.y" +#line 1074 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1075 "perly.y" +#line 1076 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1079 "perly.y" +#line 1080 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1081 "perly.y" +#line 1082 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1085 "perly.y" +#line 1086 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1087 "perly.y" +#line 1088 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1089 "perly.y" +#line 1090 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1091 "perly.y" +#line 1092 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1095 "perly.y" +#line 1096 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1102 "perly.y" +#line 1103 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1107 "perly.y" +#line 1108 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1109 "perly.y" +#line 1110 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1111 "perly.y" +#line 1112 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1114 "perly.y" +#line 1115 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1117 "perly.y" +#line 1118 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1128 "perly.y" +#line 1129 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1131 "perly.y" +#line 1132 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1138 "perly.y" +#line 1139 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1140 "perly.y" +#line 1141 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1142 "perly.y" +#line 1143 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1144 "perly.y" +#line 1145 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1146 "perly.y" +#line 1147 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1149 "perly.y" +#line 1150 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1155 "perly.y" +#line 1156 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1157 "perly.y" +#line 1158 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1165 "perly.y" +#line 1166 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1187 "perly.y" +#line 1188 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1189 "perly.y" +#line 1190 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1191 "perly.y" +#line 1192 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1193 "perly.y" +#line 1194 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1203 "perly.y" +#line 1204 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1213 "perly.y" +#line 1214 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1223 "perly.y" +#line 1224 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1233 "perly.y" +#line 1234 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1235 "perly.y" +#line 1236 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1237 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1240 "perly.y" +#line 1241 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1245 "perly.y" +#line 1246 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1249 "perly.y" +#line 1250 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1258 "perly.y" +#line 1259 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1263 "perly.y" +#line 1264 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1282 "perly.y" +#line 1283 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1288 "perly.y" +#line 1289 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1290 "perly.y" +#line 1291 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1292 "perly.y" +#line 1293 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1296 "perly.y" +#line 1297 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1298 "perly.y" +#line 1299 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1309 "perly.y" +#line 1310 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1317 "perly.y" +#line 1318 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1326 "perly.y" +#line 1327 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1331 "perly.y" +#line 1332 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1333 "perly.y" +#line 1334 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1335 "perly.y" +#line 1336 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1340 "perly.y" +#line 1341 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1346 "perly.y" +#line 1347 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1348 "perly.y" +#line 1349 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1352 "perly.y" +#line 1353 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1354 "perly.y" +#line 1355 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1360 "perly.y" +#line 1361 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1377 "perly.y" +#line 1378 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1381 "perly.y" +#line 1382 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1385 "perly.y" +#line 1386 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1391 "perly.y" +#line 1392 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1397 "perly.y" +#line 1398 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1399 "perly.y" +#line 1400 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1403 "perly.y" +#line 1404 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1408 "perly.y" +#line 1409 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1413 "perly.y" +#line 1414 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1418 "perly.y" +#line 1419 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1423 "perly.y" +#line 1424 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1425 "perly.y" +#line 1426 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1427 "perly.y" +#line 1428 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1430 "perly.y" +#line 1431 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y + * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 75678f7d983f..bad664f35af2 100644 --- a/perly.h +++ b/perly.h @@ -76,92 +76,93 @@ extern int yydebug; PERLY_PLUS = 275, PERLY_SEMICOLON = 276, PERLY_SNAIL = 277, - BAREWORD = 278, - METHOD = 279, - FUNCMETH = 280, - THING = 281, - PMFUNC = 282, - PRIVATEREF = 283, - QWLIST = 284, - FUNC0OP = 285, - FUNC0SUB = 286, - UNIOPSUB = 287, - LSTOPSUB = 288, - PLUGEXPR = 289, - PLUGSTMT = 290, - LABEL = 291, - FORMAT = 292, - SUB = 293, - SIGSUB = 294, - ANONSUB = 295, - ANON_SIGSUB = 296, - PACKAGE = 297, - USE = 298, - WHILE = 299, - UNTIL = 300, - IF = 301, - UNLESS = 302, - ELSE = 303, - ELSIF = 304, - CONTINUE = 305, - FOR = 306, - GIVEN = 307, - WHEN = 308, - DEFAULT = 309, - LOOPEX = 310, - DOTDOT = 311, - YADAYADA = 312, - FUNC0 = 313, - FUNC1 = 314, - FUNC = 315, - UNIOP = 316, - LSTOP = 317, - MULOP = 318, - ADDOP = 319, - DOLSHARP = 320, - DO = 321, - HASHBRACK = 322, - NOAMP = 323, - LOCAL = 324, - MY = 325, - REQUIRE = 326, - COLONATTR = 327, - FORMLBRACK = 328, - FORMRBRACK = 329, - SUBLEXSTART = 330, - SUBLEXEND = 331, - PREC_LOW = 332, - OROP = 333, - DOROP = 334, - ANDOP = 335, - NOTOP = 336, - ASSIGNOP = 337, - PERLY_QUESTION_MARK = 338, - PERLY_COLON = 339, - OROR = 340, - DORDOR = 341, - ANDAND = 342, - BITOROP = 343, - BITANDOP = 344, - CHEQOP = 345, - NCEQOP = 346, - CHRELOP = 347, - NCRELOP = 348, - SHIFTOP = 349, - MATCHOP = 350, - PERLY_EXCLAMATION_MARK = 351, - PERLY_TILDE = 352, - UMINUS = 353, - REFGEN = 354, - POWOP = 355, - PREINC = 356, - PREDEC = 357, - POSTINC = 358, - POSTDEC = 359, - POSTJOIN = 360, - ARROW = 361, - PERLY_PAREN_CLOSE = 362, - PERLY_PAREN_OPEN = 363 + PERLY_STAR = 278, + BAREWORD = 279, + METHOD = 280, + FUNCMETH = 281, + THING = 282, + PMFUNC = 283, + PRIVATEREF = 284, + QWLIST = 285, + FUNC0OP = 286, + FUNC0SUB = 287, + UNIOPSUB = 288, + LSTOPSUB = 289, + PLUGEXPR = 290, + PLUGSTMT = 291, + LABEL = 292, + FORMAT = 293, + SUB = 294, + SIGSUB = 295, + ANONSUB = 296, + ANON_SIGSUB = 297, + PACKAGE = 298, + USE = 299, + WHILE = 300, + UNTIL = 301, + IF = 302, + UNLESS = 303, + ELSE = 304, + ELSIF = 305, + CONTINUE = 306, + FOR = 307, + GIVEN = 308, + WHEN = 309, + DEFAULT = 310, + LOOPEX = 311, + DOTDOT = 312, + YADAYADA = 313, + FUNC0 = 314, + FUNC1 = 315, + FUNC = 316, + UNIOP = 317, + LSTOP = 318, + MULOP = 319, + ADDOP = 320, + DOLSHARP = 321, + DO = 322, + HASHBRACK = 323, + NOAMP = 324, + LOCAL = 325, + MY = 326, + REQUIRE = 327, + COLONATTR = 328, + FORMLBRACK = 329, + FORMRBRACK = 330, + SUBLEXSTART = 331, + SUBLEXEND = 332, + PREC_LOW = 333, + OROP = 334, + DOROP = 335, + ANDOP = 336, + NOTOP = 337, + ASSIGNOP = 338, + PERLY_QUESTION_MARK = 339, + PERLY_COLON = 340, + OROR = 341, + DORDOR = 342, + ANDAND = 343, + BITOROP = 344, + BITANDOP = 345, + CHEQOP = 346, + NCEQOP = 347, + CHRELOP = 348, + NCRELOP = 349, + SHIFTOP = 350, + MATCHOP = 351, + PERLY_EXCLAMATION_MARK = 352, + PERLY_TILDE = 353, + UMINUS = 354, + REFGEN = 355, + POWOP = 356, + PREINC = 357, + PREDEC = 358, + POSTINC = 359, + POSTDEC = 360, + POSTJOIN = 361, + ARROW = 362, + PERLY_PAREN_CLOSE = 363, + PERLY_PAREN_OPEN = 364 }; #endif @@ -213,6 +214,6 @@ int yyparse (void); /* Generated from: - * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y + * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 462580cb7842..5f5e09f11ab0 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3111 +#define YYLAST 3189 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 363 +#define YYMAXUTOK 364 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,8 +33,8 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 109, 2, 2, 2, - 2, 2, 110, 2, 2, 2, 2, 111, 2, 2, + 2, 2, 2, 2, 2, 2, 110, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 111, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -66,43 +66,43 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 107, 108 + 105, 106, 107, 108, 109 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 134, 134, 133, 145, 144, 155, 154, 168, 167, - 181, 180, 194, 193, 204, 203, 216, 224, 232, 236, - 244, 250, 251, 261, 262, 271, 275, 279, 286, 296, - 298, 311, 308, 332, 327, 348, 356, 355, 364, 370, - 376, 381, 383, 385, 392, 400, 402, 399, 419, 424, - 431, 430, 445, 453, 459, 466, 465, 480, 484, 489, - 497, 515, 516, 520, 524, 526, 528, 530, 532, 534, - 536, 539, 545, 546, 551, 562, 563, 569, 575, 576, - 581, 584, 588, 593, 597, 601, 602, 606, 612, 617, - 622, 623, 628, 629, 634, 635, 637, 642, 644, 656, - 657, 662, 664, 668, 688, 689, 691, 697, 762, 764, - 770, 772, 776, 782, 783, 788, 789, 793, 797, 797, - 865, 866, 871, 882, 883, 886, 897, 899, 901, 903, - 907, 909, 914, 918, 922, 926, 932, 937, 943, 949, - 951, 953, 956, 955, 966, 967, 971, 975, 978, 983, - 988, 991, 995, 999, 1005, 1013, 1020, 1026, 1028, 1030, - 1035, 1037, 1039, 1044, 1046, 1048, 1050, 1052, 1054, 1056, - 1058, 1060, 1062, 1064, 1068, 1070, 1072, 1074, 1078, 1080, - 1084, 1086, 1088, 1090, 1094, 1096, 1101, 1103, 1106, 1108, - 1110, 1113, 1116, 1127, 1130, 1137, 1139, 1141, 1143, 1145, - 1148, 1154, 1156, 1160, 1161, 1162, 1163, 1164, 1166, 1168, - 1170, 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, 1188, - 1190, 1192, 1202, 1212, 1222, 1232, 1234, 1236, 1239, 1244, - 1248, 1250, 1252, 1254, 1257, 1259, 1262, 1264, 1266, 1268, - 1270, 1272, 1274, 1276, 1278, 1281, 1283, 1285, 1287, 1289, - 1291, 1295, 1298, 1297, 1310, 1311, 1312, 1316, 1318, 1320, - 1325, 1327, 1330, 1332, 1334, 1339, 1341, 1346, 1347, 1352, - 1353, 1359, 1363, 1364, 1365, 1368, 1369, 1372, 1373, 1376, - 1380, 1384, 1390, 1396, 1398, 1402, 1406, 1407, 1411, 1412, - 1416, 1417, 1422, 1424, 1426, 1429 + 0, 135, 135, 134, 146, 145, 156, 155, 169, 168, + 182, 181, 195, 194, 205, 204, 217, 225, 233, 237, + 245, 251, 252, 262, 263, 272, 276, 280, 287, 297, + 299, 312, 309, 333, 328, 349, 357, 356, 365, 371, + 377, 382, 384, 386, 393, 401, 403, 400, 420, 425, + 432, 431, 446, 454, 460, 467, 466, 481, 485, 490, + 498, 516, 517, 521, 525, 527, 529, 531, 533, 535, + 537, 540, 546, 547, 552, 563, 564, 570, 576, 577, + 582, 585, 589, 594, 598, 602, 603, 607, 613, 618, + 623, 624, 629, 630, 635, 636, 638, 643, 645, 657, + 658, 663, 665, 669, 689, 690, 692, 698, 763, 765, + 771, 773, 777, 783, 784, 789, 790, 794, 798, 798, + 866, 867, 872, 883, 884, 887, 898, 900, 902, 904, + 908, 910, 915, 919, 923, 927, 933, 938, 944, 950, + 952, 954, 957, 956, 967, 968, 972, 976, 979, 984, + 989, 992, 996, 1000, 1006, 1014, 1021, 1027, 1029, 1031, + 1036, 1038, 1040, 1045, 1047, 1049, 1051, 1053, 1055, 1057, + 1059, 1061, 1063, 1065, 1069, 1071, 1073, 1075, 1079, 1081, + 1085, 1087, 1089, 1091, 1095, 1097, 1102, 1104, 1107, 1109, + 1111, 1114, 1117, 1128, 1131, 1138, 1140, 1142, 1144, 1146, + 1149, 1155, 1157, 1161, 1162, 1163, 1164, 1165, 1167, 1169, + 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, 1189, + 1191, 1193, 1203, 1213, 1223, 1233, 1235, 1237, 1240, 1245, + 1249, 1251, 1253, 1255, 1258, 1260, 1263, 1265, 1267, 1269, + 1271, 1273, 1275, 1277, 1279, 1282, 1284, 1286, 1288, 1290, + 1292, 1296, 1299, 1298, 1311, 1312, 1313, 1317, 1319, 1321, + 1326, 1328, 1331, 1333, 1335, 1340, 1342, 1347, 1348, 1353, + 1354, 1360, 1364, 1365, 1366, 1369, 1370, 1373, 1374, 1377, + 1381, 1385, 1391, 1397, 1399, 1403, 1407, 1408, 1412, 1413, + 1417, 1418, 1423, 1425, 1427, 1430 }; #endif @@ -116,28 +116,28 @@ static const char *const yytname[] = "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PERCENT_SIGN", "PERLY_PLUS", - "PERLY_SEMICOLON", "PERLY_SNAIL", "BAREWORD", "METHOD", "FUNCMETH", - "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", - "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", - "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", - "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", - "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", - "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", - "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", - "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", - "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", - "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", - "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", - "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", - "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "PERLY_PAREN_CLOSE", - "PERLY_PAREN_OPEN", "'$'", "'*'", "'/'", "$accept", "grammar", "@1", - "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", - "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", - "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", "$@12", "@13", - "$@14", "formline", "formarg", "condition", "sideff", "else", "cont", - "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", "formname", - "startsub", "startanonsub", "startformsub", "subname", "proto", - "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", + "PERLY_SEMICOLON", "PERLY_SNAIL", "PERLY_STAR", "BAREWORD", "METHOD", + "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", + "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", + "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", + "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", + "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", + "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", + "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", + "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", + "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", + "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", + "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", + "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", + "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", + "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "'$'", "'/'", "$accept", + "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", + "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", + "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", + "$@12", "@13", "$@14", "formline", "formarg", "condition", "sideff", + "else", "cont", "mintro", "nexpr", "texpr", "iexpr", "mexpr", "mnexpr", + "formname", "startsub", "startanonsub", "startformsub", "subname", + "proto", "subattrlist", "myattrlist", "sigvarname", "sigslurpsigil", "sigslurpelem", "sigdefault", "sigscalarelem", "sigelem", "siglist", "siglistornull", "optsubsignature", "subsignature", "subsigguts", "$@15", "optsubbody", "subbody", "optsigsubbody", "sigsubbody", "expr", @@ -165,12 +165,12 @@ static const yytype_int16 yytoknum[] = 325, 326, 327, 328, 329, 330, 331, 332, 333, 334, 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, - 355, 356, 357, 358, 359, 360, 361, 362, 363, 36, - 42, 47 + 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, + 36, 47 }; # endif -#define YYPACT_NINF (-487) +#define YYPACT_NINF (-460) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -184,64 +184,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 1117, -487, -487, -487, -487, -487, -487, -487, 27, -487, - 2722, 38, 1420, 1327, -487, -487, -487, -487, 10, 1792, - 2722, 10, 2722, 10, -487, 10, 10, -487, -487, 26, - -46, -487, 2722, -487, -487, -487, -487, 2722, -33, -18, - -41, 1885, 1699, 10, 1885, 1978, 13, 2722, 28, 2722, - 2722, 2722, 2722, 2722, 2722, 2722, 2071, 10, 10, 108, - 56, -487, -4, -487, 22, 7, 48, 19, -487, -487, - -487, 2915, -487, -487, 33, 94, 138, 162, -487, 91, - 171, 234, 156, -487, -487, -487, -487, -487, -487, 13, - 13, 169, -487, 71, 119, 126, 132, 324, 136, 142, - 38, 243, 218, -487, 252, 433, 1327, -487, -487, -487, - 583, -487, 23, 676, -487, -487, -487, -487, -487, -487, - -6, 401, -487, 401, -487, 2722, 167, 237, 2722, 211, - 429, 38, 301, 260, 2915, 226, 2164, 2722, 1699, -487, - 429, 475, 56, -487, 362, 2722, -487, -487, 429, 336, - 245, -487, -487, 2722, 429, 2815, 2257, 285, -487, -487, - -487, 429, 56, 401, 401, 401, 282, 282, 348, 131, - -487, -487, 2722, 2722, 2722, 2722, 2722, 2722, 2350, -487, - -487, 2722, -487, -487, 2722, 2722, 2722, 2722, 2722, 2722, - 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, 2722, - 2722, 2722, -487, -487, -487, 250, 2443, 2722, 2722, 2722, - 2722, 2722, 2722, 2722, -487, 347, -487, -487, 351, -487, - -487, -487, -487, -487, 279, 9, -487, -487, 281, -487, - -487, -487, -487, 38, -487, -487, 2722, 2722, 2722, 2722, - 2722, 2722, -487, -487, -487, -487, -487, 364, 364, -487, - -487, -487, 378, -487, -487, -487, 2722, 2722, 18, -487, - -487, -487, 260, 372, -487, -487, -487, 202, 334, 293, - 2722, 56, -487, 399, -487, 2536, 401, 285, 40, 45, - 52, -487, 380, 391, -487, 2722, 406, 344, 344, -487, - 2915, 262, 81, -487, 436, 429, 940, 3005, 1120, 90, - 2915, 2870, 568, 568, 661, 754, 847, 940, 940, 429, - 429, 1033, 401, 401, 327, 2722, 2722, 333, 353, -487, - 354, 2629, 12, 366, 326, -487, -487, 469, 289, 128, - 317, 157, 325, 163, 342, 769, -487, 418, -487, -487, - 59, 438, 2722, 2722, 2722, 2722, -487, 373, -487, -487, - 377, -487, -487, -487, -487, 1513, 24, -487, 2722, 2722, - -487, -487, 108, -487, 108, -487, -487, -487, -487, -487, - 412, 412, 23, 374, 15, -487, 2722, -487, -487, 387, - -487, -487, -487, -487, 493, -487, 11, 1111, -487, -487, - -487, 177, 2722, 476, -487, -487, 2722, -487, 350, 251, - -487, -487, -487, -487, 1204, -487, -487, 2722, -487, 485, - -487, 486, -487, 488, -487, 496, -487, -487, -487, 301, - 260, -487, -487, 487, 410, 108, 411, 420, 108, 423, - 417, -487, -487, -487, -487, 434, 515, 275, -487, 2722, - 435, 439, 2722, -487, -487, -487, -487, 2722, 464, -487, - 539, -487, -487, 541, -487, -487, 31, -487, 265, -487, - 2960, 544, -487, -487, 467, -487, -487, -487, -487, 556, - 260, 564, -487, 2722, -487, -487, 580, 580, 2722, 2722, - 580, -487, 484, 490, 580, 580, 2915, 108, -487, -487, - 491, -487, -487, -487, -487, 521, 578, -487, -487, -487, - -487, 590, 580, 580, -487, 114, 114, 526, 532, 218, - 2722, 2722, 580, -487, -487, 862, -487, 955, -487, -487, - -487, -487, 1048, -487, 218, 218, -487, 580, 538, -487, - -487, 580, 580, -487, 626, 558, 218, -487, -487, 68, - -487, -487, -487, 1141, -487, 2722, 218, 218, -487, 580, - -487, 650, 594, -487, -487, 562, -487, -487, -487, 218, - -487, -487, -487, 580, 1606, -487, 1234, 114, 563, -487, - -487, 580, -487 + 1015, -460, -460, -460, -460, -460, -460, -460, 26, -460, + 2825, 57, 1509, 1415, -460, -460, -460, -460, 8, 1885, + 2825, 8, 2825, 8, 8, -460, 8, 8, -460, -460, + 22, -30, -460, 2825, -460, -460, -460, -460, 2825, -24, + -21, -59, 1979, 1791, 8, 1979, 2073, 31, 2825, 78, + 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2167, 8, 103, + 83, -460, -1, -460, -2, 20, 13, 28, -460, -460, + -460, 2992, -460, -460, 14, 52, 58, 64, -460, 117, + 236, 239, 125, -460, -460, -460, -460, -460, -460, 31, + 31, 122, -460, 42, 68, 87, 99, 261, 118, 129, + 57, 240, 231, -460, 253, 1601, 1415, -460, -460, -460, + 663, -460, 2, 757, -460, -460, -460, -460, -460, -460, + 92, 299, -460, 299, -460, -460, 2825, 196, 207, 2825, + 198, 393, 57, 282, 242, 2992, 205, 2261, 2825, 1791, + -460, 393, 564, 83, -460, 466, 2825, -460, -460, 393, + 305, 81, -460, -460, 2825, 393, 2919, 2355, 245, -460, + -460, -460, 393, 83, 299, 299, 299, 153, 153, 307, + 155, -460, 2825, 2825, 2825, 2825, 2825, 2825, 2449, -460, + -460, 2825, -460, -460, 2825, 2825, 2825, 2825, 2825, 2825, + 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, + 2825, 2825, -460, -460, -460, 71, 2543, 2825, 2825, 2825, + 2825, 2825, 2825, 2825, -460, 302, -460, -460, 309, -460, + -460, -460, -460, -460, 254, 24, -460, -460, 214, -460, + -460, -460, -460, 57, -460, -460, 2825, 2825, 2825, 2825, + 2825, 2825, -460, -460, -460, -460, -460, 311, 311, -460, + -460, -460, 327, -460, -460, -460, 2825, 2825, 110, -460, + -460, -460, 242, 326, -460, -460, -460, 313, 289, 265, + 2825, 83, -460, 357, -460, 2637, 299, 245, 53, 59, + 90, -460, 344, 348, -460, 2825, 369, 306, 306, -460, + 2992, 165, 113, -460, 425, 393, 355, 3082, 1018, 930, + 2992, 2947, 501, 501, 648, 742, 836, 355, 355, 393, + 393, 420, 299, 299, 360, 2825, 2825, 365, 379, 388, + -460, 390, 2731, 29, 308, -460, -460, 460, 174, 130, + 191, 161, 300, 199, 317, 851, -460, 405, -460, -460, + 12, 404, 2825, 2825, 2825, 2825, -460, 319, -460, -460, + 321, -460, -460, -460, -460, 1603, 37, -460, 2825, 2825, + -460, -460, 103, -460, 103, -460, -460, -460, -460, -460, + 351, 351, 2, 329, 0, -460, 2825, -460, -460, 334, + -460, -460, -460, -460, 507, -460, 7, 519, -460, -460, + -460, 223, 2825, 423, -460, -460, 2825, -460, 328, 250, + -460, -460, -460, -460, -460, 553, -460, 2825, -460, 426, + -460, 432, -460, 433, -460, 435, -460, -460, -460, 282, + 242, -460, -460, 431, 359, 103, 361, 367, 103, 370, + 356, -460, -460, -460, -460, 374, 447, 310, -460, 2825, + 378, 382, 2825, -460, -460, -460, -460, 2825, 396, -460, + 481, -460, -460, 482, -460, -460, 41, -460, 297, -460, + 3037, 483, -460, -460, 399, -460, -460, -460, -460, 480, + 242, 487, -460, 2825, -460, -460, 499, 499, 2825, 2825, + 499, -460, 406, 409, 499, 499, 2992, 103, -460, -460, + 411, -460, -460, -460, -460, 453, 508, -460, -460, -460, + -460, 511, 499, 499, -460, 91, 91, 414, 427, 231, + 2825, 2825, 499, -460, -460, 945, -460, 1039, -460, -460, + -460, -460, 1133, -460, 231, 231, -460, 499, 429, -460, + -460, 499, 499, -460, 515, 440, 231, -460, -460, 30, + -460, -460, -460, 1227, -460, 2825, 231, 231, -460, 499, + -460, 547, 495, -460, -460, 467, -460, -460, -460, 231, + -460, -460, -460, 499, 1697, -460, 1321, 91, 468, -460, + -460, 499, -460 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -251,22 +251,22 @@ static const yytype_int16 yydefact[] = { 0, 2, 4, 6, 8, 10, 12, 14, 0, 18, 267, 0, 0, 0, 21, 118, 1, 21, 0, 0, - 0, 0, 0, 0, 254, 0, 0, 225, 252, 213, - 247, 249, 243, 88, 256, 88, 88, 235, 245, 0, - 0, 238, 265, 0, 0, 0, 0, 0, 0, 241, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 268, + 0, 0, 0, 0, 0, 254, 0, 0, 225, 252, + 213, 247, 249, 243, 88, 256, 88, 88, 235, 245, + 0, 0, 238, 265, 0, 0, 0, 0, 0, 0, + 241, 0, 0, 0, 0, 0, 0, 0, 0, 268, 129, 255, 220, 203, 165, 174, 166, 180, 204, 205, 206, 132, 210, 5, 226, 215, 218, 217, 219, 216, 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, 0, 15, 113, 0, 292, 295, 294, 293, 279, 196, - 0, 186, 282, 187, 281, 265, 0, 0, 0, 0, - 244, 0, 92, 94, 236, 0, 0, 267, 267, 239, - 240, 292, 266, 139, 293, 0, 283, 202, 201, 0, - 0, 90, 91, 265, 211, 0, 0, 258, 262, 264, - 263, 242, 237, 188, 189, 208, 193, 194, 214, 0, - 280, 285, 0, 0, 0, 130, 0, 0, 0, 177, + 0, 186, 282, 187, 281, 285, 265, 0, 0, 0, + 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, + 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, + 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, + 264, 263, 242, 237, 188, 189, 208, 193, 194, 214, + 0, 280, 0, 0, 0, 130, 0, 0, 0, 177, 176, 0, 183, 182, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, 192, 0, 0, 0, 0, 0, @@ -280,8 +280,8 @@ static const yytype_int16 yydefact[] = 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 0, 0, 0, 289, 287, 144, - 0, 0, 0, 291, 136, 145, 227, 0, 0, 0, + 175, 164, 173, 161, 0, 0, 0, 289, 287, 291, + 144, 0, 0, 0, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, 0, 276, 272, 273, 274, 0, 0, 18, 0, 0, @@ -289,7 +289,7 @@ static const yytype_int16 yydefact[] = 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, 97, 0, 0, 0, 149, 155, 0, 233, 0, 0, - 232, 231, 284, 153, 0, 230, 234, 267, 228, 0, + 232, 231, 234, 284, 153, 0, 230, 267, 228, 0, 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, @@ -312,16 +312,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -487, -487, -487, -487, -487, -487, -487, -487, -487, 43, - -487, -5, 2417, -487, -17, -487, 662, 572, 5, -487, - -487, -487, -487, -487, -487, -487, -487, -487, 349, -341, - -486, -145, -465, -487, 173, 338, -333, 124, -487, -3, - 270, -487, 227, 271, -244, 427, 478, -487, -487, 361, - -487, 367, -487, -487, -487, -487, 288, -487, -487, 263, - -487, 277, -8, -37, -487, -487, -487, -487, -487, -487, - -487, -487, -487, -487, -487, -487, 103, -487, -487, 603, - -124, -122, -487, -487, 404, -487, -487, 537, 34, -45, - -42, -487, -487, -487, -487, -487, 228 + -460, -460, -460, -460, -460, -460, -460, -460, -460, 301, + -460, -5, -117, -460, -17, -460, 571, 497, 1, -460, + -460, -460, -460, -460, -460, -460, -460, -460, 342, -350, + -432, -83, -459, -460, 94, 258, -272, 49, -460, -58, + 229, -460, 179, 195, -244, 340, 371, -460, -460, 249, + -460, 251, -460, -460, -460, -460, 170, -460, -460, 134, + -460, 154, -8, -37, -460, -460, -460, -460, -460, -460, + -460, -460, -460, -460, -460, -460, 100, -460, -460, 470, + -125, -131, -460, -460, 275, -460, -460, 410, 18, -46, + -40, -460, -460, -460, -460, -460, 4 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -331,12 +331,12 @@ static const yytype_int16 yydefgoto[] = 418, 379, 505, 526, 110, 539, 244, 108, 109, 419, 420, 341, 510, 558, 482, 500, 553, 562, 361, 104, 529, 234, 502, 434, 424, 363, 427, 436, 337, 219, - 131, 215, 153, 262, 264, 284, 370, 248, 249, 443, + 132, 215, 154, 262, 264, 284, 370, 248, 249, 443, 250, 251, 252, 253, 453, 454, 111, 112, 520, 451, 498, 380, 105, 60, 61, 376, 324, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 71, 127, 72, 157, - 143, 73, 448, 430, 349, 350, 227, 74, 75, 76, - 77, 78, 79, 80, 81, 82, 170 + 65, 66, 67, 68, 69, 70, 71, 128, 72, 158, + 144, 73, 448, 430, 349, 350, 227, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 171 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If @@ -344,634 +344,648 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 159, 17, 142, 160, 176, 254, 177, - 503, 120, 429, 162, 433, 268, 269, 103, 377, 18, - 530, 83, 435, 83, 285, 440, 441, 16, 21, 274, - 175, 23, 375, 114, 137, 114, 151, 150, 115, 128, - 115, 152, 245, 21, 392, 246, 23, 21, 169, 83, - 23, 207, 117, 208, 84, 117, -286, 117, -286, 117, - 117, 116, 129, -288, 116, -288, 116, 138, 116, 116, - 421, 175, 172, 173, 174, 135, 144, 117, 214, 348, - 422, 570, 158, -261, 139, 116, 116, 147, 142, 551, - 136, 117, 117, 564, 552, 394, 172, 173, 174, 181, - 116, 116, -290, -260, 178, 207, 483, 208, 271, 184, - 279, 243, -262, 280, 179, 180, 142, -264, 57, 57, - 258, 57, 405, 121, -263, 123, 447, 155, 267, 59, - 59, 228, 247, 57, 373, 130, 156, 57, 182, 183, - 134, 206, 410, 231, 140, 507, 508, 148, 282, -286, - 154, -286, 161, 186, 163, 164, 165, 166, 167, 172, - 173, 174, 527, 528, 287, 288, 289, 213, 291, 292, - 294, 412, 144, -288, 260, -288, 471, 414, 535, 220, - 353, 116, 209, 354, 210, 200, 172, 173, 174, 278, - 201, 457, 218, 202, 203, 204, 205, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 172, 173, 174, 172, - 173, 174, 555, 338, 339, 342, 343, 344, 345, 347, - 374, 355, 356, 433, 358, 359, 496, 221, 362, 364, - 362, 362, 362, 362, 222, 172, 173, 174, 286, 325, - 223, 172, 173, 174, 229, 211, 118, 212, 59, 122, - 230, 124, 449, 125, 126, 172, 173, 174, 276, 352, - 314, 315, 384, 316, 232, 462, 273, 387, 233, 317, - 145, 146, 318, 235, 319, 256, 360, 391, 290, 492, - 172, 173, 174, 393, 295, 464, 171, 296, 297, 298, - 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, - 309, 310, 311, 312, 313, 132, 133, 398, 399, 381, - 409, 353, 257, 404, 354, 320, 216, 217, 259, 236, - 237, 238, 239, 172, 173, 174, 240, 261, 241, 172, - 173, 174, 263, 265, 425, 364, 428, 428, 411, 142, - 172, 173, 174, 172, 173, 174, 413, 437, 272, 501, - 428, 428, 439, 172, 173, 174, 117, 283, 321, 322, - 323, 285, -215, 415, 533, 116, 270, 172, 173, 174, - 336, 461, 450, 207, 340, 208, -215, -215, 346, 541, - 542, 431, -83, -215, 458, -291, -291, -291, 205, 357, - 352, 550, 369, 372, 224, 172, 173, 174, 378, 59, - 383, 556, 557, 172, 173, 174, -215, -215, -215, -215, - 382, 385, 469, -215, 565, -215, 472, 390, -215, 392, - 172, 173, 174, 225, 174, -215, -215, 479, 172, 173, - 174, 428, 226, 57, 407, 417, 142, 397, -215, 487, - -215, -215, -215, 400, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -215, 172, 173, - 174, 423, -215, 401, 402, -215, -215, -215, -215, -215, - 428, 428, 515, -215, 517, -254, 406, 236, 237, 238, - 239, 446, 57, 522, 240, 432, 241, 389, 459, -254, - -254, 450, 186, 187, 442, 452, -254, 465, 466, 460, - 467, 201, 425, 428, 202, 203, 204, 205, 468, 543, - 473, 172, 173, 174, 172, 173, 174, 474, 475, -254, - -254, -254, -254, 199, 200, 478, -254, 476, -254, 201, - 477, -254, 202, 203, 204, 205, 481, 428, -254, -254, - 488, 480, 484, 395, 566, 486, 485, 172, 173, 174, - 489, -254, 491, -254, -254, -254, 493, -254, -254, -254, + 113, 255, 59, 160, 17, 433, 143, 268, 269, 161, + 176, 120, 177, 103, 163, 175, 503, 138, 377, 83, + 285, 245, 118, 421, 246, 122, 16, 124, 125, 274, + 126, 127, 114, 422, 18, 129, 117, 115, 151, 117, + 83, 117, 117, 21, 117, 117, 23, 146, 147, 170, + 139, 551, 406, 114, 392, 152, 21, 552, 115, 23, + 153, 145, 117, 207, 207, 208, 208, 159, 83, -286, + -286, -286, -286, 429, 530, -288, 117, -288, 214, 130, + -261, 314, 315, 435, 316, 136, 440, 441, 137, 143, + 317, 179, 180, 318, 319, 348, 320, 21, 175, 564, + 23, -288, 273, -288, 182, 183, 254, 243, 178, 271, + 279, 447, 247, 181, -260, 228, 280, 143, 58, 184, + 121, 258, 123, 206, 375, 373, -262, 394, -290, 267, + 59, 59, -264, 131, 58, 570, 213, 321, 135, 58, + 527, 528, 141, 270, 410, 149, 218, 58, 155, 282, + 162, 220, 164, 165, 166, 167, 168, 145, 338, 339, + 172, 173, 174, -263, 287, 288, 289, 483, 291, 292, + 294, 172, 173, 174, 278, 412, 471, 221, 156, 353, + 322, 323, 172, 173, 174, 354, 393, 157, 58, 172, + 173, 174, 172, 173, 174, 409, 222, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 507, 508, 223, 172, + 173, 174, 411, 414, 433, 342, 343, 344, 345, 347, + 374, 355, 356, 325, 358, 359, 496, 229, 362, 364, + 362, 362, 362, 362, 172, 173, 174, 457, 230, 535, + 172, 173, 174, 352, 172, 173, 174, 209, 59, 210, + 211, 449, 212, 172, 173, 174, 276, -291, -291, -291, + 205, 232, 384, 286, 462, 133, 134, 387, 216, 217, + 172, 173, 174, 555, 235, 290, 464, 391, 172, 173, + 174, 295, 233, 257, 296, 297, 298, 299, 300, 301, + 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, + 312, 313, 172, 173, 174, 256, 259, 398, 399, 261, + 353, 492, 84, 265, 405, 263, 354, 272, 283, 116, + 285, 413, 116, 357, 116, 116, 336, 116, 116, 172, + 173, 174, 224, 340, 425, 364, 428, 428, 415, 143, + 369, 117, 372, 140, 116, 116, 148, 437, 501, 461, + 428, 428, 439, 378, 346, 236, 237, 238, 239, 116, + 506, 225, 240, 509, 241, 431, 382, 513, 514, 385, + 226, 58, 450, 383, 352, 390, 172, 173, 174, 172, + 173, 174, 392, 397, 458, 524, 525, 174, 400, 172, + 173, 174, 172, 173, 174, 536, 172, 173, 174, 59, + 201, 231, 401, 202, 203, 204, 205, 172, 173, 174, + 544, 402, 469, 403, 546, 547, 472, 407, -83, 186, + 187, 381, 417, 172, 173, 174, 533, 479, 423, 58, + 432, 428, 559, 260, 442, 459, 143, 446, 465, 487, + 116, 541, 542, 452, 466, 467, 567, 468, 197, 198, + 199, 200, 389, 550, 572, 473, 201, 186, 187, 202, + 203, 204, 205, 556, 557, 478, -215, 474, 481, 475, + 428, 428, 515, 488, 517, 476, 565, 207, 477, 208, + -215, -215, 480, 522, 186, 187, 484, -215, 199, 200, + 485, 450, 489, 491, 201, 493, 460, 202, 203, 204, + 205, 495, 425, 428, 172, 173, 174, 494, 497, 543, + 504, -215, -215, -215, -215, 511, 200, 512, -215, 516, + -215, 201, 531, -215, 202, 203, 204, 205, 518, 519, + -215, -215, 523, 395, 360, 532, 548, 428, 545, 172, + 173, 174, 486, -215, 566, -215, -215, -215, 549, -215, + -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, 560, -254, 186, 187, -215, 408, 561, + -215, -215, -215, -215, -215, 563, 571, -215, -254, -254, + 365, 366, 367, 368, 107, -254, 172, 173, 174, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 172, 173, + 174, 426, 201, 242, 534, 202, 203, 204, 205, -254, + -254, -254, -254, 568, 470, 455, -254, 388, -254, 371, + 444, -254, 490, 445, 116, 499, 277, 456, -254, -254, + 521, 438, 172, 173, 174, 351, 0, 0, 0, 0, + 0, -254, 0, -254, -254, -254, 0, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, 172, 173, 174, 494, -254, 408, 495, -254, -254, - -254, -254, -254, -13, 85, 497, -254, 365, 366, 367, - 368, 504, 511, 18, 83, 518, 19, 512, 516, 519, - 455, 20, 21, 22, 86, 23, 24, 25, 26, 27, - 28, 523, 29, 30, 31, 32, 33, 34, 87, 106, - 88, 89, 90, 35, 36, 91, 92, 93, 94, 95, - 96, 186, 187, 531, 97, 98, 99, 100, 37, 532, - 101, 38, 39, 40, 41, 42, 545, 548, 43, 44, - 45, 46, 47, 48, 49, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 50, 549, 560, 561, 201, 563, - 571, 202, 203, 204, 205, 107, -3, 85, 242, 51, - 52, 426, 53, 534, 54, 55, 18, 83, 568, 19, - 470, 56, 57, 58, 20, 21, 22, 86, 23, 24, - 25, 26, 27, 28, 388, 29, 30, 31, 32, 33, - 34, 87, 106, 88, 89, 90, 35, 36, 91, 92, - 93, 94, 95, 96, 186, 187, 371, 97, 98, 99, - 100, 37, 444, 101, 38, 39, 40, 41, 42, 445, - 490, 43, 44, 45, 46, 47, 48, 49, 499, 193, - 194, 195, 196, 197, 198, 199, 200, 50, 277, 521, - 438, 201, 351, 0, 202, 203, 204, 205, 0, 0, - 85, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 83, 416, 19, 0, 56, 57, 58, 20, 21, 22, - 86, 23, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 87, 106, 88, 89, 90, 35, - 36, 91, 92, 93, 94, 95, 96, 186, 187, 0, - 97, 98, 99, 100, 37, 0, 101, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 194, 195, 196, 197, 198, 199, 200, - 50, 0, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 85, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 83, 537, 19, 0, 56, 57, 58, - 20, 21, 22, 86, 23, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 87, 106, 88, - 89, 90, 35, 36, 91, 92, 93, 94, 95, 96, - 186, 187, 0, 97, 98, 99, 100, 37, 0, 101, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 195, 196, 197, - 198, 199, 200, 50, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 85, 0, 51, 52, - 0, 53, 0, 54, 55, 18, 83, 538, 19, 0, - 56, 57, 58, 20, 21, 22, 86, 23, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 87, 106, 88, 89, 90, 35, 36, 91, 92, 93, - 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, - 37, 0, 101, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 197, 198, 199, 200, 50, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 83, - 540, 19, 0, 56, 57, 58, 20, 21, 22, 86, - 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 87, 106, 88, 89, 90, 35, 36, + -254, 463, 0, -13, 85, -254, 0, 0, -254, -254, + -254, -254, -254, 18, 83, -254, 19, 0, 0, 0, + 0, 20, 21, 22, 86, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 87, + 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, + 95, 96, 186, 187, 0, 97, 98, 99, 100, 38, + 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 193, 194, 195, + 196, 197, 198, 199, 200, 51, 0, 0, 0, 201, + 0, 0, 202, 203, 204, 205, 0, -3, 85, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 83, 0, + 19, 0, 57, 58, 0, 20, 21, 22, 86, 23, + 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, + 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, - 98, 99, 100, 37, 0, 101, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 1, 2, 3, 4, 5, 6, 7, 0, 200, 50, + 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, + 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, + 0, 0, 194, 195, 196, 197, 198, 199, 200, 51, 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 85, 0, 51, 52, 0, 53, 0, 54, - 55, 18, 83, 554, 19, 0, 56, 57, 58, 20, - 21, 22, 86, 23, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 87, 106, 88, 89, - 90, 35, 36, 91, 92, 93, 94, 95, 96, 172, - 173, 174, 97, 98, 99, 100, 37, 0, 101, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 200, 0, 0, 456, 0, - 201, 0, 50, 202, 203, 204, 205, 0, 0, 0, - 0, 0, 0, 0, 0, 85, 0, 51, 52, 0, - 53, 0, 54, 55, 18, 83, 0, 19, 0, 56, - 57, 58, 20, 21, 22, 86, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 87, - 106, 88, 89, 90, 35, 36, 91, 92, 93, 94, - 95, 96, 172, 173, 174, 97, 98, 99, 100, 37, - 0, 101, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 569, 0, - 0, 463, 0, 0, 0, 50, 0, 0, 0, 0, + 0, 0, 85, 0, 52, 53, 0, 54, 0, 55, + 56, 18, 83, 416, 19, 0, 57, 58, 0, 20, + 21, 22, 86, 23, 24, 25, 26, 27, 28, 29, + 0, 30, 31, 32, 33, 34, 35, 87, 106, 88, + 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, + 186, 187, 0, 97, 98, 99, 100, 38, 0, 101, + 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, + 47, 48, 49, 50, 0, 0, 0, 195, 196, 197, + 198, 199, 200, 51, 0, 0, 0, 201, 0, 0, + 202, 203, 204, 205, 0, 0, 85, 0, 52, 53, + 0, 54, 0, 55, 56, 18, 83, 537, 19, 0, + 57, 58, 0, 20, 21, 22, 86, 23, 24, 25, + 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, + 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, + 93, 94, 95, 96, 186, 0, 0, 97, 98, 99, + 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, + 0, 44, 45, 46, 47, 48, 49, 50, 1, 2, + 3, 4, 5, 6, 7, 0, 200, 51, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, + 85, 0, 52, 53, 0, 54, 0, 55, 56, 18, + 83, 538, 19, 0, 57, 58, 0, 20, 21, 22, + 86, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, + 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 200, 0, 0, 0, 0, 201, + 0, 51, 202, 203, 204, 205, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 83, 540, 19, 0, 57, 58, + 0, 20, 21, 22, 86, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 87, + 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, + 95, 96, 0, 0, 0, 97, 98, 99, 100, 38, + 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, - 51, 52, 0, 53, 0, 54, 55, 18, 83, 0, - 19, 0, 56, 57, 58, 20, 21, 22, 86, 23, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 87, 106, 88, 89, 90, 35, 36, 91, - 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, - 99, 100, 37, 0, 101, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 83, 554, + 19, 0, 57, 58, 0, 20, 21, 22, 86, 23, + 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, + 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, + 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, + 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, + 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 85, 0, 51, 52, 0, 53, 0, 54, 55, - 18, 83, 0, 19, 0, 56, 57, 58, 20, 21, - 22, 86, 23, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 87, 0, 88, 89, 90, - 35, 36, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 37, 0, 101, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 85, 0, 51, 52, 0, 53, - 0, 54, 55, 18, 0, 0, 19, 0, 56, 57, - 58, 20, 21, 22, -78, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 85, 0, 51, - 52, 0, 53, 0, 54, 55, 18, 0, 0, 19, - 0, 56, 57, 58, 20, 21, 22, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, + 0, 0, 85, 0, 52, 53, 0, 54, 0, 55, + 56, 18, 83, 0, 19, 0, 57, 58, 0, 20, + 21, 22, 86, 23, 24, 25, 26, 27, 28, 29, + 0, 30, 31, 32, 33, 34, 35, 87, 106, 88, + 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, + 0, 0, 0, 97, 98, 99, 100, 38, 0, 101, + 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, + 47, 48, 49, 50, 0, 0, 569, 0, 0, 0, + 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 85, 0, 52, 53, + 0, 54, 0, 55, 56, 18, 83, 0, 19, 0, + 57, 58, 0, 20, 21, 22, 86, 23, 24, 25, + 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, + 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, + 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 85, 0, 52, 53, 0, 54, 0, 55, 56, 18, + 83, 0, 19, 0, 57, 58, 0, 20, 21, 22, + 86, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 87, 0, 88, 89, 90, + 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, + 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 0, 0, 19, 0, 57, 58, + 0, 20, 21, 22, -78, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 236, 237, 238, 239, + 0, 0, 0, 240, 0, 241, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 172, 173, 174, 0, 0, 51, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 0, 57, 58, 0, 20, 21, 22, 0, 23, + 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, + 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 83, 0, 19, -78, 56, 57, 58, 20, 21, 22, - 0, 23, 141, 25, 26, 27, 28, 115, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 0, 0, 19, 119, 56, 57, 58, - 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 18, 83, 0, 19, 0, - 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, + 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 50, 0, 0, 0, + 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, + 56, 18, 83, 0, 19, -78, 57, 58, 0, 20, + 21, 22, 0, 23, 24, 142, 26, 27, 28, 29, + 115, 30, 31, 32, 33, 34, 35, 0, 0, 0, + 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, + 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, + 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, + 0, 54, 0, 55, 56, 18, 0, 0, 19, 119, + 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, + 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, + 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 18, 0, - 0, 19, 0, 56, 57, 58, 20, 21, 22, 149, - 23, 24, 25, 26, 27, 28, 0, 29, 30, 31, - 32, 33, 34, 0, 0, 0, 0, 0, 35, 36, + 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, + 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 37, 0, 0, 38, 39, 40, 41, - 42, 0, 0, 43, 44, 45, 46, 47, 48, 49, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 50, + 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, + 83, 0, 19, 0, 57, 58, 0, 20, 21, 22, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, + 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 0, 0, 19, 0, 57, 58, + 0, 20, 21, 22, 150, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 51, 52, 0, 53, 0, 54, - 55, 18, 0, 0, 19, 0, 56, 57, 58, 20, - 21, 22, 0, 23, 24, 25, 26, 27, 28, 0, - 29, 30, 31, 32, 33, 34, 0, 0, 0, 0, - 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 37, 0, 0, 38, - 39, 40, 41, 42, 0, 0, 43, 44, 45, 46, - 47, 48, 49, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 50, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 52, 0, - 53, 0, 54, 55, 18, 0, 0, 19, 168, 56, - 57, 58, 20, 21, 22, 0, 23, 24, 25, 26, - 27, 28, 0, 29, 30, 31, 32, 33, 34, 0, - 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 37, - 0, 0, 38, 39, 40, 41, 42, 0, 0, 43, - 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 50, 0, 0, 0, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 0, 57, 58, 0, 20, 21, 22, 0, 23, + 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, + 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, + 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 52, 0, 53, 0, 54, 55, 18, 0, 0, - 19, 266, 56, 57, 58, 20, 21, 22, 0, 23, - 24, 25, 26, 27, 28, 0, 29, 30, 31, 32, - 33, 34, 0, 0, 0, 0, 0, 35, 36, 0, + 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, + 56, 18, 0, 0, 19, 169, 57, 58, 0, 20, + 21, 22, 0, 23, 24, 25, 26, 27, 28, 29, + 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, + 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, + 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, + 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, + 0, 54, 0, 55, 56, 18, 0, 0, 19, 266, + 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, + 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, + 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 37, 0, 0, 38, 39, 40, 41, 42, - 0, 0, 43, 44, 45, 46, 47, 48, 49, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 50, 0, + 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, + 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 52, 0, 53, 0, 54, 55, - 18, 0, 0, 19, 281, 56, 57, 58, 20, 21, - 22, 0, 23, 24, 25, 26, 27, 28, 0, 29, - 30, 31, 32, 33, 34, 0, 0, 0, 0, 0, - 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 37, 0, 0, 38, 39, - 40, 41, 42, 0, 0, 43, 44, 45, 46, 47, - 48, 49, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 52, 0, 53, - 0, 54, 55, 18, 0, 0, 19, 293, 56, 57, - 58, 20, 21, 22, 0, 23, 24, 25, 26, 27, - 28, 0, 29, 30, 31, 32, 33, 34, 0, 0, - 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 37, 0, - 0, 38, 39, 40, 41, 42, 0, 0, 43, 44, - 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 50, 0, 0, 0, 0, 0, + 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, + 0, 0, 19, 281, 57, 58, 0, 20, 21, 22, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, + 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 0, 0, 19, 293, 57, 58, + 0, 20, 21, 22, 0, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 326, 57, 58, 0, 20, 21, 22, 0, 23, + 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, + 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, + 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 52, 0, 53, 0, 54, 55, 18, 0, 0, 19, - 326, 56, 57, 58, 20, 21, 22, 0, 23, 24, - 25, 26, 27, 28, 0, 29, 30, 31, 32, 33, - 34, 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 37, 0, 0, 38, 39, 40, 41, 42, 0, - 0, 43, 44, 45, 46, 47, 48, 49, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 50, 0, 0, + 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, + 56, 18, 0, 0, 19, 386, 57, 58, 0, 20, + 21, 22, 0, 23, 24, 25, 26, 27, 28, 29, + 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, + 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, + 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, + 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, + 0, 54, 0, 55, 56, 18, 0, 0, 19, 404, + 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, + 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, + 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 51, 52, 0, 53, 0, 54, 55, 18, - 0, 0, 19, 386, 56, 57, 58, 20, 21, 22, - 0, 23, 24, 25, 26, 27, 28, 0, 29, 30, - 31, 32, 33, 34, 0, 0, 0, 0, 0, 35, - 36, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 37, 0, 0, 38, 39, 40, - 41, 42, 0, 0, 43, 44, 45, 46, 47, 48, - 49, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 52, 0, 53, 0, - 54, 55, 18, 0, 0, 19, 403, 56, 57, 58, - 20, 21, 22, 0, 23, 24, 25, 26, 27, 28, - 0, 29, 30, 31, 32, 33, 34, 0, 0, 0, - 0, 0, 35, 36, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 37, 0, 0, - 38, 39, 40, 41, 42, 0, 0, 43, 44, 45, - 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 51, 52, - 0, 53, 0, 54, 55, 18, 0, 0, 19, 0, - 56, 57, 58, 20, 21, 22, 0, 23, 24, 25, - 26, 27, 28, 0, 29, 30, 31, 32, 33, 34, - 0, 0, 0, 0, 0, 35, 36, 0, 0, 0, + 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, + 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 37, 0, 0, 38, 39, 40, 41, 42, 0, 0, - 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, - 0, 0, 0, 0, 506, 0, 50, 509, 0, 0, - 0, 513, 514, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 52, 0, 53, 0, 54, 55, 0, 524, - 525, 0, 0, 275, 57, 58, 185, 0, 0, 536, - 0, 0, 0, 186, 187, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 544, 0, 0, 0, 546, 547, - 0, 0, 188, 189, 396, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 559, 0, 0, 0, - 201, 185, 0, 202, 203, 204, 205, 0, 186, 187, - 567, 0, 0, 0, 0, 0, 0, 0, 572, 0, - 0, 0, 0, 0, 0, 0, 0, 188, 189, 0, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, 185, 0, 202, 203, - 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, + 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, + 0, 0, 19, 0, 57, 58, 0, 20, 21, 22, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, + 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 0, 185, 0, 0, 0, 0, 0, + 0, 186, 187, 0, 0, 0, 52, 53, 0, 54, + 0, 55, 56, 0, 0, 0, 0, 0, 275, 58, + 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 189, 0, 190, 191, 192, 193, 194, - 195, 196, 197, 198, 199, 200, 0, 0, 0, 0, - 201, -291, 0, 202, 203, 204, 205, 0, 186, 187, + 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, + 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 189, 0, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 0, 0, 0, 0, 201, -291, + 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 0, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205 + 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, + 0, 0, 0, 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 125, 10, 48, 9, 42, 48, 11, 14, 13, - 475, 19, 345, 50, 355, 137, 138, 12, 262, 10, - 506, 11, 355, 11, 13, 358, 359, 0, 19, 153, - 15, 22, 14, 23, 75, 23, 23, 45, 28, 13, - 28, 28, 19, 19, 13, 22, 22, 19, 56, 11, - 22, 11, 18, 13, 11, 21, 11, 23, 13, 25, - 26, 18, 108, 11, 21, 13, 23, 108, 25, 26, - 11, 15, 78, 79, 80, 108, 42, 43, 83, 70, - 21, 567, 48, 72, 41, 42, 43, 44, 125, 21, - 108, 57, 58, 558, 26, 14, 78, 79, 80, 92, - 57, 58, 11, 72, 108, 11, 439, 13, 145, 90, - 155, 106, 72, 155, 92, 93, 153, 72, 109, 109, - 128, 109, 110, 20, 72, 22, 111, 99, 136, 137, - 138, 97, 109, 109, 256, 32, 108, 109, 90, 91, - 37, 108, 14, 100, 41, 478, 479, 44, 156, 11, - 47, 13, 49, 63, 51, 52, 53, 54, 55, 78, - 79, 80, 48, 49, 172, 173, 174, 11, 176, 177, - 178, 14, 138, 11, 131, 13, 420, 14, 511, 108, - 225, 138, 11, 225, 13, 95, 78, 79, 80, 155, - 100, 14, 23, 103, 104, 105, 106, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 78, 79, 80, 78, - 79, 80, 545, 216, 217, 220, 221, 222, 223, 224, - 257, 226, 227, 564, 229, 230, 470, 108, 236, 237, - 238, 239, 240, 241, 108, 78, 79, 80, 107, 205, - 108, 78, 79, 80, 108, 11, 18, 13, 256, 21, - 108, 23, 376, 25, 26, 78, 79, 80, 155, 225, - 10, 11, 270, 13, 21, 14, 21, 275, 50, 19, - 42, 43, 22, 21, 24, 108, 233, 285, 175, 14, - 78, 79, 80, 21, 181, 407, 58, 184, 185, 186, - 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 201, 35, 36, 315, 316, 107, - 21, 356, 75, 321, 356, 65, 89, 90, 107, 44, - 45, 46, 47, 78, 79, 80, 51, 26, 53, 78, - 79, 80, 72, 107, 342, 343, 344, 345, 21, 376, - 78, 79, 80, 78, 79, 80, 21, 355, 12, 473, - 358, 359, 357, 78, 79, 80, 322, 72, 108, 109, - 110, 13, 0, 21, 509, 322, 138, 78, 79, 80, - 23, 21, 377, 11, 23, 13, 14, 15, 99, 524, - 525, 347, 107, 21, 392, 103, 104, 105, 106, 108, - 356, 536, 28, 15, 70, 78, 79, 80, 26, 407, - 107, 546, 547, 78, 79, 80, 44, 45, 46, 47, - 76, 12, 417, 51, 559, 53, 421, 26, 56, 13, - 78, 79, 80, 99, 80, 63, 64, 432, 78, 79, - 80, 439, 108, 109, 108, 17, 473, 110, 76, 447, - 78, 79, 80, 110, 82, 83, 84, 85, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 78, 79, - 80, 23, 100, 110, 110, 103, 104, 105, 106, 107, - 478, 479, 489, 111, 491, 0, 110, 44, 45, 46, - 47, 107, 109, 500, 51, 108, 53, 107, 12, 14, - 15, 496, 63, 64, 82, 108, 21, 12, 12, 396, - 12, 100, 510, 511, 103, 104, 105, 106, 12, 526, - 23, 78, 79, 80, 78, 79, 80, 107, 107, 44, - 45, 46, 47, 94, 95, 108, 51, 107, 53, 100, - 107, 56, 103, 104, 105, 106, 21, 545, 63, 64, - 76, 107, 107, 107, 561, 442, 107, 78, 79, 80, - 11, 76, 11, 78, 79, 80, 12, 82, 83, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 78, 79, 80, 107, 100, 107, 21, 103, 104, - 105, 106, 107, 0, 1, 21, 111, 238, 239, 240, - 241, 11, 108, 10, 11, 74, 13, 107, 107, 21, - 107, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 21, 29, 30, 31, 32, 33, 34, 35, 36, + 17, 126, 10, 49, 9, 355, 43, 138, 139, 49, + 11, 19, 13, 12, 51, 15, 475, 76, 262, 11, + 13, 19, 18, 11, 22, 21, 0, 23, 24, 154, + 26, 27, 24, 21, 10, 13, 18, 29, 46, 21, + 11, 23, 24, 19, 26, 27, 22, 43, 44, 57, + 109, 21, 23, 24, 13, 24, 19, 27, 29, 22, + 29, 43, 44, 11, 11, 13, 13, 49, 11, 11, + 11, 13, 13, 345, 506, 11, 58, 13, 83, 109, + 73, 10, 11, 355, 13, 109, 358, 359, 109, 126, + 19, 93, 94, 22, 23, 71, 25, 19, 15, 558, + 22, 11, 21, 13, 91, 92, 14, 106, 109, 146, + 156, 111, 110, 93, 73, 97, 156, 154, 110, 91, + 20, 129, 22, 109, 14, 256, 73, 14, 11, 137, + 138, 139, 73, 33, 110, 567, 11, 66, 38, 110, + 49, 50, 42, 139, 14, 45, 24, 110, 48, 157, + 50, 109, 52, 53, 54, 55, 56, 139, 216, 217, + 79, 80, 81, 73, 172, 173, 174, 439, 176, 177, + 178, 79, 80, 81, 156, 14, 420, 109, 100, 225, + 109, 110, 79, 80, 81, 225, 21, 109, 110, 79, + 80, 81, 79, 80, 81, 21, 109, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 478, 479, 109, 79, + 80, 81, 21, 14, 564, 220, 221, 222, 223, 224, + 257, 226, 227, 205, 229, 230, 470, 109, 236, 237, + 238, 239, 240, 241, 79, 80, 81, 14, 109, 511, + 79, 80, 81, 225, 79, 80, 81, 11, 256, 13, + 11, 376, 13, 79, 80, 81, 156, 104, 105, 106, + 107, 21, 270, 108, 14, 36, 37, 275, 89, 90, + 79, 80, 81, 545, 21, 175, 407, 285, 79, 80, + 81, 181, 51, 76, 184, 185, 186, 187, 188, 189, + 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 201, 79, 80, 81, 109, 108, 315, 316, 27, + 356, 14, 11, 108, 322, 73, 356, 12, 73, 18, + 13, 21, 21, 109, 23, 24, 24, 26, 27, 79, + 80, 81, 71, 24, 342, 343, 344, 345, 21, 376, + 29, 323, 15, 42, 43, 44, 45, 355, 473, 21, + 358, 359, 357, 27, 100, 45, 46, 47, 48, 58, + 477, 100, 52, 480, 54, 347, 77, 484, 485, 12, + 109, 110, 377, 108, 356, 27, 79, 80, 81, 79, + 80, 81, 13, 23, 392, 502, 503, 81, 23, 79, + 80, 81, 79, 80, 81, 512, 79, 80, 81, 407, + 101, 100, 23, 104, 105, 106, 107, 79, 80, 81, + 527, 23, 417, 23, 531, 532, 421, 109, 108, 64, + 65, 108, 17, 79, 80, 81, 509, 432, 24, 110, + 109, 439, 549, 132, 83, 12, 473, 108, 12, 447, + 139, 524, 525, 109, 12, 12, 563, 12, 93, 94, + 95, 96, 108, 536, 571, 24, 101, 64, 65, 104, + 105, 106, 107, 546, 547, 109, 0, 108, 21, 108, + 478, 479, 489, 77, 491, 108, 559, 11, 108, 13, + 14, 15, 108, 500, 64, 65, 108, 21, 95, 96, + 108, 496, 11, 11, 101, 12, 396, 104, 105, 106, + 107, 21, 510, 511, 79, 80, 81, 108, 21, 526, + 11, 45, 46, 47, 48, 109, 96, 108, 52, 108, + 54, 101, 108, 57, 104, 105, 106, 107, 75, 21, + 64, 65, 21, 108, 233, 108, 21, 545, 109, 79, + 80, 81, 442, 77, 561, 79, 80, 81, 108, 83, + 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 96, 16, 0, 64, 65, 101, 108, 74, + 104, 105, 106, 107, 108, 108, 108, 111, 14, 15, + 238, 239, 240, 241, 13, 21, 79, 80, 81, 88, + 89, 90, 91, 92, 93, 94, 95, 96, 79, 80, + 81, 343, 101, 106, 510, 104, 105, 106, 107, 45, + 46, 47, 48, 564, 419, 108, 52, 277, 54, 248, + 371, 57, 452, 372, 323, 471, 156, 108, 64, 65, + 496, 356, 79, 80, 81, 225, -1, -1, -1, -1, + -1, 77, -1, 79, 80, 81, -1, 83, 84, 85, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 108, -1, 0, 1, 101, -1, -1, 104, 105, + 106, 107, 108, 10, 11, 111, 13, -1, -1, -1, + -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 63, 64, 107, 51, 52, 53, 54, 55, 107, - 57, 58, 59, 60, 61, 62, 108, 21, 65, 66, - 67, 68, 69, 70, 71, 87, 88, 89, 90, 91, - 92, 93, 94, 95, 81, 107, 16, 73, 100, 107, - 107, 103, 104, 105, 106, 13, 0, 1, 106, 96, - 97, 343, 99, 510, 101, 102, 10, 11, 564, 13, - 419, 108, 109, 110, 18, 19, 20, 21, 22, 23, - 24, 25, 26, 27, 277, 29, 30, 31, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 63, 64, 248, 51, 52, 53, - 54, 55, 371, 57, 58, 59, 60, 61, 62, 372, - 452, 65, 66, 67, 68, 69, 70, 71, 471, 88, - 89, 90, 91, 92, 93, 94, 95, 81, 155, 496, - 356, 100, 225, -1, 103, 104, 105, 106, -1, -1, - 1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, 12, 13, -1, 108, 109, 110, 18, 19, 20, - 21, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, 63, 64, -1, - 51, 52, 53, 54, 55, -1, 57, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, 89, 90, 91, 92, 93, 94, 95, - 81, -1, -1, -1, 100, -1, -1, 103, 104, 105, - 106, -1, -1, 1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, 11, 12, 13, -1, 108, 109, 110, - 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - 63, 64, -1, 51, 52, 53, 54, 55, -1, 57, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, 90, 91, 92, - 93, 94, 95, 81, -1, -1, -1, 100, -1, -1, - 103, 104, 105, 106, -1, -1, 1, -1, 96, 97, - -1, 99, -1, 101, 102, 10, 11, 12, 13, -1, - 108, 109, 110, 18, 19, 20, 21, 22, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, + 47, 48, 64, 65, -1, 52, 53, 54, 55, 56, + -1, 58, 59, 60, 61, 62, 63, -1, -1, 66, + 67, 68, 69, 70, 71, 72, -1, 89, 90, 91, + 92, 93, 94, 95, 96, 82, -1, -1, -1, 101, + -1, -1, 104, 105, 106, 107, -1, 0, 1, -1, + 97, 98, -1, 100, -1, 102, 103, 10, 11, -1, + 13, -1, 109, 110, -1, 18, 19, 20, 21, 22, + 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, + 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, + 43, 44, 45, 46, 47, 48, 64, 65, -1, 52, + 53, 54, 55, 56, -1, 58, 59, 60, 61, 62, + 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, + -1, -1, 90, 91, 92, 93, 94, 95, 96, 82, + -1, -1, -1, 101, -1, -1, 104, 105, 106, 107, + -1, -1, 1, -1, 97, 98, -1, 100, -1, 102, + 103, 10, 11, 12, 13, -1, 109, 110, -1, 18, + 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, + -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, + 64, 65, -1, 52, 53, 54, 55, 56, -1, 58, + 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, + 69, 70, 71, 72, -1, -1, -1, 91, 92, 93, + 94, 95, 96, 82, -1, -1, -1, 101, -1, -1, + 104, 105, 106, 107, -1, -1, 1, -1, 97, 98, + -1, 100, -1, 102, 103, 10, 11, 12, 13, -1, + 109, 110, -1, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 63, 64, -1, 51, 52, 53, 54, - 55, -1, 57, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, 92, 93, 94, 95, 81, -1, -1, -1, - 100, -1, -1, 103, 104, 105, 106, -1, -1, 1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, 11, - 12, 13, -1, 108, 109, 110, 18, 19, 20, 21, - 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 63, 64, -1, 51, - 52, 53, 54, 55, -1, 57, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - 3, 4, 5, 6, 7, 8, 9, -1, 95, 81, - -1, -1, -1, 100, -1, -1, 103, 104, 105, 106, - -1, -1, 1, -1, 96, 97, -1, 99, -1, 101, - 102, 10, 11, 12, 13, -1, 108, 109, 110, 18, - 19, 20, 21, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 78, - 79, 80, 51, 52, 53, 54, 55, -1, 57, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, -1, 95, -1, -1, 107, -1, - 100, -1, 81, 103, 104, 105, 106, -1, -1, -1, - -1, -1, -1, -1, -1, 1, -1, 96, 97, -1, - 99, -1, 101, 102, 10, 11, -1, 13, -1, 108, - 109, 110, 18, 19, 20, 21, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 78, 79, 80, 51, 52, 53, 54, 55, - -1, 57, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, 74, -1, - -1, 107, -1, -1, -1, 81, -1, -1, -1, -1, + 45, 46, 47, 48, 64, -1, -1, 52, 53, 54, + 55, 56, -1, 58, 59, 60, 61, 62, 63, -1, + -1, 66, 67, 68, 69, 70, 71, 72, 3, 4, + 5, 6, 7, 8, 9, -1, 96, 82, -1, -1, + -1, 101, -1, -1, 104, 105, 106, 107, -1, -1, + 1, -1, 97, 98, -1, 100, -1, 102, 103, 10, + 11, 12, 13, -1, 109, 110, -1, 18, 19, 20, + 21, 22, 23, 24, 25, 26, 27, 28, -1, 30, + 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, 48, -1, -1, + -1, 52, 53, 54, 55, 56, -1, 58, 59, 60, + 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, + 71, 72, -1, -1, 96, -1, -1, -1, -1, 101, + -1, 82, 104, 105, 106, 107, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 97, 98, -1, 100, + -1, 102, 103, 10, 11, 12, 13, -1, 109, 110, + -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, -1, -1, -1, 52, 53, 54, 55, 56, + -1, 58, 59, 60, 61, 62, 63, -1, -1, 66, + 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, - 96, 97, -1, 99, -1, 101, 102, 10, 11, -1, - 13, -1, 108, 109, 110, 18, 19, 20, 21, 22, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, + 97, 98, -1, 100, -1, 102, 103, 10, 11, 12, + 13, -1, 109, 110, -1, 18, 19, 20, 21, 22, + 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, -1, -1, -1, 51, 52, - 53, 54, 55, -1, 57, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + 43, 44, 45, 46, 47, 48, -1, -1, -1, 52, + 53, 54, 55, 56, -1, 58, 59, 60, 61, 62, + 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 1, -1, 96, 97, -1, 99, -1, 101, 102, - 10, 11, -1, 13, -1, 108, 109, 110, 18, 19, - 20, 21, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, 35, -1, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, -1, -1, - -1, 51, 52, 53, 54, 55, -1, 57, 58, 59, - 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 96, 97, -1, 99, - -1, 101, 102, 10, -1, -1, 13, -1, 108, 109, - 110, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, - -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, - -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 1, -1, 96, - 97, -1, 99, -1, 101, 102, 10, -1, -1, 13, - -1, 108, 109, 110, 18, 19, 20, -1, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, + -1, -1, 1, -1, 97, 98, -1, 100, -1, 102, + 103, 10, 11, -1, 13, -1, 109, 110, -1, 18, + 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, + -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, + 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, + -1, -1, -1, 52, 53, 54, 55, 56, -1, 58, + 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, + 69, 70, 71, 72, -1, -1, 75, -1, -1, -1, + -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 1, -1, 97, 98, + -1, 100, -1, 102, 103, 10, 11, -1, 13, -1, + 109, 110, -1, 18, 19, 20, 21, 22, 23, 24, + 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, + 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, + 45, 46, 47, 48, -1, -1, -1, 52, 53, 54, + 55, 56, -1, 58, 59, 60, 61, 62, 63, -1, + -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, + 1, -1, 97, 98, -1, 100, -1, 102, 103, 10, + 11, -1, 13, -1, 109, 110, -1, 18, 19, 20, + 21, 22, 23, 24, 25, 26, 27, 28, -1, 30, + 31, 32, 33, 34, 35, 36, -1, 38, 39, 40, + 41, 42, 43, 44, 45, 46, 47, 48, -1, -1, + -1, 52, 53, 54, 55, 56, -1, 58, 59, 60, + 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, + 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 97, 98, -1, 100, + -1, 102, 103, 10, -1, -1, 13, -1, 109, 110, + -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, + -1, -1, -1, -1, 41, 42, 45, 46, 47, 48, + -1, -1, -1, 52, -1, 54, -1, -1, -1, 56, + -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, + 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, + 79, 80, 81, -1, -1, 82, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, + 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, + 13, -1, 109, 110, -1, 18, 19, 20, -1, 22, + 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, + 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - 11, -1, 13, 107, 108, 109, 110, 18, 19, 20, - -1, 22, 23, 24, 25, 26, 27, 28, 29, 30, - 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, - 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, -1, -1, 13, 14, 108, 109, 110, - 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, - -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 10, 11, -1, 13, -1, - 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, + -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, + 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 81, -1, -1, -1, + -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, + 103, 10, 11, -1, 13, 108, 109, 110, -1, 18, + 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, + 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, + -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, + 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, + 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, + -1, 100, -1, 102, 103, 10, -1, -1, 13, 14, + 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, + 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, + 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, 10, -1, - -1, 13, -1, 108, 109, 110, 18, 19, 20, 21, - 22, 23, 24, 25, 26, 27, -1, 29, 30, 31, - 32, 33, 34, -1, -1, -1, -1, -1, 40, 41, + -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, + -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 55, -1, -1, 58, 59, 60, 61, - 62, -1, -1, 65, 66, 67, 68, 69, 70, 71, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 81, + -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, + 11, -1, 13, -1, 109, 110, -1, 18, 19, 20, + -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, + 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, + 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, + 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, + 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 97, 98, -1, 100, + -1, 102, 103, 10, -1, -1, 13, -1, 109, 110, + -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, + 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, + -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 56, + -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, + 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 96, 97, -1, 99, -1, 101, - 102, 10, -1, -1, 13, -1, 108, 109, 110, 18, - 19, 20, -1, 22, 23, 24, 25, 26, 27, -1, - 29, 30, 31, 32, 33, 34, -1, -1, -1, -1, - -1, 40, 41, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 55, -1, -1, 58, - 59, 60, 61, 62, -1, -1, 65, 66, 67, 68, - 69, 70, 71, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 81, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 96, 97, -1, - 99, -1, 101, 102, 10, -1, -1, 13, 107, 108, - 109, 110, 18, 19, 20, -1, 22, 23, 24, 25, - 26, 27, -1, 29, 30, 31, 32, 33, 34, -1, - -1, -1, -1, -1, 40, 41, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 55, - -1, -1, 58, 59, 60, 61, 62, -1, -1, 65, - 66, 67, 68, 69, 70, 71, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 81, -1, -1, -1, -1, + 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, + 13, -1, 109, 110, -1, 18, 19, 20, -1, 22, + 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, + 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 96, 97, -1, 99, -1, 101, 102, 10, -1, -1, - 13, 107, 108, 109, 110, 18, 19, 20, -1, 22, - 23, 24, 25, 26, 27, -1, 29, 30, 31, 32, - 33, 34, -1, -1, -1, -1, -1, 40, 41, -1, + -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, + 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 55, -1, -1, 58, 59, 60, 61, 62, - -1, -1, 65, 66, 67, 68, 69, 70, 71, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 81, -1, + -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, + 103, 10, -1, -1, 13, 108, 109, 110, -1, 18, + 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, + -1, 30, 31, 32, 33, 34, 35, -1, -1, -1, + -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, + 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, + 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, + -1, 100, -1, 102, 103, 10, -1, -1, 13, 108, + 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, + 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, + 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 96, 97, -1, 99, -1, 101, 102, - 10, -1, -1, 13, 107, 108, 109, 110, 18, 19, - 20, -1, 22, 23, 24, 25, 26, 27, -1, 29, - 30, 31, 32, 33, 34, -1, -1, -1, -1, -1, - 40, 41, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 55, -1, -1, 58, 59, - 60, 61, 62, -1, -1, 65, 66, 67, 68, 69, - 70, 71, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 81, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 96, 97, -1, 99, - -1, 101, 102, 10, -1, -1, 13, 107, 108, 109, - 110, 18, 19, 20, -1, 22, 23, 24, 25, 26, - 27, -1, 29, 30, 31, 32, 33, 34, -1, -1, - -1, -1, -1, 40, 41, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 55, -1, - -1, 58, 59, 60, 61, 62, -1, -1, 65, 66, - 67, 68, 69, 70, 71, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 81, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 96, - 97, -1, 99, -1, 101, 102, 10, -1, -1, 13, - 107, 108, 109, 110, 18, 19, 20, -1, 22, 23, - 24, 25, 26, 27, -1, 29, 30, 31, 32, 33, - 34, -1, -1, -1, -1, -1, 40, 41, -1, -1, + -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, + -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 55, -1, -1, 58, 59, 60, 61, 62, -1, - -1, 65, 66, 67, 68, 69, 70, 71, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 81, -1, -1, + -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, + -1, -1, 13, 108, 109, 110, -1, 18, 19, 20, + -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, + 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, + 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, + 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, + 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 97, 98, -1, 100, + -1, 102, 103, 10, -1, -1, 13, 108, 109, 110, + -1, 18, 19, 20, -1, 22, 23, 24, 25, 26, + 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, + -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 56, + -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, + 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 96, 97, -1, 99, -1, 101, 102, 10, - -1, -1, 13, 107, 108, 109, 110, 18, 19, 20, - -1, 22, 23, 24, 25, 26, 27, -1, 29, 30, - 31, 32, 33, 34, -1, -1, -1, -1, -1, 40, - 41, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 55, -1, -1, 58, 59, 60, - 61, 62, -1, -1, 65, 66, 67, 68, 69, 70, - 71, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 81, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 96, 97, -1, 99, -1, - 101, 102, 10, -1, -1, 13, 107, 108, 109, 110, - 18, 19, 20, -1, 22, 23, 24, 25, 26, 27, - -1, 29, 30, 31, 32, 33, 34, -1, -1, -1, - -1, -1, 40, 41, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 55, -1, -1, - 58, 59, 60, 61, 62, -1, -1, 65, 66, 67, - 68, 69, 70, 71, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 81, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 96, 97, - -1, 99, -1, 101, 102, 10, -1, -1, 13, -1, - 108, 109, 110, 18, 19, 20, -1, 22, 23, 24, - 25, 26, 27, -1, 29, 30, 31, 32, 33, 34, - -1, -1, -1, -1, -1, 40, 41, -1, -1, -1, + 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, + 13, 108, 109, 110, -1, 18, 19, 20, -1, 22, + 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, + 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 55, -1, -1, 58, 59, 60, 61, 62, -1, -1, - 65, 66, 67, 68, 69, 70, 71, -1, -1, -1, - -1, -1, -1, -1, 477, -1, 81, 480, -1, -1, - -1, 484, 485, -1, -1, -1, -1, -1, -1, -1, - -1, 96, 97, -1, 99, -1, 101, 102, -1, 502, - 503, -1, -1, 108, 109, 110, 56, -1, -1, 512, - -1, -1, -1, 63, 64, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 527, -1, -1, -1, 531, 532, - -1, -1, 82, 83, 84, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, 549, -1, -1, -1, - 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, - 563, -1, -1, -1, -1, -1, -1, -1, 571, -1, - -1, -1, -1, -1, -1, -1, -1, 82, 83, -1, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, 56, -1, 103, 104, - 105, 106, -1, 63, 64, -1, -1, -1, -1, -1, + -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, + 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 83, -1, 85, 86, 87, 88, 89, - 90, 91, 92, 93, 94, 95, -1, -1, -1, -1, - 100, 56, -1, 103, 104, 105, 106, -1, 63, 64, + -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, + 103, 10, -1, -1, 13, 108, 109, 110, -1, 18, + 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, + -1, 30, 31, 32, 33, 34, 35, -1, -1, -1, + -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, + 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, + 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, + -1, 100, -1, 102, 103, 10, -1, -1, 13, 108, + 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, + 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, + 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, + -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, -1, -1, -1, -1, 100, -1, -1, 103, 104, - 105, 106 + -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, + -1, -1, 13, -1, 109, 110, -1, 18, 19, 20, + -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, + 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, + 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, + 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, + 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 82, -1, -1, 57, -1, -1, -1, -1, -1, + -1, 64, 65, -1, -1, -1, 97, 98, -1, 100, + -1, 102, 103, -1, -1, -1, -1, -1, 109, 110, + 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, -1, -1, -1, -1, 101, 57, + -1, 104, 105, 106, 107, -1, 64, 65, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, 84, -1, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 96, -1, + -1, -1, -1, 101, 57, -1, 104, 105, 106, 107, + -1, 64, 65, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 84, -1, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, -1, -1, -1, -1, 101, 57, + -1, 104, 105, 106, 107, -1, 64, 65, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 86, 87, + 88, 89, 90, 91, 92, 93, 94, 95, 96, -1, + -1, -1, -1, 101, -1, -1, 104, 105, 106, 107 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -980,62 +994,62 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 13, - 18, 19, 20, 22, 23, 24, 25, 26, 27, 29, - 30, 31, 32, 33, 34, 40, 41, 55, 58, 59, - 60, 61, 62, 65, 66, 67, 68, 69, 70, 71, - 81, 96, 97, 99, 101, 102, 108, 109, 110, 174, + 18, 19, 20, 22, 23, 24, 25, 26, 27, 28, + 30, 31, 32, 33, 34, 35, 41, 42, 56, 59, + 60, 61, 62, 63, 66, 67, 68, 69, 70, 71, + 72, 82, 97, 98, 100, 102, 103, 109, 110, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 11, 121, 1, 21, 35, 37, 38, - 39, 42, 43, 44, 45, 46, 47, 51, 52, 53, - 54, 57, 121, 130, 141, 174, 36, 128, 129, 130, - 126, 168, 169, 126, 23, 28, 121, 200, 208, 14, - 174, 188, 208, 188, 208, 208, 208, 189, 13, 108, - 188, 152, 152, 152, 188, 108, 108, 75, 108, 121, - 188, 23, 175, 192, 200, 208, 208, 121, 188, 21, - 174, 23, 28, 154, 188, 99, 108, 191, 200, 201, - 202, 188, 175, 188, 188, 188, 188, 188, 107, 174, - 208, 208, 78, 79, 80, 15, 11, 13, 108, 92, - 93, 92, 90, 91, 90, 56, 63, 64, 82, 83, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 100, 103, 104, 105, 106, 108, 11, 13, 11, - 13, 11, 13, 11, 123, 153, 154, 154, 23, 151, - 108, 108, 108, 108, 70, 99, 108, 198, 200, 108, - 108, 121, 21, 50, 143, 21, 44, 45, 46, 47, - 51, 53, 129, 130, 128, 19, 22, 109, 159, 160, - 162, 163, 164, 165, 14, 192, 108, 75, 174, 107, - 121, 26, 155, 72, 156, 107, 107, 174, 193, 193, - 208, 175, 12, 21, 192, 108, 188, 191, 200, 201, - 202, 107, 174, 72, 157, 13, 107, 174, 174, 174, - 188, 174, 174, 107, 174, 188, 188, 188, 188, 188, + 205, 206, 207, 11, 121, 1, 21, 36, 38, 39, + 40, 43, 44, 45, 46, 47, 48, 52, 53, 54, + 55, 58, 121, 130, 141, 174, 37, 128, 129, 130, + 126, 168, 169, 126, 24, 29, 121, 200, 208, 14, + 174, 188, 208, 188, 208, 208, 208, 208, 189, 13, + 109, 188, 152, 152, 152, 188, 109, 109, 76, 109, + 121, 188, 24, 175, 192, 200, 208, 208, 121, 188, + 21, 174, 24, 29, 154, 188, 100, 109, 191, 200, + 201, 202, 188, 175, 188, 188, 188, 188, 188, 108, + 174, 208, 79, 80, 81, 15, 11, 13, 109, 93, + 94, 93, 91, 92, 91, 57, 64, 65, 83, 84, + 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 101, 104, 105, 106, 107, 109, 11, 13, 11, + 13, 11, 13, 11, 123, 153, 154, 154, 24, 151, + 109, 109, 109, 109, 71, 100, 109, 198, 200, 109, + 109, 121, 21, 51, 143, 21, 45, 46, 47, 48, + 52, 54, 129, 130, 128, 19, 22, 110, 159, 160, + 162, 163, 164, 165, 14, 192, 109, 76, 174, 108, + 121, 27, 155, 73, 156, 108, 108, 174, 193, 193, + 208, 175, 12, 21, 192, 109, 188, 191, 200, 201, + 202, 108, 174, 73, 157, 13, 108, 174, 174, 174, + 188, 174, 174, 108, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 13, 19, 22, 24, - 65, 108, 109, 110, 178, 200, 107, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 23, 150, 151, 151, - 23, 133, 123, 123, 123, 123, 99, 123, 70, 196, - 197, 199, 200, 201, 202, 123, 123, 108, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 28, - 158, 158, 15, 193, 175, 14, 177, 156, 26, 123, - 173, 107, 76, 107, 174, 12, 107, 174, 157, 107, - 26, 174, 13, 21, 14, 107, 84, 110, 174, 174, - 110, 110, 110, 107, 174, 110, 110, 108, 107, 21, + 188, 188, 188, 188, 10, 11, 13, 19, 22, 23, + 25, 66, 109, 110, 178, 200, 108, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 24, 150, 151, 151, + 24, 133, 123, 123, 123, 123, 100, 123, 71, 196, + 197, 199, 200, 201, 202, 123, 123, 109, 123, 123, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 29, + 158, 158, 15, 193, 175, 14, 177, 156, 27, 123, + 173, 108, 77, 108, 174, 12, 108, 174, 157, 108, + 27, 174, 13, 21, 14, 108, 85, 23, 174, 174, + 23, 23, 23, 23, 108, 174, 23, 109, 108, 21, 14, 21, 14, 21, 14, 21, 12, 17, 122, 131, - 132, 11, 21, 23, 146, 174, 147, 148, 174, 148, - 195, 200, 108, 141, 145, 148, 149, 174, 196, 123, - 148, 148, 82, 161, 161, 163, 107, 111, 194, 192, - 123, 171, 108, 166, 167, 107, 107, 14, 174, 12, - 188, 21, 14, 107, 193, 12, 12, 12, 12, 123, - 155, 156, 123, 23, 107, 107, 107, 107, 108, 123, - 107, 21, 136, 148, 107, 107, 188, 174, 76, 11, - 168, 11, 14, 12, 107, 21, 156, 21, 172, 173, + 132, 11, 21, 24, 146, 174, 147, 148, 174, 148, + 195, 200, 109, 141, 145, 148, 149, 174, 196, 123, + 148, 148, 83, 161, 161, 163, 108, 111, 194, 192, + 123, 171, 109, 166, 167, 108, 108, 14, 174, 12, + 188, 21, 14, 108, 193, 12, 12, 12, 12, 123, + 155, 156, 123, 24, 108, 108, 108, 108, 109, 123, + 108, 21, 136, 148, 108, 108, 188, 174, 77, 11, + 168, 11, 14, 12, 108, 21, 156, 21, 172, 173, 137, 192, 144, 144, 11, 124, 124, 148, 148, 124, - 134, 108, 107, 124, 124, 126, 107, 126, 74, 21, - 170, 171, 126, 21, 124, 124, 125, 48, 49, 142, - 142, 107, 107, 143, 146, 148, 124, 12, 12, 127, - 12, 143, 143, 126, 124, 108, 124, 124, 21, 107, - 143, 21, 26, 138, 12, 148, 143, 143, 135, 124, - 16, 73, 139, 107, 144, 143, 126, 124, 149, 74, - 142, 107, 124 + 134, 109, 108, 124, 124, 126, 108, 126, 75, 21, + 170, 171, 126, 21, 124, 124, 125, 49, 50, 142, + 142, 108, 108, 143, 146, 148, 124, 12, 12, 127, + 12, 143, 143, 126, 124, 109, 124, 124, 21, 108, + 143, 21, 27, 138, 12, 148, 143, 143, 135, 124, + 16, 74, 139, 108, 144, 143, 126, 124, 149, 75, + 142, 108, 124 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ @@ -1120,28 +1134,28 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, - toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_opval, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_opval, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, @@ -1154,6 +1168,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 491face02c08897e36ea2126d0fdaca15a924544759450fefcdd9947844c7b2f perly.y + * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index ab6f3958da15..0997e3e2ddc6 100644 --- a/perly.y +++ b/perly.y @@ -58,6 +58,7 @@ %token PERLY_PLUS %token PERLY_SEMICOLON %token PERLY_SNAIL +%token PERLY_STAR %token BAREWORD METHOD FUNCMETH THING PMFUNC PRIVATEREF QWLIST %token FUNC0OP FUNC0SUB UNIOPSUB LSTOPSUB @@ -1245,16 +1246,16 @@ term[product] : termbinop { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $optlistexpr, scalar($subname))); } - | term[operand] ARROW '$' '*' + | term[operand] ARROW '$' PERLY_STAR { $$ = newSVREF($operand); } - | term[operand] ARROW PERLY_SNAIL '*' + | term[operand] ARROW PERLY_SNAIL PERLY_STAR { $$ = newAVREF($operand); } - | term[operand] ARROW PERLY_PERCENT_SIGN '*' + | term[operand] ARROW PERLY_PERCENT_SIGN PERLY_STAR { $$ = newHVREF($operand); } - | term[operand] ARROW PERLY_AMPERSAND '*' + | term[operand] ARROW PERLY_AMPERSAND PERLY_STAR { $$ = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF($PERLY_AMPERSAND,$operand))); } - | term[operand] ARROW '*' '*' %prec PERLY_PAREN_OPEN + | term[operand] ARROW PERLY_STAR PERLY_STAR %prec PERLY_PAREN_OPEN { $$ = newGVREF(0,$operand); } | LOOPEX /* loop exiting command (goto, last, dump, etc) */ { $$ = newOP($LOOPEX, OPf_SPECIAL); @@ -1395,11 +1396,11 @@ hsh : PERLY_PERCENT_SIGN indirob arylen : DOLSHARP indirob { $$ = newAVREF($indirob); } - | term ARROW DOLSHARP '*' + | term ARROW DOLSHARP PERLY_STAR { $$ = newAVREF($term); } ; -star : '*' indirob +star : PERLY_STAR indirob { $$ = newGVREF(0,$indirob); } ; @@ -1414,7 +1415,7 @@ kvslice : hsh ; gelem : star - | term ARROW '*' + | term ARROW PERLY_STAR { $$ = newGVREF(0,$term); } ; diff --git a/toke.c b/toke.c index fe0a8be08bbb..92d87d56dd40 100644 --- a/toke.c +++ b/toke.c @@ -403,6 +403,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), DEBUG_TOKEN (IVAL, PERLY_SNAIL), + DEBUG_TOKEN (IVAL, PERLY_STAR), DEBUG_TOKEN (IVAL, PERLY_TILDE), { PLUGEXPR, TOKENTYPE_OPVAL, "PLUGEXPR" }, { PLUGSTMT, TOKENTYPE_OPVAL, "PLUGSTMT" }, @@ -2055,6 +2056,7 @@ S_postderef(pTHX_ int const funny, char const next) || funny == PERLY_SNAIL || funny == PERLY_PERCENT_SIGN || funny == PERLY_AMPERSAND + || funny == PERLY_STAR ); if (next == '*') { PL_expect = XOPERATOR; @@ -2064,7 +2066,7 @@ S_postderef(pTHX_ int const funny, char const next) if (PERLY_SNAIL == funny) force_next(POSTJOIN); } - force_next(next); + force_next(PERLY_STAR); PL_bufptr+=2; } else { @@ -5700,15 +5702,15 @@ static int yyl_star(pTHX_ char *s) { if (PL_expect == XPOSTDEREF) - POSTDEREF('*'); + POSTDEREF(PERLY_STAR); if (PL_expect != XOPERATOR) { s = scan_ident(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE); PL_expect = XOPERATOR; - force_ident(PL_tokenbuf, '*'); + force_ident(PL_tokenbuf, PERLY_STAR); if (!*PL_tokenbuf) - PREREF('*'); - TERM('*'); + PREREF(PERLY_STAR); + TERM(PERLY_STAR); } s++; From 77b0379fd3a3996b0a75681463aed636ae780ca8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:19 +0100 Subject: [PATCH 344/503] Distinguish C- and perly- literals - PERLY_SLASH --- perly.act | 536 +++++++++---------- perly.h | 179 +++---- perly.tab | 1528 +++++++++++++++++++++++++++-------------------------- perly.y | 3 +- toke.c | 3 +- 5 files changed, 1133 insertions(+), 1116 deletions(-) diff --git a/perly.act b/perly.act index 265af5c0d255..8a560e1c8530 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 135 "perly.y" +#line 136 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 140 "perly.y" +#line 141 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 146 "perly.y" +#line 147 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 151 "perly.y" +#line 152 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 156 "perly.y" +#line 157 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 161 "perly.y" +#line 162 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 169 "perly.y" +#line 170 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 174 "perly.y" +#line 175 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 182 "perly.y" +#line 183 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 187 "perly.y" +#line 188 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 195 "perly.y" +#line 196 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 200 "perly.y" +#line 201 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 205 "perly.y" +#line 206 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 210 "perly.y" +#line 211 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 218 "perly.y" +#line 219 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 226 "perly.y" +#line 227 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 233 "perly.y" +#line 234 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 238 "perly.y" +#line 239 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 245 "perly.y" +#line 246 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 251 "perly.y" +#line 252 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 253 "perly.y" +#line 254 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 262 "perly.y" +#line 263 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 264 "perly.y" +#line 265 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 273 "perly.y" +#line 274 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 277 "perly.y" +#line 278 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 281 "perly.y" +#line 282 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 288 "perly.y" +#line 289 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 298 "perly.y" +#line 299 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 300 "perly.y" +#line 301 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 312 "perly.y" +#line 313 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 318 "perly.y" +#line 319 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 333 "perly.y" +#line 334 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 339 "perly.y" +#line 340 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 350 "perly.y" +#line 351 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 357 "perly.y" +#line 358 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 359 "perly.y" +#line 360 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 366 "perly.y" +#line 367 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 372 "perly.y" +#line 373 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 378 "perly.y" +#line 379 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 383 "perly.y" +#line 384 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 385 "perly.y" +#line 386 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 387 "perly.y" +#line 388 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 394 "perly.y" +#line 395 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 401 "perly.y" +#line 402 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 403 "perly.y" +#line 404 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 406 "perly.y" +#line 407 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 421 "perly.y" +#line 422 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 426 "perly.y" +#line 427 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 432 "perly.y" +#line 433 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 434 "perly.y" +#line 435 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 447 "perly.y" +#line 448 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 455 "perly.y" +#line 456 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 461 "perly.y" +#line 462 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 467 "perly.y" +#line 468 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 474 "perly.y" +#line 475 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 482 "perly.y" +#line 483 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 486 "perly.y" +#line 487 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 491 "perly.y" +#line 492 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 499 "perly.y" +#line 500 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 516 "perly.y" +#line 517 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 518 "perly.y" +#line 519 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 526 "perly.y" +#line 527 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 528 "perly.y" +#line 529 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 530 "perly.y" +#line 531 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 532 "perly.y" +#line 533 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 534 "perly.y" +#line 535 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 536 "perly.y" +#line 537 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 538 "perly.y" +#line 539 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 541 "perly.y" +#line 542 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 546 "perly.y" +#line 547 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 548 "perly.y" +#line 549 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 553 "perly.y" +#line 554 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 563 "perly.y" +#line 564 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 565 "perly.y" +#line 566 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 570 "perly.y" +#line 571 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 576 "perly.y" +#line 577 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 582 "perly.y" +#line 583 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 590 "perly.y" +#line 591 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 595 "perly.y" +#line 596 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 599 "perly.y" +#line 600 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 602 "perly.y" +#line 603 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 603 "perly.y" +#line 604 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 607 "perly.y" +#line 608 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 613 "perly.y" +#line 614 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 618 "perly.y" +#line 619 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 629 "perly.y" +#line 630 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 635 "perly.y" +#line 636 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 637 "perly.y" +#line 638 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 639 "perly.y" +#line 640 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 644 "perly.y" +#line 645 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 646 "perly.y" +#line 647 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 657 "perly.y" +#line 658 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 659 "perly.y" +#line 660 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 664 "perly.y" +#line 665 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 666 "perly.y" +#line 667 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 670 "perly.y" +#line 671 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 689 "perly.y" +#line 690 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 691 "perly.y" +#line 692 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 693 "perly.y" +#line 694 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 699 "perly.y" +#line 700 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 764 "perly.y" +#line 765 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 766 "perly.y" +#line 767 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 772 "perly.y" +#line 773 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 774 "perly.y" +#line 775 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 778 "perly.y" +#line 779 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 783 "perly.y" +#line 784 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 785 "perly.y" +#line 786 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 789 "perly.y" +#line 790 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 791 "perly.y" +#line 792 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 795 "perly.y" +#line 796 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 798 "perly.y" +#line 799 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 809 "perly.y" +#line 810 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 866 "perly.y" +#line 867 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 867 "perly.y" +#line 868 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 873 "perly.y" +#line 874 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 883 "perly.y" +#line 884 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 884 "perly.y" +#line 885 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 888 "perly.y" +#line 889 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 899 "perly.y" +#line 900 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 901 "perly.y" +#line 902 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 903 "perly.y" +#line 904 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 909 "perly.y" +#line 910 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 911 "perly.y" +#line 912 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 920 "perly.y" +#line 921 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 924 "perly.y" +#line 925 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 928 "perly.y" +#line 929 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 934 "perly.y" +#line 935 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 939 "perly.y" +#line 940 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 945 "perly.y" +#line 946 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 951 "perly.y" +#line 952 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 953 "perly.y" +#line 954 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 955 "perly.y" +#line 956 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 957 "perly.y" +#line 958 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 960 "perly.y" +#line 961 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 975 "perly.y" +#line 976 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 977 "perly.y" +#line 978 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 980 "perly.y" +#line 981 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 985 "perly.y" +#line 986 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 990 "perly.y" +#line 991 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 993 "perly.y" +#line 994 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 997 "perly.y" +#line 998 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 1001 "perly.y" +#line 1002 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1007 "perly.y" +#line 1008 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1015 "perly.y" +#line 1016 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1022 "perly.y" +#line 1023 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1028 "perly.y" +#line 1029 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1030 "perly.y" +#line 1031 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1032 "perly.y" +#line 1033 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1037 "perly.y" +#line 1038 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1039 "perly.y" +#line 1040 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1041 "perly.y" +#line 1042 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1046 "perly.y" +#line 1047 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1048 "perly.y" +#line 1049 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1050 "perly.y" +#line 1051 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1052 "perly.y" +#line 1053 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1054 "perly.y" +#line 1055 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1056 "perly.y" +#line 1057 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1058 "perly.y" +#line 1059 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1060 "perly.y" +#line 1061 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1062 "perly.y" +#line 1063 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1064 "perly.y" +#line 1065 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1066 "perly.y" +#line 1067 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1070 "perly.y" +#line 1071 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1072 "perly.y" +#line 1073 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1074 "perly.y" +#line 1075 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1076 "perly.y" +#line 1077 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1080 "perly.y" +#line 1081 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1082 "perly.y" +#line 1083 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1086 "perly.y" +#line 1087 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1088 "perly.y" +#line 1089 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1090 "perly.y" +#line 1091 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1092 "perly.y" +#line 1093 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1096 "perly.y" +#line 1097 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1098 "perly.y" +#line 1099 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1103 "perly.y" +#line 1104 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1105 "perly.y" +#line 1106 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1108 "perly.y" +#line 1109 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1110 "perly.y" +#line 1111 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1112 "perly.y" +#line 1113 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1115 "perly.y" +#line 1116 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1118 "perly.y" +#line 1119 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1129 "perly.y" +#line 1130 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1132 "perly.y" +#line 1133 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1139 "perly.y" +#line 1140 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1141 "perly.y" +#line 1142 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1143 "perly.y" +#line 1144 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1145 "perly.y" +#line 1146 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1147 "perly.y" +#line 1148 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1150 "perly.y" +#line 1151 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1156 "perly.y" +#line 1157 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1158 "perly.y" +#line 1159 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1166 "perly.y" +#line 1167 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1168 "perly.y" +#line 1169 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1170 "perly.y" +#line 1171 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1172 "perly.y" +#line 1173 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1174 "perly.y" +#line 1175 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1176 "perly.y" +#line 1177 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1178 "perly.y" +#line 1179 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1180 "perly.y" +#line 1181 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1182 "perly.y" +#line 1183 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1184 "perly.y" +#line 1185 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1186 "perly.y" +#line 1187 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1188 "perly.y" +#line 1189 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1190 "perly.y" +#line 1191 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1192 "perly.y" +#line 1193 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1194 "perly.y" +#line 1195 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1204 "perly.y" +#line 1205 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1214 "perly.y" +#line 1215 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1224 "perly.y" +#line 1225 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1234 "perly.y" +#line 1235 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1236 "perly.y" +#line 1237 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1238 "perly.y" +#line 1239 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1241 "perly.y" +#line 1242 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1246 "perly.y" +#line 1247 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1250 "perly.y" +#line 1251 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1252 "perly.y" +#line 1253 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1254 "perly.y" +#line 1255 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1256 "perly.y" +#line 1257 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1259 "perly.y" +#line 1260 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1261 "perly.y" +#line 1262 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1264 "perly.y" +#line 1265 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1266 "perly.y" +#line 1267 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1268 "perly.y" +#line 1269 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1270 "perly.y" +#line 1271 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1272 "perly.y" +#line 1273 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1274 "perly.y" +#line 1275 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1276 "perly.y" +#line 1277 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1278 "perly.y" +#line 1279 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1280 "perly.y" +#line 1281 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1283 "perly.y" +#line 1284 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1285 "perly.y" +#line 1286 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1287 "perly.y" +#line 1288 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1289 "perly.y" +#line 1290 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1291 "perly.y" +#line 1292 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1293 "perly.y" +#line 1294 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1297 "perly.y" +#line 1298 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1299 "perly.y" +#line 1300 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1310 "perly.y" +#line 1311 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1318 "perly.y" +#line 1319 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1320 "perly.y" +#line 1321 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1322 "perly.y" +#line 1323 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1327 "perly.y" +#line 1328 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1329 "perly.y" +#line 1330 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1332 "perly.y" +#line 1333 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1334 "perly.y" +#line 1335 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1336 "perly.y" +#line 1337 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1341 "perly.y" +#line 1342 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1343 "perly.y" +#line 1344 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1347 "perly.y" +#line 1348 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1349 "perly.y" +#line 1350 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1353 "perly.y" +#line 1354 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1355 "perly.y" +#line 1356 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1361 "perly.y" +#line 1362 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1378 "perly.y" +#line 1379 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1382 "perly.y" +#line 1383 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1386 "perly.y" +#line 1387 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1392 "perly.y" +#line 1393 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1398 "perly.y" +#line 1399 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1400 "perly.y" +#line 1401 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1404 "perly.y" +#line 1405 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1409 "perly.y" +#line 1410 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1414 "perly.y" +#line 1415 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1419 "perly.y" +#line 1420 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1424 "perly.y" +#line 1425 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1426 "perly.y" +#line 1427 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1428 "perly.y" +#line 1429 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1431 "perly.y" +#line 1432 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y + * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index bad664f35af2..3d37a83a6ab5 100644 --- a/perly.h +++ b/perly.h @@ -75,94 +75,95 @@ extern int yydebug; PERLY_PERCENT_SIGN = 274, PERLY_PLUS = 275, PERLY_SEMICOLON = 276, - PERLY_SNAIL = 277, - PERLY_STAR = 278, - BAREWORD = 279, - METHOD = 280, - FUNCMETH = 281, - THING = 282, - PMFUNC = 283, - PRIVATEREF = 284, - QWLIST = 285, - FUNC0OP = 286, - FUNC0SUB = 287, - UNIOPSUB = 288, - LSTOPSUB = 289, - PLUGEXPR = 290, - PLUGSTMT = 291, - LABEL = 292, - FORMAT = 293, - SUB = 294, - SIGSUB = 295, - ANONSUB = 296, - ANON_SIGSUB = 297, - PACKAGE = 298, - USE = 299, - WHILE = 300, - UNTIL = 301, - IF = 302, - UNLESS = 303, - ELSE = 304, - ELSIF = 305, - CONTINUE = 306, - FOR = 307, - GIVEN = 308, - WHEN = 309, - DEFAULT = 310, - LOOPEX = 311, - DOTDOT = 312, - YADAYADA = 313, - FUNC0 = 314, - FUNC1 = 315, - FUNC = 316, - UNIOP = 317, - LSTOP = 318, - MULOP = 319, - ADDOP = 320, - DOLSHARP = 321, - DO = 322, - HASHBRACK = 323, - NOAMP = 324, - LOCAL = 325, - MY = 326, - REQUIRE = 327, - COLONATTR = 328, - FORMLBRACK = 329, - FORMRBRACK = 330, - SUBLEXSTART = 331, - SUBLEXEND = 332, - PREC_LOW = 333, - OROP = 334, - DOROP = 335, - ANDOP = 336, - NOTOP = 337, - ASSIGNOP = 338, - PERLY_QUESTION_MARK = 339, - PERLY_COLON = 340, - OROR = 341, - DORDOR = 342, - ANDAND = 343, - BITOROP = 344, - BITANDOP = 345, - CHEQOP = 346, - NCEQOP = 347, - CHRELOP = 348, - NCRELOP = 349, - SHIFTOP = 350, - MATCHOP = 351, - PERLY_EXCLAMATION_MARK = 352, - PERLY_TILDE = 353, - UMINUS = 354, - REFGEN = 355, - POWOP = 356, - PREINC = 357, - PREDEC = 358, - POSTINC = 359, - POSTDEC = 360, - POSTJOIN = 361, - ARROW = 362, - PERLY_PAREN_CLOSE = 363, - PERLY_PAREN_OPEN = 364 + PERLY_SLASH = 277, + PERLY_SNAIL = 278, + PERLY_STAR = 279, + BAREWORD = 280, + METHOD = 281, + FUNCMETH = 282, + THING = 283, + PMFUNC = 284, + PRIVATEREF = 285, + QWLIST = 286, + FUNC0OP = 287, + FUNC0SUB = 288, + UNIOPSUB = 289, + LSTOPSUB = 290, + PLUGEXPR = 291, + PLUGSTMT = 292, + LABEL = 293, + FORMAT = 294, + SUB = 295, + SIGSUB = 296, + ANONSUB = 297, + ANON_SIGSUB = 298, + PACKAGE = 299, + USE = 300, + WHILE = 301, + UNTIL = 302, + IF = 303, + UNLESS = 304, + ELSE = 305, + ELSIF = 306, + CONTINUE = 307, + FOR = 308, + GIVEN = 309, + WHEN = 310, + DEFAULT = 311, + LOOPEX = 312, + DOTDOT = 313, + YADAYADA = 314, + FUNC0 = 315, + FUNC1 = 316, + FUNC = 317, + UNIOP = 318, + LSTOP = 319, + MULOP = 320, + ADDOP = 321, + DOLSHARP = 322, + DO = 323, + HASHBRACK = 324, + NOAMP = 325, + LOCAL = 326, + MY = 327, + REQUIRE = 328, + COLONATTR = 329, + FORMLBRACK = 330, + FORMRBRACK = 331, + SUBLEXSTART = 332, + SUBLEXEND = 333, + PREC_LOW = 334, + OROP = 335, + DOROP = 336, + ANDOP = 337, + NOTOP = 338, + ASSIGNOP = 339, + PERLY_QUESTION_MARK = 340, + PERLY_COLON = 341, + OROR = 342, + DORDOR = 343, + ANDAND = 344, + BITOROP = 345, + BITANDOP = 346, + CHEQOP = 347, + NCEQOP = 348, + CHRELOP = 349, + NCRELOP = 350, + SHIFTOP = 351, + MATCHOP = 352, + PERLY_EXCLAMATION_MARK = 353, + PERLY_TILDE = 354, + UMINUS = 355, + REFGEN = 356, + POWOP = 357, + PREINC = 358, + PREDEC = 359, + POSTINC = 360, + POSTDEC = 361, + POSTJOIN = 362, + ARROW = 363, + PERLY_PAREN_CLOSE = 364, + PERLY_PAREN_OPEN = 365 }; #endif @@ -214,6 +215,6 @@ int yyparse (void); /* Generated from: - * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y + * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 5f5e09f11ab0..133b693be201 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3189 +#define YYLAST 3258 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 364 +#define YYMAXUTOK 365 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,8 +33,8 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 110, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 2, 111, 2, 2, + 2, 2, 2, 2, 2, 2, 111, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -66,43 +66,43 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109 + 105, 106, 107, 108, 109, 110 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 135, 135, 134, 146, 145, 156, 155, 169, 168, - 182, 181, 195, 194, 205, 204, 217, 225, 233, 237, - 245, 251, 252, 262, 263, 272, 276, 280, 287, 297, - 299, 312, 309, 333, 328, 349, 357, 356, 365, 371, - 377, 382, 384, 386, 393, 401, 403, 400, 420, 425, - 432, 431, 446, 454, 460, 467, 466, 481, 485, 490, - 498, 516, 517, 521, 525, 527, 529, 531, 533, 535, - 537, 540, 546, 547, 552, 563, 564, 570, 576, 577, - 582, 585, 589, 594, 598, 602, 603, 607, 613, 618, - 623, 624, 629, 630, 635, 636, 638, 643, 645, 657, - 658, 663, 665, 669, 689, 690, 692, 698, 763, 765, - 771, 773, 777, 783, 784, 789, 790, 794, 798, 798, - 866, 867, 872, 883, 884, 887, 898, 900, 902, 904, - 908, 910, 915, 919, 923, 927, 933, 938, 944, 950, - 952, 954, 957, 956, 967, 968, 972, 976, 979, 984, - 989, 992, 996, 1000, 1006, 1014, 1021, 1027, 1029, 1031, - 1036, 1038, 1040, 1045, 1047, 1049, 1051, 1053, 1055, 1057, - 1059, 1061, 1063, 1065, 1069, 1071, 1073, 1075, 1079, 1081, - 1085, 1087, 1089, 1091, 1095, 1097, 1102, 1104, 1107, 1109, - 1111, 1114, 1117, 1128, 1131, 1138, 1140, 1142, 1144, 1146, - 1149, 1155, 1157, 1161, 1162, 1163, 1164, 1165, 1167, 1169, - 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, 1189, - 1191, 1193, 1203, 1213, 1223, 1233, 1235, 1237, 1240, 1245, - 1249, 1251, 1253, 1255, 1258, 1260, 1263, 1265, 1267, 1269, - 1271, 1273, 1275, 1277, 1279, 1282, 1284, 1286, 1288, 1290, - 1292, 1296, 1299, 1298, 1311, 1312, 1313, 1317, 1319, 1321, - 1326, 1328, 1331, 1333, 1335, 1340, 1342, 1347, 1348, 1353, - 1354, 1360, 1364, 1365, 1366, 1369, 1370, 1373, 1374, 1377, - 1381, 1385, 1391, 1397, 1399, 1403, 1407, 1408, 1412, 1413, - 1417, 1418, 1423, 1425, 1427, 1430 + 0, 136, 136, 135, 147, 146, 157, 156, 170, 169, + 183, 182, 196, 195, 206, 205, 218, 226, 234, 238, + 246, 252, 253, 263, 264, 273, 277, 281, 288, 298, + 300, 313, 310, 334, 329, 350, 358, 357, 366, 372, + 378, 383, 385, 387, 394, 402, 404, 401, 421, 426, + 433, 432, 447, 455, 461, 468, 467, 482, 486, 491, + 499, 517, 518, 522, 526, 528, 530, 532, 534, 536, + 538, 541, 547, 548, 553, 564, 565, 571, 577, 578, + 583, 586, 590, 595, 599, 603, 604, 608, 614, 619, + 624, 625, 630, 631, 636, 637, 639, 644, 646, 658, + 659, 664, 666, 670, 690, 691, 693, 699, 764, 766, + 772, 774, 778, 784, 785, 790, 791, 795, 799, 799, + 867, 868, 873, 884, 885, 888, 899, 901, 903, 905, + 909, 911, 916, 920, 924, 928, 934, 939, 945, 951, + 953, 955, 958, 957, 968, 969, 973, 977, 980, 985, + 990, 993, 997, 1001, 1007, 1015, 1022, 1028, 1030, 1032, + 1037, 1039, 1041, 1046, 1048, 1050, 1052, 1054, 1056, 1058, + 1060, 1062, 1064, 1066, 1070, 1072, 1074, 1076, 1080, 1082, + 1086, 1088, 1090, 1092, 1096, 1098, 1103, 1105, 1108, 1110, + 1112, 1115, 1118, 1129, 1132, 1139, 1141, 1143, 1145, 1147, + 1150, 1156, 1158, 1162, 1163, 1164, 1165, 1166, 1168, 1170, + 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, 1188, 1190, + 1192, 1194, 1204, 1214, 1224, 1234, 1236, 1238, 1241, 1246, + 1250, 1252, 1254, 1256, 1259, 1261, 1264, 1266, 1268, 1270, + 1272, 1274, 1276, 1278, 1280, 1283, 1285, 1287, 1289, 1291, + 1293, 1297, 1300, 1299, 1312, 1313, 1314, 1318, 1320, 1322, + 1327, 1329, 1332, 1334, 1336, 1341, 1343, 1348, 1349, 1354, + 1355, 1361, 1365, 1366, 1367, 1370, 1371, 1374, 1375, 1378, + 1382, 1386, 1392, 1398, 1400, 1404, 1408, 1409, 1413, 1414, + 1418, 1419, 1424, 1426, 1428, 1431 }; #endif @@ -116,21 +116,21 @@ static const char *const yytname[] = "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PERCENT_SIGN", "PERLY_PLUS", - "PERLY_SEMICOLON", "PERLY_SNAIL", "PERLY_STAR", "BAREWORD", "METHOD", - "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", - "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", - "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", - "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", - "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", - "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", - "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", - "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", - "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", - "PERLY_COLON", "OROR", "DORDOR", "ANDAND", "BITOROP", "BITANDOP", - "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", - "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", - "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", - "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "'$'", "'/'", "$accept", + "PERLY_SEMICOLON", "PERLY_SLASH", "PERLY_SNAIL", "PERLY_STAR", + "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", + "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", + "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", + "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", + "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", + "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", + "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", + "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", + "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", + "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", + "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", + "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", + "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", + "ARROW", "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "'$'", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", @@ -166,11 +166,11 @@ static const yytype_int16 yytoknum[] = 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, - 36, 47 + 365, 36 }; # endif -#define YYPACT_NINF (-460) +#define YYPACT_NINF (-486) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -184,64 +184,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 1015, -460, -460, -460, -460, -460, -460, -460, 26, -460, - 2825, 57, 1509, 1415, -460, -460, -460, -460, 8, 1885, - 2825, 8, 2825, 8, 8, -460, 8, 8, -460, -460, - 22, -30, -460, 2825, -460, -460, -460, -460, 2825, -24, - -21, -59, 1979, 1791, 8, 1979, 2073, 31, 2825, 78, - 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2167, 8, 103, - 83, -460, -1, -460, -2, 20, 13, 28, -460, -460, - -460, 2992, -460, -460, 14, 52, 58, 64, -460, 117, - 236, 239, 125, -460, -460, -460, -460, -460, -460, 31, - 31, 122, -460, 42, 68, 87, 99, 261, 118, 129, - 57, 240, 231, -460, 253, 1601, 1415, -460, -460, -460, - 663, -460, 2, 757, -460, -460, -460, -460, -460, -460, - 92, 299, -460, 299, -460, -460, 2825, 196, 207, 2825, - 198, 393, 57, 282, 242, 2992, 205, 2261, 2825, 1791, - -460, 393, 564, 83, -460, 466, 2825, -460, -460, 393, - 305, 81, -460, -460, 2825, 393, 2919, 2355, 245, -460, - -460, -460, 393, 83, 299, 299, 299, 153, 153, 307, - 155, -460, 2825, 2825, 2825, 2825, 2825, 2825, 2449, -460, - -460, 2825, -460, -460, 2825, 2825, 2825, 2825, 2825, 2825, - 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, 2825, - 2825, 2825, -460, -460, -460, 71, 2543, 2825, 2825, 2825, - 2825, 2825, 2825, 2825, -460, 302, -460, -460, 309, -460, - -460, -460, -460, -460, 254, 24, -460, -460, 214, -460, - -460, -460, -460, 57, -460, -460, 2825, 2825, 2825, 2825, - 2825, 2825, -460, -460, -460, -460, -460, 311, 311, -460, - -460, -460, 327, -460, -460, -460, 2825, 2825, 110, -460, - -460, -460, 242, 326, -460, -460, -460, 313, 289, 265, - 2825, 83, -460, 357, -460, 2637, 299, 245, 53, 59, - 90, -460, 344, 348, -460, 2825, 369, 306, 306, -460, - 2992, 165, 113, -460, 425, 393, 355, 3082, 1018, 930, - 2992, 2947, 501, 501, 648, 742, 836, 355, 355, 393, - 393, 420, 299, 299, 360, 2825, 2825, 365, 379, 388, - -460, 390, 2731, 29, 308, -460, -460, 460, 174, 130, - 191, 161, 300, 199, 317, 851, -460, 405, -460, -460, - 12, 404, 2825, 2825, 2825, 2825, -460, 319, -460, -460, - 321, -460, -460, -460, -460, 1603, 37, -460, 2825, 2825, - -460, -460, 103, -460, 103, -460, -460, -460, -460, -460, - 351, 351, 2, 329, 0, -460, 2825, -460, -460, 334, - -460, -460, -460, -460, 507, -460, 7, 519, -460, -460, - -460, 223, 2825, 423, -460, -460, 2825, -460, 328, 250, - -460, -460, -460, -460, -460, 553, -460, 2825, -460, 426, - -460, 432, -460, 433, -460, 435, -460, -460, -460, 282, - 242, -460, -460, 431, 359, 103, 361, 367, 103, 370, - 356, -460, -460, -460, -460, 374, 447, 310, -460, 2825, - 378, 382, 2825, -460, -460, -460, -460, 2825, 396, -460, - 481, -460, -460, 482, -460, -460, 41, -460, 297, -460, - 3037, 483, -460, -460, 399, -460, -460, -460, -460, 480, - 242, 487, -460, 2825, -460, -460, 499, 499, 2825, 2825, - 499, -460, 406, 409, 499, 499, 2992, 103, -460, -460, - 411, -460, -460, -460, -460, 453, 508, -460, -460, -460, - -460, 511, 499, 499, -460, 91, 91, 414, 427, 231, - 2825, 2825, 499, -460, -460, 945, -460, 1039, -460, -460, - -460, -460, 1133, -460, 231, 231, -460, 499, 429, -460, - -460, 499, 499, -460, 515, 440, 231, -460, -460, 30, - -460, -460, -460, 1227, -460, 2825, 231, 231, -460, 499, - -460, 547, 495, -460, -460, 467, -460, -460, -460, 231, - -460, -460, -460, 499, 1697, -460, 1321, 91, 468, -460, - -460, 499, -460 + 894, -486, -486, -486, -486, -486, -486, -486, 17, -486, + 2892, 15, 1393, 1298, -486, -486, -486, -486, 29, 1942, + 2892, 29, 2892, 29, 29, -486, 29, 29, -486, -486, + 39, -64, -486, 2892, -486, -486, -486, -486, 2892, -31, + -22, -45, 2037, 1847, 29, 2037, 2132, 33, 2892, 61, + 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2227, 29, 184, + 49, -486, 2, -486, 177, 19, 186, 5, -486, -486, + -486, 3060, -486, -486, 9, 81, 162, 224, -486, 94, + 236, 244, 113, -486, -486, -486, -486, -486, -486, 33, + 33, 116, -486, 36, 41, 67, 70, -3, 98, 103, + 15, 206, 182, -486, 217, 1486, 1298, -486, -486, -486, + 528, -486, 47, 633, -486, -486, -486, -486, -486, -486, + 20, 890, -486, 890, -486, -486, 2892, 151, 197, 2892, + 171, 808, 15, 281, 237, 3060, 204, 2322, 2892, 1847, + -486, 808, 1747, 49, -486, 1649, 2892, -486, -486, 808, + 303, 102, -486, -486, 2892, 808, 2987, 2417, 247, -486, + -486, -486, 808, 49, 890, 890, 890, 88, 88, 305, + 79, -486, 2892, 2892, 2892, 2892, 2892, 2892, 2512, -486, + -486, 2892, -486, -486, 2892, 2892, 2892, 2892, 2892, 2892, + 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, + 2892, 2892, -486, -486, -486, 80, 2607, 2892, 2892, 2892, + 2892, 2892, 2892, 2892, -486, 298, -486, -486, 307, -486, + -486, -486, -486, -486, 225, 0, -486, -486, 228, -486, + -486, -486, -486, 15, -486, -486, 2892, 2892, 2892, 2892, + 2892, 2892, -486, -486, -486, -486, -486, 310, 310, -486, + -486, -486, 327, -486, -486, -486, 2892, 2892, 46, -486, + -486, -486, 237, 321, -486, -486, -486, 289, 288, 264, + 2892, 49, -486, 363, -486, 2702, 890, 247, 22, 44, + 176, -486, 325, 359, -486, 2892, 375, 314, 314, -486, + 3060, 160, 54, -486, 368, 808, 416, 3150, 992, 360, + 3060, 3015, 513, 513, 618, 393, 713, 416, 416, 808, + 808, 903, 890, 890, 373, 2892, 2892, 376, 378, 379, + -486, 380, 2797, 26, 313, -486, -486, 398, 188, 130, + 296, 164, 299, 172, 312, 728, -486, 391, -486, -486, + 32, 384, 2892, 2892, 2892, 2892, -486, 300, -486, -486, + 318, -486, -486, -486, -486, 1488, 52, -486, 2892, 2892, + -486, -486, 184, -486, 184, -486, -486, -486, -486, -486, + 329, 329, 47, 308, 59, -486, 2892, -486, -486, 319, + -486, -486, -486, -486, 424, -486, 3, 434, -486, -486, + -486, 178, 2892, 407, -486, -486, 2892, -486, 340, 222, + -486, -486, -486, -486, -486, 532, -486, 2892, -486, 412, + -486, 418, -486, 423, -486, 425, -486, -486, -486, 281, + 237, -486, -486, 413, 334, 184, 335, 336, 184, 338, + 341, -486, -486, -486, -486, 343, 435, 309, -486, 2892, + 346, 351, 2892, -486, -486, -486, -486, 2892, 383, -486, + 458, -486, -486, 462, -486, -486, 11, -486, 249, -486, + 3105, 463, -486, -486, 385, -486, -486, -486, -486, 471, + 237, 472, -486, 2892, -486, -486, 486, 486, 2892, 2892, + 486, -486, 410, 399, 486, 486, 3060, 184, -486, -486, + 408, -486, -486, -486, -486, 443, 504, -486, -486, -486, + -486, 505, 486, 486, -486, 232, 232, 421, 422, 182, + 2892, 2892, 486, -486, -486, 823, -486, 918, -486, -486, + -486, -486, 1013, -486, 182, 182, -486, 486, 417, -486, + -486, 486, 486, -486, 511, 426, 182, -486, -486, 111, + -486, -486, -486, 1108, -486, 2892, 182, 182, -486, 486, + -486, 520, 465, -486, -486, 436, -486, -486, -486, 182, + -486, -486, -486, 486, 1583, -486, 1203, 232, 441, -486, + -486, 486, -486 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -312,16 +312,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -460, -460, -460, -460, -460, -460, -460, -460, -460, 301, - -460, -5, -117, -460, -17, -460, 571, 497, 1, -460, - -460, -460, -460, -460, -460, -460, -460, -460, 342, -350, - -432, -83, -459, -460, 94, 258, -272, 49, -460, -58, - 229, -460, 179, 195, -244, 340, 371, -460, -460, 249, - -460, 251, -460, -460, -460, -460, 170, -460, -460, 134, - -460, 154, -8, -37, -460, -460, -460, -460, -460, -460, - -460, -460, -460, -460, -460, -460, 100, -460, -460, 470, - -125, -131, -460, -460, 275, -460, -460, 410, 18, -46, - -40, -460, -460, -460, -460, -460, 4 + -486, -486, -486, -486, -486, -486, -486, -486, -486, 301, + -486, -5, -117, -486, -17, -486, 545, 474, 8, -486, + -486, -486, -486, -486, -486, -486, -486, -486, 409, -350, + -485, -83, -463, -486, 76, 250, -272, 30, -486, 89, + 317, -486, 293, 198, -244, 339, 374, -486, -486, 252, + -486, 253, -486, -486, -486, -486, 183, -486, -486, 132, + -486, 159, -8, -37, -486, -486, -486, -486, -486, -486, + -486, -486, -486, -486, -486, -486, 100, -486, -486, 480, + -125, -131, -486, -486, 284, -486, -486, 420, 18, -46, + -40, -486, -486, -486, -486, -486, 4 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -345,215 +345,202 @@ static const yytype_int16 yydefgoto[] = static const yytype_int16 yytable[] = { 113, 255, 59, 160, 17, 433, 143, 268, 269, 161, - 176, 120, 177, 103, 163, 175, 503, 138, 377, 83, - 285, 245, 118, 421, 246, 122, 16, 124, 125, 274, - 126, 127, 114, 422, 18, 129, 117, 115, 151, 117, - 83, 117, 117, 21, 117, 117, 23, 146, 147, 170, - 139, 551, 406, 114, 392, 152, 21, 552, 115, 23, - 153, 145, 117, 207, 207, 208, 208, 159, 83, -286, - -286, -286, -286, 429, 530, -288, 117, -288, 214, 130, - -261, 314, 315, 435, 316, 136, 440, 441, 137, 143, - 317, 179, 180, 318, 319, 348, 320, 21, 175, 564, - 23, -288, 273, -288, 182, 183, 254, 243, 178, 271, - 279, 447, 247, 181, -260, 228, 280, 143, 58, 184, - 121, 258, 123, 206, 375, 373, -262, 394, -290, 267, - 59, 59, -264, 131, 58, 570, 213, 321, 135, 58, - 527, 528, 141, 270, 410, 149, 218, 58, 155, 282, - 162, 220, 164, 165, 166, 167, 168, 145, 338, 339, - 172, 173, 174, -263, 287, 288, 289, 483, 291, 292, - 294, 172, 173, 174, 278, 412, 471, 221, 156, 353, - 322, 323, 172, 173, 174, 354, 393, 157, 58, 172, - 173, 174, 172, 173, 174, 409, 222, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 507, 508, 223, 172, - 173, 174, 411, 414, 433, 342, 343, 344, 345, 347, - 374, 355, 356, 325, 358, 359, 496, 229, 362, 364, - 362, 362, 362, 362, 172, 173, 174, 457, 230, 535, + 18, 120, 503, 176, 163, 177, 285, 16, 377, 21, + 103, 530, 118, 23, 392, 122, 83, 124, 125, 274, + 126, 127, 138, 207, 254, 208, 117, 83, 151, 117, + 83, 117, 117, 421, 117, 117, 130, 146, 147, 170, + 406, 114, 129, 422, 114, -286, 115, -286, 152, 115, + 375, 145, 117, 153, 175, 139, 245, 159, 394, 224, + 246, 21, 348, 429, 175, 23, 117, -261, 214, 136, + 21, 447, 570, 435, 23, -260, 440, 441, 137, 143, + 314, 315, 207, 316, 208, 564, -262, 184, 225, 317, + 172, 173, 174, 318, 319, -290, 320, 226, 58, 271, + 279, 58, 178, 181, 243, 228, 280, 143, -264, 206, + 121, 258, 123, 273, 213, 373, 172, 173, 174, 267, + 59, 59, 551, 131, 172, 173, 174, 58, 135, 552, + 58, 218, 141, 270, 410, 149, 220, 321, 155, 282, + 162, 221, 164, 165, 166, 167, 168, 145, 247, 172, + 173, 174, 156, 58, 287, 288, 289, 483, 291, 292, + 294, 157, 58, -286, 278, -286, 471, 222, 412, 353, + 223, 393, 172, 173, 174, 354, 414, -288, 286, -288, + 322, 323, 457, -291, -291, -291, 205, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 507, 508, 229, 409, + 172, 173, 174, 230, 433, 342, 343, 344, 345, 347, + 374, 355, 356, 325, 358, 359, 496, 232, 362, 364, + 362, 362, 362, 362, 233, -288, 462, -288, 235, 535, 172, 173, 174, 352, 172, 173, 174, 209, 59, 210, - 211, 449, 212, 172, 173, 174, 276, -291, -291, -291, - 205, 232, 384, 286, 462, 133, 134, 387, 216, 217, - 172, 173, 174, 555, 235, 290, 464, 391, 172, 173, - 174, 295, 233, 257, 296, 297, 298, 299, 300, 301, + -263, 449, 172, 173, 174, 211, 276, 212, 172, 173, + 174, 256, 384, 492, 172, 173, 174, 387, 172, 173, + 174, 179, 180, 555, 257, 290, 464, 391, 182, 183, + 259, 295, 527, 528, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, 256, 259, 398, 399, 261, - 353, 492, 84, 265, 405, 263, 354, 272, 283, 116, - 285, 413, 116, 357, 116, 116, 336, 116, 116, 172, - 173, 174, 224, 340, 425, 364, 428, 428, 415, 143, - 369, 117, 372, 140, 116, 116, 148, 437, 501, 461, - 428, 428, 439, 378, 346, 236, 237, 238, 239, 116, - 506, 225, 240, 509, 241, 431, 382, 513, 514, 385, - 226, 58, 450, 383, 352, 390, 172, 173, 174, 172, - 173, 174, 392, 397, 458, 524, 525, 174, 400, 172, - 173, 174, 172, 173, 174, 536, 172, 173, 174, 59, - 201, 231, 401, 202, 203, 204, 205, 172, 173, 174, - 544, 402, 469, 403, 546, 547, 472, 407, -83, 186, - 187, 381, 417, 172, 173, 174, 533, 479, 423, 58, - 432, 428, 559, 260, 442, 459, 143, 446, 465, 487, - 116, 541, 542, 452, 466, 467, 567, 468, 197, 198, - 199, 200, 389, 550, 572, 473, 201, 186, 187, 202, - 203, 204, 205, 556, 557, 478, -215, 474, 481, 475, - 428, 428, 515, 488, 517, 476, 565, 207, 477, 208, - -215, -215, 480, 522, 186, 187, 484, -215, 199, 200, - 485, 450, 489, 491, 201, 493, 460, 202, 203, 204, - 205, 495, 425, 428, 172, 173, 174, 494, 497, 543, - 504, -215, -215, -215, -215, 511, 200, 512, -215, 516, - -215, 201, 531, -215, 202, 203, 204, 205, 518, 519, - -215, -215, 523, 395, 360, 532, 548, 428, 545, 172, - 173, 174, 486, -215, 566, -215, -215, -215, 549, -215, - -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, 560, -254, 186, 187, -215, 408, 561, - -215, -215, -215, -215, -215, 563, 571, -215, -254, -254, - 365, 366, 367, 368, 107, -254, 172, 173, 174, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 172, 173, - 174, 426, 201, 242, 534, 202, 203, 204, 205, -254, - -254, -254, -254, 568, 470, 455, -254, 388, -254, 371, - 444, -254, 490, 445, 116, 499, 277, 456, -254, -254, - 521, 438, 172, 173, 174, 351, 0, 0, 0, 0, - 0, -254, 0, -254, -254, -254, 0, -254, -254, -254, - -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, 463, 0, -13, 85, -254, 0, 0, -254, -254, - -254, -254, -254, 18, 83, -254, 19, 0, 0, 0, - 0, 20, 21, 22, 86, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 87, - 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, - 95, 96, 186, 187, 0, 97, 98, 99, 100, 38, - 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 193, 194, 195, - 196, 197, 198, 199, 200, 51, 0, 0, 0, 201, - 0, 0, 202, 203, 204, 205, 0, -3, 85, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 83, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 86, 23, - 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, - 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, - 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, - 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, - 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, - 0, 0, 194, 195, 196, 197, 198, 199, 200, 51, - 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, - 0, 0, 85, 0, 52, 53, 0, 54, 0, 55, - 56, 18, 83, 416, 19, 0, 57, 58, 0, 20, - 21, 22, 86, 23, 24, 25, 26, 27, 28, 29, - 0, 30, 31, 32, 33, 34, 35, 87, 106, 88, - 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, - 186, 187, 0, 97, 98, 99, 100, 38, 0, 101, - 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, - 47, 48, 49, 50, 0, 0, 0, 195, 196, 197, - 198, 199, 200, 51, 0, 0, 0, 201, 0, 0, - 202, 203, 204, 205, 0, 0, 85, 0, 52, 53, - 0, 54, 0, 55, 56, 18, 83, 537, 19, 0, - 57, 58, 0, 20, 21, 22, 86, 23, 24, 25, - 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, - 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, - 93, 94, 95, 96, 186, 0, 0, 97, 98, 99, - 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, - 0, 44, 45, 46, 47, 48, 49, 50, 1, 2, - 3, 4, 5, 6, 7, 0, 200, 51, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, - 85, 0, 52, 53, 0, 54, 0, 55, 56, 18, - 83, 538, 19, 0, 57, 58, 0, 20, 21, 22, - 86, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 312, 313, 172, 173, 174, 338, 339, 398, 399, 261, + 353, 263, 84, 265, 405, 272, 354, 411, 285, 116, + 413, 283, 116, 336, 116, 116, 346, 116, 116, 172, + 173, 174, 340, 415, 425, 364, 428, 428, 357, 143, + 369, 117, 372, 140, 116, 116, 148, 437, 501, 378, + 428, 428, 439, 133, 134, 236, 237, 238, 239, 116, + 506, 461, 240, 509, 241, 431, 382, 513, 514, 172, + 173, 174, 450, 383, 352, 385, 172, 173, 174, 172, + 173, 174, 216, 217, 458, 524, 525, 390, 392, 172, + 173, 174, 172, 173, 174, 536, 174, 397, 381, 59, + 400, 231, 401, 402, 403, 172, 173, 174, 417, 423, + 544, 58, 469, 442, 546, 547, 472, 446, -83, 459, + 172, 173, 174, 407, 465, 186, 533, 479, 432, 452, + 466, 428, 559, 260, 389, 467, 143, 468, 473, 487, + 116, 541, 542, 474, 475, 476, 567, 477, 172, 173, + 174, 478, 480, 550, 572, 484, 481, 200, 186, 187, + 485, 488, 201, 556, 557, 202, 203, 204, 205, 489, + 428, 428, 515, 491, 517, 493, 565, 395, 172, 173, + 174, 186, 187, 522, 194, 195, 196, 197, 198, 199, + 200, 450, 495, 497, 494, 201, 460, 504, 202, 203, + 204, 205, 425, 428, 172, 173, 174, 408, 512, 543, + 197, 198, 199, 200, 172, 173, 174, 516, 201, 518, + 511, 202, 203, 204, 205, 519, 523, 545, -13, 85, + 531, 532, 548, 455, 360, 549, 560, 428, 18, 83, + 561, 19, 486, 456, 566, 563, 20, 21, 22, 86, + 571, 23, 24, 25, 26, 27, 28, 29, 107, 30, + 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, + 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, + 242, 97, 98, 99, 100, 38, 534, 101, 39, 40, + 41, 42, 43, 426, 568, 44, 45, 46, 47, 48, + 49, 50, 192, 193, 194, 195, 196, 197, 198, 199, + 200, 51, 172, 173, 174, 201, 388, 470, 202, 203, + 204, 205, 371, 444, 116, 445, 52, 53, 521, 54, + 499, 55, 56, -3, 85, 490, 277, 0, 57, 58, + 438, 463, 0, 18, 83, 351, 19, 365, 366, 367, + 368, 20, 21, 22, 86, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, + 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, + 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, + 44, 45, 46, 47, 48, 49, 50, 0, 193, 194, + 195, 196, 197, 198, 199, 200, 51, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, + 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, + 416, 19, 0, 57, 58, 0, 20, 21, 22, 86, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, + 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, + 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 0, 0, 0, 195, 196, 197, 198, 199, + 200, 51, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205, 0, 0, 85, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 83, 537, 19, 0, 57, 58, + 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, + 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, + 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, + 44, 45, 46, 47, 48, 49, 50, 1, 2, 3, + 4, 5, 6, 7, 199, 200, 51, 0, 0, 0, + 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, + 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, + 538, 19, 0, 57, 58, 0, 20, 21, 22, 86, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, + 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, + 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, + 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, + 49, 50, 201, 0, 0, 202, 203, 204, 205, 0, + 200, 51, 0, 0, 0, 201, 0, 0, 202, 203, + 204, 205, 0, 0, 85, 0, 52, 53, 0, 54, + 0, 55, 56, 18, 83, 540, 19, 0, 57, 58, + 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, + 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, + 44, 45, 46, 47, 48, 49, 50, 0, 0, 200, + 0, 0, 0, 0, 201, 0, 51, 202, 203, 204, + 205, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, + 554, 19, 0, 57, 58, 0, 20, 21, 22, 86, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 200, 0, 0, 0, 0, 201, - 0, 51, 202, 203, 204, 205, 0, 0, 0, 0, + 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 83, 540, 19, 0, 57, 58, - 0, 20, 21, 22, 86, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 87, - 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, - 95, 96, 0, 0, 0, 97, 98, 99, 100, 38, - 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 83, 554, - 19, 0, 57, 58, 0, 20, 21, 22, 86, 23, - 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, - 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, - 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, - 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, - 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 85, 0, 52, 53, 0, 54, 0, 55, - 56, 18, 83, 0, 19, 0, 57, 58, 0, 20, - 21, 22, 86, 23, 24, 25, 26, 27, 28, 29, - 0, 30, 31, 32, 33, 34, 35, 87, 106, 88, - 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, - 0, 0, 0, 97, 98, 99, 100, 38, 0, 101, - 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, - 47, 48, 49, 50, 0, 0, 569, 0, 0, 0, - 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 85, 0, 52, 53, - 0, 54, 0, 55, 56, 18, 83, 0, 19, 0, - 57, 58, 0, 20, 21, 22, 86, 23, 24, 25, - 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, - 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, - 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, - 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, - 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 85, 0, 52, 53, 0, 54, 0, 55, 56, 18, - 83, 0, 19, 0, 57, 58, 0, 20, 21, 22, - 86, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 87, 0, 88, 89, 90, + 0, 55, 56, 18, 83, 0, 19, 0, 57, 58, + 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, + 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, + 44, 45, 46, 47, 48, 49, 50, 0, 0, 569, + 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, + 0, 19, 0, 57, 58, 0, 20, 21, 22, 86, + 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, + 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 0, 0, 19, 0, 57, 58, - 0, 20, 21, 22, -78, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 236, 237, 238, 239, - 0, 0, 0, 240, 0, 241, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 172, 173, 174, 0, 0, 51, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 0, 23, - 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, - 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, - 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, - 56, 18, 83, 0, 19, -78, 57, 58, 0, 20, - 21, 22, 0, 23, 24, 142, 26, 27, 28, 29, - 115, 30, 31, 32, 33, 34, 35, 0, 0, 0, - 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, - 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, - 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, - 0, 54, 0, 55, 56, 18, 0, 0, 19, 119, - 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, - 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, - 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, - 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, - 83, 0, 19, 0, 57, 58, 0, 20, 21, 22, + 0, 55, 56, 18, 83, 0, 19, 0, 57, 58, + 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 87, 0, 88, 89, 90, 36, 37, 91, 92, 93, + 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, + 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, + 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 52, 53, 0, 54, 0, 55, 56, 18, 0, + 0, 19, 0, 57, 58, 0, 20, 21, 22, -78, 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, - 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, + 36, 37, 236, 237, 238, 239, 0, 0, 0, 240, + 0, 241, 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, + 49, 50, 0, 0, 0, 0, 172, 173, 174, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 52, 53, 0, 54, + 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, 19, 0, 57, 58, - 0, 20, 21, 22, 150, 23, 24, 25, 26, 27, + 0, 20, 21, 22, 0, 0, 23, 24, 25, 26, + 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, + 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 38, 0, 0, 39, 40, 41, 42, 43, 0, -215, + 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, + 207, 0, 208, -215, -215, 0, 51, 0, 0, 0, + -215, -215, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 53, 0, 54, 0, 55, 56, 0, 0, + 0, 0, -78, 57, 58, -215, -215, -215, -215, 0, + 0, 0, -215, 0, -215, 0, 0, -215, 0, 0, + 0, 0, 0, 0, -215, -215, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, -215, 0, -215, + -215, -215, 0, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, -215, -215, -215, -254, 0, 0, + 0, -215, 0, 0, -215, -215, -215, -215, -215, 0, + 0, -254, -254, 0, 0, 0, 0, 0, -254, -254, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, -254, -254, -254, -254, 0, 0, 0, + -254, 0, -254, 0, 0, -254, 0, 0, 0, 0, + 0, 0, -254, -254, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, -254, 0, -254, -254, -254, + 0, -254, -254, -254, -254, -254, -254, -254, -254, -254, + -254, -254, -254, -254, -254, 0, 0, 0, 0, -254, + 0, 0, -254, -254, -254, -254, -254, 18, 83, 0, + 19, 0, 0, 0, 0, 20, 21, 22, 0, 0, + 23, 24, 142, 26, 27, 28, 29, 115, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 119, 57, 58, 0, + 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, @@ -561,46 +548,18 @@ static const yytype_int16 yytable[] = 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 0, 23, - 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, - 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, - 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, - 56, 18, 0, 0, 19, 169, 57, 58, 0, 20, - 21, 22, 0, 23, 24, 25, 26, 27, 28, 29, - 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, - 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, - 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, - 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, - 0, 54, 0, 55, 56, 18, 0, 0, 19, 266, - 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, - 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, - 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, - 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, - 0, 0, 19, 281, 57, 58, 0, 20, 21, 22, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, - 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 0, 0, 19, 293, 57, 58, - 0, 20, 21, 22, 0, 23, 24, 25, 26, 27, + 52, 53, 0, 54, 0, 55, 56, 18, 83, 0, + 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 0, 57, 58, 0, + 20, 21, 22, 150, 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, @@ -609,383 +568,438 @@ static const yytype_int16 yytable[] = 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 326, 57, 58, 0, 20, 21, 22, 0, 23, - 24, 25, 26, 27, 28, 29, 0, 30, 31, 32, - 33, 34, 35, 0, 0, 0, 0, 0, 36, 37, + 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 169, 57, 58, 0, + 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 38, 0, 0, 39, 40, 41, 42, - 43, 0, 0, 44, 45, 46, 47, 48, 49, 50, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 51, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 266, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 281, 57, 58, 0, + 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 53, 0, 54, 0, 55, - 56, 18, 0, 0, 19, 386, 57, 58, 0, 20, - 21, 22, 0, 23, 24, 25, 26, 27, 28, 29, - 0, 30, 31, 32, 33, 34, 35, 0, 0, 0, - 0, 0, 36, 37, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 38, 0, 0, - 39, 40, 41, 42, 43, 0, 0, 44, 45, 46, - 47, 48, 49, 50, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 52, 53, - 0, 54, 0, 55, 56, 18, 0, 0, 19, 404, - 57, 58, 0, 20, 21, 22, 0, 23, 24, 25, - 26, 27, 28, 29, 0, 30, 31, 32, 33, 34, - 35, 0, 0, 0, 0, 0, 36, 37, 0, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 293, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 326, 57, 58, 0, + 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 38, 0, 0, 39, 40, 41, 42, 43, 0, - 0, 44, 45, 46, 47, 48, 49, 50, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 51, 0, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 386, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 18, 0, 0, 19, 404, 57, 58, 0, + 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, + 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, + 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, + 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, + 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 52, 53, 0, 54, 0, 55, 56, 18, - 0, 0, 19, 0, 57, 58, 0, 20, 21, 22, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, - 36, 37, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 38, 0, 0, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 0, 0, 185, 0, 0, 0, 0, 0, - 0, 186, 187, 0, 0, 0, 52, 53, 0, 54, - 0, 55, 56, 0, 0, 0, 0, 0, 275, 58, - 188, 189, 396, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, 185, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, + 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, + 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, + 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, + 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, + 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, + 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 51, 0, 0, 185, 0, 0, 0, 0, 0, 0, + 186, 187, 0, 0, 0, 52, 53, 0, 54, 0, + 55, 56, 0, 0, 0, 0, 0, 275, 58, 188, + 189, 396, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, + 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 188, 189, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, 185, 0, 202, 203, 204, 205, - 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 188, 189, 0, 190, 191, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, + 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, + 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 189, 0, 190, 191, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 0, 0, 0, 0, 201, -291, - 0, 202, 203, 204, 205, 0, 186, 187, 0, 0, + 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 200, 0, 0, 0, 0, 201, -291, 0, + 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, - 192, 193, 194, 195, 196, 197, 198, 199, 200, 0, - 0, 0, 0, 201, 0, 0, 202, 203, 204, 205 + 0, 0, 0, 0, 0, 0, 0, 190, 191, 192, + 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { 17, 126, 10, 49, 9, 355, 43, 138, 139, 49, - 11, 19, 13, 12, 51, 15, 475, 76, 262, 11, - 13, 19, 18, 11, 22, 21, 0, 23, 24, 154, - 26, 27, 24, 21, 10, 13, 18, 29, 46, 21, - 11, 23, 24, 19, 26, 27, 22, 43, 44, 57, - 109, 21, 23, 24, 13, 24, 19, 27, 29, 22, - 29, 43, 44, 11, 11, 13, 13, 49, 11, 11, - 11, 13, 13, 345, 506, 11, 58, 13, 83, 109, - 73, 10, 11, 355, 13, 109, 358, 359, 109, 126, - 19, 93, 94, 22, 23, 71, 25, 19, 15, 558, - 22, 11, 21, 13, 91, 92, 14, 106, 109, 146, - 156, 111, 110, 93, 73, 97, 156, 154, 110, 91, - 20, 129, 22, 109, 14, 256, 73, 14, 11, 137, - 138, 139, 73, 33, 110, 567, 11, 66, 38, 110, - 49, 50, 42, 139, 14, 45, 24, 110, 48, 157, - 50, 109, 52, 53, 54, 55, 56, 139, 216, 217, - 79, 80, 81, 73, 172, 173, 174, 439, 176, 177, - 178, 79, 80, 81, 156, 14, 420, 109, 100, 225, - 109, 110, 79, 80, 81, 225, 21, 109, 110, 79, - 80, 81, 79, 80, 81, 21, 109, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 478, 479, 109, 79, - 80, 81, 21, 14, 564, 220, 221, 222, 223, 224, - 257, 226, 227, 205, 229, 230, 470, 109, 236, 237, - 238, 239, 240, 241, 79, 80, 81, 14, 109, 511, - 79, 80, 81, 225, 79, 80, 81, 11, 256, 13, - 11, 376, 13, 79, 80, 81, 156, 104, 105, 106, - 107, 21, 270, 108, 14, 36, 37, 275, 89, 90, - 79, 80, 81, 545, 21, 175, 407, 285, 79, 80, - 81, 181, 51, 76, 184, 185, 186, 187, 188, 189, + 10, 19, 475, 11, 51, 13, 13, 0, 262, 19, + 12, 506, 18, 23, 13, 21, 11, 23, 24, 154, + 26, 27, 77, 11, 14, 13, 18, 11, 46, 21, + 11, 23, 24, 11, 26, 27, 110, 43, 44, 57, + 24, 25, 13, 21, 25, 11, 30, 13, 25, 30, + 14, 43, 44, 30, 15, 110, 19, 49, 14, 72, + 23, 19, 72, 345, 15, 23, 58, 74, 83, 110, + 19, 22, 567, 355, 23, 74, 358, 359, 110, 126, + 10, 11, 11, 13, 13, 558, 74, 92, 101, 19, + 80, 81, 82, 23, 24, 11, 26, 110, 111, 146, + 156, 111, 110, 94, 106, 97, 156, 154, 74, 110, + 20, 129, 22, 21, 11, 256, 80, 81, 82, 137, + 138, 139, 21, 33, 80, 81, 82, 111, 38, 28, + 111, 25, 42, 139, 14, 45, 110, 67, 48, 157, + 50, 110, 52, 53, 54, 55, 56, 139, 111, 80, + 81, 82, 101, 111, 172, 173, 174, 439, 176, 177, + 178, 110, 111, 11, 156, 13, 420, 110, 14, 225, + 110, 21, 80, 81, 82, 225, 14, 11, 109, 13, + 110, 111, 14, 105, 106, 107, 108, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 478, 479, 110, 21, + 80, 81, 82, 110, 564, 220, 221, 222, 223, 224, + 257, 226, 227, 205, 229, 230, 470, 21, 236, 237, + 238, 239, 240, 241, 52, 11, 14, 13, 21, 511, + 80, 81, 82, 225, 80, 81, 82, 11, 256, 13, + 74, 376, 80, 81, 82, 11, 156, 13, 80, 81, + 82, 110, 270, 14, 80, 81, 82, 275, 80, 81, + 82, 94, 95, 545, 77, 175, 407, 285, 92, 93, + 109, 181, 50, 51, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 79, 80, 81, 109, 108, 315, 316, 27, - 356, 14, 11, 108, 322, 73, 356, 12, 73, 18, - 13, 21, 21, 109, 23, 24, 24, 26, 27, 79, - 80, 81, 71, 24, 342, 343, 344, 345, 21, 376, - 29, 323, 15, 42, 43, 44, 45, 355, 473, 21, - 358, 359, 357, 27, 100, 45, 46, 47, 48, 58, - 477, 100, 52, 480, 54, 347, 77, 484, 485, 12, - 109, 110, 377, 108, 356, 27, 79, 80, 81, 79, - 80, 81, 13, 23, 392, 502, 503, 81, 23, 79, - 80, 81, 79, 80, 81, 512, 79, 80, 81, 407, - 101, 100, 23, 104, 105, 106, 107, 79, 80, 81, - 527, 23, 417, 23, 531, 532, 421, 109, 108, 64, - 65, 108, 17, 79, 80, 81, 509, 432, 24, 110, - 109, 439, 549, 132, 83, 12, 473, 108, 12, 447, - 139, 524, 525, 109, 12, 12, 563, 12, 93, 94, - 95, 96, 108, 536, 571, 24, 101, 64, 65, 104, - 105, 106, 107, 546, 547, 109, 0, 108, 21, 108, - 478, 479, 489, 77, 491, 108, 559, 11, 108, 13, - 14, 15, 108, 500, 64, 65, 108, 21, 95, 96, - 108, 496, 11, 11, 101, 12, 396, 104, 105, 106, - 107, 21, 510, 511, 79, 80, 81, 108, 21, 526, - 11, 45, 46, 47, 48, 109, 96, 108, 52, 108, - 54, 101, 108, 57, 104, 105, 106, 107, 75, 21, - 64, 65, 21, 108, 233, 108, 21, 545, 109, 79, - 80, 81, 442, 77, 561, 79, 80, 81, 108, 83, - 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, 96, 16, 0, 64, 65, 101, 108, 74, - 104, 105, 106, 107, 108, 108, 108, 111, 14, 15, - 238, 239, 240, 241, 13, 21, 79, 80, 81, 88, - 89, 90, 91, 92, 93, 94, 95, 96, 79, 80, - 81, 343, 101, 106, 510, 104, 105, 106, 107, 45, - 46, 47, 48, 564, 419, 108, 52, 277, 54, 248, - 371, 57, 452, 372, 323, 471, 156, 108, 64, 65, - 496, 356, 79, 80, 81, 225, -1, -1, -1, -1, - -1, 77, -1, 79, 80, 81, -1, 83, 84, 85, - 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, - 96, 108, -1, 0, 1, 101, -1, -1, 104, 105, - 106, 107, 108, 10, 11, 111, 13, -1, -1, -1, - -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, + 200, 201, 80, 81, 82, 216, 217, 315, 316, 28, + 356, 74, 11, 109, 322, 12, 356, 21, 13, 18, + 21, 74, 21, 25, 23, 24, 101, 26, 27, 80, + 81, 82, 25, 21, 342, 343, 344, 345, 110, 376, + 30, 323, 15, 42, 43, 44, 45, 355, 473, 28, + 358, 359, 357, 36, 37, 46, 47, 48, 49, 58, + 477, 21, 53, 480, 55, 347, 78, 484, 485, 80, + 81, 82, 377, 109, 356, 12, 80, 81, 82, 80, + 81, 82, 89, 90, 392, 502, 503, 28, 13, 80, + 81, 82, 80, 81, 82, 512, 82, 24, 109, 407, + 24, 100, 24, 24, 24, 80, 81, 82, 17, 25, + 527, 111, 417, 84, 531, 532, 421, 109, 109, 12, + 80, 81, 82, 110, 12, 65, 509, 432, 110, 110, + 12, 439, 549, 132, 109, 12, 473, 12, 25, 447, + 139, 524, 525, 109, 109, 109, 563, 109, 80, 81, + 82, 110, 109, 536, 571, 109, 21, 97, 65, 66, + 109, 78, 102, 546, 547, 105, 106, 107, 108, 11, + 478, 479, 489, 11, 491, 12, 559, 109, 80, 81, + 82, 65, 66, 500, 91, 92, 93, 94, 95, 96, + 97, 496, 21, 21, 109, 102, 396, 11, 105, 106, + 107, 108, 510, 511, 80, 81, 82, 109, 109, 526, + 94, 95, 96, 97, 80, 81, 82, 109, 102, 76, + 110, 105, 106, 107, 108, 21, 21, 110, 0, 1, + 109, 109, 21, 109, 233, 109, 16, 545, 10, 11, + 75, 13, 442, 109, 561, 109, 18, 19, 20, 21, + 109, 23, 24, 25, 26, 27, 28, 29, 13, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, + 106, 53, 54, 55, 56, 57, 510, 59, 60, 61, + 62, 63, 64, 343, 564, 67, 68, 69, 70, 71, + 72, 73, 89, 90, 91, 92, 93, 94, 95, 96, + 97, 83, 80, 81, 82, 102, 277, 419, 105, 106, + 107, 108, 248, 371, 323, 372, 98, 99, 496, 101, + 471, 103, 104, 0, 1, 452, 156, -1, 110, 111, + 356, 109, -1, 10, 11, 225, 13, 238, 239, 240, + 241, 18, 19, 20, 21, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 64, 65, -1, 52, 53, 54, 55, 56, - -1, 58, 59, 60, 61, 62, 63, -1, -1, 66, - 67, 68, 69, 70, 71, 72, -1, 89, 90, 91, - 92, 93, 94, 95, 96, 82, -1, -1, -1, 101, - -1, -1, 104, 105, 106, 107, -1, 0, 1, -1, - 97, 98, -1, 100, -1, 102, 103, 10, 11, -1, - 13, -1, 109, 110, -1, 18, 19, 20, 21, 22, - 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, 48, 64, 65, -1, 52, - 53, 54, 55, 56, -1, 58, 59, 60, 61, 62, - 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, - -1, -1, 90, 91, 92, 93, 94, 95, 96, 82, - -1, -1, -1, 101, -1, -1, 104, 105, 106, 107, - -1, -1, 1, -1, 97, 98, -1, 100, -1, 102, - 103, 10, 11, 12, 13, -1, 109, 110, -1, 18, - 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, - -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, - 64, 65, -1, 52, 53, 54, 55, 56, -1, 58, - 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, - 69, 70, 71, 72, -1, -1, -1, 91, 92, 93, - 94, 95, 96, 82, -1, -1, -1, 101, -1, -1, - 104, 105, 106, 107, -1, -1, 1, -1, 97, 98, - -1, 100, -1, 102, 103, 10, 11, 12, 13, -1, - 109, 110, -1, 18, 19, 20, 21, 22, 23, 24, - 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 48, 64, -1, -1, 52, 53, 54, - 55, 56, -1, 58, 59, 60, 61, 62, 63, -1, - -1, 66, 67, 68, 69, 70, 71, 72, 3, 4, - 5, 6, 7, 8, 9, -1, 96, 82, -1, -1, - -1, 101, -1, -1, 104, 105, 106, 107, -1, -1, - 1, -1, 97, 98, -1, 100, -1, 102, 103, 10, - 11, 12, 13, -1, 109, 110, -1, 18, 19, 20, - 21, 22, 23, 24, 25, 26, 27, 28, -1, 30, - 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, 48, -1, -1, - -1, 52, 53, 54, 55, 56, -1, 58, 59, 60, - 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, - 71, 72, -1, -1, 96, -1, -1, -1, -1, 101, - -1, 82, 104, 105, 106, 107, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 97, 98, -1, 100, - -1, 102, 103, 10, 11, 12, 13, -1, 109, 110, - -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 28, -1, 30, 31, 32, 33, 34, 35, 36, + 47, 48, 49, 65, 66, -1, 53, 54, 55, 56, + 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, + 67, 68, 69, 70, 71, 72, 73, -1, 90, 91, + 92, 93, 94, 95, 96, 97, 83, -1, -1, -1, + 102, -1, -1, 105, 106, 107, 108, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, + -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, + -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, + 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, + 72, 73, -1, -1, -1, 92, 93, 94, 95, 96, + 97, 83, -1, -1, -1, 102, -1, -1, 105, 106, + 107, 108, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, 12, 13, -1, 110, 111, + -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, -1, -1, -1, 52, 53, 54, 55, 56, - -1, 58, 59, 60, 61, 62, 63, -1, -1, 66, - 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, - 97, 98, -1, 100, -1, 102, 103, 10, 11, 12, - 13, -1, 109, 110, -1, 18, 19, 20, 21, 22, - 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, - 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, - 43, 44, 45, 46, 47, 48, -1, -1, -1, 52, - 53, 54, 55, 56, -1, 58, 59, 60, 61, 62, - 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 1, -1, 97, 98, -1, 100, -1, 102, - 103, 10, 11, -1, 13, -1, 109, 110, -1, 18, - 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, - -1, 30, 31, 32, 33, 34, 35, 36, 37, 38, - 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, - -1, -1, -1, 52, 53, 54, 55, 56, -1, 58, - 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, - 69, 70, 71, 72, -1, -1, 75, -1, -1, -1, - -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 1, -1, 97, 98, - -1, 100, -1, 102, 103, 10, 11, -1, 13, -1, - 109, 110, -1, 18, 19, 20, 21, 22, 23, 24, - 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, - 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, - 45, 46, 47, 48, -1, -1, -1, 52, 53, 54, - 55, 56, -1, 58, 59, 60, 61, 62, 63, -1, - -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 1, -1, 97, 98, -1, 100, -1, 102, 103, 10, - 11, -1, 13, -1, 109, 110, -1, 18, 19, 20, - 21, 22, 23, 24, 25, 26, 27, 28, -1, 30, - 31, 32, 33, 34, 35, 36, -1, 38, 39, 40, - 41, 42, 43, 44, 45, 46, 47, 48, -1, -1, - -1, 52, 53, 54, 55, 56, -1, 58, 59, 60, - 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, - 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 97, 98, -1, 100, - -1, 102, 103, 10, -1, -1, 13, -1, 109, 110, - -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, - -1, -1, -1, -1, 41, 42, 45, 46, 47, 48, - -1, -1, -1, 52, -1, 54, -1, -1, -1, 56, - -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, - 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, - 79, 80, 81, -1, -1, 82, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, - 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, - 13, -1, 109, 110, -1, 18, 19, 20, -1, 22, - 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, - 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, - 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, - 103, 10, 11, -1, 13, 108, 109, 110, -1, 18, - 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, - 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, - -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, - 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, - 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, - -1, 100, -1, 102, 103, 10, -1, -1, 13, 14, - 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, - 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, - 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, - -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, - 11, -1, 13, -1, 109, 110, -1, 18, 19, 20, - -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, - 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, - 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, - 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, - 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 97, 98, -1, 100, - -1, 102, 103, 10, -1, -1, 13, -1, 109, 110, - -1, 18, 19, 20, 21, 22, 23, 24, 25, 26, - 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, - -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 56, - -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, - 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, - 13, -1, 109, 110, -1, 18, 19, 20, -1, 22, - 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, - 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, + 47, 48, 49, 65, 66, -1, 53, 54, 55, 56, + 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, + 67, 68, 69, 70, 71, 72, 73, 3, 4, 5, + 6, 7, 8, 9, 96, 97, 83, -1, -1, -1, + 102, -1, -1, 105, 106, 107, 108, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, + -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, + -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, + 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, + 72, 73, 102, -1, -1, 105, 106, 107, 108, -1, + 97, 83, -1, -1, -1, 102, -1, -1, 105, 106, + 107, 108, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, 12, 13, -1, 110, 111, + -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, + 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, + 67, 68, 69, 70, 71, 72, 73, -1, -1, 97, + -1, -1, -1, -1, 102, -1, 83, 105, 106, 107, + 108, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, + -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, -1, -1, + -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, + 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, + 72, 73, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, -1, 13, -1, 110, 111, + -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, + 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, + 67, 68, 69, 70, 71, 72, 73, -1, -1, 76, + -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + -1, 13, -1, 110, 111, -1, 18, 19, 20, 21, + -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, -1, -1, + -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, + 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, + 72, 73, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, -1, 13, -1, 110, 111, + -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, + 37, -1, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, + 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, + 67, 68, 69, 70, 71, 72, 73, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, -1, + -1, 13, -1, 110, 111, -1, 18, 19, 20, 21, + -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 32, 33, 34, 35, 36, -1, -1, -1, -1, -1, + 42, 43, 46, 47, 48, 49, -1, -1, -1, 53, + -1, 55, -1, -1, -1, 57, -1, -1, 60, 61, + 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, + 72, 73, -1, -1, -1, -1, 80, 81, 82, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, -1, -1, 13, -1, 110, 111, + -1, 18, 19, 20, -1, -1, 23, 24, 25, 26, + 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, + -1, -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, - 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, + 57, -1, -1, 60, 61, 62, 63, 64, -1, 0, + 67, 68, 69, 70, 71, 72, 73, -1, -1, -1, + 11, -1, 13, 14, 15, -1, 83, -1, -1, -1, + 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 98, 99, -1, 101, -1, 103, 104, -1, -1, + -1, -1, 109, 110, 111, 46, 47, 48, 49, -1, + -1, -1, 53, -1, 55, -1, -1, 58, -1, -1, + -1, -1, -1, -1, 65, 66, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 78, -1, 80, + 81, 82, -1, 84, 85, 86, 87, 88, 89, 90, + 91, 92, 93, 94, 95, 96, 97, 0, -1, -1, + -1, 102, -1, -1, 105, 106, 107, 108, 109, -1, + -1, 14, 15, -1, -1, -1, -1, -1, 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, - 103, 10, -1, -1, 13, 108, 109, 110, -1, 18, - 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, - -1, 30, 31, 32, 33, 34, 35, -1, -1, -1, - -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, - 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, - 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, - -1, 100, -1, 102, 103, 10, -1, -1, 13, 108, - 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, - 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, - 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, - -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, + -1, -1, -1, 46, 47, 48, 49, -1, -1, -1, + 53, -1, 55, -1, -1, 58, -1, -1, -1, -1, + -1, -1, 65, 66, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 78, -1, 80, 81, 82, + -1, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 97, -1, -1, -1, -1, 102, + -1, -1, 105, 106, 107, 108, 109, 10, 11, -1, + 13, -1, -1, -1, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, 14, 110, 111, -1, + 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, - -1, -1, 13, 108, 109, 110, -1, 18, 19, 20, - -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, - 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, - 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, - 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, - 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 82, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 97, 98, -1, 100, - -1, 102, 103, 10, -1, -1, 13, 108, 109, 110, - -1, 18, 19, 20, -1, 22, 23, 24, 25, 26, - 27, 28, -1, 30, 31, 32, 33, 34, 35, -1, - -1, -1, -1, -1, 41, 42, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 56, - -1, -1, 59, 60, 61, 62, 63, -1, -1, 66, - 67, 68, 69, 70, 71, 72, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 82, -1, -1, -1, -1, + 98, 99, -1, 101, -1, 103, 104, 10, 11, -1, + 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, -1, 110, 111, -1, + 18, 19, 20, 21, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 97, 98, -1, 100, -1, 102, 103, 10, -1, -1, - 13, 108, 109, 110, -1, 18, 19, 20, -1, 22, - 23, 24, 25, 26, 27, 28, -1, 30, 31, 32, - 33, 34, 35, -1, -1, -1, -1, -1, 41, 42, + 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, + 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, + 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 56, -1, -1, 59, 60, 61, 62, - 63, -1, -1, 66, 67, 68, 69, 70, 71, 72, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 82, + 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, + 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, + 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 97, 98, -1, 100, -1, 102, - 103, 10, -1, -1, 13, 108, 109, 110, -1, 18, - 19, 20, -1, 22, 23, 24, 25, 26, 27, 28, - -1, 30, 31, 32, 33, 34, 35, -1, -1, -1, - -1, -1, 41, 42, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 56, -1, -1, - 59, 60, 61, 62, 63, -1, -1, 66, 67, 68, - 69, 70, 71, 72, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 82, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 97, 98, - -1, 100, -1, 102, 103, 10, -1, -1, 13, 108, - 109, 110, -1, 18, 19, 20, -1, 22, 23, 24, - 25, 26, 27, 28, -1, 30, 31, 32, 33, 34, - 35, -1, -1, -1, -1, -1, 41, 42, -1, -1, + 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, + 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, + 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 56, -1, -1, 59, 60, 61, 62, 63, -1, - -1, 66, 67, 68, 69, 70, 71, 72, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 82, -1, -1, + 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, + 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, + 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, + 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, + -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, + -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, + 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 97, 98, -1, 100, -1, 102, 103, 10, - -1, -1, 13, -1, 109, 110, -1, 18, 19, 20, - -1, 22, 23, 24, 25, 26, 27, 28, -1, 30, - 31, 32, 33, 34, 35, -1, -1, -1, -1, -1, - 41, 42, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 56, -1, -1, 59, 60, - 61, 62, 63, -1, -1, 66, 67, 68, 69, 70, - 71, 72, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 82, -1, -1, 57, -1, -1, -1, -1, -1, - -1, 64, 65, -1, -1, -1, 97, 98, -1, 100, - -1, 102, 103, -1, -1, -1, -1, -1, 109, 110, - 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 96, -1, -1, -1, -1, 101, 57, - -1, 104, 105, 106, 107, -1, 64, 65, -1, -1, + 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, + 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, + 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, + 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, + 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, + 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, + 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 83, -1, -1, 58, -1, -1, -1, -1, -1, -1, + 65, 66, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, -1, -1, -1, -1, -1, 110, 111, 84, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 97, -1, -1, -1, -1, 102, 58, -1, + 105, 106, 107, 108, -1, 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, 84, -1, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 96, -1, - -1, -1, -1, 101, 57, -1, 104, 105, 106, 107, - -1, 64, 65, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 84, 85, -1, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, + -1, -1, 102, 58, -1, 105, 106, 107, 108, -1, + 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 84, -1, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 96, -1, -1, -1, -1, 101, 57, - -1, 104, 105, 106, 107, -1, 64, 65, -1, -1, + 85, -1, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 97, -1, -1, -1, -1, 102, 58, -1, + 105, 106, 107, 108, -1, 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 86, 87, - 88, 89, 90, 91, 92, 93, 94, 95, 96, -1, - -1, -1, -1, 101, -1, -1, 104, 105, 106, 107 + -1, -1, -1, -1, -1, -1, -1, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, + -1, -1, 102, -1, -1, 105, 106, 107, 108 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -994,62 +1008,62 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 13, - 18, 19, 20, 22, 23, 24, 25, 26, 27, 28, - 30, 31, 32, 33, 34, 35, 41, 42, 56, 59, - 60, 61, 62, 63, 66, 67, 68, 69, 70, 71, - 72, 82, 97, 98, 100, 102, 103, 109, 110, 174, + 18, 19, 20, 23, 24, 25, 26, 27, 28, 29, + 31, 32, 33, 34, 35, 36, 42, 43, 57, 60, + 61, 62, 63, 64, 67, 68, 69, 70, 71, 72, + 73, 83, 98, 99, 101, 103, 104, 110, 111, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 11, 121, 1, 21, 36, 38, 39, - 40, 43, 44, 45, 46, 47, 48, 52, 53, 54, - 55, 58, 121, 130, 141, 174, 37, 128, 129, 130, - 126, 168, 169, 126, 24, 29, 121, 200, 208, 14, + 205, 206, 207, 11, 121, 1, 21, 37, 39, 40, + 41, 44, 45, 46, 47, 48, 49, 53, 54, 55, + 56, 59, 121, 130, 141, 174, 38, 128, 129, 130, + 126, 168, 169, 126, 25, 30, 121, 200, 208, 14, 174, 188, 208, 188, 208, 208, 208, 208, 189, 13, - 109, 188, 152, 152, 152, 188, 109, 109, 76, 109, - 121, 188, 24, 175, 192, 200, 208, 208, 121, 188, - 21, 174, 24, 29, 154, 188, 100, 109, 191, 200, - 201, 202, 188, 175, 188, 188, 188, 188, 188, 108, - 174, 208, 79, 80, 81, 15, 11, 13, 109, 93, - 94, 93, 91, 92, 91, 57, 64, 65, 83, 84, - 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, - 96, 101, 104, 105, 106, 107, 109, 11, 13, 11, - 13, 11, 13, 11, 123, 153, 154, 154, 24, 151, - 109, 109, 109, 109, 71, 100, 109, 198, 200, 109, - 109, 121, 21, 51, 143, 21, 45, 46, 47, 48, - 52, 54, 129, 130, 128, 19, 22, 110, 159, 160, - 162, 163, 164, 165, 14, 192, 109, 76, 174, 108, - 121, 27, 155, 73, 156, 108, 108, 174, 193, 193, - 208, 175, 12, 21, 192, 109, 188, 191, 200, 201, - 202, 108, 174, 73, 157, 13, 108, 174, 174, 174, - 188, 174, 174, 108, 174, 188, 188, 188, 188, 188, + 110, 188, 152, 152, 152, 188, 110, 110, 77, 110, + 121, 188, 25, 175, 192, 200, 208, 208, 121, 188, + 21, 174, 25, 30, 154, 188, 101, 110, 191, 200, + 201, 202, 188, 175, 188, 188, 188, 188, 188, 109, + 174, 208, 80, 81, 82, 15, 11, 13, 110, 94, + 95, 94, 92, 93, 92, 58, 65, 66, 84, 85, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 97, 102, 105, 106, 107, 108, 110, 11, 13, 11, + 13, 11, 13, 11, 123, 153, 154, 154, 25, 151, + 110, 110, 110, 110, 72, 101, 110, 198, 200, 110, + 110, 121, 21, 52, 143, 21, 46, 47, 48, 49, + 53, 55, 129, 130, 128, 19, 23, 111, 159, 160, + 162, 163, 164, 165, 14, 192, 110, 77, 174, 109, + 121, 28, 155, 74, 156, 109, 109, 174, 193, 193, + 208, 175, 12, 21, 192, 110, 188, 191, 200, 201, + 202, 109, 174, 74, 157, 13, 109, 174, 174, 174, + 188, 174, 174, 109, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 13, 19, 22, 23, - 25, 66, 109, 110, 178, 200, 108, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 24, 150, 151, 151, - 24, 133, 123, 123, 123, 123, 100, 123, 71, 196, - 197, 199, 200, 201, 202, 123, 123, 109, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 29, - 158, 158, 15, 193, 175, 14, 177, 156, 27, 123, - 173, 108, 77, 108, 174, 12, 108, 174, 157, 108, - 27, 174, 13, 21, 14, 108, 85, 23, 174, 174, - 23, 23, 23, 23, 108, 174, 23, 109, 108, 21, + 188, 188, 188, 188, 10, 11, 13, 19, 23, 24, + 26, 67, 110, 111, 178, 200, 109, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 25, 150, 151, 151, + 25, 133, 123, 123, 123, 123, 101, 123, 72, 196, + 197, 199, 200, 201, 202, 123, 123, 110, 123, 123, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 30, + 158, 158, 15, 193, 175, 14, 177, 156, 28, 123, + 173, 109, 78, 109, 174, 12, 109, 174, 157, 109, + 28, 174, 13, 21, 14, 109, 86, 24, 174, 174, + 24, 24, 24, 24, 109, 174, 24, 110, 109, 21, 14, 21, 14, 21, 14, 21, 12, 17, 122, 131, - 132, 11, 21, 24, 146, 174, 147, 148, 174, 148, - 195, 200, 109, 141, 145, 148, 149, 174, 196, 123, - 148, 148, 83, 161, 161, 163, 108, 111, 194, 192, - 123, 171, 109, 166, 167, 108, 108, 14, 174, 12, - 188, 21, 14, 108, 193, 12, 12, 12, 12, 123, - 155, 156, 123, 24, 108, 108, 108, 108, 109, 123, - 108, 21, 136, 148, 108, 108, 188, 174, 77, 11, - 168, 11, 14, 12, 108, 21, 156, 21, 172, 173, + 132, 11, 21, 25, 146, 174, 147, 148, 174, 148, + 195, 200, 110, 141, 145, 148, 149, 174, 196, 123, + 148, 148, 84, 161, 161, 163, 109, 22, 194, 192, + 123, 171, 110, 166, 167, 109, 109, 14, 174, 12, + 188, 21, 14, 109, 193, 12, 12, 12, 12, 123, + 155, 156, 123, 25, 109, 109, 109, 109, 110, 123, + 109, 21, 136, 148, 109, 109, 188, 174, 78, 11, + 168, 11, 14, 12, 109, 21, 156, 21, 172, 173, 137, 192, 144, 144, 11, 124, 124, 148, 148, 124, - 134, 109, 108, 124, 124, 126, 108, 126, 75, 21, - 170, 171, 126, 21, 124, 124, 125, 49, 50, 142, - 142, 108, 108, 143, 146, 148, 124, 12, 12, 127, - 12, 143, 143, 126, 124, 109, 124, 124, 21, 108, - 143, 21, 27, 138, 12, 148, 143, 143, 135, 124, - 16, 74, 139, 108, 144, 143, 126, 124, 149, 75, - 142, 108, 124 + 134, 110, 109, 124, 124, 126, 109, 126, 76, 21, + 170, 171, 126, 21, 124, 124, 125, 50, 51, 142, + 142, 109, 109, 143, 146, 148, 124, 12, 12, 127, + 12, 143, 143, 126, 124, 110, 124, 124, 21, 109, + 143, 21, 28, 138, 12, 148, 143, 143, 135, 124, + 16, 75, 139, 109, 144, 143, 126, 124, 149, 76, + 142, 109, 124 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ @@ -1134,21 +1148,21 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, @@ -1168,6 +1182,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * d555d290bc7bf474791b8fd853e445933bb75ff8ff453aca9f7ff3b05b614566 perly.y + * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 0997e3e2ddc6..2724f86bcf27 100644 --- a/perly.y +++ b/perly.y @@ -57,6 +57,7 @@ %token PERLY_PERCENT_SIGN %token PERLY_PLUS %token PERLY_SEMICOLON +%token PERLY_SLASH %token PERLY_SNAIL %token PERLY_STAR @@ -1351,7 +1352,7 @@ optexpr: /* NULL */ optrepl: /* NULL */ { $$ = NULL; } - | '/' expr + | PERLY_SLASH expr { $$ = $expr; } ; diff --git a/toke.c b/toke.c index 92d87d56dd40..d6b7caeae97f 100644 --- a/toke.c +++ b/toke.c @@ -402,6 +402,7 @@ static struct debug_tokens { DEBUG_TOKEN (IVAL, PERLY_PLUS), DEBUG_TOKEN (IVAL, PERLY_QUESTION_MARK), DEBUG_TOKEN (IVAL, PERLY_SEMICOLON), + DEBUG_TOKEN (IVAL, PERLY_SLASH), DEBUG_TOKEN (IVAL, PERLY_SNAIL), DEBUG_TOKEN (IVAL, PERLY_STAR), DEBUG_TOKEN (IVAL, PERLY_TILDE), @@ -2608,7 +2609,7 @@ S_sublex_done(pTHX) + PL_parser->herelines; PL_parser->herelines = 0; } - return '/'; + return PERLY_SLASH; } else { const line_t l = CopLINE(PL_curcop); From bfa838ccb94dd637ff52d23247002d8322fc34f3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:20 +0100 Subject: [PATCH 345/503] Distinguish C- and perly- literals - PERLY_DOLLAR --- perly.act | 536 +++++++++--------- perly.h | 193 +++---- perly.tab | 1608 ++++++++++++++++++++++++++--------------------------- perly.y | 7 +- toke.c | 18 +- 5 files changed, 1171 insertions(+), 1191 deletions(-) diff --git a/perly.act b/perly.act index 8a560e1c8530..d72d1f5fd77b 100644 --- a/perly.act +++ b/perly.act @@ -5,7 +5,7 @@ */ case 2: -#line 136 "perly.y" +#line 137 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -14,7 +14,7 @@ case 2: break; case 3: -#line 141 "perly.y" +#line 142 "perly.y" { newPROG(block_end((ps[-1].val.ival),(ps[0].val.opval))); PL_compiling.cop_seq = 0; @@ -24,7 +24,7 @@ case 2: break; case 4: -#line 147 "perly.y" +#line 148 "perly.y" { parser->expect = XTERM; (yyval.ival) = 0; @@ -33,7 +33,7 @@ case 2: break; case 5: -#line 152 "perly.y" +#line 153 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -42,7 +42,7 @@ case 2: break; case 6: -#line 157 "perly.y" +#line 158 "perly.y" { parser->expect = XBLOCK; (yyval.ival) = 0; @@ -51,7 +51,7 @@ case 2: break; case 7: -#line 162 "perly.y" +#line 163 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -63,7 +63,7 @@ case 2: break; case 8: -#line 170 "perly.y" +#line 171 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -72,7 +72,7 @@ case 2: break; case 9: -#line 175 "perly.y" +#line 176 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -84,7 +84,7 @@ case 2: break; case 10: -#line 183 "perly.y" +#line 184 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -93,7 +93,7 @@ case 2: break; case 11: -#line 188 "perly.y" +#line 189 "perly.y" { PL_pad_reset_pending = TRUE; PL_eval_root = (ps[0].val.opval); @@ -105,7 +105,7 @@ case 2: break; case 12: -#line 196 "perly.y" +#line 197 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -114,7 +114,7 @@ case 2: break; case 13: -#line 201 "perly.y" +#line 202 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -123,7 +123,7 @@ case 2: break; case 14: -#line 206 "perly.y" +#line 207 "perly.y" { parser->expect = XSTATE; (yyval.ival) = 0; @@ -132,7 +132,7 @@ case 2: break; case 15: -#line 211 "perly.y" +#line 212 "perly.y" { PL_eval_root = (ps[0].val.opval); (yyval.ival) = 0; @@ -141,7 +141,7 @@ case 2: break; case 16: -#line 219 "perly.y" +#line 220 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -150,7 +150,7 @@ case 2: break; case 17: -#line 227 "perly.y" +#line 228 "perly.y" { if (parser->copline > (line_t)(ps[-6].val.ival)) parser->copline = (line_t)(ps[-6].val.ival); (yyval.opval) = block_end((ps[-5].val.ival), (ps[-2].val.opval)); @@ -159,14 +159,14 @@ case 2: break; case 18: -#line 234 "perly.y" +#line 235 "perly.y" { (yyval.ival) = block_start(TRUE); parser->parsed_sub = 0; } break; case 19: -#line 239 "perly.y" +#line 240 "perly.y" { if (parser->copline > (line_t)(ps[-3].val.ival)) parser->copline = (line_t)(ps[-3].val.ival); (yyval.opval) = block_end((ps[-2].val.ival), (ps[-1].val.opval)); @@ -175,20 +175,20 @@ case 2: break; case 20: -#line 246 "perly.y" +#line 247 "perly.y" { (yyval.ival) = block_start(FALSE); parser->parsed_sub = 0; } break; case 21: -#line 252 "perly.y" +#line 253 "perly.y" { (yyval.opval) = NULL; } break; case 22: -#line 254 "perly.y" +#line 255 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -198,13 +198,13 @@ case 2: break; case 23: -#line 263 "perly.y" +#line 264 "perly.y" { (yyval.opval) = NULL; } break; case 24: -#line 265 "perly.y" +#line 266 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-1].val.opval), (ps[0].val.opval)); PL_pad_reset_pending = TRUE; if ((ps[-1].val.opval) && (ps[0].val.opval)) @@ -214,7 +214,7 @@ case 2: break; case 25: -#line 274 "perly.y" +#line 275 "perly.y" { (yyval.opval) = (ps[0].val.opval) ? newSTATEOP(0, NULL, (ps[0].val.opval)) : NULL; } @@ -222,13 +222,13 @@ case 2: break; case 26: -#line 278 "perly.y" +#line 279 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 27: -#line 282 "perly.y" +#line 283 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -239,7 +239,7 @@ case 2: break; case 28: -#line 289 "perly.y" +#line 290 "perly.y" { SV *label = cSVOPx_sv((ps[-1].val.opval)); (yyval.opval) = newSTATEOP(SvFLAGS(label) & SVf_UTF8, @@ -250,13 +250,13 @@ case 2: break; case 29: -#line 299 "perly.y" +#line 300 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 30: -#line 301 "perly.y" +#line 302 "perly.y" { CV *fmtcv = PL_compcv; newFORM((ps[-2].val.ival), (ps[-1].val.opval), (ps[0].val.opval)); @@ -270,7 +270,7 @@ case 2: break; case 31: -#line 313 "perly.y" +#line 314 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -280,7 +280,7 @@ case 2: break; case 32: -#line 319 "perly.y" +#line 320 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-5].val.opval)->op_type == OP_CONST @@ -295,7 +295,7 @@ case 2: break; case 33: -#line 334 "perly.y" +#line 335 "perly.y" { init_named_cv(PL_compcv, (ps[-1].val.opval)); parser->in_my = 0; @@ -305,7 +305,7 @@ case 2: break; case 34: -#line 340 "perly.y" +#line 341 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (ps[-4].val.opval)->op_type == OP_CONST @@ -320,7 +320,7 @@ case 2: break; case 35: -#line 351 "perly.y" +#line 352 "perly.y" { package((ps[-1].val.opval)); if ((ps[-2].val.opval)) @@ -331,13 +331,13 @@ case 2: break; case 36: -#line 358 "perly.y" +#line 359 "perly.y" { CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ } break; case 37: -#line 360 "perly.y" +#line 361 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); utilize((ps[-6].val.ival), (ps[-5].val.ival), (ps[-3].val.opval), (ps[-2].val.opval), (ps[-1].val.opval)); @@ -348,7 +348,7 @@ case 2: break; case 38: -#line 367 "perly.y" +#line 368 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), op_scope((ps[-1].val.opval)), (ps[0].val.opval))); @@ -358,7 +358,7 @@ case 2: break; case 39: -#line 373 "perly.y" +#line 374 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newCONDOP(0, (ps[-3].val.opval), (ps[0].val.opval), op_scope((ps[-1].val.opval)))); @@ -368,7 +368,7 @@ case 2: break; case 40: -#line 379 "perly.y" +#line 380 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newGIVENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)), 0)); parser->copline = (line_t)(ps[-5].val.ival); @@ -377,19 +377,19 @@ case 2: break; case 41: -#line 384 "perly.y" +#line 385 "perly.y" { (yyval.opval) = block_end((ps[-3].val.ival), newWHENOP((ps[-2].val.opval), op_scope((ps[0].val.opval)))); } break; case 42: -#line 386 "perly.y" +#line 387 "perly.y" { (yyval.opval) = newWHENOP(0, op_scope((ps[0].val.opval))); } break; case 43: -#line 388 "perly.y" +#line 389 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -400,7 +400,7 @@ case 2: break; case 44: -#line 395 "perly.y" +#line 396 "perly.y" { (yyval.opval) = block_end((ps[-5].val.ival), newWHILEOP(0, 1, NULL, @@ -411,19 +411,19 @@ case 2: break; case 45: -#line 402 "perly.y" +#line 403 "perly.y" { parser->expect = XTERM; } break; case 46: -#line 404 "perly.y" +#line 405 "perly.y" { parser->expect = XTERM; } break; case 47: -#line 407 "perly.y" +#line 408 "perly.y" { OP *initop = (ps[-9].val.opval); OP *forop = newWHILEOP(0, 1, NULL, @@ -442,7 +442,7 @@ case 2: break; case 48: -#line 422 "perly.y" +#line 423 "perly.y" { (yyval.opval) = block_end((ps[-6].val.ival), newFOROP(0, (ps[-5].val.opval), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); parser->copline = (line_t)(ps[-8].val.ival); @@ -451,7 +451,7 @@ case 2: break; case 49: -#line 427 "perly.y" +#line 428 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, op_lvalue((ps[-6].val.opval), OP_ENTERLOOP), (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -461,13 +461,13 @@ case 2: break; case 50: -#line 433 "perly.y" +#line 434 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 51: -#line 435 "perly.y" +#line 436 "perly.y" { (yyval.opval) = block_end( (ps[-7].val.ival), @@ -484,7 +484,7 @@ case 2: break; case 52: -#line 448 "perly.y" +#line 449 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP( 0, op_lvalue(newUNOP(OP_REFGEN, 0, @@ -496,7 +496,7 @@ case 2: break; case 53: -#line 456 "perly.y" +#line 457 "perly.y" { (yyval.opval) = block_end((ps[-4].val.ival), newFOROP(0, NULL, (ps[-3].val.opval), (ps[-1].val.opval), (ps[0].val.opval))); @@ -506,7 +506,7 @@ case 2: break; case 54: -#line 462 "perly.y" +#line 463 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -516,7 +516,7 @@ case 2: break; case 55: -#line 468 "perly.y" +#line 469 "perly.y" { package((ps[-2].val.opval)); if ((ps[-3].val.opval)) { @@ -527,7 +527,7 @@ case 2: break; case 56: -#line 475 "perly.y" +#line 476 "perly.y" { /* a block is a loop that happens once */ (yyval.opval) = newWHILEOP(0, 1, NULL, @@ -539,7 +539,7 @@ case 2: break; case 57: -#line 483 "perly.y" +#line 484 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } @@ -547,7 +547,7 @@ case 2: break; case 58: -#line 487 "perly.y" +#line 488 "perly.y" { (yyval.opval) = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0), newSVOP(OP_CONST, 0, newSVpvs("Unimplemented"))); @@ -556,7 +556,7 @@ case 2: break; case 59: -#line 492 "perly.y" +#line 493 "perly.y" { (yyval.opval) = NULL; parser->copline = NOLINE; @@ -565,7 +565,7 @@ case 2: break; case 60: -#line 500 "perly.y" +#line 501 "perly.y" { OP *list; if ((ps[0].val.opval)) { OP *term = (ps[0].val.opval); @@ -584,74 +584,74 @@ case 2: break; case 61: -#line 517 "perly.y" +#line 518 "perly.y" { (yyval.opval) = NULL; } break; case 62: -#line 519 "perly.y" +#line 520 "perly.y" { (yyval.opval) = op_unscope((ps[-1].val.opval)); } break; case 64: -#line 527 "perly.y" +#line 528 "perly.y" { (yyval.opval) = NULL; } break; case 65: -#line 529 "perly.y" +#line 530 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 66: -#line 531 "perly.y" +#line 532 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 67: -#line 533 "perly.y" +#line 534 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 68: -#line 535 "perly.y" +#line 536 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, scalar((ps[0].val.opval)), (ps[-2].val.opval)); } break; case 69: -#line 537 "perly.y" +#line 538 "perly.y" { (yyval.opval) = newLOOPOP(OPf_PARENS, 1, (ps[0].val.opval), (ps[-2].val.opval)); } break; case 70: -#line 539 "perly.y" +#line 540 "perly.y" { (yyval.opval) = newFOROP(0, NULL, (ps[0].val.opval), (ps[-2].val.opval), NULL); parser->copline = (line_t)(ps[-1].val.ival); } break; case 71: -#line 542 "perly.y" +#line 543 "perly.y" { (yyval.opval) = newWHENOP((ps[0].val.opval), op_scope((ps[-2].val.opval))); } break; case 72: -#line 547 "perly.y" +#line 548 "perly.y" { (yyval.opval) = NULL; } break; case 73: -#line 549 "perly.y" +#line 550 "perly.y" { ((ps[0].val.opval))->op_flags |= OPf_PARENS; (yyval.opval) = op_scope((ps[0].val.opval)); @@ -660,7 +660,7 @@ case 2: break; case 74: -#line 554 "perly.y" +#line 555 "perly.y" { parser->copline = (line_t)(ps[-5].val.ival); (yyval.opval) = newCONDOP(0, newSTATEOP(OPf_SPECIAL,NULL,(ps[-3].val.opval)), @@ -671,19 +671,19 @@ case 2: break; case 75: -#line 564 "perly.y" +#line 565 "perly.y" { (yyval.opval) = NULL; } break; case 76: -#line 566 "perly.y" +#line 567 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 77: -#line 571 "perly.y" +#line 572 "perly.y" { (yyval.ival) = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } @@ -691,13 +691,13 @@ case 2: break; case 78: -#line 577 "perly.y" +#line 578 "perly.y" { (yyval.opval) = NULL; } break; case 80: -#line 583 "perly.y" +#line 584 "perly.y" { YYSTYPE tmplval; (void)scan_num("1", &tmplval); (yyval.opval) = tmplval.opval; } @@ -705,118 +705,118 @@ case 2: break; case 82: -#line 591 "perly.y" +#line 592 "perly.y" { (yyval.opval) = invert(scalar((ps[0].val.opval))); } break; case 83: -#line 596 "perly.y" +#line 597 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 84: -#line 600 "perly.y" +#line 601 "perly.y" { (yyval.opval) = (ps[0].val.opval); intro_my(); } break; case 85: -#line 603 "perly.y" +#line 604 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 86: -#line 604 "perly.y" +#line 605 "perly.y" { (yyval.opval) = NULL; } break; case 87: -#line 608 "perly.y" +#line 609 "perly.y" { (yyval.ival) = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } break; case 88: -#line 614 "perly.y" +#line 615 "perly.y" { (yyval.ival) = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } break; case 89: -#line 619 "perly.y" +#line 620 "perly.y" { (yyval.ival) = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } break; case 92: -#line 630 "perly.y" +#line 631 "perly.y" { (yyval.opval) = NULL; } break; case 94: -#line 636 "perly.y" +#line 637 "perly.y" { (yyval.opval) = NULL; } break; case 95: -#line 638 "perly.y" +#line 639 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 96: -#line 640 "perly.y" +#line 641 "perly.y" { (yyval.opval) = NULL; } break; case 97: -#line 645 "perly.y" +#line 646 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 98: -#line 647 "perly.y" +#line 648 "perly.y" { (yyval.opval) = NULL; } break; case 99: -#line 658 "perly.y" +#line 659 "perly.y" { parser->in_my = 0; (yyval.opval) = NULL; } break; case 100: -#line 660 "perly.y" +#line 661 "perly.y" { parser->in_my = 0; (yyval.opval) = (ps[0].val.opval); } break; case 101: -#line 665 "perly.y" +#line 666 "perly.y" { (yyval.ival) = '@'; } break; case 102: -#line 667 "perly.y" +#line 668 "perly.y" { (yyval.ival) = '%'; } break; case 103: -#line 671 "perly.y" +#line 672 "perly.y" { I32 sigil = (ps[-2].val.ival); OP *var = (ps[-1].val.opval); @@ -836,25 +836,25 @@ case 2: break; case 104: -#line 690 "perly.y" +#line 691 "perly.y" { (yyval.opval) = NULL; } break; case 105: -#line 692 "perly.y" +#line 693 "perly.y" { (yyval.opval) = newOP(OP_NULL, 0); } break; case 106: -#line 694 "perly.y" +#line 695 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 107: -#line 700 "perly.y" +#line 701 "perly.y" { OP *var = (ps[-1].val.opval); OP *defexpr = (ps[0].val.opval); @@ -919,25 +919,25 @@ case 2: break; case 108: -#line 765 "perly.y" +#line 766 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 109: -#line 767 "perly.y" +#line 768 "perly.y" { parser->in_my = KEY_sigvar; (yyval.opval) = (ps[0].val.opval); } break; case 110: -#line 773 "perly.y" +#line 774 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 111: -#line 775 "perly.y" +#line 776 "perly.y" { (yyval.opval) = op_append_list(OP_LINESEQ, (ps[-2].val.opval), (ps[0].val.opval)); } @@ -945,43 +945,43 @@ case 2: break; case 112: -#line 779 "perly.y" +#line 780 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 113: -#line 784 "perly.y" +#line 785 "perly.y" { (yyval.opval) = NULL; } break; case 114: -#line 786 "perly.y" +#line 787 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 115: -#line 790 "perly.y" +#line 791 "perly.y" { (yyval.opval) = NULL; } break; case 116: -#line 792 "perly.y" +#line 793 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 117: -#line 796 "perly.y" +#line 797 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 118: -#line 799 "perly.y" +#line 800 "perly.y" { ENTER; SAVEIV(parser->sig_elems); @@ -996,7 +996,7 @@ case 2: break; case 119: -#line 810 "perly.y" +#line 811 "perly.y" { OP *sigops = (ps[0].val.opval); struct op_argcheck_aux *aux; @@ -1055,19 +1055,19 @@ case 2: break; case 120: -#line 867 "perly.y" +#line 868 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 121: -#line 868 "perly.y" +#line 869 "perly.y" { (yyval.opval) = NULL; } break; case 122: -#line 874 "perly.y" +#line 875 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1077,19 +1077,19 @@ case 2: break; case 123: -#line 884 "perly.y" +#line 885 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 124: -#line 885 "perly.y" +#line 886 "perly.y" { (yyval.opval) = NULL; } break; case 125: -#line 889 "perly.y" +#line 890 "perly.y" { if (parser->copline > (line_t)(ps[-2].val.ival)) parser->copline = (line_t)(ps[-2].val.ival); @@ -1100,31 +1100,31 @@ case 2: break; case 126: -#line 900 "perly.y" +#line 901 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 127: -#line 902 "perly.y" +#line 903 "perly.y" { (yyval.opval) = newLOGOP((ps[-1].val.ival), 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 128: -#line 904 "perly.y" +#line 905 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 130: -#line 910 "perly.y" +#line 911 "perly.y" { (yyval.opval) = (ps[-1].val.opval); } break; case 131: -#line 912 "perly.y" +#line 913 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1133,7 +1133,7 @@ case 2: break; case 133: -#line 921 "perly.y" +#line 922 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } @@ -1141,7 +1141,7 @@ case 2: break; case 134: -#line 925 "perly.y" +#line 926 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } @@ -1149,7 +1149,7 @@ case 2: break; case 135: -#line 929 "perly.y" +#line 930 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1159,7 +1159,7 @@ case 2: break; case 136: -#line 935 "perly.y" +#line 936 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1168,7 +1168,7 @@ case 2: break; case 137: -#line 940 "perly.y" +#line 941 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1178,7 +1178,7 @@ case 2: break; case 138: -#line 946 "perly.y" +#line 947 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1188,32 +1188,32 @@ case 2: break; case 139: -#line 952 "perly.y" +#line 953 "perly.y" { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 140: -#line 954 "perly.y" +#line 955 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 141: -#line 956 "perly.y" +#line 957 "perly.y" { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 142: -#line 958 "perly.y" +#line 959 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; case 143: -#line 961 "perly.y" +#line 962 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1222,20 +1222,20 @@ case 2: break; case 146: -#line 976 "perly.y" +#line 977 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; case 147: -#line 978 "perly.y" +#line 979 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; case 148: -#line 981 "perly.y" +#line 982 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1244,7 +1244,7 @@ case 2: break; case 149: -#line 986 "perly.y" +#line 987 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1253,14 +1253,14 @@ case 2: break; case 150: -#line 991 "perly.y" +#line 992 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; case 151: -#line 994 "perly.y" +#line 995 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1268,7 +1268,7 @@ case 2: break; case 152: -#line 998 "perly.y" +#line 999 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } @@ -1276,7 +1276,7 @@ case 2: break; case 153: -#line 1002 "perly.y" +#line 1003 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1286,7 +1286,7 @@ case 2: break; case 154: -#line 1008 "perly.y" +#line 1009 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1297,7 +1297,7 @@ case 2: break; case 155: -#line 1016 "perly.y" +#line 1017 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1308,7 +1308,7 @@ case 2: break; case 156: -#line 1023 "perly.y" +#line 1024 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1318,37 +1318,37 @@ case 2: break; case 157: -#line 1029 "perly.y" +#line 1030 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } break; case 158: -#line 1031 "perly.y" +#line 1032 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 159: -#line 1033 "perly.y" +#line 1034 "perly.y" { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 160: -#line 1038 "perly.y" +#line 1039 "perly.y" { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 161: -#line 1040 "perly.y" +#line 1041 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 162: -#line 1042 "perly.y" +#line 1043 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1357,183 +1357,183 @@ case 2: break; case 163: -#line 1047 "perly.y" +#line 1048 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 164: -#line 1049 "perly.y" +#line 1050 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 165: -#line 1051 "perly.y" +#line 1052 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 166: -#line 1053 "perly.y" +#line 1054 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 167: -#line 1055 "perly.y" +#line 1056 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 168: -#line 1057 "perly.y" +#line 1058 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: -#line 1059 "perly.y" +#line 1060 "perly.y" { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 170: -#line 1061 "perly.y" +#line 1062 "perly.y" { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: -#line 1063 "perly.y" +#line 1064 "perly.y" { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: -#line 1065 "perly.y" +#line 1066 "perly.y" { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1067 "perly.y" +#line 1068 "perly.y" { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 174: -#line 1071 "perly.y" +#line 1072 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 175: -#line 1073 "perly.y" +#line 1074 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 176: -#line 1075 "perly.y" +#line 1076 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 177: -#line 1077 "perly.y" +#line 1078 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 178: -#line 1081 "perly.y" +#line 1082 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1083 "perly.y" +#line 1084 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 180: -#line 1087 "perly.y" +#line 1088 "perly.y" { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 181: -#line 1089 "perly.y" +#line 1090 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 182: -#line 1091 "perly.y" +#line 1092 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 183: -#line 1093 "perly.y" +#line 1094 "perly.y" { yyerror("syntax error"); YYERROR; } break; case 184: -#line 1097 "perly.y" +#line 1098 "perly.y" { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1099 "perly.y" +#line 1100 "perly.y" { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 186: -#line 1104 "perly.y" +#line 1105 "perly.y" { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 187: -#line 1106 "perly.y" +#line 1107 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 188: -#line 1109 "perly.y" +#line 1110 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 189: -#line 1111 "perly.y" +#line 1112 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 190: -#line 1113 "perly.y" +#line 1114 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; case 191: -#line 1116 "perly.y" +#line 1117 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; case 192: -#line 1119 "perly.y" +#line 1120 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1548,155 +1548,155 @@ case 2: break; case 193: -#line 1130 "perly.y" +#line 1131 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; case 194: -#line 1133 "perly.y" +#line 1134 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; case 195: -#line 1140 "perly.y" +#line 1141 "perly.y" { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } break; case 196: -#line 1142 "perly.y" +#line 1143 "perly.y" { (yyval.opval) = newANONLIST(NULL);} break; case 197: -#line 1144 "perly.y" +#line 1145 "perly.y" { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 198: -#line 1146 "perly.y" +#line 1147 "perly.y" { (yyval.opval) = newANONHASH(NULL); } break; case 199: -#line 1148 "perly.y" +#line 1149 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1151 "perly.y" +#line 1152 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 201: -#line 1157 "perly.y" +#line 1158 "perly.y" { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 202: -#line 1159 "perly.y" +#line 1160 "perly.y" { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; case 207: -#line 1167 "perly.y" +#line 1168 "perly.y" { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 208: -#line 1169 "perly.y" +#line 1170 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 209: -#line 1171 "perly.y" +#line 1172 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 210: -#line 1173 "perly.y" +#line 1174 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 211: -#line 1175 "perly.y" +#line 1176 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 212: -#line 1177 "perly.y" +#line 1178 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 213: -#line 1179 "perly.y" +#line 1180 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 214: -#line 1181 "perly.y" +#line 1182 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 215: -#line 1183 "perly.y" +#line 1184 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 216: -#line 1185 "perly.y" +#line 1186 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 217: -#line 1187 "perly.y" +#line 1188 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 218: -#line 1189 "perly.y" +#line 1190 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 219: -#line 1191 "perly.y" +#line 1192 "perly.y" { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 220: -#line 1193 "perly.y" +#line 1194 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 221: -#line 1195 "perly.y" +#line 1196 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1710,7 +1710,7 @@ case 2: break; case 222: -#line 1205 "perly.y" +#line 1206 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1724,7 +1724,7 @@ case 2: break; case 223: -#line 1215 "perly.y" +#line 1216 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1738,7 +1738,7 @@ case 2: break; case 224: -#line 1225 "perly.y" +#line 1226 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1752,26 +1752,26 @@ case 2: break; case 225: -#line 1235 "perly.y" +#line 1236 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 226: -#line 1237 "perly.y" +#line 1238 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; case 227: -#line 1239 "perly.y" +#line 1240 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; case 228: -#line 1242 "perly.y" +#line 1243 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1780,7 +1780,7 @@ case 2: break; case 229: -#line 1247 "perly.y" +#line 1248 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } @@ -1788,130 +1788,130 @@ case 2: break; case 230: -#line 1251 "perly.y" +#line 1252 "perly.y" { (yyval.opval) = newSVREF((ps[-3].val.opval)); } break; case 231: -#line 1253 "perly.y" +#line 1254 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 232: -#line 1255 "perly.y" +#line 1256 "perly.y" { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 233: -#line 1257 "perly.y" +#line 1258 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 234: -#line 1260 "perly.y" +#line 1261 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 235: -#line 1262 "perly.y" +#line 1263 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); PL_hints |= HINT_BLOCK_SCOPE; } break; case 236: -#line 1265 "perly.y" +#line 1266 "perly.y" { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 237: -#line 1267 "perly.y" +#line 1268 "perly.y" { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 238: -#line 1269 "perly.y" +#line 1270 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 239: -#line 1271 "perly.y" +#line 1272 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 240: -#line 1273 "perly.y" +#line 1274 "perly.y" { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; case 241: -#line 1275 "perly.y" +#line 1276 "perly.y" { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 242: -#line 1277 "perly.y" +#line 1278 "perly.y" { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 243: -#line 1279 "perly.y" +#line 1280 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 244: -#line 1281 "perly.y" +#line 1282 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 245: -#line 1284 "perly.y" +#line 1285 "perly.y" { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 246: -#line 1286 "perly.y" +#line 1287 "perly.y" { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 247: -#line 1288 "perly.y" +#line 1289 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 248: -#line 1290 "perly.y" +#line 1291 "perly.y" { (yyval.opval) = (ps[-2].val.opval); } break; case 249: -#line 1292 "perly.y" +#line 1293 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 250: -#line 1294 "perly.y" +#line 1295 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } @@ -1919,13 +1919,13 @@ case 2: break; case 251: -#line 1298 "perly.y" +#line 1299 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; case 252: -#line 1300 "perly.y" +#line 1301 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1940,115 +1940,115 @@ case 2: break; case 253: -#line 1311 "perly.y" +#line 1312 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; case 257: -#line 1319 "perly.y" +#line 1320 "perly.y" { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } break; case 258: -#line 1321 "perly.y" +#line 1322 "perly.y" { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 259: -#line 1323 "perly.y" +#line 1324 "perly.y" { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 260: -#line 1328 "perly.y" +#line 1329 "perly.y" { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 261: -#line 1330 "perly.y" +#line 1331 "perly.y" { (yyval.opval) = sawparens(newNULLLIST()); } break; case 262: -#line 1333 "perly.y" +#line 1334 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 263: -#line 1335 "perly.y" +#line 1336 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 264: -#line 1337 "perly.y" +#line 1338 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 265: -#line 1342 "perly.y" +#line 1343 "perly.y" { (yyval.opval) = NULL; } break; case 266: -#line 1344 "perly.y" +#line 1345 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 267: -#line 1348 "perly.y" +#line 1349 "perly.y" { (yyval.opval) = NULL; } break; case 268: -#line 1350 "perly.y" +#line 1351 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 269: -#line 1354 "perly.y" +#line 1355 "perly.y" { (yyval.opval) = NULL; } break; case 270: -#line 1356 "perly.y" +#line 1357 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; case 271: -#line 1362 "perly.y" +#line 1363 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; case 279: -#line 1379 "perly.y" +#line 1380 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; case 280: -#line 1383 "perly.y" +#line 1384 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; case 281: -#line 1387 "perly.y" +#line 1388 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2056,7 +2056,7 @@ case 2: break; case 282: -#line 1393 "perly.y" +#line 1394 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } @@ -2064,61 +2064,61 @@ case 2: break; case 283: -#line 1399 "perly.y" +#line 1400 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; case 284: -#line 1401 "perly.y" +#line 1402 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 285: -#line 1405 "perly.y" +#line 1406 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; case 287: -#line 1410 "perly.y" +#line 1411 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; case 289: -#line 1415 "perly.y" +#line 1416 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; case 291: -#line 1420 "perly.y" +#line 1421 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; case 292: -#line 1425 "perly.y" +#line 1426 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 293: -#line 1427 "perly.y" +#line 1428 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; case 294: -#line 1429 "perly.y" +#line 1430 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; case 295: -#line 1432 "perly.y" +#line 1433 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2130,6 @@ case 2: /* Generated from: - * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y + * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 3d37a83a6ab5..0fec7dc7ad16 100644 --- a/perly.h +++ b/perly.h @@ -69,101 +69,102 @@ extern int yydebug; PERLY_BRACKET_OPEN = 268, PERLY_BRACKET_CLOSE = 269, PERLY_COMMA = 270, - PERLY_DOT = 271, - PERLY_EQUAL_SIGN = 272, - PERLY_MINUS = 273, - PERLY_PERCENT_SIGN = 274, - PERLY_PLUS = 275, - PERLY_SEMICOLON = 276, - PERLY_SLASH = 277, - PERLY_SNAIL = 278, - PERLY_STAR = 279, - BAREWORD = 280, - METHOD = 281, - FUNCMETH = 282, - THING = 283, - PMFUNC = 284, - PRIVATEREF = 285, - QWLIST = 286, - FUNC0OP = 287, - FUNC0SUB = 288, - UNIOPSUB = 289, - LSTOPSUB = 290, - PLUGEXPR = 291, - PLUGSTMT = 292, - LABEL = 293, - FORMAT = 294, - SUB = 295, - SIGSUB = 296, - ANONSUB = 297, - ANON_SIGSUB = 298, - PACKAGE = 299, - USE = 300, - WHILE = 301, - UNTIL = 302, - IF = 303, - UNLESS = 304, - ELSE = 305, - ELSIF = 306, - CONTINUE = 307, - FOR = 308, - GIVEN = 309, - WHEN = 310, - DEFAULT = 311, - LOOPEX = 312, - DOTDOT = 313, - YADAYADA = 314, - FUNC0 = 315, - FUNC1 = 316, - FUNC = 317, - UNIOP = 318, - LSTOP = 319, - MULOP = 320, - ADDOP = 321, - DOLSHARP = 322, - DO = 323, - HASHBRACK = 324, - NOAMP = 325, - LOCAL = 326, - MY = 327, - REQUIRE = 328, - COLONATTR = 329, - FORMLBRACK = 330, - FORMRBRACK = 331, - SUBLEXSTART = 332, - SUBLEXEND = 333, - PREC_LOW = 334, - OROP = 335, - DOROP = 336, - ANDOP = 337, - NOTOP = 338, - ASSIGNOP = 339, - PERLY_QUESTION_MARK = 340, - PERLY_COLON = 341, - OROR = 342, - DORDOR = 343, - ANDAND = 344, - BITOROP = 345, - BITANDOP = 346, - CHEQOP = 347, - NCEQOP = 348, - CHRELOP = 349, - NCRELOP = 350, - SHIFTOP = 351, - MATCHOP = 352, - PERLY_EXCLAMATION_MARK = 353, - PERLY_TILDE = 354, - UMINUS = 355, - REFGEN = 356, - POWOP = 357, - PREINC = 358, - PREDEC = 359, - POSTINC = 360, - POSTDEC = 361, - POSTJOIN = 362, - ARROW = 363, - PERLY_PAREN_CLOSE = 364, - PERLY_PAREN_OPEN = 365 + PERLY_DOLLAR = 271, + PERLY_DOT = 272, + PERLY_EQUAL_SIGN = 273, + PERLY_MINUS = 274, + PERLY_PERCENT_SIGN = 275, + PERLY_PLUS = 276, + PERLY_SEMICOLON = 277, + PERLY_SLASH = 278, + PERLY_SNAIL = 279, + PERLY_STAR = 280, + BAREWORD = 281, + METHOD = 282, + FUNCMETH = 283, + THING = 284, + PMFUNC = 285, + PRIVATEREF = 286, + QWLIST = 287, + FUNC0OP = 288, + FUNC0SUB = 289, + UNIOPSUB = 290, + LSTOPSUB = 291, + PLUGEXPR = 292, + PLUGSTMT = 293, + LABEL = 294, + FORMAT = 295, + SUB = 296, + SIGSUB = 297, + ANONSUB = 298, + ANON_SIGSUB = 299, + PACKAGE = 300, + USE = 301, + WHILE = 302, + UNTIL = 303, + IF = 304, + UNLESS = 305, + ELSE = 306, + ELSIF = 307, + CONTINUE = 308, + FOR = 309, + GIVEN = 310, + WHEN = 311, + DEFAULT = 312, + LOOPEX = 313, + DOTDOT = 314, + YADAYADA = 315, + FUNC0 = 316, + FUNC1 = 317, + FUNC = 318, + UNIOP = 319, + LSTOP = 320, + MULOP = 321, + ADDOP = 322, + DOLSHARP = 323, + DO = 324, + HASHBRACK = 325, + NOAMP = 326, + LOCAL = 327, + MY = 328, + REQUIRE = 329, + COLONATTR = 330, + FORMLBRACK = 331, + FORMRBRACK = 332, + SUBLEXSTART = 333, + SUBLEXEND = 334, + PREC_LOW = 335, + OROP = 336, + DOROP = 337, + ANDOP = 338, + NOTOP = 339, + ASSIGNOP = 340, + PERLY_QUESTION_MARK = 341, + PERLY_COLON = 342, + OROR = 343, + DORDOR = 344, + ANDAND = 345, + BITOROP = 346, + BITANDOP = 347, + CHEQOP = 348, + NCEQOP = 349, + CHRELOP = 350, + NCRELOP = 351, + SHIFTOP = 352, + MATCHOP = 353, + PERLY_EXCLAMATION_MARK = 354, + PERLY_TILDE = 355, + UMINUS = 356, + REFGEN = 357, + POWOP = 358, + PREINC = 359, + PREDEC = 360, + POSTINC = 361, + POSTDEC = 362, + POSTJOIN = 363, + ARROW = 364, + PERLY_PAREN_CLOSE = 365, + PERLY_PAREN_OPEN = 366 }; #endif @@ -215,6 +216,6 @@ int yyparse (void); /* Generated from: - * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y + * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 133b693be201..c27aaea3e052 100644 --- a/perly.tab +++ b/perly.tab @@ -6,7 +6,7 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3258 +#define YYLAST 3137 /* YYNTOKENS -- Number of terminals. */ #define YYNTOKENS 112 @@ -18,7 +18,7 @@ #define YYNSTATES 573 #define YYUNDEFTOK 2 -#define YYMAXUTOK 365 +#define YYMAXUTOK 366 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -33,7 +33,7 @@ static const yytype_int8 yytranslate[] = 0, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 2, 111, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, @@ -66,43 +66,43 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109, 110 + 105, 106, 107, 108, 109, 110, 111 }; #if YYDEBUG /* YYRLINE[YYN] -- Source line where rule number YYN was defined. */ static const yytype_int16 yyrline[] = { - 0, 136, 136, 135, 147, 146, 157, 156, 170, 169, - 183, 182, 196, 195, 206, 205, 218, 226, 234, 238, - 246, 252, 253, 263, 264, 273, 277, 281, 288, 298, - 300, 313, 310, 334, 329, 350, 358, 357, 366, 372, - 378, 383, 385, 387, 394, 402, 404, 401, 421, 426, - 433, 432, 447, 455, 461, 468, 467, 482, 486, 491, - 499, 517, 518, 522, 526, 528, 530, 532, 534, 536, - 538, 541, 547, 548, 553, 564, 565, 571, 577, 578, - 583, 586, 590, 595, 599, 603, 604, 608, 614, 619, - 624, 625, 630, 631, 636, 637, 639, 644, 646, 658, - 659, 664, 666, 670, 690, 691, 693, 699, 764, 766, - 772, 774, 778, 784, 785, 790, 791, 795, 799, 799, - 867, 868, 873, 884, 885, 888, 899, 901, 903, 905, - 909, 911, 916, 920, 924, 928, 934, 939, 945, 951, - 953, 955, 958, 957, 968, 969, 973, 977, 980, 985, - 990, 993, 997, 1001, 1007, 1015, 1022, 1028, 1030, 1032, - 1037, 1039, 1041, 1046, 1048, 1050, 1052, 1054, 1056, 1058, - 1060, 1062, 1064, 1066, 1070, 1072, 1074, 1076, 1080, 1082, - 1086, 1088, 1090, 1092, 1096, 1098, 1103, 1105, 1108, 1110, - 1112, 1115, 1118, 1129, 1132, 1139, 1141, 1143, 1145, 1147, - 1150, 1156, 1158, 1162, 1163, 1164, 1165, 1166, 1168, 1170, - 1172, 1174, 1176, 1178, 1180, 1182, 1184, 1186, 1188, 1190, - 1192, 1194, 1204, 1214, 1224, 1234, 1236, 1238, 1241, 1246, - 1250, 1252, 1254, 1256, 1259, 1261, 1264, 1266, 1268, 1270, - 1272, 1274, 1276, 1278, 1280, 1283, 1285, 1287, 1289, 1291, - 1293, 1297, 1300, 1299, 1312, 1313, 1314, 1318, 1320, 1322, - 1327, 1329, 1332, 1334, 1336, 1341, 1343, 1348, 1349, 1354, - 1355, 1361, 1365, 1366, 1367, 1370, 1371, 1374, 1375, 1378, - 1382, 1386, 1392, 1398, 1400, 1404, 1408, 1409, 1413, 1414, - 1418, 1419, 1424, 1426, 1428, 1431 + 0, 137, 137, 136, 148, 147, 158, 157, 171, 170, + 184, 183, 197, 196, 207, 206, 219, 227, 235, 239, + 247, 253, 254, 264, 265, 274, 278, 282, 289, 299, + 301, 314, 311, 335, 330, 351, 359, 358, 367, 373, + 379, 384, 386, 388, 395, 403, 405, 402, 422, 427, + 434, 433, 448, 456, 462, 469, 468, 483, 487, 492, + 500, 518, 519, 523, 527, 529, 531, 533, 535, 537, + 539, 542, 548, 549, 554, 565, 566, 572, 578, 579, + 584, 587, 591, 596, 600, 604, 605, 609, 615, 620, + 625, 626, 631, 632, 637, 638, 640, 645, 647, 659, + 660, 665, 667, 671, 691, 692, 694, 700, 765, 767, + 773, 775, 779, 785, 786, 791, 792, 796, 800, 800, + 868, 869, 874, 885, 886, 889, 900, 902, 904, 906, + 910, 912, 917, 921, 925, 929, 935, 940, 946, 952, + 954, 956, 959, 958, 969, 970, 974, 978, 981, 986, + 991, 994, 998, 1002, 1008, 1016, 1023, 1029, 1031, 1033, + 1038, 1040, 1042, 1047, 1049, 1051, 1053, 1055, 1057, 1059, + 1061, 1063, 1065, 1067, 1071, 1073, 1075, 1077, 1081, 1083, + 1087, 1089, 1091, 1093, 1097, 1099, 1104, 1106, 1109, 1111, + 1113, 1116, 1119, 1130, 1133, 1140, 1142, 1144, 1146, 1148, + 1151, 1157, 1159, 1163, 1164, 1165, 1166, 1167, 1169, 1171, + 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, 1189, 1191, + 1193, 1195, 1205, 1215, 1225, 1235, 1237, 1239, 1242, 1247, + 1251, 1253, 1255, 1257, 1260, 1262, 1265, 1267, 1269, 1271, + 1273, 1275, 1277, 1279, 1281, 1284, 1286, 1288, 1290, 1292, + 1294, 1298, 1301, 1300, 1313, 1314, 1315, 1319, 1321, 1323, + 1328, 1330, 1333, 1335, 1337, 1342, 1344, 1349, 1350, 1355, + 1356, 1362, 1366, 1367, 1368, 1371, 1372, 1375, 1376, 1379, + 1383, 1387, 1393, 1399, 1401, 1405, 1409, 1410, 1414, 1415, + 1419, 1420, 1425, 1427, 1429, 1432 }; #endif @@ -114,23 +114,23 @@ static const char *const yytname[] = "$end", "error", "$undefined", "GRAMPROG", "GRAMEXPR", "GRAMBLOCK", "GRAMBARESTMT", "GRAMFULLSTMT", "GRAMSTMTSEQ", "GRAMSUBSIGNATURE", "PERLY_AMPERSAND", "PERLY_BRACE_OPEN", "PERLY_BRACE_CLOSE", - "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", "PERLY_DOT", - "PERLY_EQUAL_SIGN", "PERLY_MINUS", "PERLY_PERCENT_SIGN", "PERLY_PLUS", - "PERLY_SEMICOLON", "PERLY_SLASH", "PERLY_SNAIL", "PERLY_STAR", - "BAREWORD", "METHOD", "FUNCMETH", "THING", "PMFUNC", "PRIVATEREF", - "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", "LSTOPSUB", "PLUGEXPR", - "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", "ANONSUB", "ANON_SIGSUB", - "PACKAGE", "USE", "WHILE", "UNTIL", "IF", "UNLESS", "ELSE", "ELSIF", - "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", "LOOPEX", "DOTDOT", - "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", - "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", - "COLONATTR", "FORMLBRACK", "FORMRBRACK", "SUBLEXSTART", "SUBLEXEND", - "PREC_LOW", "OROP", "DOROP", "ANDOP", "NOTOP", "ASSIGNOP", - "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", "ANDAND", - "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", - "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", - "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", - "ARROW", "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "'$'", "$accept", + "PERLY_BRACKET_OPEN", "PERLY_BRACKET_CLOSE", "PERLY_COMMA", + "PERLY_DOLLAR", "PERLY_DOT", "PERLY_EQUAL_SIGN", "PERLY_MINUS", + "PERLY_PERCENT_SIGN", "PERLY_PLUS", "PERLY_SEMICOLON", "PERLY_SLASH", + "PERLY_SNAIL", "PERLY_STAR", "BAREWORD", "METHOD", "FUNCMETH", "THING", + "PMFUNC", "PRIVATEREF", "QWLIST", "FUNC0OP", "FUNC0SUB", "UNIOPSUB", + "LSTOPSUB", "PLUGEXPR", "PLUGSTMT", "LABEL", "FORMAT", "SUB", "SIGSUB", + "ANONSUB", "ANON_SIGSUB", "PACKAGE", "USE", "WHILE", "UNTIL", "IF", + "UNLESS", "ELSE", "ELSIF", "CONTINUE", "FOR", "GIVEN", "WHEN", "DEFAULT", + "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", + "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", + "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", + "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", + "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", + "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", + "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", + "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", + "POSTJOIN", "ARROW", "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "$accept", "grammar", "@1", "@2", "@3", "@4", "@5", "@6", "@7", "block", "formblock", "remember", "mblock", "mremember", "stmtseq", "formstmtseq", "fullstmt", "labfullstmt", "barestmt", "$@8", "$@9", "$@10", "$@11", @@ -166,11 +166,11 @@ static const yytype_int16 yytoknum[] = 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, - 365, 36 + 365, 366 }; # endif -#define YYPACT_NINF (-486) +#define YYPACT_NINF (-497) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) @@ -184,64 +184,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 894, -486, -486, -486, -486, -486, -486, -486, 17, -486, - 2892, 15, 1393, 1298, -486, -486, -486, -486, 29, 1942, - 2892, 29, 2892, 29, 29, -486, 29, 29, -486, -486, - 39, -64, -486, 2892, -486, -486, -486, -486, 2892, -31, - -22, -45, 2037, 1847, 29, 2037, 2132, 33, 2892, 61, - 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2227, 29, 184, - 49, -486, 2, -486, 177, 19, 186, 5, -486, -486, - -486, 3060, -486, -486, 9, 81, 162, 224, -486, 94, - 236, 244, 113, -486, -486, -486, -486, -486, -486, 33, - 33, 116, -486, 36, 41, 67, 70, -3, 98, 103, - 15, 206, 182, -486, 217, 1486, 1298, -486, -486, -486, - 528, -486, 47, 633, -486, -486, -486, -486, -486, -486, - 20, 890, -486, 890, -486, -486, 2892, 151, 197, 2892, - 171, 808, 15, 281, 237, 3060, 204, 2322, 2892, 1847, - -486, 808, 1747, 49, -486, 1649, 2892, -486, -486, 808, - 303, 102, -486, -486, 2892, 808, 2987, 2417, 247, -486, - -486, -486, 808, 49, 890, 890, 890, 88, 88, 305, - 79, -486, 2892, 2892, 2892, 2892, 2892, 2892, 2512, -486, - -486, 2892, -486, -486, 2892, 2892, 2892, 2892, 2892, 2892, - 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, 2892, - 2892, 2892, -486, -486, -486, 80, 2607, 2892, 2892, 2892, - 2892, 2892, 2892, 2892, -486, 298, -486, -486, 307, -486, - -486, -486, -486, -486, 225, 0, -486, -486, 228, -486, - -486, -486, -486, 15, -486, -486, 2892, 2892, 2892, 2892, - 2892, 2892, -486, -486, -486, -486, -486, 310, 310, -486, - -486, -486, 327, -486, -486, -486, 2892, 2892, 46, -486, - -486, -486, 237, 321, -486, -486, -486, 289, 288, 264, - 2892, 49, -486, 363, -486, 2702, 890, 247, 22, 44, - 176, -486, 325, 359, -486, 2892, 375, 314, 314, -486, - 3060, 160, 54, -486, 368, 808, 416, 3150, 992, 360, - 3060, 3015, 513, 513, 618, 393, 713, 416, 416, 808, - 808, 903, 890, 890, 373, 2892, 2892, 376, 378, 379, - -486, 380, 2797, 26, 313, -486, -486, 398, 188, 130, - 296, 164, 299, 172, 312, 728, -486, 391, -486, -486, - 32, 384, 2892, 2892, 2892, 2892, -486, 300, -486, -486, - 318, -486, -486, -486, -486, 1488, 52, -486, 2892, 2892, - -486, -486, 184, -486, 184, -486, -486, -486, -486, -486, - 329, 329, 47, 308, 59, -486, 2892, -486, -486, 319, - -486, -486, -486, -486, 424, -486, 3, 434, -486, -486, - -486, 178, 2892, 407, -486, -486, 2892, -486, 340, 222, - -486, -486, -486, -486, -486, 532, -486, 2892, -486, 412, - -486, 418, -486, 423, -486, 425, -486, -486, -486, 281, - 237, -486, -486, 413, 334, 184, 335, 336, 184, 338, - 341, -486, -486, -486, -486, 343, 435, 309, -486, 2892, - 346, 351, 2892, -486, -486, -486, -486, 2892, 383, -486, - 458, -486, -486, 462, -486, -486, 11, -486, 249, -486, - 3105, 463, -486, -486, 385, -486, -486, -486, -486, 471, - 237, 472, -486, 2892, -486, -486, 486, 486, 2892, 2892, - 486, -486, 410, 399, 486, 486, 3060, 184, -486, -486, - 408, -486, -486, -486, -486, 443, 504, -486, -486, -486, - -486, 505, 486, 486, -486, 232, 232, 421, 422, 182, - 2892, 2892, 486, -486, -486, 823, -486, 918, -486, -486, - -486, -486, 1013, -486, 182, 182, -486, 486, 417, -486, - -486, 486, 486, -486, 511, 426, 182, -486, -486, 111, - -486, -486, -486, 1108, -486, 2892, 182, 182, -486, 486, - -486, 520, 465, -486, -486, 436, -486, -486, -486, 182, - -486, -486, -486, 486, 1583, -486, 1203, 232, 441, -486, - -486, 486, -486 + 1082, -497, -497, -497, -497, -497, -497, -497, 30, -497, + 2773, 23, 1394, 1298, -497, -497, -497, -497, 136, 1840, + 136, 2773, 136, 2773, 136, 136, -497, 136, 136, -497, + -497, 48, -35, -497, 2773, -497, -497, -497, -497, 2773, + -31, -12, -36, 1936, 1747, 136, 1936, 2029, 88, 2773, + 16, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2122, 241, + 86, -497, 5, -497, -52, 25, 79, 35, -497, -497, + -497, 2938, -497, -497, 6, 66, 72, 97, -497, 127, + 131, 263, 137, -497, -497, -497, -497, -497, -497, 88, + 88, 151, -497, 80, 84, 109, 116, -9, 128, 142, + 23, 220, 215, -497, 257, 1485, 1298, -497, -497, -497, + 530, -497, 155, 626, -497, -497, -497, -497, -497, -497, + 13, -497, 1078, -497, 1078, -497, -497, 2773, 171, 205, + 2773, 192, 995, 23, 274, 236, 2938, 206, 2215, 2773, + 1747, -497, 995, 1646, 86, -497, 355, 2773, -497, -497, + 995, 307, 111, -497, -497, 2773, 995, 2866, 2308, 256, + -497, -497, -497, 995, 86, 1078, 1078, 1078, 416, 416, + 319, -29, 2773, 2773, 2773, 2773, 2773, 2773, 2401, -497, + -497, 2773, -497, -497, 2773, 2773, 2773, 2773, 2773, 2773, + 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, + 2773, 2773, -497, -497, -497, 1365, 2494, 2773, 2773, 2773, + 2773, 2773, 2773, 2773, -497, 313, -497, -497, 314, -497, + -497, -497, -497, -497, 242, 164, -497, -497, 232, -497, + -497, -497, -497, 23, -497, -497, 2773, 2773, 2773, 2773, + 2773, 2773, -497, -497, -497, 322, -497, -497, 322, -497, + -497, -497, 344, -497, -497, -497, 2773, 2773, 24, -497, + -497, -497, 236, 331, -497, -497, -497, -23, 282, 255, + 2773, 86, -497, 359, -497, 2587, 1078, 256, 11, 22, + 36, -497, 325, 338, -497, 2773, 361, 292, 292, -497, + 2938, 190, 43, -497, 374, 995, 899, 3028, 1182, 288, + 2938, 2893, 515, 515, 611, 707, 803, 899, 899, 995, + 995, 1091, 1078, 1078, 357, 2773, 2773, 482, 358, 360, + 362, -497, 364, 2680, 279, -497, -497, 385, 223, 54, + 244, 78, 247, 126, 298, 722, -497, 380, -497, -497, + 26, 375, 2773, 2773, 2773, 2773, -497, 384, -497, -497, + 302, -497, -497, -497, -497, 1487, 297, -497, 2773, 2773, + -497, -497, 241, -497, 241, -497, -497, -497, -497, -497, + 330, 330, 155, 310, 51, -497, 2773, -497, -497, 312, + -497, -497, -497, -497, 396, -497, 7, 418, -497, -497, + -497, 168, 2773, 413, -497, -497, 2773, -497, 336, 173, + -497, -497, -497, -497, -497, -497, 451, 2773, -497, 414, + -497, 417, -497, 421, -497, 442, -497, -497, -497, 274, + 236, -497, -497, 402, 349, 241, 350, 363, 241, 365, + 369, -497, -497, -497, -497, 366, 447, 438, -497, 2773, + 371, 372, 2773, -497, -497, -497, -497, 2773, 411, -497, + 486, -497, -497, 499, -497, -497, 28, -497, 182, -497, + 2983, 500, -497, -497, 401, -497, -497, -497, -497, 492, + 236, 493, -497, 2773, -497, -497, 506, 506, 2773, 2773, + 506, -497, 407, 419, 506, 506, 2938, 241, -497, -497, + 425, -497, -497, -497, -497, 459, 516, -497, -497, -497, + -497, 523, 506, 506, -497, 159, 159, 437, 443, 215, + 2773, 2773, 506, -497, -497, 818, -497, 914, -497, -497, + -497, -497, 1010, -497, 215, 215, -497, 506, 472, -497, + -497, 506, 506, -497, 567, 487, 215, -497, -497, 33, + -497, -497, -497, 1106, -497, 2773, 215, 215, -497, 506, + -497, 579, 539, -497, -497, 507, -497, -497, -497, 215, + -497, -497, -497, 506, 1580, -497, 1202, 159, 509, -497, + -497, 506, -497 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -251,37 +251,37 @@ static const yytype_int16 yydefact[] = { 0, 2, 4, 6, 8, 10, 12, 14, 0, 18, 267, 0, 0, 0, 21, 118, 1, 21, 0, 0, - 0, 0, 0, 0, 0, 254, 0, 0, 225, 252, - 213, 247, 249, 243, 88, 256, 88, 88, 235, 245, - 0, 0, 238, 265, 0, 0, 0, 0, 0, 0, - 241, 0, 0, 0, 0, 0, 0, 0, 0, 268, + 0, 0, 0, 0, 0, 0, 254, 0, 0, 225, + 252, 213, 247, 249, 243, 88, 256, 88, 88, 235, + 245, 0, 0, 238, 265, 0, 0, 0, 0, 0, + 0, 241, 0, 0, 0, 0, 0, 0, 0, 268, 129, 255, 220, 203, 165, 174, 166, 180, 204, 205, 206, 132, 210, 5, 226, 215, 218, 217, 219, 216, 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, 0, 15, 113, 0, 292, 295, 294, 293, 279, 196, - 0, 186, 282, 187, 281, 285, 265, 0, 0, 0, - 0, 244, 0, 92, 94, 236, 0, 0, 267, 267, - 239, 240, 292, 266, 139, 293, 0, 283, 202, 201, - 0, 0, 90, 91, 265, 211, 0, 0, 258, 262, - 264, 263, 242, 237, 188, 189, 208, 193, 194, 214, - 0, 280, 0, 0, 0, 130, 0, 0, 0, 177, + 0, 280, 186, 282, 187, 281, 285, 265, 0, 0, + 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, + 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, + 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, + 262, 264, 263, 242, 237, 188, 189, 208, 193, 194, + 214, 0, 0, 0, 0, 130, 0, 0, 0, 177, 176, 0, 183, 182, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 190, 191, 192, 0, 0, 0, 0, 0, 0, 0, 0, 0, 21, 86, 87, 87, 0, 36, 18, 18, 18, 18, 18, 0, 18, 18, 0, 18, 18, 42, 58, 0, 54, 57, 0, 0, 0, 0, - 0, 0, 28, 27, 22, 102, 101, 99, 99, 109, + 0, 0, 28, 27, 22, 99, 102, 101, 99, 109, 108, 112, 114, 119, 195, 137, 267, 0, 0, 248, 142, 93, 94, 96, 18, 246, 250, 0, 0, 0, 0, 133, 198, 0, 229, 0, 209, 0, 215, 218, 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 0, 0, 0, 289, 287, 291, - 144, 0, 0, 0, 136, 145, 227, 0, 0, 0, + 175, 164, 173, 161, 0, 0, 0, 0, 289, 287, + 291, 144, 0, 0, 136, 145, 227, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, 0, 276, 272, 273, 274, 0, 0, 18, 0, 0, @@ -289,7 +289,7 @@ static const yytype_int16 yydefact[] = 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, 97, 0, 0, 0, 149, 155, 0, 233, 0, 0, - 232, 231, 234, 284, 153, 0, 230, 267, 228, 0, + 230, 232, 231, 234, 284, 153, 0, 267, 228, 0, 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, @@ -312,16 +312,16 @@ static const yytype_int16 yydefact[] = /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -486, -486, -486, -486, -486, -486, -486, -486, -486, 301, - -486, -5, -117, -486, -17, -486, 545, 474, 8, -486, - -486, -486, -486, -486, -486, -486, -486, -486, 409, -350, - -485, -83, -463, -486, 76, 250, -272, 30, -486, 89, - 317, -486, 293, 198, -244, 339, 374, -486, -486, 252, - -486, 253, -486, -486, -486, -486, 183, -486, -486, 132, - -486, 159, -8, -37, -486, -486, -486, -486, -486, -486, - -486, -486, -486, -486, -486, -486, 100, -486, -486, 480, - -125, -131, -486, -486, 284, -486, -486, 420, 18, -46, - -40, -486, -486, -486, -486, -486, 4 + -497, -497, -497, -497, -497, -497, -497, -497, -497, 45, + -497, -5, -139, -497, -17, -497, 603, 514, 3, -497, + -497, -497, -497, -497, -497, -497, -497, -497, 751, -341, + -496, -20, -458, -497, 115, 285, -169, 67, -497, 19, + 209, -497, 169, 214, -257, 367, 390, -497, -497, 269, + -497, 271, -497, -497, -497, -497, 197, -497, -497, 161, + -497, 208, -8, -43, -497, -497, -497, -497, -497, -497, + -497, -497, -497, -497, -497, -497, 100, -497, -497, 528, + -124, -127, -497, -497, 337, -497, -497, 467, 1, -44, + -42, -497, -497, -497, -497, -497, 216 }; /* YYDEFGOTO[NTERM-NUM]. */ @@ -331,12 +331,12 @@ static const yytype_int16 yydefgoto[] = 418, 379, 505, 526, 110, 539, 244, 108, 109, 419, 420, 341, 510, 558, 482, 500, 553, 562, 361, 104, 529, 234, 502, 434, 424, 363, 427, 436, 337, 219, - 132, 215, 154, 262, 264, 284, 370, 248, 249, 443, + 133, 215, 155, 262, 264, 284, 370, 248, 249, 443, 250, 251, 252, 253, 453, 454, 111, 112, 520, 451, 498, 380, 105, 60, 61, 376, 324, 62, 63, 64, - 65, 66, 67, 68, 69, 70, 71, 128, 72, 158, - 144, 73, 448, 430, 349, 350, 227, 74, 75, 76, - 77, 78, 79, 80, 81, 82, 171 + 65, 66, 67, 68, 69, 70, 71, 129, 72, 159, + 145, 73, 448, 430, 349, 350, 227, 74, 75, 76, + 77, 78, 79, 80, 81, 82, 121 }; /* YYTABLE[YYPACT[STATE-NUM]] -- What to do in state STATE-NUM. If @@ -344,662 +344,638 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 255, 59, 160, 17, 433, 143, 268, 269, 161, - 18, 120, 503, 176, 163, 177, 285, 16, 377, 21, - 103, 530, 118, 23, 392, 122, 83, 124, 125, 274, - 126, 127, 138, 207, 254, 208, 117, 83, 151, 117, - 83, 117, 117, 421, 117, 117, 130, 146, 147, 170, - 406, 114, 129, 422, 114, -286, 115, -286, 152, 115, - 375, 145, 117, 153, 175, 139, 245, 159, 394, 224, - 246, 21, 348, 429, 175, 23, 117, -261, 214, 136, - 21, 447, 570, 435, 23, -260, 440, 441, 137, 143, - 314, 315, 207, 316, 208, 564, -262, 184, 225, 317, - 172, 173, 174, 318, 319, -290, 320, 226, 58, 271, - 279, 58, 178, 181, 243, 228, 280, 143, -264, 206, - 121, 258, 123, 273, 213, 373, 172, 173, 174, 267, - 59, 59, 551, 131, 172, 173, 174, 58, 135, 552, - 58, 218, 141, 270, 410, 149, 220, 321, 155, 282, - 162, 221, 164, 165, 166, 167, 168, 145, 247, 172, - 173, 174, 156, 58, 287, 288, 289, 483, 291, 292, - 294, 157, 58, -286, 278, -286, 471, 222, 412, 353, - 223, 393, 172, 173, 174, 354, 414, -288, 286, -288, - 322, 323, 457, -291, -291, -291, 205, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 507, 508, 229, 409, - 172, 173, 174, 230, 433, 342, 343, 344, 345, 347, - 374, 355, 356, 325, 358, 359, 496, 232, 362, 364, - 362, 362, 362, 362, 233, -288, 462, -288, 235, 535, - 172, 173, 174, 352, 172, 173, 174, 209, 59, 210, - -263, 449, 172, 173, 174, 211, 276, 212, 172, 173, - 174, 256, 384, 492, 172, 173, 174, 387, 172, 173, - 174, 179, 180, 555, 257, 290, 464, 391, 182, 183, - 259, 295, 527, 528, 296, 297, 298, 299, 300, 301, + 113, 144, 59, 255, 17, 377, 161, 20, 162, 164, + 530, 120, 268, 269, 433, 103, 176, 503, 177, 117, + 285, 117, 207, 117, 208, 117, 117, 254, 117, 117, + 16, 274, 20, -286, 83, -286, 22, 421, 375, 152, + 24, 392, 139, 179, 180, 146, 117, -288, 422, -288, + 171, 160, 172, 173, 174, 551, 84, 394, 172, 173, + 174, 130, 552, 116, 224, 116, 175, 116, 410, 116, + 116, 570, 116, 116, 447, 140, 131, 207, 214, 208, + 137, 286, -261, -286, 144, -286, -262, 381, 141, 116, + 116, 149, 412, 225, 172, 173, 174, -264, 228, 138, + 564, 175, 226, -260, 271, 172, 173, 174, -288, 243, + -288, -263, 144, 279, 153, 280, 178, 206, 157, 154, + 181, 122, 258, 124, 172, 173, 174, 158, 184, 373, + 267, 59, 59, 273, 132, 172, 173, 174, -290, 136, + 414, 146, 209, 142, 210, 231, 150, 83, 213, 156, + 282, 163, 20, 165, 166, 167, 168, 169, 278, 172, + 173, 174, 114, 471, 287, 288, 289, 115, 291, 292, + 294, 245, 182, 183, 18, 246, 429, 218, 260, 247, + 20, 353, 457, 354, 22, 116, 435, 462, 24, 440, + 441, 220, 172, 173, 174, 221, 492, 335, 327, 328, + 329, 330, 331, 332, 333, 334, 325, 172, 173, 174, + 527, 528, 393, 496, 374, 342, 343, 344, 345, 347, + 222, 355, 356, 433, 358, 359, 352, 223, 362, 364, + 362, 362, 362, 362, 118, 338, 339, 348, 123, 229, + 125, 126, 232, 127, 128, 409, 134, 135, 59, 172, + 173, 174, 449, 230, 172, 173, 174, 276, 216, 217, + 147, 148, 384, 172, 173, 174, 411, 387, 233, 413, + 483, 172, 173, 174, 211, 290, 212, 391, 360, 235, + 464, 295, 256, 257, 296, 297, 298, 299, 300, 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 172, 173, 174, 338, 339, 398, 399, 261, - 353, 263, 84, 265, 405, 272, 354, 411, 285, 116, - 413, 283, 116, 336, 116, 116, 346, 116, 116, 172, - 173, 174, 340, 415, 425, 364, 428, 428, 357, 143, - 369, 117, 372, 140, 116, 116, 148, 437, 501, 378, - 428, 428, 439, 133, 134, 236, 237, 238, 239, 116, - 506, 461, 240, 509, 241, 431, 382, 513, 514, 172, - 173, 174, 450, 383, 352, 385, 172, 173, 174, 172, - 173, 174, 216, 217, 458, 524, 525, 390, 392, 172, - 173, 174, 172, 173, 174, 536, 174, 397, 381, 59, - 400, 231, 401, 402, 403, 172, 173, 174, 417, 423, - 544, 58, 469, 442, 546, 547, 472, 446, -83, 459, - 172, 173, 174, 407, 465, 186, 533, 479, 432, 452, - 466, 428, 559, 260, 389, 467, 143, 468, 473, 487, - 116, 541, 542, 474, 475, 476, 567, 477, 172, 173, - 174, 478, 480, 550, 572, 484, 481, 200, 186, 187, - 485, 488, 201, 556, 557, 202, 203, 204, 205, 489, - 428, 428, 515, 491, 517, 493, 565, 395, 172, 173, - 174, 186, 187, 522, 194, 195, 196, 197, 198, 199, - 200, 450, 495, 497, 494, 201, 460, 504, 202, 203, - 204, 205, 425, 428, 172, 173, 174, 408, 512, 543, - 197, 198, 199, 200, 172, 173, 174, 516, 201, 518, - 511, 202, 203, 204, 205, 519, 523, 545, -13, 85, - 531, 532, 548, 455, 360, 549, 560, 428, 18, 83, - 561, 19, 486, 456, 566, 563, 20, 21, 22, 86, - 571, 23, 24, 25, 26, 27, 28, 29, 107, 30, - 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, - 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, - 242, 97, 98, 99, 100, 38, 534, 101, 39, 40, - 41, 42, 43, 426, 568, 44, 45, 46, 47, 48, - 49, 50, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 51, 172, 173, 174, 201, 388, 470, 202, 203, - 204, 205, 371, 444, 116, 445, 52, 53, 521, 54, - 499, 55, 56, -3, 85, 490, 277, 0, 57, 58, - 438, 463, 0, 18, 83, 351, 19, 365, 366, 367, - 368, 20, 21, 22, 86, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, - 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, - 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, - 44, 45, 46, 47, 48, 49, 50, 0, 193, 194, - 195, 196, 197, 198, 199, 200, 51, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, - 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, - 416, 19, 0, 57, 58, 0, 20, 21, 22, 86, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, - 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, - 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 195, 196, 197, 198, 199, - 200, 51, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 83, 537, 19, 0, 57, 58, - 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, + 312, 313, 259, 261, 172, 173, 174, 398, 399, 507, + 508, 263, 353, 20, 354, 406, 265, 22, 117, 272, + 415, 24, 172, 173, 174, 172, 173, 174, 172, 173, + 174, 283, 285, 144, 425, 364, 428, 428, 506, 336, + 340, 509, 535, 357, 346, 513, 514, 437, 431, 501, + 428, 428, 439, 369, 186, -215, 270, 352, 461, 372, + 378, 382, 116, 524, 525, 383, 207, 390, 208, -215, + -215, 385, 450, 536, 392, 174, 555, -215, -215, 172, + 173, 174, 397, 401, 458, 402, 200, 403, 544, 404, + 407, 201, 546, 547, 202, 203, 204, 205, 417, 59, + 20, 423, -215, -215, -215, -215, 172, 173, 174, -215, + 559, -215, 469, 432, -215, 442, 472, 172, 173, 174, + 446, -215, -215, 452, 567, 459, 465, 479, 473, 466, + 144, 428, 572, 467, -215, 389, -215, -215, -215, 487, + -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, + -215, -215, -215, -215, 468, 172, 173, 174, -215, 474, + 475, -215, -215, -215, -215, -215, 172, 173, 174, 481, + 428, 428, 515, 476, 517, 477, 480, 172, 173, 174, + 478, 484, 485, 522, 395, 236, 237, 238, 239, 533, + 488, 450, 240, 83, 241, 408, 460, 489, 20, 172, + 173, 174, 425, 428, 541, 542, 455, 400, 114, 543, + 491, 494, 493, 115, 495, 497, 550, 504, 511, 172, + 173, 174, -291, -291, -291, 205, 556, 557, 456, 512, + -13, 85, 172, 173, 174, 516, 518, 428, 519, 565, + 18, 83, 486, 19, 566, 523, 20, 531, -83, 21, + 22, 23, 86, 532, 24, 25, 26, 27, 28, 29, + 30, 463, 31, 32, 33, 34, 35, 36, 87, 106, + 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, + 96, 186, 187, 545, 97, 98, 99, 100, 39, 548, + 101, 40, 41, 42, 43, 44, 560, 549, 45, 46, + 47, 48, 49, 50, 51, 192, 193, 194, 195, 196, + 197, 198, 199, 200, 52, 561, 107, 563, 201, 571, + 242, 202, 203, 204, 205, 534, -3, 85, 426, 53, + 54, 568, 55, 470, 56, 57, 18, 83, 371, 19, + 444, 58, 20, 445, 388, 21, 22, 23, 86, 490, + 24, 25, 26, 27, 28, 29, 30, 521, 31, 32, + 33, 34, 35, 36, 87, 106, 88, 89, 90, 37, + 38, 91, 92, 93, 94, 95, 96, 186, 187, 499, + 97, 98, 99, 100, 39, 277, 101, 40, 41, 42, + 43, 44, 351, 438, 45, 46, 47, 48, 49, 50, + 51, 0, 193, 194, 195, 196, 197, 198, 199, 200, + 52, 0, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 85, 0, 53, 54, 0, 55, 0, + 56, 57, 18, 83, 416, 19, 0, 58, 20, 0, + 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, + 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, + 87, 106, 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, - 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, - 44, 45, 46, 47, 48, 49, 50, 1, 2, 3, - 4, 5, 6, 7, 199, 200, 51, 0, 0, 0, + 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, + 45, 46, 47, 48, 49, 50, 51, 0, 0, 194, + 195, 196, 197, 198, 199, 200, 52, 0, 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, - 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, - 538, 19, 0, 57, 58, 0, 20, 21, 22, 86, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, - 36, 37, 91, 92, 93, 94, 95, 96, 186, 187, - 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 201, 0, 0, 202, 203, 204, 205, 0, - 200, 51, 0, 0, 0, 201, 0, 0, 202, 203, - 204, 205, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 83, 540, 19, 0, 57, 58, - 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, - 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, - 44, 45, 46, 47, 48, 49, 50, 0, 0, 200, - 0, 0, 0, 0, 201, 0, 51, 202, 203, 204, - 205, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, - 554, 19, 0, 57, 58, 0, 20, 21, 22, 86, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, - 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 83, 0, 19, 0, 57, 58, - 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 87, 106, 88, 89, 90, 36, 37, 91, 92, 93, - 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, - 44, 45, 46, 47, 48, 49, 50, 0, 0, 569, - 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 0, 52, 53, 0, 54, 0, 55, 56, 18, 83, - 0, 19, 0, 57, 58, 0, 20, 21, 22, 86, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 87, 106, 88, 89, 90, - 36, 37, 91, 92, 93, 94, 95, 96, 0, 0, - 0, 97, 98, 99, 100, 38, 0, 101, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 83, 0, 19, 0, 57, 58, - 0, 20, 21, 22, 86, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 87, 0, 88, 89, 90, 36, 37, 91, 92, 93, + 0, 53, 54, 0, 55, 0, 56, 57, 18, 83, + 537, 19, 0, 58, 20, 0, 0, 21, 22, 23, + 86, 0, 24, 25, 26, 27, 28, 29, 30, 0, + 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 186, + 187, 0, 97, 98, 99, 100, 39, 0, 101, 40, + 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 0, 195, 196, 197, 198, + 199, 200, 52, 0, 0, 0, 201, 0, 0, 202, + 203, 204, 205, 0, 0, 85, 0, 53, 54, 0, + 55, 0, 56, 57, 18, 83, 538, 19, 0, 58, + 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, + 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, + 35, 36, 87, 106, 88, 89, 90, 37, 38, 91, + 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, + 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, + 0, 0, 45, 46, 47, 48, 49, 50, 51, 365, + 366, 367, 368, 0, 197, 198, 199, 200, 52, 0, + 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, + 0, 85, 0, 53, 54, 0, 55, 0, 56, 57, + 18, 83, 540, 19, 0, 58, 20, 0, 0, 21, + 22, 23, 86, 0, 24, 25, 26, 27, 28, 29, + 30, 0, 31, 32, 33, 34, 35, 36, 87, 106, + 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, + 96, 186, 187, 0, 97, 98, 99, 100, 39, 0, + 101, 40, 41, 42, 43, 44, 0, 0, 45, 46, + 47, 48, 49, 50, 51, 1, 2, 3, 4, 5, + 6, 7, 199, 200, 52, 0, 0, 0, 201, 0, + 0, 202, 203, 204, 205, 0, 0, 85, 0, 53, + 54, 0, 55, 0, 56, 57, 18, 83, 554, 19, + 0, 58, 20, 0, 0, 21, 22, 23, 86, 0, + 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, + 33, 34, 35, 36, 87, 106, 88, 89, 90, 37, + 38, 91, 92, 93, 94, 95, 96, 186, 187, 0, + 97, 98, 99, 100, 39, 0, 101, 40, 41, 42, + 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, + 51, 201, 0, 0, 202, 203, 204, 205, 0, 200, + 52, 0, 0, 0, 201, 0, 0, 202, 203, 204, + 205, 0, 0, 85, 0, 53, 54, 0, 55, 0, + 56, 57, 18, 83, 0, 19, 0, 58, 20, 0, + 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, + 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, + 87, 106, 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 38, 0, 101, 39, 40, 41, 42, 43, 0, 0, - 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 51, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, - 0, 52, 53, 0, 54, 0, 55, 56, 18, 0, - 0, 19, 0, 57, 58, 0, 20, 21, 22, -78, - 0, 23, 24, 25, 26, 27, 28, 29, 0, 30, - 31, 32, 33, 34, 35, 0, 0, 0, 0, 0, - 36, 37, 236, 237, 238, 239, 0, 0, 0, 240, - 0, 241, 0, 0, 0, 38, 0, 0, 39, 40, - 41, 42, 43, 0, 0, 44, 45, 46, 47, 48, - 49, 50, 0, 0, 0, 0, 172, 173, 174, 0, - 0, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 85, 0, 52, 53, 0, 54, - 0, 55, 56, 18, 0, 0, 19, 0, 57, 58, - 0, 20, 21, 22, 0, 0, 23, 24, 25, 26, - 27, 28, 29, 0, 30, 31, 32, 33, 34, 35, - 0, 0, 0, 0, 0, 36, 37, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 38, 0, 0, 39, 40, 41, 42, 43, 0, -215, - 44, 45, 46, 47, 48, 49, 50, 0, 0, 0, - 207, 0, 208, -215, -215, 0, 51, 0, 0, 0, - -215, -215, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 52, 53, 0, 54, 0, 55, 56, 0, 0, - 0, 0, -78, 57, 58, -215, -215, -215, -215, 0, - 0, 0, -215, 0, -215, 0, 0, -215, 0, 0, - 0, 0, 0, 0, -215, -215, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, -215, 0, -215, - -215, -215, 0, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, -215, -215, -215, -254, 0, 0, - 0, -215, 0, 0, -215, -215, -215, -215, -215, 0, - 0, -254, -254, 0, 0, 0, 0, 0, -254, -254, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, -254, -254, -254, -254, 0, 0, 0, + 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, + 45, 46, 47, 48, 49, 50, 51, 0, 0, 569, + 200, 0, 0, 0, 0, 201, 52, 0, 202, 203, + 204, 205, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 53, 54, 0, 55, 0, 56, 57, 18, 83, + 0, 19, 0, 58, 20, 0, 0, 21, 22, 23, + 86, 0, 24, 25, 26, 27, 28, 29, 30, 0, + 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 39, 0, 101, 40, + 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 314, 315, 0, 316, 0, + 0, 317, 52, 0, 0, 318, 0, 0, 0, 319, + 320, 0, 321, 0, 0, 85, 0, 53, 54, 0, + 55, 0, 56, 57, 18, 83, 0, 19, 0, 58, + 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, + 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, + 35, 36, 87, 322, 88, 89, 90, 37, 38, 91, + 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, + 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, + 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, + 0, 0, 0, 0, 0, 0, 323, 0, 52, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, + 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, + 19, 0, 0, 20, 0, 58, 21, 22, 23, -78, + 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, + 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, + 37, 38, 236, 237, 238, 239, 0, 0, 0, 240, + 0, 241, 0, 0, 0, 39, 0, 0, 40, 41, + 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, + 50, 51, 0, 0, 0, 0, 172, 173, 174, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 85, 0, 0, 0, 0, 53, 54, 0, 55, + 18, 56, 57, 19, 0, 0, 20, 0, 58, 21, + 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, + 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, + 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, + 0, 40, 41, 42, 43, 44, -254, 0, 45, 46, + 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, + -254, -254, 0, 0, 52, 0, 0, 0, -254, -254, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, + 54, 0, 55, 0, 56, 57, 0, 0, 0, 0, + -78, 58, 0, -254, -254, -254, -254, 0, 0, 0, -254, 0, -254, 0, 0, -254, 0, 0, 0, 0, 0, 0, -254, -254, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, -254, 0, -254, -254, -254, 0, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, -254, 0, 0, 0, 0, -254, 0, 0, -254, -254, -254, -254, -254, 18, 83, 0, - 19, 0, 0, 0, 0, 20, 21, 22, 0, 0, - 23, 24, 142, 26, 27, 28, 29, 115, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 19, 0, 0, 20, 0, 0, 21, 22, 23, 0, + 0, 24, 25, 143, 27, 28, 29, 30, 115, 31, + 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, + 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, + 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, + 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, + 18, 56, 57, 19, 119, 0, 20, 0, 58, 21, + 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, + 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, + 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, + 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, + 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, + 54, 0, 55, 0, 56, 57, 18, 83, 0, 19, + 0, 58, 20, 0, 0, 21, 22, 23, 0, 0, + 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, + 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, + 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, + 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 119, 57, 58, 0, - 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 53, 54, 0, 55, 18, + 56, 57, 19, 0, 0, 20, 0, 58, 21, 22, + 23, 151, 0, 24, 25, 26, 27, 28, 29, 30, + 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, + 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, + 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, + 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, + 0, 55, 18, 56, 57, 19, 0, 0, 20, 0, + 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, + 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, + 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 83, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 0, 57, 58, 0, - 20, 21, 22, 150, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, + 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 169, 57, 58, 0, - 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 0, 53, 54, 0, 55, 18, 56, 57, 19, 0, + 0, 20, 170, 58, 21, 22, 23, 0, 0, 24, + 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, + 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 266, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 281, 57, 58, 0, - 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, + 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 293, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 326, 57, 58, 0, - 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, + 57, 19, 0, 0, 20, 266, 58, 21, 22, 23, + 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, + 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, + 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, + 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, + 55, 18, 56, 57, 19, 0, 0, 20, 281, 58, + 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, + 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, + 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, + 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, + 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 386, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 18, 0, 0, 19, 404, 57, 58, 0, - 20, 21, 22, 0, 0, 23, 24, 25, 26, 27, - 28, 29, 0, 30, 31, 32, 33, 34, 35, 0, - 0, 0, 0, 0, 36, 37, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 38, - 0, 0, 39, 40, 41, 42, 43, 0, 0, 44, - 45, 46, 47, 48, 49, 50, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 51, 0, 0, 0, 0, + 53, 54, 0, 55, 18, 56, 57, 19, 0, 0, + 20, 293, 58, 21, 22, 23, 0, 0, 24, 25, + 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, + 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 53, 0, 54, 0, 55, 56, 18, 0, 0, - 19, 0, 57, 58, 0, 20, 21, 22, 0, 0, - 23, 24, 25, 26, 27, 28, 29, 0, 30, 31, - 32, 33, 34, 35, 0, 0, 0, 0, 0, 36, - 37, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 38, 0, 0, 39, 40, 41, - 42, 43, 0, 0, 44, 45, 46, 47, 48, 49, - 50, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 51, 0, 0, 185, 0, 0, 0, 0, 0, 0, - 186, 187, 0, 0, 0, 52, 53, 0, 54, 0, - 55, 56, 0, 0, 0, 0, 0, 275, 58, 188, - 189, 396, 190, 191, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 0, 0, 201, 185, 0, - 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, + 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, + 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 188, 189, 0, 190, 191, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, - 0, 0, 201, 185, 0, 202, 203, 204, 205, 0, - 186, 187, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, + 19, 0, 0, 20, 326, 58, 21, 22, 23, 0, + 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, + 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, + 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, + 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, + 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, + 18, 56, 57, 19, 0, 0, 20, 386, 58, 21, + 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, + 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, + 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, + 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, + 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, + 54, 0, 55, 18, 56, 57, 19, 0, 0, 20, + 405, 58, 21, 22, 23, 0, 0, 24, 25, 26, + 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, + 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 189, 0, 190, 191, 192, 193, 194, 195, 196, 197, - 198, 199, 200, 0, 0, 0, 0, 201, -291, 0, - 202, 203, 204, 205, 0, 186, 187, 0, 0, 0, + 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 190, 191, 192, - 193, 194, 195, 196, 197, 198, 199, 200, 0, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205 + 0, 0, 53, 54, 0, 55, 18, 56, 57, 19, + 0, 0, 20, 0, 58, 21, 22, 23, 0, 0, + 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, + 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, + 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, + 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 52, 0, 185, 0, 0, 0, 0, 0, 0, 186, + 187, 0, 0, 0, 0, 53, 54, 0, 55, 0, + 56, 57, 0, 0, 0, 0, 0, 275, 188, 189, + 396, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, + 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 188, 189, 0, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, + 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, + 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, + 199, 200, 0, 0, 0, 0, 201, -291, 0, 202, + 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, + 0, 201, 0, 0, 202, 203, 204, 205 }; static const yytype_int16 yycheck[] = { - 17, 126, 10, 49, 9, 355, 43, 138, 139, 49, - 10, 19, 475, 11, 51, 13, 13, 0, 262, 19, - 12, 506, 18, 23, 13, 21, 11, 23, 24, 154, - 26, 27, 77, 11, 14, 13, 18, 11, 46, 21, - 11, 23, 24, 11, 26, 27, 110, 43, 44, 57, - 24, 25, 13, 21, 25, 11, 30, 13, 25, 30, - 14, 43, 44, 30, 15, 110, 19, 49, 14, 72, - 23, 19, 72, 345, 15, 23, 58, 74, 83, 110, - 19, 22, 567, 355, 23, 74, 358, 359, 110, 126, - 10, 11, 11, 13, 13, 558, 74, 92, 101, 19, - 80, 81, 82, 23, 24, 11, 26, 110, 111, 146, - 156, 111, 110, 94, 106, 97, 156, 154, 74, 110, - 20, 129, 22, 21, 11, 256, 80, 81, 82, 137, - 138, 139, 21, 33, 80, 81, 82, 111, 38, 28, - 111, 25, 42, 139, 14, 45, 110, 67, 48, 157, - 50, 110, 52, 53, 54, 55, 56, 139, 111, 80, - 81, 82, 101, 111, 172, 173, 174, 439, 176, 177, - 178, 110, 111, 11, 156, 13, 420, 110, 14, 225, - 110, 21, 80, 81, 82, 225, 14, 11, 109, 13, - 110, 111, 14, 105, 106, 107, 108, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 478, 479, 110, 21, - 80, 81, 82, 110, 564, 220, 221, 222, 223, 224, - 257, 226, 227, 205, 229, 230, 470, 21, 236, 237, - 238, 239, 240, 241, 52, 11, 14, 13, 21, 511, - 80, 81, 82, 225, 80, 81, 82, 11, 256, 13, - 74, 376, 80, 81, 82, 11, 156, 13, 80, 81, - 82, 110, 270, 14, 80, 81, 82, 275, 80, 81, - 82, 94, 95, 545, 77, 175, 407, 285, 92, 93, - 109, 181, 50, 51, 184, 185, 186, 187, 188, 189, + 17, 44, 10, 127, 9, 262, 50, 16, 50, 52, + 506, 19, 139, 140, 355, 12, 11, 475, 13, 18, + 13, 20, 11, 22, 13, 24, 25, 14, 27, 28, + 0, 155, 16, 11, 11, 13, 20, 11, 14, 47, + 24, 13, 78, 95, 96, 44, 45, 11, 22, 13, + 58, 50, 81, 82, 83, 22, 11, 14, 81, 82, + 83, 13, 29, 18, 73, 20, 15, 22, 14, 24, + 25, 567, 27, 28, 23, 111, 111, 11, 83, 13, + 111, 110, 75, 11, 127, 13, 75, 110, 43, 44, + 45, 46, 14, 102, 81, 82, 83, 75, 97, 111, + 558, 15, 111, 75, 147, 81, 82, 83, 11, 106, + 13, 75, 155, 157, 26, 157, 111, 111, 102, 31, + 95, 21, 130, 23, 81, 82, 83, 111, 93, 256, + 138, 139, 140, 22, 34, 81, 82, 83, 11, 39, + 14, 140, 11, 43, 13, 100, 46, 11, 11, 49, + 158, 51, 16, 53, 54, 55, 56, 57, 157, 81, + 82, 83, 26, 420, 172, 173, 174, 31, 176, 177, + 178, 16, 93, 94, 10, 20, 345, 26, 133, 24, + 16, 225, 14, 225, 20, 140, 355, 14, 24, 358, + 359, 111, 81, 82, 83, 111, 14, 214, 206, 207, + 208, 209, 210, 211, 212, 213, 205, 81, 82, 83, + 51, 52, 22, 470, 257, 220, 221, 222, 223, 224, + 111, 226, 227, 564, 229, 230, 225, 111, 236, 237, + 238, 239, 240, 241, 18, 216, 217, 73, 22, 111, + 24, 25, 22, 27, 28, 22, 37, 38, 256, 81, + 82, 83, 376, 111, 81, 82, 83, 157, 89, 90, + 44, 45, 270, 81, 82, 83, 22, 275, 53, 22, + 439, 81, 82, 83, 11, 175, 13, 285, 233, 22, + 407, 181, 111, 78, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 80, 81, 82, 216, 217, 315, 316, 28, - 356, 74, 11, 109, 322, 12, 356, 21, 13, 18, - 21, 74, 21, 25, 23, 24, 101, 26, 27, 80, - 81, 82, 25, 21, 342, 343, 344, 345, 110, 376, - 30, 323, 15, 42, 43, 44, 45, 355, 473, 28, - 358, 359, 357, 36, 37, 46, 47, 48, 49, 58, - 477, 21, 53, 480, 55, 347, 78, 484, 485, 80, - 81, 82, 377, 109, 356, 12, 80, 81, 82, 80, - 81, 82, 89, 90, 392, 502, 503, 28, 13, 80, - 81, 82, 80, 81, 82, 512, 82, 24, 109, 407, - 24, 100, 24, 24, 24, 80, 81, 82, 17, 25, - 527, 111, 417, 84, 531, 532, 421, 109, 109, 12, - 80, 81, 82, 110, 12, 65, 509, 432, 110, 110, - 12, 439, 549, 132, 109, 12, 473, 12, 25, 447, - 139, 524, 525, 109, 109, 109, 563, 109, 80, 81, - 82, 110, 109, 536, 571, 109, 21, 97, 65, 66, - 109, 78, 102, 546, 547, 105, 106, 107, 108, 11, - 478, 479, 489, 11, 491, 12, 559, 109, 80, 81, - 82, 65, 66, 500, 91, 92, 93, 94, 95, 96, - 97, 496, 21, 21, 109, 102, 396, 11, 105, 106, - 107, 108, 510, 511, 80, 81, 82, 109, 109, 526, - 94, 95, 96, 97, 80, 81, 82, 109, 102, 76, - 110, 105, 106, 107, 108, 21, 21, 110, 0, 1, - 109, 109, 21, 109, 233, 109, 16, 545, 10, 11, - 75, 13, 442, 109, 561, 109, 18, 19, 20, 21, - 109, 23, 24, 25, 26, 27, 28, 29, 13, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, - 106, 53, 54, 55, 56, 57, 510, 59, 60, 61, - 62, 63, 64, 343, 564, 67, 68, 69, 70, 71, - 72, 73, 89, 90, 91, 92, 93, 94, 95, 96, - 97, 83, 80, 81, 82, 102, 277, 419, 105, 106, - 107, 108, 248, 371, 323, 372, 98, 99, 496, 101, - 471, 103, 104, 0, 1, 452, 156, -1, 110, 111, - 356, 109, -1, 10, 11, 225, 13, 238, 239, 240, - 241, 18, 19, 20, 21, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, 65, 66, -1, 53, 54, 55, 56, - 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, - 67, 68, 69, 70, 71, 72, 73, -1, 90, 91, - 92, 93, 94, 95, 96, 97, 83, -1, -1, -1, - 102, -1, -1, 105, 106, 107, 108, -1, -1, 1, - -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, - 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, - -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, - -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, - 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, - 72, 73, -1, -1, -1, 92, 93, 94, 95, 96, - 97, 83, -1, -1, -1, 102, -1, -1, 105, 106, - 107, 108, -1, -1, 1, -1, 98, 99, -1, 101, - -1, 103, 104, 10, 11, 12, 13, -1, 110, 111, - -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, 65, 66, -1, 53, 54, 55, 56, - 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, - 67, 68, 69, 70, 71, 72, 73, 3, 4, 5, - 6, 7, 8, 9, 96, 97, 83, -1, -1, -1, - 102, -1, -1, 105, 106, 107, 108, -1, -1, 1, - -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, - 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, - -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, - 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, 65, 66, - -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, - 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, - 72, 73, 102, -1, -1, 105, 106, 107, 108, -1, - 97, 83, -1, -1, -1, 102, -1, -1, 105, 106, - 107, 108, -1, -1, 1, -1, 98, 99, -1, 101, - -1, 103, 104, 10, 11, 12, 13, -1, 110, 111, - -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, - 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, - 67, 68, 69, 70, 71, 72, 73, -1, -1, 97, - -1, -1, -1, -1, 102, -1, 83, 105, 106, 107, - 108, -1, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, - 12, 13, -1, 110, 111, -1, 18, 19, 20, 21, - -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 200, 201, 110, 29, 81, 82, 83, 315, 316, 478, + 479, 75, 356, 16, 356, 323, 110, 20, 317, 12, + 22, 24, 81, 82, 83, 81, 82, 83, 81, 82, + 83, 75, 13, 376, 342, 343, 344, 345, 477, 26, + 26, 480, 511, 111, 102, 484, 485, 355, 347, 473, + 358, 359, 357, 31, 66, 0, 140, 356, 22, 15, + 29, 79, 317, 502, 503, 110, 11, 29, 13, 14, + 15, 12, 377, 512, 13, 83, 545, 22, 23, 81, + 82, 83, 25, 25, 392, 25, 98, 25, 527, 25, + 111, 103, 531, 532, 106, 107, 108, 109, 18, 407, + 16, 26, 47, 48, 49, 50, 81, 82, 83, 54, + 549, 56, 417, 111, 59, 85, 421, 81, 82, 83, + 110, 66, 67, 111, 563, 12, 12, 432, 26, 12, + 473, 439, 571, 12, 79, 110, 81, 82, 83, 447, + 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, + 95, 96, 97, 98, 12, 81, 82, 83, 103, 110, + 110, 106, 107, 108, 109, 110, 81, 82, 83, 22, + 478, 479, 489, 110, 491, 110, 110, 81, 82, 83, + 111, 110, 110, 500, 110, 47, 48, 49, 50, 509, + 79, 496, 54, 11, 56, 110, 396, 11, 16, 81, + 82, 83, 510, 511, 524, 525, 110, 25, 26, 526, + 11, 110, 12, 31, 22, 22, 536, 11, 111, 81, + 82, 83, 106, 107, 108, 109, 546, 547, 110, 110, + 0, 1, 81, 82, 83, 110, 77, 545, 22, 559, + 10, 11, 442, 13, 561, 22, 16, 110, 110, 19, + 20, 21, 22, 110, 24, 25, 26, 27, 28, 29, + 30, 110, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, + 50, 66, 67, 111, 54, 55, 56, 57, 58, 22, + 60, 61, 62, 63, 64, 65, 17, 110, 68, 69, + 70, 71, 72, 73, 74, 90, 91, 92, 93, 94, + 95, 96, 97, 98, 84, 76, 13, 110, 103, 110, + 106, 106, 107, 108, 109, 510, 0, 1, 343, 99, + 100, 564, 102, 419, 104, 105, 10, 11, 248, 13, + 371, 111, 16, 372, 277, 19, 20, 21, 22, 452, + 24, 25, 26, 27, 28, 29, 30, 496, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 48, 49, 50, 66, 67, 471, + 54, 55, 56, 57, 58, 157, 60, 61, 62, 63, + 64, 65, 225, 356, 68, 69, 70, 71, 72, 73, + 74, -1, 91, 92, 93, 94, 95, 96, 97, 98, + 84, -1, -1, -1, 103, -1, -1, 106, 107, 108, + 109, -1, -1, 1, -1, 99, 100, -1, 102, -1, + 104, 105, 10, 11, 12, 13, -1, 111, 16, -1, + -1, 19, 20, 21, 22, -1, 24, 25, 26, 27, + 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, 66, 67, -1, 54, 55, 56, 57, + 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, + 68, 69, 70, 71, 72, 73, 74, -1, -1, 92, + 93, 94, 95, 96, 97, 98, 84, -1, -1, -1, + 103, -1, -1, 106, 107, 108, 109, -1, -1, 1, + -1, 99, 100, -1, 102, -1, 104, 105, 10, 11, + 12, 13, -1, 111, 16, -1, -1, 19, 20, 21, + 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, -1, -1, - -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, - 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, - 72, 73, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, - -1, 103, 104, 10, 11, -1, 13, -1, 110, 111, - -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, - 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, - 67, 68, 69, 70, 71, 72, 73, -1, -1, 76, - -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, - -1, 13, -1, 110, 111, -1, 18, 19, 20, 21, - -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, + 42, 43, 44, 45, 46, 47, 48, 49, 50, 66, + 67, -1, 54, 55, 56, 57, 58, -1, 60, 61, + 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, + 72, 73, 74, -1, -1, -1, 93, 94, 95, 96, + 97, 98, 84, -1, -1, -1, 103, -1, -1, 106, + 107, 108, 109, -1, -1, 1, -1, 99, 100, -1, + 102, -1, 104, 105, 10, 11, 12, 13, -1, 111, + 16, -1, -1, 19, 20, 21, 22, -1, 24, 25, + 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, + 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, + 46, 47, 48, 49, 50, 66, 67, -1, 54, 55, + 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, + -1, -1, 68, 69, 70, 71, 72, 73, 74, 238, + 239, 240, 241, -1, 95, 96, 97, 98, 84, -1, + -1, -1, 103, -1, -1, 106, 107, 108, 109, -1, + -1, 1, -1, 99, 100, -1, 102, -1, 104, 105, + 10, 11, 12, 13, -1, 111, 16, -1, -1, 19, + 20, 21, 22, -1, 24, 25, 26, 27, 28, 29, + 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, + 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, + 50, 66, 67, -1, 54, 55, 56, 57, 58, -1, + 60, 61, 62, 63, 64, 65, -1, -1, 68, 69, + 70, 71, 72, 73, 74, 3, 4, 5, 6, 7, + 8, 9, 97, 98, 84, -1, -1, -1, 103, -1, + -1, 106, 107, 108, 109, -1, -1, 1, -1, 99, + 100, -1, 102, -1, 104, 105, 10, 11, 12, 13, + -1, 111, 16, -1, -1, 19, 20, 21, 22, -1, + 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, + 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, + 44, 45, 46, 47, 48, 49, 50, 66, 67, -1, + 54, 55, 56, 57, 58, -1, 60, 61, 62, 63, + 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, + 74, 103, -1, -1, 106, 107, 108, 109, -1, 98, + 84, -1, -1, -1, 103, -1, -1, 106, 107, 108, + 109, -1, -1, 1, -1, 99, 100, -1, 102, -1, + 104, 105, 10, 11, -1, 13, -1, 111, 16, -1, + -1, 19, 20, 21, 22, -1, 24, 25, 26, 27, + 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, + 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, + 48, 49, 50, -1, -1, -1, 54, 55, 56, 57, + 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, + 68, 69, 70, 71, 72, 73, 74, -1, -1, 77, + 98, -1, -1, -1, -1, 103, 84, -1, 106, 107, + 108, 109, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 99, 100, -1, 102, -1, 104, 105, 10, 11, + -1, 13, -1, 111, 16, -1, -1, 19, 20, 21, + 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, - 42, 43, 44, 45, 46, 47, 48, 49, -1, -1, - -1, 53, 54, 55, 56, 57, -1, 59, 60, 61, - 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, - 72, 73, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, - -1, 103, 104, 10, 11, -1, 13, -1, 110, 111, - -1, 18, 19, 20, 21, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - 37, -1, 39, 40, 41, 42, 43, 44, 45, 46, - 47, 48, 49, -1, -1, -1, 53, 54, 55, 56, - 57, -1, 59, 60, 61, 62, 63, 64, -1, -1, - 67, 68, 69, 70, 71, 72, 73, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 98, 99, -1, 101, -1, 103, 104, 10, -1, - -1, 13, -1, 110, 111, -1, 18, 19, 20, 21, - -1, 23, 24, 25, 26, 27, 28, 29, -1, 31, - 32, 33, 34, 35, 36, -1, -1, -1, -1, -1, - 42, 43, 46, 47, 48, 49, -1, -1, -1, 53, - -1, 55, -1, -1, -1, 57, -1, -1, 60, 61, - 62, 63, 64, -1, -1, 67, 68, 69, 70, 71, - 72, 73, -1, -1, -1, -1, 80, 81, 82, -1, - -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, - -1, 103, 104, 10, -1, -1, 13, -1, 110, 111, - -1, 18, 19, 20, -1, -1, 23, 24, 25, 26, - 27, 28, 29, -1, 31, 32, 33, 34, 35, 36, - -1, -1, -1, -1, -1, 42, 43, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 57, -1, -1, 60, 61, 62, 63, 64, -1, 0, - 67, 68, 69, 70, 71, 72, 73, -1, -1, -1, - 11, -1, 13, 14, 15, -1, 83, -1, -1, -1, - 21, 22, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 98, 99, -1, 101, -1, 103, 104, -1, -1, - -1, -1, 109, 110, 111, 46, 47, 48, 49, -1, - -1, -1, 53, -1, 55, -1, -1, 58, -1, -1, - -1, -1, -1, -1, 65, 66, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 78, -1, 80, - 81, 82, -1, 84, 85, 86, 87, 88, 89, 90, - 91, 92, 93, 94, 95, 96, 97, 0, -1, -1, - -1, 102, -1, -1, 105, 106, 107, 108, 109, -1, - -1, 14, 15, -1, -1, -1, -1, -1, 21, 22, + 42, 43, 44, 45, 46, 47, 48, 49, 50, -1, + -1, -1, 54, 55, 56, 57, 58, -1, 60, 61, + 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, + 72, 73, 74, -1, -1, 10, 11, -1, 13, -1, + -1, 16, 84, -1, -1, 20, -1, -1, -1, 24, + 25, -1, 27, -1, -1, 1, -1, 99, 100, -1, + 102, -1, 104, 105, 10, 11, -1, 13, -1, 111, + 16, -1, -1, 19, 20, 21, 22, -1, 24, 25, + 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, + 36, 37, 38, 68, 40, 41, 42, 43, 44, 45, + 46, 47, 48, 49, 50, -1, -1, -1, 54, 55, + 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, + -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, + -1, -1, -1, -1, -1, -1, 111, -1, 84, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, + -1, -1, -1, 99, 100, -1, 102, 10, 104, 105, + 13, -1, -1, 16, -1, 111, 19, 20, 21, 22, + -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, + 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, + 43, 44, 47, 48, 49, 50, -1, -1, -1, 54, + -1, 56, -1, -1, -1, 58, -1, -1, 61, 62, + 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, + 73, 74, -1, -1, -1, -1, 81, 82, 83, -1, + -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 1, -1, -1, -1, -1, 99, 100, -1, 102, + 10, 104, 105, 13, -1, -1, 16, -1, 111, 19, + 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, + 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, + -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, + -1, 61, 62, 63, 64, 65, 0, -1, 68, 69, + 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, + 14, 15, -1, -1, 84, -1, -1, -1, 22, 23, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, + 100, -1, 102, -1, 104, 105, -1, -1, -1, -1, + 110, 111, -1, 47, 48, 49, 50, -1, -1, -1, + 54, -1, 56, -1, -1, 59, -1, -1, -1, -1, + -1, -1, 66, 67, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 79, -1, 81, 82, 83, + -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, + 94, 95, 96, 97, 98, -1, -1, -1, -1, 103, + -1, -1, 106, 107, 108, 109, 110, 10, 11, -1, + 13, -1, -1, 16, -1, -1, 19, 20, 21, -1, + -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, + 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, + 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, + 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, + 73, 74, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 99, 100, -1, 102, + 10, 104, 105, 13, 14, -1, 16, -1, 111, 19, + 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, + 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, + -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, + -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, + 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, + 100, -1, 102, -1, 104, 105, 10, 11, -1, 13, + -1, 111, 16, -1, -1, 19, 20, 21, -1, -1, + 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, + 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, + 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, + 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, + 74, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 99, 100, -1, 102, 10, + 104, 105, 13, -1, -1, 16, -1, 111, 19, 20, + 21, 22, -1, 24, 25, 26, 27, 28, 29, 30, + -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, + -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, + 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, + 71, 72, 73, 74, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 99, 100, + -1, 102, 10, 104, 105, 13, -1, -1, 16, -1, + 111, 19, 20, 21, -1, -1, 24, 25, 26, 27, + 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, + -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, + 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 46, 47, 48, 49, -1, -1, -1, - 53, -1, 55, -1, -1, 58, -1, -1, -1, -1, - -1, -1, 65, 66, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 78, -1, 80, 81, 82, - -1, 84, 85, 86, 87, 88, 89, 90, 91, 92, - 93, 94, 95, 96, 97, -1, -1, -1, -1, 102, - -1, -1, 105, 106, 107, 108, 109, 10, 11, -1, - 13, -1, -1, -1, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, 14, 110, 111, -1, - 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, 99, 100, -1, 102, 10, 104, 105, 13, -1, + -1, 16, 110, 111, 19, 20, 21, -1, -1, 24, + 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, + 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, 11, -1, - 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, -1, 110, 111, -1, - 18, 19, 20, 21, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, + 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, - 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, - 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, -1, -1, -1, 99, 100, -1, 102, 10, 104, + 105, 13, -1, -1, 16, 110, 111, 19, 20, 21, + -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, + 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, + -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, + 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, + 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 99, 100, -1, + 102, 10, 104, 105, 13, -1, -1, 16, 110, 111, + 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, + 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, + -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, + -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, + 69, 70, 71, 72, 73, 74, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, - 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, - 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + 99, 100, -1, 102, 10, 104, 105, 13, -1, -1, + 16, 110, 111, 19, 20, 21, -1, -1, 24, 25, + 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, + 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, - 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, - 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, + -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, - 13, 109, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, 10, -1, -1, 13, 109, 110, 111, -1, - 18, 19, 20, -1, -1, 23, 24, 25, 26, 27, - 28, 29, -1, 31, 32, 33, 34, 35, 36, -1, - -1, -1, -1, -1, 42, 43, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 57, - -1, -1, 60, 61, 62, 63, 64, -1, -1, 67, - 68, 69, 70, 71, 72, 73, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, -1, -1, 99, 100, -1, 102, 10, 104, 105, + 13, -1, -1, 16, 110, 111, 19, 20, 21, -1, + -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, + 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, + 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, + 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, + 73, 74, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 99, 100, -1, 102, + 10, 104, 105, 13, -1, -1, 16, 110, 111, 19, + 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, + 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, + -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, + -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, + 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, + 100, -1, 102, 10, 104, 105, 13, -1, -1, 16, + 110, 111, 19, 20, 21, -1, -1, 24, 25, 26, + 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, + 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 98, 99, -1, 101, -1, 103, 104, 10, -1, -1, - 13, -1, 110, 111, -1, 18, 19, 20, -1, -1, - 23, 24, 25, 26, 27, 28, 29, -1, 31, 32, - 33, 34, 35, 36, -1, -1, -1, -1, -1, 42, - 43, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 57, -1, -1, 60, 61, 62, - 63, 64, -1, -1, 67, 68, 69, 70, 71, 72, - 73, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 83, -1, -1, 58, -1, -1, -1, -1, -1, -1, - 65, 66, -1, -1, -1, 98, 99, -1, 101, -1, - 103, 104, -1, -1, -1, -1, -1, 110, 111, 84, - 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 96, 97, -1, -1, -1, -1, 102, 58, -1, - 105, 106, 107, 108, -1, 65, 66, -1, -1, -1, + -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 84, 85, -1, 87, 88, 89, - 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, - -1, -1, 102, 58, -1, 105, 106, 107, 108, -1, - 65, 66, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 99, 100, -1, 102, 10, 104, 105, 13, + -1, -1, 16, -1, 111, 19, 20, 21, -1, -1, + 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, + 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, + 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, + 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, + 74, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 84, -1, 59, -1, -1, -1, -1, -1, -1, 66, + 67, -1, -1, -1, -1, 99, 100, -1, 102, -1, + 104, 105, -1, -1, -1, -1, -1, 111, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 97, 98, -1, -1, -1, -1, 103, 59, -1, 106, + 107, 108, 109, -1, 66, 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 85, -1, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 96, 97, -1, -1, -1, -1, 102, 58, -1, - 105, 106, 107, 108, -1, 65, 66, -1, -1, -1, + -1, -1, -1, 85, 86, -1, 88, 89, 90, 91, + 92, 93, 94, 95, 96, 97, 98, -1, -1, -1, + -1, 103, 59, -1, 106, 107, 108, 109, -1, 66, + 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 86, + -1, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 97, 98, -1, -1, -1, -1, 103, 59, -1, 106, + 107, 108, 109, -1, 66, 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 87, 88, 89, - 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, - -1, -1, 102, -1, -1, 105, 106, 107, 108 + -1, -1, -1, -1, -1, -1, 88, 89, 90, 91, + 92, 93, 94, 95, 96, 97, 98, -1, -1, -1, + -1, 103, -1, -1, 106, 107, 108, 109 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing @@ -1008,62 +984,62 @@ static const yytype_uint8 yystos[] = { 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, 115, 116, 117, 118, 119, 120, 0, 123, 10, 13, - 18, 19, 20, 23, 24, 25, 26, 27, 28, 29, - 31, 32, 33, 34, 35, 36, 42, 43, 57, 60, - 61, 62, 63, 64, 67, 68, 69, 70, 71, 72, - 73, 83, 98, 99, 101, 103, 104, 110, 111, 174, + 16, 19, 20, 21, 24, 25, 26, 27, 28, 29, + 30, 32, 33, 34, 35, 36, 37, 43, 44, 58, + 61, 62, 63, 64, 65, 68, 69, 70, 71, 72, + 73, 74, 84, 99, 100, 102, 104, 105, 111, 174, 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 11, 121, 1, 21, 37, 39, 40, - 41, 44, 45, 46, 47, 48, 49, 53, 54, 55, - 56, 59, 121, 130, 141, 174, 38, 128, 129, 130, - 126, 168, 169, 126, 25, 30, 121, 200, 208, 14, - 174, 188, 208, 188, 208, 208, 208, 208, 189, 13, - 110, 188, 152, 152, 152, 188, 110, 110, 77, 110, - 121, 188, 25, 175, 192, 200, 208, 208, 121, 188, - 21, 174, 25, 30, 154, 188, 101, 110, 191, 200, - 201, 202, 188, 175, 188, 188, 188, 188, 188, 109, - 174, 208, 80, 81, 82, 15, 11, 13, 110, 94, - 95, 94, 92, 93, 92, 58, 65, 66, 84, 85, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, - 97, 102, 105, 106, 107, 108, 110, 11, 13, 11, - 13, 11, 13, 11, 123, 153, 154, 154, 25, 151, - 110, 110, 110, 110, 72, 101, 110, 198, 200, 110, - 110, 121, 21, 52, 143, 21, 46, 47, 48, 49, - 53, 55, 129, 130, 128, 19, 23, 111, 159, 160, - 162, 163, 164, 165, 14, 192, 110, 77, 174, 109, - 121, 28, 155, 74, 156, 109, 109, 174, 193, 193, - 208, 175, 12, 21, 192, 110, 188, 191, 200, 201, - 202, 109, 174, 74, 157, 13, 109, 174, 174, 174, - 188, 174, 174, 109, 174, 188, 188, 188, 188, 188, + 205, 206, 207, 11, 121, 1, 22, 38, 40, 41, + 42, 45, 46, 47, 48, 49, 50, 54, 55, 56, + 57, 60, 121, 130, 141, 174, 39, 128, 129, 130, + 126, 168, 169, 126, 26, 31, 121, 200, 208, 14, + 174, 208, 188, 208, 188, 208, 208, 208, 208, 189, + 13, 111, 188, 152, 152, 152, 188, 111, 111, 78, + 111, 121, 188, 26, 175, 192, 200, 208, 208, 121, + 188, 22, 174, 26, 31, 154, 188, 102, 111, 191, + 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, + 110, 174, 81, 82, 83, 15, 11, 13, 111, 95, + 96, 95, 93, 94, 93, 59, 66, 67, 85, 86, + 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, + 98, 103, 106, 107, 108, 109, 111, 11, 13, 11, + 13, 11, 13, 11, 123, 153, 154, 154, 26, 151, + 111, 111, 111, 111, 73, 102, 111, 198, 200, 111, + 111, 121, 22, 53, 143, 22, 47, 48, 49, 50, + 54, 56, 129, 130, 128, 16, 20, 24, 159, 160, + 162, 163, 164, 165, 14, 192, 111, 78, 174, 110, + 121, 29, 155, 75, 156, 110, 110, 174, 193, 193, + 208, 175, 12, 22, 192, 111, 188, 191, 200, 201, + 202, 110, 174, 75, 157, 13, 110, 174, 174, 174, + 188, 174, 174, 110, 174, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 13, 19, 23, 24, - 26, 67, 110, 111, 178, 200, 109, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 25, 150, 151, 151, - 25, 133, 123, 123, 123, 123, 101, 123, 72, 196, - 197, 199, 200, 201, 202, 123, 123, 110, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 30, - 158, 158, 15, 193, 175, 14, 177, 156, 28, 123, - 173, 109, 78, 109, 174, 12, 109, 174, 157, 109, - 28, 174, 13, 21, 14, 109, 86, 24, 174, 174, - 24, 24, 24, 24, 109, 174, 24, 110, 109, 21, - 14, 21, 14, 21, 14, 21, 12, 17, 122, 131, - 132, 11, 21, 25, 146, 174, 147, 148, 174, 148, - 195, 200, 110, 141, 145, 148, 149, 174, 196, 123, - 148, 148, 84, 161, 161, 163, 109, 22, 194, 192, - 123, 171, 110, 166, 167, 109, 109, 14, 174, 12, - 188, 21, 14, 109, 193, 12, 12, 12, 12, 123, - 155, 156, 123, 25, 109, 109, 109, 109, 110, 123, - 109, 21, 136, 148, 109, 109, 188, 174, 78, 11, - 168, 11, 14, 12, 109, 21, 156, 21, 172, 173, + 188, 188, 188, 188, 10, 11, 13, 16, 20, 24, + 25, 27, 68, 111, 178, 200, 110, 174, 174, 174, + 174, 174, 174, 174, 174, 126, 26, 150, 151, 151, + 26, 133, 123, 123, 123, 123, 102, 123, 73, 196, + 197, 199, 200, 201, 202, 123, 123, 111, 123, 123, + 121, 140, 174, 147, 174, 140, 140, 140, 140, 31, + 158, 158, 15, 193, 175, 14, 177, 156, 29, 123, + 173, 110, 79, 110, 174, 12, 110, 174, 157, 110, + 29, 174, 13, 22, 14, 110, 87, 25, 174, 174, + 25, 25, 25, 25, 25, 110, 174, 111, 110, 22, + 14, 22, 14, 22, 14, 22, 12, 18, 122, 131, + 132, 11, 22, 26, 146, 174, 147, 148, 174, 148, + 195, 200, 111, 141, 145, 148, 149, 174, 196, 123, + 148, 148, 85, 161, 161, 163, 110, 23, 194, 192, + 123, 171, 111, 166, 167, 110, 110, 14, 174, 12, + 188, 22, 14, 110, 193, 12, 12, 12, 12, 123, + 155, 156, 123, 26, 110, 110, 110, 110, 111, 123, + 110, 22, 136, 148, 110, 110, 188, 174, 79, 11, + 168, 11, 14, 12, 110, 22, 156, 22, 172, 173, 137, 192, 144, 144, 11, 124, 124, 148, 148, 124, - 134, 110, 109, 124, 124, 126, 109, 126, 76, 21, - 170, 171, 126, 21, 124, 124, 125, 50, 51, 142, - 142, 109, 109, 143, 146, 148, 124, 12, 12, 127, - 12, 143, 143, 126, 124, 110, 124, 124, 21, 109, - 143, 21, 28, 138, 12, 148, 143, 143, 135, 124, - 16, 75, 139, 109, 144, 143, 126, 124, 149, 76, - 142, 109, 124 + 134, 111, 110, 124, 124, 126, 110, 126, 77, 22, + 170, 171, 126, 22, 124, 124, 125, 51, 52, 142, + 142, 110, 110, 143, 146, 148, 124, 12, 12, 127, + 12, 143, 143, 126, 124, 111, 124, 124, 22, 110, + 143, 22, 29, 138, 12, 148, 143, 143, 135, 124, + 17, 76, 139, 110, 144, 143, 126, 124, 149, 77, + 142, 110, 124 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ @@ -1146,23 +1122,23 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, + toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, - toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_opval, toketype_opval, toketype_ival, toketype_opval, toketype_ival, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_opval, toketype_ival, toketype_ival, toketype_ival, toketype_ival, @@ -1182,6 +1158,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 7422f72c5dfff4e2c8cd87e56299968b4a39681f2cc3b81767c0ccd50b4e2054 perly.y + * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 2724f86bcf27..75a942e03610 100644 --- a/perly.y +++ b/perly.y @@ -51,6 +51,7 @@ %token PERLY_BRACKET_OPEN %token PERLY_BRACKET_CLOSE %token PERLY_COMMA +%token PERLY_DOLLAR %token PERLY_DOT %token PERLY_EQUAL_SIGN %token PERLY_MINUS @@ -696,7 +697,7 @@ sigdefault: /* NULL */ /* subroutine signature scalar element: e.g. '$x', '$=', '$x = $default' */ sigscalarelem: - '$' sigvarname sigdefault + PERLY_DOLLAR sigvarname sigdefault { OP *var = $sigvarname; OP *defexpr = $sigdefault; @@ -1247,7 +1248,7 @@ term[product] : termbinop { $$ = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, $optlistexpr, scalar($subname))); } - | term[operand] ARROW '$' PERLY_STAR + | term[operand] ARROW PERLY_DOLLAR PERLY_STAR { $$ = newSVREF($operand); } | term[operand] ARROW PERLY_SNAIL PERLY_STAR { $$ = newAVREF($operand); } @@ -1379,7 +1380,7 @@ amper : PERLY_AMPERSAND indirob { $$ = newCVREF($PERLY_AMPERSAND,$indirob); } ; -scalar : '$' indirob +scalar : PERLY_DOLLAR indirob { $$ = newSVREF($indirob); } ; diff --git a/toke.c b/toke.c index d6b7caeae97f..25fc46f49cc1 100644 --- a/toke.c +++ b/toke.c @@ -2054,6 +2054,7 @@ S_postderef(pTHX_ int const funny, char const next) { assert(funny == DOLSHARP || memCHRs("$@%&*", funny) + || funny == PERLY_DOLLAR || funny == PERLY_SNAIL || funny == PERLY_PERCENT_SIGN || funny == PERLY_AMPERSAND @@ -2062,7 +2063,7 @@ S_postderef(pTHX_ int const funny, char const next) if (next == '*') { PL_expect = XOPERATOR; if (PL_lex_state == LEX_INTERPNORMAL && !PL_lex_brackets) { - assert(PERLY_SNAIL == funny || '$' == funny || DOLSHARP == funny); + assert(PERLY_SNAIL == funny || PERLY_DOLLAR == funny || DOLSHARP == funny); PL_lex_state = LEX_INTERPEND; if (PERLY_SNAIL == funny) force_next(POSTJOIN); @@ -2198,7 +2199,7 @@ S_force_ident(pTHX_ const char *s, int kind) gv_fetchpvn_flags(s, len, (PL_in_eval ? GV_ADDMULTI : GV_ADD) | ( UTF ? SVf_UTF8 : 0 ), - kind == '$' ? SVt_PV : + kind == PERLY_DOLLAR ? SVt_PV : kind == PERLY_SNAIL ? SVt_PVAV : kind == PERLY_PERCENT_SIGN ? SVt_PVHV : SVt_PVGV @@ -5011,6 +5012,7 @@ yyl_sigvar(pTHX_ char *s) switch (sigil) { case ',': TOKEN (PERLY_COMMA); + case '$': TOKEN (PERLY_DOLLAR); case '@': TOKEN (PERLY_SNAIL); case '%': TOKEN (PERLY_PERCENT_SIGN); case ')': TOKEN (PERLY_PAREN_CLOSE); @@ -5028,7 +5030,7 @@ yyl_dollar(pTHX_ char *s) s++; POSTDEREF(DOLSHARP); } - POSTDEREF('$'); + POSTDEREF(PERLY_DOLLAR); } if ( s[1] == '#' @@ -5066,7 +5068,7 @@ yyl_dollar(pTHX_ char *s) if (!PL_tokenbuf[1]) { if (s == PL_bufend) yyerror("Final $ should be \\$ or $name"); - PREREF('$'); + PREREF(PERLY_DOLLAR); } { @@ -5199,7 +5201,7 @@ yyl_dollar(pTHX_ char *s) else if (*s == '.' && isDIGIT(s[1])) PL_expect = XTERM; /* e.g. print $fh .3 */ else if ((*s == '?' || *s == '-' || *s == '+') - && !isSPACE(s[1]) && s[1] != '=') + && !isSPACE(s[1]) && s[1] != '=') PL_expect = XTERM; /* e.g. print $fh -1 */ else if (*s == '/' && !isSPACE(s[1]) && s[1] != '=' && s[1] != '/') @@ -5212,7 +5214,7 @@ yyl_dollar(pTHX_ char *s) } } force_ident_maybe_lex('$'); - TOKEN('$'); + TOKEN(PERLY_DOLLAR); } static int @@ -9292,9 +9294,9 @@ Perl_yylex(pTHX) if (PL_lex_dojoin) { NEXTVAL_NEXTTOKE.ival = 0; force_next(PERLY_COMMA); - force_ident("\"", '$'); + force_ident("\"", PERLY_DOLLAR); NEXTVAL_NEXTTOKE.ival = 0; - force_next('$'); + force_next(PERLY_DOLLAR); NEXTVAL_NEXTTOKE.ival = 0; force_next((2<<24)|PERLY_PAREN_OPEN); NEXTVAL_NEXTTOKE.ival = OP_JOIN; /* emulate join($", ...) */ From 6e9e8105f2afbb3cf4a380f4e9e6db6ea28d1e1c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:21 +0100 Subject: [PATCH 346/503] Cleanup remnants of 'KEY_err' removal f23102e2d6 removed DOROP token (KEY_err) but related grammar remained --- perly.act | 468 ++++++++-------- perly.h | 61 ++- perly.tab | 1550 ++++++++++++++++++++++++++--------------------------- perly.y | 4 +- toke.c | 1 - 5 files changed, 1036 insertions(+), 1048 deletions(-) diff --git a/perly.act b/perly.act index d72d1f5fd77b..41ca498c61e1 100644 --- a/perly.act +++ b/perly.act @@ -1111,20 +1111,14 @@ case 2: break; - case 128: -#line 905 "perly.y" - { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } + case 129: +#line 909 "perly.y" + { (yyval.opval) = (ps[-1].val.opval); } break; case 130: #line 911 "perly.y" - { (yyval.opval) = (ps[-1].val.opval); } - - break; - - case 131: -#line 913 "perly.y" { OP* term = (ps[0].val.opval); (yyval.opval) = op_append_elem(OP_LIST, (ps[-2].val.opval), term); @@ -1132,24 +1126,24 @@ case 2: break; - case 133: -#line 922 "perly.y" + case 132: +#line 920 "perly.y" { (yyval.opval) = op_convert_list((ps[-2].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-2].val.ival),(ps[-1].val.opval)), (ps[0].val.opval)) ); } break; - case 134: -#line 926 "perly.y" + case 133: +#line 924 "perly.y" { (yyval.opval) = op_convert_list((ps[-4].val.ival), OPf_STACKED, op_prepend_elem(OP_LIST, newGVREF((ps[-4].val.ival),(ps[-2].val.opval)), (ps[-1].val.opval)) ); } break; - case 135: -#line 930 "perly.y" + case 134: +#line 928 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, scalar((ps[-5].val.opval)), (ps[-1].val.opval)), @@ -1158,8 +1152,8 @@ case 2: break; - case 136: -#line 936 "perly.y" + case 135: +#line 934 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, scalar((ps[-2].val.opval)), newMETHOP(OP_METHOD, 0, (ps[0].val.opval)))); @@ -1167,8 +1161,8 @@ case 2: break; - case 137: -#line 941 "perly.y" + case 136: +#line 939 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), @@ -1177,8 +1171,8 @@ case 2: break; - case 138: -#line 947 "perly.y" + case 137: +#line 945 "perly.y" { (yyval.opval) = op_convert_list(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-3].val.opval), (ps[-1].val.opval)), @@ -1187,9 +1181,15 @@ case 2: break; + case 138: +#line 951 "perly.y" + { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } + + break; + case 139: #line 953 "perly.y" - { (yyval.opval) = op_convert_list((ps[-1].val.ival), 0, (ps[0].val.opval)); } + { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; @@ -1201,19 +1201,13 @@ case 2: case 141: #line 957 "perly.y" - { (yyval.opval) = op_convert_list((ps[-3].val.ival), 0, (ps[-1].val.opval)); } - - break; - - case 142: -#line 959 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); (yyval.opval) = newANONATTRSUB((ps[-1].val.ival), 0, NULL, (ps[0].val.opval)); } break; - case 143: -#line 962 "perly.y" + case 142: +#line 960 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, op_prepend_elem(OP_LIST, (ps[-1].val.opval), (ps[0].val.opval)), (ps[-4].val.opval))); @@ -1221,21 +1215,21 @@ case 2: break; - case 146: -#line 977 "perly.y" + case 145: +#line 975 "perly.y" { (yyval.opval) = newBINOP(OP_GELEM, 0, (ps[-4].val.opval), scalar((ps[-2].val.opval))); } break; - case 147: -#line 979 "perly.y" + case 146: +#line 977 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, oopsAV((ps[-3].val.opval)), scalar((ps[-1].val.opval))); } break; - case 148: -#line 982 "perly.y" + case 147: +#line 980 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-4].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1243,8 +1237,8 @@ case 2: break; - case 149: -#line 987 "perly.y" + case 148: +#line 985 "perly.y" { (yyval.opval) = newBINOP(OP_AELEM, 0, ref(newAVREF((ps[-3].val.opval)),OP_RV2AV), scalar((ps[-1].val.opval))); @@ -1252,31 +1246,31 @@ case 2: break; - case 150: -#line 992 "perly.y" + case 149: +#line 990 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, oopsHV((ps[-4].val.opval)), jmaybe((ps[-2].val.opval))); } break; - case 151: -#line 995 "perly.y" + case 150: +#line 993 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-5].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } break; - case 152: -#line 999 "perly.y" + case 151: +#line 997 "perly.y" { (yyval.opval) = newBINOP(OP_HELEM, 0, ref(newHVREF((ps[-4].val.opval)),OP_RV2HV), jmaybe((ps[-2].val.opval))); } break; - case 153: -#line 1003 "perly.y" + case 152: +#line 1001 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-3].val.opval)))); if (parser->expect == XBLOCK) @@ -1285,8 +1279,8 @@ case 2: break; - case 154: -#line 1009 "perly.y" + case 153: +#line 1007 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-4].val.opval))))); @@ -1296,8 +1290,8 @@ case 2: break; - case 155: -#line 1017 "perly.y" + case 154: +#line 1015 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), newCVREF(0, scalar((ps[-3].val.opval))))); @@ -1307,8 +1301,8 @@ case 2: break; - case 156: -#line 1024 "perly.y" + case 155: +#line 1022 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, newCVREF(0, scalar((ps[-2].val.opval)))); if (parser->expect == XBLOCK) @@ -1317,38 +1311,38 @@ case 2: break; + case 156: +#line 1028 "perly.y" + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } + + break; + case 157: #line 1030 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-4].val.opval)); } + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } break; case 158: #line 1032 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), (ps[-3].val.opval)); } + { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } break; case 159: -#line 1034 "perly.y" - { (yyval.opval) = newSLICEOP(0, (ps[-1].val.opval), NULL); } +#line 1037 "perly.y" + { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } break; case 160: #line 1039 "perly.y" - { (yyval.opval) = newASSIGNOP(OPf_STACKED, (ps[-2].val.opval), (ps[-1].val.ival), (ps[0].val.opval)); } + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 161: #line 1041 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } - - break; - - case 162: -#line 1043 "perly.y" { if ((ps[-1].val.ival) != OP_REPEAT) scalar((ps[-2].val.opval)); (yyval.opval) = newBINOP((ps[-1].val.ival), 0, (ps[-2].val.opval), scalar((ps[0].val.opval))); @@ -1356,6 +1350,12 @@ case 2: break; + case 162: +#line 1046 "perly.y" + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + + break; + case 163: #line 1048 "perly.y" { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } @@ -1364,7 +1364,7 @@ case 2: case 164: #line 1050 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + { (yyval.opval) = (ps[0].val.opval); } break; @@ -1376,7 +1376,7 @@ case 2: case 166: #line 1054 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; @@ -1388,49 +1388,49 @@ case 2: case 168: #line 1058 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 169: #line 1060 "perly.y" - { (yyval.opval) = newRANGE((ps[-1].val.ival), scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 170: #line 1062 "perly.y" - { (yyval.opval) = newLOGOP(OP_AND, 0, (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 171: #line 1064 "perly.y" - { (yyval.opval) = newLOGOP(OP_OR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } break; case 172: #line 1066 "perly.y" - { (yyval.opval) = newLOGOP(OP_DOR, 0, (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 173: -#line 1068 "perly.y" - { (yyval.opval) = bind_match((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1070 "perly.y" + { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 174: #line 1072 "perly.y" - { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 175: #line 1074 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + { yyerror("syntax error"); YYERROR; } break; @@ -1441,32 +1441,32 @@ case 2: break; case 177: -#line 1078 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1080 "perly.y" + { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 178: #line 1082 "perly.y" - { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 179: -#line 1084 "perly.y" - { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1086 "perly.y" + { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } break; case 180: #line 1088 "perly.y" - { (yyval.opval) = cmpchain_finish((ps[0].val.opval)); } + { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } break; case 181: #line 1090 "perly.y" - { (yyval.opval) = newBINOP((ps[-1].val.ival), 0, scalar((ps[-2].val.opval)), scalar((ps[0].val.opval))); } + { yyerror("syntax error"); YYERROR; } break; @@ -1477,63 +1477,57 @@ case 2: break; case 183: -#line 1094 "perly.y" - { yyerror("syntax error"); YYERROR; } +#line 1096 "perly.y" + { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 184: #line 1098 "perly.y" - { (yyval.opval) = cmpchain_start((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 185: -#line 1100 "perly.y" - { (yyval.opval) = cmpchain_extend((ps[-1].val.ival), (ps[-2].val.opval), (ps[0].val.opval)); } +#line 1103 "perly.y" + { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } break; case 186: #line 1105 "perly.y" - { (yyval.opval) = newUNOP(OP_NEGATE, 0, scalar((ps[0].val.opval))); } + { (yyval.opval) = (ps[0].val.opval); } break; case 187: -#line 1107 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1108 "perly.y" + { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 188: #line 1110 "perly.y" - { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } + { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } break; case 189: #line 1112 "perly.y" - { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, scalar((ps[0].val.opval))); } - - break; - - case 190: -#line 1114 "perly.y" { (yyval.opval) = newUNOP(OP_POSTINC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTINC)); } break; - case 191: -#line 1117 "perly.y" + case 190: +#line 1115 "perly.y" { (yyval.opval) = newUNOP(OP_POSTDEC, 0, op_lvalue(scalar((ps[-1].val.opval)), OP_POSTDEC));} break; - case 192: -#line 1120 "perly.y" + case 191: +#line 1118 "perly.y" { (yyval.opval) = op_convert_list(OP_JOIN, 0, op_append_elem( OP_LIST, @@ -1547,115 +1541,121 @@ case 2: break; - case 193: -#line 1131 "perly.y" + case 192: +#line 1129 "perly.y" { (yyval.opval) = newUNOP(OP_PREINC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREINC)); } break; - case 194: -#line 1134 "perly.y" + case 193: +#line 1132 "perly.y" { (yyval.opval) = newUNOP(OP_PREDEC, 0, op_lvalue(scalar((ps[0].val.opval)), OP_PREDEC)); } break; + case 194: +#line 1139 "perly.y" + { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } + + break; + case 195: #line 1141 "perly.y" - { (yyval.opval) = newANONLIST((ps[-1].val.opval)); } + { (yyval.opval) = newANONLIST(NULL);} break; case 196: #line 1143 "perly.y" - { (yyval.opval) = newANONLIST(NULL);} + { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } break; case 197: #line 1145 "perly.y" - { (yyval.opval) = newANONHASH((ps[-2].val.opval)); } + { (yyval.opval) = newANONHASH(NULL); } break; case 198: #line 1147 "perly.y" - { (yyval.opval) = newANONHASH(NULL); } + { SvREFCNT_inc_simple_void(PL_compcv); + (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } break; case 199: -#line 1149 "perly.y" +#line 1150 "perly.y" { SvREFCNT_inc_simple_void(PL_compcv); - (yyval.opval) = newANONATTRSUB((ps[-3].val.ival), (ps[-2].val.opval), (ps[-1].val.opval), (ps[0].val.opval)); } + (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } break; case 200: -#line 1152 "perly.y" - { SvREFCNT_inc_simple_void(PL_compcv); - (yyval.opval) = newANONATTRSUB((ps[-2].val.ival), NULL, (ps[-1].val.opval), (ps[0].val.opval)); } +#line 1156 "perly.y" + { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} break; case 201: #line 1158 "perly.y" - { (yyval.opval) = dofile((ps[0].val.opval), (ps[-1].val.ival));} + { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} break; - case 202: -#line 1160 "perly.y" - { (yyval.opval) = newUNOP(OP_NULL, OPf_SPECIAL, op_scope((ps[0].val.opval)));} + case 206: +#line 1166 "perly.y" + { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } break; case 207: #line 1168 "perly.y" - { (yyval.opval) = newCONDOP(0, (ps[-4].val.opval), (ps[-2].val.opval), (ps[0].val.opval)); } + { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } break; case 208: #line 1170 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, (ps[0].val.opval)); } + { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } break; case 209: #line 1172 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, localize((ps[0].val.opval),1)); } + { (yyval.opval) = (ps[0].val.opval); } break; case 210: #line 1174 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { (yyval.opval) = localize((ps[0].val.opval),0); } break; case 211: #line 1176 "perly.y" - { (yyval.opval) = localize((ps[0].val.opval),0); } + { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 212: #line 1178 "perly.y" - { (yyval.opval) = sawparens((ps[-1].val.opval)); } + { (yyval.opval) = (ps[0].val.opval); } break; case 213: #line 1180 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { (yyval.opval) = sawparens(newNULLLIST()); } break; case 214: #line 1182 "perly.y" - { (yyval.opval) = sawparens(newNULLLIST()); } + { (yyval.opval) = (ps[0].val.opval); } break; @@ -1679,24 +1679,18 @@ case 2: case 218: #line 1190 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} break; case 219: #line 1192 "perly.y" - { (yyval.opval) = newUNOP(OP_AV2ARYLEN, 0, ref((ps[0].val.opval), OP_AV2ARYLEN));} + { (yyval.opval) = (ps[0].val.opval); } break; case 220: #line 1194 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } - - break; - - case 221: -#line 1196 "perly.y" { (yyval.opval) = op_prepend_elem(OP_ASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_ASLICE, 0, @@ -1709,8 +1703,8 @@ case 2: break; - case 222: -#line 1206 "perly.y" + case 221: +#line 1204 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVASLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVASLICE, 0, @@ -1723,8 +1717,8 @@ case 2: break; - case 223: -#line 1216 "perly.y" + case 222: +#line 1214 "perly.y" { (yyval.opval) = op_prepend_elem(OP_HSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_HSLICE, 0, @@ -1737,8 +1731,8 @@ case 2: break; - case 224: -#line 1226 "perly.y" + case 223: +#line 1224 "perly.y" { (yyval.opval) = op_prepend_elem(OP_KVHSLICE, newOP(OP_PUSHMARK, 0), newLISTOP(OP_KVHSLICE, 0, @@ -1751,27 +1745,27 @@ case 2: break; - case 225: -#line 1236 "perly.y" + case 224: +#line 1234 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; - case 226: -#line 1238 "perly.y" + case 225: +#line 1236 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, scalar((ps[0].val.opval))); } break; - case 227: -#line 1240 "perly.y" + case 226: +#line 1238 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[-2].val.opval))); } break; - case 228: -#line 1243 "perly.y" + case 227: +#line 1241 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[-1].val.opval), scalar((ps[-3].val.opval)))); @@ -1779,67 +1773,73 @@ case 2: break; - case 229: -#line 1248 "perly.y" + case 228: +#line 1246 "perly.y" { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; + case 229: +#line 1250 "perly.y" + { (yyval.opval) = newSVREF((ps[-3].val.opval)); } + + break; + case 230: #line 1252 "perly.y" - { (yyval.opval) = newSVREF((ps[-3].val.opval)); } + { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; case 231: #line 1254 "perly.y" - { (yyval.opval) = newAVREF((ps[-3].val.opval)); } + { (yyval.opval) = newHVREF((ps[-3].val.opval)); } break; case 232: #line 1256 "perly.y" - { (yyval.opval) = newHVREF((ps[-3].val.opval)); } + { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, + scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } break; case 233: -#line 1258 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, 0, - scalar(newCVREF((ps[-1].val.ival),(ps[-3].val.opval)))); } +#line 1259 "perly.y" + { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } break; case 234: #line 1261 "perly.y" - { (yyval.opval) = newGVREF(0,(ps[-3].val.opval)); } + { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); + PL_hints |= HINT_BLOCK_SCOPE; } break; case 235: -#line 1263 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), OPf_SPECIAL); - PL_hints |= HINT_BLOCK_SCOPE; } +#line 1264 "perly.y" + { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } break; case 236: #line 1266 "perly.y" - { (yyval.opval) = newLOOPEX((ps[-1].val.ival),(ps[0].val.opval)); } + { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } break; case 237: #line 1268 "perly.y" - { (yyval.opval) = newUNOP(OP_NOT, 0, scalar((ps[0].val.opval))); } + { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 238: #line 1270 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), 0); } + { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } break; @@ -1851,81 +1851,75 @@ case 2: case 240: #line 1274 "perly.y" - { (yyval.opval) = newUNOP((ps[-1].val.ival), 0, (ps[0].val.opval)); } + { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } break; case 241: #line 1276 "perly.y" - { (yyval.opval) = newOP(OP_REQUIRE, (ps[0].val.ival) ? OPf_SPECIAL : 0); } + { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } break; case 242: #line 1278 "perly.y" - { (yyval.opval) = newUNOP(OP_REQUIRE, (ps[-1].val.ival) ? OPf_SPECIAL : 0, (ps[0].val.opval)); } + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 243: #line 1280 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, + op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } break; case 244: -#line 1282 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, - op_append_elem(OP_LIST, (ps[0].val.opval), scalar((ps[-1].val.opval)))); } +#line 1283 "perly.y" + { (yyval.opval) = newOP((ps[0].val.ival), 0); } break; case 245: #line 1285 "perly.y" - { (yyval.opval) = newOP((ps[0].val.ival), 0); } + { (yyval.opval) = newOP((ps[-2].val.ival), 0);} break; case 246: #line 1287 "perly.y" - { (yyval.opval) = newOP((ps[-2].val.ival), 0);} + { (yyval.opval) = (ps[0].val.opval); } break; case 247: #line 1289 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } + { (yyval.opval) = (ps[-2].val.opval); } break; case 248: #line 1291 "perly.y" - { (yyval.opval) = (ps[-2].val.opval); } + { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } break; case 249: #line 1293 "perly.y" - { (yyval.opval) = newUNOP(OP_ENTERSUB, OPf_STACKED, scalar((ps[0].val.opval))); } - - break; - - case 250: -#line 1295 "perly.y" { (yyval.opval) = ((ps[-2].val.ival) == OP_NOT) ? newUNOP((ps[-2].val.ival), 0, newSVOP(OP_CONST, 0, newSViv(0))) : newOP((ps[-2].val.ival), OPf_SPECIAL); } break; - case 251: -#line 1299 "perly.y" + case 250: +#line 1297 "perly.y" { (yyval.opval) = newUNOP((ps[-3].val.ival), 0, (ps[-1].val.opval)); } break; - case 252: -#line 1301 "perly.y" + case 251: +#line 1299 "perly.y" { if ( (ps[0].val.opval)->op_type != OP_TRANS && (ps[0].val.opval)->op_type != OP_TRANSR @@ -1939,39 +1933,45 @@ case 2: break; - case 253: -#line 1312 "perly.y" + case 252: +#line 1310 "perly.y" { (yyval.opval) = pmruntime((ps[-5].val.opval), (ps[-2].val.opval), (ps[-1].val.opval), 1, (ps[-4].val.ival)); } break; + case 256: +#line 1318 "perly.y" + { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } + + break; + case 257: #line 1320 "perly.y" - { (yyval.opval) = my_attrs((ps[-1].val.opval),(ps[0].val.opval)); } + { (yyval.opval) = localize((ps[0].val.opval),1); } break; case 258: #line 1322 "perly.y" - { (yyval.opval) = localize((ps[0].val.opval),1); } + { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } break; case 259: -#line 1324 "perly.y" - { (yyval.opval) = newUNOP(OP_REFGEN, 0, my_attrs((ps[-1].val.opval),(ps[0].val.opval))); } +#line 1327 "perly.y" + { (yyval.opval) = sawparens((ps[-1].val.opval)); } break; case 260: #line 1329 "perly.y" - { (yyval.opval) = sawparens((ps[-1].val.opval)); } + { (yyval.opval) = sawparens(newNULLLIST()); } break; case 261: -#line 1331 "perly.y" - { (yyval.opval) = sawparens(newNULLLIST()); } +#line 1332 "perly.y" + { (yyval.opval) = (ps[0].val.opval); } break; @@ -1988,137 +1988,131 @@ case 2: break; case 264: -#line 1338 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1341 "perly.y" + { (yyval.opval) = NULL; } break; case 265: #line 1343 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = (ps[0].val.opval); } break; case 266: -#line 1345 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1347 "perly.y" + { (yyval.opval) = NULL; } break; case 267: #line 1349 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = (ps[0].val.opval); } break; case 268: -#line 1351 "perly.y" - { (yyval.opval) = (ps[0].val.opval); } +#line 1353 "perly.y" + { (yyval.opval) = NULL; } break; case 269: #line 1355 "perly.y" - { (yyval.opval) = NULL; } - - break; - - case 270: -#line 1357 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; - case 271: -#line 1363 "perly.y" + case 270: +#line 1361 "perly.y" { parser->in_my = 0; (yyval.opval) = my((ps[0].val.opval)); } break; - case 279: -#line 1380 "perly.y" + case 278: +#line 1378 "perly.y" { (yyval.opval) = newCVREF((ps[-1].val.ival),(ps[0].val.opval)); } break; - case 280: -#line 1384 "perly.y" + case 279: +#line 1382 "perly.y" { (yyval.opval) = newSVREF((ps[0].val.opval)); } break; - case 281: -#line 1388 "perly.y" + case 280: +#line 1386 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } break; - case 282: -#line 1394 "perly.y" + case 281: +#line 1392 "perly.y" { (yyval.opval) = newHVREF((ps[0].val.opval)); if ((yyval.opval)) (yyval.opval)->op_private |= (ps[-1].val.ival); } break; - case 283: -#line 1400 "perly.y" + case 282: +#line 1398 "perly.y" { (yyval.opval) = newAVREF((ps[0].val.opval)); } break; - case 284: -#line 1402 "perly.y" + case 283: +#line 1400 "perly.y" { (yyval.opval) = newAVREF((ps[-3].val.opval)); } break; - case 285: -#line 1406 "perly.y" + case 284: +#line 1404 "perly.y" { (yyval.opval) = newGVREF(0,(ps[0].val.opval)); } break; - case 287: -#line 1411 "perly.y" + case 286: +#line 1409 "perly.y" { (yyval.opval) = newAVREF((ps[-2].val.opval)); } break; - case 289: -#line 1416 "perly.y" + case 288: +#line 1414 "perly.y" { (yyval.opval) = newHVREF((ps[-2].val.opval)); } break; - case 291: -#line 1421 "perly.y" + case 290: +#line 1419 "perly.y" { (yyval.opval) = newGVREF(0,(ps[-2].val.opval)); } break; - case 292: -#line 1426 "perly.y" + case 291: +#line 1424 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; - case 293: -#line 1428 "perly.y" + case 292: +#line 1426 "perly.y" { (yyval.opval) = scalar((ps[0].val.opval)); } break; - case 294: -#line 1430 "perly.y" + case 293: +#line 1428 "perly.y" { (yyval.opval) = op_scope((ps[0].val.opval)); } break; - case 295: -#line 1433 "perly.y" + case 294: +#line 1431 "perly.y" { (yyval.opval) = (ps[0].val.opval); } break; @@ -2130,6 +2124,6 @@ case 2: /* Generated from: - * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y + * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 0fec7dc7ad16..550c5228f844 100644 --- a/perly.h +++ b/perly.h @@ -135,36 +135,35 @@ extern int yydebug; SUBLEXEND = 334, PREC_LOW = 335, OROP = 336, - DOROP = 337, - ANDOP = 338, - NOTOP = 339, - ASSIGNOP = 340, - PERLY_QUESTION_MARK = 341, - PERLY_COLON = 342, - OROR = 343, - DORDOR = 344, - ANDAND = 345, - BITOROP = 346, - BITANDOP = 347, - CHEQOP = 348, - NCEQOP = 349, - CHRELOP = 350, - NCRELOP = 351, - SHIFTOP = 352, - MATCHOP = 353, - PERLY_EXCLAMATION_MARK = 354, - PERLY_TILDE = 355, - UMINUS = 356, - REFGEN = 357, - POWOP = 358, - PREINC = 359, - PREDEC = 360, - POSTINC = 361, - POSTDEC = 362, - POSTJOIN = 363, - ARROW = 364, - PERLY_PAREN_CLOSE = 365, - PERLY_PAREN_OPEN = 366 + ANDOP = 337, + NOTOP = 338, + ASSIGNOP = 339, + PERLY_QUESTION_MARK = 340, + PERLY_COLON = 341, + OROR = 342, + DORDOR = 343, + ANDAND = 344, + BITOROP = 345, + BITANDOP = 346, + CHEQOP = 347, + NCEQOP = 348, + CHRELOP = 349, + NCRELOP = 350, + SHIFTOP = 351, + MATCHOP = 352, + PERLY_EXCLAMATION_MARK = 353, + PERLY_TILDE = 354, + UMINUS = 355, + REFGEN = 356, + POWOP = 357, + PREINC = 358, + PREDEC = 359, + POSTINC = 360, + POSTDEC = 361, + POSTJOIN = 362, + ARROW = 363, + PERLY_PAREN_CLOSE = 364, + PERLY_PAREN_OPEN = 365 }; #endif @@ -216,6 +215,6 @@ int yyparse (void); /* Generated from: - * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y + * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index c27aaea3e052..3c1942e55e85 100644 --- a/perly.tab +++ b/perly.tab @@ -6,19 +6,19 @@ #define YYFINAL 16 /* YYLAST -- Last index in YYTABLE. */ -#define YYLAST 3137 +#define YYLAST 3128 /* YYNTOKENS -- Number of terminals. */ -#define YYNTOKENS 112 +#define YYNTOKENS 111 /* YYNNTS -- Number of nonterminals. */ #define YYNNTS 97 /* YYNRULES -- Number of rules. */ -#define YYNRULES 295 +#define YYNRULES 294 /* YYNSTATES -- Number of states. */ -#define YYNSTATES 573 +#define YYNSTATES 571 #define YYUNDEFTOK 2 -#define YYMAXUTOK 366 +#define YYMAXUTOK 365 /* YYTRANSLATE(TOKEN-NUM) -- Symbol number corresponding to TOKEN-NUM @@ -66,7 +66,7 @@ static const yytype_int8 yytranslate[] = 75, 76, 77, 78, 79, 80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 100, 101, 102, 103, 104, - 105, 106, 107, 108, 109, 110, 111 + 105, 106, 107, 108, 109, 110 }; #if YYDEBUG @@ -85,24 +85,24 @@ static const yytype_int16 yyrline[] = 625, 626, 631, 632, 637, 638, 640, 645, 647, 659, 660, 665, 667, 671, 691, 692, 694, 700, 765, 767, 773, 775, 779, 785, 786, 791, 792, 796, 800, 800, - 868, 869, 874, 885, 886, 889, 900, 902, 904, 906, - 910, 912, 917, 921, 925, 929, 935, 940, 946, 952, - 954, 956, 959, 958, 969, 970, 974, 978, 981, 986, - 991, 994, 998, 1002, 1008, 1016, 1023, 1029, 1031, 1033, - 1038, 1040, 1042, 1047, 1049, 1051, 1053, 1055, 1057, 1059, - 1061, 1063, 1065, 1067, 1071, 1073, 1075, 1077, 1081, 1083, - 1087, 1089, 1091, 1093, 1097, 1099, 1104, 1106, 1109, 1111, - 1113, 1116, 1119, 1130, 1133, 1140, 1142, 1144, 1146, 1148, - 1151, 1157, 1159, 1163, 1164, 1165, 1166, 1167, 1169, 1171, + 868, 869, 874, 885, 886, 889, 900, 902, 904, 908, + 910, 915, 919, 923, 927, 933, 938, 944, 950, 952, + 954, 957, 956, 967, 968, 972, 976, 979, 984, 989, + 992, 996, 1000, 1006, 1014, 1021, 1027, 1029, 1031, 1036, + 1038, 1040, 1045, 1047, 1049, 1051, 1053, 1055, 1057, 1059, + 1061, 1063, 1065, 1069, 1071, 1073, 1075, 1079, 1081, 1085, + 1087, 1089, 1091, 1095, 1097, 1102, 1104, 1107, 1109, 1111, + 1114, 1117, 1128, 1131, 1138, 1140, 1142, 1144, 1146, 1149, + 1155, 1157, 1161, 1162, 1163, 1164, 1165, 1167, 1169, 1171, 1173, 1175, 1177, 1179, 1181, 1183, 1185, 1187, 1189, 1191, - 1193, 1195, 1205, 1215, 1225, 1235, 1237, 1239, 1242, 1247, - 1251, 1253, 1255, 1257, 1260, 1262, 1265, 1267, 1269, 1271, - 1273, 1275, 1277, 1279, 1281, 1284, 1286, 1288, 1290, 1292, - 1294, 1298, 1301, 1300, 1313, 1314, 1315, 1319, 1321, 1323, - 1328, 1330, 1333, 1335, 1337, 1342, 1344, 1349, 1350, 1355, - 1356, 1362, 1366, 1367, 1368, 1371, 1372, 1375, 1376, 1379, - 1383, 1387, 1393, 1399, 1401, 1405, 1409, 1410, 1414, 1415, - 1419, 1420, 1425, 1427, 1429, 1432 + 1193, 1203, 1213, 1223, 1233, 1235, 1237, 1240, 1245, 1249, + 1251, 1253, 1255, 1258, 1260, 1263, 1265, 1267, 1269, 1271, + 1273, 1275, 1277, 1279, 1282, 1284, 1286, 1288, 1290, 1292, + 1296, 1299, 1298, 1311, 1312, 1313, 1317, 1319, 1321, 1326, + 1328, 1331, 1333, 1335, 1340, 1342, 1347, 1348, 1353, 1354, + 1360, 1364, 1365, 1366, 1369, 1370, 1373, 1374, 1377, 1381, + 1385, 1391, 1397, 1399, 1403, 1407, 1408, 1412, 1413, 1417, + 1418, 1423, 1425, 1427, 1430 }; #endif @@ -125,9 +125,9 @@ static const char *const yytname[] = "LOOPEX", "DOTDOT", "YADAYADA", "FUNC0", "FUNC1", "FUNC", "UNIOP", "LSTOP", "MULOP", "ADDOP", "DOLSHARP", "DO", "HASHBRACK", "NOAMP", "LOCAL", "MY", "REQUIRE", "COLONATTR", "FORMLBRACK", "FORMRBRACK", - "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "DOROP", "ANDOP", - "NOTOP", "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", - "DORDOR", "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", + "SUBLEXSTART", "SUBLEXEND", "PREC_LOW", "OROP", "ANDOP", "NOTOP", + "ASSIGNOP", "PERLY_QUESTION_MARK", "PERLY_COLON", "OROR", "DORDOR", + "ANDAND", "BITOROP", "BITANDOP", "CHEQOP", "NCEQOP", "CHRELOP", "NCRELOP", "SHIFTOP", "MATCHOP", "PERLY_EXCLAMATION_MARK", "PERLY_TILDE", "UMINUS", "REFGEN", "POWOP", "PREINC", "PREDEC", "POSTINC", "POSTDEC", "POSTJOIN", "ARROW", "PERLY_PAREN_CLOSE", "PERLY_PAREN_OPEN", "$accept", @@ -166,16 +166,16 @@ static const yytype_int16 yytoknum[] = 335, 336, 337, 338, 339, 340, 341, 342, 343, 344, 345, 346, 347, 348, 349, 350, 351, 352, 353, 354, 355, 356, 357, 358, 359, 360, 361, 362, 363, 364, - 365, 366 + 365 }; # endif -#define YYPACT_NINF (-497) +#define YYPACT_NINF (-464) #define yypact_value_is_default(Yyn) \ ((Yyn) == YYPACT_NINF) -#define YYTABLE_NINF (-291) +#define YYTABLE_NINF (-290) #define yytable_value_is_error(Yyn) \ ((Yyn) == YYTABLE_NINF) @@ -184,64 +184,64 @@ static const yytype_int16 yytoknum[] = STATE-NUM. */ static const yytype_int16 yypact[] = { - 1082, -497, -497, -497, -497, -497, -497, -497, 30, -497, - 2773, 23, 1394, 1298, -497, -497, -497, -497, 136, 1840, - 136, 2773, 136, 2773, 136, 136, -497, 136, 136, -497, - -497, 48, -35, -497, 2773, -497, -497, -497, -497, 2773, - -31, -12, -36, 1936, 1747, 136, 1936, 2029, 88, 2773, - 16, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2122, 241, - 86, -497, 5, -497, -52, 25, 79, 35, -497, -497, - -497, 2938, -497, -497, 6, 66, 72, 97, -497, 127, - 131, 263, 137, -497, -497, -497, -497, -497, -497, 88, - 88, 151, -497, 80, 84, 109, 116, -9, 128, 142, - 23, 220, 215, -497, 257, 1485, 1298, -497, -497, -497, - 530, -497, 155, 626, -497, -497, -497, -497, -497, -497, - 13, -497, 1078, -497, 1078, -497, -497, 2773, 171, 205, - 2773, 192, 995, 23, 274, 236, 2938, 206, 2215, 2773, - 1747, -497, 995, 1646, 86, -497, 355, 2773, -497, -497, - 995, 307, 111, -497, -497, 2773, 995, 2866, 2308, 256, - -497, -497, -497, 995, 86, 1078, 1078, 1078, 416, 416, - 319, -29, 2773, 2773, 2773, 2773, 2773, 2773, 2401, -497, - -497, 2773, -497, -497, 2773, 2773, 2773, 2773, 2773, 2773, - 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, 2773, - 2773, 2773, -497, -497, -497, 1365, 2494, 2773, 2773, 2773, - 2773, 2773, 2773, 2773, -497, 313, -497, -497, 314, -497, - -497, -497, -497, -497, 242, 164, -497, -497, 232, -497, - -497, -497, -497, 23, -497, -497, 2773, 2773, 2773, 2773, - 2773, 2773, -497, -497, -497, 322, -497, -497, 322, -497, - -497, -497, 344, -497, -497, -497, 2773, 2773, 24, -497, - -497, -497, 236, 331, -497, -497, -497, -23, 282, 255, - 2773, 86, -497, 359, -497, 2587, 1078, 256, 11, 22, - 36, -497, 325, 338, -497, 2773, 361, 292, 292, -497, - 2938, 190, 43, -497, 374, 995, 899, 3028, 1182, 288, - 2938, 2893, 515, 515, 611, 707, 803, 899, 899, 995, - 995, 1091, 1078, 1078, 357, 2773, 2773, 482, 358, 360, - 362, -497, 364, 2680, 279, -497, -497, 385, 223, 54, - 244, 78, 247, 126, 298, 722, -497, 380, -497, -497, - 26, 375, 2773, 2773, 2773, 2773, -497, 384, -497, -497, - 302, -497, -497, -497, -497, 1487, 297, -497, 2773, 2773, - -497, -497, 241, -497, 241, -497, -497, -497, -497, -497, - 330, 330, 155, 310, 51, -497, 2773, -497, -497, 312, - -497, -497, -497, -497, 396, -497, 7, 418, -497, -497, - -497, 168, 2773, 413, -497, -497, 2773, -497, 336, 173, - -497, -497, -497, -497, -497, -497, 451, 2773, -497, 414, - -497, 417, -497, 421, -497, 442, -497, -497, -497, 274, - 236, -497, -497, 402, 349, 241, 350, 363, 241, 365, - 369, -497, -497, -497, -497, 366, 447, 438, -497, 2773, - 371, 372, 2773, -497, -497, -497, -497, 2773, 411, -497, - 486, -497, -497, 499, -497, -497, 28, -497, 182, -497, - 2983, 500, -497, -497, 401, -497, -497, -497, -497, 492, - 236, 493, -497, 2773, -497, -497, 506, 506, 2773, 2773, - 506, -497, 407, 419, 506, 506, 2938, 241, -497, -497, - 425, -497, -497, -497, -497, 459, 516, -497, -497, -497, - -497, 523, 506, 506, -497, 159, 159, 437, 443, 215, - 2773, 2773, 506, -497, -497, 818, -497, 914, -497, -497, - -497, -497, 1010, -497, 215, 215, -497, 506, 472, -497, - -497, 506, 506, -497, 567, 487, 215, -497, -497, 33, - -497, -497, -497, 1106, -497, 2773, 215, 215, -497, 506, - -497, 579, 539, -497, -497, 507, -497, -497, -497, 215, - -497, -497, -497, 506, 1580, -497, 1202, 159, 509, -497, - -497, 506, -497 + 470, -464, -464, -464, -464, -464, -464, -464, 7, -464, + 2748, 5, 1383, 1288, -464, -464, -464, -464, 225, 1825, + 225, 2748, 225, 2748, 225, 225, -464, 225, 225, -464, + -464, 47, -47, -464, 2748, -464, -464, -464, -464, 2748, + -36, -31, -25, 1920, 1733, 225, 1920, 2012, 211, 2748, + -2, 2748, 2748, 2748, 2748, 2748, 2748, 2748, 2104, 91, + 52, -464, 4, -464, 159, 35, 167, -6, -464, -464, + -464, 2900, -464, -464, -3, 45, 150, 180, -464, 134, + 252, 314, 168, -464, -464, -464, -464, -464, -464, 211, + 211, 112, -464, 99, 116, 169, 194, 16, 197, 201, + 5, 246, 276, -464, 322, 1034, 1288, -464, -464, -464, + 528, -464, 20, 623, -464, -464, -464, -464, -464, -464, + 13, -464, 786, -464, 786, -464, -464, 2748, 250, 278, + 2748, 289, 703, 5, 348, 312, 2900, 290, 2196, 2748, + 1733, -464, 703, 357, 52, -464, 1633, 2748, -464, -464, + 703, 388, 66, -464, -464, 2748, 703, 2840, 2288, 327, + -464, -464, -464, 703, 52, 786, 786, 786, 268, 268, + 390, 43, 2748, 2748, 2748, 2748, 2748, 2380, -464, -464, + 2748, -464, -464, 2748, 2748, 2748, 2748, 2748, 2748, 2748, + 2748, 2748, 2748, 2748, 2748, 2748, 2748, 2748, 2748, 2748, + 2748, -464, -464, -464, 165, 2472, 2748, 2748, 2748, 2748, + 2748, 2748, 2748, -464, 382, -464, -464, 383, -464, -464, + -464, -464, -464, 311, 228, -464, -464, 305, -464, -464, + -464, -464, 5, -464, -464, 2748, 2748, 2748, 2748, 2748, + 2748, -464, -464, -464, 395, -464, -464, 395, -464, -464, + -464, 419, -464, -464, -464, 2748, 2748, 19, -464, -464, + -464, 312, 406, -464, -464, -464, 78, 361, 347, 2748, + 52, -464, 443, -464, 2564, 786, 327, 36, 58, 131, + -464, 153, 431, -464, 2748, 448, 385, -464, 2900, 164, + 24, -464, 158, 703, 391, 2988, 288, 893, 2900, 425, + 3020, 3020, 513, 608, 325, 391, 391, 703, 703, 798, + 786, 786, 446, 2748, 2748, 787, 455, 457, 458, -464, + 465, 2656, 392, -464, -464, 221, 200, 28, 227, 38, + 233, 54, 236, 718, -464, 477, -464, -464, 32, 478, + 2748, 2748, 2748, 2748, -464, 487, -464, -464, 396, -464, + -464, -464, -464, 1475, 345, -464, 2748, 2748, -464, -464, + 91, -464, 91, -464, -464, -464, -464, -464, 421, 421, + 20, 399, 151, -464, 2748, -464, -464, 413, -464, -464, + -464, -464, 255, -464, 21, 259, -464, -464, -464, 102, + 2748, 512, -464, -464, 2748, -464, 242, 113, -464, -464, + -464, -464, -464, -464, 277, 2748, -464, 514, -464, 522, + -464, 524, -464, 525, -464, -464, -464, 348, 312, -464, + -464, 499, 434, 91, 436, 437, 91, 442, 449, -464, + -464, -464, -464, 472, 565, 272, -464, 2748, 485, 486, + 2748, -464, -464, -464, -464, 2748, 533, -464, 602, -464, + -464, 603, -464, -464, 22, -464, 126, -464, 2944, 604, + -464, -464, 508, -464, -464, -464, -464, 600, 312, 606, + -464, 2748, -464, -464, 614, 614, 2748, 2748, 614, -464, + 520, 526, 614, 614, 2900, 91, -464, -464, 531, -464, + -464, -464, -464, 560, 619, -464, -464, -464, -464, 624, + 614, 614, -464, 287, 287, 545, 567, 276, 2748, 2748, + 614, -464, -464, 813, -464, 908, -464, -464, -464, -464, + 1003, -464, 276, 276, -464, 614, 572, -464, -464, 614, + 614, -464, 667, 581, 276, -464, -464, 8, -464, -464, + -464, 1098, -464, 2748, 276, 276, -464, 614, -464, 681, + 631, -464, -464, 599, -464, -464, -464, 276, -464, -464, + -464, 614, 1567, -464, 1193, 287, 609, -464, -464, 614, + -464 }; /* YYDEFACT[STATE-NUM] -- Default reduction number in state STATE-NUM. @@ -250,92 +250,92 @@ static const yytype_int16 yypact[] = static const yytype_int16 yydefact[] = { 0, 2, 4, 6, 8, 10, 12, 14, 0, 18, - 267, 0, 0, 0, 21, 118, 1, 21, 0, 0, - 0, 0, 0, 0, 0, 0, 254, 0, 0, 225, - 252, 213, 247, 249, 243, 88, 256, 88, 88, 235, - 245, 0, 0, 238, 265, 0, 0, 0, 0, 0, - 0, 241, 0, 0, 0, 0, 0, 0, 0, 268, - 129, 255, 220, 203, 165, 174, 166, 180, 204, 205, - 206, 132, 210, 5, 226, 215, 218, 217, 219, 216, + 266, 0, 0, 0, 21, 118, 1, 21, 0, 0, + 0, 0, 0, 0, 0, 0, 253, 0, 0, 224, + 251, 212, 246, 248, 242, 88, 255, 88, 88, 234, + 244, 0, 0, 237, 264, 0, 0, 0, 0, 0, + 0, 240, 0, 0, 0, 0, 0, 0, 0, 267, + 128, 254, 219, 202, 164, 173, 165, 179, 203, 204, + 205, 131, 209, 5, 225, 214, 217, 216, 218, 215, 0, 0, 0, 18, 7, 64, 59, 29, 89, 0, 0, 0, 87, 0, 0, 0, 0, 0, 0, 0, 0, 0, 75, 9, 0, 65, 0, 11, 26, 25, - 0, 15, 113, 0, 292, 295, 294, 293, 279, 196, - 0, 280, 186, 282, 187, 281, 285, 265, 0, 0, - 0, 0, 244, 0, 92, 94, 236, 0, 0, 267, - 267, 239, 240, 292, 266, 139, 293, 0, 283, 202, - 201, 0, 0, 90, 91, 265, 211, 0, 0, 258, - 262, 264, 263, 242, 237, 188, 189, 208, 193, 194, - 214, 0, 0, 0, 0, 130, 0, 0, 0, 177, - 176, 0, 183, 182, 0, 0, 0, 0, 0, 0, + 0, 15, 113, 0, 291, 294, 293, 292, 278, 195, + 0, 279, 185, 281, 186, 280, 284, 264, 0, 0, + 0, 0, 243, 0, 92, 94, 235, 0, 0, 266, + 266, 238, 239, 291, 265, 138, 292, 0, 282, 201, + 200, 0, 0, 90, 91, 264, 210, 0, 0, 257, + 261, 263, 262, 241, 236, 187, 188, 207, 192, 193, + 213, 0, 0, 0, 129, 0, 0, 0, 176, 175, + 0, 182, 181, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 190, 191, 192, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 21, 86, 87, 87, 0, 36, - 18, 18, 18, 18, 18, 0, 18, 18, 0, 18, - 18, 42, 58, 0, 54, 57, 0, 0, 0, 0, - 0, 0, 28, 27, 22, 99, 102, 101, 99, 109, - 108, 112, 114, 119, 195, 137, 267, 0, 0, 248, - 142, 93, 94, 96, 18, 246, 250, 0, 0, 0, - 0, 133, 198, 0, 229, 0, 209, 0, 215, 218, - 217, 261, 0, 98, 257, 0, 212, 127, 128, 126, - 131, 0, 0, 156, 0, 179, 185, 169, 162, 163, - 160, 0, 171, 172, 170, 168, 167, 184, 181, 178, - 175, 164, 173, 161, 0, 0, 0, 0, 289, 287, - 291, 144, 0, 0, 136, 145, 227, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 85, 0, 31, 33, - 0, 0, 80, 0, 0, 0, 277, 0, 278, 275, - 0, 276, 272, 273, 274, 0, 0, 18, 0, 0, - 76, 68, 63, 69, 82, 66, 67, 70, 71, 100, - 104, 104, 110, 0, 269, 158, 265, 18, 95, 115, - 200, 251, 141, 140, 0, 197, 214, 0, 259, 260, - 97, 0, 0, 0, 149, 155, 0, 233, 0, 0, - 230, 232, 231, 234, 284, 153, 0, 267, 228, 0, - 147, 0, 221, 0, 222, 0, 16, 18, 30, 92, - 94, 18, 35, 0, 0, 81, 0, 0, 83, 0, - 0, 271, 18, 79, 84, 0, 0, 65, 50, 0, - 0, 0, 105, 107, 103, 111, 138, 0, 0, 143, - 0, 199, 118, 0, 116, 134, 212, 159, 0, 152, - 207, 0, 148, 154, 0, 150, 223, 224, 146, 0, - 94, 18, 55, 265, 77, 77, 0, 0, 0, 0, - 0, 45, 0, 0, 0, 0, 106, 270, 253, 21, - 0, 21, 157, 151, 135, 0, 18, 124, 34, 123, - 21, 0, 0, 0, 20, 72, 72, 0, 0, 75, - 80, 0, 0, 40, 41, 0, 117, 0, 23, 121, - 32, 120, 0, 37, 75, 75, 21, 0, 0, 38, - 39, 0, 0, 53, 0, 0, 75, 122, 125, 0, - 56, 43, 44, 0, 73, 0, 75, 75, 46, 0, - 49, 0, 61, 24, 19, 0, 48, 52, 77, 75, - 17, 21, 60, 0, 0, 51, 0, 72, 0, 62, - 74, 0, 47 + 0, 189, 190, 191, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 21, 86, 87, 87, 0, 36, 18, + 18, 18, 18, 18, 0, 18, 18, 0, 18, 18, + 42, 58, 0, 54, 57, 0, 0, 0, 0, 0, + 0, 28, 27, 22, 99, 102, 101, 99, 109, 108, + 112, 114, 119, 194, 136, 266, 0, 0, 247, 141, + 93, 94, 96, 18, 245, 249, 0, 0, 0, 0, + 132, 197, 0, 228, 0, 208, 0, 214, 217, 216, + 260, 0, 98, 256, 0, 211, 127, 126, 130, 0, + 0, 155, 0, 178, 184, 168, 161, 162, 159, 0, + 170, 171, 169, 167, 166, 183, 180, 177, 174, 163, + 172, 160, 0, 0, 0, 0, 288, 286, 290, 143, + 0, 0, 135, 144, 226, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 31, 33, 0, 0, + 80, 0, 0, 0, 276, 0, 277, 274, 0, 275, + 271, 272, 273, 0, 0, 18, 0, 0, 76, 68, + 63, 69, 82, 66, 67, 70, 71, 100, 104, 104, + 110, 0, 268, 157, 264, 18, 95, 115, 199, 250, + 140, 139, 0, 196, 213, 0, 258, 259, 97, 0, + 0, 0, 148, 154, 0, 232, 0, 0, 229, 231, + 230, 233, 283, 152, 0, 266, 227, 0, 146, 0, + 220, 0, 221, 0, 16, 18, 30, 92, 94, 18, + 35, 0, 0, 81, 0, 0, 83, 0, 0, 270, + 18, 79, 84, 0, 0, 65, 50, 0, 0, 0, + 105, 107, 103, 111, 137, 0, 0, 142, 0, 198, + 118, 0, 116, 133, 211, 158, 0, 151, 206, 0, + 147, 153, 0, 149, 222, 223, 145, 0, 94, 18, + 55, 264, 77, 77, 0, 0, 0, 0, 0, 45, + 0, 0, 0, 0, 106, 269, 252, 21, 0, 21, + 156, 150, 134, 0, 18, 124, 34, 123, 21, 0, + 0, 0, 20, 72, 72, 0, 0, 75, 80, 0, + 0, 40, 41, 0, 117, 0, 23, 121, 32, 120, + 0, 37, 75, 75, 21, 0, 0, 38, 39, 0, + 0, 53, 0, 0, 75, 122, 125, 0, 56, 43, + 44, 0, 73, 0, 75, 75, 46, 0, 49, 0, + 61, 24, 19, 0, 48, 52, 77, 75, 17, 21, + 60, 0, 0, 51, 0, 72, 0, 62, 74, 0, + 47 }; /* YYPGOTO[NTERM-NUM]. */ static const yytype_int16 yypgoto[] = { - -497, -497, -497, -497, -497, -497, -497, -497, -497, 45, - -497, -5, -139, -497, -17, -497, 603, 514, 3, -497, - -497, -497, -497, -497, -497, -497, -497, -497, 751, -341, - -496, -20, -458, -497, 115, 285, -169, 67, -497, 19, - 209, -497, 169, 214, -257, 367, 390, -497, -497, 269, - -497, 271, -497, -497, -497, -497, 197, -497, -497, 161, - -497, 208, -8, -43, -497, -497, -497, -497, -497, -497, - -497, -497, -497, -497, -497, -497, 100, -497, -497, 528, - -124, -127, -497, -497, 337, -497, -497, 467, 1, -44, - -42, -497, -497, -497, -497, -497, 216 + -464, -464, -464, -464, -464, -464, -464, -464, -464, 37, + -464, -5, 2417, -464, -17, -464, 696, 605, 12, -464, + -464, -464, -464, -464, -464, -464, -464, -464, 33, -343, + -463, -156, -453, -464, 204, 376, -266, 161, -464, 127, + 346, -464, 273, 303, -256, 456, 488, -464, -464, 356, + -464, 366, -464, -464, -464, -464, 291, -464, -464, 283, + -464, 280, -8, -43, -464, -464, -464, -464, -464, -464, + -464, -464, -464, -464, -464, -464, 100, -464, -464, 627, + -124, -127, -464, -464, 417, -464, -464, 561, 1, -44, + -42, -464, -464, -464, -464, -464, 48 }; /* YYDEFGOTO[NTERM-NUM]. */ static const yytype_int16 yydefgoto[] = { -1, 8, 9, 10, 11, 12, 13, 14, 15, 102, - 418, 379, 505, 526, 110, 539, 244, 108, 109, 419, - 420, 341, 510, 558, 482, 500, 553, 562, 361, 104, - 529, 234, 502, 434, 424, 363, 427, 436, 337, 219, - 133, 215, 155, 262, 264, 284, 370, 248, 249, 443, - 250, 251, 252, 253, 453, 454, 111, 112, 520, 451, - 498, 380, 105, 60, 61, 376, 324, 62, 63, 64, + 416, 377, 503, 524, 110, 537, 243, 108, 109, 417, + 418, 339, 508, 556, 480, 498, 551, 560, 359, 104, + 527, 233, 500, 432, 422, 361, 425, 434, 335, 218, + 133, 214, 155, 261, 263, 283, 368, 247, 248, 441, + 249, 250, 251, 252, 451, 452, 111, 112, 518, 449, + 496, 378, 105, 60, 61, 374, 322, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 129, 72, 159, - 145, 73, 448, 430, 349, 350, 227, 74, 75, 76, + 145, 73, 446, 428, 347, 348, 226, 74, 75, 76, 77, 78, 79, 80, 81, 82, 121 }; @@ -344,136 +344,135 @@ static const yytype_int16 yydefgoto[] = number is the opposite. If YYTABLE_NINF, syntax error. */ static const yytype_int16 yytable[] = { - 113, 144, 59, 255, 17, 377, 161, 20, 162, 164, - 530, 120, 268, 269, 433, 103, 176, 503, 177, 117, - 285, 117, 207, 117, 208, 117, 117, 254, 117, 117, - 16, 274, 20, -286, 83, -286, 22, 421, 375, 152, - 24, 392, 139, 179, 180, 146, 117, -288, 422, -288, - 171, 160, 172, 173, 174, 551, 84, 394, 172, 173, - 174, 130, 552, 116, 224, 116, 175, 116, 410, 116, - 116, 570, 116, 116, 447, 140, 131, 207, 214, 208, - 137, 286, -261, -286, 144, -286, -262, 381, 141, 116, - 116, 149, 412, 225, 172, 173, 174, -264, 228, 138, - 564, 175, 226, -260, 271, 172, 173, 174, -288, 243, - -288, -263, 144, 279, 153, 280, 178, 206, 157, 154, - 181, 122, 258, 124, 172, 173, 174, 158, 184, 373, - 267, 59, 59, 273, 132, 172, 173, 174, -290, 136, - 414, 146, 209, 142, 210, 231, 150, 83, 213, 156, - 282, 163, 20, 165, 166, 167, 168, 169, 278, 172, - 173, 174, 114, 471, 287, 288, 289, 115, 291, 292, - 294, 245, 182, 183, 18, 246, 429, 218, 260, 247, - 20, 353, 457, 354, 22, 116, 435, 462, 24, 440, - 441, 220, 172, 173, 174, 221, 492, 335, 327, 328, - 329, 330, 331, 332, 333, 334, 325, 172, 173, 174, - 527, 528, 393, 496, 374, 342, 343, 344, 345, 347, - 222, 355, 356, 433, 358, 359, 352, 223, 362, 364, - 362, 362, 362, 362, 118, 338, 339, 348, 123, 229, - 125, 126, 232, 127, 128, 409, 134, 135, 59, 172, - 173, 174, 449, 230, 172, 173, 174, 276, 216, 217, - 147, 148, 384, 172, 173, 174, 411, 387, 233, 413, - 483, 172, 173, 174, 211, 290, 212, 391, 360, 235, - 464, 295, 256, 257, 296, 297, 298, 299, 300, 301, - 302, 303, 304, 305, 306, 307, 308, 309, 310, 311, - 312, 313, 259, 261, 172, 173, 174, 398, 399, 507, - 508, 263, 353, 20, 354, 406, 265, 22, 117, 272, - 415, 24, 172, 173, 174, 172, 173, 174, 172, 173, - 174, 283, 285, 144, 425, 364, 428, 428, 506, 336, - 340, 509, 535, 357, 346, 513, 514, 437, 431, 501, - 428, 428, 439, 369, 186, -215, 270, 352, 461, 372, - 378, 382, 116, 524, 525, 383, 207, 390, 208, -215, - -215, 385, 450, 536, 392, 174, 555, -215, -215, 172, - 173, 174, 397, 401, 458, 402, 200, 403, 544, 404, - 407, 201, 546, 547, 202, 203, 204, 205, 417, 59, - 20, 423, -215, -215, -215, -215, 172, 173, 174, -215, - 559, -215, 469, 432, -215, 442, 472, 172, 173, 174, - 446, -215, -215, 452, 567, 459, 465, 479, 473, 466, - 144, 428, 572, 467, -215, 389, -215, -215, -215, 487, - -215, -215, -215, -215, -215, -215, -215, -215, -215, -215, - -215, -215, -215, -215, 468, 172, 173, 174, -215, 474, - 475, -215, -215, -215, -215, -215, 172, 173, 174, 481, - 428, 428, 515, 476, 517, 477, 480, 172, 173, 174, - 478, 484, 485, 522, 395, 236, 237, 238, 239, 533, - 488, 450, 240, 83, 241, 408, 460, 489, 20, 172, - 173, 174, 425, 428, 541, 542, 455, 400, 114, 543, - 491, 494, 493, 115, 495, 497, 550, 504, 511, 172, - 173, 174, -291, -291, -291, 205, 556, 557, 456, 512, - -13, 85, 172, 173, 174, 516, 518, 428, 519, 565, - 18, 83, 486, 19, 566, 523, 20, 531, -83, 21, - 22, 23, 86, 532, 24, 25, 26, 27, 28, 29, - 30, 463, 31, 32, 33, 34, 35, 36, 87, 106, - 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, - 96, 186, 187, 545, 97, 98, 99, 100, 39, 548, - 101, 40, 41, 42, 43, 44, 560, 549, 45, 46, - 47, 48, 49, 50, 51, 192, 193, 194, 195, 196, - 197, 198, 199, 200, 52, 561, 107, 563, 201, 571, - 242, 202, 203, 204, 205, 534, -3, 85, 426, 53, - 54, 568, 55, 470, 56, 57, 18, 83, 371, 19, - 444, 58, 20, 445, 388, 21, 22, 23, 86, 490, - 24, 25, 26, 27, 28, 29, 30, 521, 31, 32, - 33, 34, 35, 36, 87, 106, 88, 89, 90, 37, - 38, 91, 92, 93, 94, 95, 96, 186, 187, 499, - 97, 98, 99, 100, 39, 277, 101, 40, 41, 42, - 43, 44, 351, 438, 45, 46, 47, 48, 49, 50, - 51, 0, 193, 194, 195, 196, 197, 198, 199, 200, - 52, 0, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 85, 0, 53, 54, 0, 55, 0, - 56, 57, 18, 83, 416, 19, 0, 58, 20, 0, - 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, - 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, - 87, 106, 88, 89, 90, 37, 38, 91, 92, 93, - 94, 95, 96, 186, 187, 0, 97, 98, 99, 100, - 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, - 45, 46, 47, 48, 49, 50, 51, 0, 0, 194, - 195, 196, 197, 198, 199, 200, 52, 0, 0, 0, - 201, 0, 0, 202, 203, 204, 205, 0, 0, 85, + 113, 144, 59, 254, 17, 375, 161, 16, 162, 164, + 431, 120, 267, 268, 20, 175, 83, 176, 22, 117, + 501, 117, 24, 117, 103, 117, 117, 253, 117, 117, + 549, 273, 20, 373, 284, 390, 244, 550, 392, 152, + 245, 528, 408, 419, 246, 146, 117, 206, 84, 207, + 171, 160, 410, 139, 420, 116, 206, 116, 207, 116, + 130, 116, 116, 131, 116, 116, 118, 174, 412, -285, + 123, -285, 125, 126, 137, 127, 128, 427, 213, 138, + 141, 116, 116, 149, 144, 140, 183, 433, 272, 223, + 438, 439, 147, 148, 172, 173, -260, -259, 227, 157, + 172, 173, 568, 562, 270, 172, 173, 205, 158, 172, + 173, -261, 144, 278, 177, 279, 455, 224, 242, 172, + 173, 122, 257, 124, 172, 173, 225, 460, 371, 180, + 266, 59, 59, -263, 132, 172, 173, 230, 217, 136, + 490, 146, -287, 142, -287, -289, 150, 172, 173, 156, + 281, 163, 285, 165, 166, 167, 168, 169, 277, 172, + 173, -285, 469, -285, 286, 287, 174, 289, 290, 292, + 259, 481, 172, 173, 445, 312, 313, 116, 314, 212, + 351, 315, 352, 172, 173, 316, 391, 379, 269, 317, + 318, -287, 319, -287, 172, 173, 333, 325, 326, 327, + 328, 329, 330, 331, 332, 323, -262, 172, 173, 219, + 505, 506, 494, 372, 340, 341, 342, 343, 345, 431, + 353, 354, 407, 356, 357, 350, 220, 360, 362, 360, + 360, 360, 360, 320, 172, 173, 83, 153, 18, 172, + 173, 20, 154, 533, 20, 172, 173, 59, 22, 409, + 447, 114, 24, 178, 179, 411, 115, 275, 413, 181, + 182, 382, 387, 208, 459, 209, 385, 393, 231, 358, + 363, 364, 365, 366, 288, 321, 389, 553, 462, 221, + 293, 172, 173, 294, 295, 296, 297, 298, 299, 300, + 301, 302, 303, 304, 305, 306, 307, 308, 309, 310, + 311, 346, 172, 173, 222, 396, 397, 228, 172, 173, + 351, 229, 352, 404, 172, 173, 117, 172, 173, 235, + 236, 237, 238, 172, 173, 210, 239, 211, 240, 232, + 406, 144, 423, 362, 426, 426, 172, 173, 525, 526, + 172, 173, 336, 337, 234, 435, 429, 499, 426, 426, + 437, 531, 116, 172, 173, 350, 256, -253, 172, 173, + 255, 20, 215, 216, 453, 22, 539, 540, 454, 24, + 448, -253, -253, -290, -290, -290, 204, 260, 548, -253, + -253, -83, 456, 134, 135, 199, 461, 262, 554, 555, + 200, 185, 186, 201, 202, 203, 204, 59, 258, 264, + 271, 563, 282, 284, -253, -253, -253, -253, 334, 338, + 467, -253, 344, -253, 470, 355, -253, 194, 195, 196, + 197, 198, 199, -253, -253, 477, 367, 200, 144, 426, + 201, 202, 203, 204, 370, 376, -253, 485, -253, -253, + 380, -253, -253, -253, -253, -253, -253, -253, -253, -253, + -253, -253, -253, -253, -253, 383, 381, 185, 186, -253, + 388, 390, -253, -253, -253, -253, -253, 173, 426, 426, + 513, 395, 515, 1, 2, 3, 4, 5, 6, 7, + 399, 520, 400, 401, 184, 196, 197, 198, 199, 448, + 402, 185, 186, 200, 458, 415, 201, 202, 203, 204, + 423, 426, 405, 20, 421, 440, 430, 541, 444, 187, + 188, 394, 189, 190, 191, 192, 193, 194, 195, 196, + 197, 198, 199, 450, 457, 471, 463, 200, -13, 85, + 201, 202, 203, 204, 464, 426, 465, 466, 18, 83, + 484, 19, 564, 472, 20, 473, 474, 21, 22, 23, + 86, 475, 24, 25, 26, 27, 28, 29, 30, 476, + 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 185, + 186, 478, 97, 98, 99, 100, 39, 479, 101, 40, + 41, 42, 43, 44, 482, 483, 45, 46, 47, 48, + 49, 50, 51, 192, 193, 194, 195, 196, 197, 198, + 199, 52, 486, 487, 489, 200, 491, 492, 201, 202, + 203, 204, 493, -3, 85, 502, 53, 54, 495, 55, + 509, 56, 57, 18, 83, 510, 19, 516, 58, 20, + 514, 517, 21, 22, 23, 86, 521, 24, 25, 26, + 27, 28, 29, 30, 529, 31, 32, 33, 34, 35, + 36, 87, 106, 88, 89, 90, 37, 38, 91, 92, + 93, 94, 95, 96, 185, 186, 530, 97, 98, 99, + 100, 39, 543, 101, 40, 41, 42, 43, 44, 546, + 547, 45, 46, 47, 48, 49, 50, 51, 558, 193, + 194, 195, 196, 197, 198, 199, 52, 559, 561, 107, + 200, 241, 532, 201, 202, 203, 204, 424, 569, 85, + 468, 53, 54, 566, 55, 442, 56, 57, 18, 83, + 414, 19, 386, 58, 20, 369, 443, 21, 22, 23, + 86, 488, 24, 25, 26, 27, 28, 29, 30, 497, + 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 185, + 186, 436, 97, 98, 99, 100, 39, 519, 101, 40, + 41, 42, 43, 44, 276, 349, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 0, 0, 0, 83, 198, + 199, 52, 0, 20, 0, 200, 0, 0, 201, 202, + 203, 204, 398, 114, 85, 0, 53, 54, 115, 55, + 0, 56, 57, 18, 83, 535, 19, 0, 58, 20, + 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, + 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, + 36, 87, 106, 88, 89, 90, 37, 38, 91, 92, + 93, 94, 95, 96, 185, 186, 0, 97, 98, 99, + 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 200, 0, + 0, 201, 202, 203, 204, 199, 52, 0, 0, 0, + 200, 0, 0, 201, 202, 203, 204, 0, 0, 85, 0, 53, 54, 0, 55, 0, 56, 57, 18, 83, - 537, 19, 0, 58, 20, 0, 0, 21, 22, 23, + 536, 19, 0, 58, 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, - 90, 37, 38, 91, 92, 93, 94, 95, 96, 186, - 187, 0, 97, 98, 99, 100, 39, 0, 101, 40, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 185, + 0, 0, 97, 98, 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, - 49, 50, 51, 0, 0, 0, 195, 196, 197, 198, - 199, 200, 52, 0, 0, 0, 201, 0, 0, 202, - 203, 204, 205, 0, 0, 85, 0, 53, 54, 0, - 55, 0, 56, 57, 18, 83, 538, 19, 0, 58, - 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, - 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, - 35, 36, 87, 106, 88, 89, 90, 37, 38, 91, - 92, 93, 94, 95, 96, 186, 187, 0, 97, 98, - 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, - 0, 0, 45, 46, 47, 48, 49, 50, 51, 365, - 366, 367, 368, 0, 197, 198, 199, 200, 52, 0, - 0, 0, 201, 0, 0, 202, 203, 204, 205, 0, - 0, 85, 0, 53, 54, 0, 55, 0, 56, 57, - 18, 83, 540, 19, 0, 58, 20, 0, 0, 21, - 22, 23, 86, 0, 24, 25, 26, 27, 28, 29, - 30, 0, 31, 32, 33, 34, 35, 36, 87, 106, - 88, 89, 90, 37, 38, 91, 92, 93, 94, 95, - 96, 186, 187, 0, 97, 98, 99, 100, 39, 0, - 101, 40, 41, 42, 43, 44, 0, 0, 45, 46, - 47, 48, 49, 50, 51, 1, 2, 3, 4, 5, - 6, 7, 199, 200, 52, 0, 0, 0, 201, 0, - 0, 202, 203, 204, 205, 0, 0, 85, 0, 53, - 54, 0, 55, 0, 56, 57, 18, 83, 554, 19, - 0, 58, 20, 0, 0, 21, 22, 23, 86, 0, - 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, - 33, 34, 35, 36, 87, 106, 88, 89, 90, 37, - 38, 91, 92, 93, 94, 95, 96, 186, 187, 0, - 97, 98, 99, 100, 39, 0, 101, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, - 51, 201, 0, 0, 202, 203, 204, 205, 0, 200, - 52, 0, 0, 0, 201, 0, 0, 202, 203, 204, - 205, 0, 0, 85, 0, 53, 54, 0, 55, 0, - 56, 57, 18, 83, 0, 19, 0, 58, 20, 0, - 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, - 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, - 87, 106, 88, 89, 90, 37, 38, 91, 92, 93, - 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, - 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, - 45, 46, 47, 48, 49, 50, 51, 0, 0, 569, - 200, 0, 0, 0, 0, 201, 52, 0, 202, 203, - 204, 205, 0, 0, 0, 0, 0, 0, 0, 85, + 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, + 199, 52, 0, 0, 0, 200, 0, 0, 201, 202, + 203, 204, 0, 0, 85, 0, 53, 54, 0, 55, + 0, 56, 57, 18, 83, 538, 19, 0, 58, 20, + 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, + 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, + 36, 87, 106, 88, 89, 90, 37, 38, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 0, 235, 236, 237, 238, 0, 52, 0, 239, 0, + 240, 0, 0, 0, 0, 0, 0, 0, 0, 85, + 0, 53, 54, 0, 55, 0, 56, 57, 18, 83, + 552, 19, 0, 58, 20, 172, 173, 21, 22, 23, + 86, 0, 24, 25, 26, 27, 28, 29, 30, 0, + 31, 32, 33, 34, 35, 36, 87, 106, 88, 89, + 90, 37, 38, 91, 92, 93, 94, 95, 96, 0, + 0, 0, 97, 98, 99, 100, 39, 0, 101, 40, + 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 53, 54, 0, 55, + 0, 56, 57, 18, 83, 0, 19, 0, 58, 20, + 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, + 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, + 36, 87, 106, 88, 89, 90, 37, 38, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 567, 0, 0, 0, 0, 0, 52, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 53, 54, 0, 55, 0, 56, 57, 18, 83, 0, 19, 0, 58, 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, 27, 28, 29, 30, 0, @@ -481,600 +480,599 @@ static const yytype_int16 yytable[] = 90, 37, 38, 91, 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, - 49, 50, 51, 0, 0, 314, 315, 0, 316, 0, - 0, 317, 52, 0, 0, 318, 0, 0, 0, 319, - 320, 0, 321, 0, 0, 85, 0, 53, 54, 0, - 55, 0, 56, 57, 18, 83, 0, 19, 0, 58, - 20, 0, 0, 21, 22, 23, 86, 0, 24, 25, - 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, - 35, 36, 87, 322, 88, 89, 90, 37, 38, 91, - 92, 93, 94, 95, 96, 0, 0, 0, 97, 98, - 99, 100, 39, 0, 101, 40, 41, 42, 43, 44, - 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, - 0, 0, 0, 0, 0, 0, 323, 0, 52, 0, + 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 85, 0, 53, 54, 0, 55, + 0, 56, 57, 18, 83, 0, 19, 0, 58, 20, + 0, 0, 21, 22, 23, 86, 0, 24, 25, 26, + 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, + 36, 87, 0, 88, 89, 90, 37, 38, 91, 92, + 93, 94, 95, 96, 0, 0, 0, 97, 98, 99, + 100, 39, 0, 101, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, + 0, 53, 54, 0, 55, 18, 56, 57, 19, 0, + 0, 20, 0, 58, 21, 22, 23, -78, 0, 24, + 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, + 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, + 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 85, 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, - 19, 0, 0, 20, 0, 58, 21, 22, 23, -78, + 19, 0, 0, 20, 0, 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, - 37, 38, 236, 237, 238, 239, 0, 0, 0, 240, - 0, 241, 0, 0, 0, 39, 0, 0, 40, 41, - 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, - 50, 51, 0, 0, 0, 0, 172, 173, 174, 0, - 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 85, 0, 0, 0, 0, 53, 54, 0, 55, - 18, 56, 57, 19, 0, 0, 20, 0, 58, 21, - 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, - 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, - 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, - 0, 40, 41, 42, 43, 44, -254, 0, 45, 46, - 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, - -254, -254, 0, 0, 52, 0, 0, 0, -254, -254, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, - 54, 0, 55, 0, 56, 57, 0, 0, 0, 0, - -78, 58, 0, -254, -254, -254, -254, 0, 0, 0, - -254, 0, -254, 0, 0, -254, 0, 0, 0, 0, - 0, 0, -254, -254, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, -254, 0, -254, -254, -254, - 0, -254, -254, -254, -254, -254, -254, -254, -254, -254, - -254, -254, -254, -254, -254, 0, 0, 0, 0, -254, - 0, 0, -254, -254, -254, -254, -254, 18, 83, 0, - 19, 0, 0, 20, 0, 0, 21, 22, 23, 0, - 0, 24, 25, 143, 27, 28, 29, 30, 115, 31, - 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, - 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, - 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, - 18, 56, 57, 19, 119, 0, 20, 0, 58, 21, + 42, 43, 44, -214, 0, 45, 46, 47, 48, 49, + 50, 51, 0, 0, 206, 0, 207, -214, -214, 0, + 52, 0, 0, 0, 0, -214, -214, 0, 0, 0, + 0, 0, 0, 0, 0, 53, 54, 0, 55, 0, + 56, 57, 0, 0, 0, 0, -78, 58, 0, 0, + -214, -214, -214, -214, 0, 0, 0, -214, 0, -214, + 0, 0, -214, 0, 0, 0, 0, 0, 0, -214, + -214, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, -214, 0, -214, -214, 0, -214, -214, -214, + -214, -214, -214, -214, -214, -214, -214, -214, -214, -214, + -214, 0, 0, 0, 0, -214, 0, 0, -214, -214, + -214, -214, -214, 18, 83, 0, 19, 0, 0, 20, + 0, 0, 21, 22, 23, 0, 0, 24, 25, 143, + 27, 28, 29, 30, 115, 31, 32, 33, 34, 35, + 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, + 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 53, 54, 0, 55, 18, 56, 57, 19, 119, + 0, 20, 0, 58, 21, 22, 23, 0, 0, 24, + 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, + 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, + 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, + 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 53, 54, 0, 55, 0, 56, 57, + 18, 83, 0, 19, 0, 58, 20, 0, 0, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, - 54, 0, 55, 0, 56, 57, 18, 83, 0, 19, - 0, 58, 20, 0, 0, 21, 22, 23, 0, 0, - 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, - 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, - 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, - 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 53, 54, 0, 55, 18, - 56, 57, 19, 0, 0, 20, 0, 58, 21, 22, - 23, 151, 0, 24, 25, 26, 27, 28, 29, 30, - 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, - 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, - 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, - 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, 19, 0, 0, 20, 0, - 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, + 58, 21, 22, 23, 151, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 53, 54, 0, 55, 18, 56, 57, 19, 0, - 0, 20, 170, 58, 21, 22, 23, 0, 0, 24, - 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, - 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, + 53, 54, 0, 55, 18, 56, 57, 19, 0, 0, + 20, 0, 58, 21, 22, 23, 0, 0, 24, 25, + 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, + 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, - 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, + 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, + 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, + 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 53, 54, 0, 55, 18, 56, 57, 19, + 0, 0, 20, 170, 58, 21, 22, 23, 0, 0, + 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, + 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, + 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, + 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, - 57, 19, 0, 0, 20, 266, 58, 21, 22, 23, + 57, 19, 0, 0, 20, 265, 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, - 55, 18, 56, 57, 19, 0, 0, 20, 281, 58, - 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, - 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, - 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, - 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, - 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 53, 54, 0, 55, 18, 56, 57, 19, 0, 0, - 20, 293, 58, 21, 22, 23, 0, 0, 24, 25, - 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, - 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, - 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, - 19, 0, 0, 20, 326, 58, 21, 22, 23, 0, - 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, - 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, - 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, - 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, - 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, - 18, 56, 57, 19, 0, 0, 20, 386, 58, 21, + 18, 56, 57, 19, 0, 0, 20, 280, 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, - 54, 0, 55, 18, 56, 57, 19, 0, 0, 20, - 405, 58, 21, 22, 23, 0, 0, 24, 25, 26, - 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, - 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, + 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, + 0, 55, 18, 56, 57, 19, 0, 0, 20, 291, + 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, + 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, + 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, - 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, + 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, + 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, + 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 53, 54, 0, 55, 18, 56, 57, 19, 0, 0, + 20, 324, 58, 21, 22, 23, 0, 0, 24, 25, + 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, + 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, + 0, 0, 45, 46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, 57, 19, - 0, 0, 20, 0, 58, 21, 22, 23, 0, 0, + 0, 0, 20, 384, 58, 21, 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, 49, 50, - 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 52, 0, 185, 0, 0, 0, 0, 0, 0, 186, - 187, 0, 0, 0, 0, 53, 54, 0, 55, 0, - 56, 57, 0, 0, 0, 0, 0, 275, 188, 189, - 396, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, 185, 0, 202, - 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 51, 0, 0, 0, 0, 0, 0, 0, 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 188, 189, 0, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, 185, 0, 202, 203, 204, 205, 0, 186, - 187, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 0, 0, 0, 189, - 0, 190, 191, 192, 193, 194, 195, 196, 197, 198, - 199, 200, 0, 0, 0, 0, 201, -291, 0, 202, - 203, 204, 205, 0, 186, 187, 0, 0, 0, 0, + 0, 0, 0, 0, 53, 54, 0, 55, 18, 56, + 57, 19, 0, 0, 20, 403, 58, 21, 22, 23, + 0, 0, 24, 25, 26, 27, 28, 29, 30, 0, + 31, 32, 33, 34, 35, 36, 0, 0, 0, 0, + 0, 37, 38, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 39, 0, 0, 40, + 41, 42, 43, 44, 0, 0, 45, 46, 47, 48, + 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, + 0, 52, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 53, 54, 0, 55, + 18, 56, 57, 19, 0, 0, 20, 0, 58, 21, + 22, 23, 0, 0, 24, 25, 26, 27, 28, 29, + 30, 0, 31, 32, 33, 34, 35, 36, 0, 0, + 0, 0, 0, 37, 38, 0, 0, 0, 0, 0, + 0, 0, 504, 0, 0, 507, 0, 0, 39, 511, + 512, 40, 41, 42, 43, 44, 0, 0, 45, 46, + 47, 48, 49, 50, 51, 0, 0, 522, 523, 0, + 0, 0, 0, 52, 0, 0, 0, 534, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 53, 54, + 0, 55, 542, 56, 57, 0, 544, 545, 0, 0, + 274, 0, 0, 0, 0, 0, 0, 0, 0, 184, + 0, 0, 0, 0, 557, 0, 185, 186, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 565, 0, + 0, 0, 0, 0, 187, 188, 570, 189, 190, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 0, 0, + 0, 0, 200, 184, 0, 201, 202, 203, 204, 0, + 185, 186, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 188, + 0, 189, 190, 191, 192, 193, 194, 195, 196, 197, + 198, 199, 0, 0, 0, 0, 200, -290, 0, 201, + 202, 203, 204, 0, 185, 186, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, - 0, 0, 0, 0, 0, 0, 190, 191, 192, 193, - 194, 195, 196, 197, 198, 199, 200, 0, 0, 0, - 0, 201, 0, 0, 202, 203, 204, 205 + 0, 0, 0, 0, 0, 189, 190, 191, 192, 193, + 194, 195, 196, 197, 198, 199, 185, 186, 0, 0, + 200, 0, 0, 201, 202, 203, 204, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 191, + 192, 193, 194, 195, 196, 197, 198, 199, 0, 0, + 0, 0, 200, 0, 0, 201, 202, 203, 204 }; static const yytype_int16 yycheck[] = { - 17, 44, 10, 127, 9, 262, 50, 16, 50, 52, - 506, 19, 139, 140, 355, 12, 11, 475, 13, 18, - 13, 20, 11, 22, 13, 24, 25, 14, 27, 28, - 0, 155, 16, 11, 11, 13, 20, 11, 14, 47, - 24, 13, 78, 95, 96, 44, 45, 11, 22, 13, - 58, 50, 81, 82, 83, 22, 11, 14, 81, 82, - 83, 13, 29, 18, 73, 20, 15, 22, 14, 24, - 25, 567, 27, 28, 23, 111, 111, 11, 83, 13, - 111, 110, 75, 11, 127, 13, 75, 110, 43, 44, - 45, 46, 14, 102, 81, 82, 83, 75, 97, 111, - 558, 15, 111, 75, 147, 81, 82, 83, 11, 106, - 13, 75, 155, 157, 26, 157, 111, 111, 102, 31, - 95, 21, 130, 23, 81, 82, 83, 111, 93, 256, - 138, 139, 140, 22, 34, 81, 82, 83, 11, 39, - 14, 140, 11, 43, 13, 100, 46, 11, 11, 49, - 158, 51, 16, 53, 54, 55, 56, 57, 157, 81, - 82, 83, 26, 420, 172, 173, 174, 31, 176, 177, - 178, 16, 93, 94, 10, 20, 345, 26, 133, 24, - 16, 225, 14, 225, 20, 140, 355, 14, 24, 358, - 359, 111, 81, 82, 83, 111, 14, 214, 206, 207, - 208, 209, 210, 211, 212, 213, 205, 81, 82, 83, - 51, 52, 22, 470, 257, 220, 221, 222, 223, 224, - 111, 226, 227, 564, 229, 230, 225, 111, 236, 237, - 238, 239, 240, 241, 18, 216, 217, 73, 22, 111, - 24, 25, 22, 27, 28, 22, 37, 38, 256, 81, - 82, 83, 376, 111, 81, 82, 83, 157, 89, 90, - 44, 45, 270, 81, 82, 83, 22, 275, 53, 22, - 439, 81, 82, 83, 11, 175, 13, 285, 233, 22, - 407, 181, 111, 78, 184, 185, 186, 187, 188, 189, + 17, 44, 10, 127, 9, 261, 50, 0, 50, 52, + 353, 19, 139, 140, 16, 11, 11, 13, 20, 18, + 473, 20, 24, 22, 12, 24, 25, 14, 27, 28, + 22, 155, 16, 14, 13, 13, 16, 29, 14, 47, + 20, 504, 14, 11, 24, 44, 45, 11, 11, 13, + 58, 50, 14, 78, 22, 18, 11, 20, 13, 22, + 13, 24, 25, 110, 27, 28, 18, 15, 14, 11, + 22, 13, 24, 25, 110, 27, 28, 343, 83, 110, + 43, 44, 45, 46, 127, 110, 92, 353, 22, 73, + 356, 357, 44, 45, 81, 82, 75, 75, 97, 101, + 81, 82, 565, 556, 147, 81, 82, 110, 110, 81, + 82, 75, 155, 157, 110, 157, 14, 101, 106, 81, + 82, 21, 130, 23, 81, 82, 110, 14, 255, 94, + 138, 139, 140, 75, 34, 81, 82, 100, 26, 39, + 14, 140, 11, 43, 13, 11, 46, 81, 82, 49, + 158, 51, 109, 53, 54, 55, 56, 57, 157, 81, + 82, 11, 418, 13, 172, 173, 15, 175, 176, 177, + 133, 437, 81, 82, 23, 10, 11, 140, 13, 11, + 224, 16, 224, 81, 82, 20, 22, 109, 140, 24, + 25, 11, 27, 13, 81, 82, 213, 205, 206, 207, + 208, 209, 210, 211, 212, 204, 75, 81, 82, 110, + 476, 477, 468, 256, 219, 220, 221, 222, 223, 562, + 225, 226, 22, 228, 229, 224, 110, 235, 236, 237, + 238, 239, 240, 68, 81, 82, 11, 26, 10, 81, + 82, 16, 31, 509, 16, 81, 82, 255, 20, 22, + 374, 26, 24, 94, 95, 22, 31, 157, 22, 92, + 93, 269, 109, 11, 22, 13, 274, 109, 22, 232, + 237, 238, 239, 240, 174, 110, 284, 543, 405, 110, + 180, 81, 82, 183, 184, 185, 186, 187, 188, 189, 190, 191, 192, 193, 194, 195, 196, 197, 198, 199, - 200, 201, 110, 29, 81, 82, 83, 315, 316, 478, - 479, 75, 356, 16, 356, 323, 110, 20, 317, 12, - 22, 24, 81, 82, 83, 81, 82, 83, 81, 82, - 83, 75, 13, 376, 342, 343, 344, 345, 477, 26, - 26, 480, 511, 111, 102, 484, 485, 355, 347, 473, - 358, 359, 357, 31, 66, 0, 140, 356, 22, 15, - 29, 79, 317, 502, 503, 110, 11, 29, 13, 14, - 15, 12, 377, 512, 13, 83, 545, 22, 23, 81, - 82, 83, 25, 25, 392, 25, 98, 25, 527, 25, - 111, 103, 531, 532, 106, 107, 108, 109, 18, 407, - 16, 26, 47, 48, 49, 50, 81, 82, 83, 54, - 549, 56, 417, 111, 59, 85, 421, 81, 82, 83, - 110, 66, 67, 111, 563, 12, 12, 432, 26, 12, - 473, 439, 571, 12, 79, 110, 81, 82, 83, 447, + 200, 73, 81, 82, 110, 313, 314, 110, 81, 82, + 354, 110, 354, 321, 81, 82, 315, 81, 82, 47, + 48, 49, 50, 81, 82, 11, 54, 13, 56, 53, + 109, 374, 340, 341, 342, 343, 81, 82, 51, 52, + 81, 82, 215, 216, 22, 353, 345, 471, 356, 357, + 355, 507, 315, 81, 82, 354, 78, 0, 81, 82, + 110, 16, 89, 90, 109, 20, 522, 523, 109, 24, + 375, 14, 15, 105, 106, 107, 108, 29, 534, 22, + 23, 109, 390, 37, 38, 97, 109, 75, 544, 545, + 102, 66, 67, 105, 106, 107, 108, 405, 109, 109, + 12, 557, 75, 13, 47, 48, 49, 50, 26, 26, + 415, 54, 101, 56, 419, 110, 59, 92, 93, 94, + 95, 96, 97, 66, 67, 430, 31, 102, 471, 437, + 105, 106, 107, 108, 15, 29, 79, 445, 81, 82, + 79, 84, 85, 86, 87, 88, 89, 90, 91, 92, + 93, 94, 95, 96, 97, 12, 109, 66, 67, 102, + 29, 13, 105, 106, 107, 108, 109, 82, 476, 477, + 487, 25, 489, 3, 4, 5, 6, 7, 8, 9, + 25, 498, 25, 25, 59, 94, 95, 96, 97, 494, + 25, 66, 67, 102, 394, 18, 105, 106, 107, 108, + 508, 509, 110, 16, 26, 84, 110, 524, 109, 84, 85, 86, 87, 88, 89, 90, 91, 92, 93, 94, - 95, 96, 97, 98, 12, 81, 82, 83, 103, 110, - 110, 106, 107, 108, 109, 110, 81, 82, 83, 22, - 478, 479, 489, 110, 491, 110, 110, 81, 82, 83, - 111, 110, 110, 500, 110, 47, 48, 49, 50, 509, - 79, 496, 54, 11, 56, 110, 396, 11, 16, 81, - 82, 83, 510, 511, 524, 525, 110, 25, 26, 526, - 11, 110, 12, 31, 22, 22, 536, 11, 111, 81, - 82, 83, 106, 107, 108, 109, 546, 547, 110, 110, - 0, 1, 81, 82, 83, 110, 77, 545, 22, 559, - 10, 11, 442, 13, 561, 22, 16, 110, 110, 19, - 20, 21, 22, 110, 24, 25, 26, 27, 28, 29, - 30, 110, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, - 50, 66, 67, 111, 54, 55, 56, 57, 58, 22, - 60, 61, 62, 63, 64, 65, 17, 110, 68, 69, - 70, 71, 72, 73, 74, 90, 91, 92, 93, 94, - 95, 96, 97, 98, 84, 76, 13, 110, 103, 110, - 106, 106, 107, 108, 109, 510, 0, 1, 343, 99, - 100, 564, 102, 419, 104, 105, 10, 11, 248, 13, - 371, 111, 16, 372, 277, 19, 20, 21, 22, 452, - 24, 25, 26, 27, 28, 29, 30, 496, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 48, 49, 50, 66, 67, 471, - 54, 55, 56, 57, 58, 157, 60, 61, 62, 63, - 64, 65, 225, 356, 68, 69, 70, 71, 72, 73, - 74, -1, 91, 92, 93, 94, 95, 96, 97, 98, - 84, -1, -1, -1, 103, -1, -1, 106, 107, 108, - 109, -1, -1, 1, -1, 99, 100, -1, 102, -1, - 104, 105, 10, 11, 12, 13, -1, 111, 16, -1, - -1, 19, 20, 21, 22, -1, 24, 25, 26, 27, - 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, 66, 67, -1, 54, 55, 56, 57, - 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, - 68, 69, 70, 71, 72, 73, 74, -1, -1, 92, - 93, 94, 95, 96, 97, 98, 84, -1, -1, -1, - 103, -1, -1, 106, 107, 108, 109, -1, -1, 1, - -1, 99, 100, -1, 102, -1, 104, 105, 10, 11, - 12, 13, -1, 111, 16, -1, -1, 19, 20, 21, + 95, 96, 97, 110, 12, 26, 12, 102, 0, 1, + 105, 106, 107, 108, 12, 543, 12, 12, 10, 11, + 440, 13, 559, 109, 16, 109, 109, 19, 20, 21, + 22, 109, 24, 25, 26, 27, 28, 29, 30, 110, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 50, 66, + 67, 109, 54, 55, 56, 57, 58, 22, 60, 61, + 62, 63, 64, 65, 109, 109, 68, 69, 70, 71, + 72, 73, 74, 90, 91, 92, 93, 94, 95, 96, + 97, 83, 79, 11, 11, 102, 12, 109, 105, 106, + 107, 108, 22, 0, 1, 11, 98, 99, 22, 101, + 110, 103, 104, 10, 11, 109, 13, 77, 110, 16, + 109, 22, 19, 20, 21, 22, 22, 24, 25, 26, + 27, 28, 29, 30, 109, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, 66, 67, 109, 54, 55, 56, + 57, 58, 110, 60, 61, 62, 63, 64, 65, 22, + 109, 68, 69, 70, 71, 72, 73, 74, 17, 91, + 92, 93, 94, 95, 96, 97, 83, 76, 109, 13, + 102, 106, 508, 105, 106, 107, 108, 341, 109, 1, + 417, 98, 99, 562, 101, 369, 103, 104, 10, 11, + 12, 13, 276, 110, 16, 247, 370, 19, 20, 21, + 22, 450, 24, 25, 26, 27, 28, 29, 30, 469, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 50, 66, + 67, 354, 54, 55, 56, 57, 58, 494, 60, 61, + 62, 63, 64, 65, 157, 224, 68, 69, 70, 71, + 72, 73, 74, -1, -1, -1, -1, -1, 11, 96, + 97, 83, -1, 16, -1, 102, -1, -1, 105, 106, + 107, 108, 25, 26, 1, -1, 98, 99, 31, 101, + -1, 103, 104, 10, 11, 12, 13, -1, 110, 16, + -1, -1, 19, 20, 21, 22, -1, 24, 25, 26, + 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, 66, 67, -1, 54, 55, 56, + 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, 102, -1, + -1, 105, 106, 107, 108, 97, 83, -1, -1, -1, + 102, -1, -1, 105, 106, 107, 108, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + 12, 13, -1, 110, 16, -1, -1, 19, 20, 21, 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 66, - 67, -1, 54, 55, 56, 57, 58, -1, 60, 61, + -1, -1, 54, 55, 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, - 72, 73, 74, -1, -1, -1, 93, 94, 95, 96, - 97, 98, 84, -1, -1, -1, 103, -1, -1, 106, - 107, 108, 109, -1, -1, 1, -1, 99, 100, -1, - 102, -1, 104, 105, 10, 11, 12, 13, -1, 111, - 16, -1, -1, 19, 20, 21, 22, -1, 24, 25, - 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, - 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, - 46, 47, 48, 49, 50, 66, 67, -1, 54, 55, - 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, - -1, -1, 68, 69, 70, 71, 72, 73, 74, 238, - 239, 240, 241, -1, 95, 96, 97, 98, 84, -1, - -1, -1, 103, -1, -1, 106, 107, 108, 109, -1, - -1, 1, -1, 99, 100, -1, 102, -1, 104, 105, - 10, 11, 12, 13, -1, 111, 16, -1, -1, 19, - 20, 21, 22, -1, 24, 25, 26, 27, 28, 29, - 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, - 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, - 50, 66, 67, -1, 54, 55, 56, 57, 58, -1, - 60, 61, 62, 63, 64, 65, -1, -1, 68, 69, - 70, 71, 72, 73, 74, 3, 4, 5, 6, 7, - 8, 9, 97, 98, 84, -1, -1, -1, 103, -1, - -1, 106, 107, 108, 109, -1, -1, 1, -1, 99, - 100, -1, 102, -1, 104, 105, 10, 11, 12, 13, - -1, 111, 16, -1, -1, 19, 20, 21, 22, -1, - 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, - 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, - 44, 45, 46, 47, 48, 49, 50, 66, 67, -1, - 54, 55, 56, 57, 58, -1, 60, 61, 62, 63, - 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, - 74, 103, -1, -1, 106, 107, 108, 109, -1, 98, - 84, -1, -1, -1, 103, -1, -1, 106, 107, 108, - 109, -1, -1, 1, -1, 99, 100, -1, 102, -1, - 104, 105, 10, 11, -1, 13, -1, 111, 16, -1, - -1, 19, 20, 21, 22, -1, 24, 25, 26, 27, - 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, - 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, - 48, 49, 50, -1, -1, -1, 54, 55, 56, 57, - 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, - 68, 69, 70, 71, 72, 73, 74, -1, -1, 77, - 98, -1, -1, -1, -1, 103, 84, -1, 106, 107, - 108, 109, -1, -1, -1, -1, -1, -1, -1, 1, - -1, 99, 100, -1, 102, -1, 104, 105, 10, 11, - -1, 13, -1, 111, 16, -1, -1, 19, 20, 21, + 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, + 97, 83, -1, -1, -1, 102, -1, -1, 105, 106, + 107, 108, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, 12, 13, -1, 110, 16, + -1, -1, 19, 20, 21, 22, -1, 24, 25, 26, + 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, -1, -1, -1, 54, 55, 56, + 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, + -1, 47, 48, 49, 50, -1, 83, -1, 54, -1, + 56, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + 12, 13, -1, 110, 16, 81, 82, 19, 20, 21, 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, -1, -1, -1, 54, 55, 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, - 72, 73, 74, -1, -1, 10, 11, -1, 13, -1, - -1, 16, 84, -1, -1, 20, -1, -1, -1, 24, - 25, -1, 27, -1, -1, 1, -1, 99, 100, -1, - 102, -1, 104, 105, 10, 11, -1, 13, -1, 111, - 16, -1, -1, 19, 20, 21, 22, -1, 24, 25, - 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, - 36, 37, 38, 68, 40, 41, 42, 43, 44, 45, - 46, 47, 48, 49, 50, -1, -1, -1, 54, 55, - 56, 57, 58, -1, 60, 61, 62, 63, 64, 65, - -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, - -1, -1, -1, -1, -1, -1, 111, -1, 84, -1, + 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, -1, 13, -1, 110, 16, + -1, -1, 19, 20, 21, 22, -1, 24, 25, 26, + 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, -1, -1, -1, 54, 55, 56, + 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, + 77, -1, -1, -1, -1, -1, 83, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, + -1, 98, 99, -1, 101, -1, 103, 104, 10, 11, + -1, 13, -1, 110, 16, -1, -1, 19, 20, 21, + 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, + 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, + 42, 43, 44, 45, 46, 47, 48, 49, 50, -1, + -1, -1, 54, 55, 56, 57, 58, -1, 60, 61, + 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, + 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 1, -1, 98, 99, -1, 101, + -1, 103, 104, 10, 11, -1, 13, -1, 110, 16, + -1, -1, 19, 20, 21, 22, -1, 24, 25, 26, + 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, + 37, 38, -1, 40, 41, 42, 43, 44, 45, 46, + 47, 48, 49, 50, -1, -1, -1, 54, 55, 56, + 57, 58, -1, 60, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, + -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 1, -1, -1, -1, + -1, 98, 99, -1, 101, 10, 103, 104, 13, -1, + -1, 16, -1, 110, 19, 20, 21, 22, -1, 24, + 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, + 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, + 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, + -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, 1, -1, - -1, -1, -1, 99, 100, -1, 102, 10, 104, 105, - 13, -1, -1, 16, -1, 111, 19, 20, 21, 22, + -1, -1, -1, 98, 99, -1, 101, 10, 103, 104, + 13, -1, -1, 16, -1, 110, 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, - 43, 44, 47, 48, 49, 50, -1, -1, -1, 54, - -1, 56, -1, -1, -1, 58, -1, -1, 61, 62, - 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, - 73, 74, -1, -1, -1, -1, 81, 82, 83, -1, - -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 1, -1, -1, -1, -1, 99, 100, -1, 102, - 10, 104, 105, 13, -1, -1, 16, -1, 111, 19, - 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, - 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, - -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, - -1, 61, 62, 63, 64, 65, 0, -1, 68, 69, - 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, - 14, 15, -1, -1, 84, -1, -1, -1, 22, 23, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, - 100, -1, 102, -1, 104, 105, -1, -1, -1, -1, - 110, 111, -1, 47, 48, 49, 50, -1, -1, -1, - 54, -1, 56, -1, -1, 59, -1, -1, -1, -1, - -1, -1, 66, 67, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 79, -1, 81, 82, 83, - -1, 85, 86, 87, 88, 89, 90, 91, 92, 93, - 94, 95, 96, 97, 98, -1, -1, -1, -1, 103, - -1, -1, 106, 107, 108, 109, 110, 10, 11, -1, - 13, -1, -1, 16, -1, -1, 19, 20, 21, -1, - -1, 24, 25, 26, 27, 28, 29, 30, 31, 32, - 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, - 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, - 73, 74, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 99, 100, -1, 102, - 10, 104, 105, 13, 14, -1, 16, -1, 111, 19, + 63, 64, 65, 0, -1, 68, 69, 70, 71, 72, + 73, 74, -1, -1, 11, -1, 13, 14, 15, -1, + 83, -1, -1, -1, -1, 22, 23, -1, -1, -1, + -1, -1, -1, -1, -1, 98, 99, -1, 101, -1, + 103, 104, -1, -1, -1, -1, 109, 110, -1, -1, + 47, 48, 49, 50, -1, -1, -1, 54, -1, 56, + -1, -1, 59, -1, -1, -1, -1, -1, -1, 66, + 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 79, -1, 81, 82, -1, 84, 85, 86, + 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, + 97, -1, -1, -1, -1, 102, -1, -1, 105, 106, + 107, 108, 109, 10, 11, -1, 13, -1, -1, 16, + -1, -1, 19, 20, 21, -1, -1, 24, 25, 26, + 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, + 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, + -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, + -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 98, 99, -1, 101, 10, 103, 104, 13, 14, + -1, 16, -1, 110, 19, 20, 21, -1, -1, 24, + 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, + 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, + 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, + -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 98, 99, -1, 101, -1, 103, 104, + 10, 11, -1, 13, -1, 110, 16, -1, -1, 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, - 100, -1, 102, -1, 104, 105, 10, 11, -1, 13, - -1, 111, 16, -1, -1, 19, 20, 21, -1, -1, - 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, - 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, - 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, - 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, - 74, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 84, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 99, 100, -1, 102, 10, - 104, 105, 13, -1, -1, 16, -1, 111, 19, 20, - 21, 22, -1, 24, 25, 26, 27, 28, 29, 30, - -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, - -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, - 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, - 71, 72, 73, 74, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 84, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 99, 100, - -1, 102, 10, 104, 105, 13, -1, -1, 16, -1, - 111, 19, 20, 21, -1, -1, 24, 25, 26, 27, + -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 98, 99, + -1, 101, 10, 103, 104, 13, -1, -1, 16, -1, + 110, 19, 20, 21, 22, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 84, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 99, 100, -1, 102, 10, 104, 105, 13, -1, - -1, 16, 110, 111, 19, 20, 21, -1, -1, 24, - 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, - 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, + 98, 99, -1, 101, 10, 103, 104, 13, -1, -1, + 16, -1, 110, 19, 20, 21, -1, -1, 24, 25, + 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, + 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, - 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 84, + -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, + -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, + -1, -1, -1, -1, -1, -1, -1, 83, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 98, 99, -1, 101, 10, 103, 104, 13, + -1, -1, 16, 109, 110, 19, 20, 21, -1, -1, + 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, + 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, + 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, + 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, + 74, -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 99, 100, -1, 102, 10, 104, - 105, 13, -1, -1, 16, 110, 111, 19, 20, 21, + -1, -1, -1, -1, 98, 99, -1, 101, 10, 103, + 104, 13, -1, -1, 16, 109, 110, 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 84, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 99, 100, -1, - 102, 10, 104, 105, 13, -1, -1, 16, 110, 111, - 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, - 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, - -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, - -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, - 69, 70, 71, 72, 73, 74, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 84, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 99, 100, -1, 102, 10, 104, 105, 13, -1, -1, - 16, 110, 111, 19, 20, 21, -1, -1, 24, 25, - 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, - 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, - -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, - -1, -1, -1, -1, -1, -1, -1, -1, 84, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 99, 100, -1, 102, 10, 104, 105, - 13, -1, -1, 16, 110, 111, 19, 20, 21, -1, - -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, - 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, - 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, - 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, - 73, 74, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 84, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 99, 100, -1, 102, - 10, 104, 105, 13, -1, -1, 16, 110, 111, 19, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 98, 99, -1, 101, + 10, 103, 104, 13, -1, -1, 16, 109, 110, 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, -1, -1, - -1, -1, -1, -1, 84, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 99, - 100, -1, 102, 10, 104, 105, 13, -1, -1, 16, - 110, 111, 19, 20, 21, -1, -1, 24, 25, 26, - 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, - 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, + -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 98, 99, + -1, 101, 10, 103, 104, 13, -1, -1, 16, 109, + 110, 19, 20, 21, -1, -1, 24, 25, 26, 27, + 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, + -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, - -1, 68, 69, 70, 71, 72, 73, 74, -1, -1, - -1, -1, -1, -1, -1, -1, -1, 84, -1, -1, + 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, + 68, 69, 70, 71, 72, 73, 74, -1, -1, -1, + -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 98, 99, -1, 101, 10, 103, 104, 13, -1, -1, + 16, 109, 110, 19, 20, 21, -1, -1, 24, 25, + 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, + 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, + -1, -1, 68, 69, 70, 71, 72, 73, 74, -1, + -1, -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, 99, 100, -1, 102, 10, 104, 105, 13, - -1, -1, 16, -1, 111, 19, 20, 21, -1, -1, + -1, -1, 98, 99, -1, 101, 10, 103, 104, 13, + -1, -1, 16, 109, 110, 19, 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, 72, 73, - 74, -1, -1, -1, -1, -1, -1, -1, -1, -1, - 84, -1, 59, -1, -1, -1, -1, -1, -1, 66, - 67, -1, -1, -1, -1, 99, 100, -1, 102, -1, - 104, 105, -1, -1, -1, -1, -1, 111, 85, 86, - 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, - 97, 98, -1, -1, -1, -1, 103, 59, -1, 106, - 107, 108, 109, -1, 66, 67, -1, -1, -1, -1, + 74, -1, -1, -1, -1, -1, -1, -1, -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, 85, 86, -1, 88, 89, 90, 91, - 92, 93, 94, 95, 96, 97, 98, -1, -1, -1, - -1, 103, 59, -1, 106, 107, 108, 109, -1, 66, - 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, -1, -1, -1, 86, - -1, 88, 89, 90, 91, 92, 93, 94, 95, 96, - 97, 98, -1, -1, -1, -1, 103, 59, -1, 106, - 107, 108, 109, -1, 66, 67, -1, -1, -1, -1, + -1, -1, -1, -1, 98, 99, -1, 101, 10, 103, + 104, 13, -1, -1, 16, 109, 110, 19, 20, 21, + -1, -1, 24, 25, 26, 27, 28, 29, 30, -1, + 32, 33, 34, 35, 36, 37, -1, -1, -1, -1, + -1, 43, 44, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 58, -1, -1, 61, + 62, 63, 64, 65, -1, -1, 68, 69, 70, 71, + 72, 73, 74, -1, -1, -1, -1, -1, -1, -1, + -1, 83, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 98, 99, -1, 101, + 10, 103, 104, 13, -1, -1, 16, -1, 110, 19, + 20, 21, -1, -1, 24, 25, 26, 27, 28, 29, + 30, -1, 32, 33, 34, 35, 36, 37, -1, -1, + -1, -1, -1, 43, 44, -1, -1, -1, -1, -1, + -1, -1, 475, -1, -1, 478, -1, -1, 58, 482, + 483, 61, 62, 63, 64, 65, -1, -1, 68, 69, + 70, 71, 72, 73, 74, -1, -1, 500, 501, -1, + -1, -1, -1, 83, -1, -1, -1, 510, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 98, 99, + -1, 101, 525, 103, 104, -1, 529, 530, -1, -1, + 110, -1, -1, -1, -1, -1, -1, -1, -1, 59, + -1, -1, -1, -1, 547, -1, 66, 67, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 561, -1, + -1, -1, -1, -1, 84, 85, 569, 87, 88, 89, + 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, + -1, -1, 102, 59, -1, 105, 106, 107, 108, -1, + 66, 67, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 85, + -1, 87, 88, 89, 90, 91, 92, 93, 94, 95, + 96, 97, -1, -1, -1, -1, 102, 59, -1, 105, + 106, 107, 108, -1, 66, 67, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, - -1, -1, -1, -1, -1, -1, 88, 89, 90, 91, - 92, 93, 94, 95, 96, 97, 98, -1, -1, -1, - -1, 103, -1, -1, 106, 107, 108, 109 + -1, -1, -1, -1, -1, 87, 88, 89, 90, 91, + 92, 93, 94, 95, 96, 97, 66, 67, -1, -1, + 102, -1, -1, 105, 106, 107, 108, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, 89, + 90, 91, 92, 93, 94, 95, 96, 97, -1, -1, + -1, -1, 102, -1, -1, 105, 106, 107, 108 }; /* YYSTOS[STATE-NUM] -- The (internal number of the) accessing symbol of state STATE-NUM. */ static const yytype_uint8 yystos[] = { - 0, 3, 4, 5, 6, 7, 8, 9, 113, 114, - 115, 116, 117, 118, 119, 120, 0, 123, 10, 13, + 0, 3, 4, 5, 6, 7, 8, 9, 112, 113, + 114, 115, 116, 117, 118, 119, 0, 122, 10, 13, 16, 19, 20, 21, 24, 25, 26, 27, 28, 29, 30, 32, 33, 34, 35, 36, 37, 43, 44, 58, 61, 62, 63, 64, 65, 68, 69, 70, 71, 72, - 73, 74, 84, 99, 100, 102, 104, 105, 111, 174, - 175, 176, 179, 180, 181, 182, 183, 184, 185, 186, - 187, 188, 190, 193, 199, 200, 201, 202, 203, 204, - 205, 206, 207, 11, 121, 1, 22, 38, 40, 41, + 73, 74, 83, 98, 99, 101, 103, 104, 110, 173, + 174, 175, 178, 179, 180, 181, 182, 183, 184, 185, + 186, 187, 189, 192, 198, 199, 200, 201, 202, 203, + 204, 205, 206, 11, 120, 1, 22, 38, 40, 41, 42, 45, 46, 47, 48, 49, 50, 54, 55, 56, - 57, 60, 121, 130, 141, 174, 39, 128, 129, 130, - 126, 168, 169, 126, 26, 31, 121, 200, 208, 14, - 174, 208, 188, 208, 188, 208, 208, 208, 208, 189, - 13, 111, 188, 152, 152, 152, 188, 111, 111, 78, - 111, 121, 188, 26, 175, 192, 200, 208, 208, 121, - 188, 22, 174, 26, 31, 154, 188, 102, 111, 191, - 200, 201, 202, 188, 175, 188, 188, 188, 188, 188, - 110, 174, 81, 82, 83, 15, 11, 13, 111, 95, - 96, 95, 93, 94, 93, 59, 66, 67, 85, 86, + 57, 60, 120, 129, 140, 173, 39, 127, 128, 129, + 125, 167, 168, 125, 26, 31, 120, 199, 207, 14, + 173, 207, 187, 207, 187, 207, 207, 207, 207, 188, + 13, 110, 187, 151, 151, 151, 187, 110, 110, 78, + 110, 120, 187, 26, 174, 191, 199, 207, 207, 120, + 187, 22, 173, 26, 31, 153, 187, 101, 110, 190, + 199, 200, 201, 187, 174, 187, 187, 187, 187, 187, + 109, 173, 81, 82, 15, 11, 13, 110, 94, 95, + 94, 92, 93, 92, 59, 66, 67, 84, 85, 87, 88, 89, 90, 91, 92, 93, 94, 95, 96, 97, - 98, 103, 106, 107, 108, 109, 111, 11, 13, 11, - 13, 11, 13, 11, 123, 153, 154, 154, 26, 151, - 111, 111, 111, 111, 73, 102, 111, 198, 200, 111, - 111, 121, 22, 53, 143, 22, 47, 48, 49, 50, - 54, 56, 129, 130, 128, 16, 20, 24, 159, 160, - 162, 163, 164, 165, 14, 192, 111, 78, 174, 110, - 121, 29, 155, 75, 156, 110, 110, 174, 193, 193, - 208, 175, 12, 22, 192, 111, 188, 191, 200, 201, - 202, 110, 174, 75, 157, 13, 110, 174, 174, 174, - 188, 174, 174, 110, 174, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 10, 11, 13, 16, 20, 24, - 25, 27, 68, 111, 178, 200, 110, 174, 174, 174, - 174, 174, 174, 174, 174, 126, 26, 150, 151, 151, - 26, 133, 123, 123, 123, 123, 102, 123, 73, 196, - 197, 199, 200, 201, 202, 123, 123, 111, 123, 123, - 121, 140, 174, 147, 174, 140, 140, 140, 140, 31, - 158, 158, 15, 193, 175, 14, 177, 156, 29, 123, - 173, 110, 79, 110, 174, 12, 110, 174, 157, 110, - 29, 174, 13, 22, 14, 110, 87, 25, 174, 174, - 25, 25, 25, 25, 25, 110, 174, 111, 110, 22, - 14, 22, 14, 22, 14, 22, 12, 18, 122, 131, - 132, 11, 22, 26, 146, 174, 147, 148, 174, 148, - 195, 200, 111, 141, 145, 148, 149, 174, 196, 123, - 148, 148, 85, 161, 161, 163, 110, 23, 194, 192, - 123, 171, 111, 166, 167, 110, 110, 14, 174, 12, - 188, 22, 14, 110, 193, 12, 12, 12, 12, 123, - 155, 156, 123, 26, 110, 110, 110, 110, 111, 123, - 110, 22, 136, 148, 110, 110, 188, 174, 79, 11, - 168, 11, 14, 12, 110, 22, 156, 22, 172, 173, - 137, 192, 144, 144, 11, 124, 124, 148, 148, 124, - 134, 111, 110, 124, 124, 126, 110, 126, 77, 22, - 170, 171, 126, 22, 124, 124, 125, 51, 52, 142, - 142, 110, 110, 143, 146, 148, 124, 12, 12, 127, - 12, 143, 143, 126, 124, 111, 124, 124, 22, 110, - 143, 22, 29, 138, 12, 148, 143, 143, 135, 124, - 17, 76, 139, 110, 144, 143, 126, 124, 149, 77, - 142, 110, 124 + 102, 105, 106, 107, 108, 110, 11, 13, 11, 13, + 11, 13, 11, 122, 152, 153, 153, 26, 150, 110, + 110, 110, 110, 73, 101, 110, 197, 199, 110, 110, + 120, 22, 53, 142, 22, 47, 48, 49, 50, 54, + 56, 128, 129, 127, 16, 20, 24, 158, 159, 161, + 162, 163, 164, 14, 191, 110, 78, 173, 109, 120, + 29, 154, 75, 155, 109, 109, 173, 192, 192, 207, + 174, 12, 22, 191, 110, 187, 190, 199, 200, 201, + 109, 173, 75, 156, 13, 109, 173, 173, 187, 173, + 173, 109, 173, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 10, 11, 13, 16, 20, 24, 25, 27, + 68, 110, 177, 199, 109, 173, 173, 173, 173, 173, + 173, 173, 173, 125, 26, 149, 150, 150, 26, 132, + 122, 122, 122, 122, 101, 122, 73, 195, 196, 198, + 199, 200, 201, 122, 122, 110, 122, 122, 120, 139, + 173, 146, 173, 139, 139, 139, 139, 31, 157, 157, + 15, 192, 174, 14, 176, 155, 29, 122, 172, 109, + 79, 109, 173, 12, 109, 173, 156, 109, 29, 173, + 13, 22, 14, 109, 86, 25, 173, 173, 25, 25, + 25, 25, 25, 109, 173, 110, 109, 22, 14, 22, + 14, 22, 14, 22, 12, 18, 121, 130, 131, 11, + 22, 26, 145, 173, 146, 147, 173, 147, 194, 199, + 110, 140, 144, 147, 148, 173, 195, 122, 147, 147, + 84, 160, 160, 162, 109, 23, 193, 191, 122, 170, + 110, 165, 166, 109, 109, 14, 173, 12, 187, 22, + 14, 109, 192, 12, 12, 12, 12, 122, 154, 155, + 122, 26, 109, 109, 109, 109, 110, 122, 109, 22, + 135, 147, 109, 109, 187, 173, 79, 11, 167, 11, + 14, 12, 109, 22, 155, 22, 171, 172, 136, 191, + 143, 143, 11, 123, 123, 147, 147, 123, 133, 110, + 109, 123, 123, 125, 109, 125, 77, 22, 169, 170, + 125, 22, 123, 123, 124, 51, 52, 141, 141, 109, + 109, 142, 145, 147, 123, 12, 12, 126, 12, 142, + 142, 125, 123, 110, 123, 123, 22, 109, 142, 22, + 29, 137, 12, 147, 142, 142, 134, 123, 17, 76, + 138, 109, 143, 142, 125, 123, 148, 77, 141, 109, + 123 }; /* YYR1[YYN] -- Symbol number of symbol that rule YYN derives. */ static const yytype_uint8 yyr1[] = { - 0, 112, 114, 113, 115, 113, 116, 113, 117, 113, - 118, 113, 119, 113, 120, 113, 121, 122, 123, 124, - 125, 126, 126, 127, 127, 128, 128, 129, 129, 130, - 130, 131, 130, 132, 130, 130, 133, 130, 130, 130, - 130, 130, 130, 130, 130, 134, 135, 130, 130, 130, - 136, 130, 130, 130, 130, 137, 130, 130, 130, 130, - 138, 139, 139, 140, 141, 141, 141, 141, 141, 141, - 141, 141, 142, 142, 142, 143, 143, 144, 145, 145, - 146, 146, 147, 148, 149, 150, 150, 151, 152, 153, - 154, 154, 155, 155, 156, 156, 156, 157, 157, 158, - 158, 159, 159, 160, 161, 161, 161, 162, 163, 163, - 164, 164, 164, 165, 165, 166, 166, 167, 169, 168, - 170, 170, 171, 172, 172, 173, 174, 174, 174, 174, - 175, 175, 175, 176, 176, 176, 176, 176, 176, 176, - 176, 176, 177, 176, 178, 178, 179, 179, 179, 179, + 0, 111, 113, 112, 114, 112, 115, 112, 116, 112, + 117, 112, 118, 112, 119, 112, 120, 121, 122, 123, + 124, 125, 125, 126, 126, 127, 127, 128, 128, 129, + 129, 130, 129, 131, 129, 129, 132, 129, 129, 129, + 129, 129, 129, 129, 129, 133, 134, 129, 129, 129, + 135, 129, 129, 129, 129, 136, 129, 129, 129, 129, + 137, 138, 138, 139, 140, 140, 140, 140, 140, 140, + 140, 140, 141, 141, 141, 142, 142, 143, 144, 144, + 145, 145, 146, 147, 148, 149, 149, 150, 151, 152, + 153, 153, 154, 154, 155, 155, 155, 156, 156, 157, + 157, 158, 158, 159, 160, 160, 160, 161, 162, 162, + 163, 163, 163, 164, 164, 165, 165, 166, 168, 167, + 169, 169, 170, 171, 171, 172, 173, 173, 173, 174, + 174, 174, 175, 175, 175, 175, 175, 175, 175, 175, + 175, 176, 175, 177, 177, 178, 178, 178, 178, 178, + 178, 178, 178, 178, 178, 178, 178, 178, 178, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, 179, - 180, 180, 180, 180, 180, 180, 180, 180, 180, 180, - 180, 180, 180, 180, 181, 181, 181, 181, 182, 182, - 183, 183, 183, 183, 184, 184, 185, 185, 185, 185, - 185, 185, 185, 185, 185, 186, 186, 186, 186, 186, - 186, 187, 187, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 188, 188, 188, 188, 188, 188, 188, 188, - 188, 188, 189, 188, 188, 188, 188, 190, 190, 190, - 191, 191, 191, 191, 191, 192, 192, 193, 193, 194, - 194, 195, 196, 196, 196, 197, 197, 198, 198, 199, - 200, 201, 202, 203, 203, 204, 205, 205, 206, 206, - 207, 207, 208, 208, 208, 208 + 179, 179, 179, 180, 180, 180, 180, 181, 181, 182, + 182, 182, 182, 183, 183, 184, 184, 184, 184, 184, + 184, 184, 184, 184, 185, 185, 185, 185, 185, 185, + 186, 186, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 187, 187, 187, 187, 187, 187, 187, 187, 187, + 187, 188, 187, 187, 187, 187, 189, 189, 189, 190, + 190, 190, 190, 190, 191, 191, 192, 192, 193, 193, + 194, 195, 195, 195, 196, 196, 197, 197, 198, 199, + 200, 201, 202, 202, 203, 204, 204, 205, 205, 206, + 206, 207, 207, 207, 207 }; /* YYR2[YYN] -- Number of symbols on the right hand side of rule YYN. */ @@ -1092,24 +1090,24 @@ static const yytype_int8 yyr2[] = 1, 1, 0, 1, 0, 2, 1, 2, 1, 0, 1, 1, 1, 3, 0, 1, 2, 3, 1, 1, 2, 3, 1, 0, 1, 0, 1, 3, 0, 2, - 1, 1, 4, 1, 1, 5, 3, 3, 3, 1, - 2, 3, 1, 3, 5, 6, 3, 3, 5, 2, - 4, 4, 0, 5, 1, 1, 5, 4, 5, 4, - 5, 6, 5, 4, 5, 4, 3, 6, 4, 5, - 3, 3, 3, 3, 3, 1, 1, 3, 3, 3, - 3, 3, 3, 3, 1, 3, 2, 2, 3, 3, - 1, 3, 2, 2, 3, 3, 2, 2, 2, 2, - 2, 2, 2, 2, 2, 3, 2, 4, 3, 5, - 4, 2, 2, 1, 1, 1, 1, 5, 2, 3, - 1, 2, 3, 1, 2, 1, 1, 1, 1, 1, - 1, 4, 4, 5, 5, 1, 1, 3, 4, 3, - 4, 4, 4, 4, 4, 1, 2, 2, 1, 2, - 2, 1, 2, 1, 2, 1, 3, 1, 3, 1, - 3, 4, 0, 6, 1, 1, 1, 3, 2, 4, - 3, 2, 1, 1, 1, 0, 1, 0, 1, 0, - 2, 1, 1, 1, 1, 1, 1, 2, 2, 2, - 2, 2, 2, 2, 4, 2, 1, 3, 1, 3, - 1, 3, 1, 1, 1, 1 + 1, 1, 4, 1, 1, 5, 3, 3, 1, 2, + 3, 1, 3, 5, 6, 3, 3, 5, 2, 4, + 4, 0, 5, 1, 1, 5, 4, 5, 4, 5, + 6, 5, 4, 5, 4, 3, 6, 4, 5, 3, + 3, 3, 3, 3, 1, 1, 3, 3, 3, 3, + 3, 3, 3, 1, 3, 2, 2, 3, 3, 1, + 3, 2, 2, 3, 3, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 3, 2, 4, 3, 5, 4, + 2, 2, 1, 1, 1, 1, 5, 2, 3, 1, + 2, 3, 1, 2, 1, 1, 1, 1, 1, 1, + 4, 4, 5, 5, 1, 1, 3, 4, 3, 4, + 4, 4, 4, 4, 1, 2, 2, 1, 2, 2, + 1, 2, 1, 2, 1, 3, 1, 3, 1, 3, + 4, 0, 6, 1, 1, 1, 3, 2, 4, 3, + 2, 1, 1, 1, 0, 1, 0, 1, 0, 2, + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, + 2, 2, 2, 4, 2, 1, 3, 1, 3, 1, + 3, 1, 1, 1, 1 }; typedef enum { @@ -1135,7 +1133,7 @@ static const toketypes yy_type_tab[] = toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, - toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, + toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, toketype_ival, @@ -1158,6 +1156,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 125e373e186e1cf8e055f2faf0d9fa51818b4e2b7b6bfda0b1688f3da43b8c35 perly.y + * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index 75a942e03610..bd65eb44de4b 100644 --- a/perly.y +++ b/perly.y @@ -102,7 +102,7 @@ %nonassoc PREC_LOW %nonassoc LOOPEX -%left OROP DOROP +%left OROP %left ANDOP %right NOTOP %nonassoc LSTOP LSTOPSUB @@ -901,8 +901,6 @@ expr : expr[lhs] ANDOP expr[rhs] { $$ = newLOGOP(OP_AND, 0, $lhs, $rhs); } | expr[lhs] OROP[operator] expr[rhs] { $$ = newLOGOP($operator, 0, $lhs, $rhs); } - | expr[lhs] DOROP expr[rhs] - { $$ = newLOGOP(OP_DOR, 0, $lhs, $rhs); } | listexpr %prec PREC_LOW ; diff --git a/toke.c b/toke.c index 25fc46f49cc1..f4404bd8c850 100644 --- a/toke.c +++ b/toke.c @@ -353,7 +353,6 @@ static struct debug_tokens { { DO, TOKENTYPE_NONE, "DO" }, { DOLSHARP, TOKENTYPE_NONE, "DOLSHARP" }, { DORDOR, TOKENTYPE_NONE, "DORDOR" }, - { DOROP, TOKENTYPE_OPNUM, "DOROP" }, { DOTDOT, TOKENTYPE_IVAL, "DOTDOT" }, { ELSE, TOKENTYPE_NONE, "ELSE" }, { ELSIF, TOKENTYPE_IVAL, "ELSIF" }, From a410a50e809ed4d65dd48c5d9137ed5aa20354dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Branislav=20Zahradn=C3=ADk?= Date: Fri, 11 Dec 2020 17:19:22 +0100 Subject: [PATCH 347/503] Use explicit %empty --- perly.act | 4 ++-- perly.h | 2 +- perly.tab | 20 ++++++++++---------- perly.y | 46 +++++++++++++++++++++++----------------------- 4 files changed, 36 insertions(+), 36 deletions(-) diff --git a/perly.act b/perly.act index 41ca498c61e1..16abe6eb6bac 100644 --- a/perly.act +++ b/perly.act @@ -730,7 +730,7 @@ case 2: case 86: #line 605 "perly.y" - { (yyval.opval) = NULL; } + { (yyval.opval) = NULL; } break; @@ -2124,6 +2124,6 @@ case 2: /* Generated from: - * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y + * 9a5909b0af5f61f96907e330008f3cdc9dadcab1417c5bcb188cb3b9f6593c01 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.h b/perly.h index 550c5228f844..a9286314a980 100644 --- a/perly.h +++ b/perly.h @@ -215,6 +215,6 @@ int yyparse (void); /* Generated from: - * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y + * 9a5909b0af5f61f96907e330008f3cdc9dadcab1417c5bcb188cb3b9f6593c01 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.tab b/perly.tab index 3c1942e55e85..d615eb09d87a 100644 --- a/perly.tab +++ b/perly.tab @@ -74,17 +74,17 @@ static const yytype_int8 yytranslate[] = static const yytype_int16 yyrline[] = { 0, 137, 137, 136, 148, 147, 158, 157, 171, 170, - 184, 183, 197, 196, 207, 206, 219, 227, 235, 239, - 247, 253, 254, 264, 265, 274, 278, 282, 289, 299, + 184, 183, 197, 196, 207, 206, 219, 227, 234, 239, + 246, 252, 254, 263, 265, 274, 278, 282, 289, 299, 301, 314, 311, 335, 330, 351, 359, 358, 367, 373, 379, 384, 386, 388, 395, 403, 405, 402, 422, 427, 434, 433, 448, 456, 462, 469, 468, 483, 487, 492, - 500, 518, 519, 523, 527, 529, 531, 533, 535, 537, - 539, 542, 548, 549, 554, 565, 566, 572, 578, 579, - 584, 587, 591, 596, 600, 604, 605, 609, 615, 620, - 625, 626, 631, 632, 637, 638, 640, 645, 647, 659, - 660, 665, 667, 671, 691, 692, 694, 700, 765, 767, - 773, 775, 779, 785, 786, 791, 792, 796, 800, 800, + 500, 517, 519, 523, 527, 529, 531, 533, 535, 537, + 539, 542, 547, 549, 554, 564, 566, 571, 577, 579, + 583, 587, 591, 596, 600, 604, 605, 608, 614, 619, + 625, 626, 630, 632, 636, 638, 640, 645, 647, 658, + 660, 665, 667, 671, 690, 692, 694, 700, 765, 767, + 773, 775, 779, 784, 786, 790, 792, 796, 800, 800, 868, 869, 874, 885, 886, 889, 900, 902, 904, 908, 910, 915, 919, 923, 927, 933, 938, 944, 950, 952, 954, 957, 956, 967, 968, 972, 976, 979, 984, 989, @@ -99,7 +99,7 @@ static const yytype_int16 yyrline[] = 1251, 1253, 1255, 1258, 1260, 1263, 1265, 1267, 1269, 1271, 1273, 1275, 1277, 1279, 1282, 1284, 1286, 1288, 1290, 1292, 1296, 1299, 1298, 1311, 1312, 1313, 1317, 1319, 1321, 1326, - 1328, 1331, 1333, 1335, 1340, 1342, 1347, 1348, 1353, 1354, + 1328, 1331, 1333, 1335, 1340, 1342, 1346, 1348, 1352, 1354, 1360, 1364, 1365, 1366, 1369, 1370, 1373, 1374, 1377, 1381, 1385, 1391, 1397, 1399, 1403, 1407, 1408, 1412, 1413, 1417, 1418, 1423, 1425, 1427, 1430 @@ -1156,6 +1156,6 @@ static const toketypes yy_type_tab[] = }; /* Generated from: - * 8501134166a6baa08c401894156c496a30dbabab6b166ea837cd490b6db2e410 perly.y + * 9a5909b0af5f61f96907e330008f3cdc9dadcab1417c5bcb188cb3b9f6593c01 perly.y * acf1cbfd2545faeaaa58b1cf0cf9d7f98b5be0752eb7a54528ef904a9e2e1ca7 regen_perly.pl * ex: set ro: */ diff --git a/perly.y b/perly.y index bd65eb44de4b..8e3630b58142 100644 --- a/perly.y +++ b/perly.y @@ -231,7 +231,7 @@ formblock: PERLY_EQUAL_SIGN remember PERLY_SEMICOLON FORMRBRACK formstmtseq PERL } ; -remember: /* NULL */ /* start a full lexical scope */ +remember: %empty /* start a full lexical scope */ { $$ = block_start(TRUE); parser->parsed_sub = 0; } ; @@ -243,13 +243,13 @@ mblock : PERLY_BRACE_OPEN mremember stmtseq PERLY_BRACE_CLOSE } ; -mremember: /* NULL */ /* start a partial lexical scope */ +mremember: %empty /* start a partial lexical scope */ { $$ = block_start(FALSE); parser->parsed_sub = 0; } ; /* A sequence of statements in the program */ -stmtseq : /* NULL */ +stmtseq : %empty { $$ = NULL; } | stmtseq[list] fullstmt { $$ = op_append_list(OP_LINESEQ, $list, $fullstmt); @@ -260,7 +260,7 @@ stmtseq : /* NULL */ ; /* A sequence of format lines */ -formstmtseq: /* NULL */ +formstmtseq: %empty { $$ = NULL; } | formstmtseq[list] formline { $$ = op_append_list(OP_LINESEQ, $list, $formline); @@ -514,7 +514,7 @@ formline: THING formarg } ; -formarg : /* NULL */ +formarg : %empty { $$ = NULL; } | FORMLBRACK stmtseq FORMRBRACK { $$ = op_unscope($stmtseq); } @@ -544,7 +544,7 @@ sideff : error ; /* else and elsif blocks */ -else : /* NULL */ +else : %empty { $$ = NULL; } | ELSE mblock { @@ -561,26 +561,26 @@ else : /* NULL */ ; /* Continue blocks */ -cont : /* NULL */ +cont : %empty { $$ = NULL; } | CONTINUE block { $$ = op_scope($block); } ; /* determine whether there are any new my declarations */ -mintro : /* NULL */ +mintro : %empty { $$ = (PL_min_intro_pending && PL_max_intro_pending >= PL_min_intro_pending); intro_my(); } /* Normal expression */ -nexpr : /* NULL */ +nexpr : %empty { $$ = NULL; } | sideff ; /* Boolean expression */ -texpr : /* NULL means true */ +texpr : %empty /* NULL means true */ { YYSTYPE tmplval; (void)scan_num("1", &tmplval); $$ = tmplval.opval; } @@ -602,21 +602,21 @@ mnexpr : nexpr ; formname: BAREWORD { $$ = $BAREWORD; } - | /* NULL */ { $$ = NULL; } + | %empty { $$ = NULL; } ; -startsub: /* NULL */ /* start a regular subroutine scope */ +startsub: %empty /* start a regular subroutine scope */ { $$ = start_subparse(FALSE, 0); SAVEFREESV(PL_compcv); } ; -startanonsub: /* NULL */ /* start an anonymous subroutine scope */ +startanonsub: %empty /* start an anonymous subroutine scope */ { $$ = start_subparse(FALSE, CVf_ANON); SAVEFREESV(PL_compcv); } ; -startformsub: /* NULL */ /* start a format subroutine scope */ +startformsub: %empty /* start a format subroutine scope */ { $$ = start_subparse(TRUE, 0); SAVEFREESV(PL_compcv); } ; @@ -627,13 +627,13 @@ subname : BAREWORD ; /* Subroutine prototype */ -proto : /* NULL */ +proto : %empty { $$ = NULL; } | THING ; /* Optional list of subroutine attributes */ -subattrlist: /* NULL */ +subattrlist: %empty { $$ = NULL; } | COLONATTR THING { $$ = $THING; } @@ -655,7 +655,7 @@ myattrlist: COLONATTR THING */ /* the '' or 'foo' part of a '$' or '@foo' etc signature variable */ -sigvarname: /* NULL */ +sigvarname: %empty { parser->in_my = 0; $$ = NULL; } | PRIVATEREF { parser->in_my = 0; $$ = $PRIVATEREF; } @@ -687,7 +687,7 @@ sigslurpelem: sigslurpsigil sigvarname sigdefault/* def only to catch errors */ ; /* default part of sub signature scalar element: i.e. '= default_expr' */ -sigdefault: /* NULL */ +sigdefault: %empty { $$ = NULL; } | ASSIGNOP { $$ = newOP(OP_NULL, 0); } @@ -781,13 +781,13 @@ siglist: ; /* () or (....) */ -siglistornull: /* NULL */ +siglistornull: %empty { $$ = NULL; } | siglist { $$ = $siglist; } /* optional subroutine signature */ -optsubsignature: /* NULL */ +optsubsignature: %empty { $$ = NULL; } | subsignature { $$ = $subsignature; } @@ -1337,19 +1337,19 @@ myterm : PERLY_PAREN_OPEN expr PERLY_PAREN_CLOSE ; /* Basic list expressions */ -optlistexpr: /* NULL */ %prec PREC_LOW +optlistexpr: %empty %prec PREC_LOW { $$ = NULL; } | listexpr %prec PREC_LOW { $$ = $listexpr; } ; -optexpr: /* NULL */ +optexpr: %empty { $$ = NULL; } | expr { $$ = $expr; } ; -optrepl: /* NULL */ +optrepl: %empty { $$ = NULL; } | PERLY_SLASH expr { $$ = $expr; } From 837781cc8ee9bae7551c730bec6b89449af033dc Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 06:52:08 -0600 Subject: [PATCH 348/503] perlapi: Document line_t --- handy.h | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/handy.h b/handy.h index f0a2a3cb75c2..27c6edb1e2ec 100644 --- a/handy.h +++ b/handy.h @@ -2429,7 +2429,14 @@ END_EXTERN_C : (LATIN1_TO_NATIVE(((U8) (c)) ^ 64))))) #endif -/* Line numbers are unsigned, 32 bits. */ +/* +=for apidoc Ay||line_t +The typedef to use to declare variables that are to hold line numbers. + +=cut + + Line numbers are unsigned, 32 bits. +*/ typedef U32 line_t; #define NOLINE ((line_t) 4294967295UL) /* = FFFFFFFF */ From b1decff385f198a18c063aa3815c47f77440aab6 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 09:11:23 -0600 Subject: [PATCH 349/503] Document gv_fetchfile(_flags)? --- embed.fnc | 4 ++-- gv.c | 21 +++++++++++++++++++++ 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/embed.fnc b/embed.fnc index f0078bff5579..c7bdfdaf4af2 100644 --- a/embed.fnc +++ b/embed.fnc @@ -951,8 +951,8 @@ Cp |void |gv_check |NN HV* stash AbpD |void |gv_efullname |NN SV* sv|NN const GV* gv ApMb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain -Ap |GV* |gv_fetchfile |NN const char* name -Ap |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\ +Adp |GV* |gv_fetchfile |NN const char* name +Adp |GV* |gv_fetchfile_flags|NN const char *const name|const STRLEN len\ |const U32 flags Amd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name \ |STRLEN len|I32 level diff --git a/gv.c b/gv.c index e849d0fe474c..d7048248c250 100644 --- a/gv.c +++ b/gv.c @@ -92,6 +92,27 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) return gv; } +/* +=for apidoc gv_fetchfile +=for apidoc_item gv_fetchfile_flags + +These return the debugger glob for the file (compiled by Perl) whose name is +given by the C parameter. + +There are currently exactly two differences between these functions. + +The C parameter to C is a C string, meaning it is +C-terminated; whereas the C parameter to C is a +Perl string, whose length (in bytes) is passed in via the C parameter +This means the name may contain embedded C characters. +C doesn't exist in plain C). + +The other difference is that C has an extra C +parameter, which is currently completely ignored, but allows for possible +future extensions. + +=cut +*/ GV * Perl_gv_fetchfile(pTHX_ const char *name) { From 340e526363979e280a7f5786a1249ada130b8a93 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 09:40:53 -0600 Subject: [PATCH 350/503] Document safesys...alloc fcns; safesysfree --- embed.fnc | 8 ++++---- util.c | 29 +++++++++++++++++++++++++---- 2 files changed, 29 insertions(+), 8 deletions(-) diff --git a/embed.fnc b/embed.fnc index c7bdfdaf4af2..c187f27dd08a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2648,10 +2648,10 @@ S |int |yywarn |NN const char *const s|U32 flags Ap |void |dump_mstats |NN const char* s Ap |int |get_mstats |NN perl_mstats_t *buf|int buflen|int level #endif -ATpa |Malloc_t|safesysmalloc |MEM_SIZE nbytes -ATpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size -ATpR |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes -ATp |Free_t |safesysfree |Malloc_t where +ATdpa |Malloc_t|safesysmalloc |MEM_SIZE nbytes +ATdpa |Malloc_t|safesyscalloc |MEM_SIZE elements|MEM_SIZE size +ATdpR |Malloc_t|safesysrealloc|Malloc_t where|MEM_SIZE nbytes +AdTp |Free_t |safesysfree |Malloc_t where CrTp |void |croak_memory_wrap Cp |int |runops_standard Cp |int |runops_debug diff --git a/util.c b/util.c index e4e194cdb230..dd971f5ebfed 100644 --- a/util.c +++ b/util.c @@ -123,7 +123,13 @@ S_maybe_protect_ro(pTHX_ struct perl_memory_debug_header *header) # endif #endif -/* paranoid version of system's malloc() */ +/* +=for apidoc_section $memory +=for apidoc safesysmalloc +Paranoid version of system's malloc() + +=cut +*/ Malloc_t Perl_safesysmalloc(MEM_SIZE size) @@ -207,7 +213,12 @@ Perl_safesysmalloc(MEM_SIZE size) return ptr; } -/* paranoid version of system's realloc() */ +/* +=for apidoc safesysrealloc +Paranoid version of system's realloc() + +=cut +*/ Malloc_t Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) @@ -336,7 +347,12 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) return ptr; } -/* safe version of system's free() */ +/* +=for apidoc safesysfree +Safe version of system's free() + +=cut +*/ Free_t Perl_safesysfree(Malloc_t where) @@ -401,7 +417,12 @@ Perl_safesysfree(Malloc_t where) } } -/* safe version of system's calloc() */ +/* +=for apidoc safesyscalloc +Safe version of system's calloc() + +=cut +*/ Malloc_t Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) From 1d440ec4903d5548d4d83f3e1d3547bbd528ae6f Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 09:18:53 -0600 Subject: [PATCH 351/503] Document gv_autoload4 --- embed.fnc | 2 +- gv.h | 7 +++++++ 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/embed.fnc b/embed.fnc index c187f27dd08a..e60536969edd 100644 --- a/embed.fnc +++ b/embed.fnc @@ -940,7 +940,7 @@ Ap |GV* |gv_add_by_type |NULLOK GV *gv|svtype type ApMb |GV* |gv_AVadd |NULLOK GV *gv ApMb |GV* |gv_HVadd |NULLOK GV *gv ApMb |GV* |gv_IOadd |NULLOK GV* gv -AmR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name \ +AdmR |GV* |gv_autoload4 |NULLOK HV* stash|NN const char* name \ |STRLEN len|I32 method ApR |GV* |gv_autoload_sv |NULLOK HV* stash|NN SV* namesv|U32 flags ApR |GV* |gv_autoload_pv |NULLOK HV* stash|NN const char* namepv \ diff --git a/gv.h b/gv.h index 6ac99814f6c2..2589b53ac760 100644 --- a/gv.h +++ b/gv.h @@ -269,6 +269,13 @@ Return the CV from the GV. #define gv_fetchmeth(stash,name,len,level) gv_fetchmeth_pvn(stash, name, len, level, 0) #define gv_fetchmeth_autoload(stash,name,len,level) gv_fetchmeth_pvn_autoload(stash, name, len, level, 0) #define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags) + +/* +=for apidoc gv_autoload4 +Equivalent to C>. + +=cut +*/ #define gv_autoload4(stash, name, len, autoload) \ gv_autoload_pvn(stash, name, len, !!(autoload)) #define newGVgen(pack) newGVgen_flags(pack, 0) From cbcd1db37b0359885fc7985026f88e9af3f368c3 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 27 Dec 2020 10:26:57 -0700 Subject: [PATCH 352/503] perlapi: Two references aren't yet links This was causing a podcheck error --- sv.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sv.h b/sv.h index 3bddfeffe9e9..9d11270af548 100644 --- a/sv.h +++ b/sv.h @@ -1388,8 +1388,8 @@ object type. Exposed to perl code via Internals::SvREADONLY(). Low level micro optimization of C>. It is generally better to use C instead. This is because C ignores potential issues that C handles. C needs to have a real C that is unencombered by -things like COW. Using C> or -C> before calling this should clean it up, but +things like COW. Using C or +C before calling this should clean it up, but why not just use C if you're not sure about the provenance? =cut From ae2473a79f9993cdc7ce3bbe67a497c9258d987b Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Sun, 27 Dec 2020 21:42:59 +0900 Subject: [PATCH 353/503] POSIX.xs: Use Perl_signbit unconditionally for POSIX::signbit(). Previously POSIX::signbit() had a fallback implementation for the case Perl_signbit is not defined, but this is apparently broken because it returns wrongly non-zero (true) value for signbit(+0.0). Currently Perl_signbit is always defined (either as a macro or as a function), so it can be used unconditionally. Additionally, unused macro c99_signbit is deleted, which is also apparently broken because there is no signbitl() in C99. --- ext/POSIX/POSIX.xs | 21 ++------------------- 1 file changed, 2 insertions(+), 19 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 60c7fd2c7402..83f2875db316 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -280,7 +280,7 @@ static int not_here(const char *s); # define c99_rint rintq # define c99_round roundq # define c99_scalbn scalbnq -# define c99_signbit signbitq +/* We already define Perl_signbit to signbitq in perl.h. */ # define c99_tgamma tgammaq # define c99_trunc truncq # define bessel_j0 j0q @@ -331,9 +331,7 @@ static int not_here(const char *s); # define c99_rint rintl # define c99_round roundl # define c99_scalbn scalbnl -# ifdef HAS_SIGNBIT /* possibly bad assumption */ -# define c99_signbit signbitl -# endif +/* We already define Perl_signbit in perl.h. */ # define c99_tgamma tgammal # define c99_trunc truncl #else @@ -376,9 +374,6 @@ static int not_here(const char *s); # define c99_round round # define c99_scalbn scalbn /* We already define Perl_signbit in perl.h. */ -# ifdef HAS_SIGNBIT -# define c99_signbit signbit -# endif # define c99_tgamma tgamma # define c99_trunc trunc #endif @@ -578,9 +573,6 @@ static int not_here(const char *s); #ifndef HAS_SCALBN # undef c99_scalbn #endif -#ifndef HAS_SIGNBIT -# undef c99_signbit -#endif #ifndef HAS_TGAMMA # undef c99_tgamma #endif @@ -2626,16 +2618,7 @@ fpclassify(x) break; case 8: default: -#ifdef Perl_signbit RETVAL = Perl_signbit(x); -#else - RETVAL = (x < 0); -#ifdef DOUBLE_IS_IEEE_FORMAT - if (x == -0.0) { - RETVAL = TRUE; - } -#endif -#endif break; } OUTPUT: From a6f530a0b574fb28104e14e5aea6489caa8c1fe8 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 21 Dec 2020 15:17:18 -0500 Subject: [PATCH 354/503] lib/B/Deparse-core.t: Tidy leading whitespace The loops-within-loops structure of this program means that irregular leading whitespace makes it difficult to follow the control flow. Convert leading tabs to whitespace. Rebreak some lines to show structure of nested ternaries more clearly. Join short lines in a couple of instances. --- lib/B/Deparse-core.t | 183 ++++++++++++++++++++++--------------------- 1 file changed, 93 insertions(+), 90 deletions(-) diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t index 80dbc052153b..deffaf7f8fe3 100644 --- a/lib/B/Deparse-core.t +++ b/lib/B/Deparse-core.t @@ -60,51 +60,49 @@ sub testit { # lex=1: my ($a,$b); () = foo($a,$b,$c) # lex=2: () = foo(my $a,$b,$c) for my $lex (0, 1, 2) { - if ($lex) { - next if $keyword =~ /local|our|state|my/; - } - my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n " : ""; - - if ($lex == 2) { - my $repl = 'my $a'; - if ($expr =~ 'CORE::do') { - # do foo() is a syntax error, so B::Deparse emits - # do (foo()), but does not distinguish between foo and my, - # because it is too complicated. - $repl = '(my $a)'; - } - s/\$a/$repl/ for $expr, $expected_expr; - } - - my $desc = "$keyword: lex=$lex $expr => $expected_expr"; - $desc .= " (lex sub)" if $lexsub; + if ($lex) { + next if $keyword =~ /local|our|state|my/; + } + my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n " : ""; + + if ($lex == 2) { + my $repl = 'my $a'; + if ($expr =~ 'CORE::do') { + # do foo() is a syntax error, so B::Deparse emits + # do (foo()), but does not distinguish between foo and my, + # because it is too complicated. + $repl = '(my $a)'; + } + s/\$a/$repl/ for $expr, $expected_expr; + } + + my $desc = "$keyword: lex=$lex $expr => $expected_expr"; + $desc .= " (lex sub)" if $lexsub; my $code; - my $code_ref; - if ($lexsub) { - package lexsubtest; - no warnings 'experimental::lexical_subs', 'experimental::isa'; - use feature 'lexical_subs'; - no strict 'vars'; + my $code_ref; + if ($lexsub) { + package lexsubtest; + no warnings 'experimental::lexical_subs', 'experimental::isa'; + use feature 'lexical_subs'; + no strict 'vars'; $code = "sub { state sub $keyword; ${vars}() = $expr }"; - $code = "use feature 'isa';\n$code" if $keyword eq "isa"; - $code_ref = eval $code - or die "$@ in $expr"; - } - else { - package test; - no warnings 'experimental::isa'; - use subs (); - import subs $keyword; - $code = "no strict 'vars'; sub { ${vars}() = $expr }"; - $code = "use feature 'isa';\n$code" if $keyword eq "isa"; - $code_ref = eval $code - or die "$@ in $expr"; - } - - my $got_text = $deparse->coderef2text($code_ref); - - unless ($got_text =~ / + $code = "use feature 'isa';\n$code" if $keyword eq "isa"; + $code_ref = eval $code or die "$@ in $expr"; + } + else { + package test; + no warnings 'experimental::isa'; + use subs (); + import subs $keyword; + $code = "no strict 'vars'; sub { ${vars}() = $expr }"; + $code = "use feature 'isa';\n$code" if $keyword eq "isa"; + $code_ref = eval $code or die "$@ in $expr"; + } + + my $got_text = $deparse->coderef2text($code_ref); + + unless ($got_text =~ / package (?:lexsub)?test; (?: BEGIN \{\$\{\^WARNING_BITS\} = "[^"]+"\} )? use strict 'refs', 'subs'; @@ -112,14 +110,14 @@ sub testit { (?: (?:CORE::)?state sub \w+; )? \Q$vars\E\(\) = (.*) \}/s) { - ::fail($desc); - ::diag("couldn't extract line from boilerplate\n"); - ::diag($got_text); - return; - } - - my $got_expr = $1; - is $got_expr, $expected_expr, $desc + ::fail($desc); + ::diag("couldn't extract line from boilerplate\n"); + ::diag($got_text); + return; + } + + my $got_expr = $1; + is $got_expr, $expected_expr, $desc or ::diag("ORIGINAL CODE:\n$code");; } } @@ -149,17 +147,17 @@ sub do_infix_keyword { testit $keyword, "(\$a CORE::$keyword \$b)", $exp, 1; testit $keyword, "(\$a $keyword \$b)", $exp, 1; if (!$strong) { - # B::Deparse fully qualifies any sub whose name is a keyword, - # imported or not, since the importedness may not be reproduced by - # the deparsed code. x is special. - my $pre = "test::" x ($keyword ne 'x'); - testit $keyword, "$keyword(\$a, \$b)", "$pre$keyword(\$a, \$b);"; + # B::Deparse fully qualifies any sub whose name is a keyword, + # imported or not, since the importedness may not be reproduced by + # the deparsed code. x is special. + my $pre = "test::" x ($keyword ne 'x'); + testit $keyword, "$keyword(\$a, \$b)", "$pre$keyword(\$a, \$b);"; } testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1; } # test a keyword that is a standard op/function, like 'index(...)'. -# narg - how many args to test it with +# $narg - how many args to test it with # $parens - "foo $a, $b" is deparsed as "foo($a, $b)" # $dollar - an extra '$_' arg will appear in the deparsed output # $strong - keyword is strong @@ -171,30 +169,35 @@ sub do_std_keyword { $SEEN_STRENGTH{$keyword} = $strong; for my $core (0,1) { # if true, add CORE:: to keyword being deparsed - for my $lexsub (0,1) { # if true, define lex sub - my @code; - for my $do_exp(0, 1) { # first create expr, then expected-expr - my @args = map "\$$_", (undef,"a".."z")[1..$narg]; - push @args, '$_' - if $dollar && $do_exp && ($strong && !$lexsub or $core); - my $args = join(', ', @args); - # XXX $lex_parens is temporary, until lex subs are - # deparsed properly. - my $lex_parens = - !$core && $do_exp && $lexsub && $keyword ne 'map'; - $args = ((!$core && !$strong) || $parens || $lex_parens) - ? "($args)" - : @args ? " $args" : ""; - push @code, (($core && !($do_exp && $strong)) - ? "CORE::" - : $lexsub && $do_exp - ? "CORE::" x $core - : $do_exp && !$core && !$strong ? "test::" : "") - . "$keyword$args;"; - } - # code[0]: to run; code[1]: expected - testit $keyword, @code, $lexsub; - } + for my $lexsub (0,1) { # if true, define lex sub + my @code; + for my $do_exp(0, 1) { # first create expr, then expected-expr + my @args = map "\$$_", (undef,"a".."z")[1..$narg]; + push @args, '$_' + if $dollar && $do_exp && ($strong && !$lexsub or $core); + my $args = join(', ', @args); + # XXX $lex_parens is temporary, until lex subs are + # deparsed properly. + my $lex_parens = + !$core && $do_exp && $lexsub && $keyword ne 'map'; + $args = ((!$core && !$strong) || $parens || $lex_parens) + ? "($args)" + : @args + ? " $args" + : ""; + push @code, ( + ($core && !($do_exp && $strong)) + ? "CORE::" + : $lexsub && $do_exp + ? "CORE::" x $core + : $do_exp && !$core && !$strong + ? "test::" + : "" + ) . "$keyword$args;"; + } + # code[0]: to run; code[1]: expected + testit $keyword, @code, $lexsub; + } } } @@ -217,18 +220,18 @@ while () { die "unrecognised flag(s): '$flags'" unless $flags =~ /^-?$/; if ($args eq 'B') { # binary infix - die "$keyword: binary (B) op can't have '\$' flag\\n" if $dollar; - die "$keyword: binary (B) op can't have '1' flag\\n" if $invert1; - do_infix_keyword($keyword, $parens, $strong); + die "$keyword: binary (B) op can't have '\$' flag\\n" if $dollar; + die "$keyword: binary (B) op can't have '1' flag\\n" if $invert1; + do_infix_keyword($keyword, $parens, $strong); } else { - my @narg = split //, $args; - for my $n (0..$#narg) { - my $narg = $narg[$n]; - my $p = $parens; - $p = !$p if ($n == 0 && $invert1); - do_std_keyword($keyword, $narg, $p, (!$n && $dollar), $strong); - } + my @narg = split //, $args; + for my $n (0..$#narg) { + my $narg = $narg[$n]; + my $p = $parens; + $p = !$p if ($n == 0 && $invert1); + do_std_keyword($keyword, $narg, $p, (!$n && $dollar), $strong); + } } } From 9998efdc54c2deeabcd196f1c77f052833d28b3b Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 21 Dec 2020 15:26:37 -0500 Subject: [PATCH 355/503] Avoid indirect object notation Small touch-ups to inline documentation. Shorten spelling of one nested 'if' block. --- lib/B/Deparse-core.t | 22 ++++++++-------------- 1 file changed, 8 insertions(+), 14 deletions(-) diff --git a/lib/B/Deparse-core.t b/lib/B/Deparse-core.t index deffaf7f8fe3..cdbd27ce5e42 100644 --- a/lib/B/Deparse-core.t +++ b/lib/B/Deparse-core.t @@ -41,13 +41,15 @@ plan tests => 3904; use feature (sprintf(":%vd", $^V)); # to avoid relying on the feature # logic to add CORE:: use B::Deparse; -my $deparse = new B::Deparse; +my $deparse = B::Deparse->new(); my %SEEN; my %SEEN_STRENGTH; -# for a given keyword, create a sub of that name, then -# deparse "() = $expr", and see if it matches $expected_expr +# For a given keyword, create a sub of that name, +# then deparse 3 different assignment expressions +# using that keyword. See if the $expr we get back +# matches $expected_expr. sub testit { my ($keyword, $expr, $expected_expr, $lexsub) = @_; @@ -55,14 +57,11 @@ sub testit { $expected_expr //= $expr; $SEEN{$keyword} = 1; - # lex=0: () = foo($a,$b,$c) # lex=1: my ($a,$b); () = foo($a,$b,$c) # lex=2: () = foo(my $a,$b,$c) for my $lex (0, 1, 2) { - if ($lex) { - next if $keyword =~ /local|our|state|my/; - } + next if ($lex and $keyword =~ /local|our|state|my/); my $vars = $lex == 1 ? 'my($a, $b, $c, $d, $e);' . "\n " : ""; if ($lex == 2) { @@ -126,8 +125,7 @@ sub testit { # Deparse can't distinguish 'and' from '&&' etc my %infix_map = qw(and && or ||); - -# test a keyword that is a binary infix operator, like 'cmp'. +# Test a keyword that is a binary infix operator, like 'cmp'. # $parens - "$a op $b" is deparsed as "($a op $b)" # $strong - keyword is strong @@ -156,7 +154,7 @@ sub do_infix_keyword { testit $keyword, "$keyword(\$a, \$b)", "$keyword(\$a, \$b);", 1; } -# test a keyword that is a standard op/function, like 'index(...)'. +# Test a keyword that is a standard op/function, like 'index(...)'. # $narg - how many args to test it with # $parens - "foo $a, $b" is deparsed as "foo($a, $b)" # $dollar - an extra '$_' arg will appear in the deparsed output @@ -391,8 +389,6 @@ my %not_tested = map { $_ => 1} qw( y ); - - # Sanity check against keyword data: # make sure we haven't missed any keywords, # and that we got the strength right. @@ -434,8 +430,6 @@ SKIP: ok($pass, "sanity checks"); } - - __DATA__ # # format: From ec8faddea92f3f0c23233b57a34f11b94391762f Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 19 Dec 2020 19:10:41 -0500 Subject: [PATCH 356/503] pod/buildtoc: documentation in POD format In partial satisfaction of https://github.com/Perl/perl5/issues/18413 --- pod/buildtoc | 38 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) diff --git a/pod/buildtoc b/pod/buildtoc index 004a726a0fb0..c846d994b3ff 100644 --- a/pod/buildtoc +++ b/pod/buildtoc @@ -275,4 +275,42 @@ sub unitem { $initem = 0; } +=head1 NAME + +pod/buildtoc - Generate table of contents + +=head1 DESCRIPTION + +This program generates a table of contents for the documentation included in the Perl core distribution. This table of contents takes two forms: + +=over 4 + +=item 1 F + +A file in Perl's Plain Old Documentation (POD) format found in the F directory in the core distribution. Once Perl is installed, this file becomes accessible system-wide via C. + +=item 2 F + +A shell script originally written by Tom Christiansen and Raphael Manfredi, also found in the F directory, which can be used to translate Perl documentation into F pages. + +=back + +=head1 USAGE + +This program will typically B need to be called directly by a user. Rather, it is one of the last commands invoked during C: + + ./perl -Ilib -I. -f pod/buildtoc -q + +The only command-line switch is C<-q|--quiet>, which quiets some non-critical warnings. + +=head2 Diagnosing Problems + +This program Cs F and makes use of several subroutines found in that file: C and C in particular. Consequently, any warnings or exceptions you see when this program is running may be being passed through from those subroutines. You may have to (a) examine those subroutines and/or (b) run that program from the command-line to fully understand what is causing such warnings or exceptions. + +=head2 AUTHORS and MAINTENANCE + +This program was introduced into the Perl 5 core distribution by Andy Dougherty, based on earlier work by Tom Christiansen. It is maintained by the Perl 5 Porters. + +=cut + # ex: set ts=8 sts=4 sw=4 et: From cfc95b5630c63927ab68bb4cdc08b1dec23c5569 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Wed, 21 Oct 2020 10:52:11 +1100 Subject: [PATCH 357/503] Configure - test that gcvt/qgcvt are not buggy (Issue 18170) --- Configure | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/Configure b/Configure index 90ea4bd55249..2d2f22fc082a 100755 --- a/Configure +++ b/Configure @@ -10374,6 +10374,15 @@ void checkit(const char *expect, char *got) } } +void lencheck(int expect, int got) +{ + if (expect != got) { + printf("%s length mismatch: Expected %d, got %d\n", + myname, expect, got); + exit(1); + } +} + int main() { char buf[64]; @@ -10446,6 +10455,12 @@ int main() else checkit("1e+34", buf); + /* Test for an Ubuntu/Debian bug in gcvt and qgcvt. See: * + * https://bugs.launchpad.net/ubuntu/+source/glibc/+bug/1899553 */ + + Gconvert((DOUBLETYPE)0.4, 53, 0, buf); + lencheck(55, (int)strlen(buf)); + /* For Perl, if you add additional tests here, also add them to * t/base/num.t for benefit of platforms not using Configure or * overriding d_Gconvert */ From 760f7304f745da0fc8198aee516dd0e583bd59d6 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Wed, 21 Oct 2020 10:52:53 +1100 Subject: [PATCH 358/503] sv.c - suppress bogus -Wformat-overflow warnings (Issue 18170) --- sv.c | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/sv.c b/sv.c index 682656f63052..ed0b6bdd30ee 100644 --- a/sv.c +++ b/sv.c @@ -13058,10 +13058,15 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV *const sv, const char *const pat, const STRLEN p && precis /* See earlier comment about buggy Gconvert when digits, aka precis, is 0 */ && has_precis - /* check, in manner not involving wrapping, that it will - * fit in ebuf */ - && float_need < sizeof(ebuf) + /* check that "%.g" formatting will fit in ebuf */ && sizeof(ebuf) - float_need > precis + /* sizeof(ebuf) - float_need will have wrapped if float_need > sizeof(ebuf). * + * Therefore we should check that float_need < sizeof(ebuf). Normally, we would * + * have run this check first, but that triggers incorrect -Wformat-overflow * + * compilation warnings with some versions of gcc if Gconvert invokes sprintf(). * + * ( See: https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89161 ) * + * So, instead, we check it next: */ + && float_need < sizeof(ebuf) && !(width || left || plus || alt) && !fill && intsize != 'q' From d8629936fe90863e11d1afdce1a0758ffeb2bc92 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Wed, 21 Oct 2020 10:53:38 +1100 Subject: [PATCH 359/503] t/op/sprintf2.t - append new test (Issue 18170) --- t/op/sprintf2.t | 40 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index 38a550c2816f..b1996e70cc0b 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -1178,4 +1178,44 @@ if ($Config{intsize} == 4 && $Config{uvsize} > 4 && $Config{sizesize} > 4) { is($off2, 1, "offset after 0"); } +# %g formatting was broken on Ubuntu, Debian and perhaps other systems +# for a long time. Here we verify that no such breakage still exists. +# See https://github.com/Perl/perl5/issues/18170 + +if($Config{nvsize} == 8) { + # double or 8-byte long double + TODO: { + local $::TODO = 'Extended precision %g formatting' if $^O eq 'cygwin' + or + ($^O eq 'MSWin32' and + $Config{cc} eq 'cl' and + $Config{ccversion} =~ /^(\d+)/ and + $1 < 19); + + cmp_ok(sprintf("%.54g", 0.3), 'eq', '0.299999999999999988897769753748434595763683319091796875', + "sprintf( \"%.54g\", 0.3 ) renders correctly"); + } +} +elsif($Config{nvtype} eq 'long double' && ($Config{longdblkind} == 3 || $Config{longdblkind} == 4)) { + # 80-bit extended precision long double + TODO: { + local $::TODO = 'Extended precision %g formatting' if $^O eq 'cygwin'; + + cmp_ok(sprintf("%.64g", 0.3), 'eq', '0.3000000000000000000108420217248550443400745280086994171142578125', + "sprintf( \"%.64g\", 0.3 ) renders correctly"); + } +} +elsif($Config{nvtype} eq 'long double' && $Config{longdblkind} >= 5 && $Config{longdblkind} <= 8) { + # double-double + cmp_ok(sprintf("%.108g", 0.1), 'eq', + '0.0999999999999999999999999999999996918512088980422635110435291864116290339037362855378887616097927093505859375', + "sprintf( \"%.108g\", 0.1 ) renders correctly"); +} +else { + # IEEE-754 128-bit long double or __float128 + cmp_ok(sprintf("%.115g", 0.3), 'eq', + '0.299999999999999999999999999999999990370350278063820734720110287075363407309491758923059023800306022167205810546875', + "sprintf( \"%.115g\", 0.3 ) renders correctly"); +} + done_testing(); From e7d8ad4273f0519fd9a560584aa85fc9f5a2732d Mon Sep 17 00:00:00 2001 From: sisyphus Date: Wed, 21 Oct 2020 10:54:22 +1100 Subject: [PATCH 360/503] APItest.xs - suppress valid -Wformat-overflow warning (Issue 18170) --- ext/XS-APItest/APItest.pm | 2 +- ext/XS-APItest/APItest.xs | 15 +++++++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/ext/XS-APItest/APItest.pm b/ext/XS-APItest/APItest.pm index eda042ec0e8f..9ee0f7125853 100644 --- a/ext/XS-APItest/APItest.pm +++ b/ext/XS-APItest/APItest.pm @@ -5,7 +5,7 @@ use strict; use warnings; use Carp; -our $VERSION = '1.14'; +our $VERSION = '1.15'; require XSLoader; diff --git a/ext/XS-APItest/APItest.xs b/ext/XS-APItest/APItest.xs index acfbe22a5ce9..c4f7d4462593 100644 --- a/ext/XS-APItest/APItest.xs +++ b/ext/XS-APItest/APItest.xs @@ -6853,10 +6853,21 @@ test_Gconvert(SV * number, SV * num_digits) PREINIT: char buffer[100]; int len; + int extras; CODE: len = (int) SvIV(num_digits); - if (len > 99) croak("Too long a number for test_Gconvert"); - if (len < 0) croak("Too short a number for test_Gconvert"); + /* To silence a -Wformat-overflow compiler warning we * + * make allowance for the following characters that may * + * appear, in addition to the digits of the significand: * + * a leading "-", a single byte radix point, "e-", the * + * terminating NULL, and a 3 or 4 digit exponent. * + * Ie, allow 8 bytes if nvtype is "double", otherwise 9 * + * bytes (as the exponent could then contain 4 digits ). */ + extras = sizeof(NV) == 8 ? 8 : 9; + if(len > 100 - extras) + croak("Too long a number for test_Gconvert"); + if (len < 0) + croak("Too short a number for test_Gconvert"); PERL_UNUSED_RESULT(Gconvert(SvNV(number), len, 0, /* No trailing zeroes */ buffer)); From ae1b822d06cf7e05be28d18f27c3db719daa41f9 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sat, 7 Nov 2020 12:05:14 +1100 Subject: [PATCH 361/503] win32/makefile.mk - define __USE_MINGW_ANSI_STDIO by default --- win32/makefile.mk | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/win32/makefile.mk b/win32/makefile.mk index fc47aa11c38f..26c824dca5e5 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -101,12 +101,14 @@ USE_IMP_SYS *= define #USE_LONG_DOUBLE *= define # -# Uncomment this if you want to build perl with __USE_MINGW_ANSI_STDIO defined. +# Comment this out if you want to build perl without __USE_MINGW_ANSI_STDIO defined. # (If you're building perl with USE_LONG_DOUBLE defined then # __USE_MINGW_ANSI_STDIO will be defined whether or not this is uncommented.) -# This option is not supported for MSVC builds. +# The advantage of defining __USE_MINGW_ANSI_STDIO is that it provides correct +# (s)printf formatting of numbers, whereas the MS runtime might not. +# This option has no effect on MSVC builds. # -#USE_MINGW_ANSI_STDIO *= define +USE_MINGW_ANSI_STDIO *= define # # Comment this out if you want the legacy default behavior of including '.' at From b14ae3c3b36461b9e396451434fba1dff9a69bb8 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sat, 7 Nov 2020 12:05:42 +1100 Subject: [PATCH 362/503] win32/GNUmakefile - define __USE_MINGW_ANSI_STDIO by default --- win32/GNUmakefile | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 2aa79e5a0d29..553011345500 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -129,12 +129,14 @@ USE_PERLIO := define #USE_LONG_DOUBLE := define # -# Uncomment this if you want to build perl with __USE_MINGW_ANSI_STDIO defined. +# Comment this out if you want to build perl without __USE_MINGW_ANSI_STDIO defined. # (If you're building perl with USE_LONG_DOUBLE defined then # __USE_MINGW_ANSI_STDIO will be defined whether or not this is uncommented.) -# This option is not supported for MSVC builds. +# The advantage of defining __USE_MINGW_ANSI_STDIO is that it provides correct +# (s)printf formatting of numbers, whereas the MS runtime might not. +# This option has no effect on MSVC builds. # -#USE_MINGW_ANSI_STDIO := define +USE_MINGW_ANSI_STDIO := define # # Comment this out if you want the legacy default behavior of including '.' at From 2e056cf94a7ce6085dd18a17e472fb202d07149a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 27 Aug 2020 15:23:41 -0600 Subject: [PATCH 363/503] perlapi: Turn reference to SvSHARED_HASH into a link --- sv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sv.c b/sv.c index ed0b6bdd30ee..f906901620aa 100644 --- a/sv.c +++ b/sv.c @@ -9457,7 +9457,7 @@ created first. Turns on the C flag (or C and C in 5.16 and earlier). If the C parameter is non-zero, that value is used; otherwise the hash is computed. The string's hash can later be retrieved from the SV -with the C macro. The idea here is +with the C> macro. The idea here is that as the string table is used for shared hash keys these strings will have C and hash lookup will avoid string compare. From 52e47e2245c776f87b48eb4d4989a823997e7689 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 29 Aug 2020 12:25:00 -0600 Subject: [PATCH 364/503] perlapi: More fully document gv_stashpvn --- gv.c | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/gv.c b/gv.c index d7048248c250..7c758a63e0ac 100644 --- a/gv.c +++ b/gv.c @@ -1473,12 +1473,13 @@ is returned. Flags may be one of: - GV_ADD - SVf_UTF8 - GV_NOADD_NOINIT - GV_NOINIT - GV_NOEXPAND - GV_ADDMG + GV_ADD Create and initialize the package if doesn't + already exist + GV_NOADD_NOINIT Don't create the package, + GV_ADDMG GV_ADD iff the GV is magical + GV_NOINIT GV_ADD, but don't initialize + GV_NOEXPAND Don't expand SvOK() entries to PVGV + SVf_UTF8 The name is in UTF-8 The most important of which are probably C and C. From 66c65f79d3ac3abda04a869359d6f034ab2c32aa Mon Sep 17 00:00:00 2001 From: Ricardo Signes Date: Wed, 23 Dec 2020 22:28:44 -0500 Subject: [PATCH 365/503] pod: update a few documents for perlgov changes --- pod/perlhack.pod | 6 ++--- pod/perlhist.pod | 4 +-- pod/perlpolicy.pod | 57 +++++++++++++++++++++++++------------------ pod/perlsecpolicy.pod | 6 ++--- 4 files changed, 41 insertions(+), 32 deletions(-) diff --git a/pod/perlhack.pod b/pod/perlhack.pod index 9d5b45a57136..c76008228802 100644 --- a/pod/perlhack.pod +++ b/pod/perlhack.pod @@ -691,7 +691,7 @@ still options for the future of prototypes that haven't been addressed. Good patches (tight code, complete, correct) stand more chance of going in. Sloppy or incorrect patches might be placed on the back burner -until the pumpking has time to fix, or might be discarded altogether +until fixes can be made, or they might be discarded altogether without further notice. =head3 Is the implementation generic enough to be portable? @@ -728,7 +728,7 @@ man's pointless cruft. =head3 Does it create too much work? -Work for the pumpking, work for Perl programmers, work for module +Work for the committers, work for Perl programmers, work for module authors, ... Perl is supposed to be easy. =head3 Patches speak louder than words @@ -1184,7 +1184,7 @@ functions do, as well as the many macros used in the source. =item * F This is a collection of words of wisdom for a Perl porter; some of it -is only useful to the pumpkin holder, but most of it applies to anyone +is only useful to the pumpkin holders, but most of it applies to anyone wanting to go about Perl development. =back diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 5b7c2e18c6b8..091c4e7de4f8 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -65,8 +65,8 @@ the strings?). =head1 THE RECORDS Pump- Release Date Notes - king (by no means - comprehensive, + kin (by no means + Holder comprehensive, see Changes* for details) ====================================================================== diff --git a/pod/perlpolicy.pod b/pod/perlpolicy.pod index 35f2a9a63055..ba54b9259886 100644 --- a/pod/perlpolicy.pod +++ b/pod/perlpolicy.pod @@ -24,22 +24,26 @@ some are actively patching their pet area (threads, Win32, the regexp -engine), while others seem to do nothing but complain. In other words, it's your usual mix of technical people. +Among these people are the core Perl team. These are trusted volunteers +involved in the ongoing development of the Perl language and interpreter. +They are not required to be language developers or committers. + Over this group of porters presides Larry Wall. He has the final word in what does and does not change in any of the Perl programming languages. These days, Larry spends most of his time on Raku, while Perl 5 is -shepherded by a "pumpking", a porter responsible for deciding what +shepherded by a steering council of porters responsible for deciding what goes into each release and ensuring that releases happen on a regular basis. Larry sees Perl development along the lines of the US government: -there's the Legislature (the porters), the Executive branch (the --pumpking), and the Supreme Court (Larry). The legislature can -discuss and submit patches to the executive branch all they like, but -the executive branch is free to veto them. Rarely, the Supreme Court -will side with the executive branch over the legislature, or the -legislature over the executive branch. Mostly, however, the -legislature and the executive branch are supposed to get along and -work out their differences without impeachment or court cases. +there's the Legislature (the porters, represented by the core team), the +Executive branch (the steering council), and the Supreme Court (Larry). +The legislature can discuss and submit patches to the executive branch +all they like, but the executive branch is free to veto them. Rarely, +the Supreme Court will side with the executive branch over the +legislature, or the legislature over the executive branch. Mostly, +however, the legislature and the executive branch are supposed to get +along and work out their differences without impeachment or court cases. You might sometimes see reference to Rule 1 and Rule 2. Larry's power as Supreme Court is expressed in The Rules: @@ -61,6 +65,10 @@ regardless of whether he previously invoked Rule 1. Got that? Larry is always right, even when he was wrong. It's rare to see either Rule exercised, but they are often alluded to. +For the specifics on how the members of the core team and steering +council are elected or rotated, consult L, which spells it all +out in detail. + =head1 MAINTENANCE AND SUPPORT Perl 5 is developed by a community, not a corporate entity. Every change @@ -168,7 +176,7 @@ Using a lexical pragma to enable or disable legacy behavior should be considered when appropriate, and in the absence of any pragma legacy behavior should be enabled. Which backward-incompatible changes are controlled implicitly by a 'use v5.x.y' is a decision which should be -made by the pumpking in consultation with the community. +made by the steering council in consultation with the community. Historically, we've held ourselves to a far higher standard than backward-compatibility -- bugward-compatibility. Any accident of @@ -263,8 +271,9 @@ perl (e.g. spelling corrections in documentation) should be resisted in order to reduce the overall risk of overlooking something. The intention is to create maintenance releases which are both worthwhile and which users can have full confidence in the stability of. (A secondary concern is to avoid burning -out the maint-pumpking or overwhelming other committers voting on changes to be -included (see L below).) +out the maint-release manager or overwhelming other committers voting on +changes to be included (see L +below).) The following types of change may be considered acceptable, as long as they do not also fall into any of the "unacceptable" categories set out below: @@ -328,7 +337,8 @@ The following types of change are NOT acceptable: =item * -Patches that break binary compatibility. (Please talk to a pumpking.) +Patches that break binary compatibility. (Please talk to the steering +council.) =item * @@ -356,11 +366,11 @@ be included. =head2 Getting changes into a maint branch -Historically, only the pumpking cherry-picked changes from bleadperl -into maintperl. This has scaling problems. At the same time, -maintenance branches of stable versions of Perl need to be treated with -great care. To that end, as of Perl 5.12, we have a new process for -maint branches. +Historically, only the single-person project manager cherry-picked +changes from bleadperl into maintperl. This has scaling problems. At +the same time, maintenance branches of stable versions of Perl need to +be treated with great care. To that end, as of Perl 5.12, we have a new +process for maint branches. Any committer may cherry-pick any commit from blead to a maint branch by first adding an entry to the relevant voting file in the maint-votes branch @@ -383,7 +393,7 @@ interested may be heard. It is not necessary for voting to be held on cherry-picking perldelta entries associated with changes that have already been cherry-picked, nor -for the maint-pumpking to obtain votes on changes required by the +for the maint-release manager to obtain votes on changes required by the F where such changes can be applied by the means of cherry-picking from blead. @@ -436,7 +446,7 @@ should be respected whenever possible. =item * -Patches may be applied by the pumpkin holder without the explicit +Patches may be applied by the steering council without the explicit cooperation of the module author if and only if they are very minor, time-critical in some fashion (such as urgent security fixes), or if the module author cannot be reached. Those patches must still be @@ -451,7 +461,7 @@ of the change acknowledged. The version of the module distributed with Perl should, whenever possible, be the latest version of the module as distributed by the author (the latest non-beta version in the case of public Perl -releases), although the pumpkin holder may hold off on upgrading the +releases), although the steering council may hold off on upgrading the version of the module distributed with Perl to the latest version until the latest version has had sufficient testing. @@ -464,10 +474,9 @@ reasonable compromises when there are disagreements). As a last resort, however: - If the author's vision of the future of their module is sufficiently -different from the vision of the pumpkin holder and perl5-porters as a -whole so as to cause serious problems for Perl, the pumpkin holder may +different from the vision of the steering council and perl5-porters as a +whole so as to cause serious problems for Perl, the steering council may choose to formally fork the version of the module in the Perl core from the one maintained by the author. This should not be done lightly and should B if at all possible be done only after direct input diff --git a/pod/perlsecpolicy.pod b/pod/perlsecpolicy.pod index ad555f074a1d..07a702495dfe 100644 --- a/pod/perlsecpolicy.pod +++ b/pod/perlsecpolicy.pod @@ -30,7 +30,7 @@ security team. You should receive an initial response to your report within 72 hours. If you do not receive a response in that time, please contact the security team lead L and -the Perl pumpking L. +the L. When members of the security team reply to your messages, they will generally include the perl-security@perl.org address in the "To" or "CC" @@ -297,8 +297,8 @@ open and transparent as possible about the state of your security report. New vulnerability reports will receive an initial reply within 72 hours from the time they arrive at the security team's mailing list. If you do not receive any response in that time, contact the security team lead -L and the Perl pumpking -L. +L and the the L. The initial response sent by the security team will confirm your message was received and provide an estimated time frame for the security team's From ce122704aea566d341329194a0eab92bf3d9deca Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Mon, 7 Dec 2020 23:47:07 +0900 Subject: [PATCH 366/503] sv.c: more imprecision warnings on increment/decrement Previously, imprecision warnings on increment (Lost precision when incrementing %f by 1) were only issued on positive finite values, and, on decrement, only issued on negative finite values. This commit extends this warnings on both sign and infinite values. This fixes GH #18333. --- sv.c | 22 ++++++++++++++++------ t/op/inc.t | 20 ++++++++++++++++++++ 2 files changed, 36 insertions(+), 6 deletions(-) diff --git a/sv.c b/sv.c index f906901620aa..3942b54d6a4e 100644 --- a/sv.c +++ b/sv.c @@ -8949,9 +8949,14 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) } if (flags & SVp_NOK) { const NV was = SvNVX(sv); - if (LIKELY(!Perl_isinfnan(was)) && - NV_OVERFLOWS_INTEGERS_AT != 0.0 && - was >= NV_OVERFLOWS_INTEGERS_AT) { + if (NV_OVERFLOWS_INTEGERS_AT != 0.0 && + /* If NVX was NaN, the following comparisons return always false */ + UNLIKELY(was >= NV_OVERFLOWS_INTEGERS_AT || + was < -NV_OVERFLOWS_INTEGERS_AT) +#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) + && LIKELY(!Perl_isnan(was)) +#endif + ) { /* diag_listed_as: Lost precision when %s %f by 1 */ Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION), "Lost precision when incrementing %" NVff " by 1", @@ -9128,9 +9133,14 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) oops_its_num: { const NV was = SvNVX(sv); - if (LIKELY(!Perl_isinfnan(was)) && - NV_OVERFLOWS_INTEGERS_AT != 0.0 && - was <= -NV_OVERFLOWS_INTEGERS_AT) { + if (NV_OVERFLOWS_INTEGERS_AT != 0.0 && + /* If NVX was NaN, these comparisons return always false */ + UNLIKELY(was <= -NV_OVERFLOWS_INTEGERS_AT || + was > NV_OVERFLOWS_INTEGERS_AT) +#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) + && LIKELY(!Perl_isnan(was))) +#endif + ) { /* diag_listed_as: Lost precision when %s %f by 1 */ Perl_ck_warner(aTHX_ packWARN(WARN_IMPRECISION), "Lost precision when decrementing %" NVff " by 1", diff --git a/t/op/inc.t b/t/op/inc.t index 3d5cc024d3be..6d0f7b7b9e37 100644 --- a/t/op/inc.t +++ b/t/op/inc.t @@ -255,6 +255,26 @@ EOC "$description under use warnings 'imprecision'"); } + # Verify warnings on incrementing/decrementing large values + # whose integral part will not fit in NVs. [GH #18333] + foreach ([$start_n - 4, '$i++', 'negative large value', 'inc'], + ['+Inf' + 0, '$i++', '+Inf', 'inc'], + ['-Inf' + 0, '$i++', '-Inf', 'inc'], + [$start_p + 4, '$i--', 'positive large value', 'dec'], + ['+Inf' + 0, '$i--', '+Inf', 'dec'], + ['-Inf' + 0, '$i--', '-Inf', 'dec']) { + my ($start, $action, $description, $act) = @$_; + my $code = eval << "EOC" or die $@; +sub { + use warnings 'imprecision'; + my \$i = \$start; + $action; +} +EOC + warning_like($code, qr/Lost precision when ${act}rementing /, + "${act}rementing $description under use warnings 'imprecision'"); + } + $found = 1; last; } From a236dd374ef115db25a1a2fe46f55c62e38898a2 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Wed, 23 Dec 2020 03:56:12 +0900 Subject: [PATCH 367/503] sv.c: Suppress imprecision warnings on Inf. This commit will partially revert the effect of the commit c33ee94ba2086d48e3750cfdeb51402b61bb1ac7. [GH #18388] --- sv.c | 12 ++++++++---- t/op/inc.t | 30 +++++++++++++++++++++++++----- 2 files changed, 33 insertions(+), 9 deletions(-) diff --git a/sv.c b/sv.c index 3942b54d6a4e..dc85b830e9be 100644 --- a/sv.c +++ b/sv.c @@ -8952,9 +8952,11 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) if (NV_OVERFLOWS_INTEGERS_AT != 0.0 && /* If NVX was NaN, the following comparisons return always false */ UNLIKELY(was >= NV_OVERFLOWS_INTEGERS_AT || - was < -NV_OVERFLOWS_INTEGERS_AT) + was < -NV_OVERFLOWS_INTEGERS_AT) && #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - && LIKELY(!Perl_isnan(was)) + LIKELY(!Perl_isinfnan(was)) +#else + LIKELY(!Perl_isinf(was)) #endif ) { /* diag_listed_as: Lost precision when %s %f by 1 */ @@ -9136,9 +9138,11 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) if (NV_OVERFLOWS_INTEGERS_AT != 0.0 && /* If NVX was NaN, these comparisons return always false */ UNLIKELY(was <= -NV_OVERFLOWS_INTEGERS_AT || - was > NV_OVERFLOWS_INTEGERS_AT) + was > NV_OVERFLOWS_INTEGERS_AT) && #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - && LIKELY(!Perl_isnan(was))) + LIKELY(!Perl_isinfnan(was))) +#else + LIKELY(!Perl_isinf(was)) #endif ) { /* diag_listed_as: Lost precision when %s %f by 1 */ diff --git a/t/op/inc.t b/t/op/inc.t index 6d0f7b7b9e37..4ea3c6c63f1a 100644 --- a/t/op/inc.t +++ b/t/op/inc.t @@ -258,11 +258,7 @@ EOC # Verify warnings on incrementing/decrementing large values # whose integral part will not fit in NVs. [GH #18333] foreach ([$start_n - 4, '$i++', 'negative large value', 'inc'], - ['+Inf' + 0, '$i++', '+Inf', 'inc'], - ['-Inf' + 0, '$i++', '-Inf', 'inc'], - [$start_p + 4, '$i--', 'positive large value', 'dec'], - ['+Inf' + 0, '$i--', '+Inf', 'dec'], - ['-Inf' + 0, '$i--', '-Inf', 'dec']) { + [$start_p + 4, '$i--', 'positive large value', 'dec']) { my ($start, $action, $description, $act) = @$_; my $code = eval << "EOC" or die $@; sub { @@ -423,4 +419,28 @@ SKIP: { } } # SKIP +# Incrementing/decrementing Inf/NaN should not trigger 'imprecision' warnings +# [GH #18333, #18388] +# Note these tests only check for warnings; t/op/infnan.t has tests that +# checks the result of incrementing/decrementing Inf/NaN. +foreach my $infnan ('+Inf', '-Inf', 'NaN') { + my $start = $infnan + 0; + SKIP: { + skip "NV does not have $infnan", 2 + unless ($infnan eq 'NaN' ? $Config{d_double_has_nan} : $Config{d_double_has_inf}); + foreach (['$i++', 'inc'], + ['$i--', 'dec']) { + my ($action, $act) = @$_; + my $code = eval <<"EOC" or die $@; +sub { + use warnings 'imprecision'; + my \$i = \$start; + $action; +} +EOC + warning_is($code, undef, "${act}rementing $infnan under use warnings 'imprecision'"); + } + } # SKIP +} + done_testing(); From 3dbc7e76ea39f2a1085c2b3ee8c9f2b59f53dfd1 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Tue, 29 Dec 2020 02:46:30 +0900 Subject: [PATCH 368/503] sv.c: Delete irrelevant preprocessor conditionals 66435b24ea changed Perl_isnan to Perl_isinfnan, but I forgot to update corresponding preprocessor conditionals. --- sv.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sv.c b/sv.c index dc85b830e9be..15ec9db7e58e 100644 --- a/sv.c +++ b/sv.c @@ -8953,7 +8953,7 @@ Perl_sv_inc_nomg(pTHX_ SV *const sv) /* If NVX was NaN, the following comparisons return always false */ UNLIKELY(was >= NV_OVERFLOWS_INTEGERS_AT || was < -NV_OVERFLOWS_INTEGERS_AT) && -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) +#if defined(NAN_COMPARE_BROKEN) LIKELY(!Perl_isinfnan(was)) #else LIKELY(!Perl_isinf(was)) @@ -9139,7 +9139,7 @@ Perl_sv_dec_nomg(pTHX_ SV *const sv) /* If NVX was NaN, these comparisons return always false */ UNLIKELY(was <= -NV_OVERFLOWS_INTEGERS_AT || was > NV_OVERFLOWS_INTEGERS_AT) && -#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) +#if defined(NAN_COMPARE_BROKEN) LIKELY(!Perl_isinfnan(was))) #else LIKELY(!Perl_isinf(was)) From b30a5dee76d42a0c8e99b595031828d9df32ca4b Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Wed, 30 Dec 2020 00:03:19 +0900 Subject: [PATCH 369/503] perldelta.pod: Document "Lost precision" warning changes [GH #18333, #18388] --- pod/perldelta.pod | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index bc2614eb5615..a6c8b9426ddd 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -220,6 +220,15 @@ XXX Changes (i.e. rewording) of diagnostic messages go here XXX Describe change here +=item * + +L + +This warning was only issued for positive too-large values when incrementing, +and only for negative ones when decrementing. +It is now issued for both of positive or negative too-large values. +[L] + =back =head1 Utility Changes From ac950c896259b18f7198cb1afc8ac44ab5eb9072 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 8 Oct 2020 13:53:47 -0600 Subject: [PATCH 370/503] perlapi: Consolidate newRV and newRV_inc pod --- embed.fnc | 2 +- sv.h | 7 ++++--- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/embed.fnc b/embed.fnc index e60536969edd..573ecc5acaa4 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1475,7 +1475,7 @@ ApdR |OP* |newPADOP |I32 type|I32 flags|NN SV* sv #endif ApdR |OP* |newPMOP |I32 type|I32 flags ApdR |OP* |newPVOP |I32 type|I32 flags|NULLOK char* pv -ApR |SV* |newRV |NN SV *const sv +ApdR |SV* |newRV |NN SV *const sv ApdR |SV* |newRV_noinc |NN SV *const tmpRef ApdR |SV* |newSV |const STRLEN len ApR |OP* |newSVREF |NN OP* o diff --git a/sv.h b/sv.h index 9d11270af548..1a5aa31df9a3 100644 --- a/sv.h +++ b/sv.h @@ -2170,10 +2170,11 @@ Returns the hash for C created by C>. #endif /* -=for apidoc Am|SV*|newRV_inc|SV* sv +=for apidoc newRV +=for apidoc_item ||newRV_inc| -Creates an RV wrapper for an SV. The reference count for the original SV is -incremented. +These are identical. They create an RV wrapper for an SV. The reference count +for the original SV is incremented. =cut */ From de343f440fedc6e5f1dbb95dee19f10a46ef8794 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 8 Oct 2020 14:20:48 -0600 Subject: [PATCH 371/503] perlapi: link to SvPV --- sv.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sv.h b/sv.h index 1a5aa31df9a3..ba701ed1a6f9 100644 --- a/sv.h +++ b/sv.h @@ -747,7 +747,7 @@ Returns a boolean indicating whether the SV contains a v-string. =for apidoc Am|U32|SvOOK|SV* sv Returns a U32 indicating whether the pointer to the string buffer is offset. This hack is used internally to speed up removal of characters from the -beginning of a C. When C is true, then the start of the +beginning of a C>. When C is true, then the start of the allocated string buffer is actually C bytes before C. This offset used to be stored in C, but is now stored within the spare part of the buffer. @@ -922,7 +922,7 @@ Set the size of the string buffer for the SV. See C>. =for apidoc Am|U32|SvUTF8|SV* sv Returns a U32 value indicating the UTF-8 status of an SV. If things are set-up properly, this indicates whether or not the SV contains UTF-8 encoded data. -You should use this I a call to C or one of its variants, in +You should use this I a call to C> or one of its variants, in case any call to string overloading updates the internal flag. If you want to take into account the L pragma, use C> From 1f6e74eb3536a13f38c1016477cd5b62dfe4e3da Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 17 Oct 2020 07:26:56 -0600 Subject: [PATCH 372/503] Document regexp, regmatch_info --- regexp.h | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) diff --git a/regexp.h b/regexp.h index cfb8d443ceea..43a5168f74e8 100644 --- a/regexp.h +++ b/regexp.h @@ -97,6 +97,7 @@ struct reg_code_blocks { /* += for apidoc AyT||regexp The regexp/REGEXP struct, see L for further documentation on the individual fields. The struct is ordered so that the most commonly used fields are placed at the start. @@ -673,12 +674,17 @@ typedef struct { } regmatch_info_aux; -/* some basic information about the current match that is created by - * Perl_regexec_flags and then passed to regtry(), regmatch() etc. - * It is allocated as a local var on the stack, so nothing should be - * stored in it that needs preserving or clearing up on croak(). - * For that, see the aux_info and aux_info_eval members of the - * regmatch_state union. */ +/* +=for apidoc Ay||regmatch_info +Some basic information about the current match that is created by +Perl_regexec_flags and then passed to regtry(), regmatch() etc. +It is allocated as a local var on the stack, so nothing should be +stored in it that needs preserving or clearing up on croak(). +For that, see the aux_info and aux_info_eval members of the +regmatch_state union. + +=cut +*/ typedef struct { REGEXP *prog; /* the regex being executed */ From 4cfbe5474a5c5f852a6dbf0138dc796c2800be93 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 30 Dec 2020 05:55:08 -0700 Subject: [PATCH 373/503] Fix buggy fc() in Turkish locale When Turkish handling was added, fc() wasn't properly updated --- pp.c | 12 +++++++++--- t/op/lc.t | 23 ++++++++++++++++------- 2 files changed, 25 insertions(+), 10 deletions(-) diff --git a/pp.c b/pp.c index 5e1706346da5..23cc6c8adba6 100644 --- a/pp.c +++ b/pp.c @@ -4813,7 +4813,7 @@ PP(pp_fc) do { extra++; - s_peek = (U8 *) memchr(s_peek + 1, 'i', + s_peek = (U8 *) memchr(s_peek + 1, 'I', send - (s_peek + 1)); } while (s_peek != NULL); } @@ -4828,8 +4828,14 @@ PP(pp_fc) + 1 /* Trailing NUL */ ); d = (U8*)SvPVX(dest) + len; - *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU); - *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU); + if (*s == 'I') { + *d++ = UTF8_TWO_BYTE_HI(LATIN_SMALL_LETTER_DOTLESS_I); + *d++ = UTF8_TWO_BYTE_LO(LATIN_SMALL_LETTER_DOTLESS_I); + } + else { + *d++ = UTF8_TWO_BYTE_HI(GREEK_SMALL_LETTER_MU); + *d++ = UTF8_TWO_BYTE_LO(GREEK_SMALL_LETTER_MU); + } s++; for (; s < send; s++) { diff --git a/t/op/lc.t b/t/op/lc.t index fce77f3d3416..812c41d6b6b7 100644 --- a/t/op/lc.t +++ b/t/op/lc.t @@ -17,7 +17,7 @@ BEGIN { use feature qw( fc ); -plan tests => 139 + 2 * (4 * 256) + 15; +plan tests => 139 + 2 * (5 * 256) + 17; is(lc(undef), "", "lc(undef) is ''"); is(lcfirst(undef), "", "lcfirst(undef) is ''"); @@ -352,13 +352,14 @@ foreach my $turkic (0 .. 1) { my $locale = ($turkic) ? $turkic_locale : $non_turkic_locale; SKIP: { - skip "Can't find a $type UTF-8 locale", 4*256 unless defined $locale; + skip "Can't find a $type UTF-8 locale", 5*256 unless defined $locale; use feature qw( unicode_strings ); no locale; my @unicode_lc; + my @unicode_fc; my @unicode_uc; my @unicode_lcfirst; my @unicode_ucfirst; @@ -366,6 +367,7 @@ foreach my $turkic (0 .. 1) { # Get all the values outside of 'locale' for my $i (0 .. 255) { push @unicode_lc, lc(chr $i); + push @unicode_fc, fc(chr $i); push @unicode_uc, uc(chr $i); push @unicode_lcfirst, lcfirst(chr $i); push @unicode_ucfirst, ucfirst(chr $i); @@ -373,6 +375,7 @@ foreach my $turkic (0 .. 1) { if ($turkic) { $unicode_lc[ord 'I'] = chr 0x131; + $unicode_fc[ord 'I'] = chr 0x131; $unicode_lcfirst[ord 'I'] = chr 0x131; $unicode_uc[ord 'i'] = chr 0x130; $unicode_ucfirst[ord 'i'] = chr 0x130; @@ -384,6 +387,7 @@ foreach my $turkic (0 .. 1) { for my $i (0 .. 255) { is(lc(chr $i), $unicode_lc[$i], "In a $type UTF-8 locale, lc(chr $i) is the same as official Unicode"); is(uc(chr $i), $unicode_uc[$i], "In a $type UTF-8 locale, uc(chr $i) is the same as official Unicode"); + is(fc(chr $i), $unicode_fc[$i], "In a $type UTF-8 locale, fc(chr $i) is the same as official Unicode"); is(lcfirst(chr $i), $unicode_lcfirst[$i], "In a $type UTF-8 locale, lcfirst(chr $i) is the same as official Unicode"); is(ucfirst(chr $i), $unicode_ucfirst[$i], "In a $type UTF-8 locale, ucfirst(chr $i) is the same as official Unicode"); } @@ -391,27 +395,32 @@ foreach my $turkic (0 .. 1) { } SKIP: { - skip "Can't find a turkic UTF-8 locale", 15 unless defined $turkic_locale; + skip "Can't find a turkic UTF-8 locale", 17 unless defined $turkic_locale; # These are designed to stress the calculation of space needed for the # strings. $filler contains a variety of characters that have special # handling in the casing functions, and some regular chars as well. + # (0x49 = 'I') my $filler_length = 10000; - my $filler = uni_to_native("\x{df}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length; + my $filler = uni_to_native("\x{df}\x{49}\x{69}\x{b5}\x{e0}\x{c1}\x{b6}\x{ff}") x $filler_length; # These are the correct answers to what should happen when the given # casing function is called on $filler; - my $filler_lc = uni_to_native("\x{df}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length; - my $filler_fc = ("ss" . uni_to_native("\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length; - my $filler_uc = ("SS" . uni_to_native("\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length; + my $filler_lc = uni_to_native("\x{df}\x{131}\x{69}\x{b5}\x{e0}\x{e1}\x{b6}\x{ff}") x $filler_length; + my $filler_fc = ("ss" . uni_to_native("\x{131}\x{69}\x{3bc}\x{e0}\x{e1}\x{b6}\x{ff}")) x $filler_length; + my $filler_uc = ("SS" . uni_to_native("\x{49}\x{130}\x{39c}\x{c0}\x{c1}\x{b6}\x{178}")) x $filler_length; use locale; setlocale(&POSIX::LC_CTYPE, $turkic_locale); is (lc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc", "lc non-UTF-8, in Turkic locale, beginning with a bunch of I's"); + is (fc "IIIIIII$filler", "\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc", + "fc non-UTF-8, in Turkic locale, beginning with a bunch of I's"); is (lc "${filler}IIIIIII$filler", "$filler_lc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc", "lc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning"); + is (fc "${filler}IIIIIII$filler", "$filler_fc\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_fc", + "fc non-UTF-8, in Turkic locale, a bunch of I's, but not at the beginning"); is (lc "${filler}I\x{307}$filler", "${filler_lc}i$filler_lc", "lc in Turkic locale with DOT ABOVE immediately following I"); is (lc "${filler}I\x{307}IIIIII$filler", "${filler_lc}i\x{131}\x{131}\x{131}\x{131}\x{131}\x{131}$filler_lc", From 07319fdbb283f93cb655c3106b5237cbc7272038 Mon Sep 17 00:00:00 2001 From: Tomasz Konojacki Date: Wed, 30 Dec 2020 14:03:02 +0100 Subject: [PATCH 374/503] op.c: croak on "my $_" when "use utf8" is in effect Fixes #18449 --- op.c | 16 +++++++++------- t/op/mydef.t | 11 +++++++++-- 2 files changed, 18 insertions(+), 9 deletions(-) diff --git a/op.c b/op.c index b2e12dd0c0c0..dce844d297ae 100644 --- a/op.c +++ b/op.c @@ -730,6 +730,7 @@ PADOFFSET Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) { PADOFFSET off; + bool is_idfirst, is_default; const bool is_our = (PL_parser->in_my == KEY_our); PERL_ARGS_ASSERT_ALLOCMY; @@ -738,14 +739,15 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags) Perl_croak(aTHX_ "panic: allocmy illegal flag bits 0x%" UVxf, (UV)flags); + is_idfirst = flags & SVf_UTF8 + ? isIDFIRST_utf8_safe((U8*)name + 1, name + len) + : isIDFIRST_A(name[1]); + + /* $_, @_, etc. */ + is_default = len == 2 && name[1] == '_'; + /* complain about "my $" etc etc */ - if ( len - && !( is_our - || isALPHA(name[1]) - || ( (flags & SVf_UTF8) - && isIDFIRST_utf8_safe((U8 *)name+1, name + len)) - || (name[1] == '_' && len > 2))) - { + if (!is_our && (!is_idfirst || is_default)) { const char * const type = PL_parser->in_my == KEY_sigvar ? "subroutine signature" : PL_parser->in_my == KEY_state ? "\"state\"" : "\"my\""; diff --git a/t/op/mydef.t b/t/op/mydef.t index 42a81d9ab0fa..225ce98e51c5 100644 --- a/t/op/mydef.t +++ b/t/op/mydef.t @@ -6,10 +6,17 @@ BEGIN { set_up_inc('../lib'); } -plan tests => 1; - use strict; eval 'my $_'; like $@, qr/^Can't use global \$_ in "my" at /; +{ + # using utf8 allows $_ to be declared with 'my' + # GH #18449 + use utf8; + eval 'my $_;'; + like $@, qr/^Can't use global \$_ in "my" at /; +} + +done_testing; From 41b10d901d383944620dc9fe58a82531022cc937 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 31 Dec 2020 09:08:21 -0700 Subject: [PATCH 375/503] Use SSize_t for read lock counter We have tests to make sure this doesn't go negative, but wrongly declared the variable as unsigned. Spotted by Craig Berry. --- perl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/perl.h b/perl.h index cbb6905fe0af..9627f3408cee 100644 --- a/perl.h +++ b/perl.h @@ -3345,7 +3345,7 @@ typedef pthread_key_t perl_key; typedef struct { perl_mutex lock; perl_cond wakeup; - Size_t readers_count; + SSize_t readers_count; } perl_RnW1_mutex_t; From b0a5c47fb08a6483b52748f0d36c6b83ef4a3339 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Fri, 1 Jan 2021 13:31:37 -0500 Subject: [PATCH 376/503] Delete Porting/cherrymaint Per discussion in https://github.com/Perl/perl5/issues/18028 --- MANIFEST | 1 - Porting/README.pod | 5 --- Porting/cherrymaint | 103 -------------------------------------------- 3 files changed, 109 deletions(-) delete mode 100644 Porting/cherrymaint diff --git a/MANIFEST b/MANIFEST index 1d334a514cb6..eed88d7f511a 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5354,7 +5354,6 @@ Porting/checkcfgvar.pl Check that config scripts define all symbols Porting/checkpodencoding.pl Check POD encoding Porting/checkURL.pl Check whether we have working URLs Porting/checkVERSION.pl Check whether we have $VERSIONs -Porting/cherrymaint Command line tool for updating cherrymaint Porting/cmpVERSION.pl Compare whether two trees have changed modules Porting/config.sh Sample config.sh Porting/config_H Sample config.h diff --git a/Porting/README.pod b/Porting/README.pod index b02a4da85e48..aa268215a0b8 100644 --- a/Porting/README.pod +++ b/Porting/README.pod @@ -78,11 +78,6 @@ Checks that all the URLs in the Perl source are valid. Used by F to ensure changed modules have had their versions updated. -=head2 F - -Command line tool to update cherrymaint; a tool for selecting commits from -blead to cherry-pick into stable perl versions. - =head2 F Compare the current Perl source tree and a given tag for modules that have diff --git a/Porting/cherrymaint b/Porting/cherrymaint deleted file mode 100644 index 08e8eb55a1b2..000000000000 --- a/Porting/cherrymaint +++ /dev/null @@ -1,103 +0,0 @@ -#!/usr/bin/env perl -use 5.010; -use strict; -use warnings; -use File::Basename; -use Getopt::Long; -require LWP::UserAgent; - -my %votemap = ( - 'unexamined' => 0, - 'rejected' => 1, - 'vote' => 4, - 'picked' => 5, -); - - -chomp(my $git_addr = `git config --get cherrymaint.address`); -my $addr = length $git_addr ? $git_addr : 'localhost:3000'; - -# Usage -my $program = basename $0; -my $usage = << "HERE"; -Usage: $program [--address address] [ACTION] [COMMIT] - - ACTIONS: (default is 'vote' if omitted) - -HERE -$usage .= join( "\n", map { " --$_" } (sort keys %votemap), 'help' ); -$usage .= "\n" . << "HERE"; - - COMMIT: a git revision ID (SHA1 or symbolic reference like HEAD) - - You must first tunnel $addr to perl5.git.perl.org:3000? E.g. - \$ ssh -C -L${\ join q{:} => reverse split /:/, $addr}:3000 perl5.git.perl.org - -HERE - -die $usage if grep { /^(--help|-h)$/ } @ARGV; - -# Determine action -my %opt = (address => \$addr); -GetOptions( \%opt, 'address=s', keys %votemap ) or die $usage; - -if ( keys(%opt) > 2 ) { - die "Error: cherrymaint takes only one action argument\n\n$usage" -} - -my ($action) = grep { exists $votemap{$_} } keys %opt; -$action ||= 'vote'; - -# Determine commit SHA1 -my $commit = shift @ARGV; - -unless ( defined $commit ) { - die "Error: cherrymaint requires an explicit commit ID\n\n$usage" -} - -my $short_id = qx/git rev-parse --short $commit/; -if ( $? ) { - die "Error: couldn't get git commit SHA1 from '$commit'\n"; -} -chomp $short_id; - -# Confirm actions -unless ( $action eq 'vote' ) { - say "Are you sure you want to mark $short_id as $action? (y/n)"; - my $ans = ; - exit 0 unless $ans =~ /^y/i; -} - -# Send the action to cherrymaint -my $n = $votemap{$action}; -my $url = "http://$addr/mark?commit=${short_id}&value=${n}"; - -my $ua = LWP::UserAgent->new( - agent => 'Porting/cherrymaint ', - timeout => 30, - env_proxy => 1, -); - -my $response = $ua->get($url); - -if ($response->is_success) { - say "Done."; -} -else { - die $response->status_line . << "HERE"; - -Have you remembered to tunnel $addr to perl5.git.perl.org:3000? E.g. - \$ ssh -C -L${\ join q{:} => reverse split /:/, $addr}:3000 perl5.git.perl.org - -Or maybe you created a different tunnel? You can specify the address to use -either on the command line with --address, or by doing - \$ git config cherrymaint.address host:port - -HERE - -# Note that you can vote through your browser by pointing it at the local -# end of the tunnel. For example, L if you went with -# the suggested default values -} - -exit 0; From 52c50ff1ed8dbfeb5b2be8f606d40f5a0f2004eb Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 2 Jan 2021 10:18:26 -0700 Subject: [PATCH 377/503] regexp.h: Clarify how a computed value is derived. --- regexp.h | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/regexp.h b/regexp.h index 43a5168f74e8..c4210edf8437 100644 --- a/regexp.h +++ b/regexp.h @@ -712,11 +712,12 @@ typedef struct { # define MAX_RECURSE_EVAL_NOCHANGE_DEPTH 10 #endif -/* The +3 is based on the current Unicode standards needs, and is unlikely to - * change. An assertion should fail in regexec.c if it is too low. It is - * needed for certain edge cases involving multi-character folds when the first - * component also participates in a fold individually. */ -#define MAX_MATCHES (MAX_FOLD_FROMS + 3) +/* The +1 is because everything matches itself, which isn't included in + * MAX_FOLD_FROMS; the +2 is based on the current Unicode standards needs, and + * is unlikely to change. An assertion should fail in regexec.c if it is too + * low. It is needed for certain edge cases involving multi-character folds + * when the first component also participates in a fold individually. */ +#define MAX_MATCHES (MAX_FOLD_FROMS + 1 + 2) struct next_matchable_info { U8 first_byte_mask; From 12c5822e63454624e46d26e95b1964592be3affe Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 2 Jan 2021 12:45:09 -0700 Subject: [PATCH 378/503] regexec.c: Clarify comments --- regexec.c | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/regexec.c b/regexec.c index 2a5fa540bc49..3ca22883610c 100644 --- a/regexec.c +++ b/regexec.c @@ -4849,8 +4849,8 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, lengths[m->count] = UVCHR_SKIP(fold_from); m->count++; } - else { /* Non-UTF8 target: any code point above 255 - can't appear in it */ + else { /* Non-UTF8 target: no code point above 255 can appear in it + */ if (fold_from > 255) { continue; } @@ -4973,7 +4973,10 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, if (m->count > 1) { /* No need to sort a single entry */ for (i = 0; i < (PERL_UINT_FAST8_T) m->count; i++) { - /* Keep the same order for all but the longest */ + /* Keep the same order for all but the longest. (If the + * asserts fail, it could be because m->matches is declared too + * short, either because of a new Unicode release, or an + * overlooked test case, or it could be a bug.) */ if (i != index_of_longest) { assert(cur_pos + lengths[i] <= C_ARRAY_LENGTH(m->matches)); Copy(matches[i], m->matches + cur_pos, lengths[i], U8); From 46033c991aa390e9da2bdb8c8005b6806d7bffdc Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 2 Jan 2021 15:42:25 -0700 Subject: [PATCH 379/503] regexec.c: Fix assertion failure GH #18451 This was caused by copying too many characters for the size of the buffer. Only one character is needed. --- regexec.c | 39 ++++++++++++++++++++++++++------------- t/re/re_tests | 3 ++- 2 files changed, 28 insertions(+), 14 deletions(-) diff --git a/regexec.c b/regexec.c index 3ca22883610c..b46693e5ac0f 100644 --- a/regexec.c +++ b/regexec.c @@ -4694,24 +4694,37 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, * * Everything generally matches at least itself. But if there is a * UTF8ness mismatch, we have to convert to that of the target string. */ - if (utf8_pat == utf8_target || UTF8_IS_INVARIANT(*pat)) { - lengths[0] = MIN(pat_len, C_ARRAY_LENGTH(matches[0])); - Copy(pat, matches[0], lengths[0], U8); + if (UTF8_IS_INVARIANT(*pat)) { /* Immaterial if either is in UTF-8 */ + matches[0][0] = pat[0]; + lengths[0] = 1; m->count++; } - else if (utf8_target) { /* target is UTF-8; pattern isn't */ - matches[0][0] = UTF8_EIGHT_BIT_HI(pat[0]); - matches[0][1] = UTF8_EIGHT_BIT_LO(pat[0]); - lengths[0] = 2; - m->count++; - } - else { /* pattern is UTF-8, target isn't */ - if (UTF8_IS_DOWNGRADEABLE_START(*pat)) { - matches[0][0] = EIGHT_BIT_UTF8_TO_NATIVE(pat[0], pat[1]); - lengths[0] = 1; + else if (utf8_target) { + if (utf8_pat) { + lengths[0] = UTF8SKIP(pat); + Copy(pat, matches[0], lengths[0], U8); + m->count++; + } + else { /* target is UTF-8, pattern isn't */ + matches[0][0] = UTF8_EIGHT_BIT_HI(pat[0]); + matches[0][1] = UTF8_EIGHT_BIT_LO(pat[0]); + lengths[0] = 2; m->count++; } } + else if (! utf8_pat) { /* Neither is UTF-8 */ + matches[0][0] = pat[0]; + lengths[0] = 1; + m->count++; + } + else /* target isn't UTF-8; pattern is. No match possible unless the + pattern's first character can fit in a byte */ + if (UTF8_IS_DOWNGRADEABLE_START(*pat)) + { + matches[0][0] = EIGHT_BIT_UTF8_TO_NATIVE(pat[0], pat[1]); + lengths[0] = 1; + m->count++; + } /* Here we have taken care of any necessary node-type changes */ diff --git a/t/re/re_tests b/t/re/re_tests index ab5a0d801257..ff8bd7b43a18 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -2013,7 +2013,7 @@ AB\s+\x{100} AB \x{100}X y - - (?:(?^:(?{1}))[^0-9]) : y $& : # [perl #133348] /[\xdf-/i - ca - Invalid [] range # [perl #133620] likely only fails under valgrind /[\x59-/i - ce - Unmatched [ # [perl #133620] likely only fails under valgrind -/\1a(b)/ bab n - - # This compiles but fails to match as \1 is not set when parsed. +/\1a(b)/ bab n - - # This compiles but fails to match as \1 is not set when parsed /(?iu)(?<=\xdf)hbase/ sshbase y $& hbase /\x{30c3}?[\x{30a2}\x{30a4}\x{30a6}\x{30a8}\x{30aa}-\x{30e2}\x{30e4}\x{30e6}\x{30e8}-\x{30f4}](?:[\x{30e3}\x{30e5}\x{30e7}\x{30a1}\x{30a3}\x{30a5}\x{30a7}\x{30a9}])?\x{30fc}?\x{30f3}?/ \x{30de}\x{30fc}\x{30af}\x{30b5}\x{30fc}\x{30d3}\x{30b9} y $& \x{30de}\x{30fc} # part of [perl #133942 /[\x{3041}-\x{3093}]+/ \x{6f22}\x{5b57}\x{3001}\x{30ab}\x{30bf}\x{30ab}\x{30ca}\x{3001}\x{3072}\x{3089}\x{304c}\x{306a}\x{306e}\x{5165}\x{3063}\x{305f}String y $& \x{3072}\x{3089}\x{304c}\x{306a}\x{306e} # [perl #133978] @@ -2025,6 +2025,7 @@ AB\s+\x{100} AB \x{100}X y - - /(?iaa:A?\K*)/ African_Feh c - \\K* is forbidden - matches null string many times in regex ^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + b + y $1 a + b # [GH #18096] ^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + + c y $1 a + # [GH #18096] +/0?\xdf\xdf\xdf\xdfs\o{500}|/i \o{600} y $& # [GH #18451] # Keep these lines at the end of the file # pat string y/n/etc expr expected-expr skip-reason comment # vim: softtabstop=0 noexpandtab From 036189b0a003875df7bf09c7f7fd702267f549e5 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 26 Dec 2020 08:44:08 -0700 Subject: [PATCH 380/503] Use perl.h versions of PERL_UNUSED_foo in XSUB.h This commit was applied to perl.h, but not to XSUB.h: commit a730e3f230f364cffe49370f816f975ae7c9c403 Author: Jarkko Hietaniemi Date: Thu Sep 4 09:08:33 2014 -0400 Use sizeof() in UNUSED_ARG and UNUSED_VAR to avoid accessing the values. The values might even be uninitialized in the case of PERL_UNUSED_VAR. --- XSUB.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/XSUB.h b/XSUB.h index 616d8138401a..c1e395988542 100644 --- a/XSUB.h +++ b/XSUB.h @@ -108,10 +108,10 @@ is a lexical C<$_> in scope. */ #ifndef PERL_UNUSED_ARG -# define PERL_UNUSED_ARG(x) ((void)x) +# define PERL_UNUSED_ARG(x) ((void)sizeof(x)) #endif #ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)x) +# define PERL_UNUSED_VAR(x) ((void)sizeof(x)) #endif #define ST(off) PL_stack_base[ax + (off)] From 7f02c1397bd1a1ff685776c0bde8d553793c031d Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 29 Aug 2020 10:55:47 -0600 Subject: [PATCH 381/503] Document various CopSTASHfoo functions --- cop.h | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/cop.h b/cop.h index 96b6739b1914..a1f5b921bb12 100644 --- a/cop.h +++ b/cop.h @@ -446,6 +446,23 @@ Returns the GV associated with the C C Available only on unthreaded perls. Makes C the name of the file associated with the C C +=for apidoc Am|HV *|CopSTASH|const COP * c +Returns the stash associated with C. + +=for apidoc Am|bool|CopSTASH_eq|const COP * c|const HV * hv +Returns a boolean as to whether or not C is the stash associated with C. + +=for apidoc Am|bool|CopSTASH_set|COP * c|HV * hv +Set the stash associated with C to C. + +=for apidoc Am|char *|CopSTASHPV|const COP * c +Returns the package name of the stash associated with C, or C if no +associated stash + +=for apidoc Am|void|CopSTASHPV_set|COP * c|const char * pv +Set the package name of the stash associated with C, to the NUL-terminated C +string C

, creating the package if necessary. + =cut */ From 0f14f058b16bfb27c6240d4ea745a895c7e6dd28 Mon Sep 17 00:00:00 2001 From: Felipe Gasper Date: Tue, 29 Dec 2020 03:22:40 -0500 Subject: [PATCH 382/503] Signatures: add argument counts to count-mismatch error messages. Issue #18405 --- pod/perldelta.pod | 3 +- pod/perldiag.pod | 20 ++- pp.c | 15 ++- t/op/signatures.t | 303 ++++++++++++++++++++++++---------------------- 4 files changed, 190 insertions(+), 151 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index a6c8b9426ddd..60fa1d05291b 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -218,7 +218,8 @@ XXX Changes (i.e. rewording) of diagnostic messages go here =item * -XXX Describe change here +Subroutine argument-count mismatch errors now include the number of +given and expected arguments. =item * diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 46e86a1a5ddb..b21102e2485d 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -6307,14 +6307,20 @@ See L. (F) There has to be at least one argument to syscall() to specify the system call to call, silly dilly. -=item Too few arguments for subroutine '%s' +=item Too few arguments for subroutine '%s' (got %d; expected %d) (F) A subroutine using a signature fewer arguments than required by the signature. The caller of the subroutine is presumably at fault. The message attempts to include the name of the called subroutine. If the subroutine has been aliased, the subroutine's original name will be -shown, regardless of what name the caller used. +shown, regardless of what name the caller used. It will also indicate the +number of arguments given and the number expected. + +=item Too few arguments for subroutine '%s' (got %d; expected at least %d) + +Similar to the previous message but for subroutines that accept a variable +number of arguments. =item Too late for "-%s" option @@ -6346,14 +6352,20 @@ BEGIN block. (F) The function requires fewer arguments than you specified. -=item Too many arguments for subroutine '%s' +=item Too many arguments for subroutine '%s' (got %d; expected %d) (F) A subroutine using a signature received more arguments than permitted by the signature. The caller of the subroutine is presumably at fault. The message attempts to include the name of the called subroutine. If the subroutine has been aliased, the subroutine's original name will be shown, -regardless of what name the caller used. +regardless of what name the caller used. It will also indicate the number +of arguments given and the number expected. + +=item Too many arguments for subroutine '%s' (got %d; expected at most %d) + +Similar to the previous message but for subroutines that accept a variable +number of arguments. =item Too many nested open parens in regex; marked by <-- HERE in m/%s/ diff --git a/pp.c b/pp.c index 23cc6c8adba6..d0e639fa3235 100644 --- a/pp.c +++ b/pp.c @@ -7151,10 +7151,17 @@ PP(pp_argcheck) too_few = (argc < (params - opt_params)); if (UNLIKELY(too_few || (!slurpy && argc > params))) - /* diag_listed_as: Too few arguments for subroutine '%s' */ - /* diag_listed_as: Too many arguments for subroutine '%s' */ - Perl_croak_caller("Too %s arguments for subroutine '%" SVf "'", - too_few ? "few" : "many", S_find_runcv_name()); + + /* diag_listed_as: Too few arguments for subroutine '%s' (got %d; expected %d) */ + /* diag_listed_as: Too few arguments for subroutine '%s' (got %d; expected at least %d) */ + /* diag_listed_as: Too many arguments for subroutine '%s' (got %d; expected %d) */ + /* diag_listed_as: Too many arguments for subroutine '%s' (got %d; expected at most %d)*/ + Perl_croak_caller("Too %s arguments for subroutine '%" SVf "' (got %" UVuf "; expected %s%" UVuf ")", + too_few ? "few" : "many", + S_find_runcv_name(), + argc, + too_few ? (slurpy || opt_params ? "at least " : "") : (opt_params ? "at most " : ""), + too_few ? (params - opt_params) : params); if (UNLIKELY(slurpy == '%' && argc > params && (argc - params) % 2)) /* diag_listed_as: Odd name/value argument for subroutine '%s' */ diff --git a/t/op/signatures.t b/t/op/signatures.t index 80fde83cffab..d22d11b5174b 100644 --- a/t/op/signatures.t +++ b/t/op/signatures.t @@ -37,129 +37,148 @@ is eval("t001(456)"), 123; is eval("t001(456, 789)"), 123; is $a, 123; +sub _create_mismatch_regexp { + my ($funcname, $got, $expected, $flexible_str) = @_; + + my $many_few_str = ($got > $expected) ? 'many' : 'few'; + + $flexible_str //= q<>; + + return qr/\AToo $many_few_str arguments for subroutine '$funcname' \(got $got; expected $flexible_str$expected\) at \(eval \d+\) line 1\.\n\z/; +} + +sub _create_flexible_mismatch_regexp { + my ($funcname, $got, $expected) = @_; + + my $flexible_str = ($got > $expected) ? 'at most' : 'at least'; + $flexible_str .= q< >; + + return _create_mismatch_regexp($funcname, $got, $expected, $flexible_str); +} + sub t002 () { $a || "z" } is prototype(\&t002), undef; is eval("t002()"), 123; is eval("t002(456)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t002', 1, 0); is eval("t002(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t002' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t002', 2, 0); is $a, 123; sub t003 ( ) { $a || "z" } is prototype(\&t003), undef; is eval("t003()"), 123; is eval("t003(456)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t003', 1, 0); is eval("t003(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t003' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t003', 2, 0); is $a, 123; sub t006 ($a) { $a || "z" } is prototype(\&t006), undef; is eval("t006()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t006', 0, 1); is eval("t006(0)"), "z"; is eval("t006(456)"), 456; is eval("t006(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t006', 2, 1); is eval("t006(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t006' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t006', 3, 1); is $a, 123; sub t007 ($a, $b) { $a.$b } is prototype(\&t007), undef; is eval("t007()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t007', 0, 2); is eval("t007(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t007', 1, 2); is eval("t007(456, 789)"), "456789"; is eval("t007(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t007', 3, 2); is eval("t007(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t007' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t007', 4, 2); is $a, 123; sub t008 ($a, $b, $c) { $a.$b.$c } is prototype(\&t008), undef; is eval("t008()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t008', 0, 3); is eval("t008(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t008', 1, 3); is eval("t008(456, 789)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t008', 2, 3); is eval("t008(456, 789, 987)"), "456789987"; is eval("t008(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t008' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t008', 4, 3); is $a, 123; sub t009 ($abc, $def) { $abc.$def } is prototype(\&t009), undef; is eval("t009()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t009', 0, 2); is eval("t009(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t009', 1, 2); is eval("t009(456, 789)"), "456789"; is eval("t009(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t009', 3, 2); is eval("t009(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t009' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t009', 4, 2); is $a, 123; sub t010 ($a, $) { $a || "z" } is prototype(\&t010), undef; is eval("t010()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t010', 0, 2); is eval("t010(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t010', 1, 2); is eval("t010(0, 789)"), "z"; is eval("t010(456, 789)"), 456; is eval("t010(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t010', 3, 2); is eval("t010(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t010' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t010', 4, 2); is $a, 123; sub t011 ($, $a) { $a || "z" } is prototype(\&t011), undef; is eval("t011()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t011', 0, 2); is eval("t011(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t011', 1, 2); is eval("t011(456, 0)"), "z"; is eval("t011(456, 789)"), 789; is eval("t011(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t011', 3, 2); is eval("t011(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t011' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t011', 4, 2); is $a, 123; sub t012 ($, $) { $a || "z" } is prototype(\&t012), undef; is eval("t012()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t012', 0, 2); is eval("t012(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t012', 1, 2); is eval("t012(0, 789)"), 123; is eval("t012(456, 789)"), 123; is eval("t012(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t012', 3, 2); is eval("t012(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t012' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t012', 4, 2); is $a, 123; sub t013 ($) { $a || "z" } is prototype(\&t013), undef; is eval("t013()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t013', 0, 1); is eval("t013(0)"), 123; is eval("t013(456)"), 123; is eval("t013(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t013', 2, 1); is eval("t013(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t013', 3, 1); is eval("t013(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t013' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t013', 4, 1); is $a, 123; sub t014 ($a = 222) { $a // "z" } @@ -169,9 +188,9 @@ is eval("t014(0)"), 0; is eval("t014(undef)"), "z"; is eval("t014(456)"), 456; is eval("t014(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t014', 2, 1); is eval("t014(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t014' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t014', 3, 1); is $a, 123; sub t015 ($a = undef) { $a // "z" } @@ -181,9 +200,9 @@ is eval("t015(0)"), 0; is eval("t015(undef)"), "z"; is eval("t015(456)"), 456; is eval("t015(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t015', 2, 1); is eval("t015(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t015' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t015', 3, 1); is $a, 123; sub t016 ($a = do { $z++; 222 }) { $a // "z" } @@ -195,9 +214,9 @@ is eval("t016(0)"), 0; is eval("t016(undef)"), "z"; is eval("t016(456)"), 456; is eval("t016(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t016', 2, 1); is eval("t016(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t016' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t016', 3, 1); is $z, 1; is eval("t016()"), 222; is $z, 2; @@ -213,9 +232,9 @@ is eval("t017(0)"), 0; is eval("t017(undef)"), "z"; is eval("t017(456)"), 456; is eval("t017(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t017', 2, 1); is eval("t017(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t017' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t017', 3, 1); is $a, 123; sub t019 ($p = 222, $a = 333) { "$p/$a" } @@ -225,7 +244,7 @@ is eval("t019(0)"), "0/333"; is eval("t019(456)"), "456/333"; is eval("t019(456, 789)"), "456/789"; is eval("t019(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t019' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t019', 3, 2); is $a, 123; sub t020 :prototype($) { $_[0]."z" } @@ -236,7 +255,7 @@ is eval("t021(0)"), "0/333"; is eval("t021(456)"), "456/333"; is eval("t021(456, 789)"), "456/789"; is eval("t021(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t021' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t021', 3, 2); is $a, 123; sub t022 ($p = do { $z += 10; 222 }, $a = do { $z++; 333 }) { "$p/$a" } @@ -250,7 +269,7 @@ is eval("t022(456)"), "456/333"; is $z, 13; is eval("t022(456, 789)"), "456/789"; is eval("t022(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t022' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t022', 3, 2); is $z, 13; is $a, 123; @@ -259,7 +278,7 @@ is prototype(\&t023), undef; is eval("t023()"), "azy"; is eval("t023(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; is eval("t023(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t023' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t023', 2, 1); is $a, 123; sub t036 ($a = $a."x") { $a."y" } @@ -268,7 +287,7 @@ is eval("t036()"), "123xy"; is eval("t036(0)"), "0y"; is eval("t036(456)"), "456y"; is eval("t036(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t036' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t036', 2, 1); is $a, 123; sub t120 ($a = $_) { $a // "z" } @@ -283,7 +302,7 @@ $_ = "___"; is eval("t120(456)"), 456; $_ = "___"; is eval("t120(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t120' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t120', 2, 1); is $a, 123; sub t121 ($a = caller) { $a // "z" } @@ -293,13 +312,13 @@ is eval("t121(undef)"), "z"; is eval("t121(0)"), 0; is eval("t121(456)"), 456; is eval("t121(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t121', 2, 1); is eval("package T121::Z; ::t121()"), "T121::Z"; is eval("package T121::Z; ::t121(undef)"), "z"; is eval("package T121::Z; ::t121(0)"), 0; is eval("package T121::Z; ::t121(456)"), 456; is eval("package T121::Z; ::t121(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t121' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t121', 2, 1); is $a, 123; sub t129 ($a = return 222) { $a."x" } @@ -308,7 +327,7 @@ is eval("t129()"), "222"; is eval("t129(0)"), "0x"; is eval("t129(456)"), "456x"; is eval("t129(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t129' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t129', 2, 1); is $a, 123; use feature "current_sub"; @@ -320,7 +339,7 @@ is eval("t122(1)"), "10"; is eval("t122(5)"), "543210"; is eval("t122(5, 789)"), "5789"; is eval("t122(5, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t122' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t122', 3, 2); is $a, 123; sub t123 ($list = wantarray) { $list ? "list" : "scalar" } @@ -332,7 +351,7 @@ is eval("(t123(0))[0]"), "scalar"; is eval("scalar(t123(1))"), "list"; is eval("(t123(1))[0]"), "list"; is eval("t123(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t123' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t123', 2, 1); is $a, 123; sub t124 ($b = (local $a = $a + 1)) { "$a/$b" } @@ -342,7 +361,7 @@ is $a, 123; is eval("t124(456)"), "123/456"; is $a, 123; is eval("t124(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t124' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t124', 2, 1); is $a, 123; sub t125 ($c = (our $t125_counter)++) { $c } @@ -355,7 +374,7 @@ is eval("t125(789)"), 789; is eval("t125()"), 3; is eval("t125()"), 4; is eval("t125(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t125' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t125', 2, 1); is $a, 123; use feature "state"; @@ -371,7 +390,7 @@ is $z, 223; is eval("t126()"), 222; is $z, 223; is eval("t126(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t126' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t126', 2, 1); is $z, 223; is $a, 123; @@ -390,7 +409,7 @@ is eval("t127(789)"), 789; is eval("t127()"), 225; is eval("t127()"), 226; is eval("t127(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t127' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t127', 2, 1); is $z, 223; is $a, 123; @@ -401,7 +420,7 @@ is eval("t037(0)"), "0/0x"; is eval("t037(456)"), "456/456x"; is eval("t037(456, 789)"), "456/789"; is eval("t037(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t037' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t037', 3, 2); is $a, 123; sub t128 ($a = 222, $b = ($a = 333)) { "$a/$b" } @@ -411,7 +430,7 @@ is eval("t128(0)"), "333/333"; is eval("t128(456)"), "333/333"; is eval("t128(456, 789)"), "456/789"; is eval("t128(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t128' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t128', 3, 2); is $a, 123; sub t130 { join(",", @_).";".scalar(@_) } @@ -422,7 +441,7 @@ is eval("t131(0)"), "0;1"; is eval("t131(456)"), "456;1"; is eval("t131(456, 789)"), "456/789"; is eval("t131(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t131' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t131', 3, 2); is $a, 123; eval "#line 8 foo\nsub t024 (\$a =) { }"; @@ -435,11 +454,11 @@ is eval("t025()"), 123; is eval("t025(0)"), 123; is eval("t025(456)"), 123; is eval("t025(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t025', 2, 1); is eval("t025(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t025', 3, 1); is eval("t025(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t025' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t025', 4, 1); is $a, 123; sub t026 ($ = 222) { $a // "z" } @@ -448,11 +467,11 @@ is eval("t026()"), 123; is eval("t026(0)"), 123; is eval("t026(456)"), 123; is eval("t026(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t026', 2, 1); is eval("t026(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t026', 3, 1); is eval("t026(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t026' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t026', 4, 1); is $a, 123; sub t032 ($ = do { $z++; 222 }) { $a // "z" } @@ -463,11 +482,11 @@ is $z, 1; is eval("t032(0)"), 123; is eval("t032(456)"), 123; is eval("t032(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t032', 2, 1); is eval("t032(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t032', 3, 1); is eval("t032(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t032' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t032', 4, 1); is $z, 1; is $a, 123; @@ -477,11 +496,11 @@ is eval("t027()"), 123; is eval("t027(0)"), 123; is eval("t027(456)"), 123; is eval("t027(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t027', 2, 1); is eval("t027(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t027', 3, 1); is eval("t027(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t027' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t027', 4, 1); is $a, 123; sub t119 ($ =, $a = 333) { $a // "z" } @@ -491,81 +510,81 @@ is eval("t119(0)"), 333; is eval("t119(456)"), 333; is eval("t119(456, 789)"), 789; is eval("t119(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t119', 3, 2); is eval("t119(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t119' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t119', 4, 2); is $a, 123; sub t028 ($a, $b = 333) { "$a/$b" } is prototype(\&t028), undef; is eval("t028()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t028', 0, 1); is eval("t028(0)"), "0/333"; is eval("t028(456)"), "456/333"; is eval("t028(456, 789)"), "456/789"; is eval("t028(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t028' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t028', 3, 2); is $a, 123; sub t045 ($a, $ = 333) { "$a/" } is prototype(\&t045), undef; is eval("t045()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t045', 0, 1); is eval("t045(0)"), "0/"; is eval("t045(456)"), "456/"; is eval("t045(456, 789)"), "456/"; is eval("t045(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t045' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t045', 3, 2); is $a, 123; sub t046 ($, $b = 333) { "$a/$b" } is prototype(\&t046), undef; is eval("t046()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t046', 0, 1); is eval("t046(0)"), "123/333"; is eval("t046(456)"), "123/333"; is eval("t046(456, 789)"), "123/789"; is eval("t046(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t046' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t046', 3, 2); is $a, 123; sub t047 ($, $ = 333) { "$a/" } is prototype(\&t047), undef; is eval("t047()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t047', 0, 1); is eval("t047(0)"), "123/"; is eval("t047(456)"), "123/"; is eval("t047(456, 789)"), "123/"; is eval("t047(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t047' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t047', 3, 2); is $a, 123; sub t029 ($a, $b, $c = 222, $d = 333) { "$a/$b/$c/$d" } is prototype(\&t029), undef; is eval("t029()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t029', 0, 2); is eval("t029(0)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t029', 1, 2); is eval("t029(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t029', 1, 2); is eval("t029(456, 789)"), "456/789/222/333"; is eval("t029(456, 789, 987)"), "456/789/987/333"; is eval("t029(456, 789, 987, 654)"), "456/789/987/654"; is eval("t029(456, 789, 987, 654, 321)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t029', 5, 4); is eval("t029(456, 789, 987, 654, 321, 111)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t029' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t029', 6, 4); is $a, 123; sub t038 ($a, $b = $a."x") { "$a/$b" } is prototype(\&t038), undef; is eval("t038()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t038', 0, 1); is eval("t038(0)"), "0/0x"; is eval("t038(456)"), "456/456x"; is eval("t038(456, 789)"), "456/789"; is eval("t038(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t038' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t038', 3, 2); is $a, 123; eval "#line 8 foo\nsub t030 (\$a = 222, \$b) { }"; @@ -660,7 +679,7 @@ is $@, qq{A slurpy parameter may not have a default value at foo line 8, near "= sub t041 ($a, @b) { $a.";".join("/", @b) } is prototype(\&t041), undef; is eval("t041()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t041' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t041', 0, 1); is eval("t041(0)"), "0;"; is eval("t041(456)"), "456;"; is eval("t041(456, 789)"), "456;789"; @@ -673,7 +692,7 @@ is $a, 123; sub t042 ($a, @) { $a.";" } is prototype(\&t042), undef; is eval("t042()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t042' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t042', 0, 1); is eval("t042(0)"), "0;"; is eval("t042(456)"), "456;"; is eval("t042(456, 789)"), "456;"; @@ -686,7 +705,7 @@ is $a, 123; sub t043 ($, @b) { $a.";".join("/", @b) } is prototype(\&t043), undef; is eval("t043()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t043' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t043', 0, 1); is eval("t043(0)"), "123;"; is eval("t043(456)"), "123;"; is eval("t043(456, 789)"), "123;789"; @@ -699,7 +718,7 @@ is $a, 123; sub t044 ($, @) { $a.";" } is prototype(\&t044), undef; is eval("t044()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t044' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t044', 0, 1); is eval("t044(0)"), "123;"; is eval("t044(456)"), "123;"; is eval("t044(456, 789)"), "123;"; @@ -712,7 +731,7 @@ is $a, 123; sub t049 ($a, %b) { $a.";".join("/", map { $_."=".$b{$_} } sort keys %b) } is prototype(\&t049), undef; is eval("t049()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t049', 0, 1); is eval("t049(222)"), "222;"; is eval("t049(222, 456)"), undef; like $@, qr#\AOdd name/value argument for subroutine 'main::t049' at \(eval \d+\) line 1\.\n\z#; @@ -729,11 +748,11 @@ is $a, 123; sub t051 ($a, $b, $c, @d) { "$a;$b;$c;".join("/", @d).";".scalar(@d) } is prototype(\&t051), undef; is eval("t051()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t051', 0, 3); is eval("t051(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t051', 1, 3); is eval("t051(456, 789)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t051' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t051', 2, 3); is eval("t051(456, 789, 987)"), "456;789;987;;0"; is eval("t051(456, 789, 987, 654)"), "456;789;987;654;1"; is eval("t051(456, 789, 987, 654, 321)"), "456;789;987;654/321;2"; @@ -743,9 +762,9 @@ is $a, 123; sub t052 ($a, $b, %c) { "$a;$b;".join("/", map { $_."=".$c{$_} } sort keys %c) } is prototype(\&t052), undef; is eval("t052()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t052', 0, 2); is eval("t052(222)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t052', 1, 2); is eval("t052(222, 333)"), "222;333;"; is eval("t052(222, 333, 456)"), undef; like $@, qr#\AOdd name/value argument for subroutine 'main::t052' at \(eval \d+\) line 1\.\n\z#; @@ -764,11 +783,11 @@ sub t053 ($a, $b, $c, %d) { } is prototype(\&t053), undef; is eval("t053()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t053', 0, 3); is eval("t053(222)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t053', 1, 3); is eval("t053(222, 333)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t053', 2, 3); is eval("t053(222, 333, 444)"), "222;333;444;"; is eval("t053(222, 333, 444, 456)"), undef; like $@, qr#\AOdd name/value argument for subroutine 'main::t053' at \(eval \d+\) line 1\.\n\z#; @@ -878,7 +897,7 @@ is $a, 123; sub t058 ($a, $b = 333, @c) { "$a;$b;".join("/", @c).";".scalar(@c) } is prototype(\&t058), undef; is eval("t058()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t058' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t058', 0, 1); is eval("t058(456)"), "456;333;;0"; is eval("t058(456, 789)"), "456;789;;0"; is eval("t058(456, 789, 987)"), "456;789;987;1"; @@ -956,27 +975,27 @@ EOF sub t080 ($a,,, $b) { $a.$b } is prototype(\&t080), undef; is eval("t080()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t080', 0, 2); is eval("t080(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t080', 1, 2); is eval("t080(456, 789)"), "456789"; is eval("t080(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t080', 3, 2); is eval("t080(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t080' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t080', 4, 2); is $a, 123; sub t081 ($a, $b,,) { $a.$b } is prototype(\&t081), undef; is eval("t081()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t081', 0, 2); is eval("t081(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t081', 1, 2); is eval("t081(456, 789)"), "456789"; is eval("t081(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t081', 3, 2); is eval("t081(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t081' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t081', 4, 2); is $a, 123; eval "#line 8 foo\nsub t082 (, \$a) { }"; @@ -988,14 +1007,14 @@ is $@, qq{syntax error at foo line 8, near "(,"\n}; sub t084($a,$b){ $a.$b } is prototype(\&t084), undef; is eval("t084()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t084', 0, 2); is eval("t084(456)"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t084', 1, 2); is eval("t084(456, 789)"), "456789"; is eval("t084(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t084', 3, 2); is eval("t084(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t084' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t084', 4, 2); is $a, 123; sub t085 @@ -1014,13 +1033,13 @@ sub t085 { $a.$b } is prototype(\&t085), undef; is eval("t085()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t085', 0, 1); is eval("t085(456)"), "456333"; is eval("t085(456, 789)"), "456789"; is eval("t085(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t085', 3, 2); is eval("t085(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t085' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t085', 4, 2); is $a, 123; sub t086 @@ -1039,13 +1058,13 @@ sub t086 { $a.$b } is prototype(\&t086), undef; is eval("t086()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t086', 0, 1); is eval("t086(456)"), "456333"; is eval("t086(456, 789)"), "456789"; is eval("t086(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t086', 3, 2); is eval("t086(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t086' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t086', 4, 2); is $a, 123; sub t087 @@ -1064,13 +1083,13 @@ sub t087 { $a.$b } is prototype(\&t087), undef; is eval("t087()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t087', 0, 1); is eval("t087(456)"), "456333"; is eval("t087(456, 789)"), "456789"; is eval("t087(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t087', 3, 2); is eval("t087(456, 789, 987, 654)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t087' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t087', 4, 2); is $a, 123; eval "#line 8 foo\nsub t088 (\$ #foo\na) { }"; @@ -1134,25 +1153,25 @@ like $@, qr/\ACan't use global \%_ in subroutine signature at foo line 8/; my $t103 = sub ($a) { $a || "z" }; is prototype($t103), undef; is eval("\$t103->()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 0, 1); is eval("\$t103->(0)"), "z"; is eval("\$t103->(456)"), 456; is eval("\$t103->(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 2, 1); is eval("\$t103->(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 3, 1); is $a, 123; my $t118 = sub :prototype($) ($a) { $a || "z" }; is prototype($t118), "\$"; is eval("\$t118->()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 0, 1); is eval("\$t118->(0)"), "z"; is eval("\$t118->(456)"), 456; is eval("\$t118->(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 2, 1); is eval("\$t118->(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::__ANON__' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::__ANON__', 3, 1); is $a, 123; sub t033 ($a = sub ($a) { $a."z" }) { $a->("a")."y" } @@ -1160,7 +1179,7 @@ is prototype(\&t033), undef; is eval("t033()"), "azy"; is eval("t033(sub { \"x\".\$_[0].\"x\" })"), "xaxy"; is eval("t033(sub { \"x\".\$_[0].\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t033' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t033', 2, 1); is $a, 123; sub t133 ($a = sub ($a = 222) { $a."z" }) { $a->()."/".$a->("a") } @@ -1168,7 +1187,7 @@ is prototype(\&t133), undef; is eval("t133()"), "222z/az"; is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" })"), "xux/xax"; is eval("t133(sub { \"x\".(\$_[0] // \"u\").\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t133' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t133', 2, 1); is $a, 123; sub t134 ($a = sub ($a, $t = sub { $_[0]."p" }) { $t->($a)."z" }) { @@ -1180,7 +1199,7 @@ is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t134(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t134' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t134', 2, 1); is $a, 123; sub t135 ($a = sub ($a, $t = sub ($p) { $p."p" }) { $t->($a)."z" }) { @@ -1192,7 +1211,7 @@ is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t135(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t135' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t135', 2, 1); is $a, 123; sub t132 ( @@ -1206,19 +1225,19 @@ is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" })"), "xax/xbqx"; is eval("t132(sub { \"x\".(\$_[1] // sub{\$_[0]})->(\$_[0]).\"x\" }, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t132' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_flexible_mismatch_regexp('main::t132', 2, 1); is $a, 123; sub t104 :method ($a) { $a || "z" } is prototype(\&t104), undef; is eval("t104()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t104', 0, 1); is eval("t104(0)"), "z"; is eval("t104(456)"), 456; is eval("t104(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t104', 2, 1); is eval("t104(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t104' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t104', 3, 1); is $a, 123; sub t105 :prototype($) ($a) { $a || "z" } @@ -1236,13 +1255,13 @@ is $a, 123; sub t106 :prototype(@) ($a) { $a || "z" } is prototype(\&t106), "\@"; is eval("t106()"), undef; -like $@, qr/\AToo few arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t106', 0, 1); is eval("t106(0)"), "z"; is eval("t106(456)"), 456; is eval("t106(456, 789)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t106', 2, 1); is eval("t106(456, 789, 987)"), undef; -like $@, qr/\AToo many arguments for subroutine 'main::t106' at \(eval \d+\) line 1\.\n\z/; +like $@, _create_mismatch_regexp('main::t106', 3, 1); is $a, 123; eval "#line 8 foo\nsub t107(\$a) :method { }"; From 5bd38fbfd04fc614128ba3d481fc326ef9fddbfa Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Sat, 2 Jan 2021 16:37:39 -0600 Subject: [PATCH 383/503] sprintf does not display 54 digits on VMS It displays 17, which is what Perl and apparently just about everybody else used to do. I'm not convinced there was ever a bug here as no standard I can find says you have to display 3 times as many digits as are necessary to provide a non-lossy round trip from double to character and back. --- t/op/sprintf2.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/op/sprintf2.t b/t/op/sprintf2.t index b1996e70cc0b..aa942df5fba6 100644 --- a/t/op/sprintf2.t +++ b/t/op/sprintf2.t @@ -1187,6 +1187,8 @@ if($Config{nvsize} == 8) { TODO: { local $::TODO = 'Extended precision %g formatting' if $^O eq 'cygwin' or + $^O eq 'VMS' + or ($^O eq 'MSWin32' and $Config{cc} eq 'cl' and $Config{ccversion} =~ /^(\d+)/ and From 08ac607a2fe5c53538767d3fe608e98f726e0bec Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Sat, 2 Jan 2021 16:48:21 -0600 Subject: [PATCH 384/503] Revert "Fix Time::HiRes compile probe on VMS" This reverts commit 9eebd4ca7bb8610f51a27d96c12e9b1676958d55. It turns out that probing for the existence of functions also only generates informational messages (and thus a successful exit status) when the function is missing, e.g.: ret = clock_nanosleep(CLOCK_REALTIME, 0, &ts1, &ts2); ..........^ %CC-I-IMPLICITFUNC, In this statement, the identifier "clock_nanosleep" is implicitly declared as a function. at line number 13 in file D0:[craig.blead.dist.Time-HiRes]try.c;1 And we aren't linking in Time::HiRes's probes on VMS since making that work both in and out of core in a general way is no small feat. So we go back to requiring no compiler messages in the test compiles. --- Porting/Maintainers.pl | 3 --- dist/Time-HiRes/Makefile.PL | 2 +- t/porting/customized.dat | 1 - 3 files changed, 1 insertion(+), 5 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index ed248761c728..66330fe4f451 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1206,9 +1206,6 @@ package Maintainers; 'Time::HiRes' => { 'DISTRIBUTION' => 'ATOOMIC/Time-HiRes-1.9764.tar.gz', 'FILES' => q[dist/Time-HiRes], - 'CUSTOMIZED' => [ - qw( Makefile.PL ), - ], }, 'Time::Local' => { diff --git a/dist/Time-HiRes/Makefile.PL b/dist/Time-HiRes/Makefile.PL index 0c01fc03e8ac..c918cd14545b 100644 --- a/dist/Time-HiRes/Makefile.PL +++ b/dist/Time-HiRes/Makefile.PL @@ -88,7 +88,7 @@ __EOD__ open( CMDFILE, '>', "$tmp.com" ); print CMDFILE "\$ SET MESSAGE/NOFACILITY/NOSEVERITY/NOIDENT/NOTEXT\n"; print CMDFILE "\$ $cccmd\n"; - print CMDFILE "\$ IF .NOT. \$SEVERITY THEN EXIT 44\n"; # escalate + print CMDFILE "\$ IF \$SEVERITY .NE. 1 THEN EXIT 44\n"; # escalate close CMDFILE; system("\@ $tmp.com"); $ok = $?==0; diff --git a/t/porting/customized.dat b/t/porting/customized.dat index c90372da1388..bf97579afee5 100644 --- a/t/porting/customized.dat +++ b/t/porting/customized.dat @@ -22,7 +22,6 @@ Net::Ping dist/Net-Ping/t/500_ping_icmp.t 3eeb60181c01b85f876bd6658644548fdf2e24 Net::Ping dist/Net-Ping/t/501_ping_icmpv6.t 54373de5858f8fb7e078e4998a4b3b8dbca91783 Pod::Perldoc cpan/Pod-Perldoc/lib/Pod/Perldoc.pm 582be34c077c9ff44d99914724a0cc2140bcd48c Test::Harness cpan/Test-Harness/t/source.t aaa3939591114c0c52ecd44159218336d1f762b9 -Time::HiRes dist/Time-HiRes/Makefile.PL a8c1da5ec1672780e453304925ee0615b422c61f Win32API::File cpan/Win32API-File/File.pm 8fd212857f821cb26648878b96e57f13bf21b99e Win32API::File cpan/Win32API-File/File.xs beb870fed4490d2faa547b4a8576b8d64d1d27c5 experimental cpan/experimental/t/basic.t cb9da8dd05b854375809872a05dd32637508d5da From ded7c7ec0c875ea7bd53811b9db312f3b2e85a95 Mon Sep 17 00:00:00 2001 From: "Craig A. Berry" Date: Sat, 2 Jan 2021 17:09:20 -0600 Subject: [PATCH 385/503] Remove trailing semicolon from ALIGNED_TYPE definition Every use of it already has its own semicolon, and duplicating it can lead to warnings like this: ALIGNED_TYPE(XPVGV); ...................^ %CC-I-EXTRASEMI, Extraneous semicolon. at line number 894 in file D0:[craig.blead]sv.c;1 --- sv.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sv.c b/sv.c index 15ec9db7e58e..828f685132bb 100644 --- a/sv.c +++ b/sv.c @@ -888,7 +888,7 @@ struct body_details { name align_me; \ NV nv; \ IV iv; \ - } ALIGNED_TYPE_NAME(name); + } ALIGNED_TYPE_NAME(name) ALIGNED_TYPE(regexp); ALIGNED_TYPE(XPVGV); From 0f2beabb08039ae97dbc9dc54dff894c14b6e38b Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 8 Jun 2020 10:13:35 +1000 Subject: [PATCH 386/503] add a bareword_filehandles feature, which is enabled by default This disables use of bareword filehandles except for the built-in handles --- MANIFEST | 1 + embed.fnc | 1 + embed.h | 1 + feature.h | 49 +-- lib/feature.pm | 139 +++++---- op.c | 23 ++ pod/perldiag.pod | 9 + proto.h | 3 + regen/feature.pl | 23 +- t/lib/feature/bareword_filehandles | 486 +++++++++++++++++++++++++++++ t/porting/known_pod_issues.dat | 1 + toke.c | 10 + 12 files changed, 669 insertions(+), 77 deletions(-) create mode 100644 t/lib/feature/bareword_filehandles diff --git a/MANIFEST b/MANIFEST index eed88d7f511a..53c500da8dc4 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5622,6 +5622,7 @@ t/lib/Devel/nodb.pm Module for t/run/switchd.t t/lib/Devel/switchd.pm Module for t/run/switchd.t t/lib/Devel/switchd_empty.pm Module for t/run/switchd.t t/lib/Devel/switchd_goto.pm Module for t/run/switchd.t +t/lib/feature/bareword_filehandles Tests for enabling/disabling bareword_filehandles feature t/lib/feature/bits Tests for feature bit handling t/lib/feature/bundle Tests for feature bundles t/lib/feature/implicit Tests for implicit loading of feature.pm diff --git a/embed.fnc b/embed.fnc index 573ecc5acaa4..e633097f9b8d 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2896,6 +2896,7 @@ S |bool |process_special_blocks |I32 floor \ S |void |clear_special_blocks |NN const char *const fullname\ |NN GV *const gv|NN CV *const cv #endif +p |void |no_bareword_filehandle|NN const char *fhname XpR |void* |Slab_Alloc |size_t sz Xp |void |Slab_Free |NN void *op #if defined(PERL_DEBUG_READONLY_OPS) diff --git a/embed.h b/embed.h index fd5f3b426459..d3a60006d8a6 100644 --- a/embed.h +++ b/embed.h @@ -1408,6 +1408,7 @@ #define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b) #define newXS_len_flags(a,b,c,d,e,f,g) Perl_newXS_len_flags(aTHX_ a,b,c,d,e,f,g) #define nextargv(a,b) Perl_nextargv(aTHX_ a,b) +#define no_bareword_filehandle(a) Perl_no_bareword_filehandle(aTHX_ a) #define noperl_die Perl_noperl_die #define notify_parser_that_changed_to_utf8() Perl_notify_parser_that_changed_to_utf8(aTHX) #define oopsAV(a) Perl_oopsAV(aTHX_ a) diff --git a/feature.h b/feature.h index 20f799696ae6..173719f2b96e 100644 --- a/feature.h +++ b/feature.h @@ -12,22 +12,23 @@ #define HINT_FEATURE_SHIFT 26 -#define FEATURE_BITWISE_BIT 0x0001 -#define FEATURE___SUB___BIT 0x0002 -#define FEATURE_MYREF_BIT 0x0004 -#define FEATURE_EVALBYTES_BIT 0x0008 -#define FEATURE_FC_BIT 0x0010 -#define FEATURE_INDIRECT_BIT 0x0020 -#define FEATURE_ISA_BIT 0x0040 -#define FEATURE_MULTIDIMENSIONAL_BIT 0x0080 -#define FEATURE_POSTDEREF_QQ_BIT 0x0100 -#define FEATURE_REFALIASING_BIT 0x0200 -#define FEATURE_SAY_BIT 0x0400 -#define FEATURE_SIGNATURES_BIT 0x0800 -#define FEATURE_STATE_BIT 0x1000 -#define FEATURE_SWITCH_BIT 0x2000 -#define FEATURE_UNIEVAL_BIT 0x4000 -#define FEATURE_UNICODE_BIT 0x8000 +#define FEATURE_BAREWORD_FILEHANDLES_BIT 0x0001 +#define FEATURE_BITWISE_BIT 0x0002 +#define FEATURE___SUB___BIT 0x0004 +#define FEATURE_MYREF_BIT 0x0008 +#define FEATURE_EVALBYTES_BIT 0x0010 +#define FEATURE_FC_BIT 0x0020 +#define FEATURE_INDIRECT_BIT 0x0040 +#define FEATURE_ISA_BIT 0x0080 +#define FEATURE_MULTIDIMENSIONAL_BIT 0x0100 +#define FEATURE_POSTDEREF_QQ_BIT 0x0200 +#define FEATURE_REFALIASING_BIT 0x0400 +#define FEATURE_SAY_BIT 0x0800 +#define FEATURE_SIGNATURES_BIT 0x1000 +#define FEATURE_STATE_BIT 0x2000 +#define FEATURE_SWITCH_BIT 0x4000 +#define FEATURE_UNIEVAL_BIT 0x8000 +#define FEATURE_UNICODE_BIT 0x10000 #define FEATURE_BUNDLE_DEFAULT 0 #define FEATURE_BUNDLE_510 1 @@ -47,7 +48,7 @@ ? (PL_curcop->cop_features & (mask)) : FALSE) /* The longest string we pass in. */ -#define MAX_FEATURE_LEN (sizeof("multidimensional")-1) +#define MAX_FEATURE_LEN (sizeof("bareword_filehandles")-1) #define FEATURE_FC_IS_ENABLED \ ( \ @@ -166,6 +167,13 @@ FEATURE_IS_ENABLED_MASK(FEATURE_MULTIDIMENSIONAL_BIT)) \ ) +#define FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED \ + ( \ + CURRENT_FEATURE_BUNDLE <= FEATURE_BUNDLE_527 \ + || (CURRENT_FEATURE_BUNDLE == FEATURE_BUNDLE_CUSTOM && \ + FEATURE_IS_ENABLED_MASK(FEATURE_BAREWORD_FILEHANDLES_BIT)) \ + ) + #define SAVEFEATUREBITS() SAVEI32(PL_compiling.cop_features) @@ -236,7 +244,12 @@ S_magic_sethint_feature(pTHX_ SV *keysv, const char *keypv, STRLEN keylen, return; case 'b': - if (keylen == sizeof("feature_bitwise")-1 + if (keylen == sizeof("feature_bareword_filehandles")-1 + && memcmp(subf+1, "areword_filehandles", keylen - sizeof("feature_")) == 0) { + mask = FEATURE_BAREWORD_FILEHANDLES_BIT; + break; + } + else if (keylen == sizeof("feature_bitwise")-1 && memcmp(subf+1, "itwise", keylen - sizeof("feature_")) == 0) { mask = FEATURE_BITWISE_BIT; break; diff --git a/lib/feature.pm b/lib/feature.pm index 7c60f1d28ec2..a8e943a81916 100644 --- a/lib/feature.pm +++ b/lib/feature.pm @@ -5,35 +5,36 @@ package feature; -our $VERSION = '1.61'; +our $VERSION = '1.62'; our %feature = ( - fc => 'feature_fc', - isa => 'feature_isa', - say => 'feature_say', - state => 'feature_state', - switch => 'feature_switch', - bitwise => 'feature_bitwise', - indirect => 'feature_indirect', - evalbytes => 'feature_evalbytes', - signatures => 'feature_signatures', - current_sub => 'feature___SUB__', - refaliasing => 'feature_refaliasing', - postderef_qq => 'feature_postderef_qq', - unicode_eval => 'feature_unieval', - declared_refs => 'feature_myref', - unicode_strings => 'feature_unicode', - multidimensional => 'feature_multidimensional', + fc => 'feature_fc', + isa => 'feature_isa', + say => 'feature_say', + state => 'feature_state', + switch => 'feature_switch', + bitwise => 'feature_bitwise', + indirect => 'feature_indirect', + evalbytes => 'feature_evalbytes', + signatures => 'feature_signatures', + current_sub => 'feature___SUB__', + refaliasing => 'feature_refaliasing', + postderef_qq => 'feature_postderef_qq', + unicode_eval => 'feature_unieval', + declared_refs => 'feature_myref', + unicode_strings => 'feature_unicode', + multidimensional => 'feature_multidimensional', + bareword_filehandles => 'feature_bareword_filehandles', ); our %feature_bundle = ( - "5.10" => [qw(indirect multidimensional say state switch)], - "5.11" => [qw(indirect multidimensional say state switch unicode_strings)], - "5.15" => [qw(current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)], - "5.23" => [qw(current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], - "5.27" => [qw(bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], - "all" => [qw(bitwise current_sub declared_refs evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], - "default" => [qw(indirect multidimensional)], + "5.10" => [qw(bareword_filehandles indirect multidimensional say state switch)], + "5.11" => [qw(bareword_filehandles indirect multidimensional say state switch unicode_strings)], + "5.15" => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional say state switch unicode_eval unicode_strings)], + "5.23" => [qw(bareword_filehandles current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], + "5.27" => [qw(bareword_filehandles bitwise current_sub evalbytes fc indirect multidimensional postderef_qq say state switch unicode_eval unicode_strings)], + "all" => [qw(bareword_filehandles bitwise current_sub declared_refs evalbytes fc indirect isa multidimensional postderef_qq refaliasing say signatures state switch unicode_eval unicode_strings)], + "default" => [qw(bareword_filehandles indirect multidimensional)], ); $feature_bundle{"5.12"} = $feature_bundle{"5.11"}; @@ -392,6 +393,22 @@ previous versions, it was simply on all the time. You can use the L module on CPAN to disable multidimensional array emulation for older versions of Perl. +=head2 The 'bareword_filehandles' feature. + +This feature enables bareword filehandles for builtin functions +operations, a generally discouraged practice. It is enabled by +default, but can be turned off to disable bareword filehandles, except +for the exceptions listed below. + +The perl built-in filehandles C, C, C, C, +C, C and the special C<_> are always enabled. + +This feature is enabled under this name from Perl 5.34 onwards. In +previous versions it was simply on all the time. + +You can use the L module on CPAN to disable +bareword filehandles for older versions of perl. + =head1 FEATURE BUNDLES It's possible to load multiple features together, using @@ -405,54 +422,64 @@ The following feature bundles are available: bundle features included --------- ----------------- :default indirect multidimensional + bareword_filehandles - :5.10 indirect multidimensional say state switch - - :5.12 indirect multidimensional say state switch - unicode_strings - - :5.14 indirect multidimensional say state switch - unicode_strings - - :5.16 current_sub evalbytes fc indirect + :5.10 bareword_filehandles indirect multidimensional say state switch - unicode_eval unicode_strings - :5.18 current_sub evalbytes fc indirect + :5.12 bareword_filehandles indirect multidimensional say state switch - unicode_eval unicode_strings - - :5.20 current_sub evalbytes fc indirect - multidimensional say state switch - unicode_eval unicode_strings + unicode_strings - :5.22 current_sub evalbytes fc indirect + :5.14 bareword_filehandles indirect multidimensional say state switch - unicode_eval unicode_strings + unicode_strings - :5.24 current_sub evalbytes fc indirect - multidimensional postderef_qq say state + :5.16 bareword_filehandles current_sub evalbytes + fc indirect multidimensional say state switch unicode_eval unicode_strings - :5.26 current_sub evalbytes fc indirect - multidimensional postderef_qq say state + :5.18 bareword_filehandles current_sub evalbytes + fc indirect multidimensional say state switch unicode_eval unicode_strings - :5.28 bitwise current_sub evalbytes fc indirect - multidimensional postderef_qq say state + :5.20 bareword_filehandles current_sub evalbytes + fc indirect multidimensional say state switch unicode_eval unicode_strings - :5.30 bitwise current_sub evalbytes fc indirect - multidimensional postderef_qq say state + :5.22 bareword_filehandles current_sub evalbytes + fc indirect multidimensional say state switch unicode_eval unicode_strings - :5.32 bitwise current_sub evalbytes fc indirect - multidimensional postderef_qq say state - switch unicode_eval unicode_strings + :5.24 bareword_filehandles current_sub evalbytes + fc indirect multidimensional postderef_qq + say state switch unicode_eval + unicode_strings - :5.34 bitwise current_sub evalbytes fc indirect - multidimensional postderef_qq say state - switch unicode_eval unicode_strings + :5.26 bareword_filehandles current_sub evalbytes + fc indirect multidimensional postderef_qq + say state switch unicode_eval + unicode_strings + + :5.28 bareword_filehandles bitwise current_sub + evalbytes fc indirect multidimensional + postderef_qq say state switch unicode_eval + unicode_strings + + :5.30 bareword_filehandles bitwise current_sub + evalbytes fc indirect multidimensional + postderef_qq say state switch unicode_eval + unicode_strings + + :5.32 bareword_filehandles bitwise current_sub + evalbytes fc indirect multidimensional + postderef_qq say state switch unicode_eval + unicode_strings + + :5.34 bareword_filehandles bitwise current_sub + evalbytes fc indirect multidimensional + postderef_qq say state switch unicode_eval + unicode_strings The C<:default> bundle represents the feature set that is enabled before any C or C declaration. diff --git a/op.c b/op.c index dce844d297ae..889a032736cf 100644 --- a/op.c +++ b/op.c @@ -724,6 +724,21 @@ S_no_bareword_allowed(pTHX_ OP *o) o->op_private &= ~OPpCONST_STRICT; /* prevent warning twice about the same OP */ } +void +Perl_no_bareword_filehandle(pTHX_ const char *fhname) { + PERL_ARGS_ASSERT_NO_BAREWORD_FILEHANDLE; + + if (strNE(fhname, "STDERR") + && strNE(fhname, "STDOUT") + && strNE(fhname, "STDIN") + && strNE(fhname, "_") + && strNE(fhname, "ARGV") + && strNE(fhname, "ARGVOUT") + && strNE(fhname, "DATA")) { + qerror(Perl_mess(aTHX_ "Bareword filehandle \"%s\" not allowed under 'no feature \"bareword_filehandles\"'", fhname)); + } +} + /* "register" allocation */ PADOFFSET @@ -13090,6 +13105,11 @@ Perl_ck_fun(pTHX_ OP *o) { OP * const newop = newGVOP(OP_GV, 0, gv_fetchsv(((SVOP*)kid)->op_sv, GV_ADD, SVt_PVIO)); + /* a first argument is handled by toke.c, ideally we'd + just check here but several ops don't use ck_fun() */ + if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED && numargs > 1) { + no_bareword_filehandle(SvPVX(cSVOPx_sv((SVOP*)kid))); + } /* replace kid with newop in chain */ op_sibling_splice(o, prev_kid, 1, newop); op_free(kid); @@ -15159,6 +15179,9 @@ Perl_ck_trunc(pTHX_ OP *o) { o->op_flags |= OPf_SPECIAL; kid->op_private &= ~OPpCONST_STRICT; + if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) { + no_bareword_filehandle(SvPVX(cSVOPx_sv(kid))); + } } } return ck_fun(o); diff --git a/pod/perldiag.pod b/pod/perldiag.pod index b21102e2485d..27aa36e573b1 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -563,6 +563,15 @@ symbol. Perhaps you need to predeclare a subroutine? compiler saw no other uses of that namespace before that point. Perhaps you need to predeclare a package? +=item Bareword filehandle "%s" not allowed under 'no feature "bareword_filehandles"' + +(F) You attempted to use a bareword filehandle with the +C feature disabled. + +Only the built-in handles C, C, C, C, +C and C can be used with the C +feature disabled. + =item BEGIN failed--compilation aborted (F) An untrapped exception was raised while executing a BEGIN diff --git a/proto.h b/proto.h index 46e69cc20625..333dde15e62b 100644 --- a/proto.h +++ b/proto.h @@ -2533,6 +2533,9 @@ PERL_CALLCONV char* Perl_ninstr(const char* big, const char* bigend, const char* #define PERL_ARGS_ASSERT_NINSTR \ assert(big); assert(bigend); assert(little); assert(lend) +PERL_CALLCONV void Perl_no_bareword_filehandle(pTHX_ const char *fhname); +#define PERL_ARGS_ASSERT_NO_BAREWORD_FILEHANDLE \ + assert(fhname) PERL_CALLCONV_NO_RET void Perl_noperl_die(const char* pat, ...) __attribute__noreturn__ __attribute__format__(__printf__,1,2); diff --git a/regen/feature.pl b/regen/feature.pl index 7ef071b83fbc..e626ca9feed5 100755 --- a/regen/feature.pl +++ b/regen/feature.pl @@ -39,6 +39,7 @@ BEGIN isa => 'isa', indirect => 'indirect', multidimensional => 'multidimensional', + bareword_filehandles => 'bareword_filehandles', ); # NOTE: If a feature is ever enabled in a non-contiguous range of Perl @@ -48,7 +49,7 @@ BEGIN # 5.odd implies the next 5.even, but an explicit 5.even can override it. # features bundles -use constant V5_9_5 => sort qw{say state switch indirect multidimensional}; +use constant V5_9_5 => sort qw{say state switch indirect multidimensional bareword_filehandles}; use constant V5_11 => sort ( +V5_9_5, qw{unicode_strings} ); use constant V5_15 => sort ( +V5_11, qw{unicode_eval evalbytes current_sub fc} ); use constant V5_23 => sort ( +V5_15, qw{postderef_qq} ); @@ -56,7 +57,7 @@ BEGIN my %feature_bundle = ( all => [ sort keys %feature ], - default => [ qw{indirect multidimensional} ], + default => [ qw{indirect multidimensional bareword_filehandles} ], # using 5.9.5 features bundle "5.9.5" => [ +V5_9_5 ], "5.10" => [ +V5_9_5 ], @@ -476,7 +477,7 @@ sub longest { __END__ package feature; -our $VERSION = '1.61'; +our $VERSION = '1.62'; FEATURES @@ -798,6 +799,22 @@ =head2 The 'multidimensional' feature You can use the L module on CPAN to disable multidimensional array emulation for older versions of Perl. +=head2 The 'bareword_filehandles' feature. + +This feature enables bareword filehandles for builtin functions +operations, a generally discouraged practice. It is enabled by +default, but can be turned off to disable bareword filehandles, except +for the exceptions listed below. + +The perl built-in filehandles C, C, C, C, +C, C and the special C<_> are always enabled. + +This feature is enabled under this name from Perl 5.34 onwards. In +previous versions it was simply on all the time. + +You can use the L module on CPAN to disable +bareword filehandles for older versions of perl. + =head1 FEATURE BUNDLES It's possible to load multiple features together, using diff --git a/t/lib/feature/bareword_filehandles b/t/lib/feature/bareword_filehandles new file mode 100644 index 000000000000..7eba75732cbf --- /dev/null +++ b/t/lib/feature/bareword_filehandles @@ -0,0 +1,486 @@ +Test no feature bareword_filehandles + +todo: + +print HANDLE +print HANDLE LIST +printf HANDLE +printf HANDLE LIST +say HANDLE +say HANDLE LIST +readline +<> / +<<>> - has an implicit argument +truncate +stat +-X +lstat +open +close +eof +fileno +flock +getc +read +write ? +seek +tell +select +sysopen +sysread +syswrite +sysseek +pipe + +socket +connect +bind +listen +recv +send +setsockopt +getsockopt +shutdown +socketpair +accept +getpeername +getsockname + +binmode +ioctl +fcntl +chmod - doesn't accept bareword handles +chown - doesn't accept bareword handles + +opendir +closedir +readdir +seekdir +telldir +rewinddir +chdir + +also check + +sort +map +grep + +aren't modified + + +__END__ +# NAME defaults and explicitly on +#!perl -c +use File::Temp qw(tempfile); +use Fcntl qw(SEEK_SET); +use Socket; +my ($fh, $name) = tempfile; +open FOO, ">", File::Spec->devnull; +print FOO; +print FOO "Hello"; +printf FOO "Hello"; +seek FOO, 0, SEEK_SET; +truncate FOO, 0; +print FOO "Something read\n"; +close FOO; +; +{ + local *ARGV; + local *ARGVOUT; + @ARGV = $name; + <<>>; + <>; +} +pipe FH1, FH2; +socketpair S1, S2, AF_UNIX, SOCK_STREAM, PF_UNSPEC; +shutdown S1, 0; + +use feature "bareword_filehandles"; +open FOO, ">", File::Spec->devnull; +print FOO; +print FOO "Hello"; +printf FOO "Hello"; +seek FOO, 0, SEEK_SET; +truncate FOO, 0; +print FOO "Something read\n"; +close FOO; +; +{ + local *ARGV; + local *ARGVOUT; + @ARGV = $name; + <<>>; + <>; +} +pipe FH3, FH4; +socketpair S3, S4, AF_UNIX, SOCK_STREAM, PF_UNSPEC; +shutdown S3, 0; + +EXPECT +- syntax OK +######## +# NAME check atan2() with a handle doesn't trigger bareword filehandle errors +no feature "bareword_filehandles", "indirect"; +my $x = atan2(FOO 1, 2); +# my original approach to this hooked newGVREF(), which the parsing for most LOPs (as with +# atan2() above) could end up calling newGVREF(), producing an unexpected error message. +EXPECT +OPTIONS fatal +Number found where operator expected at - line 2, near "FOO 1" + (Do you need to predeclare FOO?) +Missing comma after first argument to atan2 function at - line 2, near "2)" +Execution of - aborted due to compilation errors. +######## +# NAME print HANDLE LIST, printf HANDLE LIST, print HANDLE, printf HANDLE +use File::Spec; +open FOO, ">", File::Spec->devnull or die $!; +$_ = "abc"; +print FOO "test\n"; +printf FOO "test\n"; +print FOO; +printf FOO; +no feature "bareword_filehandles"; +print FOO "test2\n"; +printf FOO "test2\n"; +print FOO; +printf FOO; +print STDERR; +print STDOUT; +print ARGV; +print ARGVOUT; +print DATA; +print STDIN; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12. +Execution of - aborted due to compilation errors. +######## +# NAME say HANDLE LIST, say HANDLE +use File::Spec; +use feature "say"; +open FOO, ">", File::Spec->devnull or die $!; +$_ = "abc"; +say FOO "test\n"; +say FOO; +no feature "bareword_filehandles"; +say FOO "test2\n"; +say FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Execution of - aborted due to compilation errors. +######## +# NAME readline FOO, readline, <>, +use File::Spec; +open FOO, "<", File::Spec->devnull or die $!; +my $x = readline FOO; +$x .= readline FOO; # rcatline +$x = readline(FOO); # parsed a little differently with () +$x .= readline(FOO); +$x = ; +$x .= ; +no feature "bareword_filehandles"; +$x = readline FOO; +$x .= readline FOO; # rcatline +$x = readline(FOO); # parsed a little differently with () +$x .= readline(FOO); +$x = ; +$x .= ; +$x = readline STDIN; +$x = ; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 13. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 14. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 15. +Execution of - aborted due to compilation errors. +######## +# NAME truncate +use strict; +use warnings; +# if all goes well this doesn't run anyway +my $name = "bare$$.tmp"; +END { unlink $name if $name; } +open FOO, ">", $name or die; +print FOO "Non-zero length data\n"; +truncate FOO, 2; +no feature "bareword_filehandles"; +truncate FOO, 1; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Execution of - aborted due to compilation errors. +######## +# NAME stat, lstat, -X +use File::Spec; +open FOO, "<", File::Spec->devnull; +my @x = stat FOO; +@x = lstat FOO; +my $x = -s FOO; +no feature "bareword_filehandles"; +@x = stat FOO; +@x = lstat FOO; +$x = -s FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Execution of - aborted due to compilation errors. +######## +# NAME open, close, eof, fileno +use File::Spec; +open FOO, "<", File::Spec->devnull; +my $x = eof FOO; +$x = fileno FOO; +close FOO; +no feature "bareword_filehandles"; +open FOO, "<", File::Spec->devnull; +$x = eof FOO; +$x = fileno FOO; +close FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Execution of - aborted due to compilation errors. +######## +# NAME flock +use Fcntl ":flock"; +open FOO, "<", $0 or die; +flock FOO, LOCK_SH; +no feature "bareword_filehandles"; +flock FOO, LOCK_UN; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5. +Execution of - aborted due to compilation errors. +######## +# NAME getc, read, seek, tell +open FOO, "<", $0 or die; +my $x = getc FOO; +read(FOO, $x, 1); +$x = tell FOO; +seek FOO, 0, 0; +no feature "bareword_filehandles"; +$x = getc FOO; +read(FOO, $x, 1); +$x = tell FOO; +seek FOO, 0, 0; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Execution of - aborted due to compilation errors. +######## +# NAME select +open FOO, "<", $0 or die; +my $old = select FOO; +no feature "bareword_filehandles"; +select FOO; +select $old; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 4. +Execution of - aborted due to compilation errors. +######## +# NAME sysopen, sysread, syswrite, sysseek +use Fcntl; +use File::Spec; +sysopen FOO, File::Spec->devnull, O_RDWR or die; +sysread FOO, my $x, 10; +syswrite FOO, "Test"; +my $y = sysseek FOO, 0, SEEK_CUR; +close FOO; +no feature "bareword_filehandles"; +sysopen FOO, File::Spec->devnull, O_RDWR or die; +sysread FOO, my $x, 10; +syswrite FOO, "Test"; +my $y = sysseek FOO, 0, SEEK_CUR; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 12. +Execution of - aborted due to compilation errors. +######## +# NAME pipe +my $fh; +pipe IN, $fh; +pipe $fh, OUT; +pipe IN, OUT; +no feature "bareword_filehandles"; +pipe IN, $fh; +pipe $fh, OUT; +pipe IN, OUT; +EXPECT +OPTIONS fatal +Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Execution of - aborted due to compilation errors. +######## +# NAME socket, connect, bind, listen +my $fh; +# this won't run, just use dummy values for domain, type, protocol +socket(FOO, 0, 0,0); +connect(FOO, "abc"); +bind(FOO, "abc"); +listen(FOO, 5); +no feature "bareword_filehandles"; +socket(FOO, 0, 0,0); +connect(FOO, "abc"); +bind(FOO, "abc"); +listen(FOO, 5); +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 10. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 11. +Execution of - aborted due to compilation errors. +######## +# NAME accept +accept(FOO, CHILD); +accept($fh, CHILD); +accept(FOO, $fh); +no feature "bareword_filehandles"; +accept(FOO, CHILD); +accept($fh, CHILD); +accept(FOO, $fh); +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5. +Bareword filehandle "CHILD" not allowed under 'no feature "bareword_filehandles"' at - line 5. +Bareword filehandle "CHILD" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Execution of - aborted due to compilation errors. +######## +# NAME send, recv, setsockopt, getsockopt +send FOO, "abc", 0; +recv FOO, my $x, 10, 0; +setsockopt FOO, 0, 0, 0; +my $y = getsockopt FOO, 0, 0; +no feature "bareword_filehandles"; +send FOO, "abc", 0; +recv FOO, my $x, 10, 0; +setsockopt FOO, 0, 0, 0; +my $y = getsockopt FOO, 0, 0; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Execution of - aborted due to compilation errors. +######## +# NAME shutdown, getsockname, getpeername +shutdown FOO, 0; +my $sockname = getsockname FOO; +my $peername = getpeername FOO; +no feature "bareword_filehandles"; +shutdown FOO, 0; +$sockname = getsockname FOO; +$peername = getpeername FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Execution of - aborted due to compilation errors. +######## +# NAME socketpair +my $fh; +socketpair IN, $fh, 0, 0, 0; +socketpair $fh, OUT, 0, 0, 0; +socketpair IN, OUT, 0, 0, 0; +no feature "bareword_filehandles"; +socketpair IN, $fh, 0, 0, 0; +socketpair $fh, OUT, 0, 0, 0; +socketpair IN, OUT, 0, 0, 0; +EXPECT +OPTIONS fatal +Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "IN" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "OUT" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Execution of - aborted due to compilation errors. +######## +# NAME binmode, ioctl, fcntl +binmode FOO; +binmode FOO, ":raw"; +ioctl FOO, 0, 0; +fcntl FOO, 0, 0; +no feature "bareword_filehandles"; +binmode FOO; +binmode FOO, ":raw"; +ioctl FOO, 0, 0; +fcntl FOO, 0, 0; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Execution of - aborted due to compilation errors. +######## +# NAME opendir, closedir, readdir +opendir FOO, "."; +my @x = readdir FOO; +chdir FOO; +closedir FOO; +no feature "bareword_filehandles"; +opendir FOO, "."; +my @x = readdir FOO; +chdir FOO; +closedir FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 9. +Execution of - aborted due to compilation errors. +######## +# NAME seekdir, telldir, rewinddir +use strict; +my $x = telldir FOO; +seekdir FOO, $x; +rewinddir FOO; +no feature "bareword_filehandles"; +my $x = telldir FOO; +seekdir FOO, $x; +rewinddir FOO; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 6. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 7. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 8. +Execution of - aborted due to compilation errors. +######## +# NAME file tests +-T FOO; +-s FOO; +no feature "bareword_filehandles"; +-T FOO; +-s FOO; +-s _; +EXPECT +OPTIONS fatal +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 4. +Bareword filehandle "FOO" not allowed under 'no feature "bareword_filehandles"' at - line 5. +Execution of - aborted due to compilation errors. diff --git a/t/porting/known_pod_issues.dat b/t/porting/known_pod_issues.dat index 5783359268c3..cc720a0e2da9 100644 --- a/t/porting/known_pod_issues.dat +++ b/t/porting/known_pod_issues.dat @@ -415,4 +415,5 @@ porting/release_managers_guide.pod Verbatim line length including indents exceed porting/todo.pod ? Should you be using F<...> or maybe L<...> instead of 1 lib/benchmark.pm Verbatim line length including indents exceeds 78 by 2 lib/config.pod ? Should you be using L<...> instead of -1 +lib/feature.pm Apparent broken link 1 lib/perl5db.pl ? Should you be using L<...> instead of 1 diff --git a/toke.c b/toke.c index f4404bd8c850..e58db68cfef6 100644 --- a/toke.c +++ b/toke.c @@ -7482,6 +7482,11 @@ yyl_just_a_word(pTHX_ char *s, STRLEN len, I32 orig_keyword, struct code c) } s = SvPVX(PL_linestr) + s_off; + if (((PL_opargs[PL_last_lop_op] >> OASHIFT) & 7) == OA_FILEREF + && !FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) { + no_bareword_filehandle(PL_tokenbuf); + } + /* If not a declared subroutine, it's an indirect object. */ /* (But it's an indir obj regardless for sort.) */ /* Also, if "_" follows a filetest operator, it's a bareword */ @@ -11096,6 +11101,11 @@ S_scan_inputsymbol(pTHX_ char *start) newCVREF(0, newGVOP(OP_GV, 0, gv_readline)))) : newUNOP(OP_READLINE, nomagicopen ? OPf_SPECIAL : 0, newGVOP(OP_GV, 0, gv)); pl_yylval.ival = OP_NULL; + + /* leave the token generation above to avoid confusing the parser */ + if (!FEATURE_BAREWORD_FILEHANDLES_IS_ENABLED) { + no_bareword_filehandle(d); + } } } From b52b12abf8b9ae61054fee0e3b56abb68d86dea4 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Mon, 4 Jan 2021 11:39:17 +1100 Subject: [PATCH 387/503] perldelta for 0f2beabb0803 --- pod/perldelta.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 60fa1d05291b..de73568d74b0 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -125,9 +125,9 @@ XXX Remove this section if not applicable. =item * -L has been upgraded from version A.xx to B.yy. +L has been upgraded from version 1.61 to 1.62. -If there was something important to note about this change, include that here. +Added the default enabled C feature. =back From 17d6745fa31cd682049fda05fac46d7ba49e14a6 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 11:25:32 +0000 Subject: [PATCH 388/503] Have IO's socket code write errors also into $IO::Socket::errstr --- dist/IO/lib/IO/Socket.pm | 16 +++++++++------- dist/IO/lib/IO/Socket/INET.pm | 8 ++++---- 2 files changed, 13 insertions(+), 11 deletions(-) diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index ad8966dd2268..0dc4f58efa61 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -27,6 +27,8 @@ our $VERSION = "1.44"; our @EXPORT_OK = qw(sockatmark); +our $errstr; + sub import { my $pkg = shift; if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast @@ -132,11 +134,11 @@ sub connect { # set we now emulate the behavior in Linux # - Karthik Rajagopalan $err = $sock->getsockopt(SOL_SOCKET,SO_ERROR); - $@ = "connect: $err"; + $errstr = $@ = "connect: $err"; } elsif(!@$w[0]) { $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); - $@ = "connect: timeout"; + $errstr = $@ = "connect: timeout"; } elsif (!connect($sock,$addr) && not ($!{EISCONN} || ($^O eq 'MSWin32' && @@ -147,12 +149,12 @@ sub connect { # Windows sets errno to WSAEINVAL (10022) (pre-5.19.4) or # EINVAL (22) (5.19.4 onwards). $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } elsif ($blocking || !($!{EINPROGRESS} || $!{EWOULDBLOCK})) { $err = $!; - $@ = "connect: $!"; + $errstr = $@ = "connect: $!"; } } @@ -246,7 +248,7 @@ sub accept { my $sel = IO::Select->new( $sock ); unless ($sel->can_read($timeout)) { - $@ = 'accept: timeout'; + $errstr = $@ = 'accept: timeout'; $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1); return; } @@ -832,7 +834,7 @@ Let's create a TCP server on C. LocalPort => 3333, ReusePort => 1, Listen => 5, - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Waiting on 3333"; while (1) { @@ -873,7 +875,7 @@ A client for such a server could be proto => 'tcp', PeerPort => 3333, PeerHost => '0.0.0.0', - ) || die "Can't open socket: $@"; + ) || die "Can't open socket: $IO::Socket::errstr"; say "Sending Hello World!"; my $size = $client->send("Hello World!"); diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index 8688f375b5f7..5f21d0d74147 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -79,7 +79,7 @@ sub _sock_info { if(defined $proto && $proto =~ /\D/) { my $num = _get_proto_number($proto); unless (defined $num) { - $@ = "Bad protocol '$proto'"; + $IO::Socket::errstr = $@ = "Bad protocol '$proto'"; return; } $proto = $num; @@ -94,7 +94,7 @@ sub _sock_info { $port = $serv[2] || $defport || $pnum; unless (defined $port) { - $@ = "Bad service '$origport'"; + $IO::Socket::errstr = $@ = "Bad service '$origport'"; return; } @@ -113,7 +113,7 @@ sub _error { { local($!); my $title = ref($sock).": "; - $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); + $IO::Socket::errstr = $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_); $sock->close() if(defined fileno($sock)); } @@ -404,7 +404,7 @@ Examples: Proto => udp, LocalAddr => 'localhost', Broadcast => 1 ) - or die "Can't bind : $@\n"; + or die "Can't bind : $IO::Socket::errstr\n"; B From a8924acdbbc06b79d6ff8a9edfbe28c271e8bc88 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 11:25:54 +0000 Subject: [PATCH 389/503] Bump IO::Socket version number --- dist/IO/lib/IO/Socket.pm | 2 +- dist/IO/lib/IO/Socket/INET.pm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 0dc4f58efa61..067fad8f1984 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -23,7 +23,7 @@ require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian'); our @ISA = qw(IO::Handle); -our $VERSION = "1.44"; +our $VERSION = "1.45"; our @EXPORT_OK = qw(sockatmark); diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index 5f21d0d74147..c4f2d0d0b374 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -14,7 +14,7 @@ use Exporter; use Errno; our @ISA = qw(IO::Socket); -our $VERSION = "1.41"; +our $VERSION = "1.42"; my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; From 21c36f15f89a5f339bd2c3afa068369990af2f97 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 11:59:18 +0000 Subject: [PATCH 390/503] Update IO::Socket unit test for $IO::Socket::errstr --- dist/IO/t/io_sock.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/dist/IO/t/io_sock.t b/dist/IO/t/io_sock.t index 3bc5118cbc7b..c7b6bb63856b 100644 --- a/dist/IO/t/io_sock.t +++ b/dist/IO/t/io_sock.t @@ -129,7 +129,7 @@ if(my $pid = fork()) { $sock->close; } else { - print "# $@\n"; + print "# $IO::Socket::errstr\n"; print "not ok 6\n"; print "not ok 7\n"; print "not ok 8\n"; @@ -146,7 +146,7 @@ if(my $pid = fork()) { $sock->close; } else { - print "# $@\n"; + print "# $IO::Socket::errstr\n"; print "not ok 10\n"; } From f96ba148dab8a4bec9680f76c8b8cccd6b198659 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 12:04:21 +0000 Subject: [PATCH 391/503] Remote note from IO::Socket::INET's docs about a change that predates even perl v5.6.0 --- dist/IO/lib/IO/Socket/INET.pm | 7 ------- 1 file changed, 7 deletions(-) diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index c4f2d0d0b374..d194ee13e1c9 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -406,13 +406,6 @@ Examples: Broadcast => 1 ) or die "Can't bind : $IO::Socket::errstr\n"; -B - -As of VERSION 1.18 all IO::Socket objects have autoflush turned on -by default. This was not the case with earlier releases. - -B - =back =head2 METHODS From aaedda86bf3baa31f82437e706c3bdb86b7db464 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 12:24:15 +0000 Subject: [PATCH 392/503] Actually document the IO::Socket constructor's behaviour on failure, pointing out the $IO::Socket::errstr package var --- dist/IO/lib/IO/Socket.pm | 12 ++++++++++++ dist/IO/lib/IO/Socket/INET.pm | 12 ++++++++++++ dist/IO/lib/IO/Socket/UNIX.pm | 12 ++++++++++++ 3 files changed, 36 insertions(+) diff --git a/dist/IO/lib/IO/Socket.pm b/dist/IO/lib/IO/Socket.pm index 067fad8f1984..7f298155b5ce 100644 --- a/dist/IO/lib/IO/Socket.pm +++ b/dist/IO/lib/IO/Socket.pm @@ -532,6 +532,18 @@ by default, be either C or C. Other domains can be used if a proper subclass for the domain family is registered. All other arguments will be passed to the C method of the package for that domain. +If the constructor fails it will return C and set the C<$errstr> package +variable to contain an error message. + + $sock = IO::Socket->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; + +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket->new(...) + or die "Cannot create socket - $@\n"; + =head1 METHODS C inherits all methods from L and implements the diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index d194ee13e1c9..85065b934839 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -406,6 +406,18 @@ Examples: Broadcast => 1 ) or die "Can't bind : $IO::Socket::errstr\n"; +If the constructor fails it will return C and set the +C<$IO::Socket::errstr> package variable to contain an error message. + + $sock = IO::Socket::INET->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; + +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket::INET->new(...) + or die "Cannot create socket - $@\n"; + =back =head2 METHODS diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm index 14d0b27a8ce7..42e86f763969 100644 --- a/dist/IO/lib/IO/Socket/UNIX.pm +++ b/dist/IO/lib/IO/Socket/UNIX.pm @@ -127,6 +127,18 @@ be a C specification. If the C argument is given, but false, the queue size will be set to 5. +If the constructor fails it will return C and set the +C<$IO::Socket::errstr> package variable to contain an error message. + + $sock = IO::Socket::UNIX->new(...) + or die "Cannot create socket - $IO::Socket::errstr\n"; + +For legacy reasons the error message is also set into the global C<$@> +variable, and you may still find older code which looks here instead. + + $sock = IO::Socket::UNIX->new(...) + or die "Cannot create socket - $@\n"; + =back =head1 METHODS From 8f107e8c8a9c7f9ab50acb269e4ea25c203279d9 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 15:07:10 +0000 Subject: [PATCH 393/503] Add a unit test that IO::Socket constructor uses error variables as specified --- MANIFEST | 1 + dist/IO/t/io_sock_errstr.t | 34 ++++++++++++++++++++++++++++++++++ 2 files changed, 35 insertions(+) create mode 100644 dist/IO/t/io_sock_errstr.t diff --git a/MANIFEST b/MANIFEST index 53c500da8dc4..dcd03aa93881 100644 --- a/MANIFEST +++ b/MANIFEST @@ -3716,6 +3716,7 @@ dist/IO/t/io_pipe.t See if pipe()-related methods from IO work dist/IO/t/io_poll.t See if poll()-related methods from IO work dist/IO/t/io_sel.t See if select()-related methods from IO work dist/IO/t/io_sock.t See if INET socket-related methods from IO work +dist/IO/t/io_sock_errstr.t See if socket constructors put error string in the right place dist/IO/t/io_taint.t See if the untaint method from IO works dist/IO/t/io_tell.t See if seek()/tell()-related methods from IO work dist/IO/t/io_udp.t See if UDP socket-related methods from IO work diff --git a/dist/IO/t/io_sock_errstr.t b/dist/IO/t/io_sock_errstr.t new file mode 100644 index 000000000000..dc75c44fad53 --- /dev/null +++ b/dist/IO/t/io_sock_errstr.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More; + +plan tests => 3; + +use Errno qw( EINVAL ); + +# Keep this unit test in a file of its own because we need to override +# connect() globally +BEGIN { + *CORE::GLOBAL::connect = sub { $! = EINVAL; return undef }; +} + +my $EINVAL_STR = do { local $! = EINVAL; "$!" }; + +use IO::Socket; + +# test that error strings turn up in both places +my $sock = IO::Socket::INET->new( + PeerHost => "localhost", + PeerPort => 1, +); +my $e = $@; + +ok(!defined $sock, 'fails to connect with CORE::GLOBAL::connect override'); + +is($IO::Socket::errstr, "IO::Socket::INET: connect: $EINVAL_STR", + 'error message appears in $IO::Socket::errstr'); +is($e, "IO::Socket::INET: connect: $EINVAL_STR", + 'error message appeared in $@'); From b9c2c70bf0e33ea806d9112b2e6ddd9dee5dc24d Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 15:10:27 +0000 Subject: [PATCH 394/503] Bump VERSION of every file in dist/IO to 1.45 consistently --- dist/IO/IO.pm | 2 +- dist/IO/lib/IO/Dir.pm | 2 +- dist/IO/lib/IO/File.pm | 2 +- dist/IO/lib/IO/Handle.pm | 2 +- dist/IO/lib/IO/Pipe.pm | 2 +- dist/IO/lib/IO/Poll.pm | 2 +- dist/IO/lib/IO/Seekable.pm | 2 +- dist/IO/lib/IO/Select.pm | 2 +- dist/IO/lib/IO/Socket/INET.pm | 2 +- dist/IO/lib/IO/Socket/UNIX.pm | 2 +- 10 files changed, 10 insertions(+), 10 deletions(-) diff --git a/dist/IO/IO.pm b/dist/IO/IO.pm index 5b637df61dcc..c5d954b7f703 100644 --- a/dist/IO/IO.pm +++ b/dist/IO/IO.pm @@ -7,7 +7,7 @@ use Carp; use strict; use warnings; -our $VERSION = "1.44"; +our $VERSION = "1.45"; XSLoader::load 'IO', $VERSION; sub import { diff --git a/dist/IO/lib/IO/Dir.pm b/dist/IO/lib/IO/Dir.pm index 3a14ca8983b4..60174b2522e3 100644 --- a/dist/IO/lib/IO/Dir.pm +++ b/dist/IO/lib/IO/Dir.pm @@ -18,7 +18,7 @@ use File::stat; use File::Spec; our @ISA = qw(Tie::Hash Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.45"; our @EXPORT_OK = qw(DIR_UNLINK); diff --git a/dist/IO/lib/IO/File.pm b/dist/IO/lib/IO/File.pm index cf51d9bf6366..856fdcabc249 100644 --- a/dist/IO/lib/IO/File.pm +++ b/dist/IO/lib/IO/File.pm @@ -135,7 +135,7 @@ require Exporter; our @ISA = qw(IO::Handle IO::Seekable Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.45"; our @EXPORT = @IO::Seekable::EXPORT; diff --git a/dist/IO/lib/IO/Handle.pm b/dist/IO/lib/IO/Handle.pm index 45b6d4f5200e..1f2f83bd2428 100644 --- a/dist/IO/lib/IO/Handle.pm +++ b/dist/IO/lib/IO/Handle.pm @@ -270,7 +270,7 @@ use IO (); # Load the XS module require Exporter; our @ISA = qw(Exporter); -our $VERSION = "1.42"; +our $VERSION = "1.45"; our @EXPORT_OK = qw( autoflush diff --git a/dist/IO/lib/IO/Pipe.pm b/dist/IO/lib/IO/Pipe.pm index c3ceb862336f..73cdf32eff85 100644 --- a/dist/IO/lib/IO/Pipe.pm +++ b/dist/IO/lib/IO/Pipe.pm @@ -13,7 +13,7 @@ use strict; use Carp; use Symbol; -our $VERSION = "1.41"; +our $VERSION = "1.45"; sub new { my $type = shift; diff --git a/dist/IO/lib/IO/Poll.pm b/dist/IO/lib/IO/Poll.pm index 3fe0179626f9..77083f4d6de6 100644 --- a/dist/IO/lib/IO/Poll.pm +++ b/dist/IO/lib/IO/Poll.pm @@ -12,7 +12,7 @@ use IO::Handle; use Exporter (); our @ISA = qw(Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.45"; our @EXPORT = qw( POLLIN POLLOUT diff --git a/dist/IO/lib/IO/Seekable.pm b/dist/IO/lib/IO/Seekable.pm index 2370dcb89a06..7c103b50f498 100644 --- a/dist/IO/lib/IO/Seekable.pm +++ b/dist/IO/lib/IO/Seekable.pm @@ -106,7 +106,7 @@ require Exporter; our @EXPORT = qw(SEEK_SET SEEK_CUR SEEK_END); our @ISA = qw(Exporter); -our $VERSION = "1.41"; +our $VERSION = "1.45"; sub seek { @_ == 3 or croak 'usage: $io->seek(POS, WHENCE)'; diff --git a/dist/IO/lib/IO/Select.pm b/dist/IO/lib/IO/Select.pm index 35a47ccbe052..2367d95c8bc8 100644 --- a/dist/IO/lib/IO/Select.pm +++ b/dist/IO/lib/IO/Select.pm @@ -10,7 +10,7 @@ use strict; use warnings::register; require Exporter; -our $VERSION = "1.42"; +our $VERSION = "1.45"; our @ISA = qw(Exporter); # This is only so we can do version checking diff --git a/dist/IO/lib/IO/Socket/INET.pm b/dist/IO/lib/IO/Socket/INET.pm index 85065b934839..d315731e87f1 100644 --- a/dist/IO/lib/IO/Socket/INET.pm +++ b/dist/IO/lib/IO/Socket/INET.pm @@ -14,7 +14,7 @@ use Exporter; use Errno; our @ISA = qw(IO::Socket); -our $VERSION = "1.42"; +our $VERSION = "1.45"; my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1; diff --git a/dist/IO/lib/IO/Socket/UNIX.pm b/dist/IO/lib/IO/Socket/UNIX.pm index 42e86f763969..261edc46ec10 100644 --- a/dist/IO/lib/IO/Socket/UNIX.pm +++ b/dist/IO/lib/IO/Socket/UNIX.pm @@ -11,7 +11,7 @@ use IO::Socket; use Carp; our @ISA = qw(IO::Socket); -our $VERSION = "1.42"; +our $VERSION = "1.45"; IO::Socket::UNIX->register_domain( AF_UNIX ); From 9390a7df39e1b744bb75f4dda4fcc3d89badff84 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 17:16:55 +0000 Subject: [PATCH 395/503] regen META.json --- META.json | 1 + 1 file changed, 1 insertion(+) diff --git a/META.json b/META.json index 1aaa841d76ce..1bd987002f7b 100644 --- a/META.json +++ b/META.json @@ -96,6 +96,7 @@ "dist/IO/t/io_poll.t", "dist/IO/t/io_sel.t", "dist/IO/t/io_sock.t", + "dist/IO/t/io_sock_errstr.t", "dist/IO/t/io_taint.t", "dist/IO/t/io_tell.t", "dist/IO/t/io_udp.t", From c990c01498071976216d6749f3f075c469089452 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 17:43:00 +0000 Subject: [PATCH 396/503] regen META.yml --- META.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/META.yml b/META.yml index 74699ed94e03..1e7388dc5919 100644 --- a/META.yml +++ b/META.yml @@ -93,6 +93,7 @@ no_index: - dist/IO/t/io_poll.t - dist/IO/t/io_sel.t - dist/IO/t/io_sock.t + - dist/IO/t/io_sock_errstr.t - dist/IO/t/io_taint.t - dist/IO/t/io_tell.t - dist/IO/t/io_udp.t From 3dc2277ddfa7ffadd0ca1eaf94ba9e194b81b917 Mon Sep 17 00:00:00 2001 From: "Paul \"LeoNerd\" Evans" Date: Mon, 4 Jan 2021 22:18:57 +0000 Subject: [PATCH 397/503] Add ChangeLog entry for IO version 1.45 --- dist/IO/ChangeLog | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/dist/IO/ChangeLog b/dist/IO/ChangeLog index 52f74dff4ab2..087592e3a0c1 100644 --- a/dist/IO/ChangeLog +++ b/dist/IO/ChangeLog @@ -1,3 +1,7 @@ +IO 1.45 + * Put IO::Socket constructor error messages in $IO::Socket::errstr as well + as $@, to encourage better practices + IO 1.44 * IO::Handle::error() now checks both the input and output stream for error. This is an issue for sockets and character devices. GH #6799 From e5388933b79bba4c658121614da1fb0ed1f55416 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 5 Jan 2021 10:44:04 +1100 Subject: [PATCH 398/503] export the win32 symlink related symbols I couldn't make the build fail due to these missing exports while I was developing the win32 symlink() support, but I did have it fail while testing an unrelated change, and reproduced it, so export them. --- makedef.pl | 3 +++ 1 file changed, 3 insertions(+) diff --git a/makedef.pl b/makedef.pl index 16dd951086d2..94ff2f54d18a 100644 --- a/makedef.pl +++ b/makedef.pl @@ -911,6 +911,9 @@ sub readvar { win32_puts win32_getchar win32_putchar + win32_symlink + win32_lstat + win32_readlink )); } elsif ($ARGS{PLATFORM} eq 'vms') { From 7e8ad094bab6acb9ea36c1fc61356052a737e31a Mon Sep 17 00:00:00 2001 From: dlaugt Date: Mon, 4 Jan 2021 21:35:36 +0100 Subject: [PATCH 399/503] Define RSFP_FILENO before using it --- toke.c | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/toke.c b/toke.c index e58db68cfef6..cf0a06a44a02 100644 --- a/toke.c +++ b/toke.c @@ -6696,6 +6696,12 @@ yyl_backslash(pTHX_ char *s) OPERATOR(REFGEN); } +#ifdef NETWARE +#define RSFP_FILENO (PL_rsfp) +#else +#define RSFP_FILENO (PerlIO_fileno(PL_rsfp)) +#endif + static void yyl_data_handle(pTHX) { @@ -9207,13 +9213,6 @@ yyl_try(pTHX_ char *s) - cases for built-in keywords */ -#ifdef NETWARE -#define RSFP_FILENO (PL_rsfp) -#else -#define RSFP_FILENO (PerlIO_fileno(PL_rsfp)) -#endif - - int Perl_yylex(pTHX) { From 42ee5e7db05ee0d07ff1d182f7c85e4d9c8bbf5e Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Tue, 5 Jan 2021 11:03:18 +1100 Subject: [PATCH 400/503] =?UTF-8?q?Daniel=20La=C3=BCgt=20is=20now=20a=20pe?= =?UTF-8?q?rl=20author?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- AUTHORS | 1 + 1 file changed, 1 insertion(+) diff --git a/AUTHORS b/AUTHORS index 405c70f59e53..6cb7f0e05c97 100644 --- a/AUTHORS +++ b/AUTHORS @@ -300,6 +300,7 @@ Daniel Dragan Daniel Frederick Crisman Daniel Grisinger Daniel Kahn Gillmor +Daniel Laügt Daniel Lieberman Daniel Muiño Daniel P. Berrange From d4bd519965a4229109edf9d24771d94f929c7c70 Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Tue, 5 Jan 2021 15:26:53 +0000 Subject: [PATCH 401/503] Update comment after 5b354d2a8a The specified commit fixed a bug by treating ($x, undef) on the LHS as 2 scalars; this comment should have been updated to match. --- op.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/op.c b/op.c index 889a032736cf..4fb8c7199ef5 100644 --- a/op.c +++ b/op.c @@ -17901,7 +17901,7 @@ Perl_rpeep(pTHX_ OP *o) || !r /* .... = (); */ || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */ || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */ - || (lscalars < 2) /* ($x, undef) = ... */ + || (lscalars < 2) /* (undef, $x) = ... */ ) { NOOP; /* always safe */ } From 77242fe8e71200b51aaf77de4056c274e22d8805 Mon Sep 17 00:00:00 2001 From: Hugo van der Sanden Date: Tue, 5 Jan 2021 15:33:54 +0000 Subject: [PATCH 402/503] fix issue references in tests from 282d9dfeb4 Some cut-n-paste errors. --- t/op/aassign.t | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/t/op/aassign.t b/t/op/aassign.t index aa1f2c722c80..41d7c829855b 100644 --- a/t/op/aassign.t +++ b/t/op/aassign.t @@ -595,7 +595,7 @@ SKIP: { } { - # GH #16685 + # GH #17816 # don't use the "1-arg on LHS can't be common" optimisation # when there are undef's there my $x = 1; @@ -604,11 +604,11 @@ SKIP: { } { - # GH #17816 + # GH #16685 # honour trailing undef's in list context my $x = 1; my @a = (($x, undef, undef) = (1)); - is(scalar @a, 3, "GH #17816"); + is(scalar @a, 3, "GH #16685"); } From 64a5950af609117d2098f7616334aff77df9ed63 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Wed, 6 Jan 2021 11:43:16 +1100 Subject: [PATCH 403/503] fix a typo --- pod/perldiag.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 27aa36e573b1..fd2833a3611f 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3297,7 +3297,7 @@ line. See L for more details. =item \K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/ -(F) Your regular expression used C<\K> in a lookhead or lookbehind +(F) Your regular expression used C<\K> in a lookahead or lookbehind assertion, which currently isn't permitted. This may change in the future, see L Date: Thu, 7 Jan 2021 10:11:30 +1100 Subject: [PATCH 404/503] pl2bat.pl now needs access to ExtUtils::PL2Bat This could cause failures in parallel builds. --- write_buildcustomize.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/write_buildcustomize.pl b/write_buildcustomize.pl index b161aab01e6c..d25ef7509430 100644 --- a/write_buildcustomize.pl +++ b/write_buildcustomize.pl @@ -44,6 +44,7 @@ cpan/version/lib cpan/Getopt-Long/lib cpan/Text-ParseWords/lib + cpan/ExtUtils-PL2Bat/lib ); # These are for XS building on Win32, since nonxs and xs build simultaneously From e03e7cdb6e3945a4eccf1c80f087b043ef8045f5 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Thu, 24 Dec 2020 15:33:23 +0200 Subject: [PATCH 405/503] Improve GDBM_File This patch implements new functions and improves compatibility with new versions of GDBM. * ext/GDBM_File/GDBM_File.xs: Define interface methods for functions in newer GDBM versions. (GDBM_version): New static method. Return the version number (string in scalar, array of numbers in list context). Provide heurisics for determining the library version for GDBM prior to 1.9. (gdbm_close): Propagate return value from the library call. (gdbm_DESTROY): Croak if closing the database fails. (gdbm_UNTIE): New method. (gdbm_FETCH): Check database validity. Croak if gdbm_fetch returns error (except GDBM_ITEM_NOT_FOUND). (gdbm_STORE,gdbm_DELETE): Likewise. (gdbm_FIRSTKEY,gdbm_NEXTKEY): Likewise. (gdbm_EXISTS): Check database validity. (gdbm_errno): New function. (gdbm_syserrno): New function. (gdbm_strerror): New function. (gdbm_clear_error): New function. (gdbm_needs_recovery): New function. (gdbm_recover): New function. (gdbm_count): New function. * ext/GDBM_File/typemap (gdbm_count_t): Map to T_COUNT. * ext/GDBM_File/GDBM_File.pm: Document everything. Raise $VERSION. * MANIFEST: Update. * AUTHORS: Update. --- AUTHORS | 1 + MANIFEST | 2 + ext/GDBM_File/GDBM_File.pm | 328 +++++++++++++++-- ext/GDBM_File/GDBM_File.xs | 708 +++++++++++++++++++++++++++++++++++-- ext/GDBM_File/t/count.t | 34 ++ ext/GDBM_File/t/opt.t | 37 ++ ext/GDBM_File/typemap | 3 + 7 files changed, 1050 insertions(+), 63 deletions(-) create mode 100644 ext/GDBM_File/t/count.t create mode 100644 ext/GDBM_File/t/opt.t diff --git a/AUTHORS b/AUTHORS index 6cb7f0e05c97..c084ef712ac2 100644 --- a/AUTHORS +++ b/AUTHORS @@ -1160,6 +1160,7 @@ Sebastian Wittmeier Sebastien Barre Sergey Alekseev Sergey Aleynikov +Sergey Poznyakoff Sergiy Borodych Sevan Janiyan Shawn diff --git a/MANIFEST b/MANIFEST index dcd03aa93881..533e9e85be5c 100644 --- a/MANIFEST +++ b/MANIFEST @@ -4221,8 +4221,10 @@ ext/GDBM_File/GDBM_File.pm GDBM extension Perl module ext/GDBM_File/GDBM_File.xs GDBM extension external subroutines ext/GDBM_File/hints/sco.pl Hint for GDBM_File for named architecture ext/GDBM_File/Makefile.PL GDBM extension makefile writer +ext/GDBM_File/t/count.t Test if the count method works ext/GDBM_File/t/fatal.t Test the fatal_func argument to gdbm_open ext/GDBM_File/t/gdbm.t See if GDBM_File works +ext/GDBM_File/t/opt.t Test if gdbm_setopt and derived methods work ext/GDBM_File/typemap GDBM extension interface types ext/Hash-Util/Changes Change history of Hash::Util ext/Hash-Util/lib/Hash/Util.pm Hash::Util diff --git a/ext/GDBM_File/GDBM_File.pm b/ext/GDBM_File/GDBM_File.pm index b4fc49f42e8a..d837536f804c 100644 --- a/ext/GDBM_File/GDBM_File.pm +++ b/ext/GDBM_File/GDBM_File.pm @@ -6,9 +6,47 @@ GDBM_File - Perl5 access to the gdbm library. =head1 SYNOPSIS - use GDBM_File ; - tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640; + use GDBM_File; + [$db =] tie %hash, 'GDBM_File', $filename, &GDBM_WRCREAT, 0640; # Use the %hash array. + + $e = $db->errno; + $e = $db->syserrno; + $str = $db->strerror; + $bool = $db->needs_recovery; + + $db->clear_error; + + $db->reorganize; + $db->sync; + + $n = $db->count; + + $n = $db->flags; + + $str = $db->dbname; + + $db->cache_size; + $db->cache_size($newsize); + + $n = $db->block_size; + + $bool = $db->sync_mode; + $db->sync_mode($bool); + + $bool = $db->centfree; + $db->centfree($bool); + + $bool = $db->coalesce; + $db->coalesce($bool); + + $bool = $db->mmap; + + $size = $db->mmapsize; + $db->mmapsize($newsize); + + $db->recover(%args); + untie %hash ; =head1 DESCRIPTION @@ -24,6 +62,250 @@ Unlike Perl's built-in hashes, it is not safe to C the current item from a GDBM_File tied hash while iterating over it with C. This is a limitation of the gdbm library. +=head1 STATIC METHODS + +=head2 GDBM_version + + $str = GDBM_File->GDBM_version; + @ar = GDBM_File->GDBM_version; + +Returns the version number of the underlying B library. In scalar +context, returns the library version formatted as string: + + MINOR.MAJOR[.PATCH][ (GUESS)] + +where I, I, and I are version numbers, and I is +a guess level (see below). + +In list context, returns a list: + + ( MINOR, MAJOR, PATCH [, GUESS] ) + +The I component is present only if B version is 1.8.3 or +earlier. This is because earlier releases of B did not include +information about their version and the B module has to implement +certain guesswork in order to determine it. I is a textual description +in string context, and a positive number indicating how rough the guess is +in list context. Possible values are: + +=over 4 + +=item 1 - exact guess + +The major and minor version numbers are guaranteed to be correct. The actual +patchlevel is most probably guessed right, but can be 1-2 less than indicated. + +=item 2 - approximate + +The major and minor number are guaranteed to be correct. The patchlevel is +set to the upper bound. + +=item 3 - rough guess + +The version is guaranteed to be not newer than B.I>. + +=back + +=head1 METHODS + +=head2 close + + $db->close; + +Closes the database. You are not advised to use this method directly. Please, +use B instead. + +=head2 errno + + $db->errno + +Returns the last error status associated with this database. + +=head2 syserrno + + $db->syserrno + +Returns the last system error status (C C variable), associated with +this database, + +=head2 strerror + + $db->strerror + +Returns textual description of the last error that occurred in this database. + +=head2 clear_error + + $db->clear_error + +Clear error status. + +=head2 needs_recovery + + $db->needs_recovery + +Returns true if the database needs recovery. + +=head2 reorganize + + $db->reorganize; + +Reorganizes the database. + +=head2 sync + + $db->sync; + +Synchronizes recent changes to the database with its disk copy. + +=head2 count + + $n = $db->count; + +Returns number of keys in the database. + +=head2 flags + + $db->flags; + +Returns flags passed as 4th argument to B. + +=head2 dbname + + $db->dbname; + +Returns the database name (i.e. 3rd argument to B. + +=head2 cache_size + + $db->cache_size; + $db->cache_size($newsize); + +Returns the size of the internal B cache for that database. + +Called with argument, sets the size to I<$newsize>. + +=head2 block_size + + $db->block_size; + +Returns the block size of the database. + +=head2 sync_mode + + $db->sync_mode; + $db->sync_mode($bool); + +Returns the status of the automatic synchronization mode. Called with argument, +enables or disables the sync mode, depending on whether $bool is B or +B. + +When synchronization mode is on (B), any changes to the database are +immediately written to the disk. This ensures database consistency in case +of any unforeseen errors (e.g. power failures), at the expense of considerable +slowdown of operation. + +Synchronization mode is off by default. + +=head2 centfree + + $db->centfree; + $db->centfree($bool); + +Returns status of the central free block pool (B<0> - disabled, +B<1> - enabled). + +With argument, changes its status. + +By default, central free block pool is disabled. + +=head2 coalesce + + $db->coalesce; + $db->coalesce($bool); + +=head2 mmap + + $db->mmap; + +Returns true if memory mapping is enabled. + +This method will B if the B library is complied without +memory mapping support. + +=head2 mmapsize + + $db->mmapsize; + $db->mmapsize($newsize); + +If memory mapping is enabled, returns the size of memory mapping. With +argument, sets the size to B<$newsize>. + +This method will B if the B library is complied without +memory mapping support. + +=head2 recover + + $db->recover(%args); + +Recovers data from a failed database. B<%args> is optional and can contain +following keys: + +=over 4 + +=item err => sub { ... } + +Reference to code for detailed error reporting. Upon encountering an error, +B will call this sub with a single argument - a description of the +error. + +=item backup => \$str + +Creates a backup copy of the database before recovery and returns its +filename in B<$str>. + +=item max_failed_keys => $n + +Maximum allowed number of failed keys. If the actual number becomes equal +to I<$n>, B aborts and returns error. + +=item max_failed_buckets => $n + +Maximum allowed number of failed buckets. If the actual number becomes equal +to I<$n>, B aborts and returns error. + +=item max_failures => $n + +Maximum allowed number of failures during recovery. + +=item stat => \%hash + +Return recovery statistics in I<%hash>. Upon return, the following keys will +be present: + +=over 8 + +=item recovered_keys + +Number of successfully recovered keys. + +=item recovered_buckets + +Number of successfully recovered buckets. + +=item failed_keys + +Number of keys that failed to be retrieved. + +=item failed_buckets + +Number of buckets that failed to be retrieved. + +=back + +=back + + =head1 AVAILABILITY gdbm is available from any GNU archive. The master site is @@ -43,15 +325,11 @@ can be safely used with C. A maliciously crafted file might cause perl to crash or even expose a security vulnerability. -=head1 BUGS - -The available functions and the gdbm/perl interface need to be documented. - -The GDBM error number and error message interface needs to be added. - =head1 SEE ALSO -L, L, L. +L, L, L, +L, +L. =cut @@ -67,25 +345,25 @@ require Exporter; require XSLoader; @ISA = qw(Tie::Hash Exporter); @EXPORT = qw( - GDBM_CACHESIZE - GDBM_CENTFREE - GDBM_COALESCEBLKS - GDBM_FAST - GDBM_FASTMODE - GDBM_INSERT - GDBM_NEWDB - GDBM_NOLOCK - GDBM_OPENMASK - GDBM_READER - GDBM_REPLACE - GDBM_SYNC - GDBM_SYNCMODE - GDBM_WRCREAT - GDBM_WRITER + GDBM_CACHESIZE + GDBM_CENTFREE + GDBM_COALESCEBLKS + GDBM_FAST + GDBM_FASTMODE + GDBM_INSERT + GDBM_NEWDB + GDBM_NOLOCK + GDBM_OPENMASK + GDBM_READER + GDBM_REPLACE + GDBM_SYNC + GDBM_SYNCMODE + GDBM_WRCREAT + GDBM_WRITER ); # This module isn't dual life, so no need for dev version numbers. -$VERSION = '1.18'; +$VERSION = '1.19'; XSLoader::load(); diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index 7f910491166f..ef7bde57b12f 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -23,23 +23,106 @@ typedef datum datum_key ; typedef datum datum_value ; typedef datum datum_key_copy; -#if defined(GDBM_VERSION_MAJOR) && defined(GDBM_VERSION_MINOR) \ - && GDBM_VERSION_MAJOR > 1 || \ - (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9) -typedef void (*FATALFUNC)(const char *); +/* Indexes for gdbm_flags aliases */ +enum { + opt_flags = 0, + opt_cache_size, + opt_sync_mode, + opt_centfree, + opt_coalesce, + opt_dbname, + opt_block_size, + opt_mmap, + opt_mmapsize +}; + +/* Names of gdbm_flags aliases, for error reporting. + Indexed by opt_ constants above. +*/ +char const *opt_names[] = { + "GDBM_File::flags", + "GDBM_File::cache_size", + "GDBM_File::sync_mode", + "GDBM_File::centfree", + "GDBM_File::coalesce", + "GDBM_File::dbname", + "GDBM_File::block_size", + "GDBM_File::mmap", + "GDBM_File::mmapsize" +}; + +#ifdef GDBM_VERSION_MAJOR +# define GDBM_VERSION_GUESS 0 #else -typedef void (*FATALFUNC)(); +/* Try educated guess + * The value of GDBM_VERSION_GUESS indicates how rough the guess is: + * 1 - Precise; based on the CVS logs and existing archives + * 2 - Moderate. The major and minor number are correct. The patchlevel + * is set to the upper bound. + * 3 - Rough; The version is guaranteed to be not newer than major.minor. + */ +# if defined(GDBM_SYNCMODE) +/* CHANGES from 1.7.3 to 1.8 + * 1. Added GDBM_CENTFREE functionality and option. + */ +# define GDBM_VERSION_MAJOR 1 +# define GDBM_VERSION_MINOR 8 +# define GDBM_VERSION_PATCH 3 +# define GDBM_VERSION_GUESS 1 +# elif defined(GDBM_FASTMODE) +/* CHANGES from 1.7.2 to 1.7.3 + * 1. Fixed a couple of last minute problems. (Namely, no autoconf.h in + * version.c, and no GDBM_FASTMODE in gdbm.h!) + */ +# define GDBM_VERSION_MAJOR 1 +# define GDBM_VERSION_MINOR 7 +# define GDBM_VERSION_PATCH 3 +# define GDBM_VERSION_GUESS 1 +# elif defined(GDBM_FAST) +/* From CVS logs: + * Mon May 17 12:32:02 1993 Phil Nelson (phil at cs.wwu.edu) + * + * * gdbm.proto: Added GDBM_FAST to the read_write flags. + */ +# define GDBM_VERSION_MAJOR 1 +# define GDBM_VERSION_MINOR 7 +# define GDBM_VERSION_PATCH 2 +# define GDBM_VERSION_GUESS 2 +# else +# define GDBM_VERSION_MAJOR 1 +# define GDBM_VERSION_MINOR 6 +# define GDBM_VERSION_GUESS 3 +# endif #endif -#ifndef GDBM_FAST -static int -not_here(char *s) -{ - croak("GDBM_File::%s not implemented on this architecture", s); - return -1; +#ifndef GDBM_VERSION_PATCH +# define GDBM_VERSION_PATCH 0 +#endif + +/* The use of fatal_func argument to gdbm_open is deprecated since 1.13 */ +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 +# define FATALFUNC NULL +#elif GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9 +# define FATALFUNC croak_string +# define NEED_FATALFUNC 1 +#else +# define FATALFUNC (void (*)()) croak_string +# define NEED_FATALFUNC 1 +#endif + +#ifdef NEED_FATALFUNC +static void +croak_string(const char *message) { + Perl_croak_nocontext("%s", message); } #endif +#define not_here(s) (croak("GDBM_File::%s not implemented", #s),-1) + +#if ! (GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11) +typedef unsigned gdbm_count_t; +#endif + /* GDBM allocates the datum with system malloc() and expects the user * to free() it. So we either have to free() it immediately, or have * perl free() it when it deallocates the SV, depending on whether @@ -62,10 +145,72 @@ output_datum(pTHX_ SV *arg, char *str, int size) #define gdbm_setopt(db,optflag,optval,optlen) not_here("gdbm_setopt") #endif +#ifndef GDBM_ITEM_NOT_FOUND +# define GDBM_ITEM_NOT_FOUND GDBM_NO_ERROR +#endif + +/* Prior to 1.13, gdbm_fetch family functions set gdbm_errno to GDBM_NO_ERROR + if the requested key did not exist */ +#define ITEM_NOT_FOUND() \ + (gdbm_errno == GDBM_ITEM_NOT_FOUND || gdbm_errno == GDBM_NO_ERROR) + +#define CHECKDB(db) do { \ + if (!db->dbp) { \ + croak("database was closed"); \ + } \ + } while (0) + static void -croak_string(const char *message) { - Perl_croak_nocontext("%s", message); +dbcroak(GDBM_File db, char const *func) +{ +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 + croak("%s: %s", func, gdbm_db_strerror(db->dbp)); +#else + (void)db; + croak("%s: %s", func, gdbm_strerror(gdbm_errno)); +#endif +} + +#if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90) +# define gdbm_close(db) gdbm_close(db->dbp) +#else +# define gdbm_close(db) (gdbm_close(db->dbp),0) +#endif +static int +gdbm_file_close(GDBM_File db) +{ + int rc = 0; + if (db->dbp) { + rc = gdbm_close(db); + db->dbp = NULL; + } + return rc; +} + +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 +/* Error-reporting wrapper for gdbm_recover */ +static void +rcvr_errfun(void *cv, char const *fmt, ...) +{ + va_list ap; + + dSP; + + ENTER; + SAVETMPS; + + PUSHMARK(SP); + va_start(ap, fmt); + XPUSHs(sv_2mortal(vnewSVpvf(fmt, &ap))); + va_end(ap); + PUTBACK; + + call_sv((SV*)cv, G_DISCARD); + + FREETMPS; + LEAVE; } +#endif #include "const-c.inc" @@ -73,6 +218,41 @@ MODULE = GDBM_File PACKAGE = GDBM_File PREFIX = gdbm_ INCLUDE: const-xs.inc +void +gdbm_GDBM_version(package) + char *package; + PPCODE: + I32 gimme = GIMME_V; + if (gimme == G_VOID) { + /* nothing */; + } else if (gimme == G_SCALAR) { + static char const *guess[] = { + "", + " (exact guess)", + " (approximate)", + " (rough guess)" + }; + if (GDBM_VERSION_PATCH > 0) { + XPUSHs(sv_2mortal(newSVpvf("%d.%d.%d%s", + GDBM_VERSION_MAJOR, + GDBM_VERSION_MINOR, + GDBM_VERSION_PATCH, + guess[GDBM_VERSION_GUESS]))); + } else { + XPUSHs(sv_2mortal(newSVpvf("%d.%d%s", + GDBM_VERSION_MAJOR, + GDBM_VERSION_MINOR, + guess[GDBM_VERSION_GUESS]))); + } + } else { + XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MAJOR))); + XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_MINOR))); + XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_PATCH))); + if (GDBM_VERSION_GUESS > 0) { + XPUSHs(sv_2mortal(newSVuv(GDBM_VERSION_GUESS))); + } + } + GDBM_File gdbm_TIEHASH(dbtype, name, read_write, mode) char * dbtype @@ -82,7 +262,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode) PREINIT: GDBM_FILE dbp; CODE: - dbp = gdbm_open(name, 0, read_write, mode, (FATALFUNC)croak_string); + dbp = gdbm_open(name, 0, read_write, mode, FATALFUNC); if (!dbp && gdbm_errno == GDBM_BLOCK_SIZE_ERROR) { /* * By specifying a block size of 0 above, we asked gdbm to @@ -93,8 +273,7 @@ gdbm_TIEHASH(dbtype, name, read_write, mode) * defaulting to fail. In that case, force an acceptable * block size. */ - dbp = gdbm_open(name, 4096, read_write, mode, - (FATALFUNC)croak_string); + dbp = gdbm_open(name, 4096, read_write, mode, FATALFUNC); } if (dbp) { RETVAL = (GDBM_File)safecalloc(1, sizeof(GDBM_File_type)); @@ -105,31 +284,46 @@ gdbm_TIEHASH(dbtype, name, read_write, mode) OUTPUT: RETVAL - -#define gdbm_close(db) gdbm_close(db->dbp) -void -gdbm_close(db) - GDBM_File db - CLEANUP: - void gdbm_DESTROY(db) GDBM_File db PREINIT: int i = store_value; - CODE: - gdbm_close(db); + CODE: + if (gdbm_file_close(db)) { + croak("gdbm_close: %s; %s", gdbm_strerror(gdbm_errno), + strerror(errno)); + } do { if (db->filter[i]) SvREFCNT_dec(db->filter[i]); } while (i-- > 0); safefree(db); +void +gdbm_UNTIE(db, count) + GDBM_File db + unsigned count + CODE: + if (count == 0) { + if (gdbm_file_close(db)) + croak("gdbm_close: %s; %s", + gdbm_strerror(gdbm_errno), + strerror(errno)); + } + + #define gdbm_FETCH(db,key) gdbm_fetch(db->dbp,key) datum_value gdbm_FETCH(db, key) GDBM_File db datum_key_copy key + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { + dbcroak(db, "gdbm_fetch"); + } #define gdbm_STORE(db,key,value,flags) gdbm_store(db->dbp,key,value,flags) int @@ -138,12 +332,11 @@ gdbm_STORE(db, key, value, flags = GDBM_REPLACE) datum_key key datum_value value int flags + INIT: + CHECKDB(db); CLEANUP: if (RETVAL) { - if (RETVAL < 0 && errno == EPERM) - croak("No write permission to gdbm file"); - croak("gdbm store returned %d, errno %d, key \"%.*s\"", - RETVAL,errno,key.dsize,key.dptr); + dbcroak(db, "gdbm_store"); } #define gdbm_DELETE(db,key) gdbm_delete(db->dbp,key) @@ -151,35 +344,468 @@ int gdbm_DELETE(db, key) GDBM_File db datum_key key + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL && !ITEM_NOT_FOUND()) { + dbcroak(db, "gdbm_delete"); + } #define gdbm_FIRSTKEY(db) gdbm_firstkey(db->dbp) datum_key gdbm_FIRSTKEY(db) GDBM_File db + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { + dbcroak(db, "gdbm_firstkey"); + } #define gdbm_NEXTKEY(db,key) gdbm_nextkey(db->dbp,key) datum_key gdbm_NEXTKEY(db, key) GDBM_File db datum_key key + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL.dptr == NULL && !ITEM_NOT_FOUND()) { + dbcroak(db, "gdbm_nextkey"); + } + +#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) +int +gdbm_EXISTS(db, key) + GDBM_File db + datum_key key + INIT: + CHECKDB(db); +## + +int +gdbm_close(db) + GDBM_File db + INIT: + CHECKDB(db); + CODE: + RETVAL = gdbm_file_close(db); + OUTPUT: + RETVAL + +int +gdbm_errno(db) + GDBM_File db + INIT: + CHECKDB(db); + CODE: +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 + RETVAL = gdbm_last_errno(db->dbp); +#else + RETVAL = gdbm_errno; +#endif + OUTPUT: + RETVAL + +int +gdbm_syserrno(db) + GDBM_File db + INIT: + CHECKDB(db); + CODE: +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 + { + int ec = gdbm_last_errno(db->dbp); + if (gdbm_check_syserr(ec)) { + RETVAL = gdbm_last_syserr(db->dbp); + } else { + RETVAL = 0; + } + } +#else + not_here("syserrno"); +#endif + OUTPUT: + RETVAL + +SV * +gdbm_strerror(db) + GDBM_File db + PREINIT: + char const *errstr; + INIT: + CHECKDB(db); + CODE: +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 + errstr = gdbm_db_strerror(db->dbp); +#else + errstr = gdbm_strerror(gdbm_errno); +#endif + RETVAL = newSVpv(errstr, 0); + OUTPUT: + RETVAL + +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 +# define gdbm_clear_error(db) gdbm_clear_error(db->dbp) +#else +# define gdbm_clear_error(db) (gdbm_errno = 0) +#endif +void +gdbm_clear_error(db) + GDBM_File db + INIT: + CHECKDB(db); + +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 +# define gdbm_needs_recovery(db) gdbm_needs_recovery(db->dbp) +#else +# define gdbm_needs_recovery(db) not_here("gdbm_needs_recovery") +#endif +int +gdbm_needs_recovery(db) + GDBM_File db + INIT: + CHECKDB(db); + #define gdbm_reorganize(db) gdbm_reorganize(db->dbp) int gdbm_reorganize(db) GDBM_File db + INIT: + CHECKDB(db); + +# Arguments: +# err => sub { ... } +# max_failed_keys => $n +# max_failed_buckets => $n +# max_failures => $n +# backup => \$str +# stat => \%hash + +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 13 -#define gdbm_sync(db) gdbm_sync(db->dbp) void -gdbm_sync(db) +gdbm_recover(db, ...) GDBM_File db + PREINIT: + int flags = GDBM_RCVR_FORCE; + SV *backup_ref = &PL_sv_undef; + SV *stat_ref = &PL_sv_undef; + gdbm_recovery rcvr; + INIT: + CHECKDB(db); + CODE: + if (items > 1) { + int i; + if ((items % 2) == 0) { + croak("bad number of arguments"); + } + for (i = 1; i < items; i += 2) { + char *kw; + SV *sv = ST(i); + SV *val = ST(i+1); -#define gdbm_EXISTS(db,key) gdbm_exists(db->dbp,key) + if (!SvPOK(sv)) + croak("bad arguments near #%d", i); + kw = SvPV_nolen(sv); + if (strcmp(kw, "err") == 0) { + if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVCV) { + rcvr.data = SvRV(val); + } else { + croak("%s must be a code ref", kw); + } + rcvr.errfun = rcvr_errfun; + flags |= GDBM_RCVR_ERRFUN; + } else if (strcmp(kw, "max_failed_keys") == 0) { + if (SvIOK(val)) { + rcvr.max_failed_keys = SvUV(val); + } else { + croak("max_failed_keys must be numeric"); + } + flags |= GDBM_RCVR_MAX_FAILED_KEYS; + } else if (strcmp(kw, "max_failed_buckets") == 0) { + if (SvIOK(val)) { + rcvr.max_failed_buckets = SvUV(val); + } else { + croak("max_failed_buckets must be numeric"); + } + flags |= GDBM_RCVR_MAX_FAILED_BUCKETS; + } else if (strcmp(kw, "max_failures") == 0) { + if (SvIOK(val)) { + rcvr.max_failures = SvUV(val); + } else { + croak("max_failures must be numeric"); + } + flags |= GDBM_RCVR_MAX_FAILURES; + } else if (strcmp(kw, "backup") == 0) { + if (SvROK(val) && SvTYPE(SvRV(val)) < SVt_PVAV) { + backup_ref = val; + } else { + croak("backup must be a scalar reference"); + } + flags |= GDBM_RCVR_BACKUP; + } else if (strcmp(kw, "stat") == 0) { + if (SvROK(val) && SvTYPE(SvRV(val)) == SVt_PVHV) { + stat_ref = val; + } else { + croak("backup must be a scalar reference"); + } + } else { + croak("%s: unrecognized argument", kw); + } + } + } + if (gdbm_recover(db->dbp, &rcvr, flags)) { + dbcroak(db, "gdbm_recover"); + } + if (stat_ref != &PL_sv_undef) { + HV *hv = (HV*)SvRV(stat_ref); +#define STAT_RECOVERED_KEYS_STR "recovered_keys" +#define STAT_RECOVERED_KEYS_LEN (sizeof(STAT_RECOVERED_KEYS_STR)-1) +#define STAT_RECOVERED_BUCKETS_STR "recovered_buckets" +#define STAT_RECOVERED_BUCKETS_LEN (sizeof(STAT_RECOVERED_BUCKETS_STR)-1) +#define STAT_FAILED_KEYS_STR "failed_keys" +#define STAT_FAILED_KEYS_LEN (sizeof(STAT_FAILED_KEYS_STR)-1) +#define STAT_FAILED_BUCKETS_STR "failed_buckets" +#define STAT_FAILED_BUCKETS_LEN (sizeof(STAT_FAILED_BUCKETS_STR)-1) + hv_store(hv, STAT_RECOVERED_KEYS_STR, STAT_RECOVERED_KEYS_LEN, + newSVuv(rcvr.recovered_keys), 0); + hv_store(hv, + STAT_RECOVERED_BUCKETS_STR, + STAT_RECOVERED_BUCKETS_LEN, + newSVuv(rcvr.recovered_buckets), 0); + hv_store(hv, + STAT_FAILED_KEYS_STR, + STAT_FAILED_KEYS_LEN, + newSVuv(rcvr.failed_keys), 0); + hv_store(hv, + STAT_FAILED_BUCKETS_STR, + STAT_FAILED_BUCKETS_LEN, + newSVuv(rcvr.failed_buckets), 0); + } + if (backup_ref != &PL_sv_undef) { + SV *sv = SvRV(backup_ref); + sv_setpv(sv, rcvr.backup_name); + free(rcvr.backup_name); + } + +#endif + +#if GDBM_VERSION_MAJOR == 1 && (GDBM_VERSION_MINOR > 16 || GDBM_VERSION_PATCH >= 90) +# define gdbm_sync(db) gdbm_sync(db->dbp) +#else +# define gdbm_sync(db) (gdbm_sync(db->dbp),0) +#endif int -gdbm_EXISTS(db, key) +gdbm_sync(db) GDBM_File db - datum_key key + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL) { + dbcroak(db, "gdbm_sync"); + } + +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 11 + +gdbm_count_t +gdbm_count(db) + GDBM_File db + PREINIT: + gdbm_count_t c; + INIT: + CHECKDB(db); + CODE: + if (gdbm_count(db->dbp, &c)) { + dbcroak(db, "gdbm_count"); + } + RETVAL = c; + OUTPUT: + RETVAL + +#endif + +#define OPTNAME(a,b) a ## b +#define INTOPTSETUP(opt) \ + do { \ + if (items == 1) { \ + opcode = OPTNAME(GDBM_GET, opt); \ + } else { \ + opcode = OPTNAME(GDBM_SET, opt); \ + sv = ST(1); \ + if (!SvIOK(sv)) { \ + croak("%s: bad argument type", opt_names[ix]); \ + } \ + c_iv = SvIV(sv); \ + } \ + } while (0) +#if GDBM_VERSION_MAJOR == 1 && GDBM_VERSION_MINOR >= 9 +# define OPTVALPTR void * +#else +# define OPTVALPTR int * +#endif + +# GDBM_GET defines appeared in version 1.9 (2011-08-12). +# +# Provide definitions for earlier versions. These will cause gdbm_setopt +# to fail with GDBM_OPT_ILLEGAL + +#ifndef GDBM_GETFLAGS +# define GDBM_GETFLAGS -1 +#endif +#ifndef GDBM_GETMMAP +# define GDBM_GETMMAP -1 +#endif +#ifndef GDBM_GETCACHESIZE +# define GDBM_GETCACHESIZE -1 +#endif +#ifndef GDBM_GETSYNCMODE +# define GDBM_GETSYNCMODE -1 +#endif +#ifndef GDBM_GETCENTFREE +# define GDBM_GETCENTFREE -1 +#endif +#ifndef GDBM_GETCOALESCEBLKS +# define GDBM_GETCOALESCEBLKS -1 +#endif +#ifndef GDBM_GETMAXMAPSIZE +# define GDBM_GETMAXMAPSIZE -1 +#endif +#ifndef GDBM_GETDBNAME +# define GDBM_GETDBNAME -1 +#endif +#ifndef GDBM_GETBLOCKSIZE +# define GDBM_GETBLOCKSIZE -1 +#endif + +# These two appeared in version 1.10: + +#ifndef GDBM_SETMAXMAPSIZE +# define GDBM_SETMAXMAPSIZE -1 +#endif +#ifndef GDBM_SETMMAP +# define GDBM_SETMMAP -1 +#endif + +# These GDBM_SET defines appeared in 1.10, replacing obsolete opcodes. +# Provide definitions for older versions + +#ifndef GDBM_SETCACHESIZE +# define GDBM_SETCACHESIZE GDBM_CACHESIZE +#endif +#ifndef GDBM_SETSYNCMODE +# define GDBM_SETSYNCMODE GDBM_SYNCMODE +#endif +#ifndef GDBM_SETCENTFREE +# define GDBM_SETCENTFREE GDBM_CENTFREE +#endif +#ifndef GDBM_SETCOALESCEBLKS +# define GDBM_SETCOALESCEBLKS GDBM_COALESCEBLKS +#endif + +SV * +gdbm_flags(db, ...) + GDBM_File db + SV * RETVAL = &PL_sv_undef; + ALIAS: + GDBM_File::cache_size = opt_cache_size + GDBM_File::sync_mode = opt_sync_mode + GDBM_File::centfree = opt_centfree + GDBM_File::coalesce = opt_coalesce + GDBM_File::dbname = opt_dbname + GDBM_File::block_size = opt_block_size + GDBM_File::mmap = opt_mmap + GDBM_File::mmapsize = opt_mmapsize + PREINIT: + int opcode = -1; + int c_iv; + unsigned c_uv; + char *c_cv; + OPTVALPTR vptr = (OPTVALPTR) &c_iv; + size_t vsiz = sizeof(c_iv); + SV *sv; + INIT: + CHECKDB(db); + CODE: + if (items > 2) { + croak("%s: too many arguments", opt_names[ix]); + } + + switch (ix) { + case opt_flags: + if (items > 1) { + croak("%s: too many arguments", opt_names[ix]); + } + opcode = GDBM_GETFLAGS; + break; + case opt_cache_size: + INTOPTSETUP(CACHESIZE); + break; + case opt_sync_mode: + INTOPTSETUP(SYNCMODE); + break; + case opt_centfree: + INTOPTSETUP(CENTFREE); + break; + case opt_coalesce: + INTOPTSETUP(COALESCEBLKS); + break; + case opt_dbname: + if (items > 1) { + croak("%s: too many arguments", opt_names[ix]); + } + opcode = GDBM_GETDBNAME; + vptr = (OPTVALPTR) &c_cv; + vsiz = sizeof(c_cv); + break; + case opt_block_size: + if (items > 1) { + croak("%s: too many arguments", opt_names[ix]); + } + opcode = GDBM_GETBLOCKSIZE; + break; + case opt_mmap: + if (items > 1) { + croak("%s: too many arguments", opt_names[ix]); + } + opcode = GDBM_GETMMAP; + break; + case opt_mmapsize: + vptr = (OPTVALPTR) &c_uv; + vsiz = sizeof(c_uv); + if (items == 1) { + opcode = GDBM_GETMAXMAPSIZE; + } else { + opcode = GDBM_SETMAXMAPSIZE; + sv = ST(1); + if (!SvUOK(sv)) { + croak("%s: bad argument type", opt_names[ix]); + } + c_uv = SvUV(sv); + } + break; + } + + if (gdbm_setopt(db->dbp, opcode, vptr, vsiz)) { + if (gdbm_errno == GDBM_OPT_ILLEGAL) + croak("%s not implemented", opt_names[ix]); + dbcroak(db, "gdbm_setopt"); + } + + if (vptr == (OPTVALPTR) &c_iv) { + RETVAL = newSViv(c_iv); + } else if (vptr == (OPTVALPTR) &c_uv) { + RETVAL = newSVuv(c_uv); + } else { + RETVAL = newSVpv(c_cv, 0); + free(c_cv); + } + OUTPUT: + RETVAL + #define gdbm_setopt(db,optflag, optval, optlen) gdbm_setopt(db->dbp,optflag, optval, optlen) int gdbm_setopt (db, optflag, optval, optlen) @@ -187,17 +813,23 @@ gdbm_setopt (db, optflag, optval, optlen) int optflag int &optval int optlen - + INIT: + CHECKDB(db); + CLEANUP: + if (RETVAL) { + dbcroak(db, "gdbm_setopt"); + } SV * filter_fetch_key(db, code) GDBM_File db SV * code SV * RETVAL = &PL_sv_undef ; - ALIAS: + ALIAS: GDBM_File::filter_fetch_key = fetch_key GDBM_File::filter_store_key = store_key GDBM_File::filter_fetch_value = fetch_value GDBM_File::filter_store_value = store_value - CODE: - DBM_setFilter(db->filter[ix], code); + CODE: + DBM_setFilter(db->filter[ix], code); + diff --git a/ext/GDBM_File/t/count.t b/ext/GDBM_File/t/count.t new file mode 100644 index 000000000000..7b3034123426 --- /dev/null +++ b/ext/GDBM_File/t/count.t @@ -0,0 +1,34 @@ +#!./perl -w +use strict; + +use Test::More; +use Config; + +BEGIN { + plan(skip_all => "GDBM_File was not built") + unless $Config{extensions} =~ /\bGDBM_File\b/; + + # https://rt.perl.org/Public/Bug/Display.html?id=117967 + plan(skip_all => "GDBM_File is flaky in $^O") + if $^O =~ /darwin/; + + plan(tests => 3); + use_ok('GDBM_File'); + } + +unlink ; + +my %h; +my $db = tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640); +isa_ok($db, 'GDBM_File'); +SKIP: { + skip 'GDBM_File::count not available', 1 + unless $db->can('count'); + + $h{one} = '1'; + $h{two} = '2'; + $h{three} = '3'; + is($db->count, 3, 'count'); +} + +unlink ; diff --git a/ext/GDBM_File/t/opt.t b/ext/GDBM_File/t/opt.t new file mode 100644 index 000000000000..41b3373e66a5 --- /dev/null +++ b/ext/GDBM_File/t/opt.t @@ -0,0 +1,37 @@ +#!./perl -w +use strict; + +use Test::More; +use Config; + +BEGIN { + plan(skip_all => "GDBM_File was not built") + unless $Config{extensions} =~ /\bGDBM_File\b/; + + # https://rt.perl.org/Public/Bug/Display.html?id=117967 + plan(skip_all => "GDBM_File is flaky in $^O") + if $^O =~ /darwin/; + + plan(tests => 8); + use_ok('GDBM_File'); +} + +unlink ; + +my %h; +my $db = tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640); +isa_ok($db, 'GDBM_File'); +SKIP: { + my $name = eval { $db->dbname } or do { + skip "gdbm_setopt GET calls not implemented", 6 + if $@ =~ /GDBM_File::dbname not implemented/; + }; + is($db->dbname, 'Op_dbmx', 'get dbname'); + is(eval { $db->dbname("a"); }, undef, 'dbname - bad usage'); + is($db->flags, GDBM_WRCREAT, 'get flags'); + is($db->sync_mode, 0, 'get sync_mode'); + is($db->sync_mode(1), 1, 'set sync_mode'); + is($db->sync_mode, 1, 'get sync_mode'); +} + +unlink ; diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap index 8d6edeed3552..5a52b2138372 100644 --- a/ext/GDBM_File/typemap +++ b/ext/GDBM_File/typemap @@ -11,6 +11,7 @@ SDBM_File T_PTROBJ ODBM_File T_PTROBJ DB_File T_PTROBJ DBZ_File T_PTROBJ +gdbm_count_t T_COUNT INPUT T_DATUM_K @@ -54,3 +55,5 @@ T_DATUM_V DBM_ckFilter($arg, filter[fetch_value],\"filter_fetch_value\"); T_PTROBJ sv_setref_pv($arg, dbtype, (void*)$var); +T_COUNT + sv_setuv($arg, (UV)$var); From 35cde4f7e7f6687315e63f6c984bb94b71564667 Mon Sep 17 00:00:00 2001 From: Sergey Poznyakoff Date: Wed, 6 Jan 2021 10:51:17 +0200 Subject: [PATCH 406/503] GDBM_File: minor changes * ext/GDBM_File/GDBM_File.xs (rcvr_errfun): Use dTHX (gdbm_GDBM_version): Don't declare package. * ext/GDBM_File/typemap: Map gdbm_count_t to T_UV. * ext/GDBM_File/t/count.t: Use File::Temp to create db in a temporary directory. * ext/GDBM_File/t/fatal.t: Likewise. * ext/GDBM_File/t/opt.t: Likewise. --- ext/GDBM_File/GDBM_File.xs | 5 ++--- ext/GDBM_File/t/count.t | 9 ++++++--- ext/GDBM_File/t/fatal.t | 9 +++++---- ext/GDBM_File/t/opt.t | 12 ++++++------ ext/GDBM_File/typemap | 4 +--- 5 files changed, 20 insertions(+), 19 deletions(-) diff --git a/ext/GDBM_File/GDBM_File.xs b/ext/GDBM_File/GDBM_File.xs index ef7bde57b12f..cd0bb6f26ffa 100644 --- a/ext/GDBM_File/GDBM_File.xs +++ b/ext/GDBM_File/GDBM_File.xs @@ -192,9 +192,9 @@ gdbm_file_close(GDBM_File db) static void rcvr_errfun(void *cv, char const *fmt, ...) { - va_list ap; - + dTHX; dSP; + va_list ap; ENTER; SAVETMPS; @@ -220,7 +220,6 @@ INCLUDE: const-xs.inc void gdbm_GDBM_version(package) - char *package; PPCODE: I32 gimme = GIMME_V; if (gimme == G_VOID) { diff --git a/ext/GDBM_File/t/count.t b/ext/GDBM_File/t/count.t index 7b3034123426..110624724629 100644 --- a/ext/GDBM_File/t/count.t +++ b/ext/GDBM_File/t/count.t @@ -3,6 +3,8 @@ use strict; use Test::More; use Config; +use File::Temp 'tempdir'; +use File::Spec; BEGIN { plan(skip_all => "GDBM_File was not built") @@ -16,10 +18,12 @@ BEGIN { use_ok('GDBM_File'); } -unlink ; +my $wd = tempdir(CLEANUP => 1); my %h; -my $db = tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640); +my $db = tie(%h, 'GDBM_File', File::Spec->catfile($wd, 'Op_dbmx'), + GDBM_WRCREAT, 0640); + isa_ok($db, 'GDBM_File'); SKIP: { skip 'GDBM_File::count not available', 1 @@ -31,4 +35,3 @@ SKIP: { is($db->count, 3, 'count'); } -unlink ; diff --git a/ext/GDBM_File/t/fatal.t b/ext/GDBM_File/t/fatal.t index 1cbfdc60181a..170508232b06 100644 --- a/ext/GDBM_File/t/fatal.t +++ b/ext/GDBM_File/t/fatal.t @@ -11,6 +11,8 @@ use strict; use Test::More; use Config; +use File::Temp 'tempdir'; +use File::Spec; BEGIN { plan(skip_all => "GDBM_File was not built") @@ -24,8 +26,6 @@ BEGIN { use_ok('GDBM_File'); } -unlink ; - open my $fh, '<', $^X or die "Can't open $^X: $!"; my $fileno = fileno $fh; isnt($fileno, undef, "Can find next available file descriptor"); @@ -35,8 +35,10 @@ is((open $fh, "<&=$fileno"), undef, "Check that we cannot open fileno $fileno. \$! is $!"); umask(0); +my $wd = tempdir(CLEANUP => 1); my %h; -isa_ok(tie(%h, 'GDBM_File', 'fatal_dbmx', GDBM_WRCREAT, 0640), 'GDBM_File'); +isa_ok(tie(%h, 'GDBM_File', File::Spec->catfile($wd, 'fatal_dbmx'), + GDBM_WRCREAT, 0640), 'GDBM_File'); isnt((open $fh, "<&=$fileno"), undef, "dup fileno $fileno") or diag("\$! = $!"); @@ -63,4 +65,3 @@ SKIP: { 'expected error message from GDBM_File'); } -unlink ; diff --git a/ext/GDBM_File/t/opt.t b/ext/GDBM_File/t/opt.t index 41b3373e66a5..72390ac32e88 100644 --- a/ext/GDBM_File/t/opt.t +++ b/ext/GDBM_File/t/opt.t @@ -3,6 +3,8 @@ use strict; use Test::More; use Config; +use File::Temp 'tempdir'; +use File::Spec; BEGIN { plan(skip_all => "GDBM_File was not built") @@ -16,22 +18,20 @@ BEGIN { use_ok('GDBM_File'); } -unlink ; - +my $wd = tempdir(CLEANUP => 1); +my $dbname = File::Spec->catfile($wd, 'Op_dbmx'); my %h; -my $db = tie(%h, 'GDBM_File', 'Op_dbmx', GDBM_WRCREAT, 0640); +my $db = tie(%h, 'GDBM_File', $dbname, GDBM_WRCREAT, 0640); isa_ok($db, 'GDBM_File'); SKIP: { my $name = eval { $db->dbname } or do { skip "gdbm_setopt GET calls not implemented", 6 if $@ =~ /GDBM_File::dbname not implemented/; }; - is($db->dbname, 'Op_dbmx', 'get dbname'); + is($db->dbname, $dbname, 'get dbname'); is(eval { $db->dbname("a"); }, undef, 'dbname - bad usage'); is($db->flags, GDBM_WRCREAT, 'get flags'); is($db->sync_mode, 0, 'get sync_mode'); is($db->sync_mode(1), 1, 'set sync_mode'); is($db->sync_mode, 1, 'get sync_mode'); } - -unlink ; diff --git a/ext/GDBM_File/typemap b/ext/GDBM_File/typemap index 5a52b2138372..7bc475daf63b 100644 --- a/ext/GDBM_File/typemap +++ b/ext/GDBM_File/typemap @@ -11,7 +11,7 @@ SDBM_File T_PTROBJ ODBM_File T_PTROBJ DB_File T_PTROBJ DBZ_File T_PTROBJ -gdbm_count_t T_COUNT +gdbm_count_t T_UV INPUT T_DATUM_K @@ -55,5 +55,3 @@ T_DATUM_V DBM_ckFilter($arg, filter[fetch_value],\"filter_fetch_value\"); T_PTROBJ sv_setref_pv($arg, dbtype, (void*)$var); -T_COUNT - sv_setuv($arg, (UV)$var); From 85c783f37d0b9b2c1bc2b93ae02254efe983d87a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20La=C3=BCgt?= Date: Tue, 5 Jan 2021 16:48:24 +0100 Subject: [PATCH 407/503] Generate lib/Config.pod with unix format to be read with pod/buildtoc --- configpm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configpm b/configpm index 0451f2de272c..94a477803733 100755 --- a/configpm +++ b/configpm @@ -856,7 +856,7 @@ tie %%Config, 'Config', { ENDOFTIE -open(CONFIG_POD, '>', $Config_POD) or die "Can't open $Config_POD: $!"; +open(CONFIG_POD, '>:raw', $Config_POD) or die "Can't open $Config_POD: $!"; print CONFIG_POD <<'ENDOFTAIL'; =head1 NAME From d1293dc2841a5dd8bf302ca97e28bd2f200bfc13 Mon Sep 17 00:00:00 2001 From: Tony Cook Date: Thu, 7 Jan 2021 11:32:36 +1100 Subject: [PATCH 408/503] reinstate USE_LARGE_FILES for the packaged win32 config.h files 8b3db1a0c enabled this, but a change based on the old disable- use-large-file rule in my d9f9953f74 disabled it, so re-enable it. This prevents some build warnings when building miniperl. --- win32/config_H.gc | 25 +++++++++++++++++++------ win32/config_H.vc | 25 +++++++++++++++++++------ 2 files changed, 38 insertions(+), 12 deletions(-) diff --git a/win32/config_H.gc b/win32/config_H.gc index 46a13c3f1cc7..2143b37b3ead 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Mon Oct 19 14:19:25 2020 + * Configuration time: Thu Jan 7 11:18:08 2021 * Configured by : tony * Target system : */ @@ -1369,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "10.0.18363.1139" /**/ +#define OSVERS "10.0.19041.685" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -4247,7 +4247,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -/*#define USE_LARGE_FILES / **/ +#define USE_LARGE_FILES /**/ #endif /* USE_LONG_DOUBLE: @@ -4540,6 +4540,19 @@ /*#define HAS_ENDSERVENT_R / **/ #define ENDSERVENT_R_PROTO 0 /**/ +/* GETENV_PRESERVES_OTHER_THREAD: + * This symbol, if defined, indicates that the getenv system call doesn't + * zap the static buffer of getenv() in a different thread. + * + * The typical getenv() implementation will return a pointer to the proper + * position in **environ. But some may instead copy them to a static + * buffer in getenv(). If there is a per-thread instance of that buffer, + * or the return points to **environ, then a many-reader/1-writer mutex + * will work; otherwise an exclusive locking mutex is required to prevent + * races. + */ +#define GETENV_PRESERVES_OTHER_THREAD /**/ + /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine * is available to getgrent re-entrantly. @@ -5211,9 +5224,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long /* type */ -#define LSEEKSIZE 4 /* size */ -#define Off_t_size 4 /* size */ +#define Off_t long long /* type */ +#define LSEEKSIZE 8 /* size */ +#define Off_t_size 8 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes diff --git a/win32/config_H.vc b/win32/config_H.vc index d067e1d1422d..2162287f1449 100644 --- a/win32/config_H.vc +++ b/win32/config_H.vc @@ -9,7 +9,7 @@ /* Package name : perl5 * Source directory : - * Configuration time: Mon Oct 19 14:24:24 2020 + * Configuration time: Thu Jan 7 11:25:42 2021 * Configured by : tony * Target system : */ @@ -1369,7 +1369,7 @@ * feature tests from Configure are generally more reliable. */ #define OSNAME "MSWin32" /**/ -#define OSVERS "10.0.18363.1139" /**/ +#define OSVERS "10.0.19041.685" /**/ /* CAT2: * This macro concatenates 2 tokens together. @@ -4247,7 +4247,7 @@ * should be used when available. */ #ifndef USE_LARGE_FILES -/*#define USE_LARGE_FILES / **/ +#define USE_LARGE_FILES /**/ #endif /* USE_LONG_DOUBLE: @@ -4540,6 +4540,19 @@ /*#define HAS_ENDSERVENT_R / **/ #define ENDSERVENT_R_PROTO 0 /**/ +/* GETENV_PRESERVES_OTHER_THREAD: + * This symbol, if defined, indicates that the getenv system call doesn't + * zap the static buffer of getenv() in a different thread. + * + * The typical getenv() implementation will return a pointer to the proper + * position in **environ. But some may instead copy them to a static + * buffer in getenv(). If there is a per-thread instance of that buffer, + * or the return points to **environ, then a many-reader/1-writer mutex + * will work; otherwise an exclusive locking mutex is required to prevent + * races. + */ +#define GETENV_PRESERVES_OTHER_THREAD /**/ + /* HAS_GETGRENT_R: * This symbol, if defined, indicates that the getgrent_r routine * is available to getgrent re-entrantly. @@ -5211,9 +5224,9 @@ /* Off_t_size: * This symbol holds the number of bytes used by the Off_t. */ -#define Off_t long /* type */ -#define LSEEKSIZE 4 /* size */ -#define Off_t_size 4 /* size */ +#define Off_t __int64 /* type */ +#define LSEEKSIZE 8 /* size */ +#define Off_t_size 8 /* size */ /* Mode_t: * This symbol holds the type used to declare file modes From 4a5737988002f58bbf693c68841c90a216964ea2 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Thu, 7 Jan 2021 10:22:27 +0000 Subject: [PATCH 409/503] Add .gitignore to the list of files that are safe to ignore in make_ext.pl Without this the build on Windows was failing, presumably since cfb249103f: FATAL - ..\make_ext.pl has Carp in the list of simple extensions, but it now contains file '.gitignore' which we can't handle at ..\make_ext.pl line 498. --- make_ext.pl | 1 + 1 file changed, 1 insertion(+) diff --git a/make_ext.pl b/make_ext.pl index ce3debd60397..79ae1efb1ae9 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -659,6 +659,7 @@ sub just_pm_to_blib { |README |README\.patching |README\.release + |\.gitignore )\z/xi; # /i to deal with case munging systems. if ($leaf eq "$last.pm") { ++$has_top; From 781d8b49760b7a212bb93c6a88cb71e9db9e1d71 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Thu, 7 Jan 2021 10:23:06 +0000 Subject: [PATCH 410/503] Bump copyright to 2021 in perl.c and README. Check that porting/copyright.t is passing when run with --now: ../perl -I../lib porting/copyright.t --now --- README | 2 +- perl.c | 5 +++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/README b/README index c0e833d28e3c..859122434fa4 100644 --- a/README +++ b/README @@ -1,6 +1,6 @@ Perl is Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012, -2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 by Larry Wall and others. +2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 by Larry Wall and others. All rights reserved. diff --git a/perl.c b/perl.c index 6c3ed0d55575..48ae9a3a04fd 100644 --- a/perl.c +++ b/perl.c @@ -3,7 +3,8 @@ * * Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001 * 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2012 - * 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 by Larry Wall and others + * 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 by Larry Wall + * and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -3819,7 +3820,7 @@ S_minus_v(pTHX) #endif PerlIO_printf(PIO_stdout, - "\n\nCopyright 1987-2020, Larry Wall\n"); + "\n\nCopyright 1987-2021, Larry Wall\n"); #ifdef MSDOS PerlIO_printf(PIO_stdout, "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n"); From 80ac1a601fa9ffc0dd7b4ae6fc3c0f3fb2f2add2 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 8 Jan 2021 11:39:38 -0700 Subject: [PATCH 411/503] perlre: Fix description of quantifer {m,n} upper limit The allowable max was doubled in 5.30 --- pod/perlre.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlre.pod b/pod/perlre.pod index bc475ec27a4a..e44f9431ecc9 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -880,7 +880,7 @@ quantifiers). The C<"*"> quantifier is equivalent to C<{0,}>, the C<"+"> quantifier to C<{1,}>, and the C<"?"> quantifier to C<{0,1}>. I and I are limited to non-negative integral values less than a preset limit defined when perl is built. -This is usually 32766 on the most common platforms. The actual limit can +This is usually 65534 on the most common platforms. The actual limit can be seen in the error message generated by code such as this: $_ **= $_ , / {$_} / for 2 .. 42; From ddf1101c515d0377bdc9a4fb7433bce54bdabc1e Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 9 Jan 2021 14:06:32 +0000 Subject: [PATCH 412/503] Perl 5.32.1 RC1 today --- pod/perlhist.pod | 1 + 1 file changed, 1 insertion(+) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 091c4e7de4f8..23c7f9888e56 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -694,6 +694,7 @@ the strings?). Sawyer X 5.32.0-RC0 2020-May-30 The 5.32 maintenance track Sawyer X 5.32.0-RC1 2020-Jun-07 Sawyer X 5.32.0 2020-Jun-20 + Steve 5.32.1-RC1 2021-Jan-09 Sawyer X 5.33.0 2020-Jul-17 The 5.33 development track Ether 5.33.1 2020-Aug-20 From f2d0b37bf1bbfea76c6a0d5ea0fa7c72fc8a1c06 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 9 Jan 2021 17:05:41 +0000 Subject: [PATCH 413/503] Add epigraph for 5.32.1-RC1 --- Porting/epigraphs.pod | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 8121849fac78..90e9e20dcaf8 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -81,6 +81,16 @@ L + +Why bother to learn to read when you can smell meat a mile away? If you +live in Moscow, though, and if you've got an ounce of brain in your head +you can't help learning to read - and without going to night-school +either. There are forty-thousand dogs in Moscow and I'll bet there's +not one of them so stupid he can't spell out the word 'sausage'. + =head2 v5.32.0 - Bob Dylan, "The Times They Are A Changing" L From 0e13edb07d947dbcdc01541ae91cff6cb3b1e441 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Sun, 10 Jan 2021 01:18:28 +0000 Subject: [PATCH 414/503] perlguts.pod - single character case correction SvfARG -> SVfARG --- pod/perlguts.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 965ca72ffafb..0d3e1b870934 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -2843,7 +2843,7 @@ with PTR2UV(). The contents of SVs may be printed using the C format, like so: - Perl_croak(aTHX_ "This croaked because: %" SVf "\n", SvfARG(err_msg)) + Perl_croak(aTHX_ "This croaked because: %" SVf "\n", SVfARG(err_msg)) where C is an SV. From 294f60cbf8e3f2ff407c4e11c89b51678d415a47 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sun, 10 Jan 2021 11:34:51 +0000 Subject: [PATCH 415/503] Aiming for 5.32.1 on 23rd January --- Porting/release_schedule.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 9c624e25bac5..21ba9a1c6fc3 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -14,7 +14,7 @@ deemed necessary by the Pumpking. =head2 Perl 5.32 2020-06-20 5.32.0 ✓ Sawyer X - 2020-??-?? 5.32.1 + 2021-01-23 5.32.1 Steve Hay =head2 Perl 5.30 From 53deed8922394340ce196a8092ba2ecdd30fc1bc Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sun, 10 Jan 2021 01:51:15 +0000 Subject: [PATCH 416/503] Correct for build-time warning Addresses this build-time warning: suggest braces around initialization of subobject [-Wmissing-braces] --- regexec.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regexec.c b/regexec.c index b46693e5ac0f..cab82cf51464 100644 --- a/regexec.c +++ b/regexec.c @@ -4527,7 +4527,7 @@ S_setup_EXACTISH_ST(pTHX_ const regnode * const text_node, /* Here and below, '15' is the value of UTF8_MAXBYTES_CASE, which requires at least :e */ - U8 matches[MAX_MATCHES][UTF8_MAXBYTES_CASE + 1] = { 0 }; + U8 matches[MAX_MATCHES][UTF8_MAXBYTES_CASE + 1] = { { 0 } }; U8 lengths[MAX_MATCHES] = { 0 }; U8 index_of_longest = 0; From 48fc63036cfacac5fa2abb1fc3f2c3dcc630c47f Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:11:37 +1100 Subject: [PATCH 417/503] perl.h - enable USE_QUADMATH builds (mingw compilers only) on MS Windows Align __float128 when using 64-bit mingw compilers. --- perl.h | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) diff --git a/perl.h b/perl.h index 9627f3408cee..0ca6f89e9f0c 100644 --- a/perl.h +++ b/perl.h @@ -2178,7 +2178,22 @@ You probably want to be using L> instead. # endif #endif -typedef NVTYPE NV; +/* On MS Windows,with 64-bit mingw-w64 compilers, we + need to attend to a __float128 alignment issue if + USE_QUADMATH is defined. Otherwise we simply: + typedef NVTYPE NV + 32-bit mingw.org compilers might also require + aligned(32) - at least that's what I found with my + Math::Foat128 module. But this is as yet untested + here, so no allowance is being made for mingw.org + compilers at this stage. -- sisyphus January 2021 +*/ +#if defined(USE_QUADMATH) && defined(__MINGW64__) + /* 64-bit build, mingw-w64 compiler only */ + typedef NVTYPE NV __attribute__ ((aligned(8))); +#else + typedef NVTYPE NV; +#endif #ifdef I_IEEEFP # include From 2460aa0752e71928bf75b1fb69974d5ae55088e1 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:15:09 +1100 Subject: [PATCH 418/503] ext/POSIX/POSIX.xs - allow POSIX::strtold on Windows USE_QUADMATH builds --- ext/POSIX/POSIX.xs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/ext/POSIX/POSIX.xs b/ext/POSIX/POSIX.xs index 83f2875db316..0fab00952593 100644 --- a/ext/POSIX/POSIX.xs +++ b/ext/POSIX/POSIX.xs @@ -1416,9 +1416,9 @@ char *tzname[] = { "" , "" }; # define setuid(a) not_here("setuid") # define setgid(a) not_here("setgid") #endif /* NETWARE */ -#ifndef USE_LONG_DOUBLE +#if !defined(USE_LONG_DOUBLE) && !defined(USE_QUADMATH) # define strtold(s1,s2) not_here("strtold") -#endif /* USE_LONG_DOUBLE */ +#endif /* !(USE_LONG_DOUBLE) && !(USE_QUADMATH) */ #else # ifndef HAS_MKFIFO From 1b85cc0a5c415af255c3b6744b518904f7fdb314 Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:20:32 +1100 Subject: [PATCH 419/503] win32/config_H.gc - enable USE_QUADMATH builds (mingw compilers only) on MS Windows --- win32/config_H.gc | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/win32/config_H.gc b/win32/config_H.gc index 2143b37b3ead..4d605b193d60 100644 --- a/win32/config_H.gc +++ b/win32/config_H.gc @@ -3927,6 +3927,13 @@ * with the standard IEEE 754 formats DBL_MANT_DIG includes * the implicit bit, which doesn't really exist. */ +/* FLT128MANTBITS: + * This symbol, if defined, tells how many mantissa bits + * there are in __float128 precision floating point format. + * Note that this is usually FLT128_MANT_DIG minus one, since + * with the standard IEEE 754 formats FLT128_MANT_DIG includes + * the implicit bit, which doesn't really exist. + */ /* LONGDBLMANTBITS: * This symbol, if defined, tells how many mantissa bits * there are in long double precision floating point format. @@ -3942,6 +3949,7 @@ */ #define DOUBLEMANTBITS 52 #define LONGDBLMANTBITS 64 +#define FLT128MANTBITS 112 #define NVMANTBITS 52 /* NEED_VA_COPY: From 5240fd959a2d4356ddcd05fd24693c9c98d27dba Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:24:20 +1100 Subject: [PATCH 420/503] win32/config_sh.PL - enable USE_QUADMATH builds (mingw compilers only) on MS Windows --- win32/config_sh.PL | 28 +++++++++++++++++++++++++++- 1 file changed, 27 insertions(+), 1 deletion(-) diff --git a/win32/config_sh.PL b/win32/config_sh.PL index 72300c5be98d..f1d746e15890 100644 --- a/win32/config_sh.PL +++ b/win32/config_sh.PL @@ -145,7 +145,7 @@ else { # set 64-bit-int options if ($opt{use64bitint} eq 'define') { - if ($opt{uselongdouble} eq 'define') { + if ($opt{uselongdouble} eq 'define' || $opt{usequadmath} eq 'define') { $opt{d_nv_preserves_uv} = 'define'; $opt{nv_preserves_uv_bits} = 64; } @@ -227,6 +227,32 @@ if ($opt{uselongdouble} eq 'define') { $opt{longdblkind} = 3; $opt{longdblmantbits} = 64; } +# set __float128 options +elsif ($opt{usequadmath} eq 'define') { + $opt{d_Gconvert} = 'sprintf((b),"%.*""Lg",(n),(x))'; + $opt{d_PRIEUldbl} = 'define'; + $opt{d_PRIFUldbl} = 'define'; + $opt{d_PRIGUldbl} = 'define'; + $opt{d_modflproto} = 'define'; + $opt{d_strtold} = 'define'; + $opt{d_PRIeldbl} = 'define'; + $opt{d_PRIfldbl} = 'define'; + $opt{d_PRIgldbl} = 'define'; + $opt{d_SCNfldbl} = 'define'; + $opt{nv_overflows_integers_at} = '256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*2.0'; + $opt{nvsize} = 16; + $opt{nvtype} = '__float128'; + $opt{nvEUformat} = '"QE"'; + $opt{nvFUformat} = '"QF"'; + $opt{nvGUformat} = '"QG"'; + $opt{nveformat} = '"Qe"'; + $opt{nvfformat} = '"Qf"'; + $opt{nvgformat} = '"Qg"'; + $opt{nvmantbits} = 112; + $opt{longdblkind} = 3; + $opt{longdblmantbits} = 64; + $opt{i_quadmath} = 'define'; +} else { $opt{d_Gconvert} = 'sprintf((b),"%.*g",(n),(x))'; $opt{d_PRIEUldbl} = 'undef'; From e7392fc268568686a791c32bc31682f5fa68fbfd Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:29:04 +1100 Subject: [PATCH 421/503] win32/GNUmakefile - enable USE_QUADMATH builds (mingw compilers only) on MS Windows --- win32/GNUmakefile | 52 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 52 insertions(+) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 553011345500..af0fdf45045c 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -128,6 +128,13 @@ USE_PERLIO := define # #USE_LONG_DOUBLE := define +# +# Uncomment these if you want to support the use of __float128 in GCC builds. +# This option is not supported for MSVC builds. +# +#USE_QUADMATH := define +#I_QUADMATH := define + # # Comment this out if you want to build perl without __USE_MINGW_ANSI_STDIO defined. # (If you're building perl with USE_LONG_DOUBLE defined then @@ -301,6 +308,8 @@ USE_PERLIO ?= undef USE_LARGE_FILES ?= undef USE_64_BIT_INT ?= undef USE_LONG_DOUBLE ?= undef +USE_QUADMATH ?= undef +I_QUADMATH ?= undef DEFAULT_INC_EXCLUDES_DOT ?= undef USE_NO_REGISTRY ?= undef @@ -440,6 +449,8 @@ endif # does not support it. ifneq ($(CCTYPE),GCC) USE_LONG_DOUBLE = undef +USE_QUADMATH = undef +I_QUADMATH = undef endif ARCHITECTURE = $(PROCESSOR_ARCHITECTURE) @@ -478,6 +489,10 @@ ifeq ($(USE_LONG_DOUBLE),define) ARCHNAME := $(ARCHNAME)-ld endif +ifeq ($(USE_QUADMATH),define) +ARCHNAME := $(ARCHNAME)-quadmath +endif + # Set the install location of the compiler headers/libraries. # These are saved into $Config{incpath} and $Config{libpth}. ifneq ($(GCCCROSS),) @@ -594,6 +609,10 @@ LIBFILES = $(LIBC) -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool \ -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 \ -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32 +ifeq ($(USE_QUADMATH),define) +LIBFILES += -lquadmath +endif + ifeq ($(CFG),Debug) OPTIMIZE = -g -O2 LINK_DBG = -g @@ -1191,6 +1210,7 @@ CFG_VARS = \ "usecplusplus=$(USE_CPLUSPLUS)" \ "cf_email=$(EMAIL)" \ "d_mymalloc=$(PERL_MALLOC)" \ + "i_quadmath=$(I_QUADMATH)" \ "libs=$(LIBFILES)" \ "incpath=$(subst ",\",$(CCINCDIR))" \ "libperl=$(subst ",\",$(PERLIMPLIBBASE))" \ @@ -1208,6 +1228,7 @@ CFG_VARS = \ "useperlio=$(USE_PERLIO)" \ "use64bitint=$(USE_64_BIT_INT)" \ "uselongdouble=$(USE_LONG_DOUBLE)" \ + "usequadmath=$(USE_QUADMATH)" \ "usesitecustomize=$(USE_SITECUST)" \ "default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT)" \ "LINK_FLAGS=$(subst ",\",$(LINK_FLAGS))"\ @@ -1362,6 +1383,8 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #undef NVff&& \ echo #undef NVgf&& \ echo #undef USE_LONG_DOUBLE&& \ + echo #undef I_QUADMATH&& \ + echo #undef USE_QUADMATH&& \ echo #undef USE_CPLUSPLUS)>> config.h ifeq ($(CCTYPE),MSVC140) @(echo #undef FILE_ptr&& \ @@ -1427,6 +1450,9 @@ ifeq ($(USE_64_BIT_INT),define) ifeq ($(USE_LONG_DOUBLE),define) @(echo #define NV_PRESERVES_UV&& \ echo #define NV_PRESERVES_UV_BITS 64)>> config.h +else ifeq ($(USE_QUADMATH),define) + @(echo #define NV_PRESERVES_UV&& \ + echo #define NV_PRESERVES_UV_BITS 64)>> config.h else @(echo #undef NV_PRESERVES_UV&& \ echo #define NV_PRESERVES_UV_BITS 53)>> config.h @@ -1469,7 +1495,30 @@ ifeq ($(USE_LONG_DOUBLE),define) echo #define NVef "Le"&& \ echo #define NVff "Lf"&& \ echo #define NVgf "Lg"&& \ + echo #undef I_QUADMATH&& \ + echo #undef USE_QUADMATH&& \ echo #define USE_LONG_DOUBLE)>> config.h +else ifeq ($(USE_QUADMATH),define) + @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%%.*""Lg",^(n^),^(x^)^)&& \ + echo #define HAS_FREXPL&& \ + echo #define HAS_ISNANL&& \ + echo #define HAS_MODFL&& \ + echo #define HAS_MODFL_PROTO&& \ + echo #define HAS_SQRTL&& \ + echo #define HAS_STRTOLD&& \ + echo #define PERL_PRIfldbl "Lf"&& \ + echo #define PERL_PRIgldbl "Lg"&& \ + echo #define PERL_PRIeldbl "Le"&& \ + echo #define PERL_SCNfldbl "Lf"&& \ + echo #define NVTYPE __float128&& \ + echo #define NVSIZE 16&& \ + echo #define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*2.0&& \ + echo #define NVef "Qe"&& \ + echo #define NVff "Qf"&& \ + echo #define NVgf "Qg"&& \ + echo #undef USE_LONG_DOUBLE&& \ + echo #define I_QUADMATH&& \ + echo #define USE_QUADMATH)>> config.h else @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%%.*g",^(n^),^(x^)^)&& \ echo #undef HAS_FREXPL&& \ @@ -1488,6 +1537,8 @@ else echo #define NVef "e"&& \ echo #define NVff "f"&& \ echo #define NVgf "g"&& \ + echo #undef I_QUADMATH&& \ + echo #undef USE_QUADMATH&& \ echo #undef USE_LONG_DOUBLE)>> config.h endif ifeq ($(USE_CPLUSPLUS),define) @@ -1902,6 +1953,7 @@ test-prep-gcc : if exist $(CCDLLDIR)\libgcc_s_dw2-1.dll $(XCOPY) $(CCDLLDIR)\libgcc_s_dw2-1.dll ..\t\$(NULL) if exist $(CCDLLDIR)\libstdc++-6.dll $(XCOPY) $(CCDLLDIR)\libstdc++-6.dll ..\t\$(NULL) if exist $(CCDLLDIR)\libwinpthread-1.dll $(XCOPY) $(CCDLLDIR)\libwinpthread-1.dll ..\t\$(NULL) + if exist $(CCDLLDIR)\libquadmath-0.dll $(XCOPY) $(CCDLLDIR)\libquadmath-0.dll ..\t\$(NULL) endif From ebc271eaf774c515e66806a9128307e76eaf6edc Mon Sep 17 00:00:00 2001 From: sisyphus Date: Sun, 10 Jan 2021 15:31:59 +1100 Subject: [PATCH 422/503] win32/makefile.mk - enable USE_QUADMATH builds (mingw compilers only) on MS Windows --- win32/makefile.mk | 61 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/win32/makefile.mk b/win32/makefile.mk index 26c824dca5e5..1e2a39c13c67 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -100,6 +100,13 @@ USE_IMP_SYS *= define # #USE_LONG_DOUBLE *= define +# +# Uncomment this if you want to support the use of __float128s in GCC builds. +# This option is not supported for MSVC builds. +# +#USE_QUADMATH *= define +#I_QUADMATH *= define + # # Comment this out if you want to build perl without __USE_MINGW_ANSI_STDIO defined. # (If you're building perl with USE_LONG_DOUBLE defined then @@ -303,6 +310,8 @@ USE_ITHREADS *= undef USE_IMP_SYS *= undef USE_64_BIT_INT *= undef USE_LONG_DOUBLE *= undef +USE_QUADMATH *= undef +I_QUADMATH *= undef DEFAULT_INC_EXCLUDES_DOT *= undef USE_NO_REGISTRY *= undef @@ -425,6 +434,13 @@ USE_64_BIT_INT = define USE_LONG_DOUBLE != undef .ENDIF +# Disable the __foat128 option for MSVC builds since that compiler +# does not support it. +.IF "$(CCTYPE)" != "GCC" +USE_QUADMATH != undef +I_QUADMATH != undef +.ENDIF + ARCHITECTURE = $(PROCESSOR_ARCHITECTURE) .IF "$(ARCHITECTURE)" == "AMD64" ARCHITECTURE = x64 @@ -453,6 +469,10 @@ ARCHNAME !:= $(ARCHNAME)-64int ARCHNAME !:= $(ARCHNAME)-ld .ENDIF +.IF "$(USE_QUADMATH)" == "define" +ARCHNAME !:= $(ARCHNAME)-quadmath +.ENDIF + # Set the install location of the compiler headers/libraries. # These are saved into $Config{incpath} and $Config{libpth}. .IF "$(GCCCROSS)" == "define" @@ -569,6 +589,10 @@ LIBFILES = $(LIBC) -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool \ -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 \ -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32 +.IF "$(USE_QUADMATH)" == "define" +LIBFILES += -lquadmath +.ENDIF + .IF "$(CFG)" == "Debug" OPTIMIZE = -g -O2 LINK_DBG = -g @@ -1136,6 +1160,7 @@ CFG_VARS = \ d_mymalloc=$(PERL_MALLOC) ~ \ libs=$(LIBFILES:f) ~ \ incpath=$(CCINCDIR) ~ \ + iquadmath=$(I_QUADMATH) ~ \ libperl=$(PERLIMPLIB:f) ~ \ libpth=$(CCLIBDIR);$(EXTRALIBDIRS) ~ \ libc=$(LIBC) ~ \ @@ -1150,6 +1175,7 @@ CFG_VARS = \ usemultiplicity=$(USE_MULTI) ~ \ use64bitint=$(USE_64_BIT_INT) ~ \ uselongdouble=$(USE_LONG_DOUBLE) ~ \ + usequadmath=$(USE_QUADMATH) ~ \ usesitecustomize=$(USE_SITECUST) ~ \ default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT) ~ \ LINK_FLAGS=$(LINK_FLAGS) ~ \ @@ -1297,6 +1323,7 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #undef HAS_MODFL_PROTO&& \ echo #undef HAS_SQRTL&& \ echo #undef HAS_STRTOLD&& \ + echo #undef I_QUADMATH&& \ echo #undef PERL_PRIfldbl&& \ echo #undef PERL_PRIgldbl&& \ echo #undef PERL_PRIeldbl&& \ @@ -1309,6 +1336,7 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #undef NVff&& \ echo #undef NVgf&& \ echo #undef USE_LONG_DOUBLE&& \ + echo #undef USE_QUADMATH&& \ echo #undef USE_CPLUSPLUS)>> config.h .IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" @(echo #undef FILE_ptr&& \ @@ -1354,9 +1382,14 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) .IF "$(USE_LONG_DOUBLE)"=="define" @(echo #define NV_PRESERVES_UV&& \ echo #define NV_PRESERVES_UV_BITS 64)>> config.h +.ELSE +.IF "$(USE_QUADMATH)"=="define" + @(echo #define NV_PRESERVES_UV&& \ + echo #define NV_PRESERVES_UV_BITS 64)>> config.h .ELSE @(echo #undef NV_PRESERVES_UV&& \ echo #define NV_PRESERVES_UV_BITS 53)>> config.h +.ENDIF .ENDIF @(echo #define IVdf "I64d"&& \ echo #define UVuf "I64u"&& \ @@ -1396,7 +1429,31 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #define NVef "Le"&& \ echo #define NVff "Lf"&& \ echo #define NVgf "Lg"&& \ + echo #undef I_QUADMATH&& \ + echo #undef USE_QUADMATH&& \ echo #define USE_LONG_DOUBLE)>> config.h +.ELSE +.IF "$(USE_QUADMATH)"=="define" + @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%%.*""Lg",^(n^),^(x^)^)&& \ + echo #define HAS_FREXPL&& \ + echo #define HAS_ISNANL&& \ + echo #define HAS_MODFL&& \ + echo #define HAS_MODFL_PROTO&& \ + echo #define HAS_SQRTL&& \ + echo #define HAS_STRTOLD&& \ + echo #define PERL_PRIfldbl "Lf"&& \ + echo #define PERL_PRIgldbl "Lg"&& \ + echo #define PERL_PRIeldbl "Le"&& \ + echo #define PERL_SCNfldbl "Lf"&& \ + echo #define NVTYPE __float128&& \ + echo #define NVSIZE 16&& \ + echo #define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*2.0&& \ + echo #define NVef "Qe"&& \ + echo #define NVff "Qf"&& \ + echo #define NVgf "Qg"&& \ + echo #undef USE_LONG_DOUBLE&& \ + echo #define I_QUADMATH&& \ + echo #define USE_QUADMATH)>> config.h .ELSE @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%.*g",^(n^),^(x^)^)&& \ echo #undef HAS_FREXPL&& \ @@ -1415,8 +1472,11 @@ $(MINIDIR)\.exists : $(CFGH_TMPL) echo #define NVef "e"&& \ echo #define NVff "f"&& \ echo #define NVgf "g"&& \ + echo #undef I_QUADMATH&& \ + echo #undef USE_QUADMATH&& \ echo #undef USE_LONG_DOUBLE)>> config.h .ENDIF +.ENDIF .IF "$(USE_CPLUSPLUS)"=="define" @(echo #define USE_CPLUSPLUS&& \ echo #endif)>> config.h @@ -1817,6 +1877,7 @@ test-prep-gcc : if exist $(CCDLLDIR)\libgcc_s_dw2-1.dll $(XCOPY) $(CCDLLDIR)\libgcc_s_dw2-1.dll ..\t\$(NULL) if exist $(CCDLLDIR)\libstdc++-6.dll $(XCOPY) $(CCDLLDIR)\libstdc++-6.dll ..\t\$(NULL) if exist $(CCDLLDIR)\libwinpthread-1.dll $(XCOPY) $(CCDLLDIR)\libwinpthread-1.dll ..\t\$(NULL) + if exist $(CCDLLDIR)\libquadmath-0.dll $(XCOPY) $(CCDLLDIR)\libquadmath-0.dll ..\t\$(NULL) .ENDIF From a55134cc382529aee24f81156d7540b61a753544 Mon Sep 17 00:00:00 2001 From: Tom Hukins Date: Mon, 4 Jan 2021 10:28:54 +0000 Subject: [PATCH 423/503] rt.perl.org no longer stores Perl 5 bugs --- Porting/how_to_write_a_perldelta.pod | 5 ----- 1 file changed, 5 deletions(-) diff --git a/Porting/how_to_write_a_perldelta.pod b/Porting/how_to_write_a_perldelta.pod index 1934b7484f34..ec0385caabd1 100644 --- a/Porting/how_to_write_a_perldelta.pod +++ b/Porting/how_to_write_a_perldelta.pod @@ -39,11 +39,6 @@ Be consistent in how bugs are referenced. One style is =over 4 -=item rt.perl.org - -C inline, but enclose in square brackets after a sentence. -C<[perl #43010]>. This mirrors how rt.perl.org subject lines appear. - =item rt.cpan.org C inline, but enclose in square brackets after a sentence. From b1b78d72d0a45b8c802c562d35c93eaac2fec117 Mon Sep 17 00:00:00 2001 From: Felipe Gasper Date: Wed, 13 Jan 2021 13:52:33 -0500 Subject: [PATCH 424/503] Fix trivial typos in perlguts.pod. --- pod/perlguts.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 0d3e1b870934..8d0b7894f07a 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -3570,7 +3570,7 @@ the API function C is used to mortalize an xV, adding its address to the temporaries stack. Likewise, there is no public API to read values from the temporaries stack. -Instead. the macros C and C are used. The C +Instead, the macros C and C are used. The C macro establishes the base levels of the temporaries stack, by capturing the current value of C into C and saving the previous value to the save stack. Thereafter, whenever C is invoked all of From 68ad61f5afbf1b95e3717e314a9204b5689471c7 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Thu, 14 Jan 2021 23:12:26 +0900 Subject: [PATCH 425/503] perl.h: Fix typos in conditional macro names --- perl.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/perl.h b/perl.h index 0ca6f89e9f0c..93cc6b91cb39 100644 --- a/perl.h +++ b/perl.h @@ -2483,7 +2483,7 @@ extern long double Perl_my_frexpl(long double x, int *e); # define FP_QNAN FP_QNAN # endif # include -# ifdef I_IEEFP +# ifdef I_IEEEFP # include # endif # ifdef I_FP @@ -2692,7 +2692,7 @@ extern long double Perl_my_frexpl(long double x, int *e); # define Perl_isfinitel(x) isfinitel(x) # elif defined(HAS_FINITEL) # define Perl_isfinitel(x) finitel(x) -# elif defined(HAS_INFL) && defined(HAS_NANL) +# elif defined(HAS_ISINFL) && defined(HAS_ISNANL) # define Perl_isfinitel(x) !(isinfl(x)||isnanl(x)) # else # define Perl_isfinitel(x) ((x) * 0 == 0) /* See Perl_isfinite. */ From 3cf084545922950b28fae154dc96f9d4e3e5fc60 Mon Sep 17 00:00:00 2001 From: Kang-min Liu Date: Fri, 15 Jan 2021 17:24:31 +0900 Subject: [PATCH 426/503] update the links to freenode According to its documentation[1], the hostname for connecting to freenode should be chat.freenode.net now. [1]: https://freenode.net/kb/answer/chat --- README.tw | 2 +- pod/perlcommunity.pod | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/README.tw b/README.tw index 05220aa61525..9ec8af2ddd83 100644 --- a/README.tw +++ b/README.tw @@ -115,7 +115,7 @@ Perl 郵遞論壇一覽 臺灣 Perl 推廣組一覽 -=item L +=item L Perl.tw 線上聊天室 diff --git a/pod/perlcommunity.pod b/pod/perlcommunity.pod index 9084047270a9..7f1cc0c1b150 100644 --- a/pod/perlcommunity.pod +++ b/pod/perlcommunity.pod @@ -44,7 +44,7 @@ own IRC network, L. General (not help-oriented) chat can be found at L. Many other more specific chats are also hosted on the network. Information about irc.perl.org is located on the network's website: L. For a more help-oriented #perl, -check out L. Most Perl-related channels +check out L. Most Perl-related channels will be kind enough to point you in the right direction if you ask nicely. Any large IRC network (Dalnet, EFnet) is also likely to have a #perl channel, From c5f9609a1a8a7a902c023d06c8b2a4c42afce078 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 9 Jan 2021 20:41:12 -0700 Subject: [PATCH 427/503] t/lib/Cname.pm: Comment, white-space only --- t/lib/Cname.pm | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/t/lib/Cname.pm b/t/lib/Cname.pm index dad356ae6664..1c6eca4649f7 100644 --- a/t/lib/Cname.pm +++ b/t/lib/Cname.pm @@ -2,6 +2,9 @@ package Cname; our $Evil='A'; sub translator { + + # Returns the input as a name, except for these special ones + my $str = shift; if ( $str eq 'EVIL' ) { # Returns A first time, AB second, ABC third ... A-ZA the 27th time. @@ -24,6 +27,7 @@ sub translator { if ( $str eq 'TOO-LONG-STR') { return 'A' x 256; } + return $str; } From 557ff1b2a4ecd18fe9229e7e0eb8fa123adc5670 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 06:28:32 -0700 Subject: [PATCH 428/503] perlre: Add another mnemonic for /d This is for people who may not be familiar with the current term. I found this in a thesaurus searching for something else, and our original term 'dodgy' wasn't there. --- pod/perlre.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perlre.pod b/pod/perlre.pod index e44f9431ecc9..308b79253205 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -721,8 +721,8 @@ the pattern uses L|/Script Runs> Another mnemonic for this modifier is "Depends", as the rules actually used depend on various things, and as a result you can get unexpected results. See L. The Unicode Bug has -become rather infamous, leading to yet another (without swearing) name -for this modifier, "Dodgy". +become rather infamous, leading to yet other (without swearing) names +for this modifier, "Dicey" and "Dodgy". Unless the pattern or string are encoded in UTF-8, only ASCII characters can match positively. From 1604cfb0273418ed479719f39def5ee559bffda2 Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Mon, 28 Dec 2020 18:04:52 -0800 Subject: [PATCH 429/503] style: Detabify indentation of the C code maintained by the core. This just detabifies to get rid of the mixed tab/space indentation. Applying consistent indentation and dealing with other tabs are another issue. Done with `expand -i`. * vutil.* left alone, it's part of version. * Left regen managed files alone for now. --- NetWare/CLIBstuf.c | 216 +- NetWare/Main.c | 234 +- NetWare/NWTInfo.c | 936 +++---- NetWare/NWUtil.c | 1168 ++++---- NetWare/Nwmain.c | 2016 +++++++------- NetWare/Nwpipe.c | 1006 +++---- NetWare/deb.h | 28 +- NetWare/intdef.h | 28 +- NetWare/interface.c | 122 +- NetWare/interface.h | 20 +- NetWare/iperlhost.h | 16 +- NetWare/netware.h | 12 +- NetWare/nw5.c | 894 +++--- NetWare/nw5sck.c | 58 +- NetWare/nw5thread.c | 10 +- NetWare/nw5thread.h | 88 +- NetWare/nwhashcls.h | 32 +- NetWare/nwperlhost.h | 262 +- NetWare/nwperlsys.c | 194 +- NetWare/nwperlsys.h | 326 +-- NetWare/nwpipe.h | 28 +- NetWare/nwplglob.c | 60 +- NetWare/nwtinfo.h | 34 +- NetWare/nwutil.h | 50 +- NetWare/nwvmem.h | 292 +- NetWare/win32ish.h | 8 +- Porting/timecheck.c | 104 +- Porting/timecheck2.c | 4 +- amigaos4/amigaio.c | 1862 ++++++------- amigaos4/amigaio.h | 28 +- amigaos4/amigaos.c | 1042 +++---- av.c | 494 ++-- av.h | 2 +- cv.h | 48 +- cygwin/cygwin.c | 400 +-- deb.c | 252 +- dist/IO/poll.c | 84 +- djgpp/djgpp.c | 66 +- doio.c | 2406 ++++++++-------- doop.c | 750 ++--- dosish.h | 6 +- dquote.c | 22 +- dump.c | 1854 ++++++------- ext/DynaLoader/dlutils.c | 30 +- ext/File-Glob/bsd_glob.c | 1250 ++++----- ext/File-Glob/bsd_glob.h | 36 +- ext/SDBM_File/dba.c | 104 +- ext/SDBM_File/dbd.c | 142 +- ext/SDBM_File/dbe.c | 704 ++--- ext/SDBM_File/dbu.c | 318 +-- ext/SDBM_File/sdbm.c | 528 ++-- ext/SDBM_File/sdbm.h | 32 +- ext/SDBM_File/tune.h | 2 +- ext/SDBM_File/util.c | 52 +- ext/Win32CORE/Win32CORE.c | 128 +- generate_uudmap.c | 22 +- gv.c | 2072 +++++++------- gv.h | 86 +- handy.h | 42 +- hints/t001.c | 94 +- hv.c | 2602 +++++++++--------- hv.h | 108 +- inline.h | 136 +- intrpvar.h | 38 +- invlist_inline.h | 10 +- iperlsys.h | 502 ++-- locale.c | 88 +- malloc.c | 1770 ++++++------ mathoms.c | 94 +- mg.c | 2320 ++++++++-------- mg.h | 24 +- mro_core.c | 1188 ++++---- numeric.c | 220 +- op.h | 196 +- os2/dl_os2.c | 198 +- os2/os2.c | 4972 ++++++++++++++++----------------- os2/os2ish.h | 354 +-- os2/perlrexx.c | 108 +- pad.c | 2200 +++++++-------- pad.h | 88 +- parser.h | 10 +- patchlevel.h | 86 +- perl_inc_macro.h | 40 +- perlio.c | 4134 ++++++++++++++-------------- perlio.h | 12 +- perliol.h | 10 +- perlvars.h | 14 +- perly.c | 98 +- plan9/plan9.c | 24 +- plan9/plan9ish.h | 2 +- pp.h | 88 +- pp_ctl.c | 5278 ++++++++++++++++++------------------ pp_hot.c | 2524 ++++++++--------- pp_pack.c | 3820 +++++++++++++------------- pp_sys.c | 3986 +++++++++++++-------------- qnx/qnx.c | 2 +- regcomp.c | 5262 +++++++++++++++++------------------ regcomp.h | 34 +- regen.pl | 2 +- scope.c | 808 +++--- scope.h | 48 +- t/lib/h2ph.h | 6 +- taint.c | 150 +- thread.h | 172 +- universal.c | 612 ++--- unixish.h | 4 +- utf8.c | 510 ++-- utf8.h | 4 +- utfebcdic.h | 122 +- util.c | 2548 ++++++++--------- util.h | 24 +- vms/munchconfig.c | 30 +- vms/vms.c | 5192 +++++++++++++++++------------------ vms/vmsish.h | 4 +- win32/fcrypt.c | 418 +-- win32/include/dirent.h | 20 +- win32/include/sys/socket.h | 2 +- win32/perlglob.c | 22 +- win32/perlhost.h | 544 ++-- win32/perllib.c | 176 +- win32/vdir.h | 720 ++--- win32/vmem.h | 788 +++--- win32/win32.c | 2370 ++++++++-------- win32/win32.h | 10 +- win32/win32io.c | 4 +- win32/win32iop.h | 2 +- win32/win32sck.c | 406 +-- win32/win32thread.h | 98 +- 128 files changed, 40830 insertions(+), 40830 deletions(-) diff --git a/NetWare/CLIBstuf.c b/NetWare/CLIBstuf.c index 26a4a4b50228..f0e58b14b949 100644 --- a/NetWare/CLIBstuf.c +++ b/NetWare/CLIBstuf.c @@ -33,119 +33,119 @@ void ImportFromCLIB (unsigned int nlmHandle, void** psymbol, char* symbolName) { - *psymbol = ImportSymbol(nlmHandle, symbolName); - if (*psymbol == NULL) - { - ConsolePrintf("Symbol %s not found, unable to continue\n", symbolName); - exit(1); - } + *psymbol = ImportSymbol(nlmHandle, symbolName); + if (*psymbol == NULL) + { + ConsolePrintf("Symbol %s not found, unable to continue\n", symbolName); + exit(1); + } } void fnInitGpfGlobals(void) { - unsigned int nlmHandle = GetNLMHandle(); - - ImportFromCLIB(nlmHandle, &gpf___get_stdin, "__get_stdin"); - ImportFromCLIB(nlmHandle, &gpf___get_stdout, "__get_stdout"); - ImportFromCLIB(nlmHandle, &gpf___get_stderr, "__get_stderr"); - ImportFromCLIB(nlmHandle, &gpf_clearerr, "clearerr"); - ImportFromCLIB(nlmHandle, &gpf_fclose, "fclose"); - ImportFromCLIB(nlmHandle, &gpf_feof, "feof"); - ImportFromCLIB(nlmHandle, &gpf_ferror, "ferror"); - ImportFromCLIB(nlmHandle, &gpf_fflush, "fflush"); - ImportFromCLIB(nlmHandle, &gpf_fgetc, "fgetc"); - ImportFromCLIB(nlmHandle, &gpf_fgetpos, "fgetpos"); - ImportFromCLIB(nlmHandle, &gpf_fgets, "fgets"); - ImportFromCLIB(nlmHandle, &gpf_fopen, "fopen"); - ImportFromCLIB(nlmHandle, &gpf_fputc, "fputc"); - ImportFromCLIB(nlmHandle, &gpf_fputs, "fputs"); - ImportFromCLIB(nlmHandle, &gpf_fread, "fread"); - ImportFromCLIB(nlmHandle, &gpf_freopen, "freopen"); - ImportFromCLIB(nlmHandle, &gpf_fscanf, "fscanf"); - ImportFromCLIB(nlmHandle, &gpf_fseek, "fseek"); - ImportFromCLIB(nlmHandle, &gpf_fsetpos, "fsetpos"); - ImportFromCLIB(nlmHandle, &gpf_ftell, "ftell"); - ImportFromCLIB(nlmHandle, &gpf_fwrite, "fwrite"); - ImportFromCLIB(nlmHandle, &gpf_getc, "getc"); - ImportFromCLIB(nlmHandle, &gpf_getchar, "getchar"); - ImportFromCLIB(nlmHandle, &gpf_gets, "gets"); - ImportFromCLIB(nlmHandle, &gpf_perror, "perror"); - ImportFromCLIB(nlmHandle, &gpf_putc, "putc"); - ImportFromCLIB(nlmHandle, &gpf_putchar, "putchar"); - ImportFromCLIB(nlmHandle, &gpf_puts, "puts"); - ImportFromCLIB(nlmHandle, &gpf_rename, "rename"); - ImportFromCLIB(nlmHandle, &gpf_rewind, "rewind"); - ImportFromCLIB(nlmHandle, &gpf_scanf, "scanf"); - ImportFromCLIB(nlmHandle, &gpf_setbuf, "setbuf"); - ImportFromCLIB(nlmHandle, &gpf_setvbuf, "setvbuf"); - ImportFromCLIB(nlmHandle, &gpf_sscanf, "sscanf"); - ImportFromCLIB(nlmHandle, &gpf_tmpfile, "tmpfile"); - ImportFromCLIB(nlmHandle, &gpf_tmpnam, "tmpnam"); - ImportFromCLIB(nlmHandle, &gpf_ungetc, "ungetc"); - ImportFromCLIB(nlmHandle, &gpf_vfscanf, "vfscanf"); - ImportFromCLIB(nlmHandle, &gpf_vscanf, "vscanf"); - ImportFromCLIB(nlmHandle, &gpf_vsscanf, "vsscanf"); - ImportFromCLIB(nlmHandle, &gpf_fdopen, "fdopen"); - ImportFromCLIB(nlmHandle, &gpf_fileno, "fileno"); - ImportFromCLIB(nlmHandle, &gpf_cgets, "cgets"); - ImportFromCLIB(nlmHandle, &gpf_cprintf, "cprintf"); - ImportFromCLIB(nlmHandle, &gpf_cputs, "cputs"); - ImportFromCLIB(nlmHandle, &gpf_cscanf, "cscanf"); - ImportFromCLIB(nlmHandle, &gpf_fcloseall, "fcloseall"); - ImportFromCLIB(nlmHandle, &gpf_fgetchar, "fgetchar"); - ImportFromCLIB(nlmHandle, &gpf_flushall, "flushall"); - ImportFromCLIB(nlmHandle, &gpf_fputchar, "fputchar"); - ImportFromCLIB(nlmHandle, &gpf_getch, "getch"); - ImportFromCLIB(nlmHandle, &gpf_getche, "getche"); - ImportFromCLIB(nlmHandle, &gpf_putch, "putch"); - ImportFromCLIB(nlmHandle, &gpf_ungetch, "ungetch"); - ImportFromCLIB(nlmHandle, &gpf_vcprintf, "vcprintf"); - ImportFromCLIB(nlmHandle, &gpf_vcscanf, "vcscanf"); - - ImportFromCLIB(nlmHandle, &gpf_memchr, "memchr"); - ImportFromCLIB(nlmHandle, &gpf_memcmp, "memcmp"); - ImportFromCLIB(nlmHandle, &gpf_memcpy, "memcpy"); - ImportFromCLIB(nlmHandle, &gpf_memmove, "memmove"); - ImportFromCLIB(nlmHandle, &gpf_memset, "memset"); - ImportFromCLIB(nlmHandle, &gpf_memicmp, "memicmp"); - - ImportFromCLIB(nlmHandle, &gpf_strerror, "strerror"); - ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); - - ImportFromCLIB(nlmHandle, &gpf_strcpy, "strcpy"); - ImportFromCLIB(nlmHandle, &gpf_strcat, "strcat"); - ImportFromCLIB(nlmHandle, &gpf_strchr, "strchr"); - ImportFromCLIB(nlmHandle, &gpf_strstr, "strstr"); - ImportFromCLIB(nlmHandle, &gpf_strcoll, "strcoll"); - ImportFromCLIB(nlmHandle, &gpf_strcspn, "strcspn"); - ImportFromCLIB(nlmHandle, &gpf_strpbrk, "strpbrk"); - ImportFromCLIB(nlmHandle, &gpf_strrchr, "strrchr"); - ImportFromCLIB(nlmHandle, &gpf_strrev, "strrev"); - ImportFromCLIB(nlmHandle, &gpf_strspn, "strspn"); - ImportFromCLIB(nlmHandle, &gpf_strupr, "strupr"); - ImportFromCLIB(nlmHandle, &gpf_strxfrm, "strxfrm"); - ImportFromCLIB(nlmHandle, &gpf_strcmp, "strcmp"); - ImportFromCLIB(nlmHandle, &gpf_stricmp, "stricmp"); - ImportFromCLIB(nlmHandle, &gpf_strtok, "strtok"); - ImportFromCLIB(nlmHandle, &gpf_strlen, "strlen"); - ImportFromCLIB(nlmHandle, &gpf_strncpy, "strncpy"); - ImportFromCLIB(nlmHandle, &gpf_strncat, "strncat"); - ImportFromCLIB(nlmHandle, &gpf_strncmp, "strncmp"); - ImportFromCLIB(nlmHandle, &gpf_strcmpi, "strcmpi"); - ImportFromCLIB(nlmHandle, &gpf_strnicmp, "strnicmp"); - ImportFromCLIB(nlmHandle, &gpf_strdup, "strdup"); - ImportFromCLIB(nlmHandle, &gpf_strlist, "strlist"); - ImportFromCLIB(nlmHandle, &gpf_strlwr, "strlwr"); - ImportFromCLIB(nlmHandle, &gpf_strnset, "strnset"); - ImportFromCLIB(nlmHandle, &gpf_strset, "strset"); - ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); - ImportFromCLIB(nlmHandle, &gpf_printf, "printf"); - ImportFromCLIB(nlmHandle, &gpf_fprintf, "fprintf"); - ImportFromCLIB(nlmHandle, &gpf_sprintf, "sprintf"); - ImportFromCLIB(nlmHandle, &gpf_vprintf, "vprintf"); - ImportFromCLIB(nlmHandle, &gpf_vfprintf, "vfprintf"); - ImportFromCLIB(nlmHandle, &gpf_vsprintf, "vsprintf"); + unsigned int nlmHandle = GetNLMHandle(); + + ImportFromCLIB(nlmHandle, &gpf___get_stdin, "__get_stdin"); + ImportFromCLIB(nlmHandle, &gpf___get_stdout, "__get_stdout"); + ImportFromCLIB(nlmHandle, &gpf___get_stderr, "__get_stderr"); + ImportFromCLIB(nlmHandle, &gpf_clearerr, "clearerr"); + ImportFromCLIB(nlmHandle, &gpf_fclose, "fclose"); + ImportFromCLIB(nlmHandle, &gpf_feof, "feof"); + ImportFromCLIB(nlmHandle, &gpf_ferror, "ferror"); + ImportFromCLIB(nlmHandle, &gpf_fflush, "fflush"); + ImportFromCLIB(nlmHandle, &gpf_fgetc, "fgetc"); + ImportFromCLIB(nlmHandle, &gpf_fgetpos, "fgetpos"); + ImportFromCLIB(nlmHandle, &gpf_fgets, "fgets"); + ImportFromCLIB(nlmHandle, &gpf_fopen, "fopen"); + ImportFromCLIB(nlmHandle, &gpf_fputc, "fputc"); + ImportFromCLIB(nlmHandle, &gpf_fputs, "fputs"); + ImportFromCLIB(nlmHandle, &gpf_fread, "fread"); + ImportFromCLIB(nlmHandle, &gpf_freopen, "freopen"); + ImportFromCLIB(nlmHandle, &gpf_fscanf, "fscanf"); + ImportFromCLIB(nlmHandle, &gpf_fseek, "fseek"); + ImportFromCLIB(nlmHandle, &gpf_fsetpos, "fsetpos"); + ImportFromCLIB(nlmHandle, &gpf_ftell, "ftell"); + ImportFromCLIB(nlmHandle, &gpf_fwrite, "fwrite"); + ImportFromCLIB(nlmHandle, &gpf_getc, "getc"); + ImportFromCLIB(nlmHandle, &gpf_getchar, "getchar"); + ImportFromCLIB(nlmHandle, &gpf_gets, "gets"); + ImportFromCLIB(nlmHandle, &gpf_perror, "perror"); + ImportFromCLIB(nlmHandle, &gpf_putc, "putc"); + ImportFromCLIB(nlmHandle, &gpf_putchar, "putchar"); + ImportFromCLIB(nlmHandle, &gpf_puts, "puts"); + ImportFromCLIB(nlmHandle, &gpf_rename, "rename"); + ImportFromCLIB(nlmHandle, &gpf_rewind, "rewind"); + ImportFromCLIB(nlmHandle, &gpf_scanf, "scanf"); + ImportFromCLIB(nlmHandle, &gpf_setbuf, "setbuf"); + ImportFromCLIB(nlmHandle, &gpf_setvbuf, "setvbuf"); + ImportFromCLIB(nlmHandle, &gpf_sscanf, "sscanf"); + ImportFromCLIB(nlmHandle, &gpf_tmpfile, "tmpfile"); + ImportFromCLIB(nlmHandle, &gpf_tmpnam, "tmpnam"); + ImportFromCLIB(nlmHandle, &gpf_ungetc, "ungetc"); + ImportFromCLIB(nlmHandle, &gpf_vfscanf, "vfscanf"); + ImportFromCLIB(nlmHandle, &gpf_vscanf, "vscanf"); + ImportFromCLIB(nlmHandle, &gpf_vsscanf, "vsscanf"); + ImportFromCLIB(nlmHandle, &gpf_fdopen, "fdopen"); + ImportFromCLIB(nlmHandle, &gpf_fileno, "fileno"); + ImportFromCLIB(nlmHandle, &gpf_cgets, "cgets"); + ImportFromCLIB(nlmHandle, &gpf_cprintf, "cprintf"); + ImportFromCLIB(nlmHandle, &gpf_cputs, "cputs"); + ImportFromCLIB(nlmHandle, &gpf_cscanf, "cscanf"); + ImportFromCLIB(nlmHandle, &gpf_fcloseall, "fcloseall"); + ImportFromCLIB(nlmHandle, &gpf_fgetchar, "fgetchar"); + ImportFromCLIB(nlmHandle, &gpf_flushall, "flushall"); + ImportFromCLIB(nlmHandle, &gpf_fputchar, "fputchar"); + ImportFromCLIB(nlmHandle, &gpf_getch, "getch"); + ImportFromCLIB(nlmHandle, &gpf_getche, "getche"); + ImportFromCLIB(nlmHandle, &gpf_putch, "putch"); + ImportFromCLIB(nlmHandle, &gpf_ungetch, "ungetch"); + ImportFromCLIB(nlmHandle, &gpf_vcprintf, "vcprintf"); + ImportFromCLIB(nlmHandle, &gpf_vcscanf, "vcscanf"); + + ImportFromCLIB(nlmHandle, &gpf_memchr, "memchr"); + ImportFromCLIB(nlmHandle, &gpf_memcmp, "memcmp"); + ImportFromCLIB(nlmHandle, &gpf_memcpy, "memcpy"); + ImportFromCLIB(nlmHandle, &gpf_memmove, "memmove"); + ImportFromCLIB(nlmHandle, &gpf_memset, "memset"); + ImportFromCLIB(nlmHandle, &gpf_memicmp, "memicmp"); + + ImportFromCLIB(nlmHandle, &gpf_strerror, "strerror"); + ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); + + ImportFromCLIB(nlmHandle, &gpf_strcpy, "strcpy"); + ImportFromCLIB(nlmHandle, &gpf_strcat, "strcat"); + ImportFromCLIB(nlmHandle, &gpf_strchr, "strchr"); + ImportFromCLIB(nlmHandle, &gpf_strstr, "strstr"); + ImportFromCLIB(nlmHandle, &gpf_strcoll, "strcoll"); + ImportFromCLIB(nlmHandle, &gpf_strcspn, "strcspn"); + ImportFromCLIB(nlmHandle, &gpf_strpbrk, "strpbrk"); + ImportFromCLIB(nlmHandle, &gpf_strrchr, "strrchr"); + ImportFromCLIB(nlmHandle, &gpf_strrev, "strrev"); + ImportFromCLIB(nlmHandle, &gpf_strspn, "strspn"); + ImportFromCLIB(nlmHandle, &gpf_strupr, "strupr"); + ImportFromCLIB(nlmHandle, &gpf_strxfrm, "strxfrm"); + ImportFromCLIB(nlmHandle, &gpf_strcmp, "strcmp"); + ImportFromCLIB(nlmHandle, &gpf_stricmp, "stricmp"); + ImportFromCLIB(nlmHandle, &gpf_strtok, "strtok"); + ImportFromCLIB(nlmHandle, &gpf_strlen, "strlen"); + ImportFromCLIB(nlmHandle, &gpf_strncpy, "strncpy"); + ImportFromCLIB(nlmHandle, &gpf_strncat, "strncat"); + ImportFromCLIB(nlmHandle, &gpf_strncmp, "strncmp"); + ImportFromCLIB(nlmHandle, &gpf_strcmpi, "strcmpi"); + ImportFromCLIB(nlmHandle, &gpf_strnicmp, "strnicmp"); + ImportFromCLIB(nlmHandle, &gpf_strdup, "strdup"); + ImportFromCLIB(nlmHandle, &gpf_strlist, "strlist"); + ImportFromCLIB(nlmHandle, &gpf_strlwr, "strlwr"); + ImportFromCLIB(nlmHandle, &gpf_strnset, "strnset"); + ImportFromCLIB(nlmHandle, &gpf_strset, "strset"); + ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); + ImportFromCLIB(nlmHandle, &gpf_printf, "printf"); + ImportFromCLIB(nlmHandle, &gpf_fprintf, "fprintf"); + ImportFromCLIB(nlmHandle, &gpf_sprintf, "sprintf"); + ImportFromCLIB(nlmHandle, &gpf_vprintf, "vprintf"); + ImportFromCLIB(nlmHandle, &gpf_vfprintf, "vfprintf"); + ImportFromCLIB(nlmHandle, &gpf_vsprintf, "vsprintf"); } diff --git a/NetWare/Main.c b/NetWare/Main.c index 5116cbcfe1b9..4dea1dd2beb2 100644 --- a/NetWare/Main.c +++ b/NetWare/Main.c @@ -32,8 +32,8 @@ #include "clibstuf.h" #ifdef MPK_ON - #include - #include + #include + #include #endif //MPK_ON @@ -52,131 +52,131 @@ void main(void) { - fnInitGpfGlobals(); // For importing the CLIB calls in place of the Watcom calls - SynchronizeStart(); // Don't allow anything else to happen until all the symbols are imported - #ifdef MPK_ON - ExitThread(TSR_THREAD, 0); - #else - ExitThread(TSR_THREAD, 0); - #endif + fnInitGpfGlobals(); // For importing the CLIB calls in place of the Watcom calls + SynchronizeStart(); // Don't allow anything else to happen until all the symbols are imported + #ifdef MPK_ON + ExitThread(TSR_THREAD, 0); + #else + ExitThread(TSR_THREAD, 0); + #endif } void ImportFromCLIB (unsigned int nlmHandle, void** psymbol, char* symbolName) { - *psymbol = ImportSymbol(nlmHandle, symbolName); - if (*psymbol == NULL) - { - ConsolePrintf("Symbol %s not found, unable to continue\n", symbolName); - exit(1); - } + *psymbol = ImportSymbol(nlmHandle, symbolName); + if (*psymbol == NULL) + { + ConsolePrintf("Symbol %s not found, unable to continue\n", symbolName); + exit(1); + } } void fnInitGpfGlobals(void) { - unsigned int nlmHandle = GetNLMHandle(); - - ImportFromCLIB(nlmHandle, &gpf___get_stdin, "__get_stdin"); - ImportFromCLIB(nlmHandle, &gpf___get_stdout, "__get_stdout"); - ImportFromCLIB(nlmHandle, &gpf___get_stderr, "__get_stderr"); - ImportFromCLIB(nlmHandle, &gpf_clearerr, "clearerr"); - ImportFromCLIB(nlmHandle, &gpf_fclose, "fclose"); - ImportFromCLIB(nlmHandle, &gpf_feof, "feof"); - ImportFromCLIB(nlmHandle, &gpf_ferror, "ferror"); - ImportFromCLIB(nlmHandle, &gpf_fflush, "fflush"); - ImportFromCLIB(nlmHandle, &gpf_fgetc, "fgetc"); - ImportFromCLIB(nlmHandle, &gpf_fgetpos, "fgetpos"); - ImportFromCLIB(nlmHandle, &gpf_fgets, "fgets"); - ImportFromCLIB(nlmHandle, &gpf_fopen, "fopen"); - ImportFromCLIB(nlmHandle, &gpf_fputc, "fputc"); - ImportFromCLIB(nlmHandle, &gpf_fputs, "fputs"); - ImportFromCLIB(nlmHandle, &gpf_fread, "fread"); - ImportFromCLIB(nlmHandle, &gpf_freopen, "freopen"); - ImportFromCLIB(nlmHandle, &gpf_fscanf, "fscanf"); - ImportFromCLIB(nlmHandle, &gpf_fseek, "fseek"); - ImportFromCLIB(nlmHandle, &gpf_fsetpos, "fsetpos"); - ImportFromCLIB(nlmHandle, &gpf_ftell, "ftell"); - ImportFromCLIB(nlmHandle, &gpf_fwrite, "fwrite"); - ImportFromCLIB(nlmHandle, &gpf_getc, "getc"); - ImportFromCLIB(nlmHandle, &gpf_getchar, "getchar"); - ImportFromCLIB(nlmHandle, &gpf_gets, "gets"); - ImportFromCLIB(nlmHandle, &gpf_perror, "perror"); - ImportFromCLIB(nlmHandle, &gpf_putc, "putc"); - ImportFromCLIB(nlmHandle, &gpf_putchar, "putchar"); - ImportFromCLIB(nlmHandle, &gpf_puts, "puts"); - ImportFromCLIB(nlmHandle, &gpf_rename, "rename"); - ImportFromCLIB(nlmHandle, &gpf_rewind, "rewind"); - ImportFromCLIB(nlmHandle, &gpf_scanf, "scanf"); - ImportFromCLIB(nlmHandle, &gpf_setbuf, "setbuf"); - ImportFromCLIB(nlmHandle, &gpf_setvbuf, "setvbuf"); - ImportFromCLIB(nlmHandle, &gpf_sscanf, "sscanf"); - ImportFromCLIB(nlmHandle, &gpf_tmpfile, "tmpfile"); - ImportFromCLIB(nlmHandle, &gpf_tmpnam, "tmpnam"); - ImportFromCLIB(nlmHandle, &gpf_ungetc, "ungetc"); - ImportFromCLIB(nlmHandle, &gpf_vfscanf, "vfscanf"); - ImportFromCLIB(nlmHandle, &gpf_vscanf, "vscanf"); - ImportFromCLIB(nlmHandle, &gpf_vsscanf, "vsscanf"); - ImportFromCLIB(nlmHandle, &gpf_fdopen, "fdopen"); - ImportFromCLIB(nlmHandle, &gpf_fileno, "fileno"); - ImportFromCLIB(nlmHandle, &gpf_cgets, "cgets"); - ImportFromCLIB(nlmHandle, &gpf_cprintf, "cprintf"); - ImportFromCLIB(nlmHandle, &gpf_cputs, "cputs"); - ImportFromCLIB(nlmHandle, &gpf_cscanf, "cscanf"); - ImportFromCLIB(nlmHandle, &gpf_fcloseall, "fcloseall"); - ImportFromCLIB(nlmHandle, &gpf_fgetchar, "fgetchar"); - ImportFromCLIB(nlmHandle, &gpf_flushall, "flushall"); - ImportFromCLIB(nlmHandle, &gpf_fputchar, "fputchar"); - ImportFromCLIB(nlmHandle, &gpf_getch, "getch"); - ImportFromCLIB(nlmHandle, &gpf_getche, "getche"); - ImportFromCLIB(nlmHandle, &gpf_putch, "putch"); - ImportFromCLIB(nlmHandle, &gpf_ungetch, "ungetch"); - ImportFromCLIB(nlmHandle, &gpf_vcprintf, "vcprintf"); - ImportFromCLIB(nlmHandle, &gpf_vcscanf, "vcscanf"); - - ImportFromCLIB(nlmHandle, &gpf_memchr, "memchr"); - ImportFromCLIB(nlmHandle, &gpf_memcmp, "memcmp"); - ImportFromCLIB(nlmHandle, &gpf_memcpy, "memcpy"); - ImportFromCLIB(nlmHandle, &gpf_memmove, "memmove"); - ImportFromCLIB(nlmHandle, &gpf_memset, "memset"); - ImportFromCLIB(nlmHandle, &gpf_memicmp, "memicmp"); - - ImportFromCLIB(nlmHandle, &gpf_strerror, "strerror"); - ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); - - ImportFromCLIB(nlmHandle, &gpf_strcpy, "strcpy"); - ImportFromCLIB(nlmHandle, &gpf_strcat, "strcat"); - ImportFromCLIB(nlmHandle, &gpf_strchr, "strchr"); - ImportFromCLIB(nlmHandle, &gpf_strstr, "strstr"); - ImportFromCLIB(nlmHandle, &gpf_strcoll, "strcoll"); - ImportFromCLIB(nlmHandle, &gpf_strcspn, "strcspn"); - ImportFromCLIB(nlmHandle, &gpf_strpbrk, "strpbrk"); - ImportFromCLIB(nlmHandle, &gpf_strrchr, "strrchr"); - ImportFromCLIB(nlmHandle, &gpf_strrev, "strrev"); - ImportFromCLIB(nlmHandle, &gpf_strspn, "strspn"); - ImportFromCLIB(nlmHandle, &gpf_strupr, "strupr"); - ImportFromCLIB(nlmHandle, &gpf_strxfrm, "strxfrm"); - ImportFromCLIB(nlmHandle, &gpf_strcmp, "strcmp"); - ImportFromCLIB(nlmHandle, &gpf_stricmp, "stricmp"); - ImportFromCLIB(nlmHandle, &gpf_strtok, "strtok"); - ImportFromCLIB(nlmHandle, &gpf_strlen, "strlen"); - ImportFromCLIB(nlmHandle, &gpf_strncpy, "strncpy"); - ImportFromCLIB(nlmHandle, &gpf_strncat, "strncat"); - ImportFromCLIB(nlmHandle, &gpf_strncmp, "strncmp"); - ImportFromCLIB(nlmHandle, &gpf_strcmpi, "strcmpi"); - ImportFromCLIB(nlmHandle, &gpf_strnicmp, "strnicmp"); - ImportFromCLIB(nlmHandle, &gpf_strdup, "strdup"); - ImportFromCLIB(nlmHandle, &gpf_strlist, "strlist"); - ImportFromCLIB(nlmHandle, &gpf_strlwr, "strlwr"); - ImportFromCLIB(nlmHandle, &gpf_strnset, "strnset"); - ImportFromCLIB(nlmHandle, &gpf_strset, "strset"); - ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); - ImportFromCLIB(nlmHandle, &gpf_printf, "printf"); - ImportFromCLIB(nlmHandle, &gpf_fprintf, "fprintf"); - ImportFromCLIB(nlmHandle, &gpf_sprintf, "sprintf"); - ImportFromCLIB(nlmHandle, &gpf_vprintf, "vprintf"); - ImportFromCLIB(nlmHandle, &gpf_vfprintf, "vfprintf"); - ImportFromCLIB(nlmHandle, &gpf_vsprintf, "vsprintf"); + unsigned int nlmHandle = GetNLMHandle(); + + ImportFromCLIB(nlmHandle, &gpf___get_stdin, "__get_stdin"); + ImportFromCLIB(nlmHandle, &gpf___get_stdout, "__get_stdout"); + ImportFromCLIB(nlmHandle, &gpf___get_stderr, "__get_stderr"); + ImportFromCLIB(nlmHandle, &gpf_clearerr, "clearerr"); + ImportFromCLIB(nlmHandle, &gpf_fclose, "fclose"); + ImportFromCLIB(nlmHandle, &gpf_feof, "feof"); + ImportFromCLIB(nlmHandle, &gpf_ferror, "ferror"); + ImportFromCLIB(nlmHandle, &gpf_fflush, "fflush"); + ImportFromCLIB(nlmHandle, &gpf_fgetc, "fgetc"); + ImportFromCLIB(nlmHandle, &gpf_fgetpos, "fgetpos"); + ImportFromCLIB(nlmHandle, &gpf_fgets, "fgets"); + ImportFromCLIB(nlmHandle, &gpf_fopen, "fopen"); + ImportFromCLIB(nlmHandle, &gpf_fputc, "fputc"); + ImportFromCLIB(nlmHandle, &gpf_fputs, "fputs"); + ImportFromCLIB(nlmHandle, &gpf_fread, "fread"); + ImportFromCLIB(nlmHandle, &gpf_freopen, "freopen"); + ImportFromCLIB(nlmHandle, &gpf_fscanf, "fscanf"); + ImportFromCLIB(nlmHandle, &gpf_fseek, "fseek"); + ImportFromCLIB(nlmHandle, &gpf_fsetpos, "fsetpos"); + ImportFromCLIB(nlmHandle, &gpf_ftell, "ftell"); + ImportFromCLIB(nlmHandle, &gpf_fwrite, "fwrite"); + ImportFromCLIB(nlmHandle, &gpf_getc, "getc"); + ImportFromCLIB(nlmHandle, &gpf_getchar, "getchar"); + ImportFromCLIB(nlmHandle, &gpf_gets, "gets"); + ImportFromCLIB(nlmHandle, &gpf_perror, "perror"); + ImportFromCLIB(nlmHandle, &gpf_putc, "putc"); + ImportFromCLIB(nlmHandle, &gpf_putchar, "putchar"); + ImportFromCLIB(nlmHandle, &gpf_puts, "puts"); + ImportFromCLIB(nlmHandle, &gpf_rename, "rename"); + ImportFromCLIB(nlmHandle, &gpf_rewind, "rewind"); + ImportFromCLIB(nlmHandle, &gpf_scanf, "scanf"); + ImportFromCLIB(nlmHandle, &gpf_setbuf, "setbuf"); + ImportFromCLIB(nlmHandle, &gpf_setvbuf, "setvbuf"); + ImportFromCLIB(nlmHandle, &gpf_sscanf, "sscanf"); + ImportFromCLIB(nlmHandle, &gpf_tmpfile, "tmpfile"); + ImportFromCLIB(nlmHandle, &gpf_tmpnam, "tmpnam"); + ImportFromCLIB(nlmHandle, &gpf_ungetc, "ungetc"); + ImportFromCLIB(nlmHandle, &gpf_vfscanf, "vfscanf"); + ImportFromCLIB(nlmHandle, &gpf_vscanf, "vscanf"); + ImportFromCLIB(nlmHandle, &gpf_vsscanf, "vsscanf"); + ImportFromCLIB(nlmHandle, &gpf_fdopen, "fdopen"); + ImportFromCLIB(nlmHandle, &gpf_fileno, "fileno"); + ImportFromCLIB(nlmHandle, &gpf_cgets, "cgets"); + ImportFromCLIB(nlmHandle, &gpf_cprintf, "cprintf"); + ImportFromCLIB(nlmHandle, &gpf_cputs, "cputs"); + ImportFromCLIB(nlmHandle, &gpf_cscanf, "cscanf"); + ImportFromCLIB(nlmHandle, &gpf_fcloseall, "fcloseall"); + ImportFromCLIB(nlmHandle, &gpf_fgetchar, "fgetchar"); + ImportFromCLIB(nlmHandle, &gpf_flushall, "flushall"); + ImportFromCLIB(nlmHandle, &gpf_fputchar, "fputchar"); + ImportFromCLIB(nlmHandle, &gpf_getch, "getch"); + ImportFromCLIB(nlmHandle, &gpf_getche, "getche"); + ImportFromCLIB(nlmHandle, &gpf_putch, "putch"); + ImportFromCLIB(nlmHandle, &gpf_ungetch, "ungetch"); + ImportFromCLIB(nlmHandle, &gpf_vcprintf, "vcprintf"); + ImportFromCLIB(nlmHandle, &gpf_vcscanf, "vcscanf"); + + ImportFromCLIB(nlmHandle, &gpf_memchr, "memchr"); + ImportFromCLIB(nlmHandle, &gpf_memcmp, "memcmp"); + ImportFromCLIB(nlmHandle, &gpf_memcpy, "memcpy"); + ImportFromCLIB(nlmHandle, &gpf_memmove, "memmove"); + ImportFromCLIB(nlmHandle, &gpf_memset, "memset"); + ImportFromCLIB(nlmHandle, &gpf_memicmp, "memicmp"); + + ImportFromCLIB(nlmHandle, &gpf_strerror, "strerror"); + ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); + + ImportFromCLIB(nlmHandle, &gpf_strcpy, "strcpy"); + ImportFromCLIB(nlmHandle, &gpf_strcat, "strcat"); + ImportFromCLIB(nlmHandle, &gpf_strchr, "strchr"); + ImportFromCLIB(nlmHandle, &gpf_strstr, "strstr"); + ImportFromCLIB(nlmHandle, &gpf_strcoll, "strcoll"); + ImportFromCLIB(nlmHandle, &gpf_strcspn, "strcspn"); + ImportFromCLIB(nlmHandle, &gpf_strpbrk, "strpbrk"); + ImportFromCLIB(nlmHandle, &gpf_strrchr, "strrchr"); + ImportFromCLIB(nlmHandle, &gpf_strrev, "strrev"); + ImportFromCLIB(nlmHandle, &gpf_strspn, "strspn"); + ImportFromCLIB(nlmHandle, &gpf_strupr, "strupr"); + ImportFromCLIB(nlmHandle, &gpf_strxfrm, "strxfrm"); + ImportFromCLIB(nlmHandle, &gpf_strcmp, "strcmp"); + ImportFromCLIB(nlmHandle, &gpf_stricmp, "stricmp"); + ImportFromCLIB(nlmHandle, &gpf_strtok, "strtok"); + ImportFromCLIB(nlmHandle, &gpf_strlen, "strlen"); + ImportFromCLIB(nlmHandle, &gpf_strncpy, "strncpy"); + ImportFromCLIB(nlmHandle, &gpf_strncat, "strncat"); + ImportFromCLIB(nlmHandle, &gpf_strncmp, "strncmp"); + ImportFromCLIB(nlmHandle, &gpf_strcmpi, "strcmpi"); + ImportFromCLIB(nlmHandle, &gpf_strnicmp, "strnicmp"); + ImportFromCLIB(nlmHandle, &gpf_strdup, "strdup"); + ImportFromCLIB(nlmHandle, &gpf_strlist, "strlist"); + ImportFromCLIB(nlmHandle, &gpf_strlwr, "strlwr"); + ImportFromCLIB(nlmHandle, &gpf_strnset, "strnset"); + ImportFromCLIB(nlmHandle, &gpf_strset, "strset"); + ImportFromCLIB(nlmHandle, &gpf_strtok_r, "strtok_r"); + ImportFromCLIB(nlmHandle, &gpf_printf, "printf"); + ImportFromCLIB(nlmHandle, &gpf_fprintf, "fprintf"); + ImportFromCLIB(nlmHandle, &gpf_sprintf, "sprintf"); + ImportFromCLIB(nlmHandle, &gpf_vprintf, "vprintf"); + ImportFromCLIB(nlmHandle, &gpf_vfprintf, "vfprintf"); + ImportFromCLIB(nlmHandle, &gpf_vsprintf, "vsprintf"); } diff --git a/NetWare/NWTInfo.c b/NetWare/NWTInfo.c index b057d56b2ad8..a1221e703c56 100644 --- a/NetWare/NWTInfo.c +++ b/NetWare/NWTInfo.c @@ -23,10 +23,10 @@ #include "nwtinfo.h" #ifdef MPK_ON - #include - #include + #include + #include #else - #include + #include #endif //MPK_ON // Number of entries in the hashtable @@ -42,11 +42,11 @@ // Semaphore to control access to global linked list // #ifdef MPK_ON - static SEMAPHORE g_tinfoSem = NULL; - static SEMAPHORE g_tCtxSem = NULL; + static SEMAPHORE g_tinfoSem = NULL; + static SEMAPHORE g_tCtxSem = NULL; #else - static LONG g_tinfoSem = 0L; - static LONG g_tCtxSem = 0L; + static LONG g_tinfoSem = 0L; + static LONG g_tCtxSem = 0L; #endif //MPK_ON // Hash table of thread information structures @@ -70,37 +70,37 @@ ThreadContext* g_ThreadCtx; BOOL fnTerminateThreadInfo(void) { - int index = 0; - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - for (index = 0; index < NUM_ENTRIES; index++) - { - if (g_ThreadInfo[index] != NULL) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - return FALSE; - } - } - #ifdef MPK_ON - kSemaphoreFree(g_tinfoSem); - g_tinfoSem = NULL; - #else - CloseLocalSemaphore(g_tinfoSem); - g_tinfoSem = 0; - #endif //MPK_ON - } - - return TRUE; + int index = 0; + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + for (index = 0; index < NUM_ENTRIES; index++) + { + if (g_ThreadInfo[index] != NULL) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + return FALSE; + } + } + #ifdef MPK_ON + kSemaphoreFree(g_tinfoSem); + g_tinfoSem = NULL; + #else + CloseLocalSemaphore(g_tinfoSem); + g_tinfoSem = 0; + #endif //MPK_ON + } + + return TRUE; } @@ -109,7 +109,7 @@ BOOL fnTerminateThreadInfo(void) Function : fnInitializeThreadInfo Description : Initializes the global ThreadInfo hashtable and semaphore. - Call once per NLM instance + Call once per NLM instance Parameters : None. @@ -119,22 +119,22 @@ BOOL fnTerminateThreadInfo(void) void fnInitializeThreadInfo(void) { - int index = 0; + int index = 0; - if (g_tinfoSem) - return; + if (g_tinfoSem) + return; - #ifdef MPK_ON - g_tinfoSem = kSemaphoreAlloc((BYTE *)"threadInfo", 1); - #else - g_tinfoSem = OpenLocalSemaphore(1); - #endif //MPK_ON - + #ifdef MPK_ON + g_tinfoSem = kSemaphoreAlloc((BYTE *)"threadInfo", 1); + #else + g_tinfoSem = OpenLocalSemaphore(1); + #endif //MPK_ON + - for (index = 0; index < NUM_ENTRIES; index++) - g_ThreadInfo[index] = NULL; + for (index = 0; index < NUM_ENTRIES; index++) + g_ThreadInfo[index] = NULL; - return; + return; } @@ -152,18 +152,18 @@ void fnInitializeThreadInfo(void) BOOL fnRegisterWithThreadTable(void) { - ThreadInfo* tinfo = NULL; - - #ifdef MPK_ON - tinfo = fnAddThreadInfo(labs((int)kCurrentThread())); - #else - tinfo = fnAddThreadInfo(GetThreadID()); - #endif //MPK_ON - - if (!tinfo) - return FALSE; - else - return TRUE; + ThreadInfo* tinfo = NULL; + + #ifdef MPK_ON + tinfo = fnAddThreadInfo(labs((int)kCurrentThread())); + #else + tinfo = fnAddThreadInfo(GetThreadID()); + #endif //MPK_ON + + if (!tinfo) + return FALSE; + else + return TRUE; } @@ -181,11 +181,11 @@ BOOL fnRegisterWithThreadTable(void) BOOL fnUnregisterWithThreadTable(void) { - #ifdef MPK_ON - return fnRemoveThreadInfo(labs((int)kCurrentThread())); - #else - return fnRemoveThreadInfo(GetThreadID()); - #endif //MPK_ON + #ifdef MPK_ON + return fnRemoveThreadInfo(labs((int)kCurrentThread())); + #else + return fnRemoveThreadInfo(GetThreadID()); + #endif //MPK_ON } @@ -203,50 +203,50 @@ BOOL fnUnregisterWithThreadTable(void) ThreadInfo* fnAddThreadInfo(int tid) { - ThreadInfo* tip = NULL; - int index = 0; - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - // Add a new one to the beginning of the hash entry - // - tip = (ThreadInfo *) malloc(sizeof(ThreadInfo)); - if (tip == NULL) - { - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - return NULL; - } - index = INDEXOF(tid); // just take the bottom five bits - tip->next = g_ThreadInfo[index]; - tip->tid = tid; - tip->m_dontTouchHashLists = FALSE; - tip->m_allocList = NULL; - - g_ThreadInfo [index] = tip; - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return tip; + ThreadInfo* tip = NULL; + int index = 0; + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + // Add a new one to the beginning of the hash entry + // + tip = (ThreadInfo *) malloc(sizeof(ThreadInfo)); + if (tip == NULL) + { + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + return NULL; + } + index = INDEXOF(tid); // just take the bottom five bits + tip->next = g_ThreadInfo[index]; + tip->tid = tid; + tip->m_dontTouchHashLists = FALSE; + tip->m_allocList = NULL; + + g_ThreadInfo [index] = tip; + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return tip; } @@ -255,7 +255,7 @@ ThreadInfo* fnAddThreadInfo(int tid) Function : fnRemoveThreadInfo Description : Frees the specified thread info structure and removes it from the - global linked list. + global linked list. Parameters : tid (IN) - ID of the thread. @@ -265,54 +265,54 @@ ThreadInfo* fnAddThreadInfo(int tid) BOOL fnRemoveThreadInfo(int tid) { - ThreadInfo* tip = NULL; - ThreadInfo* prevt = NULL; - int index = INDEXOF(tid); // just take the bottom five bits - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) - { - if (tip->tid == tid) - { - if (prevt == NULL) - g_ThreadInfo[index] = tip->next; - else - prevt->next = tip->next; - - free(tip); - tip=NULL; - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return TRUE; - } - prevt = tip; - } - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return FALSE; // entry not found + ThreadInfo* tip = NULL; + ThreadInfo* prevt = NULL; + int index = INDEXOF(tid); // just take the bottom five bits + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) + { + if (tip->tid == tid) + { + if (prevt == NULL) + g_ThreadInfo[index] = tip->next; + else + prevt->next = tip->next; + + free(tip); + tip=NULL; + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return TRUE; + } + prevt = tip; + } + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return FALSE; // entry not found } @@ -330,153 +330,153 @@ BOOL fnRemoveThreadInfo(int tid) ThreadInfo* fnGetThreadInfo(int tid) { - ThreadInfo* tip; - int index = INDEXOF(tid); // just take the bottom five bits - - if (g_tinfoSem) { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - // see if this is already in the table at the index'th offset - // - for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) - { - if (tip->tid == tid) - { - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - return tip; - } - } - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return NULL; + ThreadInfo* tip; + int index = INDEXOF(tid); // just take the bottom five bits + + if (g_tinfoSem) { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + // see if this is already in the table at the index'th offset + // + for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) + { + if (tip->tid == tid) + { + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + return tip; + } + } + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return NULL; } BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList) { - ThreadInfo* tip; - int index,tid; - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - #ifdef MPK_ON - tid=index = abs(kCurrentThread()); - #else - tid=index = GetThreadID(); - #endif //MPK_ON - - index = INDEXOF(index); // just take the bottom five bits - - // see if this is already in the table at the index'th offset - // - for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) - { - if (tip->tid == tid) - { - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - tip->m_allocList = addrs; - tip->m_dontTouchHashLists = dontTouchHashList; - return TRUE; - } - } - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return FALSE; + ThreadInfo* tip; + int index,tid; + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + #ifdef MPK_ON + tid=index = abs(kCurrentThread()); + #else + tid=index = GetThreadID(); + #endif //MPK_ON + + index = INDEXOF(index); // just take the bottom five bits + + // see if this is already in the table at the index'th offset + // + for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) + { + if (tip->tid == tid) + { + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + tip->m_allocList = addrs; + tip->m_dontTouchHashLists = dontTouchHashList; + return TRUE; + } + } + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return FALSE; } BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList) { - ThreadInfo* tip; - int index,tid; - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tinfoSem); - #else - WaitOnLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - #ifdef MPK_ON - tid=index = abs(kCurrentThread()); - #else - tid=index = GetThreadID(); - #endif //MPK_ON - - index = INDEXOF(index); // just take the bottom five bits - - // see if this is already in the table at the index'th offset - // - for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) - { - if (tip->tid == tid) - { - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - *addrs = tip->m_allocList; - *dontTouchHashList = tip->m_dontTouchHashLists; - return TRUE; - } - } - - if (g_tinfoSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tinfoSem); - #else - SignalLocalSemaphore(g_tinfoSem); - #endif //MPK_ON - } - - return FALSE; + ThreadInfo* tip; + int index,tid; + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tinfoSem); + #else + WaitOnLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + #ifdef MPK_ON + tid=index = abs(kCurrentThread()); + #else + tid=index = GetThreadID(); + #endif //MPK_ON + + index = INDEXOF(index); // just take the bottom five bits + + // see if this is already in the table at the index'th offset + // + for (tip = g_ThreadInfo[index]; tip != NULL; tip = tip->next) + { + if (tip->tid == tid) + { + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + *addrs = tip->m_allocList; + *dontTouchHashList = tip->m_dontTouchHashLists; + return TRUE; + } + } + + if (g_tinfoSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tinfoSem); + #else + SignalLocalSemaphore(g_tinfoSem); + #endif //MPK_ON + } + + return FALSE; } @@ -494,20 +494,20 @@ BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList) long fnInitializeThreadCtx(void) { - int index = 0; - //long tid; + int index = 0; + //long tid; - if (!g_tCtxSem) { - #ifdef MPK_ON - g_tCtxSem = kSemaphoreAlloc((BYTE *)"threadCtx", 1); - #else - g_tCtxSem = OpenLocalSemaphore(1); - #endif //MPK_ON + if (!g_tCtxSem) { + #ifdef MPK_ON + g_tCtxSem = kSemaphoreAlloc((BYTE *)"threadCtx", 1); + #else + g_tCtxSem = OpenLocalSemaphore(1); + #endif //MPK_ON - g_ThreadCtx =NULL; - } + g_ThreadCtx =NULL; + } - return 0l; + return 0l; } @@ -518,7 +518,7 @@ long fnInitializeThreadCtx(void) Description : Add a new thread context. Parameters : lTLSIndex (IN) - Index - t (IN) - void pointer. + t (IN) - void pointer. Returns : Pointer to ThreadContext structure. @@ -526,67 +526,67 @@ long fnInitializeThreadCtx(void) ThreadContext* fnAddThreadCtx(long lTLSIndex, void *t) { - ThreadContext* tip = NULL; - ThreadContext* temp = NULL; - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tCtxSem); - #else - WaitOnLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - - // add a new one to the beginning of the list - // - tip = (ThreadContext *) malloc(sizeof(ThreadContext)); - if (tip == NULL) - { - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - return NULL; - } - - #ifdef MPK_ON - lTLSIndex = labs(kCurrentThread()); - #else - lTLSIndex = GetThreadID(); - #endif //MPK_ON - - tip->next = NULL; - tip->tid = lTLSIndex; - tip->tInfo = t; - - if(g_ThreadCtx==NULL) { - g_ThreadCtx = tip; - } else { - int count=0; - //Traverse to the end - temp = g_ThreadCtx; - while(temp->next != NULL) - { - temp = temp->next; - count++; - } - temp->next = tip; - } - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - return tip; + ThreadContext* tip = NULL; + ThreadContext* temp = NULL; + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tCtxSem); + #else + WaitOnLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + + // add a new one to the beginning of the list + // + tip = (ThreadContext *) malloc(sizeof(ThreadContext)); + if (tip == NULL) + { + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + return NULL; + } + + #ifdef MPK_ON + lTLSIndex = labs(kCurrentThread()); + #else + lTLSIndex = GetThreadID(); + #endif //MPK_ON + + tip->next = NULL; + tip->tid = lTLSIndex; + tip->tInfo = t; + + if(g_ThreadCtx==NULL) { + g_ThreadCtx = tip; + } else { + int count=0; + //Traverse to the end + temp = g_ThreadCtx; + while(temp->next != NULL) + { + temp = temp->next; + count++; + } + temp->next = tip; + } + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + return tip; } @@ -604,58 +604,58 @@ ThreadContext* fnAddThreadCtx(long lTLSIndex, void *t) BOOL fnRemoveThreadCtx(long lTLSIndex) { - ThreadContext* tip = NULL; - ThreadContext* prevt = NULL; - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tCtxSem); - #else - WaitOnLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - - #ifdef MPK_ON - lTLSIndex = labs(kCurrentThread()); - #else - lTLSIndex = GetThreadID(); - #endif //MPK_ON - - tip = g_ThreadCtx; - while(tip) { - if (tip->tid == lTLSIndex) { - if (prevt == NULL) - g_ThreadCtx = tip->next; - else - prevt->next = tip->next; - - free(tip); - tip=NULL; - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - return TRUE; - } - prevt = tip; - tip = tip->next; - } - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - - return FALSE; // entry not found + ThreadContext* tip = NULL; + ThreadContext* prevt = NULL; + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tCtxSem); + #else + WaitOnLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + + #ifdef MPK_ON + lTLSIndex = labs(kCurrentThread()); + #else + lTLSIndex = GetThreadID(); + #endif //MPK_ON + + tip = g_ThreadCtx; + while(tip) { + if (tip->tid == lTLSIndex) { + if (prevt == NULL) + g_ThreadCtx = tip->next; + else + prevt->next = tip->next; + + free(tip); + tip=NULL; + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + return TRUE; + } + prevt = tip; + tip = tip->next; + } + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + + return FALSE; // entry not found } @@ -673,48 +673,48 @@ BOOL fnRemoveThreadCtx(long lTLSIndex) void* fnGetThreadCtx(long lTLSIndex) { - ThreadContext* tip; - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreWait(g_tCtxSem); - #else - WaitOnLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - - #ifdef MPK_ON - lTLSIndex = labs(kCurrentThread()); - #else - lTLSIndex = GetThreadID(); - #endif //MPK_ON - - tip = g_ThreadCtx; - while(tip) { - if (tip->tid == lTLSIndex) { - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - return (tip->tInfo); - } - tip=tip->next; - } - - if (g_tCtxSem) - { - #ifdef MPK_ON - kSemaphoreSignal(g_tCtxSem); - #else - SignalLocalSemaphore(g_tCtxSem); - #endif //MPK_ON - } - - return NULL; + ThreadContext* tip; + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreWait(g_tCtxSem); + #else + WaitOnLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + + #ifdef MPK_ON + lTLSIndex = labs(kCurrentThread()); + #else + lTLSIndex = GetThreadID(); + #endif //MPK_ON + + tip = g_ThreadCtx; + while(tip) { + if (tip->tid == lTLSIndex) { + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + return (tip->tInfo); + } + tip=tip->next; + } + + if (g_tCtxSem) + { + #ifdef MPK_ON + kSemaphoreSignal(g_tCtxSem); + #else + SignalLocalSemaphore(g_tCtxSem); + #endif //MPK_ON + } + + return NULL; } diff --git a/NetWare/NWUtil.c b/NetWare/NWUtil.c index 6d60dfbabdb5..bb39971f5626 100644 --- a/NetWare/NWUtil.c +++ b/NetWare/NWUtil.c @@ -57,7 +57,7 @@ char *s2 = NULL; // Used in fnSkipToken. Function : fnSkipWhite Description : This function skips the white space characters in the given string and - returns the resultant value. + returns the resultant value. Parameters : s (IN) - Input string. @@ -67,9 +67,9 @@ char *s2 = NULL; // Used in fnSkipToken. char *fnSkipWhite(char *s) { - while (isspace(*s)) - s++; - return s; + while (isspace(*s)) + s++; + return s; } @@ -79,10 +79,10 @@ char *fnSkipWhite(char *s) Function : fnNwGetEnvironmentStr Description : This function returns the NetWare environment string if available, - otherwise returns the supplied default value + otherwise returns the supplied default value Parameters : name (IN) - To hold the NetWare environment value. - defaultvalue (IN) - Default value. + defaultvalue (IN) - Default value. Returns : String. @@ -91,10 +91,10 @@ char *fnSkipWhite(char *s) char *fnNwGetEnvironmentStr(char *name, char *defaultvalue) { - char* ret = getenv(name); - if (ret == NULL) - ret = defaultvalue; - return ret; + char* ret = getenv(name); + if (ret == NULL) + ret = defaultvalue; + return ret; } @@ -104,11 +104,11 @@ char *fnNwGetEnvironmentStr(char *name, char *defaultvalue) Function : fnCommandLineParser Description : This function parses the command line into argc/argv style of - Number of params and array of params. + Number of params and array of params. Parameters : pclp (IN) - CommandLine structure. - commandLine (IN) - CommandLine String. - preserverQuotes (IN) - Indicates whether to preserve/copy the quotes or not. + commandLine (IN) - CommandLine String. + preserverQuotes (IN) - Indicates whether to preserve/copy the quotes or not. Returns : Nothing. @@ -116,275 +116,275 @@ char *fnNwGetEnvironmentStr(char *name, char *defaultvalue) void fnCommandLineParser(PCOMMANDLINEPARSER pclp, char * commandLine, BOOL preserveQuotes) { - char *buffer = NULL; + char *buffer = NULL; - int index = 0; - int do_delete = 1; - int i=0, j=0, k=0; + int index = 0; + int do_delete = 1; + int i=0, j=0, k=0; - // +1 makes room for the terminating NULL - buffer = (char *) malloc((strlen(commandLine) + 1) * sizeof(char)); - if (buffer == NULL) - { - pclp->m_isValid = FALSE; - return; - } + // +1 makes room for the terminating NULL + buffer = (char *) malloc((strlen(commandLine) + 1) * sizeof(char)); + if (buffer == NULL) + { + pclp->m_isValid = FALSE; + return; + } - if (preserveQuotes) - { - // No I/O redirection nor quote processing if preserveQuotes + if (preserveQuotes) + { + // No I/O redirection nor quote processing if preserveQuotes - char *s = NULL; - char *sSkippedToken = NULL; + char *s = NULL; + char *sSkippedToken = NULL; - strcpy(buffer, commandLine); - s = buffer; - s = fnSkipWhite(s); // Skip white spaces. + strcpy(buffer, commandLine); + s = buffer; + s = fnSkipWhite(s); // Skip white spaces. - s2 = s; // Update the global pointer. + s2 = s; // Update the global pointer. - pclp->sSkippedToken = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->sSkippedToken == NULL) - { - pclp->m_isValid = FALSE; - return; - } + pclp->sSkippedToken = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->sSkippedToken == NULL) + { + pclp->m_isValid = FALSE; + return; + } - while (*s && pclp->m_isValid) - { + while (*s && pclp->m_isValid) + { /**** // Commented since only one time malloc and free is enough as is done outside this while loop. // It is not required to do them everytime the execution comes into this while loop. // Still retained here. Remove this once things are proved to be working fine to a good confident level, - if(pclp->sSkippedToken) - { - free(pclp->sSkippedToken); - pclp->sSkippedToken = NULL; - } - - if(pclp->sSkippedToken == NULL) - { - pclp->sSkippedToken = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->sSkippedToken == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } + if(pclp->sSkippedToken) + { + free(pclp->sSkippedToken); + pclp->sSkippedToken = NULL; + } + + if(pclp->sSkippedToken == NULL) + { + pclp->sSkippedToken = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->sSkippedToken == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } ****/ - // Empty the string. - strncpy(pclp->sSkippedToken, "", (MAX_DN_BYTES * sizeof(char))); - - // s is advanced by fnSkipToken - pclp->sSkippedToken = fnSkipToken(s, pclp->sSkippedToken); // Collect the next command-line argument. - - s2 = fnSkipWhite(s2); // s2 is already updated by fnSkipToken. - s = s2; // Update the local pointer too. - - fnAppendArgument(pclp, pclp->sSkippedToken); // Append the argument into an array. - } - - if(pclp->sSkippedToken) - { - free(pclp->sSkippedToken); - pclp->sSkippedToken = NULL; - } - } - else - { - char *s = NULL; - - strcpy(buffer, commandLine); - s = buffer; - s = fnSkipWhite(s); - - s1 = s; // Update the global pointer. - - while (*s && pclp->m_isValid) - { - // s is advanced by fnScanToken - // Check for I/O redirection here, *outside* of - // fnScanToken(), so that quote-protected angle - // brackets do NOT cause redirection. - if (*s == '<') - { - s = fnSkipWhite(s+1); // get stdin redirection - - if(pclp->m_redirInName) - { - free(pclp->m_redirInName); - pclp->m_redirInName = NULL; - } - - if(pclp->m_redirInName == NULL) - { - pclp->m_redirInName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->m_redirInName == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } - - // Collect the next command-line argument. - pclp->m_redirInName = fnScanToken(s, pclp->m_redirInName); - - s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. - s = s1; // Update the local pointer too. - } - else if (*s == '>') - { - s = fnSkipWhite(s+1); //get stdout redirection - - if(pclp->m_redirOutName) - { - free(pclp->m_redirOutName); - pclp->m_redirOutName = NULL; - } - - if(pclp->m_redirOutName == NULL) - { - pclp->m_redirOutName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->m_redirOutName == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } - - // Collect the next command-line argument. - pclp->m_redirOutName = fnScanToken(s, pclp->m_redirOutName); - - s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. - s = s1; // Update the local pointer too. - } - else if (*s == '2' && s[1] == '>') - { - s = fnSkipWhite(s+2); // get stderr redirection - - if(pclp->m_redirErrName) - { - free(pclp->m_redirErrName); - pclp->m_redirErrName = NULL; - } - - if(pclp->m_redirErrName == NULL) - { - pclp->m_redirErrName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->m_redirErrName == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } - - // Collect the next command-line argument. - pclp->m_redirErrName = fnScanToken(s, pclp->m_redirErrName); - - s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. - s = s1; // Update the local pointer too. - } - else if (*s == '&' && s[1] == '>') - { - s = fnSkipWhite(s+2); // get stdout+stderr redirection - - if(pclp->m_redirBothName) - { - free(pclp->m_redirBothName); - pclp->m_redirBothName = NULL; - } - - if(pclp->m_redirBothName == NULL) - { - pclp->m_redirBothName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->m_redirBothName == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } - - // Collect the next command-line argument. - pclp->m_redirBothName = fnScanToken(s, pclp->m_redirBothName); - - s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. - s = s1; // Update the local pointer too. - } - else - { - if(pclp->nextarg) - { - free(pclp->nextarg); - pclp->nextarg = NULL; - } - - if(pclp->nextarg == NULL) - { - pclp->nextarg = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(pclp->nextarg == NULL) - { - pclp->m_isValid = FALSE; - return; - } - } - - // Collect the next command-line argument. - pclp->nextarg = fnScanToken(s, pclp->nextarg); - - s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. - s = s1; // Update the local pointer too. - - // Append the next command-line argument into an array. - fnAppendArgument(pclp, pclp->nextarg); - } - } - } - - - // The -{ option, the --noscreen option, the --autodestroy option, if present, - // are processed now and removed from the argument vector. - for(index=0; index < pclp->m_argc; ) - { - // "-q" is replaced by "-{", because of clash with GetOpt - sgp - 7th Nov 2000 - // Copied from NDK build - Jan 5th 2001 - if (strncmp(pclp->m_argv[index], (char *)"-{", 2) == 0) - { - // found a -q option; grab the semaphore number - sscanf(pclp->m_argv[index], (char *)"-{%x", &pclp->m_qSemaphore); - fnDeleteArgument(pclp, index); // Delete the argument from the list. - } - else if (strcmp(pclp->m_argv[index], (char *)"--noscreen") == 0) - { - // found a --noscreen option - pclp->m_noScreen = 1; - fnDeleteArgument(pclp, index); - } - else if (strcmp(pclp->m_argv[index], (char *)"--autodestroy") == 0) - { - // found a --autodestroy option - create a screen but close automatically - pclp->m_AutoDestroy = 1; - fnDeleteArgument(pclp, index); - } - else - index++; - } - - // pclp->m_isValid is TRUE if there are more than 2 command line parameters OR - // if there is only one command and if it is the comman PERL. - pclp->m_isValid = ((pclp->m_argc >= 2) || ((pclp->m_argc > 0) && (stricmp(pclp->m_argv[0], LOAD_COMMAND) != 0))); - - if(buffer) - { - free(buffer); - buffer = NULL; - } - - return; + // Empty the string. + strncpy(pclp->sSkippedToken, "", (MAX_DN_BYTES * sizeof(char))); + + // s is advanced by fnSkipToken + pclp->sSkippedToken = fnSkipToken(s, pclp->sSkippedToken); // Collect the next command-line argument. + + s2 = fnSkipWhite(s2); // s2 is already updated by fnSkipToken. + s = s2; // Update the local pointer too. + + fnAppendArgument(pclp, pclp->sSkippedToken); // Append the argument into an array. + } + + if(pclp->sSkippedToken) + { + free(pclp->sSkippedToken); + pclp->sSkippedToken = NULL; + } + } + else + { + char *s = NULL; + + strcpy(buffer, commandLine); + s = buffer; + s = fnSkipWhite(s); + + s1 = s; // Update the global pointer. + + while (*s && pclp->m_isValid) + { + // s is advanced by fnScanToken + // Check for I/O redirection here, *outside* of + // fnScanToken(), so that quote-protected angle + // brackets do NOT cause redirection. + if (*s == '<') + { + s = fnSkipWhite(s+1); // get stdin redirection + + if(pclp->m_redirInName) + { + free(pclp->m_redirInName); + pclp->m_redirInName = NULL; + } + + if(pclp->m_redirInName == NULL) + { + pclp->m_redirInName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->m_redirInName == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } + + // Collect the next command-line argument. + pclp->m_redirInName = fnScanToken(s, pclp->m_redirInName); + + s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. + s = s1; // Update the local pointer too. + } + else if (*s == '>') + { + s = fnSkipWhite(s+1); //get stdout redirection + + if(pclp->m_redirOutName) + { + free(pclp->m_redirOutName); + pclp->m_redirOutName = NULL; + } + + if(pclp->m_redirOutName == NULL) + { + pclp->m_redirOutName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->m_redirOutName == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } + + // Collect the next command-line argument. + pclp->m_redirOutName = fnScanToken(s, pclp->m_redirOutName); + + s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. + s = s1; // Update the local pointer too. + } + else if (*s == '2' && s[1] == '>') + { + s = fnSkipWhite(s+2); // get stderr redirection + + if(pclp->m_redirErrName) + { + free(pclp->m_redirErrName); + pclp->m_redirErrName = NULL; + } + + if(pclp->m_redirErrName == NULL) + { + pclp->m_redirErrName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->m_redirErrName == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } + + // Collect the next command-line argument. + pclp->m_redirErrName = fnScanToken(s, pclp->m_redirErrName); + + s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. + s = s1; // Update the local pointer too. + } + else if (*s == '&' && s[1] == '>') + { + s = fnSkipWhite(s+2); // get stdout+stderr redirection + + if(pclp->m_redirBothName) + { + free(pclp->m_redirBothName); + pclp->m_redirBothName = NULL; + } + + if(pclp->m_redirBothName == NULL) + { + pclp->m_redirBothName = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->m_redirBothName == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } + + // Collect the next command-line argument. + pclp->m_redirBothName = fnScanToken(s, pclp->m_redirBothName); + + s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. + s = s1; // Update the local pointer too. + } + else + { + if(pclp->nextarg) + { + free(pclp->nextarg); + pclp->nextarg = NULL; + } + + if(pclp->nextarg == NULL) + { + pclp->nextarg = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(pclp->nextarg == NULL) + { + pclp->m_isValid = FALSE; + return; + } + } + + // Collect the next command-line argument. + pclp->nextarg = fnScanToken(s, pclp->nextarg); + + s1 = fnSkipWhite(s1); // s1 is already updated by fnScanToken. + s = s1; // Update the local pointer too. + + // Append the next command-line argument into an array. + fnAppendArgument(pclp, pclp->nextarg); + } + } + } + + + // The -{ option, the --noscreen option, the --autodestroy option, if present, + // are processed now and removed from the argument vector. + for(index=0; index < pclp->m_argc; ) + { + // "-q" is replaced by "-{", because of clash with GetOpt - sgp - 7th Nov 2000 + // Copied from NDK build - Jan 5th 2001 + if (strncmp(pclp->m_argv[index], (char *)"-{", 2) == 0) + { + // found a -q option; grab the semaphore number + sscanf(pclp->m_argv[index], (char *)"-{%x", &pclp->m_qSemaphore); + fnDeleteArgument(pclp, index); // Delete the argument from the list. + } + else if (strcmp(pclp->m_argv[index], (char *)"--noscreen") == 0) + { + // found a --noscreen option + pclp->m_noScreen = 1; + fnDeleteArgument(pclp, index); + } + else if (strcmp(pclp->m_argv[index], (char *)"--autodestroy") == 0) + { + // found a --autodestroy option - create a screen but close automatically + pclp->m_AutoDestroy = 1; + fnDeleteArgument(pclp, index); + } + else + index++; + } + + // pclp->m_isValid is TRUE if there are more than 2 command line parameters OR + // if there is only one command and if it is the comman PERL. + pclp->m_isValid = ((pclp->m_argc >= 2) || ((pclp->m_argc > 0) && (stricmp(pclp->m_argv[0], LOAD_COMMAND) != 0))); + + if(buffer) + { + free(buffer); + buffer = NULL; + } + + return; } @@ -396,7 +396,7 @@ void fnCommandLineParser(PCOMMANDLINEPARSER pclp, char * commandLine, BOOL prese Description : This function appends the arguments into a list. Parameters : pclp (IN) - CommandLine structure. - new_arg (IN) - The new argument to be appended. + new_arg (IN) - The new argument to be appended. Returns : Nothing. @@ -404,98 +404,98 @@ void fnCommandLineParser(PCOMMANDLINEPARSER pclp, char * commandLine, BOOL prese void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) { - char **new_argv = pclp->new_argv; - - int new_argv_len = pclp->m_argv_len*2; - int i = 0, j = 0; - - - // Lengthen the argument vector if there's not room for another. - // Testing for 'm_argc+2' rather than 'm_argc+1' in the test guarantees - // that there'll always be a NULL terminator at the end of argv. - if ((pclp->m_argc + 2) > pclp->m_argv_len) - { - new_argv = (char **) malloc(new_argv_len * sizeof(char*)); // get a longer arg-vector - if (new_argv == NULL) - { - pclp->m_isValid = FALSE; - return; - } - for(i=0; im_isValid = FALSE; - return; - } - } - - for (i=0; im_argc; i++) - strcpy(new_argv[i], pclp->m_argv[i]); // copy old arg strings - - for(i=0; i<(pclp->m_argv_len); i++) - { - if(pclp->m_argv[i]) - { - free(pclp->m_argv[i]); - pclp->m_argv[i] = NULL; - } - } - if (pclp->m_argv != NULL) - { - free(pclp->m_argv); - pclp->m_argv = NULL; - } - - - pclp->m_argv = new_argv; - pclp->m_argv_len = new_argv_len; - - } - - // Once m_argv is guaranteed long enough, appending the argument is a direct job. - strcpy(pclp->m_argv[pclp->m_argc], new_arg); // Appended the new argument. - pclp->m_argc++; // Increment the number of parameters appended. - - // The char array is emptied for all elements upto the end so that there are no - // junk characters. If this is not done, then the issue is like this: - // - Simple perl command like "perl" on the system console works fine for the first time. - // - When "perl" is executed the second time, a new blank screen should come up - // which allows for editing also. This was not consistently working well. - // More so when the command was like, "perl ", that is the name "perl" followed - // by a few blank spaces, it used to give error in opening file: - // "unable to open the file" since the filename would have some junk characters. - // - // These issues are fixed through the code below. - for(i=pclp->m_argc; im_argv_len; i++) - strncpy(pclp->m_argv[i], "", (MAX_DN_BYTES * sizeof(char))); // MAX_DN_BYTES is the size of pclp->m_argv[]. - - - // Fix for empty command line double quote abend - perl <.pl> "" - if ((new_arg==NULL) || ((strlen(new_arg))<=0)) - { - pclp->m_argc--; // Decrement the number of parameters appended. - pclp->m_isValid = FALSE; - return; - } - - - return; + char **new_argv = pclp->new_argv; + + int new_argv_len = pclp->m_argv_len*2; + int i = 0, j = 0; + + + // Lengthen the argument vector if there's not room for another. + // Testing for 'm_argc+2' rather than 'm_argc+1' in the test guarantees + // that there'll always be a NULL terminator at the end of argv. + if ((pclp->m_argc + 2) > pclp->m_argv_len) + { + new_argv = (char **) malloc(new_argv_len * sizeof(char*)); // get a longer arg-vector + if (new_argv == NULL) + { + pclp->m_isValid = FALSE; + return; + } + for(i=0; im_isValid = FALSE; + return; + } + } + + for (i=0; im_argc; i++) + strcpy(new_argv[i], pclp->m_argv[i]); // copy old arg strings + + for(i=0; i<(pclp->m_argv_len); i++) + { + if(pclp->m_argv[i]) + { + free(pclp->m_argv[i]); + pclp->m_argv[i] = NULL; + } + } + if (pclp->m_argv != NULL) + { + free(pclp->m_argv); + pclp->m_argv = NULL; + } + + + pclp->m_argv = new_argv; + pclp->m_argv_len = new_argv_len; + + } + + // Once m_argv is guaranteed long enough, appending the argument is a direct job. + strcpy(pclp->m_argv[pclp->m_argc], new_arg); // Appended the new argument. + pclp->m_argc++; // Increment the number of parameters appended. + + // The char array is emptied for all elements upto the end so that there are no + // junk characters. If this is not done, then the issue is like this: + // - Simple perl command like "perl" on the system console works fine for the first time. + // - When "perl" is executed the second time, a new blank screen should come up + // which allows for editing also. This was not consistently working well. + // More so when the command was like, "perl ", that is the name "perl" followed + // by a few blank spaces, it used to give error in opening file: + // "unable to open the file" since the filename would have some junk characters. + // + // These issues are fixed through the code below. + for(i=pclp->m_argc; im_argv_len; i++) + strncpy(pclp->m_argv[i], "", (MAX_DN_BYTES * sizeof(char))); // MAX_DN_BYTES is the size of pclp->m_argv[]. + + + // Fix for empty command line double quote abend - perl <.pl> "" + if ((new_arg==NULL) || ((strlen(new_arg))<=0)) + { + pclp->m_argc--; // Decrement the number of parameters appended. + pclp->m_isValid = FALSE; + return; + } + + + return; } @@ -505,11 +505,11 @@ void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) Function : fnSkipToken Description : This function collects the next command-line argument, breaking on - unquoted white space. The quote symbols are copied into the output. - White space has already been skipped. + unquoted white space. The quote symbols are copied into the output. + White space has already been skipped. Parameters : s (IN) - Input string in which the token is skipped. - r (IN) - The resultant return string. + r (IN) - The resultant return string. Returns : String. @@ -517,44 +517,44 @@ void fnAppendArgument(PCOMMANDLINEPARSER pclp, char *new_arg) char *fnSkipToken(char *s, char *r) { - char *t=NULL; - char quote = '\0'; // NULL, single quote, or double quote - char ch = '\0'; - - for (t=s; t[0]; t++) - { - ch = t[0]; - if (!quote) - { - if (isspace(ch)) // if unquoted whitespace... - { - break; // ...end of token found - } - else if (ch=='"' || ch=='\'') // if opening quote... - { - quote = ch; // ...enter quote mode - } - } - else - { - if (ch=='\\' && t[1]==quote) // if escaped quote... - { - t++; // ...skip backslash - } - else if (ch==quote) // if close quote... - { - quote = 0; // ...leave quote mode - } - } - } - - r = fnStashString(s, r, t-s); // get heap-allocated token string - t = fnSkipWhite(t); // skip any trailing white space - s = t; // return updated source pointer - - s2 = t; // return updated global source pointer - - return r; // return heap-allocated token string + char *t=NULL; + char quote = '\0'; // NULL, single quote, or double quote + char ch = '\0'; + + for (t=s; t[0]; t++) + { + ch = t[0]; + if (!quote) + { + if (isspace(ch)) // if unquoted whitespace... + { + break; // ...end of token found + } + else if (ch=='"' || ch=='\'') // if opening quote... + { + quote = ch; // ...enter quote mode + } + } + else + { + if (ch=='\\' && t[1]==quote) // if escaped quote... + { + t++; // ...skip backslash + } + else if (ch==quote) // if close quote... + { + quote = 0; // ...leave quote mode + } + } + } + + r = fnStashString(s, r, t-s); // get heap-allocated token string + t = fnSkipWhite(t); // skip any trailing white space + s = t; // return updated source pointer + + s2 = t; // return updated global source pointer + + return r; // return heap-allocated token string } @@ -564,12 +564,12 @@ char *fnSkipToken(char *s, char *r) Function : fnScanToken Description : This function collects the next command-line argument, breaking on - unquoted white space or I/O redirection symbols. Quote symbols are not - copied into the output. - When called, any leading white space has already been skipped. + unquoted white space or I/O redirection symbols. Quote symbols are not + copied into the output. + When called, any leading white space has already been skipped. Parameters : x (IN) - Input string in which the token is scanned. - r (IN) - The resultant return string. + r (IN) - The resultant return string. Returns : String. @@ -577,61 +577,61 @@ char *fnSkipToken(char *s, char *r) char *fnScanToken(char *x, char *r) { - char *s = x; // input string position - char *t = x; // output string position - char quote = '\0'; // either NULL, or single quote, or double quote - char ch = '\0'; - char c = '\0'; - - while (*s) - { - ch = *s; // invariant: ch != 0 - - // look to see if we've reached the end of the token - if (!quote) // but don't look for token break if we're inside quotes - { - if (isspace(ch)) - break; // break on whitespace - if (ch=='>') - break; // break on ">" (redirect stdout) - if (ch=='<') - break; // break on "<" (redirect stdin) - if (ch=='&' && x[1]=='>') - break; // break on "&>" (redirect both stdout & stderr) - } - - // process the next source character - if (ch=='\\' && (c=s[1]) && (c=='\\'||c=='>'||c=='<'||c==quote)) - { - //-----------------if an escaped '\\', '>', '<', or quote... - s++; // ...skip over the backslash... - *t++ = *s++; // ...and copy the escaped character - } - else if (ch==quote) // (won't match unless inside quotes because invariant ch!=0) - { - //-----------------if close quote... - s++; // ...skip over the quote... - quote=0; // ...and leave quote mode - } - else if (!quote && (ch=='"' || ch=='\'')) - { - //-----------------if opening quote... - quote = *s++; // ...enter quote mode (remembering quote char, and skipping the quote) - } - else - { //----------if normal character... - *t++ = *s++; // ...copy the character - } - } - - // clean up return values - r = fnStashString(x, r, t-x); // get heap-allocated token string - s = fnSkipWhite(s); // skip any trailing white space - x = s; // return updated source pointer - - s1 = s; // return updated global source pointer - - return r; + char *s = x; // input string position + char *t = x; // output string position + char quote = '\0'; // either NULL, or single quote, or double quote + char ch = '\0'; + char c = '\0'; + + while (*s) + { + ch = *s; // invariant: ch != 0 + + // look to see if we've reached the end of the token + if (!quote) // but don't look for token break if we're inside quotes + { + if (isspace(ch)) + break; // break on whitespace + if (ch=='>') + break; // break on ">" (redirect stdout) + if (ch=='<') + break; // break on "<" (redirect stdin) + if (ch=='&' && x[1]=='>') + break; // break on "&>" (redirect both stdout & stderr) + } + + // process the next source character + if (ch=='\\' && (c=s[1]) && (c=='\\'||c=='>'||c=='<'||c==quote)) + { + //-----------------if an escaped '\\', '>', '<', or quote... + s++; // ...skip over the backslash... + *t++ = *s++; // ...and copy the escaped character + } + else if (ch==quote) // (won't match unless inside quotes because invariant ch!=0) + { + //-----------------if close quote... + s++; // ...skip over the quote... + quote=0; // ...and leave quote mode + } + else if (!quote && (ch=='"' || ch=='\'')) + { + //-----------------if opening quote... + quote = *s++; // ...enter quote mode (remembering quote char, and skipping the quote) + } + else + { //----------if normal character... + *t++ = *s++; // ...copy the character + } + } + + // clean up return values + r = fnStashString(x, r, t-x); // get heap-allocated token string + s = fnSkipWhite(s); // skip any trailing white space + x = s; // return updated source pointer + + s1 = s; // return updated global source pointer + + return r; } @@ -643,8 +643,8 @@ char *fnScanToken(char *x, char *r) Description : This function return the heap-allocated token string. Parameters : s (IN) - Input string from which the token is extracted. - buffer (IN) - Return string. - length (IN) - Length of the token to be extracted. + buffer (IN) - Return string. + length (IN) - Length of the token to be extracted. Returns : String. @@ -652,19 +652,19 @@ char *fnScanToken(char *x, char *r) char *fnStashString(char *s, char *buffer, int length) { - if (length <= 0) - { - // Copy "" instead of NULL since "" indicates that there is memory allocated having no/null value. - // NULL indicates that there is no memory allocated to it! - strcpy(buffer, ""); - } - else - { - strncpy(buffer, s, length); - buffer[length] = '\0'; - } - - return buffer; + if (length <= 0) + { + // Copy "" instead of NULL since "" indicates that there is memory allocated having no/null value. + // NULL indicates that there is no memory allocated to it! + strcpy(buffer, ""); + } + else + { + strncpy(buffer, s, length); + buffer[length] = '\0'; + } + + return buffer; } @@ -676,7 +676,7 @@ char *fnStashString(char *s, char *buffer, int length) Description : This function deletes an argument (that was originally appended) from the list. Parameters : pclp (IN) - CommandLine structure. - index (IN) - Index of the argument to be deleted. + index (IN) - Index of the argument to be deleted. Returns : Nothing. @@ -684,33 +684,33 @@ char *fnStashString(char *s, char *buffer, int length) void fnDeleteArgument(PCOMMANDLINEPARSER pclp, int index) { - int i = index; + int i = index; - // If index is greater than the no. of arguments, just return. - if (index >= pclp->m_argc) - return; + // If index is greater than the no. of arguments, just return. + if (index >= pclp->m_argc) + return; - // Move all the arguments after the index one up. - while(i < (pclp->m_argv_len-1)) - { - strcpy(pclp->m_argv[i], pclp->m_argv[i+1]); - i++; - } + // Move all the arguments after the index one up. + while(i < (pclp->m_argv_len-1)) + { + strcpy(pclp->m_argv[i], pclp->m_argv[i+1]); + i++; + } - // Delete the last one and free memory. - if ( pclp->m_argv[i] ) - { - free(pclp->m_argv[i]); - pclp->m_argv[i] = NULL; - } + // Delete the last one and free memory. + if ( pclp->m_argv[i] ) + { + free(pclp->m_argv[i]); + pclp->m_argv[i] = NULL; + } - pclp->m_argc--; // Decrement the number of arguments. - pclp->m_argv_len--; + pclp->m_argc--; // Decrement the number of arguments. + pclp->m_argv_len--; - return; + return; } @@ -729,82 +729,82 @@ void fnDeleteArgument(PCOMMANDLINEPARSER pclp, int index) char* fnMy_MkTemp(char* templatestr) { - char* pXs=NULL; - char numbuf[50]={'\0'}; - int count=0; - char* pPid=NULL; + char* pXs=NULL; + char numbuf[50]={'\0'}; + int count=0; + char* pPid=NULL; - char termchar = '\0'; - char letter = 'a'; - char letter1 = 'a'; + char termchar = '\0'; + char letter = 'a'; + char letter1 = 'a'; - if (templatestr && (pXs = strstr(templatestr, (char *)"XXXXXX"))) - { - // generate temp name - termchar = pXs[6]; - ltoa(GetThreadID(), numbuf, 16); + if (templatestr && (pXs = strstr(templatestr, (char *)"XXXXXX"))) + { + // generate temp name + termchar = pXs[6]; + ltoa(GetThreadID(), numbuf, 16); // numbuf[sizeof(numbuf)-1] = '\0'; - numbuf[strlen(numbuf)-1] = '\0'; - // beware! thread IDs are 8 hex digits on NW 4.11 and only the - // lower digits seem to change, whereas on NW 5 they are in the - // range of < 1000 hex or 3 hex digits in length. So the following - // logic ensures we use the least significant portion of the number. - if (strlen(numbuf) > 5) - pPid = &numbuf[strlen(numbuf)-5]; - else - pPid = numbuf; + numbuf[strlen(numbuf)-1] = '\0'; + // beware! thread IDs are 8 hex digits on NW 4.11 and only the + // lower digits seem to change, whereas on NW 5 they are in the + // range of < 1000 hex or 3 hex digits in length. So the following + // logic ensures we use the least significant portion of the number. + if (strlen(numbuf) > 5) + pPid = &numbuf[strlen(numbuf)-5]; + else + pPid = numbuf; /** - Backtick operation uses temp files that are stored under NWDEFPERLTEMP - directory. They are temporarily used and then cleaned up after usage. - In cases where multiple backtick operations are used that call some - complex scripts, new temp files will be created before the old ones are - deleted. So, we need to have a provision to create many temp files. - Hence the below logic. It is found that provision for 26 files may - not be enough in some cases. - - This below logic allows 26 files (like, pla00015.tmp through plz00015.tmp) - plus 6x26=676 (like, plaa0015.tmp through plzz0015.tmp) + Backtick operation uses temp files that are stored under NWDEFPERLTEMP + directory. They are temporarily used and then cleaned up after usage. + In cases where multiple backtick operations are used that call some + complex scripts, new temp files will be created before the old ones are + deleted. So, we need to have a provision to create many temp files. + Hence the below logic. It is found that provision for 26 files may + not be enough in some cases. + + This below logic allows 26 files (like, pla00015.tmp through plz00015.tmp) + plus 6x26=676 (like, plaa0015.tmp through plzz0015.tmp) **/ - letter = 'a'; - do - { - sprintf(pXs, (char *)"%c%05.5s", letter, pPid); - pXs[6] = termchar; - if (access(templatestr, 0) != 0) // File does not exist - { - return templatestr; - } - letter++; - } while (letter <= 'z'); - - letter1 = 'a'; - do - { - letter = 'a'; - do - { - sprintf(pXs, (char *)"%c%c%04.5s", letter1, letter, pPid); - pXs[6] = termchar; - if (access(templatestr, 0) != 0) // File does not exist - { - return templatestr; - } - letter++; - } while (letter <= 'z'); - letter1++; - } while (letter1 <= 'z'); - - errno = ENOENT; - return NULL; - } - else - { - errno = EINVAL; - return NULL; - } + letter = 'a'; + do + { + sprintf(pXs, (char *)"%c%05.5s", letter, pPid); + pXs[6] = termchar; + if (access(templatestr, 0) != 0) // File does not exist + { + return templatestr; + } + letter++; + } while (letter <= 'z'); + + letter1 = 'a'; + do + { + letter = 'a'; + do + { + sprintf(pXs, (char *)"%c%c%04.5s", letter1, letter, pPid); + pXs[6] = termchar; + if (access(templatestr, 0) != 0) // File does not exist + { + return templatestr; + } + letter++; + } while (letter <= 'z'); + letter1++; + } while (letter1 <= 'z'); + + errno = ENOENT; + return NULL; + } + else + { + errno = EINVAL; + return NULL; + } } @@ -814,10 +814,10 @@ char* fnMy_MkTemp(char* templatestr) Function : fnSystemCommand Description : This function constructs a system command from the given - null-terminated argv array and runs the command on the system console. + null-terminated argv array and runs the command on the system console. Parameters : argv (IN) - Array of input commands. - argc (IN) - Number of input parameters. + argc (IN) - Number of input parameters. Returns : Nothing. @@ -825,34 +825,34 @@ char* fnMy_MkTemp(char* templatestr) void fnSystemCommand (char** argv, int argc) { - // calculate the size of a temp buffer needed - int k = 0; - int totalSize = 0; - int bytes = 0; - char* tempCmd = NULL; - char* tptr = NULL; + // calculate the size of a temp buffer needed + int k = 0; + int totalSize = 0; + int bytes = 0; + char* tempCmd = NULL; + char* tptr = NULL; - for(k=0; k - #include + #include + #include #endif //MPK_ON @@ -44,9 +44,9 @@ // so it should be okay for this to be global. // #ifdef MPK_ON - THREAD gThreadHandle; + THREAD gThreadHandle; #else - int gThreadGroupID = -1; + int gThreadGroupID = -1; #endif //MPK_ON @@ -77,8 +77,8 @@ char sPerlScreenName[MAX_DN_BYTES * sizeof(char)] = {'\0'}; // typedef struct tagScriptData { - char *m_commandLine; - BOOL m_fromConsole; + char *m_commandLine; + BOOL m_fromConsole; }ScriptData; @@ -131,10 +131,10 @@ void nw_freeenviron(); Function : main Description : Called when the NLM is first loaded. Registers the command-line handler - and then terminates-stay-resident. + and then terminates-stay-resident. Parameters : argc (IN) - No of Input strings. - argv (IN) - Array of Input strings. + argv (IN) - Array of Input strings. Returns : Nothing. @@ -142,117 +142,117 @@ void nw_freeenviron(); void main(int argc, char *argv[]) { - char sysCmdLine[MAX_COMMAND_SIZE] = {'\0'}; - char cmdLineCopy[sizeof(PERL_COMMAND_NAME)+sizeof(sysCmdLine)+2] = {'\0'}; + char sysCmdLine[MAX_COMMAND_SIZE] = {'\0'}; + char cmdLineCopy[sizeof(PERL_COMMAND_NAME)+sizeof(sysCmdLine)+2] = {'\0'}; - ScriptData* psdata = NULL; + ScriptData* psdata = NULL; - // Keep this thread alive, since we use the thread group id of this thread to allocate memory on. - // When we unload the NLM, clib will tear the thread down. - // - #ifdef MPK_ON - gThreadHandle = kCurrentThread(); - #else - gThreadGroupID = GetThreadGroupID (); - #endif //MPK_ON + // Keep this thread alive, since we use the thread group id of this thread to allocate memory on. + // When we unload the NLM, clib will tear the thread down. + // + #ifdef MPK_ON + gThreadHandle = kCurrentThread(); + #else + gThreadGroupID = GetThreadGroupID (); + #endif //MPK_ON - signal (SIGTERM, fnSigTermHandler); - fnInitGpfGlobals(); // For importing the CLIB calls in place of the Watcom calls - fnInitializeThreadInfo(); + signal (SIGTERM, fnSigTermHandler); + fnInitGpfGlobals(); // For importing the CLIB calls in place of the Watcom calls + fnInitializeThreadInfo(); // Ensure that we have a "temp" directory - fnSetupNamespace(); - if (access(NWDEFPERLTEMP, 0) != 0) - mkdir(NWDEFPERLTEMP); - - // Create the file NUL if not present. This is done only once per NLM load. - // This is required for -e. - // Earlier versions were creating temporary files (in perl.c file) for -e. - // Now, the technique of creating temporary files are removed since they were - // fragile or insecure or slow. It now uses the memory by setting - // the BIT_BUCKET to "nul" on Win32, which is equivalent to /dev/nul of Unix. - // Since there is no equivalent of /dev/nul on NetWare, the work-around is that - // we create a file called "nul" and the BIT_BUCKET is set to "nul". - // This makes sure that -e works on NetWare too without the creation of temporary files - // in -e code in perl.c - { - char sNUL[MAX_DN_BYTES] = {'\0'}; - - strcpy(sNUL, NWDEFPERLROOT); - strcat(sNUL, "\\nwnul"); - if (access((const char *)sNUL, 0) != 0) - { - // The file, "nul" is not found and so create the file. - FILE *fp = NULL; - - fp = fopen((const char *)sNUL, (const char *)"w"); - fclose(fp); - } - } - - fnRegisterCommandLineHandler(); // Register the command line handler - SynchronizeStart(); // Restart the NLM startup process when using synchronization mode. - - fnGetPerlScreenName(sPerlScreenName); // Get the screen name. Done only once per NLM load. - - - // If the command line has two strings, then the first has to be "Perl" and the second is assumed - // to be a script to be run. If only one string (i.e., Perl) is input, then there is nothing to do! - // - if ((argc > 1) && getcmd(sysCmdLine)) - { - strcpy(cmdLineCopy, PERL_COMMAND_NAME); - strcat(cmdLineCopy, (char *)" "); // Space between the Perl Command and the input script name. - strcat(cmdLineCopy, sysCmdLine); // The command line parameters built into - - // Create a safe copy of the command line and pass it to the - // new thread for parsing. The new thread will be responsible - // to delete it when it is finished with it. - // - psdata = (ScriptData *) malloc(sizeof(ScriptData)); - if (psdata) - { - psdata->m_commandLine = NULL; - psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(psdata->m_commandLine) - { - strcpy(psdata->m_commandLine, cmdLineCopy); - psdata->m_fromConsole = TRUE; - - #ifdef MPK_ON + fnSetupNamespace(); + if (access(NWDEFPERLTEMP, 0) != 0) + mkdir(NWDEFPERLTEMP); + + // Create the file NUL if not present. This is done only once per NLM load. + // This is required for -e. + // Earlier versions were creating temporary files (in perl.c file) for -e. + // Now, the technique of creating temporary files are removed since they were + // fragile or insecure or slow. It now uses the memory by setting + // the BIT_BUCKET to "nul" on Win32, which is equivalent to /dev/nul of Unix. + // Since there is no equivalent of /dev/nul on NetWare, the work-around is that + // we create a file called "nul" and the BIT_BUCKET is set to "nul". + // This makes sure that -e works on NetWare too without the creation of temporary files + // in -e code in perl.c + { + char sNUL[MAX_DN_BYTES] = {'\0'}; + + strcpy(sNUL, NWDEFPERLROOT); + strcat(sNUL, "\\nwnul"); + if (access((const char *)sNUL, 0) != 0) + { + // The file, "nul" is not found and so create the file. + FILE *fp = NULL; + + fp = fopen((const char *)sNUL, (const char *)"w"); + fclose(fp); + } + } + + fnRegisterCommandLineHandler(); // Register the command line handler + SynchronizeStart(); // Restart the NLM startup process when using synchronization mode. + + fnGetPerlScreenName(sPerlScreenName); // Get the screen name. Done only once per NLM load. + + + // If the command line has two strings, then the first has to be "Perl" and the second is assumed + // to be a script to be run. If only one string (i.e., Perl) is input, then there is nothing to do! + // + if ((argc > 1) && getcmd(sysCmdLine)) + { + strcpy(cmdLineCopy, PERL_COMMAND_NAME); + strcat(cmdLineCopy, (char *)" "); // Space between the Perl Command and the input script name. + strcat(cmdLineCopy, sysCmdLine); // The command line parameters built into + + // Create a safe copy of the command line and pass it to the + // new thread for parsing. The new thread will be responsible + // to delete it when it is finished with it. + // + psdata = (ScriptData *) malloc(sizeof(ScriptData)); + if (psdata) + { + psdata->m_commandLine = NULL; + psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(psdata->m_commandLine) + { + strcpy(psdata->m_commandLine, cmdLineCopy); + psdata->m_fromConsole = TRUE; + + #ifdef MPK_ON // kStartThread((char *)"ConsoleHandlerThread", fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void *)psdata); - // Establish a new thread within a new thread group. - BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #else - // Start a new thread in its own thread group - BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #endif //MPK_ON - } - else - { - free(psdata); - psdata = NULL; - return; - } - } - else - return; - } - - - // Keep this thread alive, since we use the thread group id of this thread to allocate memory on. - // When we unload the NLM, clib will tear the thread down. - // - #ifdef MPK_ON - kSuspendThread(gThreadHandle); - #else - SuspendThread(GetThreadID()); - #endif //MPK_ON - - - return; + // Establish a new thread within a new thread group. + BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #else + // Start a new thread in its own thread group + BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #endif //MPK_ON + } + else + { + free(psdata); + psdata = NULL; + return; + } + } + else + return; + } + + + // Keep this thread alive, since we use the thread group id of this thread to allocate memory on. + // When we unload the NLM, clib will tear the thread down. + // + #ifdef MPK_ON + kSuspendThread(gThreadHandle); + #else + SuspendThread(GetThreadID()); + #endif //MPK_ON + + + return; } @@ -271,55 +271,55 @@ void main(int argc, char *argv[]) void fnSigTermHandler(int sig) { - int k = 0; - - - #ifdef MPK_ON - kResumeThread(gThreadHandle); - #endif //MPK_ON - - // Unregister the command line handler. - // - if (gCmdProcInit) - { - UnRegisterConsoleCommand (&gCmdParser); - gCmdProcInit = FALSE; - } - - // Free the global environ buffer - nw_freeenviron(); - - // Kill running scripts. - // - if (!fnTerminateThreadInfo()) - { - ConsolePrintf("Terminating Perl scripts...\n"); - gKillAll = TRUE; - - // fnTerminateThreadInfo will be run for 5 threads. If more threads/scripts are run, - // then the NLM will unload without terminating the thread info and leaks more memory. - // If this number is increased to reduce memory leaks, then it will unnecessarily take more time - // to unload when there are a smaller no of threads. Since this is a rare case, the no is kept as 5. - // - while (!fnTerminateThreadInfo() && k < 5) - { - nw_sleep(1); - k++; - } - } - - // Delete the file, "nul" if present since the NLM is unloaded. - { - char sNUL[MAX_DN_BYTES] = {'\0'}; - - strcpy(sNUL, NWDEFPERLROOT); - strcat(sNUL, "\\nwnul"); - if (access((const char *)sNUL, 0) == 0) - { - // The file, "nul" is found and so delete it. - unlink((const char *)sNUL); - } - } + int k = 0; + + + #ifdef MPK_ON + kResumeThread(gThreadHandle); + #endif //MPK_ON + + // Unregister the command line handler. + // + if (gCmdProcInit) + { + UnRegisterConsoleCommand (&gCmdParser); + gCmdProcInit = FALSE; + } + + // Free the global environ buffer + nw_freeenviron(); + + // Kill running scripts. + // + if (!fnTerminateThreadInfo()) + { + ConsolePrintf("Terminating Perl scripts...\n"); + gKillAll = TRUE; + + // fnTerminateThreadInfo will be run for 5 threads. If more threads/scripts are run, + // then the NLM will unload without terminating the thread info and leaks more memory. + // If this number is increased to reduce memory leaks, then it will unnecessarily take more time + // to unload when there are a smaller no of threads. Since this is a rare case, the no is kept as 5. + // + while (!fnTerminateThreadInfo() && k < 5) + { + nw_sleep(1); + k++; + } + } + + // Delete the file, "nul" if present since the NLM is unloaded. + { + char sNUL[MAX_DN_BYTES] = {'\0'}; + + strcpy(sNUL, NWDEFPERLROOT); + strcat(sNUL, "\\nwnul"); + if (access((const char *)sNUL, 0) == 0) + { + // The file, "nul" is found and so delete it. + unlink((const char *)sNUL); + } + } } @@ -329,12 +329,12 @@ void fnSigTermHandler(int sig) Function : fnCommandLineHandler Description : Gets called by OS when someone enters an unknown command at the system console, - after this routine is registered by RegisterConsoleCommand. - For the valid command we just spawn a thread with enough stack space - to actually run the script. + after this routine is registered by RegisterConsoleCommand. + For the valid command we just spawn a thread with enough stack space + to actually run the script. Parameters : screenID (IN) - id for the screen. - cmdLine (IN) - Command line string. + cmdLine (IN) - Command line string. Returns : Long. @@ -342,78 +342,78 @@ void fnSigTermHandler(int sig) LONG fnCommandLineHandler (LONG screenID, BYTE * cmdLine) { - ScriptData* psdata=NULL; - int OsThrdGrpID = -1; - LONG retCode = CS_CMD_FOUND; - char* cptr = NULL; - - - #ifdef MPK_ON - // Initialisation for MPK_ON - #else - OsThrdGrpID = -1; - #endif //MPK_ON - - - #ifdef MPK_ON - // For MPK_ON - #else - if (gThreadGroupID != -1) - OsThrdGrpID = SetThreadGroupID (gThreadGroupID); - #endif //MPK_ON - - - cptr = fnSkipWhite(cmdLine); // Skip white spaces. - if ((strnicmp(cptr, PERL_COMMAND_NAME, strlen(PERL_COMMAND_NAME)) == 0) && - ((cptr[strlen(PERL_COMMAND_NAME)] == ' ') || - (cptr[strlen(PERL_COMMAND_NAME)] == '\t') || - (cptr[strlen(PERL_COMMAND_NAME)] == '\0'))) - { - // Create a safe copy of the command line and pass it to the new thread for parsing. - // The new thread will be responsible to delete it when it is finished with it. - // - psdata = (ScriptData *) malloc(sizeof(ScriptData)); - if (psdata) - { - psdata->m_commandLine = NULL; - psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if(psdata->m_commandLine) - { - strcpy(psdata->m_commandLine, (char *)cmdLine); - psdata->m_fromConsole = TRUE; - - #ifdef MPK_ON + ScriptData* psdata=NULL; + int OsThrdGrpID = -1; + LONG retCode = CS_CMD_FOUND; + char* cptr = NULL; + + + #ifdef MPK_ON + // Initialisation for MPK_ON + #else + OsThrdGrpID = -1; + #endif //MPK_ON + + + #ifdef MPK_ON + // For MPK_ON + #else + if (gThreadGroupID != -1) + OsThrdGrpID = SetThreadGroupID (gThreadGroupID); + #endif //MPK_ON + + + cptr = fnSkipWhite(cmdLine); // Skip white spaces. + if ((strnicmp(cptr, PERL_COMMAND_NAME, strlen(PERL_COMMAND_NAME)) == 0) && + ((cptr[strlen(PERL_COMMAND_NAME)] == ' ') || + (cptr[strlen(PERL_COMMAND_NAME)] == '\t') || + (cptr[strlen(PERL_COMMAND_NAME)] == '\0'))) + { + // Create a safe copy of the command line and pass it to the new thread for parsing. + // The new thread will be responsible to delete it when it is finished with it. + // + psdata = (ScriptData *) malloc(sizeof(ScriptData)); + if (psdata) + { + psdata->m_commandLine = NULL; + psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if(psdata->m_commandLine) + { + strcpy(psdata->m_commandLine, (char *)cmdLine); + psdata->m_fromConsole = TRUE; + + #ifdef MPK_ON // kStartThread((char *)"ConsoleHandlerThread", fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void *)psdata); - // Establish a new thread within a new thread group. - BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #else - // Start a new thread in its own thread group - BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #endif //MPK_ON - } - else - { - free(psdata); - psdata = NULL; - retCode = CS_CMD_NOT_FOUND; - } - } - else - retCode = CS_CMD_NOT_FOUND; - } - else - retCode = CS_CMD_NOT_FOUND; - - - #ifdef MPK_ON - // For MPK_ON - #else - if (OsThrdGrpID != -1) - SetThreadGroupID (OsThrdGrpID); - #endif //MPK_ON - - - return retCode; + // Establish a new thread within a new thread group. + BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #else + // Start a new thread in its own thread group + BeginThreadGroup(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #endif //MPK_ON + } + else + { + free(psdata); + psdata = NULL; + retCode = CS_CMD_NOT_FOUND; + } + } + else + retCode = CS_CMD_NOT_FOUND; + } + else + retCode = CS_CMD_NOT_FOUND; + + + #ifdef MPK_ON + // For MPK_ON + #else + if (OsThrdGrpID != -1) + SetThreadGroupID (OsThrdGrpID); + #endif //MPK_ON + + + return retCode; } @@ -432,16 +432,16 @@ LONG fnCommandLineHandler (LONG screenID, BYTE * cmdLine) void fnRegisterCommandLineHandler(void) { - // Allocates resource tag for Console Command - if ((gCmdParser.RTag = - AllocateResourceTag (GetNLMHandle(), (char *)"Console Command", ConsoleCommandSignature)) != 0) - { - gCmdParser.parseRoutine = fnCommandLineHandler; // Set the Console Command parsing routine. - RegisterConsoleCommand (&gCmdParser); // Registers the Console Command parsing function - gCmdProcInit = TRUE; - } - - return; + // Allocates resource tag for Console Command + if ((gCmdParser.RTag = + AllocateResourceTag (GetNLMHandle(), (char *)"Console Command", ConsoleCommandSignature)) != 0) + { + gCmdParser.parseRoutine = fnCommandLineHandler; // Set the Console Command parsing routine. + RegisterConsoleCommand (&gCmdParser); // Registers the Console Command parsing function + gCmdProcInit = TRUE; + } + + return; } @@ -460,44 +460,44 @@ void fnRegisterCommandLineHandler(void) void fnSetupNamespace(void) { - SetCurrentNameSpace(NWOS2_NAME_SPACE); + SetCurrentNameSpace(NWOS2_NAME_SPACE); - //LATER: call SetTargetNameSpace(NWOS2_NAME_SPACE)? Currently, if - // I make this call, then CPerlExe::Rename fails in certain cases, - // and it isn't clear why. Looks like a CLIB bug... + //LATER: call SetTargetNameSpace(NWOS2_NAME_SPACE)? Currently, if + // I make this call, then CPerlExe::Rename fails in certain cases, + // and it isn't clear why. Looks like a CLIB bug... // SetTargetNameSpace(NWOS2_NAME_SPACE); - //Uncommented that above call, retaining the comment so that it will be easy - //to revert back if there is any problem - sgp - 10th May 2000 - - //Commented again, since Perl debugger had some problems because of - //the above call - sgp - 20th June 2000 - - { - // if running on Moab, call UseAccurateCaseForPaths. This API - // does bad things on 4.11 so we call only for Moab. - PFGETFILESERVERMAJORVERSIONNUMBER pf_getfileservermajorversionnumber = NULL; - pf_getfileservermajorversionnumber = (PFGETFILESERVERMAJORVERSIONNUMBER) - ImportSymbol(GetNLMHandle(), (char *)"GetFileServerMajorVersionNumber"); - if (pf_getfileservermajorversionnumber && ((*pf_getfileservermajorversionnumber)() > 4)) - { - PFUSEACCURATECASEFORPATHS pf_useaccuratecaseforpaths = NULL; - pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS) - ImportSymbol(GetNLMHandle(), (char *)"UseAccurateCaseForPaths"); - if (pf_useaccuratecaseforpaths) - (*pf_useaccuratecaseforpaths)(TRUE); - { - PFUNAUGMENTASTERISK pf_unaugmentasterisk = NULL; - pf_unaugmentasterisk = (PFUNAUGMENTASTERISK) - ImportSymbol(GetNLMHandle(), (char *)"UnAugmentAsterisk"); - if (pf_unaugmentasterisk) - (*pf_unaugmentasterisk)(TRUE); - } - } - } - - return; + //Uncommented that above call, retaining the comment so that it will be easy + //to revert back if there is any problem - sgp - 10th May 2000 + + //Commented again, since Perl debugger had some problems because of + //the above call - sgp - 20th June 2000 + + { + // if running on Moab, call UseAccurateCaseForPaths. This API + // does bad things on 4.11 so we call only for Moab. + PFGETFILESERVERMAJORVERSIONNUMBER pf_getfileservermajorversionnumber = NULL; + pf_getfileservermajorversionnumber = (PFGETFILESERVERMAJORVERSIONNUMBER) + ImportSymbol(GetNLMHandle(), (char *)"GetFileServerMajorVersionNumber"); + if (pf_getfileservermajorversionnumber && ((*pf_getfileservermajorversionnumber)() > 4)) + { + PFUSEACCURATECASEFORPATHS pf_useaccuratecaseforpaths = NULL; + pf_useaccuratecaseforpaths = (PFUSEACCURATECASEFORPATHS) + ImportSymbol(GetNLMHandle(), (char *)"UseAccurateCaseForPaths"); + if (pf_useaccuratecaseforpaths) + (*pf_useaccuratecaseforpaths)(TRUE); + { + PFUNAUGMENTASTERISK pf_unaugmentasterisk = NULL; + pf_unaugmentasterisk = (PFUNAUGMENTASTERISK) + ImportSymbol(GetNLMHandle(), (char *)"UnAugmentAsterisk"); + if (pf_unaugmentasterisk) + (*pf_unaugmentasterisk)(TRUE); + } + } + } + + return; } @@ -516,94 +516,94 @@ void fnSetupNamespace(void) void fnLaunchPerl(void* context) { - char* defaultDir = NULL; - char curdir[_MAX_PATH] = {'\0'}; - ScriptData* psdata = (ScriptData *) context; - - unsigned int moduleHandle = 0; - int currentThreadGroupID = -1; - - #ifdef MPK_ON - kExitNetWare(); - #endif //MPK_ON - - errno = 0; - - if (psdata->m_fromConsole) - { - // get the default working directory name - // - defaultDir = fnNwGetEnvironmentStr("PERL_ROOT", NWDEFPERLROOT); - } - else - defaultDir = getcwd(curdir, sizeof(curdir)-1); - - // set long name space - // - fnSetupNamespace(); - - // make the working directory the current directory if from console - // - if (psdata->m_fromConsole) - chdir(defaultDir); - - // run the script - // - fnRunScript(psdata); - - // May have to check this, I am blindly calling UCSTerminate, irrespective of - // whether it is initialized or not - // Copied from the previous Perl - sgp - 31st Oct 2000 - moduleHandle = FindNLMHandle("UCSCORE.NLM"); - if (moduleHandle) - { - PFUCSTERMINATE ucsterminate = (PFUCSTERMINATE)ImportSymbol(moduleHandle, "therealUCSTerminate"); - if (ucsterminate!=NULL) - (*ucsterminate)(); - } - - if (psdata->m_fromConsole) - { - // change thread groups for the call to free the memory - // allocated before the new thread group was started - #ifdef MPK_ON - // For MPK_ON - #else - if (gThreadGroupID != -1) - currentThreadGroupID = SetThreadGroupID (gThreadGroupID); - #endif //MPK_ON - } - - // Free memory - if (psdata) - { - if(psdata->m_commandLine) - { - free(psdata->m_commandLine); - psdata->m_commandLine = NULL; - } - - free(psdata); - psdata = NULL; - context = NULL; - } - - #ifdef MPK_ON - // For MPK_ON - #else - if (currentThreadGroupID != -1) - SetThreadGroupID (currentThreadGroupID); - #endif //MPK_ON - - #ifdef MPK_ON + char* defaultDir = NULL; + char curdir[_MAX_PATH] = {'\0'}; + ScriptData* psdata = (ScriptData *) context; + + unsigned int moduleHandle = 0; + int currentThreadGroupID = -1; + + #ifdef MPK_ON + kExitNetWare(); + #endif //MPK_ON + + errno = 0; + + if (psdata->m_fromConsole) + { + // get the default working directory name + // + defaultDir = fnNwGetEnvironmentStr("PERL_ROOT", NWDEFPERLROOT); + } + else + defaultDir = getcwd(curdir, sizeof(curdir)-1); + + // set long name space + // + fnSetupNamespace(); + + // make the working directory the current directory if from console + // + if (psdata->m_fromConsole) + chdir(defaultDir); + + // run the script + // + fnRunScript(psdata); + + // May have to check this, I am blindly calling UCSTerminate, irrespective of + // whether it is initialized or not + // Copied from the previous Perl - sgp - 31st Oct 2000 + moduleHandle = FindNLMHandle("UCSCORE.NLM"); + if (moduleHandle) + { + PFUCSTERMINATE ucsterminate = (PFUCSTERMINATE)ImportSymbol(moduleHandle, "therealUCSTerminate"); + if (ucsterminate!=NULL) + (*ucsterminate)(); + } + + if (psdata->m_fromConsole) + { + // change thread groups for the call to free the memory + // allocated before the new thread group was started + #ifdef MPK_ON + // For MPK_ON + #else + if (gThreadGroupID != -1) + currentThreadGroupID = SetThreadGroupID (gThreadGroupID); + #endif //MPK_ON + } + + // Free memory + if (psdata) + { + if(psdata->m_commandLine) + { + free(psdata->m_commandLine); + psdata->m_commandLine = NULL; + } + + free(psdata); + psdata = NULL; + context = NULL; + } + + #ifdef MPK_ON + // For MPK_ON + #else + if (currentThreadGroupID != -1) + SetThreadGroupID (currentThreadGroupID); + #endif //MPK_ON + + #ifdef MPK_ON // kExitThread(NULL); - #else - // just let the thread terminate by falling off the end of the - // function started by BeginThreadGroup + #else + // just let the thread terminate by falling off the end of the + // function started by BeginThreadGroup // ExitThread(EXIT_THREAD, 0); - #endif + #endif - return; + return; } @@ -622,459 +622,459 @@ void fnLaunchPerl(void* context) void fnRunScript(ScriptData* psdata) { - char **av=NULL; - char **en=NULL; - int exitstatus = 1; - int i=0, j=0; - int *dummy = 0; - - PCOMMANDLINEPARSER pclp = NULL; - - // Set up the environment block. This will only work on - // on Moab; on 4.11 the environment block will be empty. - char** env = NULL; - - BOOL use_system_console = TRUE; - BOOL newscreen = FALSE; - int newscreenhandle = 0; - - // redirect stdin or stdout and run the script - FILE* redirOut = NULL; - FILE* redirIn = NULL; - FILE* redirErr = NULL; - FILE* stderr_fp = NULL; - - int stdin_fd=-1, stdin_fd_dup=-1; - int stdout_fd=-1, stdout_fd_dup=-1; - int stderr_fd=-1, stderr_fd_dup=-1; - - - // Main callback instance - // - if (fnRegisterWithThreadTable() == FALSE) - return; - - // parse the command line into argc/argv style: - // number of params and char array of params - // - pclp = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER)); - if (!pclp) - { - fnUnregisterWithThreadTable(); - return; - } - - // Initialise the variables - pclp->m_isValid = TRUE; - pclp->m_redirInName = NULL; - pclp->m_redirOutName = NULL; - pclp->m_redirErrName = NULL; - pclp->m_redirBothName = NULL; - pclp->nextarg = NULL; - pclp->sSkippedToken = NULL; - pclp->m_argv = NULL; - pclp->new_argv = NULL; - - #ifdef MPK_ON - pclp->m_qSemaphore = NULL; - #else - pclp->m_qSemaphore = 0L; - #endif //MPK_ON - - pclp->m_noScreen = 0; - pclp->m_AutoDestroy = 0; - pclp->m_argc = 0; - pclp->m_argv_len = 1; - - // Allocate memory - pclp->m_argv = (char **) malloc(pclp->m_argv_len * sizeof(char *)); - if (pclp->m_argv == NULL) - { - free(pclp); - pclp = NULL; - - fnUnregisterWithThreadTable(); - return; - } - - pclp->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if (pclp->m_argv[0] == NULL) - { - free(pclp->m_argv); - pclp->m_argv=NULL; - - free(pclp); - pclp = NULL; - - fnUnregisterWithThreadTable(); - return; - } - - // Parse the command line - fnCommandLineParser(pclp, (char *)psdata->m_commandLine, FALSE); - if (!pclp->m_isValid) - { - if(pclp->m_argv) - { - for(i=0; im_argv_len; i++) - { - if(pclp->m_argv[i] != NULL) - { - free(pclp->m_argv[i]); - pclp->m_argv[i] = NULL; - } - } - - free(pclp->m_argv); - pclp->m_argv = NULL; - } - - if(pclp->nextarg) - { - free(pclp->nextarg); - pclp->nextarg = NULL; - } - if(pclp->sSkippedToken != NULL) - { - free(pclp->sSkippedToken); - pclp->sSkippedToken = NULL; - } - - if(pclp->m_redirInName) - { - free(pclp->m_redirInName); - pclp->m_redirInName = NULL; - } - if(pclp->m_redirOutName) - { - free(pclp->m_redirOutName); - pclp->m_redirOutName = NULL; - } - if(pclp->m_redirErrName) - { - free(pclp->m_redirErrName); - pclp->m_redirErrName = NULL; - } - if(pclp->m_redirBothName) - { - free(pclp->m_redirBothName); - pclp->m_redirBothName = NULL; - } - - // Signal a semaphore, if indicated by "-{" option, to indicate that - // the script has terminated and files are closed - // - if (pclp->m_qSemaphore != 0) - { - #ifdef MPK_ON - kSemaphoreSignal(pclp->m_qSemaphore); - #else - SignalLocalSemaphore(pclp->m_qSemaphore); - #endif //MPK_ON - } - - free(pclp); - pclp = NULL; - - fnUnregisterWithThreadTable(); - return; - } - - // Simulating a shell on NetWare can be difficult. If you don't - // create a new screen for the script to run in, you can output to - // the console but you can't get any input from the console. Therefore, - // every invocation of perl potentially needs its own screen unless - // you are running either "perl -h" or "perl -v" or you are redirecting - // stdin from a file. - // - // So we need to create a new screen and set that screen as the current - // screen when running any script launched from the console that is not - // "perl -h" or "perl -v" and is not redirecting stdin from a file. - // - // But it would be a little weird if we didn't create a new screen only - // in the case when redirecting stdin from a file; in only that case, - // stdout would be the console instead of a new screen. - // - // There is also the issue of standard err. In short, we might as well - // create a new screen no matter what is going on with redirection, just - // for the sake of consistency. - // - // In summary, we should a create a new screen and make that screen the - // current screen unless one of the following is true: - // * The command is "perl -h" - // * The command is "perl -v" - // * The script was launched by another perl script. In this case, - // the screen belonging to the parent perl script should probably be - // the same screen for this process. And it will be if use BeginThread - // instead of BeginThreadGroup when launching Perl from within a Perl - // script. - // - // In those cases where we create a new screen we should probably also display - // that screen. - // - - use_system_console = pclp->m_noScreen || - ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-h") == 0)) || - ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-v") == 0)); - - newscreen = (!use_system_console) && psdata->m_fromConsole; - - if (newscreen) - { - newscreenhandle = CreateScreen(sPerlScreenName, 0); - if (newscreenhandle) - DisplayScreen(newscreenhandle); - } - else if (use_system_console) - CreateScreen((char *)"System Console", 0); - - if (pclp->m_redirInName) - { - if ((stdin_fd = fileno(stdin)) != -1) - { - stdin_fd_dup = dup(stdin_fd); - if (stdin_fd_dup != -1) - { - redirIn = fdopen (stdin_fd_dup, (char const *)"r"); - if (redirIn) - stdin = freopen (pclp->m_redirInName, (char const *)"r", redirIn); - if (!stdin) - { - redirIn = NULL; - // undo the redirect, if possible - stdin = fdopen(stdin_fd, (char const *)"r"); - } - } - } - } - - /** - The below code stores the handle for the existing stdout to be used later and the existing stdout is closed. - stdout is then initialised to the new File pointer where the operations are done onto that. - Later (look below for the code), the saved stdout is restored back. - **/ - if (pclp->m_redirOutName) - { - if ((stdout_fd = fileno(stdout)) != -1) // Handle of the existing stdout. - { - stdout_fd_dup = dup(stdout_fd); - if (stdout_fd_dup != -1) - { - // Close the existing stdout. - fflush(stdout); // Write any unwritten data to the file. - - // New stdout - redirOut = fdopen (stdout_fd_dup, (char const *)"w"); - if (redirOut) - stdout = freopen (pclp->m_redirOutName, (char const *)"w", redirOut); - if (!stdout) - { - redirOut = NULL; - // Undo the redirection. - stdout = fdopen(stdout_fd, (char const *)"w"); - } - setbuf(stdout, NULL); // Unbuffered file pointer. - } - } - } - - if (pclp->m_redirErrName) - { - if ((stderr_fd = fileno(stderr)) != -1) - { - stderr_fd_dup = dup(stderr_fd); - if (stderr_fd_dup != -1) - { - fflush(stderr); - - redirErr = fdopen (stderr_fd_dup, (char const *)"w"); - if (redirErr) - stderr = freopen (pclp->m_redirErrName, (char const *)"w", redirErr); - if (!stderr) - { - redirErr = NULL; - // undo the redirect, if possible - stderr = fdopen(stderr_fd, (char const *)"w"); - } - setbuf(stderr, NULL); // Unbuffered file pointer. - } - } - } - - if (pclp->m_redirBothName) - { - if ((stdout_fd = fileno(stdout)) != -1) - { - stdout_fd_dup = dup(stdout_fd); - if (stdout_fd_dup != -1) - { - fflush(stdout); - - redirOut = fdopen (stdout_fd_dup, (char const *)"w"); - if (redirOut) - stdout = freopen (pclp->m_redirBothName, (char const *)"w", redirOut); - if (!stdout) - { - redirOut = NULL; - // undo the redirect, if possible - stdout = fdopen(stdout_fd, (char const *)"w"); - } - setbuf(stdout, NULL); // Unbuffered file pointer. - } - } - if ((stderr_fd = fileno(stderr)) != -1) - { - stderr_fp = stderr; - stderr = stdout; - } - } - - env = NULL; - fnSetUpEnvBlock(&env); // Set up the ENV block - - // Run the Perl script - exitstatus = RunPerl(pclp->m_argc, pclp->m_argv, env); - - // clean up any redirection - // - if (pclp->m_redirInName && redirIn) - { - fclose(stdin); - stdin = fdopen(stdin_fd, (char const *)"r"); // Put back the old handle for stdin. - } - - if (pclp->m_redirOutName && redirOut) - { - // Close the new stdout. - fflush(stdout); - fclose(stdout); - - // Put back the old handle for stdout. - stdout = fdopen(stdout_fd, (char const *)"w"); - setbuf(stdout, NULL); // Unbuffered file pointer. - } - - if (pclp->m_redirErrName && redirErr) - { - fflush(stderr); - fclose(stderr); - - stderr = fdopen(stderr_fd, (char const *)"w"); // Put back the old handle for stderr. - setbuf(stderr, NULL); // Unbuffered file pointer. - } - - if (pclp->m_redirBothName && redirOut) - { - stderr = stderr_fp; - - fflush(stdout); - fclose(stdout); - - stdout = fdopen(stdout_fd, (char const *)"w"); // Put back the old handle for stdout. - setbuf(stdout, NULL); // Unbuffered file pointer. - } - - - if (newscreen && newscreenhandle) - { - //added for --autodestroy switch - if(!pclp->m_AutoDestroy) - { - if ((redirOut == NULL) && (redirIn == NULL) && (!gKillAll)) - { - printf((char *)"\n\nPress any key to exit\n"); - getch(); - } - } - DestroyScreen(newscreenhandle); - } + char **av=NULL; + char **en=NULL; + int exitstatus = 1; + int i=0, j=0; + int *dummy = 0; + + PCOMMANDLINEPARSER pclp = NULL; + + // Set up the environment block. This will only work on + // on Moab; on 4.11 the environment block will be empty. + char** env = NULL; + + BOOL use_system_console = TRUE; + BOOL newscreen = FALSE; + int newscreenhandle = 0; + + // redirect stdin or stdout and run the script + FILE* redirOut = NULL; + FILE* redirIn = NULL; + FILE* redirErr = NULL; + FILE* stderr_fp = NULL; + + int stdin_fd=-1, stdin_fd_dup=-1; + int stdout_fd=-1, stdout_fd_dup=-1; + int stderr_fd=-1, stderr_fd_dup=-1; + + + // Main callback instance + // + if (fnRegisterWithThreadTable() == FALSE) + return; + + // parse the command line into argc/argv style: + // number of params and char array of params + // + pclp = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER)); + if (!pclp) + { + fnUnregisterWithThreadTable(); + return; + } + + // Initialise the variables + pclp->m_isValid = TRUE; + pclp->m_redirInName = NULL; + pclp->m_redirOutName = NULL; + pclp->m_redirErrName = NULL; + pclp->m_redirBothName = NULL; + pclp->nextarg = NULL; + pclp->sSkippedToken = NULL; + pclp->m_argv = NULL; + pclp->new_argv = NULL; + + #ifdef MPK_ON + pclp->m_qSemaphore = NULL; + #else + pclp->m_qSemaphore = 0L; + #endif //MPK_ON + + pclp->m_noScreen = 0; + pclp->m_AutoDestroy = 0; + pclp->m_argc = 0; + pclp->m_argv_len = 1; + + // Allocate memory + pclp->m_argv = (char **) malloc(pclp->m_argv_len * sizeof(char *)); + if (pclp->m_argv == NULL) + { + free(pclp); + pclp = NULL; + + fnUnregisterWithThreadTable(); + return; + } + + pclp->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if (pclp->m_argv[0] == NULL) + { + free(pclp->m_argv); + pclp->m_argv=NULL; + + free(pclp); + pclp = NULL; + + fnUnregisterWithThreadTable(); + return; + } + + // Parse the command line + fnCommandLineParser(pclp, (char *)psdata->m_commandLine, FALSE); + if (!pclp->m_isValid) + { + if(pclp->m_argv) + { + for(i=0; im_argv_len; i++) + { + if(pclp->m_argv[i] != NULL) + { + free(pclp->m_argv[i]); + pclp->m_argv[i] = NULL; + } + } + + free(pclp->m_argv); + pclp->m_argv = NULL; + } + + if(pclp->nextarg) + { + free(pclp->nextarg); + pclp->nextarg = NULL; + } + if(pclp->sSkippedToken != NULL) + { + free(pclp->sSkippedToken); + pclp->sSkippedToken = NULL; + } + + if(pclp->m_redirInName) + { + free(pclp->m_redirInName); + pclp->m_redirInName = NULL; + } + if(pclp->m_redirOutName) + { + free(pclp->m_redirOutName); + pclp->m_redirOutName = NULL; + } + if(pclp->m_redirErrName) + { + free(pclp->m_redirErrName); + pclp->m_redirErrName = NULL; + } + if(pclp->m_redirBothName) + { + free(pclp->m_redirBothName); + pclp->m_redirBothName = NULL; + } + + // Signal a semaphore, if indicated by "-{" option, to indicate that + // the script has terminated and files are closed + // + if (pclp->m_qSemaphore != 0) + { + #ifdef MPK_ON + kSemaphoreSignal(pclp->m_qSemaphore); + #else + SignalLocalSemaphore(pclp->m_qSemaphore); + #endif //MPK_ON + } + + free(pclp); + pclp = NULL; + + fnUnregisterWithThreadTable(); + return; + } + + // Simulating a shell on NetWare can be difficult. If you don't + // create a new screen for the script to run in, you can output to + // the console but you can't get any input from the console. Therefore, + // every invocation of perl potentially needs its own screen unless + // you are running either "perl -h" or "perl -v" or you are redirecting + // stdin from a file. + // + // So we need to create a new screen and set that screen as the current + // screen when running any script launched from the console that is not + // "perl -h" or "perl -v" and is not redirecting stdin from a file. + // + // But it would be a little weird if we didn't create a new screen only + // in the case when redirecting stdin from a file; in only that case, + // stdout would be the console instead of a new screen. + // + // There is also the issue of standard err. In short, we might as well + // create a new screen no matter what is going on with redirection, just + // for the sake of consistency. + // + // In summary, we should a create a new screen and make that screen the + // current screen unless one of the following is true: + // * The command is "perl -h" + // * The command is "perl -v" + // * The script was launched by another perl script. In this case, + // the screen belonging to the parent perl script should probably be + // the same screen for this process. And it will be if use BeginThread + // instead of BeginThreadGroup when launching Perl from within a Perl + // script. + // + // In those cases where we create a new screen we should probably also display + // that screen. + // + + use_system_console = pclp->m_noScreen || + ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-h") == 0)) || + ((pclp->m_argc == 2) && (strcmp(pclp->m_argv[1], (char *)"-v") == 0)); + + newscreen = (!use_system_console) && psdata->m_fromConsole; + + if (newscreen) + { + newscreenhandle = CreateScreen(sPerlScreenName, 0); + if (newscreenhandle) + DisplayScreen(newscreenhandle); + } + else if (use_system_console) + CreateScreen((char *)"System Console", 0); + + if (pclp->m_redirInName) + { + if ((stdin_fd = fileno(stdin)) != -1) + { + stdin_fd_dup = dup(stdin_fd); + if (stdin_fd_dup != -1) + { + redirIn = fdopen (stdin_fd_dup, (char const *)"r"); + if (redirIn) + stdin = freopen (pclp->m_redirInName, (char const *)"r", redirIn); + if (!stdin) + { + redirIn = NULL; + // undo the redirect, if possible + stdin = fdopen(stdin_fd, (char const *)"r"); + } + } + } + } + + /** + The below code stores the handle for the existing stdout to be used later and the existing stdout is closed. + stdout is then initialised to the new File pointer where the operations are done onto that. + Later (look below for the code), the saved stdout is restored back. + **/ + if (pclp->m_redirOutName) + { + if ((stdout_fd = fileno(stdout)) != -1) // Handle of the existing stdout. + { + stdout_fd_dup = dup(stdout_fd); + if (stdout_fd_dup != -1) + { + // Close the existing stdout. + fflush(stdout); // Write any unwritten data to the file. + + // New stdout + redirOut = fdopen (stdout_fd_dup, (char const *)"w"); + if (redirOut) + stdout = freopen (pclp->m_redirOutName, (char const *)"w", redirOut); + if (!stdout) + { + redirOut = NULL; + // Undo the redirection. + stdout = fdopen(stdout_fd, (char const *)"w"); + } + setbuf(stdout, NULL); // Unbuffered file pointer. + } + } + } + + if (pclp->m_redirErrName) + { + if ((stderr_fd = fileno(stderr)) != -1) + { + stderr_fd_dup = dup(stderr_fd); + if (stderr_fd_dup != -1) + { + fflush(stderr); + + redirErr = fdopen (stderr_fd_dup, (char const *)"w"); + if (redirErr) + stderr = freopen (pclp->m_redirErrName, (char const *)"w", redirErr); + if (!stderr) + { + redirErr = NULL; + // undo the redirect, if possible + stderr = fdopen(stderr_fd, (char const *)"w"); + } + setbuf(stderr, NULL); // Unbuffered file pointer. + } + } + } + + if (pclp->m_redirBothName) + { + if ((stdout_fd = fileno(stdout)) != -1) + { + stdout_fd_dup = dup(stdout_fd); + if (stdout_fd_dup != -1) + { + fflush(stdout); + + redirOut = fdopen (stdout_fd_dup, (char const *)"w"); + if (redirOut) + stdout = freopen (pclp->m_redirBothName, (char const *)"w", redirOut); + if (!stdout) + { + redirOut = NULL; + // undo the redirect, if possible + stdout = fdopen(stdout_fd, (char const *)"w"); + } + setbuf(stdout, NULL); // Unbuffered file pointer. + } + } + if ((stderr_fd = fileno(stderr)) != -1) + { + stderr_fp = stderr; + stderr = stdout; + } + } + + env = NULL; + fnSetUpEnvBlock(&env); // Set up the ENV block + + // Run the Perl script + exitstatus = RunPerl(pclp->m_argc, pclp->m_argv, env); + + // clean up any redirection + // + if (pclp->m_redirInName && redirIn) + { + fclose(stdin); + stdin = fdopen(stdin_fd, (char const *)"r"); // Put back the old handle for stdin. + } + + if (pclp->m_redirOutName && redirOut) + { + // Close the new stdout. + fflush(stdout); + fclose(stdout); + + // Put back the old handle for stdout. + stdout = fdopen(stdout_fd, (char const *)"w"); + setbuf(stdout, NULL); // Unbuffered file pointer. + } + + if (pclp->m_redirErrName && redirErr) + { + fflush(stderr); + fclose(stderr); + + stderr = fdopen(stderr_fd, (char const *)"w"); // Put back the old handle for stderr. + setbuf(stderr, NULL); // Unbuffered file pointer. + } + + if (pclp->m_redirBothName && redirOut) + { + stderr = stderr_fp; + + fflush(stdout); + fclose(stdout); + + stdout = fdopen(stdout_fd, (char const *)"w"); // Put back the old handle for stdout. + setbuf(stdout, NULL); // Unbuffered file pointer. + } + + + if (newscreen && newscreenhandle) + { + //added for --autodestroy switch + if(!pclp->m_AutoDestroy) + { + if ((redirOut == NULL) && (redirIn == NULL) && (!gKillAll)) + { + printf((char *)"\n\nPress any key to exit\n"); + getch(); + } + } + DestroyScreen(newscreenhandle); + } /** - // Commented since a few abends were happening in fnFpSetMode - // Set the mode for stdin and stdout - fnFpSetMode(stdin, O_TEXT, dummy); - fnFpSetMode(stdout, O_TEXT, dummy); + // Commented since a few abends were happening in fnFpSetMode + // Set the mode for stdin and stdout + fnFpSetMode(stdin, O_TEXT, dummy); + fnFpSetMode(stdout, O_TEXT, dummy); **/ - setmode(stdin, O_TEXT); - setmode(stdout, O_TEXT); - - // Cleanup - if(pclp->m_argv) - { - for(i=0; im_argv_len; i++) - { - if(pclp->m_argv[i] != NULL) - { - free(pclp->m_argv[i]); - pclp->m_argv[i] = NULL; - } - } - - free(pclp->m_argv); - pclp->m_argv = NULL; - } - - if(pclp->nextarg) - { - free(pclp->nextarg); - pclp->nextarg = NULL; - } - if(pclp->sSkippedToken != NULL) - { - free(pclp->sSkippedToken); - pclp->sSkippedToken = NULL; - } - - if(pclp->m_redirInName) - { - free(pclp->m_redirInName); - pclp->m_redirInName = NULL; - } - if(pclp->m_redirOutName) - { - free(pclp->m_redirOutName); - pclp->m_redirOutName = NULL; - } - if(pclp->m_redirErrName) - { - free(pclp->m_redirErrName); - pclp->m_redirErrName = NULL; - } - if(pclp->m_redirBothName) - { - free(pclp->m_redirBothName); - pclp->m_redirBothName = NULL; - } - - // Signal a semaphore, if indicated by -{ option, to indicate that - // the script has terminated and files are closed - // - if (pclp->m_qSemaphore != 0) - { - #ifdef MPK_ON - kSemaphoreSignal(pclp->m_qSemaphore); - #else - SignalLocalSemaphore(pclp->m_qSemaphore); - #endif //MPK_ON - } - - if(pclp) - { - free(pclp); - pclp = NULL; - } - - if(env) - { - fnDestroyEnvBlock(env); - env = NULL; - } - - fnUnregisterWithThreadTable(); - // Remove the thread context set during Perl_set_context - Remove_Thread_Ctx(); - - return; + setmode(stdin, O_TEXT); + setmode(stdout, O_TEXT); + + // Cleanup + if(pclp->m_argv) + { + for(i=0; im_argv_len; i++) + { + if(pclp->m_argv[i] != NULL) + { + free(pclp->m_argv[i]); + pclp->m_argv[i] = NULL; + } + } + + free(pclp->m_argv); + pclp->m_argv = NULL; + } + + if(pclp->nextarg) + { + free(pclp->nextarg); + pclp->nextarg = NULL; + } + if(pclp->sSkippedToken != NULL) + { + free(pclp->sSkippedToken); + pclp->sSkippedToken = NULL; + } + + if(pclp->m_redirInName) + { + free(pclp->m_redirInName); + pclp->m_redirInName = NULL; + } + if(pclp->m_redirOutName) + { + free(pclp->m_redirOutName); + pclp->m_redirOutName = NULL; + } + if(pclp->m_redirErrName) + { + free(pclp->m_redirErrName); + pclp->m_redirErrName = NULL; + } + if(pclp->m_redirBothName) + { + free(pclp->m_redirBothName); + pclp->m_redirBothName = NULL; + } + + // Signal a semaphore, if indicated by -{ option, to indicate that + // the script has terminated and files are closed + // + if (pclp->m_qSemaphore != 0) + { + #ifdef MPK_ON + kSemaphoreSignal(pclp->m_qSemaphore); + #else + SignalLocalSemaphore(pclp->m_qSemaphore); + #endif //MPK_ON + } + + if(pclp) + { + free(pclp); + pclp = NULL; + } + + if(env) + { + fnDestroyEnvBlock(env); + env = NULL; + } + + fnUnregisterWithThreadTable(); + // Remove the thread context set during Perl_set_context + Remove_Thread_Ctx(); + + return; } @@ -1093,74 +1093,74 @@ void fnRunScript(ScriptData* psdata) void fnSetUpEnvBlock(char*** penv) { - char** env = NULL; - - int sequence = 0; - char var[kMaxVariableNameLen+1] = {'\0'}; - char val[kMaxValueLen+1] = {'\0'}; - char both[kMaxVariableNameLen + kMaxValueLen + 5] = {'\0'}; - size_t len = kMaxValueLen; - int totalcnt = 0; - - while(scanenv( &sequence, var, &len, val )) - { - totalcnt++; - len = kMaxValueLen; - } - // add one for null termination - totalcnt++; - - env = (char **) malloc (totalcnt * sizeof(char *)); - if (env) - { - int cnt = 0; - int i = 0; - - sequence = 0; - len = kMaxValueLen; - - while( (cnt < (totalcnt-1)) && scanenv( &sequence, var, &len, val ) ) - { - val[len] = '\0'; - strcpy( both, var ); - strcat( both, (char *)"=" ); - strcat( both, val ); - - env[cnt] = (char *) malloc((sizeof(both)+1) * sizeof(char)); - if (env[cnt]) - { - strcpy(env[cnt], both); - cnt++; - } - else - { - for(i=0; im_commandLine = NULL; - psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - - if(psdata->m_commandLine) - { - strcpy(psdata->m_commandLine, cmdLine); - psdata->m_fromConsole = FALSE; - - #ifdef MPK_ON - BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #else - // Start a new thread in its own thread group - BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); - #endif //MPK_ON - } - else - { - free(psdata); - psdata = NULL; - return; - } - } - else - return; - - return; + int currentThreadGroup = -1; + + ScriptData* psdata=NULL; + + // Create a safe copy of the command line and pass it to the + // new thread for parsing. The new thread will be responsible + // to delete it when it is finished with it. + psdata = (ScriptData *) malloc(sizeof(ScriptData)); + if (psdata) + { + psdata->m_commandLine = NULL; + psdata->m_commandLine = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + + if(psdata->m_commandLine) + { + strcpy(psdata->m_commandLine, cmdLine); + psdata->m_fromConsole = FALSE; + + #ifdef MPK_ON + BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #else + // Start a new thread in its own thread group + BeginThread(fnLaunchPerl, NULL, PERL_COMMAND_STACK_SIZE, (void*)psdata); + #endif //MPK_ON + } + else + { + free(psdata); + psdata = NULL; + return; + } + } + else + return; + + return; } @@ -1315,7 +1315,7 @@ void fnInternalPerlLaunchHandler(char* cmdLine) Function : fnGetPerlScreenName Description : This function creates the Perl screen name. - Gets called from main only once when the Perl NLM loads. + Gets called from main only once when the Perl NLM loads. Parameters : sPerlScreenName (OUT) - Resultant Perl screen name. @@ -1325,30 +1325,30 @@ void fnInternalPerlLaunchHandler(char* cmdLine) void fnGetPerlScreenName(char *sPerlScreenName) { - // HYAK: - // The logic for using 32 in the below array sizes is like this: - // The NetWare CLIB SDK documentation says that for base 2 conversion, - // this number must be minimum 8. Also, in the example of the documentation, - // 20 is used as the size and testing is done for bases from 2 upto 16. - // So, to simply chose a number above 20 and also keeping in mind not to reserve - // unnecessary big array sizes, I have chosen 32 ! - // Less than that may also suffice. - char sPerlRevision[32 * sizeof(char)] = {'\0'}; - char sPerlVersion[32 * sizeof(char)] = {'\0'}; - char sPerlSubVersion[32 * sizeof(char)] = {'\0'}; - - // The defines for PERL_REVISION, PERL_VERSION, PERL_SUBVERSION are available in - // patchlevel.h under root and gets included when perl.h is included. - // The number 10 below indicates base 10. - itoa(PERL_REVISION, sPerlRevision, 10); - itoa(PERL_VERSION, sPerlVersion, 10); - itoa(PERL_SUBVERSION, sPerlSubVersion, 10); - - // Concatenate substrings to get a string like Perl5.6.1 which is used as the screen name. - sprintf(sPerlScreenName, "%s%s.%s.%s", PERL_COMMAND_NAME, - sPerlRevision, sPerlVersion, sPerlSubVersion); - - return; + // HYAK: + // The logic for using 32 in the below array sizes is like this: + // The NetWare CLIB SDK documentation says that for base 2 conversion, + // this number must be minimum 8. Also, in the example of the documentation, + // 20 is used as the size and testing is done for bases from 2 upto 16. + // So, to simply chose a number above 20 and also keeping in mind not to reserve + // unnecessary big array sizes, I have chosen 32 ! + // Less than that may also suffice. + char sPerlRevision[32 * sizeof(char)] = {'\0'}; + char sPerlVersion[32 * sizeof(char)] = {'\0'}; + char sPerlSubVersion[32 * sizeof(char)] = {'\0'}; + + // The defines for PERL_REVISION, PERL_VERSION, PERL_SUBVERSION are available in + // patchlevel.h under root and gets included when perl.h is included. + // The number 10 below indicates base 10. + itoa(PERL_REVISION, sPerlRevision, 10); + itoa(PERL_VERSION, sPerlVersion, 10); + itoa(PERL_SUBVERSION, sPerlSubVersion, 10); + + // Concatenate substrings to get a string like Perl5.6.1 which is used as the screen name. + sprintf(sPerlScreenName, "%s%s.%s.%s", PERL_COMMAND_NAME, + sPerlRevision, sPerlVersion, sPerlSubVersion); + + return; } @@ -1376,13 +1376,13 @@ char** genviron = NULL; char *** nw_getenviron() { - if (genviron) - return (&genviron); // This might leak memory upto 11736 bytes on some versions of NetWare. + if (genviron) + return (&genviron); // This might leak memory upto 11736 bytes on some versions of NetWare. // return genviron; // Abending on some versions of NetWare. - else - fnSetUpEnvBlock(&genviron); + else + fnSetUpEnvBlock(&genviron); - return (&genviron); + return (&genviron); } @@ -1402,10 +1402,10 @@ nw_getenviron() void nw_freeenviron() { - if (genviron) - { - fnDestroyEnvBlock(genviron); - genviron=NULL; - } + if (genviron) + { + fnDestroyEnvBlock(genviron); + genviron=NULL; + } } diff --git a/NetWare/Nwpipe.c b/NetWare/Nwpipe.c index ce9c19800d63..154ee096968c 100644 --- a/NetWare/Nwpipe.c +++ b/NetWare/Nwpipe.c @@ -52,111 +52,111 @@ BOOL fnPipeFileMakeArgv(PTEMPPIPEFILE ptpf) { - int i=0, j=0; - int dindex = 0; - int sindex = 0; - - ptpf->m_argv_len = 0; - - - // Below 2 is added for the following reason: - // - The first one is for an additional value that will be added through ptpf->m_redirect. - // - The second one is for a NULL termination of the array. - // This is required for spawnvp API that takes a NULL-terminated array as its 3rd parameter. - // If the array is NOT NULL-terminated, then the server abends at the spawnvp call !! - ptpf->m_argv = (char **) malloc((ptpf->m_pipeCommand->m_argc + 2) * sizeof(char*)); - if (ptpf->m_argv == NULL) - return FALSE; - - // For memory allocation it is just +1 since the last one is only for NULL-termination - // and no memory is required to be allocated. - for(i=0; i<(ptpf->m_pipeCommand->m_argc + 1); i++) - { - ptpf->m_argv[i] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if (ptpf->m_argv[i] == NULL) - { - for(j=0; jm_argv[j]) - { - free(ptpf->m_argv[j]); - ptpf->m_argv[j] = NULL; - } - } - free(ptpf->m_argv); - ptpf->m_argv = NULL; - - return FALSE; - } - } - - // Copy over parsed items, removing "load" keyword if necessary. - sindex = ((stricmp(ptpf->m_pipeCommand->m_argv[0], LOAD_COMMAND) == 0) ? 1 : 0); - while (sindex < ptpf->m_pipeCommand->m_argc) - { - strcpy(ptpf->m_argv[dindex], ptpf->m_pipeCommand->m_argv[sindex]); - dindex++; - sindex++; - } - - if (stricmp(ptpf->m_argv[0], PERL_COMMAND_NAME) == 0) // If Perl is the first command. - { - ptpf->m_launchPerl = TRUE; - - #ifdef MPK_ON - ptpf->m_perlSynchSemaphore = kSemaphoreAlloc((BYTE *)"pipeSemaphore", 0); - #else - ptpf->m_perlSynchSemaphore = OpenLocalSemaphore(0); - #endif //MPK_ON - } - else if (stricmp(ptpf->m_argv[0], (char *)"perlglob") == 0) - ptpf->m_doPerlGlob = TRUE; - - - // Create last argument, which will redirect to or from the temp file - if (!ptpf->m_doPerlGlob || ptpf->m_mode) - { - if (!ptpf->m_mode) // If read mode? - { - if (ptpf->m_launchPerl) - strcpy(ptpf->m_redirect, (char *)">"); - else - strcpy(ptpf->m_redirect, (char *)"(CLIB_OPT)/>"); - } - else - { - if (ptpf->m_launchPerl) - strcpy(ptpf->m_redirect, (char *)"<"); - else - strcpy(ptpf->m_redirect, (char *)"(CLIB_OPT)/<"); - } - strcat(ptpf->m_redirect, ptpf->m_fileName); - - if (ptpf->m_launchPerl) - { - char tbuf[15] = {'\0'}; - sprintf(tbuf, (char *)" -{%x", ptpf->m_perlSynchSemaphore); - strcat(ptpf->m_redirect, tbuf); - } - - strcpy(ptpf->m_argv[dindex], (char*) ptpf->m_redirect); - dindex++; - } - - if (dindex < (ptpf->m_pipeCommand->m_argc + 1)) - { - if(ptpf->m_argv[dindex]) - { - free(ptpf->m_argv[dindex]); - ptpf->m_argv[dindex] = NULL; // NULL termination - required for spawnvp call. - } - } - - ptpf->m_argv_len = dindex; // Length of the argv array OR number of argv string values. - ptpf->m_argv[ptpf->m_argv_len] = NULL; // NULL termination - required for spawnvp call. - - - return TRUE; + int i=0, j=0; + int dindex = 0; + int sindex = 0; + + ptpf->m_argv_len = 0; + + + // Below 2 is added for the following reason: + // - The first one is for an additional value that will be added through ptpf->m_redirect. + // - The second one is for a NULL termination of the array. + // This is required for spawnvp API that takes a NULL-terminated array as its 3rd parameter. + // If the array is NOT NULL-terminated, then the server abends at the spawnvp call !! + ptpf->m_argv = (char **) malloc((ptpf->m_pipeCommand->m_argc + 2) * sizeof(char*)); + if (ptpf->m_argv == NULL) + return FALSE; + + // For memory allocation it is just +1 since the last one is only for NULL-termination + // and no memory is required to be allocated. + for(i=0; i<(ptpf->m_pipeCommand->m_argc + 1); i++) + { + ptpf->m_argv[i] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if (ptpf->m_argv[i] == NULL) + { + for(j=0; jm_argv[j]) + { + free(ptpf->m_argv[j]); + ptpf->m_argv[j] = NULL; + } + } + free(ptpf->m_argv); + ptpf->m_argv = NULL; + + return FALSE; + } + } + + // Copy over parsed items, removing "load" keyword if necessary. + sindex = ((stricmp(ptpf->m_pipeCommand->m_argv[0], LOAD_COMMAND) == 0) ? 1 : 0); + while (sindex < ptpf->m_pipeCommand->m_argc) + { + strcpy(ptpf->m_argv[dindex], ptpf->m_pipeCommand->m_argv[sindex]); + dindex++; + sindex++; + } + + if (stricmp(ptpf->m_argv[0], PERL_COMMAND_NAME) == 0) // If Perl is the first command. + { + ptpf->m_launchPerl = TRUE; + + #ifdef MPK_ON + ptpf->m_perlSynchSemaphore = kSemaphoreAlloc((BYTE *)"pipeSemaphore", 0); + #else + ptpf->m_perlSynchSemaphore = OpenLocalSemaphore(0); + #endif //MPK_ON + } + else if (stricmp(ptpf->m_argv[0], (char *)"perlglob") == 0) + ptpf->m_doPerlGlob = TRUE; + + + // Create last argument, which will redirect to or from the temp file + if (!ptpf->m_doPerlGlob || ptpf->m_mode) + { + if (!ptpf->m_mode) // If read mode? + { + if (ptpf->m_launchPerl) + strcpy(ptpf->m_redirect, (char *)">"); + else + strcpy(ptpf->m_redirect, (char *)"(CLIB_OPT)/>"); + } + else + { + if (ptpf->m_launchPerl) + strcpy(ptpf->m_redirect, (char *)"<"); + else + strcpy(ptpf->m_redirect, (char *)"(CLIB_OPT)/<"); + } + strcat(ptpf->m_redirect, ptpf->m_fileName); + + if (ptpf->m_launchPerl) + { + char tbuf[15] = {'\0'}; + sprintf(tbuf, (char *)" -{%x", ptpf->m_perlSynchSemaphore); + strcat(ptpf->m_redirect, tbuf); + } + + strcpy(ptpf->m_argv[dindex], (char*) ptpf->m_redirect); + dindex++; + } + + if (dindex < (ptpf->m_pipeCommand->m_argc + 1)) + { + if(ptpf->m_argv[dindex]) + { + free(ptpf->m_argv[dindex]); + ptpf->m_argv[dindex] = NULL; // NULL termination - required for spawnvp call. + } + } + + ptpf->m_argv_len = dindex; // Length of the argv array OR number of argv string values. + ptpf->m_argv[ptpf->m_argv_len] = NULL; // NULL termination - required for spawnvp call. + + + return TRUE; } @@ -167,8 +167,8 @@ BOOL fnPipeFileMakeArgv(PTEMPPIPEFILE ptpf) Description : This function opens the pipe file. Parameters : ptpf (IN) - Input structure. - command (IN) - Input command string. - mode (IN) - Mode of opening. + command (IN) - Input command string. + mode (IN) - Mode of opening. Returns : File pointer. @@ -176,281 +176,281 @@ BOOL fnPipeFileMakeArgv(PTEMPPIPEFILE ptpf) FILE* fnPipeFileOpen(PTEMPPIPEFILE ptpf, char* command, char* mode) { - int i=0, j=0; + int i=0, j=0; - char tempName[_MAX_PATH] = {'\0'}; + char tempName[_MAX_PATH] = {'\0'}; - ptpf->m_fileName = (char *) malloc(_MAX_PATH * sizeof(char)); - if(ptpf->m_fileName == NULL) - return NULL; + ptpf->m_fileName = (char *) malloc(_MAX_PATH * sizeof(char)); + if(ptpf->m_fileName == NULL) + return NULL; - // The char array is emptied so that there is no junk characters. - strncpy(ptpf->m_fileName, "", (_MAX_PATH * sizeof(char))); - + // The char array is emptied so that there is no junk characters. + strncpy(ptpf->m_fileName, "", (_MAX_PATH * sizeof(char))); + - // Save off stuff - // - if(strchr(mode,'r') != 0) - ptpf->m_mode = FALSE; // Read mode - else if(strchr(mode,'w') != 0) - ptpf->m_mode = TRUE; // Write mode - else - { - if(ptpf->m_fileName != NULL) - { + // Save off stuff + // + if(strchr(mode,'r') != 0) + ptpf->m_mode = FALSE; // Read mode + else if(strchr(mode,'w') != 0) + ptpf->m_mode = TRUE; // Write mode + else + { + if(ptpf->m_fileName != NULL) + { // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; - } + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; + } - return NULL; - } + return NULL; + } - ptpf->m_pipeCommand = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER)); - if (!ptpf->m_pipeCommand) - { + ptpf->m_pipeCommand = (PCOMMANDLINEPARSER) malloc(sizeof(COMMANDLINEPARSER)); + if (!ptpf->m_pipeCommand) + { // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; - return NULL; - } + return NULL; + } - // Initialise the variables - ptpf->m_pipeCommand->m_isValid = TRUE; + // Initialise the variables + ptpf->m_pipeCommand->m_isValid = TRUE; /**** // Commented since these are not being used. Still retained here. // To be removed once things are proved to be working fine to a good confident level, - ptpf->m_pipeCommand->m_redirInName = NULL; - ptpf->m_pipeCommand->m_redirOutName = NULL; - ptpf->m_pipeCommand->m_redirErrName = NULL; - ptpf->m_pipeCommand->m_redirBothName = NULL; - ptpf->m_pipeCommand->nextarg = NULL; + ptpf->m_pipeCommand->m_redirInName = NULL; + ptpf->m_pipeCommand->m_redirOutName = NULL; + ptpf->m_pipeCommand->m_redirErrName = NULL; + ptpf->m_pipeCommand->m_redirBothName = NULL; + ptpf->m_pipeCommand->nextarg = NULL; ****/ - ptpf->m_pipeCommand->sSkippedToken = NULL; - ptpf->m_pipeCommand->m_argv = NULL; - ptpf->m_pipeCommand->new_argv = NULL; + ptpf->m_pipeCommand->sSkippedToken = NULL; + ptpf->m_pipeCommand->m_argv = NULL; + ptpf->m_pipeCommand->new_argv = NULL; - #ifdef MPK_ON - ptpf->m_pipeCommand->m_qSemaphore = NULL; - #else - ptpf->m_pipeCommand->m_qSemaphore = 0L; - #endif //MPK_ON + #ifdef MPK_ON + ptpf->m_pipeCommand->m_qSemaphore = NULL; + #else + ptpf->m_pipeCommand->m_qSemaphore = 0L; + #endif //MPK_ON - ptpf->m_pipeCommand->m_noScreen = 0; - ptpf->m_pipeCommand->m_AutoDestroy = 0; - ptpf->m_pipeCommand->m_argc = 0; - ptpf->m_pipeCommand->m_argv_len = 1; + ptpf->m_pipeCommand->m_noScreen = 0; + ptpf->m_pipeCommand->m_AutoDestroy = 0; + ptpf->m_pipeCommand->m_argc = 0; + ptpf->m_pipeCommand->m_argv_len = 1; - ptpf->m_pipeCommand->m_argv = (char **) malloc(ptpf->m_pipeCommand->m_argv_len * sizeof(char *)); - if (ptpf->m_pipeCommand->m_argv == NULL) - { - free(ptpf->m_pipeCommand); - ptpf->m_pipeCommand = NULL; + ptpf->m_pipeCommand->m_argv = (char **) malloc(ptpf->m_pipeCommand->m_argv_len * sizeof(char *)); + if (ptpf->m_pipeCommand->m_argv == NULL) + { + free(ptpf->m_pipeCommand); + ptpf->m_pipeCommand = NULL; // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); - - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; - - return NULL; - } - ptpf->m_pipeCommand->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if (ptpf->m_pipeCommand->m_argv[0] == NULL) - { - for(j=0; jm_pipeCommand->m_argv[j]) - { - free(ptpf->m_pipeCommand->m_argv[j]); - ptpf->m_pipeCommand->m_argv[j]=NULL; - } - } - free(ptpf->m_pipeCommand->m_argv); - ptpf->m_pipeCommand->m_argv=NULL; - - free(ptpf->m_pipeCommand); - ptpf->m_pipeCommand = NULL; + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); + + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; + + return NULL; + } + ptpf->m_pipeCommand->m_argv[0] = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if (ptpf->m_pipeCommand->m_argv[0] == NULL) + { + for(j=0; jm_pipeCommand->m_argv[j]) + { + free(ptpf->m_pipeCommand->m_argv[j]); + ptpf->m_pipeCommand->m_argv[j]=NULL; + } + } + free(ptpf->m_pipeCommand->m_argv); + ptpf->m_pipeCommand->m_argv=NULL; + + free(ptpf->m_pipeCommand); + ptpf->m_pipeCommand = NULL; // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; - return NULL; - } + return NULL; + } - ptpf->m_redirect = (char *) malloc(MAX_DN_BYTES * sizeof(char)); - if (ptpf->m_redirect == NULL) - { - for(i=0; im_pipeCommand->m_argv_len; i++) - { - if(ptpf->m_pipeCommand->m_argv[i] != NULL) - { - free(ptpf->m_pipeCommand->m_argv[i]); - ptpf->m_pipeCommand->m_argv[i] = NULL; - } - } + ptpf->m_redirect = (char *) malloc(MAX_DN_BYTES * sizeof(char)); + if (ptpf->m_redirect == NULL) + { + for(i=0; im_pipeCommand->m_argv_len; i++) + { + if(ptpf->m_pipeCommand->m_argv[i] != NULL) + { + free(ptpf->m_pipeCommand->m_argv[i]); + ptpf->m_pipeCommand->m_argv[i] = NULL; + } + } - free(ptpf->m_pipeCommand->m_argv); - ptpf->m_pipeCommand->m_argv = NULL; + free(ptpf->m_pipeCommand->m_argv); + ptpf->m_pipeCommand->m_argv = NULL; - free(ptpf->m_pipeCommand); - ptpf->m_pipeCommand = NULL; + free(ptpf->m_pipeCommand); + ptpf->m_pipeCommand = NULL; // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); - - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; - - return NULL; - } - - // The char array is emptied. - // If it is not done so, then it could contain some junk values and the string length in that case - // will not be zero. This causes erroneous results in fnPipeFileMakeArgv() function - // where strlen(ptpf->m_redirect) is used as a check for incrementing the parameter count and - // it will wrongly get incremented in such cases. - strncpy(ptpf->m_redirect, "", (MAX_DN_BYTES * sizeof(char))); - - // Parse the parameters. - fnCommandLineParser(ptpf->m_pipeCommand, (char *)command, TRUE); - if (!ptpf->m_pipeCommand->m_isValid) - { - fnTempPipeFileReleaseMemory(ptpf); - return NULL; - } - - - // Create a temporary file name - // - strncpy ( tempName, fnNwGetEnvironmentStr((char *)"TEMP", NWDEFPERLTEMP), (_MAX_PATH - 20) ); - tempName[_MAX_PATH-20] = '\0'; - strcat(tempName, (char *)"\\plXXXXXX.tmp"); - if (!fnMy_MkTemp(tempName)) - { - fnTempPipeFileReleaseMemory(ptpf); - return NULL; - } - - // create a temporary place-holder file - fclose(fopen(tempName, (char *)"w")); - strcpy(ptpf->m_fileName, tempName); - - - // Make the argument array - if(!fnPipeFileMakeArgv(ptpf)) - { - fnTempPipeFileReleaseMemory(ptpf); - - // Release additional memory - if(ptpf->m_argv != NULL) - { - for(i=0; im_argv_len; i++) - { - if(ptpf->m_argv[i] != NULL) - { - free(ptpf->m_argv[i]); - ptpf->m_argv[i] = NULL; - } - } - - free(ptpf->m_argv); - ptpf->m_argv = NULL; - } - - return NULL; - } - - - // Open the temp file in the appropriate way... - // - if (!ptpf->m_mode) // If Read mode? - { - // we wish to spawn a command, intercept its output, - // and then get that output - // - if (!ptpf->m_argv[0]) - { - fnTempPipeFileReleaseMemory(ptpf); - - // Release additional memory - if(ptpf->m_argv != NULL) - { - for(i=0; im_argv_len; i++) - { - if(ptpf->m_argv[i] != NULL) - { - free(ptpf->m_argv[i]); - ptpf->m_argv[i] = NULL; - } - } - - free(ptpf->m_argv); - ptpf->m_argv = NULL; - } - - return NULL; - } - - if (ptpf->m_launchPerl) - fnPipeFileDoPerlLaunch(ptpf); - else - if (ptpf->m_doPerlGlob) - fnDoPerlGlob(ptpf->m_argv, ptpf->m_fileName); // hack to do perl globbing - else - spawnvp(P_WAIT, ptpf->m_argv[0], ptpf->m_argv); - - ptpf->m_file = fopen (ptpf->m_fileName, (char *)"r"); // Get the Pipe file handle - } - else if (ptpf->m_mode) // If Write mode? - { - // we wish to open the file for writing now and - // do the command later - // - ptpf->m_file = fopen(ptpf->m_fileName, (char *)"w"); - } - - fnTempPipeFileReleaseMemory(ptpf); - - // Release additional memory - if(ptpf->m_argv != NULL) - { - for(i=0; i<(ptpf->m_argv_len); i++) - { - if(ptpf->m_argv[i] != NULL) - { - free(ptpf->m_argv[i]); - ptpf->m_argv[i] = NULL; - } - } - - free(ptpf->m_argv); - ptpf->m_argv = NULL; - } - - - return ptpf->m_file; // Return the Pipe file handle. + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); + + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; + + return NULL; + } + + // The char array is emptied. + // If it is not done so, then it could contain some junk values and the string length in that case + // will not be zero. This causes erroneous results in fnPipeFileMakeArgv() function + // where strlen(ptpf->m_redirect) is used as a check for incrementing the parameter count and + // it will wrongly get incremented in such cases. + strncpy(ptpf->m_redirect, "", (MAX_DN_BYTES * sizeof(char))); + + // Parse the parameters. + fnCommandLineParser(ptpf->m_pipeCommand, (char *)command, TRUE); + if (!ptpf->m_pipeCommand->m_isValid) + { + fnTempPipeFileReleaseMemory(ptpf); + return NULL; + } + + + // Create a temporary file name + // + strncpy ( tempName, fnNwGetEnvironmentStr((char *)"TEMP", NWDEFPERLTEMP), (_MAX_PATH - 20) ); + tempName[_MAX_PATH-20] = '\0'; + strcat(tempName, (char *)"\\plXXXXXX.tmp"); + if (!fnMy_MkTemp(tempName)) + { + fnTempPipeFileReleaseMemory(ptpf); + return NULL; + } + + // create a temporary place-holder file + fclose(fopen(tempName, (char *)"w")); + strcpy(ptpf->m_fileName, tempName); + + + // Make the argument array + if(!fnPipeFileMakeArgv(ptpf)) + { + fnTempPipeFileReleaseMemory(ptpf); + + // Release additional memory + if(ptpf->m_argv != NULL) + { + for(i=0; im_argv_len; i++) + { + if(ptpf->m_argv[i] != NULL) + { + free(ptpf->m_argv[i]); + ptpf->m_argv[i] = NULL; + } + } + + free(ptpf->m_argv); + ptpf->m_argv = NULL; + } + + return NULL; + } + + + // Open the temp file in the appropriate way... + // + if (!ptpf->m_mode) // If Read mode? + { + // we wish to spawn a command, intercept its output, + // and then get that output + // + if (!ptpf->m_argv[0]) + { + fnTempPipeFileReleaseMemory(ptpf); + + // Release additional memory + if(ptpf->m_argv != NULL) + { + for(i=0; im_argv_len; i++) + { + if(ptpf->m_argv[i] != NULL) + { + free(ptpf->m_argv[i]); + ptpf->m_argv[i] = NULL; + } + } + + free(ptpf->m_argv); + ptpf->m_argv = NULL; + } + + return NULL; + } + + if (ptpf->m_launchPerl) + fnPipeFileDoPerlLaunch(ptpf); + else + if (ptpf->m_doPerlGlob) + fnDoPerlGlob(ptpf->m_argv, ptpf->m_fileName); // hack to do perl globbing + else + spawnvp(P_WAIT, ptpf->m_argv[0], ptpf->m_argv); + + ptpf->m_file = fopen (ptpf->m_fileName, (char *)"r"); // Get the Pipe file handle + } + else if (ptpf->m_mode) // If Write mode? + { + // we wish to open the file for writing now and + // do the command later + // + ptpf->m_file = fopen(ptpf->m_fileName, (char *)"w"); + } + + fnTempPipeFileReleaseMemory(ptpf); + + // Release additional memory + if(ptpf->m_argv != NULL) + { + for(i=0; i<(ptpf->m_argv_len); i++) + { + if(ptpf->m_argv[i] != NULL) + { + free(ptpf->m_argv[i]); + ptpf->m_argv[i] = NULL; + } + } + + free(ptpf->m_argv); + ptpf->m_argv = NULL; + } + + + return ptpf->m_file; // Return the Pipe file handle. } @@ -468,71 +468,71 @@ FILE* fnPipeFileOpen(PTEMPPIPEFILE ptpf, char* command, char* mode) void fnPipeFileClose(PTEMPPIPEFILE ptpf) { - int i = 0; - - if (ptpf->m_mode) // If Write mode? - { - // we wish to spawn a command using our temp file for - // its input - // - if(ptpf->m_file != NULL) - { - fclose (ptpf->m_file); - ptpf->m_file = NULL; - } - - if (ptpf->m_launchPerl) - fnPipeFileDoPerlLaunch(ptpf); - else if (ptpf->m_argv) - spawnvp(P_WAIT, ptpf->m_argv[0], ptpf->m_argv); - } - - - // Close the temporary Pipe File, if opened - if (ptpf->m_file) - { - fclose(ptpf->m_file); - ptpf->m_file = NULL; - } - // Delete the temporary Pipe Filename if still valid and free the memory associated with the file name. - if(ptpf->m_fileName != NULL) - { + int i = 0; + + if (ptpf->m_mode) // If Write mode? + { + // we wish to spawn a command using our temp file for + // its input + // + if(ptpf->m_file != NULL) + { + fclose (ptpf->m_file); + ptpf->m_file = NULL; + } + + if (ptpf->m_launchPerl) + fnPipeFileDoPerlLaunch(ptpf); + else if (ptpf->m_argv) + spawnvp(P_WAIT, ptpf->m_argv[0], ptpf->m_argv); + } + + + // Close the temporary Pipe File, if opened + if (ptpf->m_file) + { + fclose(ptpf->m_file); + ptpf->m_file = NULL; + } + // Delete the temporary Pipe Filename if still valid and free the memory associated with the file name. + if(ptpf->m_fileName != NULL) + { // if (strlen(ptpf->m_fileName)) - if (ptpf->m_fileName) - unlink(ptpf->m_fileName); + if (ptpf->m_fileName) + unlink(ptpf->m_fileName); - free(ptpf->m_fileName); - ptpf->m_fileName = NULL; - } + free(ptpf->m_fileName); + ptpf->m_fileName = NULL; + } /** - if(ptpf->m_argv != NULL) - { - for(i=0; i<(ptpf->m_argv_len); i++) - { - if(ptpf->m_argv[i] != NULL) - { - free(ptpf->m_argv[i]); - ptpf->m_argv[i] = NULL; - } - } - - free(ptpf->m_argv); - ptpf->m_argv = NULL; - } + if(ptpf->m_argv != NULL) + { + for(i=0; i<(ptpf->m_argv_len); i++) + { + if(ptpf->m_argv[i] != NULL) + { + free(ptpf->m_argv[i]); + ptpf->m_argv[i] = NULL; + } + } + + free(ptpf->m_argv); + ptpf->m_argv = NULL; + } **/ - if (ptpf->m_perlSynchSemaphore) - { - #ifdef MPK_ON - kSemaphoreFree(ptpf->m_perlSynchSemaphore); - #else - CloseLocalSemaphore(ptpf->m_perlSynchSemaphore); - #endif //MPK_ON - } + if (ptpf->m_perlSynchSemaphore) + { + #ifdef MPK_ON + kSemaphoreFree(ptpf->m_perlSynchSemaphore); + #else + CloseLocalSemaphore(ptpf->m_perlSynchSemaphore); + #endif //MPK_ON + } - return; + return; } @@ -550,30 +550,30 @@ void fnPipeFileClose(PTEMPPIPEFILE ptpf) void fnPipeFileDoPerlLaunch(PTEMPPIPEFILE ptpf) { - char curdir[_MAX_PATH] = {'\0'}; - char* pcwd = NULL; - - int i=0; - - - // save off the current working directory to restore later - // this is just a hack! these problems of synchronization and - // restoring calling context need a much better solution! - pcwd = (char *)getcwd(curdir, sizeof(curdir)-1); - fnSystemCommand(ptpf->m_argv, ptpf->m_argv_len); - if (ptpf->m_perlSynchSemaphore) - { - #ifdef MPK_ON - kSemaphoreWait(ptpf->m_perlSynchSemaphore); - #else - WaitOnLocalSemaphore(ptpf->m_perlSynchSemaphore); - #endif //MPK_ON - } - - if (pcwd) - chdir(pcwd); - - return; + char curdir[_MAX_PATH] = {'\0'}; + char* pcwd = NULL; + + int i=0; + + + // save off the current working directory to restore later + // this is just a hack! these problems of synchronization and + // restoring calling context need a much better solution! + pcwd = (char *)getcwd(curdir, sizeof(curdir)-1); + fnSystemCommand(ptpf->m_argv, ptpf->m_argv_len); + if (ptpf->m_perlSynchSemaphore) + { + #ifdef MPK_ON + kSemaphoreWait(ptpf->m_perlSynchSemaphore); + #else + WaitOnLocalSemaphore(ptpf->m_perlSynchSemaphore); + #endif //MPK_ON + } + + if (pcwd) + chdir(pcwd); + + return; } @@ -591,27 +591,27 @@ void fnPipeFileDoPerlLaunch(PTEMPPIPEFILE ptpf) void fnTempPipeFile(PTEMPPIPEFILE ptpf) { - ptpf->m_fileName = NULL; + ptpf->m_fileName = NULL; - ptpf->m_mode = FALSE; // Default mode = Read mode. - ptpf->m_file = NULL; - ptpf->m_pipeCommand = NULL; - ptpf->m_argv = NULL; + ptpf->m_mode = FALSE; // Default mode = Read mode. + ptpf->m_file = NULL; + ptpf->m_pipeCommand = NULL; + ptpf->m_argv = NULL; - ptpf->m_redirect = NULL; + ptpf->m_redirect = NULL; - ptpf->m_launchPerl = FALSE; - ptpf->m_doPerlGlob = FALSE; + ptpf->m_launchPerl = FALSE; + ptpf->m_doPerlGlob = FALSE; - #ifdef MPK_ON - ptpf->m_perlSynchSemaphore = NULL; - #else - ptpf->m_perlSynchSemaphore = 0L; - #endif + #ifdef MPK_ON + ptpf->m_perlSynchSemaphore = NULL; + #else + ptpf->m_perlSynchSemaphore = 0L; + #endif - ptpf->m_argv_len = 0; + ptpf->m_argv_len = 0; - return; + return; } @@ -629,76 +629,76 @@ void fnTempPipeFile(PTEMPPIPEFILE ptpf) void fnTempPipeFileReleaseMemory(PTEMPPIPEFILE ptpf) { - int i=0; - - - if (ptpf->m_pipeCommand) - { - if(ptpf->m_pipeCommand->m_argv != NULL) - { - for(i=0; im_pipeCommand->m_argv_len; i++) - { - if(ptpf->m_pipeCommand->m_argv[i] != NULL) - { - free(ptpf->m_pipeCommand->m_argv[i]); - ptpf->m_pipeCommand->m_argv[i] = NULL; - } - } - - free(ptpf->m_pipeCommand->m_argv); - ptpf->m_pipeCommand->m_argv = NULL; - } - - if(ptpf->m_pipeCommand->sSkippedToken != NULL) - { - free(ptpf->m_pipeCommand->sSkippedToken); - ptpf->m_pipeCommand->sSkippedToken = NULL; - } + int i=0; + + + if (ptpf->m_pipeCommand) + { + if(ptpf->m_pipeCommand->m_argv != NULL) + { + for(i=0; im_pipeCommand->m_argv_len; i++) + { + if(ptpf->m_pipeCommand->m_argv[i] != NULL) + { + free(ptpf->m_pipeCommand->m_argv[i]); + ptpf->m_pipeCommand->m_argv[i] = NULL; + } + } + + free(ptpf->m_pipeCommand->m_argv); + ptpf->m_pipeCommand->m_argv = NULL; + } + + if(ptpf->m_pipeCommand->sSkippedToken != NULL) + { + free(ptpf->m_pipeCommand->sSkippedToken); + ptpf->m_pipeCommand->sSkippedToken = NULL; + } /**** // Commented since these are not being used. Still retained here. // To be removed once things are proved to be working fine to a good confident level, - if(ptpf->m_pipeCommand->nextarg) - { - free(ptpf->m_pipeCommand->nextarg); - ptpf->m_pipeCommand->nextarg = NULL; - } - - if(ptpf->m_pipeCommand->m_redirInName) - { - free(ptpf->m_pipeCommand->m_redirInName); - ptpf->m_pipeCommand->m_redirInName = NULL; - } - if(ptpf->m_pipeCommand->m_redirOutName) - { - free(ptpf->m_pipeCommand->m_redirOutName); - ptpf->m_pipeCommand->m_redirOutName = NULL; - } - if(ptpf->m_pipeCommand->m_redirErrName) - { - free(ptpf->m_pipeCommand->m_redirErrName); - ptpf->m_pipeCommand->m_redirErrName = NULL; - } - if(ptpf->m_pipeCommand->m_redirBothName) - { - free(ptpf->m_pipeCommand->m_redirBothName); - ptpf->m_pipeCommand->m_redirBothName = NULL; - } + if(ptpf->m_pipeCommand->nextarg) + { + free(ptpf->m_pipeCommand->nextarg); + ptpf->m_pipeCommand->nextarg = NULL; + } + + if(ptpf->m_pipeCommand->m_redirInName) + { + free(ptpf->m_pipeCommand->m_redirInName); + ptpf->m_pipeCommand->m_redirInName = NULL; + } + if(ptpf->m_pipeCommand->m_redirOutName) + { + free(ptpf->m_pipeCommand->m_redirOutName); + ptpf->m_pipeCommand->m_redirOutName = NULL; + } + if(ptpf->m_pipeCommand->m_redirErrName) + { + free(ptpf->m_pipeCommand->m_redirErrName); + ptpf->m_pipeCommand->m_redirErrName = NULL; + } + if(ptpf->m_pipeCommand->m_redirBothName) + { + free(ptpf->m_pipeCommand->m_redirBothName); + ptpf->m_pipeCommand->m_redirBothName = NULL; + } ****/ - if(ptpf->m_pipeCommand != NULL) - { - free(ptpf->m_pipeCommand); - ptpf->m_pipeCommand = NULL; - } - } + if(ptpf->m_pipeCommand != NULL) + { + free(ptpf->m_pipeCommand); + ptpf->m_pipeCommand = NULL; + } + } - if(ptpf->m_redirect != NULL) - { - free(ptpf->m_redirect); - ptpf->m_redirect = NULL; - } + if(ptpf->m_redirect != NULL) + { + free(ptpf->m_redirect); + ptpf->m_redirect = NULL; + } - return; + return; } diff --git a/NetWare/deb.h b/NetWare/deb.h index e79a8f41a76d..a0000bc041da 100644 --- a/NetWare/deb.h +++ b/NetWare/deb.h @@ -25,21 +25,21 @@ #if defined(DEBUGON) && !defined(USE_D2) - //debug build and d1 flag is used, so enable IDB - #define DBGMESG ConsolePrintf - #define IDB(x) \ - ConsolePrintf(x); \ - _asm {int 3} + //debug build and d1 flag is used, so enable IDB + #define DBGMESG ConsolePrintf + #define IDB(x) \ + ConsolePrintf(x); \ + _asm {int 3} #else - #if defined(USE_D2) - //debug build and d2 flag is used, so disable IDB - #define DBGMESG ConsolePrintf - #define IDB ConsolePrintf - #else - //release build, so disable DBGMESG and IDB - #define DBGMESG - #define IDB - #endif //if defined(USE_D2) + #if defined(USE_D2) + //debug build and d2 flag is used, so disable IDB + #define DBGMESG ConsolePrintf + #define IDB ConsolePrintf + #else + //release build, so disable DBGMESG and IDB + #define DBGMESG + #define IDB + #endif //if defined(USE_D2) #endif //if defined(DEBUGON) && !defined(USE_D2) diff --git a/NetWare/intdef.h b/NetWare/intdef.h index 4c566c4e45bc..b0bcf010b555 100644 --- a/NetWare/intdef.h +++ b/NetWare/intdef.h @@ -47,8 +47,8 @@ //#define strcpy(x,y) NWLstrbcpy(x,y,NWstrlen(y)+1) #define strcpy(x,y) \ - NWstrncpy(x,y,NWstrlen(y)); \ - x[NWstrlen(y)] ='\0'; + NWstrncpy(x,y,NWstrlen(y)); \ + x[NWstrlen(y)] ='\0'; #define strncpy(x,y,z) NWLstrbcpy(x,y,(z + 1)) #define strcat(x,y) NWLstrbcpy((x + NWstrlen(x)), y, (NWstrlen(y) +1)) #define strncmp(s1,s2,l) NWgstrncmp(s1,s2,l) @@ -58,28 +58,28 @@ #define wsprintf NWsprintf #define strncat(x,y,l) \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strncat\n"); \ - strncat(x,y,l); + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strncat\n"); \ + strncat(x,y,l); #define strdup(s1) \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strdup\n"); \ - strdup(s1); + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strdup\n"); \ + strdup(s1); #define strlist \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strlist\n"); \ - strlist; + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strlist\n"); \ + strlist; #define strlwr(s1) \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strlwr\n"); \ - strlwr(s1); + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strlwr\n"); \ + strlwr(s1); #define strnset(s1,l1,l2) \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strnset\n"); \ - strnset(s1,l1,l2); + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strnset\n"); \ + strnset(s1,l1,l2); #define strset(s1,l1) \ - NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strset\n"); \ - strset(s1,l1); + NWsprintf("oops!!! Not yet defined for NWI18N, define in intdef.h, still using strset\n"); \ + strset(s1,l1); #endif // __INTDEF__ diff --git a/NetWare/interface.c b/NetWare/interface.c index be3eddf149b2..cd2c6deb08c9 100644 --- a/NetWare/interface.c +++ b/NetWare/interface.c @@ -41,58 +41,58 @@ ClsPerlHost::~ClsPerlHost() ClsPerlHost::VersionNumber() { - return 0; + return 0; } bool ClsPerlHost::RegisterWithThreadTable() { - return(fnRegisterWithThreadTable()); + return(fnRegisterWithThreadTable()); } bool ClsPerlHost::UnregisterWithThreadTable() { - return(fnUnregisterWithThreadTable()); + return(fnUnregisterWithThreadTable()); } int ClsPerlHost::PerlCreate(PerlInterpreter *my_perl) { /* if (!(my_perl = perl_alloc())) // Allocate memory for Perl. - return (1);*/ + return (1);*/ perl_construct(my_perl); - return 1; + return 1; } int ClsPerlHost::PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env) { - return(perl_parse(my_perl, xs_init, argc, argv, env)); // Parse the command line. + return(perl_parse(my_perl, xs_init, argc, argv, env)); // Parse the command line. } int ClsPerlHost::PerlRun(PerlInterpreter *my_perl) { - return(perl_run(my_perl)); // Run Perl. + return(perl_run(my_perl)); // Run Perl. } int ClsPerlHost::PerlDestroy(PerlInterpreter *my_perl) { - return(perl_destruct(my_perl)); // Destructor for Perl. + return(perl_destruct(my_perl)); // Destructor for Perl. } void ClsPerlHost::PerlFree(PerlInterpreter *my_perl) { - perl_free(my_perl); // Free the memory allocated for Perl. + perl_free(my_perl); // Free the memory allocated for Perl. - // Remove the thread context set during Perl_set_context - // This is added here since for web script there is no other place this gets executed - // and it cannot be included into cgi2perl.xs unless this symbol is exported. - Remove_Thread_Ctx(); + // Remove the thread context set during Perl_set_context + // This is added here since for web script there is no other place this gets executed + // and it cannot be included into cgi2perl.xs unless this symbol is exported. + Remove_Thread_Ctx(); } /*============================================================================================ @@ -109,58 +109,58 @@ ClsPerlHost::PerlFree(PerlInterpreter *my_perl) static void xs_init(pTHX) { - char *file = __FILE__; + char *file = __FILE__; - dXSUB_SYS; - newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); + dXSUB_SYS; + newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); } EXTERN_C int RunPerl(int argc, char **argv, char **env) { - int exitstatus = 0; - ClsPerlHost nlm; - - PerlInterpreter *my_perl = NULL; // defined in Perl.h - PerlInterpreter *new_perl = NULL; // defined in Perl.h - - PERL_SYS_INIT(&argc, &argv); - - if (!(my_perl = perl_alloc())) // Allocate memory for Perl. - return (1); - - if(nlm.PerlCreate(my_perl)) - { - PL_perl_destruct_level = 0; - - if(!nlm.PerlParse(my_perl, argc, argv, env)) - { - #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing - new_perl = perl_clone(my_perl, 1); - - (void) perl_run(new_perl); // Run Perl. - PERL_SET_THX(my_perl); - #else - (void) nlm.PerlRun(my_perl); - #endif - } - exitstatus = nlm.PerlDestroy(my_perl); - } - if(my_perl) - nlm.PerlFree(my_perl); - - #ifdef USE_ITHREADS - if (new_perl) - { - PERL_SET_THX(new_perl); - exitstatus = nlm.PerlDestroy(new_perl); - nlm.PerlFree(my_perl); - } - #endif - - PERL_SYS_TERM(); - return exitstatus; + int exitstatus = 0; + ClsPerlHost nlm; + + PerlInterpreter *my_perl = NULL; // defined in Perl.h + PerlInterpreter *new_perl = NULL; // defined in Perl.h + + PERL_SYS_INIT(&argc, &argv); + + if (!(my_perl = perl_alloc())) // Allocate memory for Perl. + return (1); + + if(nlm.PerlCreate(my_perl)) + { + PL_perl_destruct_level = 0; + + if(!nlm.PerlParse(my_perl, argc, argv, env)) + { + #if defined(TOP_CLONE) && defined(USE_ITHREADS) // XXXXXX testing + new_perl = perl_clone(my_perl, 1); + + (void) perl_run(new_perl); // Run Perl. + PERL_SET_THX(my_perl); + #else + (void) nlm.PerlRun(my_perl); + #endif + } + exitstatus = nlm.PerlDestroy(my_perl); + } + if(my_perl) + nlm.PerlFree(my_perl); + + #ifdef USE_ITHREADS + if (new_perl) + { + PERL_SET_THX(new_perl); + exitstatus = nlm.PerlDestroy(new_perl); + nlm.PerlFree(my_perl); + } + #endif + + PERL_SYS_TERM(); + return exitstatus; } @@ -173,7 +173,7 @@ int RunPerl(int argc, char **argv, char **env) // IPerlHost* AllocStdPerl() { - return (IPerlHost*) new ClsPerlHost(); + return (IPerlHost*) new ClsPerlHost(); } @@ -185,7 +185,7 @@ IPerlHost* AllocStdPerl() // void FreeStdPerl(IPerlHost* pPerlHost) { - if (pPerlHost) - delete (ClsPerlHost*) pPerlHost; + if (pPerlHost) + delete (ClsPerlHost*) pPerlHost; } diff --git a/NetWare/interface.h b/NetWare/interface.h index 2c9d46d75d53..3718cfea6210 100644 --- a/NetWare/interface.h +++ b/NetWare/interface.h @@ -27,19 +27,19 @@ class ClsPerlHost : public IPerlHost { public: - ClsPerlHost(void); - virtual ~ClsPerlHost(void); + ClsPerlHost(void); + virtual ~ClsPerlHost(void); - int VersionNumber(); + int VersionNumber(); - int PerlCreate(PerlInterpreter *my_perl); - int PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env); - int PerlRun(PerlInterpreter *my_perl); - int PerlDestroy(PerlInterpreter *my_perl); - void PerlFree(PerlInterpreter *my_perl); + int PerlCreate(PerlInterpreter *my_perl); + int PerlParse(PerlInterpreter *my_perl, int argc, char** argv, char** env); + int PerlRun(PerlInterpreter *my_perl); + int PerlDestroy(PerlInterpreter *my_perl); + void PerlFree(PerlInterpreter *my_perl); - //bool RegisterWithThreadTable(void); - //bool UnregisterWithThreadTable(void); + //bool RegisterWithThreadTable(void); + //bool UnregisterWithThreadTable(void); }; diff --git a/NetWare/iperlhost.h b/NetWare/iperlhost.h index fe3dab7a34ae..946ee0a2c327 100644 --- a/NetWare/iperlhost.h +++ b/NetWare/iperlhost.h @@ -28,16 +28,16 @@ class IPerlHost { public: - virtual int VersionNumber() = 0; + virtual int VersionNumber() = 0; - virtual int PerlCreate(PerlInterpreter *my_perl) = 0; - virtual int PerlParse(PerlInterpreter *my_perl,int argc, char** argv, char** env) = 0; - virtual int PerlRun(PerlInterpreter *my_perl) = 0; - virtual int PerlDestroy(PerlInterpreter *my_perl) = 0; - virtual void PerlFree(PerlInterpreter *my_perl) = 0; + virtual int PerlCreate(PerlInterpreter *my_perl) = 0; + virtual int PerlParse(PerlInterpreter *my_perl,int argc, char** argv, char** env) = 0; + virtual int PerlRun(PerlInterpreter *my_perl) = 0; + virtual int PerlDestroy(PerlInterpreter *my_perl) = 0; + virtual void PerlFree(PerlInterpreter *my_perl) = 0; - //virtual bool RegisterWithThreadTable(void)=0; - //virtual bool UnregisterWithThreadTable(void)=0; + //virtual bool RegisterWithThreadTable(void)=0; + //virtual bool UnregisterWithThreadTable(void)=0; }; extern "C" IPerlHost* AllocStdPerl(); diff --git a/NetWare/netware.h b/NetWare/netware.h index c106476e28dd..af9e59936a13 100644 --- a/NetWare/netware.h +++ b/NetWare/netware.h @@ -33,10 +33,10 @@ //structure that will be used by times routine. struct tms { - long tms_utime; - long tms_stime; - long tms_cutime; - long tms_cstime; + long tms_utime; + long tms_stime; + long tms_cutime; + long tms_cstime; }; #define PERL_GET_CONTEXT_DEFINED @@ -87,9 +87,9 @@ EXTERN_C void Perl_nw5_init(int *argcp, char ***argvp); // Below is called in Run.c file when a perl script executes/runs. #ifdef MPK_ON - #define PERL_ASYNC_CHECK() kYieldThread(); + #define PERL_ASYNC_CHECK() kYieldThread(); #else - #define PERL_ASYNC_CHECK() ThreadSwitch(); + #define PERL_ASYNC_CHECK() ThreadSwitch(); #endif diff --git a/NetWare/nw5.c b/NetWare/nw5.c index 46642a4d5978..7db8ac090125 100644 --- a/NetWare/nw5.c +++ b/NetWare/nw5.c @@ -65,8 +65,8 @@ does not abend the server. void nw_abort(void) { - abort(); // Terminate the NLM application abnormally. - return; + abort(); // Terminate the NLM application abnormally. + return; } int @@ -84,8 +84,8 @@ nw_chmod(const char *path, int mode) void nw_clearerr(FILE *pf) { - if(pf) - clearerr(pf); + if(pf) + clearerr(pf); } int @@ -96,156 +96,156 @@ nw_close(int fd) nw_closedir(DIR *dirp) { - return (closedir(dirp)); + return (closedir(dirp)); } void nw_setbuf(FILE *pf, char *buf) { - if(pf) - setbuf(pf, buf); + if(pf) + setbuf(pf, buf); } int nw_setmode(FILE *fp, int mode) { /** - // Commented since a few abends were happening in fnFpSetMode - int *dummy = 0; - return(fnFpSetMode(fp, mode, dummy)); + // Commented since a few abends were happening in fnFpSetMode + int *dummy = 0; + return(fnFpSetMode(fp, mode, dummy)); **/ - int handle = -1; - errno = 0; + int handle = -1; + errno = 0; - handle = fileno(fp); - if (errno) - { - errno = 0; - return -1; - } - return setmode(handle, mode); + handle = fileno(fp); + if (errno) + { + errno = 0; + return -1; + } + return setmode(handle, mode); } int nw_setvbuf(FILE *pf, char *buf, int type, size_t size) { - if(pf) - return setvbuf(pf, buf, type, size); - else - return -1; + if(pf) + return setvbuf(pf, buf, type, size); + else + return -1; } unsigned int nw_sleep(unsigned int t) { - delay(t*1000); // Put the thread to sleep for 't' seconds. Initially 't' is passed in milliseconds. + delay(t*1000); // Put the thread to sleep for 't' seconds. Initially 't' is passed in milliseconds. return 0; } int nw_spawnvp(int mode, char *cmdname, char **argv) { - // There is no pass-around environment on NetWare so we throw that - // argument away for now. - - // The function "spawnvp" does not work in all situations. Loading - // edit.nlm seems to work, for example, but the name of the file - // to edit does not appear to get passed correctly. Another problem - // is that on Netware, P_WAIT does not really work reliably. It only - // works with NLMs built to use CLIB (according to Nile Thayne). - // NLMs such as EDIT that are written directly to the system have no - // way of running synchronously from another process. The whole - // architecture on NetWare seems pretty busted, so we just support it - // as best we can. - // - // The spawnvp function only launches NLMs, it will not execute a command; - // the NetWare "system" function is used for that purpose. Unfortunately, "system" - // always returns success whether the command is successful or not or even - // if the command was not found! To avoid ambiguity--you can have both an - // NLM named "perl" and a system command named "perl"--we need to - // force perl scripts to carry the word "load" when loading an NLM. This - // might be clearer anyway. - - int ret = 0; - int argc = 0; - - - if (stricmp(cmdname, LOAD_COMMAND) == 0) - { - if (argv[1] != NULL) - ret = spawnvp(mode, argv[1], &argv[1]); - } - else - { - int i=0; - while (argv[i] != '\0') - i++; - argc = i; - - fnSystemCommand(argv, argc); - } - - return ret; + // There is no pass-around environment on NetWare so we throw that + // argument away for now. + + // The function "spawnvp" does not work in all situations. Loading + // edit.nlm seems to work, for example, but the name of the file + // to edit does not appear to get passed correctly. Another problem + // is that on Netware, P_WAIT does not really work reliably. It only + // works with NLMs built to use CLIB (according to Nile Thayne). + // NLMs such as EDIT that are written directly to the system have no + // way of running synchronously from another process. The whole + // architecture on NetWare seems pretty busted, so we just support it + // as best we can. + // + // The spawnvp function only launches NLMs, it will not execute a command; + // the NetWare "system" function is used for that purpose. Unfortunately, "system" + // always returns success whether the command is successful or not or even + // if the command was not found! To avoid ambiguity--you can have both an + // NLM named "perl" and a system command named "perl"--we need to + // force perl scripts to carry the word "load" when loading an NLM. This + // might be clearer anyway. + + int ret = 0; + int argc = 0; + + + if (stricmp(cmdname, LOAD_COMMAND) == 0) + { + if (argv[1] != NULL) + ret = spawnvp(mode, argv[1], &argv[1]); + } + else + { + int i=0; + while (argv[i] != '\0') + i++; + argc = i; + + fnSystemCommand(argv, argc); + } + + return ret; } int nw_execv(char *cmdname, char **argv) { - return spawnvp(P_WAIT, cmdname, (char **)argv); + return spawnvp(P_WAIT, cmdname, (char **)argv); } int nw_execvp(char *cmdname, char **argv) { - return nw_spawnvp(P_WAIT, cmdname, (char **)argv); + return nw_spawnvp(P_WAIT, cmdname, (char **)argv); } int nw_stat(const char *path, struct stat *sbuf) { - return (stat(path, sbuf)); + return (stat(path, sbuf)); } FILE * nw_stderr(void) { - return (stderr); + return (stderr); } FILE * nw_stdin(void) { - return (stdin); + return (stdin); } FILE * nw_stdout() { - return (stdout); + return (stdout); } long nw_telldir(DIR *dirp) { - dTHX; - Perl_croak(aTHX_ "The telldir() function is not implemented on NetWare\n"); - return 0l; + dTHX; + Perl_croak(aTHX_ "The telldir() function is not implemented on NetWare\n"); + return 0l; } int nw_times(struct tms *timebuf) { - clock_t now = clock(); + clock_t now = clock(); - timebuf->tms_utime = now; - timebuf->tms_stime = 0; - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; + timebuf->tms_utime = now; + timebuf->tms_stime = 0; + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; - return 0; + return 0; } FILE* @@ -257,37 +257,37 @@ nw_tmpfile(void) int nw_uname(struct utsname *name) { - return(uname(name)); + return(uname(name)); } int nw_ungetc(int c, FILE *pf) { - if(pf) - return ungetc(c, pf); - else - return -1; + if(pf) + return ungetc(c, pf); + else + return -1; } int nw_unlink(const char *filename) { - return(unlink(filename)); + return(unlink(filename)); } int nw_utime(const char *filename, struct utimbuf *times) { - return(utime(filename, times)); + return(utime(filename, times)); } int nw_vfprintf(FILE *fp, const char *format, va_list args) { - if(fp) - return (vfprintf(fp, format, args)); - else - return -1; + if(fp) + return (vfprintf(fp, format, args)); + else + return -1; } int @@ -311,7 +311,7 @@ nw_write(int fd, const void *buf, unsigned int cnt) char * nw_crypt(const char *txt, const char *salt) { - dTHX; + dTHX; #ifdef HAVE_DES_FCRYPT dTHR; @@ -331,221 +331,221 @@ nw_dup(int fd) int nw_dup2(int fd1,int fd2) { - return dup2(fd1,fd2); + return dup2(fd1,fd2); } void* nw_dynaload(const char* filename) { - return NULL; + return NULL; } int nw_fclose(FILE *pf) { - if(pf) - return (fclose(pf)); - else - return -1; + if(pf) + return (fclose(pf)); + else + return -1; } FILE * nw_fdopen(int handle, const char *mode) { - return(fdopen(handle, mode)); + return(fdopen(handle, mode)); } int nw_feof(FILE *fp) { - if(fp) - return (feof(fp)); - else - return -1; + if(fp) + return (feof(fp)); + else + return -1; } int nw_ferror(FILE *fp) { - if(fp) - return (ferror(fp)); - else - return -1; + if(fp) + return (ferror(fp)); + else + return -1; } int nw_fflush(FILE *pf) { - if(pf) - return fflush(pf); - else - return -1; + if(pf) + return fflush(pf); + else + return -1; } int nw_fgetpos(FILE *pf, fpos_t *p) { - if(pf) - return fgetpos(pf, p); - else - return -1; + if(pf) + return fgetpos(pf, p); + else + return -1; } char* nw_fgets(char *s, int n, FILE *pf) { - if(pf) - return(fgets(s, n, pf)); - else - return NULL; + if(pf) + return(fgets(s, n, pf)); + else + return NULL; } int nw_fileno(FILE *pf) { - if(pf) - return fileno(pf); - else - return -1; + if(pf) + return fileno(pf); + else + return -1; } int nw_flock(int fd, int oper) { - dTHX; - Perl_croak(aTHX_ "The flock() function is not implemented on NetWare\n"); - return 0; + dTHX; + Perl_croak(aTHX_ "The flock() function is not implemented on NetWare\n"); + return 0; } FILE * nw_fopen(const char *filename, const char *mode) { - return (fopen(filename, mode)); + return (fopen(filename, mode)); } int nw_fputc(int c, FILE *pf) { - if(pf) - return fputc(c,pf); - else - return -1; + if(pf) + return fputc(c,pf); + else + return -1; } int nw_fputs(const char *s, FILE *pf) { - if(pf) - return fputs(s, pf); - else - return -1; + if(pf) + return fputs(s, pf); + else + return -1; } size_t nw_fread(void *buf, size_t size, size_t count, FILE *fp) { - if(fp) - return fread(buf, size, count, fp); - else - return -1; + if(fp) + return fread(buf, size, count, fp); + else + return -1; } FILE * nw_freopen(const char *path, const char *mode, FILE *stream) { - if(stream) - return freopen(path, mode, stream); - else - return NULL; + if(stream) + return freopen(path, mode, stream); + else + return NULL; } int nw_fseek(FILE *pf, long offset, int origin) { - if(pf) - return (fseek(pf, offset, origin)); - else - return -1; + if(pf) + return (fseek(pf, offset, origin)); + else + return -1; } int nw_fsetpos(FILE *pf, const fpos_t *p) { - if(pf) - return fsetpos(pf, p); - else - return -1; + if(pf) + return fsetpos(pf, p); + else + return -1; } long nw_ftell(FILE *pf) { - if(pf) - return ftell(pf); - else - return -1; + if(pf) + return ftell(pf); + else + return -1; } size_t nw_fwrite(const void *buf, size_t size, size_t count, FILE *fp) { - if(fp) - return fwrite(buf, size, count, fp); - else - return -1; + if(fp) + return fwrite(buf, size, count, fp); + else + return -1; } long nw_get_osfhandle(int fd) { - return 0l; + return 0l; } int nw_getc(FILE *pf) { - if(pf) - return getc(pf); - else - return -1; + if(pf) + return getc(pf); + else + return -1; } int nw_putc(int c, FILE *pf) { - if(pf) - return putc(c,pf); - else - return -1; + if(pf) + return putc(c,pf); + else + return -1; } int nw_fgetc(FILE *pf) { - if(pf) - return fgetc(pf); - else - return -1; + if(pf) + return fgetc(pf); + else + return -1; } int nw_getpid(void) { - return GetThreadGroupID(); + return GetThreadGroupID(); } int nw_kill(int pid, int sig) { - return 0; + return 0; } int nw_link(const char *oldname, const char *newname) { - return 0; + return 0; } long @@ -569,165 +569,165 @@ nw_rmdir(const char *dir) DIR * nw_opendir(const char *filename) { - char *buff = NULL; - int len = 0; - DIR *ret = NULL; - - len = strlen(filename); - buff = malloc(len + 5); - if (buff) { - strcpy(buff, filename); - if (buff[len-1]=='/' || buff[len-1]=='\\') { - buff[--len] = 0; - } - strcpy(buff+len, "/*.*"); - ret = opendir(buff); - free (buff); - buff = NULL; - return ret; - } else { - return NULL; - } + char *buff = NULL; + int len = 0; + DIR *ret = NULL; + + len = strlen(filename); + buff = malloc(len + 5); + if (buff) { + strcpy(buff, filename); + if (buff[len-1]=='/' || buff[len-1]=='\\') { + buff[--len] = 0; + } + strcpy(buff+len, "/*.*"); + ret = opendir(buff); + free (buff); + buff = NULL; + return ret; + } else { + return NULL; + } } int nw_open(const char *path, int flag, ...) { - va_list ap; - int pmode = -1; + va_list ap; + int pmode = -1; - va_start(ap, flag); + va_start(ap, flag); pmode = va_arg(ap, int); va_end(ap); - if (stricmp(path, "/dev/null")==0) - path = "NWNUL"; + if (stricmp(path, "/dev/null")==0) + path = "NWNUL"; - return open(path, flag, pmode); + return open(path, flag, pmode); } int nw_open_osfhandle(long handle, int flags) { - return 0; + return 0; } unsigned long nw_os_id(void) { - return 0l; + return 0l; } int nw_Pipe(int* a, int* e) { - int ret = 0; + int ret = 0; - errno = 0; - ret = pipe(a); - if(errno) - e = &errno; + errno = 0; + ret = pipe(a); + if(errno) + e = &errno; - return ret; + return ret; } FILE* nw_Popen(char* command, char* mode, int* e) { - int i = -1; - - FILE* ret = NULL; - PTEMPPIPEFILE ptpf = NULL; - - // this callback is supposed to call _popen, which spawns an - // asynchronous command and opens a pipe to it. The returned - // file handle can be read or written to; if read, it represents - // stdout of the called process and will return EOF when the - // called process finishes. If written to, it represents stdin - // of the called process. Naturally _popen is not available on - // NetWare so we must do some fancy stuff to simulate it. We will - // redirect to and from temp files; this has the side effect - // of having to run the process synchronously rather than - // asynchronously. This means that you will only be able to do - // this with CLIB NLMs built to run on the calling thread. - - errno = 0; - - ptpf1[iPopenCount] = (PTEMPPIPEFILE) malloc(sizeof(TEMPPIPEFILE)); - if (!ptpf1[iPopenCount]) - return NULL; - - ptpf = ptpf1[iPopenCount]; - iPopenCount ++; - if(iPopenCount > MAX_PIPE_RECURSION) - iPopenCount = MAX_PIPE_RECURSION; // Limit to the max no of pipes to be open recursively. - - fnTempPipeFile(ptpf); - ret = fnPipeFileOpen((PTEMPPIPEFILE) ptpf, (char *) command, (char *) mode); - if (ret) - File1[iPopenCount-1] = ret; // Store the obtained Pipe file handle. - else - { // Pipe file not obtained. So free the allocated memory. - if(ptpf1[iPopenCount-1]) - { - free(ptpf1[iPopenCount-1]); - ptpf1[iPopenCount-1] = NULL; - ptpf = NULL; - iPopenCount --; - } - } - - if (errno) - e = &errno; - - return ret; + int i = -1; + + FILE* ret = NULL; + PTEMPPIPEFILE ptpf = NULL; + + // this callback is supposed to call _popen, which spawns an + // asynchronous command and opens a pipe to it. The returned + // file handle can be read or written to; if read, it represents + // stdout of the called process and will return EOF when the + // called process finishes. If written to, it represents stdin + // of the called process. Naturally _popen is not available on + // NetWare so we must do some fancy stuff to simulate it. We will + // redirect to and from temp files; this has the side effect + // of having to run the process synchronously rather than + // asynchronously. This means that you will only be able to do + // this with CLIB NLMs built to run on the calling thread. + + errno = 0; + + ptpf1[iPopenCount] = (PTEMPPIPEFILE) malloc(sizeof(TEMPPIPEFILE)); + if (!ptpf1[iPopenCount]) + return NULL; + + ptpf = ptpf1[iPopenCount]; + iPopenCount ++; + if(iPopenCount > MAX_PIPE_RECURSION) + iPopenCount = MAX_PIPE_RECURSION; // Limit to the max no of pipes to be open recursively. + + fnTempPipeFile(ptpf); + ret = fnPipeFileOpen((PTEMPPIPEFILE) ptpf, (char *) command, (char *) mode); + if (ret) + File1[iPopenCount-1] = ret; // Store the obtained Pipe file handle. + else + { // Pipe file not obtained. So free the allocated memory. + if(ptpf1[iPopenCount-1]) + { + free(ptpf1[iPopenCount-1]); + ptpf1[iPopenCount-1] = NULL; + ptpf = NULL; + iPopenCount --; + } + } + + if (errno) + e = &errno; + + return ret; } int nw_Pclose(FILE* file, int* e) { - int i=0, j=0; + int i=0, j=0; - errno = 0; + errno = 0; - if(file) - { - if(iPopenCount > 0) - { - for (i=0; i 0) + { + for (i=0; i': - case '<': - case '|': - if (!inquote) - return TRUE; - default: - break; - } - ++ptr; + switch(*ptr) { + case '%': + return TRUE; + case '\'': + case '\"': + if (inquote) { + if (quote == *ptr) { + inquote = 0; + quote = '\0'; + } + } + else { + quote = *ptr; + inquote++; + } + break; + case '>': + case '<': + case '|': + if (!inquote) + return TRUE; + default: + break; + } + ++ptr; } return FALSE; } @@ -1110,7 +1110,7 @@ has_shell_metachars(char *ptr) int fork(void) { - return 0; + return 0; } @@ -1118,5 +1118,5 @@ fork(void) int Perl_Ireentrant_buffer_ptr(aTHX) { - return 0; + return 0; } diff --git a/NetWare/nw5sck.c b/NetWare/nw5sck.c index 35dee92bf123..217313e2238f 100644 --- a/NetWare/nw5sck.c +++ b/NetWare/nw5sck.c @@ -57,50 +57,50 @@ nw_ntohs(u_short netshort) SOCKET nw_accept(SOCKET s, struct sockaddr *addr, int *addrlen) { - return ((SOCKET)(accept(s, addr, addrlen))); + return ((SOCKET)(accept(s, addr, addrlen))); } int nw_bind(SOCKET s, const struct sockaddr *addr, int addrlen) { - return ((int)bind(s, (struct sockaddr *)addr, addrlen)); + return ((int)bind(s, (struct sockaddr *)addr, addrlen)); } int nw_connect(SOCKET s, const struct sockaddr *addr, int addrlen) { - return((int)connect(s, (struct sockaddr *)addr, addrlen)); + return((int)connect(s, (struct sockaddr *)addr, addrlen)); } void nw_endhostent() { - endhostent(); + endhostent(); } void nw_endnetent() { - endnetent(); + endnetent(); } void nw_endprotoent() { - endprotoent(); + endprotoent(); } void nw_endservent() { - endservent(); + endservent(); } struct hostent * nw_gethostent() { - return(gethostent()); + return(gethostent()); } struct netent * @@ -118,7 +118,7 @@ nw_getprotoent(void) struct hostent * nw_gethostbyname(const char *name) { - return(gethostbyname((char*)name)); + return(gethostbyname((char*)name)); } int @@ -130,13 +130,13 @@ nw_gethostname(char *name, int len) struct hostent * nw_gethostbyaddr(const char *addr, int len, int type) { - return(gethostbyaddr((char*)addr, len, type)); + return(gethostbyaddr((char*)addr, len, type)); } struct netent * nw_getnetbyaddr(long net, int type) { - return(getnetbyaddr(net,type)); + return(getnetbyaddr(net,type)); } struct netent * @@ -148,19 +148,19 @@ nw_getnetbyname(char *name) int nw_getpeername(SOCKET s, struct sockaddr *addr, int *addrlen) { - return((int)getpeername(s, addr, addrlen)); + return((int)getpeername(s, addr, addrlen)); } struct protoent * nw_getprotobyname(const char *name) { - return ((struct protoent *)getprotobyname((char*)name)); + return ((struct protoent *)getprotobyname((char*)name)); } struct protoent * nw_getprotobynumber(int num) { - return ((struct protoent *)getprotobynumber(num)); + return ((struct protoent *)getprotobynumber(num)); } struct servent * @@ -186,7 +186,7 @@ void nw_sethostent(int stayopen) { #ifdef HAS_SETHOSTENT - sethostent(stayopen); + sethostent(stayopen); #endif } @@ -194,7 +194,7 @@ void nw_setnetent(int stayopen) { #ifdef HAS_SETNETENT - setnetent(stayopen); + setnetent(stayopen); #endif } @@ -202,7 +202,7 @@ void nw_setprotoent(int stayopen) { #ifdef HAS_SETPROTENT - setprotoent(stayopen); + setprotoent(stayopen); #endif } @@ -210,26 +210,26 @@ void nw_setservent(int stayopen) { #ifdef HAS_SETSERVENT - setservent(stayopen); + setservent(stayopen); #endif } int nw_setsockopt(SOCKET s, int level, int optname, const char* optval, int optlen) { - return setsockopt(s, level, optname, (char*)optval, optlen); + return setsockopt(s, level, optname, (char*)optval, optlen); } int nw_getsockname(SOCKET s, struct sockaddr *addr, int *addrlen) { - return getsockname(s, addr, addrlen); + return getsockname(s, addr, addrlen); } int nw_getsockopt(SOCKET s, int level, int optname, char *optval, int *optlen) { - return ((int)getsockopt(s, level, optname, optval, optlen)); + return ((int)getsockopt(s, level, optname, optval, optlen)); } unsigned long @@ -253,9 +253,9 @@ nw_socket(int af, int type, int protocol) s = socket(af, type, protocol); #else if((s = socket(af, type, protocol)) == INVALID_SOCKET) - //errno = WSAGetLastError(); + //errno = WSAGetLastError(); else - s = s; + s = s; #endif /* USE_SOCKETS_AS_HANDLES */ return s; @@ -270,18 +270,18 @@ nw_listen(SOCKET s, int backlog) int nw_send(SOCKET s, const char *buf, int len, int flags) { - return(send(s,(char*)buf,len,flags)); + return(send(s,(char*)buf,len,flags)); } int nw_recv(SOCKET s, char *buf, int len, int flags) { - return (recv(s, buf, len, flags)); + return (recv(s, buf, len, flags)); } int nw_sendto(SOCKET s, const char *buf, int len, int flags, - const struct sockaddr *to, int tolen) + const struct sockaddr *to, int tolen) { return(sendto(s, (char*)buf, len, flags, (struct sockaddr *)to, tolen)); } @@ -293,16 +293,16 @@ nw_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, int int frombufsize = *fromlen; r = recvfrom(s, buf, len, flags, from, fromlen); - //Not sure if the is required - chksgp + //Not sure if the is required - chksgp if (r && frombufsize == *fromlen) - (void)nw_getpeername(s, from, fromlen); + (void)nw_getpeername(s, from, fromlen); return r; } int nw_select(int nfds, fd_set* rd, fd_set* wr, fd_set* ex, const struct timeval* timeout) { - return(select(nfds, rd, wr, ex, (struct timeval*)timeout)); + return(select(nfds, rd, wr, ex, (struct timeval*)timeout)); } int diff --git a/NetWare/nw5thread.c b/NetWare/nw5thread.c index abedb5c2da1f..3b9d8304de4d 100644 --- a/NetWare/nw5thread.c +++ b/NetWare/nw5thread.c @@ -36,7 +36,7 @@ Perl_set_context(void *t) # ifdef USE_DECLSPEC_THREAD Perl_current_context = t; # else - fnAddThreadCtx(PL_thr_key, t); + fnAddThreadCtx(PL_thr_key, t); # endif #endif } @@ -49,7 +49,7 @@ Perl_get_context(void) # ifdef USE_DECLSPEC_THREAD return Perl_current_context; # else - return(fnGetThreadCtx(PL_thr_key)); + return(fnGetThreadCtx(PL_thr_key)); # endif #else return NULL; @@ -63,12 +63,12 @@ Remove_Thread_Ctx(void) { #if defined(USE_ITHREADS) # ifdef USE_DECLSPEC_THREAD - return TRUE; + return TRUE; # else - return(fnRemoveThreadCtx(PL_thr_key)); + return(fnRemoveThreadCtx(PL_thr_key)); # endif # else - return TRUE; + return TRUE; #endif } diff --git a/NetWare/nw5thread.h b/NetWare/nw5thread.h index e7d86757ee3a..40cbdc3aac70 100644 --- a/NetWare/nw5thread.h +++ b/NetWare/nw5thread.h @@ -37,10 +37,10 @@ typedef struct nw_cond { long waiters; unsigned int sem; } perl_cond; extern "C" { #endif - #include - #include - #define kSUCCESS (0) - #define ERROR_INVALID_MUTEX (0x1010) + #include + #include + #define kSUCCESS (0) + #define ERROR_INVALID_MUTEX (0x1010) #ifdef __cplusplus } @@ -55,34 +55,34 @@ extern "C" typedef MUTEX perl_mutex; # define MUTEX_INIT(m) \ STMT_START { \ - /*if ((*(m) = kMutexAlloc("NetWarePerlMutex")) == NULL) */\ - /*Perl_croak_nocontext("panic: MUTEX_ALLOC"); */\ - /*ConsolePrintf("Mutex Init %d\n",*(m)); */\ + /*if ((*(m) = kMutexAlloc("NetWarePerlMutex")) == NULL) */\ + /*Perl_croak_nocontext("panic: MUTEX_ALLOC"); */\ + /*ConsolePrintf("Mutex Init %d\n",*(m)); */\ } STMT_END # define MUTEX_LOCK(m) \ STMT_START { \ - /*ConsolePrintf("Mutex lock %d\n",*(m)); */\ - /*if (kMutexLock(*(m)) == ERROR_INVALID_MUTEX) */\ - /*Perl_croak_nocontext("panic: MUTEX_LOCK"); */\ + /*ConsolePrintf("Mutex lock %d\n",*(m)); */\ + /*if (kMutexLock(*(m)) == ERROR_INVALID_MUTEX) */\ + /*Perl_croak_nocontext("panic: MUTEX_LOCK"); */\ } STMT_END # define MUTEX_UNLOCK(m) \ STMT_START { \ - /*ConsolePrintf("Mutex unlock %d\n",*(m)); */\ - /*if (kMutexUnlock(*(m)) != kSUCCESS) \ - Perl_croak_nocontext("panic: MUTEX_UNLOCK"); */\ + /*ConsolePrintf("Mutex unlock %d\n",*(m)); */\ + /*if (kMutexUnlock(*(m)) != kSUCCESS) \ + Perl_croak_nocontext("panic: MUTEX_UNLOCK"); */\ } STMT_END # define MUTEX_DESTROY(m) \ STMT_START { \ - /*ConsolePrintf("Mutex Destroy %d\n",*(m)); */\ - /*if (kMutexWaitCount(*(m)) == 0 ) */\ - /*{ */\ - /*PERL_SET_INTERP(NULL); *//*newly added CHKSGP???*/ \ - /*if (kMutexFree(*(m)) != kSUCCESS) */ \ - /*Perl_croak_nocontext("panic: MUTEX_FREE"); */\ - /*} */\ + /*ConsolePrintf("Mutex Destroy %d\n",*(m)); */\ + /*if (kMutexWaitCount(*(m)) == 0 ) */\ + /*{ */\ + /*PERL_SET_INTERP(NULL); *//*newly added CHKSGP???*/ \ + /*if (kMutexFree(*(m)) != kSUCCESS) */ \ + /*Perl_croak_nocontext("panic: MUTEX_FREE"); */\ + /*} */\ } STMT_END #else @@ -100,56 +100,56 @@ typedef unsigned long perl_mutex; //For now let us just see when this happens -sgp. #define COND_INIT(c) \ STMT_START { \ - /*ConsolePrintf("In COND_INIT\n"); */\ + /*ConsolePrintf("In COND_INIT\n"); */\ } STMT_END /* (c)->waiters = 0; \ - (c)->sem = OpenLocalSemaphore (0); \ - if ((c)->sem == NULL) \ - Perl_croak_nocontext("panic: COND_INIT (%ld)",errno); \*/ + (c)->sem = OpenLocalSemaphore (0); \ + if ((c)->sem == NULL) \ + Perl_croak_nocontext("panic: COND_INIT (%ld)",errno); \*/ #define COND_SIGNAL(c) \ STMT_START { \ - /*ConsolePrintf("In COND_SIGNAL\n"); */\ + /*ConsolePrintf("In COND_SIGNAL\n"); */\ } STMT_END /*if ((c)->waiters > 0 && \ - SignalLocalSemaphore((c)->sem) != 0) \ - Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",errno); \*/ + SignalLocalSemaphore((c)->sem) != 0) \ + Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",errno); \*/ #define COND_BROADCAST(c) \ STMT_START { \ - /*ConsolePrintf("In COND_BROADCAST\n"); */\ + /*ConsolePrintf("In COND_BROADCAST\n"); */\ } STMT_END - /*if ((c)->waiters > 0 ) { \ - int count; \ - for(count=0; count<(c)->waiters; count++) { \ - if(SignalLocalSemaphore((c)->sem) != 0) \ - Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\ - } \ - } \*/ + /*if ((c)->waiters > 0 ) { \ + int count; \ + for(count=0; count<(c)->waiters; count++) { \ + if(SignalLocalSemaphore((c)->sem) != 0) \ + Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\ + } \ + } \*/ #define COND_WAIT(c, m) \ STMT_START { \ - /*ConsolePrintf("In COND_WAIT\n"); */\ + /*ConsolePrintf("In COND_WAIT\n"); */\ } STMT_END #define COND_DESTROY(c) \ STMT_START { \ - /*ConsolePrintf("In COND_DESTROY\n"); */\ + /*ConsolePrintf("In COND_DESTROY\n"); */\ } STMT_END /* (c)->waiters = 0; \ - if (CloseLocalSemaphore((c)->sem) != 0) \ - Perl_croak_nocontext("panic: COND_DESTROY (%ld)",errno); \*/ + if (CloseLocalSemaphore((c)->sem) != 0) \ + Perl_croak_nocontext("panic: COND_DESTROY (%ld)",errno); \*/ #if 0 #define DETACH(t) \ STMT_START { \ - if (CloseHandle((t)->self) == 0) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH"); \ - } \ + if (CloseHandle((t)->self) == 0) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH"); \ + } \ } STMT_END #endif //#if 0 @@ -172,7 +172,7 @@ extern __declspec(thread) void *PL_current_context; //See the comment at the end of file nw5thread.c as to why PL_thr_key is not assigned - sgp #define ALLOC_THREAD_KEY \ STMT_START { \ - fnInitializeThreadCtx(); \ + fnInitializeThreadCtx(); \ } STMT_END diff --git a/NetWare/nwhashcls.h b/NetWare/nwhashcls.h index 55ff20022036..ba18053ee2b1 100644 --- a/NetWare/nwhashcls.h +++ b/NetWare/nwhashcls.h @@ -22,8 +22,8 @@ struct HASHNODE { - void *data; - struct HASHNODE *next; + void *data; + struct HASHNODE *next; }; typedef void (*HASHFORALLFUN)(void *, void *); @@ -31,22 +31,22 @@ typedef void (*HASHFORALLFUN)(void *, void *); class NWPerlHashList { private: - HASHNODE* MemListHash[BUCKET_SIZE]; + HASHNODE* MemListHash[BUCKET_SIZE]; void removeAll() const; public: - ~NWPerlHashList(); - NWPerlHashList(); - int insert(void *lData); - int remove(void *lData); + ~NWPerlHashList(); + NWPerlHashList(); + int insert(void *lData); + int remove(void *lData); void forAll( void (*)(void *, void*), void * ) const; }; struct KEYHASHNODE { - void *key; - void *data; - KEYHASHNODE *next; + void *key; + void *data; + KEYHASHNODE *next; }; /** @@ -55,16 +55,16 @@ typedef void (*KEYHASHFORALLFUN)(void *, void *); class NWPerlKeyHashList { private: - KEYHASHNODE* MemListHash[BUCKET_SIZE]; + KEYHASHNODE* MemListHash[BUCKET_SIZE]; void removeAll() const; public: - ~NWPerlKeyHashList(); - NWPerlKeyHashList(); - int insert(void *key, void *lData); - int remove(void *key); + ~NWPerlKeyHashList(); + NWPerlKeyHashList(); + int insert(void *key, void *lData); + int remove(void *key); void forAll( void (*)(void *, void*), void * ) const; - int find(void *key, void **pData); + int find(void *key, void **pData); }; **/ diff --git a/NetWare/nwperlhost.h b/NetWare/nwperlhost.h index c69e554489b0..e011bd351ff5 100644 --- a/NetWare/nwperlhost.h +++ b/NetWare/nwperlhost.h @@ -52,10 +52,10 @@ class CPerlHost public: CPerlHost(void); CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc); + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc); CPerlHost(const CPerlHost& host); virtual ~CPerlHost(void); @@ -73,21 +73,21 @@ class CPerlHost inline void* Malloc(size_t size) { return m_pVMem->Malloc(size); }; inline void* Realloc(void* ptr, size_t size) { return m_pVMem->Realloc(ptr, size); }; inline void Free(void* ptr) { m_pVMem->Free(ptr); }; - inline void* Calloc(size_t num, size_t size){ return m_pVMem->Calloc(num, size); }; + inline void* Calloc(size_t num, size_t size){ return m_pVMem->Calloc(num, size); }; /* IPerlMemShared */ inline void* MallocShared(size_t size) { - return m_pVMemShared->Malloc(size); + return m_pVMemShared->Malloc(size); }; inline void* ReallocShared(void* ptr, size_t size) { return m_pVMemShared->Realloc(ptr, size); }; inline void FreeShared(void* ptr) { m_pVMemShared->Free(ptr); }; inline void* CallocShared(size_t num, size_t size) { - size_t count = num*size; - void* lpVoid = MallocShared(count); + size_t count = num*size; + void* lpVoid = MallocShared(count); - return lpVoid; + return lpVoid; }; /* IPerlMemParse */ @@ -96,10 +96,10 @@ class CPerlHost inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); }; inline void* CallocParse(size_t num, size_t size) { - size_t count = num*size; - void* lpVoid = MallocParse(count); + size_t count = num*size; + void* lpVoid = MallocParse(count); - return lpVoid; + return lpVoid; }; /* IPerlEnv */ @@ -107,11 +107,11 @@ class CPerlHost int Putenv(const char *envstring); inline char *Getenv(const char *varname, unsigned long *len) { - *len = 0; - char *e = Getenv(varname); - if (e) - *len = strlen(e); - return e; + *len = 0; + char *e = Getenv(varname); + if (e) + *len = strlen(e); + return e; } @@ -341,33 +341,33 @@ PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name) void PerlEnvClearenv(struct IPerlEnv* piPerl) { - // If removed, compilation fails while compiling CGI2Perl. + // If removed, compilation fails while compiling CGI2Perl. } void* PerlEnvGetChildenv(struct IPerlEnv* piPerl) { - // If removed, compilation fails while compiling CGI2Perl. - return NULL; + // If removed, compilation fails while compiling CGI2Perl. + return NULL; } void PerlEnvFreeChildenv(struct IPerlEnv* piPerl, void* childEnv) { - // If removed, compilation fails while compiling CGI2Perl. + // If removed, compilation fails while compiling CGI2Perl. } char* PerlEnvGetChilddir(struct IPerlEnv* piPerl) { - // If removed, compilation fails while compiling CGI2Perl. - return NULL; + // If removed, compilation fails while compiling CGI2Perl. + return NULL; } void PerlEnvFreeChilddir(struct IPerlEnv* piPerl, char* childDir) { - // If removed, compilation fails while compiling CGI2Perl. + // If removed, compilation fails while compiling CGI2Perl. } struct IPerlEnv perlEnv = @@ -636,7 +636,7 @@ PerlStdIOSetpos(struct IPerlStdIO* piPerl, PerlIO* pf, const Fpos_t *p) void PerlStdIOInit(struct IPerlStdIO* piPerl) { - // If removed, compilation error occurs. + // If removed, compilation error occurs. } void @@ -668,17 +668,17 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf) /* open the file in the same mode */ if(((FILE*)pf)->_flag & _IOREAD) { - mode[0] = 'r'; - mode[1] = 0; + mode[0] = 'r'; + mode[1] = 0; } else if(((FILE*)pf)->_flag & _IOWRT) { - mode[0] = 'a'; - mode[1] = 0; + mode[0] = 'a'; + mode[1] = 0; } else if(((FILE*)pf)->_flag & _IORW) { - mode[0] = 'r'; - mode[1] = '+'; - mode[2] = 0; + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; } /* it appears that the binmode is attached to the @@ -689,7 +689,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, PerlIO* pf) /* move the file pointer to the same position */ if (!fgetpos((FILE*)pf, &pos)) { - fsetpos((FILE*)pfdup, &pos); + fsetpos((FILE*)pfdup, &pos); } return pfdup; } @@ -757,14 +757,14 @@ PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode) int PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size) { - return (nw_chsize(handle,size)); + return (nw_chsize(handle,size)); } int @@ -788,7 +788,7 @@ PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2) int PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) { - //On NetWare simulate flock by locking a range on the file + //On NetWare simulate flock by locking a range on the file return nw_flock(fd, oper); } @@ -801,8 +801,8 @@ PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) int PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int @@ -832,7 +832,7 @@ PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) char* PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template) { - return(nw_mktemp(Template)); + return(nw_mktemp(Template)); } int @@ -939,37 +939,37 @@ struct IPerlLIO perlLIO = int PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode) { - return mkdir(dirname); + return mkdir(dirname); } int PerlDirChdir(struct IPerlDir* piPerl, const char *dirname) { - return nw_chdir(dirname); + return nw_chdir(dirname); } int PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname) { - return nw_rmdir(dirname); + return nw_rmdir(dirname); } int PerlDirClose(struct IPerlDir* piPerl, DIR *dirp) { - return nw_closedir(dirp); + return nw_closedir(dirp); } DIR* PerlDirOpen(struct IPerlDir* piPerl, const char *filename) { - return nw_opendir(filename); + return nw_opendir(filename); } struct direct * PerlDirRead(struct IPerlDir* piPerl, DIR *dirp) { - return nw_readdir(dirp); + return nw_readdir(dirp); } void @@ -1008,42 +1008,42 @@ struct IPerlDir perlDir = u_long PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong) { - return(nw_htonl(hostlong)); + return(nw_htonl(hostlong)); } u_short PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort) { - return(nw_htons(hostshort)); + return(nw_htons(hostshort)); } u_long PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong) { - return nw_ntohl(netlong); + return nw_ntohl(netlong); } u_short PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort) { - return nw_ntohs(netshort); + return nw_ntohs(netshort); } SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen) { - return nw_accept(s, addr, addrlen); + return nw_accept(s, addr, addrlen); } int PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) { - return nw_bind(s, name, namelen); + return nw_bind(s, name, namelen); } int PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) { - return nw_connect(s, name, namelen); + return nw_connect(s, name, namelen); } void @@ -1073,7 +1073,7 @@ PerlSockEndservent(struct IPerlSock* piPerl) struct hostent* PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type) { - return(nw_gethostbyaddr(addr,len,type)); + return(nw_gethostbyaddr(addr,len,type)); } struct hostent* @@ -1085,13 +1085,13 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) struct hostent* PerlSockGethostent(struct IPerlSock* piPerl) { - return(nw_gethostent()); + return(nw_gethostent()); } int PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen) { - return nw_gethostname(name,namelen); + return nw_gethostname(name,namelen); } struct netent * @@ -1144,31 +1144,31 @@ PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* pr struct servent* PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto) { - return nw_getservbyport(port, proto); + return nw_getservbyport(port, proto); } struct servent* PerlSockGetservent(struct IPerlSock* piPerl) { - return nw_getservent(); + return nw_getservent(); } int PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) { - return nw_getsockname(s, name, namelen); + return nw_getsockname(s, name, namelen); } int PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen) { - return nw_getsockopt(s, level, optname, optval, optlen); + return nw_getsockopt(s, level, optname, optval, optlen); } unsigned long PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp) { - return(nw_inet_addr(cp)); + return(nw_inet_addr(cp)); } char* @@ -1180,79 +1180,79 @@ PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in) int PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog) { - return (nw_listen(s, backlog)); + return (nw_listen(s, backlog)); } int PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags) { - return (nw_recv(s, buffer, len, flags)); + return (nw_recv(s, buffer, len, flags)); } int PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) { - return nw_recvfrom(s, buffer, len, flags, from, fromlen); + return nw_recvfrom(s, buffer, len, flags, from, fromlen); } int PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) { - return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); + return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); } int PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags) { - return (nw_send(s, buffer, len, flags)); + return (nw_send(s, buffer, len, flags)); } int PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) { - return(nw_sendto(s, buffer, len, flags, to, tolen)); + return(nw_sendto(s, buffer, len, flags, to, tolen)); } void PerlSockSethostent(struct IPerlSock* piPerl, int stayopen) { - nw_sethostent(stayopen); + nw_sethostent(stayopen); } void PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen) { - nw_setnetent(stayopen); + nw_setnetent(stayopen); } void PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen) { - nw_setprotoent(stayopen); + nw_setprotoent(stayopen); } void PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) { - nw_setservent(stayopen); + nw_setservent(stayopen); } int PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) { - return nw_setsockopt(s, level, optname, optval, optlen); + return nw_setsockopt(s, level, optname, optval, optlen); } int PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how) { - return nw_shutdown(s, how); + return nw_shutdown(s, how); } SOCKET PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) { - return nw_socket(af, type, protocol); + return nw_socket(af, type, protocol); } int @@ -1266,9 +1266,9 @@ PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp) { - dTHX; // (J) dTHXo + dTHX; // (J) dTHXo Perl_croak(aTHX_ "ioctlsocket not implemented!\n"); - return 0; + return 0; } struct IPerlSock perlSock = @@ -1301,8 +1301,8 @@ struct IPerlSock perlSock = PerlSockGetsockname, PerlSockGetsockopt, PerlSockInetAddr, - PerlSockInetNtoa, - PerlSockListen, + PerlSockInetNtoa, + PerlSockListen, PerlSockRecv, PerlSockRecvfrom, PerlSockSelect, @@ -1314,9 +1314,9 @@ struct IPerlSock perlSock = PerlSockSetservent, PerlSockSetsockopt, PerlSockShutdown, - PerlSockSocket, + PerlSockSocket, PerlSockSocketpair, - //Following commented by sgp bcos of comiplation error too many initializers (E279) + //Following commented by sgp bcos of comiplation error too many initializers (E279) // PerlSockClosesocket, }; @@ -1342,25 +1342,25 @@ void PerlProcExit(struct IPerlProc* piPerl, int status) { // exit(status); - dTHX; - //dJMPENV; - JMPENV_JUMP(2); + dTHX; + //dJMPENV; + JMPENV_JUMP(2); } void PerlProc_Exit(struct IPerlProc* piPerl, int status) { // _exit(status); - dTHX; - //dJMPENV; - JMPENV_JUMP(2); + dTHX; + //dJMPENV; + JMPENV_JUMP(2); } int PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int @@ -1378,36 +1378,36 @@ PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const uid_t PerlProcGetuid(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } uid_t PerlProcGeteuid(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } gid_t PerlProcGetgid(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } gid_t PerlProcGetegid(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } char * PerlProcGetlogin(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return NULL; + // If removed, compilation error occurs. + return NULL; } int @@ -1436,7 +1436,7 @@ PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) dTHX; // (J) dTHXo PERL_FLUSHALL_FOR_CHILD; - return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); + return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); } int @@ -1454,15 +1454,15 @@ PerlProcPipe(struct IPerlProc* piPerl, int *phandles) int PerlProcSetuid(struct IPerlProc* piPerl, uid_t u) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int PerlProcSetgid(struct IPerlProc* piPerl, gid_t g) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int @@ -1492,15 +1492,15 @@ PerlProcWaitpid(struct IPerlProc* piPerl, int pid, int *status, int flags) Sighandler_t PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) { - // If removed, compilation error occurs. + // If removed, compilation error occurs. return 0; } int PerlProcFork(struct IPerlProc* piPerl) { - // If removed, compilation error occurs. - return 0; + // If removed, compilation error occurs. + return 0; } int @@ -1582,8 +1582,8 @@ CPerlHost::CPerlHost(void) m_pVMemShared = new VMem(); m_pVMemParse = new VMem(); - memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); - memcpy(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); + memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); + memcpy(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); memcpy(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); memcpy(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); memcpy(&m_hostperlStdIO, &perlStdIO, sizeof(perlStdIO)); @@ -1605,26 +1605,26 @@ CPerlHost::CPerlHost(void) #define SETUPEXCHANGE(xptr, iptr, table) \ STMT_START { \ - if (xptr) { \ - iptr = *xptr; \ - *xptr = &table; \ - } \ - else { \ - iptr = &table; \ - } \ + if (xptr) { \ + iptr = *xptr; \ + *xptr = &table; \ + } \ + else { \ + iptr = &table; \ + } \ } STMT_END CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc) + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) { m_pVMem = new VMem(); m_pVMemShared = new VMem(); m_pVMemParse = new VMem(); - memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); + memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); memcpy(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); memcpy(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); memcpy(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); @@ -1648,7 +1648,7 @@ CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, CPerlHost::CPerlHost(const CPerlHost& host) { - memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); + memcpy(&m_hostperlMem, &perlMem, sizeof(perlMem)); memcpy(&m_hostperlMemShared, &perlMemShared, sizeof(perlMemShared)); memcpy(&m_hostperlMemParse, &perlMemParse, sizeof(perlMemParse)); memcpy(&m_hostperlEnv, &perlEnv, sizeof(perlEnv)); @@ -1672,26 +1672,26 @@ CPerlHost::CPerlHost(const CPerlHost& host) CPerlHost::~CPerlHost(void) { - if ( m_pVMemParse ) delete m_pVMemParse; - if ( m_pVMemShared ) delete m_pVMemShared; - if ( m_pVMem ) delete m_pVMem; + if ( m_pVMemParse ) delete m_pVMemParse; + if ( m_pVMemShared ) delete m_pVMemShared; + if ( m_pVMem ) delete m_pVMem; } char* CPerlHost::Getenv(const char *varname) { - // getenv is always present. In old CLIB, it is implemented - // to always return NULL. With java loaded on NW411, it will - // return values set by envset. Is correctly implemented by - // CLIB on MOAB. - // - return getenv(varname); + // getenv is always present. In old CLIB, it is implemented + // to always return NULL. With java loaded on NW411, it will + // return values set by envset. Is correctly implemented by + // CLIB on MOAB. + // + return getenv(varname); } int CPerlHost::Putenv(const char *envstring) { - return(putenv(envstring)); + return(putenv(envstring)); } diff --git a/NetWare/nwperlsys.c b/NetWare/nwperlsys.c index 32c15cb4380b..adc9abc75e92 100644 --- a/NetWare/nwperlsys.c +++ b/NetWare/nwperlsys.c @@ -34,10 +34,10 @@ Function : fnFreeMemEntry Description : Called for each outstanding memory allocation at the end of a script run. - Frees the outstanding allocations + Frees the outstanding allocations Parameters : ptr (IN). - context (IN) + context (IN) Returns : Nothing. @@ -45,10 +45,10 @@ void fnFreeMemEntry(void* ptr, void* context) { - if(ptr) - { - PerlMemFree(NULL, ptr); - } + if(ptr) + { + PerlMemFree(NULL, ptr); + } } /*============================================================================================ @@ -84,21 +84,21 @@ perl_alloc(void) { PerlInterpreter* my_perl = NULL; - WCValHashTable* m_allocList; - m_allocList = new WCValHashTable (fnAllocListHash, 256); - fnInsertHashListAddrs(m_allocList, FALSE); - my_perl = perl_alloc_using(&perlMem, - &perlMem, - NULL, - &perlEnv, - &perlStdIO, - &perlLIO, - &perlDir, - &perlSock, - &perlProc); - if (my_perl) { - //nw5_internal_host = m_allocList; - } + WCValHashTable* m_allocList; + m_allocList = new WCValHashTable (fnAllocListHash, 256); + fnInsertHashListAddrs(m_allocList, FALSE); + my_perl = perl_alloc_using(&perlMem, + &perlMem, + NULL, + &perlEnv, + &perlStdIO, + &perlLIO, + &perlDir, + &perlSock, + &perlProc); + if (my_perl) { + //nw5_internal_host = m_allocList; + } return my_perl; } @@ -115,72 +115,72 @@ perl_alloc(void) ==============================================================================================*/ EXTERN_C PerlInterpreter* perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc) + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) { PerlInterpreter *my_perl = NULL; - struct IPerlMem* lpMem; - struct IPerlEnv* lpEnv; - struct IPerlStdIO* lpStdio; - struct IPerlLIO* lpLIO; - struct IPerlDir* lpDir; - struct IPerlSock* lpSock; - struct IPerlProc* lpProc; - - WCValHashTable* m_allocList; - m_allocList = new WCValHashTable (fnAllocListHash, 256); - fnInsertHashListAddrs(m_allocList, FALSE); - - if (!ppMem) - lpMem=&perlMem; - else - lpMem=*ppMem; - - if (!ppEnv) - lpEnv=&perlEnv; - else - lpEnv=*ppEnv; - - if (!ppStdIO) - lpStdio=&perlStdIO; - else - lpStdio=*ppStdIO; - - if (!ppLIO) - lpLIO=&perlLIO; - else - lpLIO=*ppLIO; - - if (!ppDir) - lpDir=&perlDir; - else - lpDir=*ppDir; - - if (!ppSock) - lpSock=&perlSock; - else - lpSock=*ppSock; - - if (!ppProc) - lpProc=&perlProc; - else - lpProc=*ppProc; - my_perl = perl_alloc_using(lpMem, - lpMem, - NULL, - lpEnv, - lpStdio, - lpLIO, - lpDir, - lpSock, - lpProc); - - if (my_perl) { - //nw5_internal_host = pHost; - } + struct IPerlMem* lpMem; + struct IPerlEnv* lpEnv; + struct IPerlStdIO* lpStdio; + struct IPerlLIO* lpLIO; + struct IPerlDir* lpDir; + struct IPerlSock* lpSock; + struct IPerlProc* lpProc; + + WCValHashTable* m_allocList; + m_allocList = new WCValHashTable (fnAllocListHash, 256); + fnInsertHashListAddrs(m_allocList, FALSE); + + if (!ppMem) + lpMem=&perlMem; + else + lpMem=*ppMem; + + if (!ppEnv) + lpEnv=&perlEnv; + else + lpEnv=*ppEnv; + + if (!ppStdIO) + lpStdio=&perlStdIO; + else + lpStdio=*ppStdIO; + + if (!ppLIO) + lpLIO=&perlLIO; + else + lpLIO=*ppLIO; + + if (!ppDir) + lpDir=&perlDir; + else + lpDir=*ppDir; + + if (!ppSock) + lpSock=&perlSock; + else + lpSock=*ppSock; + + if (!ppProc) + lpProc=&perlProc; + else + lpProc=*ppProc; + my_perl = perl_alloc_using(lpMem, + lpMem, + NULL, + lpEnv, + lpStdio, + lpLIO, + lpDir, + lpSock, + lpProc); + + if (my_perl) { + //nw5_internal_host = pHost; + } return my_perl; } /*============================================================================================ @@ -198,19 +198,19 @@ perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, EXTERN_C void nw5_delete_internal_host(void *h) { - WCValHashTable* m_allocList; - void **listptr; - BOOL m_dontTouchHashLists; - if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - m_allocList = (WCValHashTable*)listptr; - fnInsertHashListAddrs(m_allocList, TRUE); - if (m_allocList) - { - m_allocList->forAll(fnFreeMemEntry, NULL); - fnInsertHashListAddrs(NULL, FALSE); - delete m_allocList; - } - } + WCValHashTable* m_allocList; + void **listptr; + BOOL m_dontTouchHashLists; + if (fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { + m_allocList = (WCValHashTable*)listptr; + fnInsertHashListAddrs(m_allocList, TRUE); + if (m_allocList) + { + m_allocList->forAll(fnFreeMemEntry, NULL); + fnInsertHashListAddrs(NULL, FALSE); + delete m_allocList; + } + } } #endif /* PERL_IMPLICIT_SYS */ diff --git a/NetWare/nwperlsys.h b/NetWare/nwperlsys.h index 3d82dd1c8dd5..34f713d28752 100644 --- a/NetWare/nwperlsys.h +++ b/NetWare/nwperlsys.h @@ -48,103 +48,103 @@ END_EXTERN_C void* PerlMemMalloc(struct IPerlMem* piPerl, size_t size) { - void *ptr = NULL; - ptr = malloc(size); - if (ptr) { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - if (listptr) { - WCValHashTable* m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->insert(ptr); - } - } - } - return(ptr); + void *ptr = NULL; + ptr = malloc(size); + if (ptr) { + void **listptr; + BOOL m_dontTouchHashLists; + if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { + if (listptr) { + WCValHashTable* m_allocList= (WCValHashTable*)listptr; + (WCValHashTable*)m_allocList->insert(ptr); + } + } + } + return(ptr); } void* PerlMemRealloc(struct IPerlMem* piPerl, void* ptr, size_t size) { - void *newptr = NULL; - WCValHashTable* m_allocList; + void *newptr = NULL; + WCValHashTable* m_allocList; - newptr = realloc(ptr, size); + newptr = realloc(ptr, size); - if (ptr) - { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->remove(ptr); - } - } - if (newptr) - { - if (m_allocList) - (WCValHashTable*)m_allocList->insert(newptr); - } + if (ptr) + { + void **listptr; + BOOL m_dontTouchHashLists; + if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { + m_allocList= (WCValHashTable*)listptr; + (WCValHashTable*)m_allocList->remove(ptr); + } + } + if (newptr) + { + if (m_allocList) + (WCValHashTable*)m_allocList->insert(newptr); + } - return(newptr); + return(newptr); } void PerlMemFree(struct IPerlMem* piPerl, void* ptr) { - BOOL m_dontTouchHashLists; - WCValHashTable* m_allocList; - - void **listptr; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - m_allocList= (WCValHashTable*)listptr; - // Final clean up, free all the nodes from the hash list - if (m_dontTouchHashLists) - { - if(ptr) - { - free(ptr); - ptr = NULL; - } - } - else - { - if(ptr && m_allocList) - { - if ((WCValHashTable*)m_allocList->remove(ptr)) - { - free(ptr); - ptr = NULL; - } - else - { - // If it comes here, that means that the memory pointer is not contained in the hash list. - // But no need to free now, since if is deleted here, it will result in an abend!! - // If the memory is still there, it will be cleaned during final cleanup anyway. - } - } - } - } - return; + BOOL m_dontTouchHashLists; + WCValHashTable* m_allocList; + + void **listptr; + if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { + m_allocList= (WCValHashTable*)listptr; + // Final clean up, free all the nodes from the hash list + if (m_dontTouchHashLists) + { + if(ptr) + { + free(ptr); + ptr = NULL; + } + } + else + { + if(ptr && m_allocList) + { + if ((WCValHashTable*)m_allocList->remove(ptr)) + { + free(ptr); + ptr = NULL; + } + else + { + // If it comes here, that means that the memory pointer is not contained in the hash list. + // But no need to free now, since if is deleted here, it will result in an abend!! + // If the memory is still there, it will be cleaned during final cleanup anyway. + } + } + } + } + return; } void* PerlMemCalloc(struct IPerlMem* piPerl, size_t num, size_t size) { - void *ptr = NULL; + void *ptr = NULL; - ptr = calloc(num, size); - if (ptr) { - void **listptr; - BOOL m_dontTouchHashLists; - if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { - if (listptr) { - WCValHashTable* m_allocList= (WCValHashTable*)listptr; - (WCValHashTable*)m_allocList->insert(ptr); - } - } - } - return(ptr); + ptr = calloc(num, size); + if (ptr) { + void **listptr; + BOOL m_dontTouchHashLists; + if(fnGetHashListAddrs(&listptr,&m_dontTouchHashLists)) { + if (listptr) { + WCValHashTable* m_allocList= (WCValHashTable*)listptr; + (WCValHashTable*)m_allocList->insert(ptr); + } + } + } + return(ptr); } struct IPerlMem perlMem = @@ -162,37 +162,37 @@ struct IPerlMem perlMem = int PerlDirMakedir(struct IPerlDir* piPerl, const char *dirname, int mode) { - return mkdir(dirname); + return mkdir(dirname); } int PerlDirChdir(struct IPerlDir* piPerl, const char *dirname) { - return nw_chdir(dirname); + return nw_chdir(dirname); } int PerlDirRmdir(struct IPerlDir* piPerl, const char *dirname) { - return nw_rmdir(dirname); + return nw_rmdir(dirname); } int PerlDirClose(struct IPerlDir* piPerl, DIR *dirp) { - return nw_closedir(dirp); + return nw_closedir(dirp); } DIR* PerlDirOpen(struct IPerlDir* piPerl, const char *filename) { - return nw_opendir(filename); + return nw_opendir(filename); } struct direct * PerlDirRead(struct IPerlDir* piPerl, DIR *dirp) { - return nw_readdir(dirp); + return nw_readdir(dirp); } void @@ -215,7 +215,7 @@ PerlDirTell(struct IPerlDir* piPerl, DIR *dirp) struct IPerlDir perlDir = { - PerlDirMakedir, + PerlDirMakedir, PerlDirChdir, PerlDirRmdir, PerlDirClose, @@ -233,23 +233,23 @@ struct IPerlDir perlDir = char* PerlEnvGetenv(struct IPerlEnv* piPerl, const char *varname) { - return(getenv(varname)); + return(getenv(varname)); }; int PerlEnvPutenv(struct IPerlEnv* piPerl, const char *envstring) { - return(putenv(envstring)); + return(putenv(envstring)); }; char* PerlEnvGetenv_len(struct IPerlEnv* piPerl, const char* varname, unsigned long* len) { - *len = 0; - char *e = getenv(varname); - if (e) - *len = strlen(e); - return e; + *len = 0; + char *e = getenv(varname); + if (e) + *len = strlen(e); + return e; } int @@ -261,13 +261,13 @@ PerlEnvUname(struct IPerlEnv* piPerl, struct utsname *name) void PerlEnvClearenv(struct IPerlEnv* piPerl) { - + } struct IPerlEnv perlEnv = { - PerlEnvGetenv, - PerlEnvPutenv, + PerlEnvGetenv, + PerlEnvPutenv, PerlEnvGetenv_len, PerlEnvUname, PerlEnvClearenv, @@ -559,17 +559,17 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) /* open the file in the same mode */ if(((FILE*)pf)->_flag & _IOREAD) { - mode[0] = 'r'; - mode[1] = 0; + mode[0] = 'r'; + mode[1] = 0; } else if(((FILE*)pf)->_flag & _IOWRT) { - mode[0] = 'a'; - mode[1] = 0; + mode[0] = 'a'; + mode[1] = 0; } else if(((FILE*)pf)->_flag & _IORW) { - mode[0] = 'r'; - mode[1] = '+'; - mode[2] = 0; + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; } /* it appears that the binmode is attached to the @@ -580,14 +580,14 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) /* move the file pointer to the same position */ if (!fgetpos(pf, &pos)) { - fsetpos(pfdup, &pos); + fsetpos(pfdup, &pos); } return pfdup; } struct IPerlStdIO perlStdIO = { - PerlStdIOStdin, + PerlStdIOStdin, PerlStdIOStdout, PerlStdIOStderr, PerlStdIOOpen, @@ -647,15 +647,15 @@ PerlLIOChmod(struct IPerlLIO* piPerl, const char *filename, int pmode) int PerlLIOChown(struct IPerlLIO* piPerl, const char *filename, uid_t owner, gid_t group) { - dTHX; + dTHX; Perl_croak(aTHX_ "chown not implemented!\n"); - return 0; + return 0; } int PerlLIOChsize(struct IPerlLIO* piPerl, int handle, long size) { - return (nw_chsize(handle,size)); + return (nw_chsize(handle,size)); } int @@ -679,7 +679,7 @@ PerlLIODup2(struct IPerlLIO* piPerl, int handle1, int handle2) int PerlLIOFlock(struct IPerlLIO* piPerl, int fd, int oper) { - //On NetWare simulate flock by locking a range on the file + //On NetWare simulate flock by locking a range on the file return nw_flock(fd, oper); } @@ -692,7 +692,7 @@ PerlLIOFileStat(struct IPerlLIO* piPerl, int handle, struct stat *buffer) int PerlLIOIOCtl(struct IPerlLIO* piPerl, int i, unsigned int u, char *data) { - return 0; + return 0; } int @@ -722,7 +722,7 @@ PerlLIOLstat(struct IPerlLIO* piPerl, const char *path, struct stat *buffer) char* PerlLIOMktemp(struct IPerlLIO* piPerl, char *Template) { - return(nw_mktemp(Template)); + return(nw_mktemp(Template)); } int @@ -793,7 +793,7 @@ PerlLIOWrite(struct IPerlLIO* piPerl, int handle, const void *buffer, unsigned i struct IPerlLIO perlLIO = { - PerlLIOAccess, + PerlLIOAccess, PerlLIOChmod, PerlLIOChown, PerlLIOChsize, @@ -844,26 +844,26 @@ void PerlProcExit(struct IPerlProc* piPerl, int status) { // exit(status); - dTHX; - dJMPENV; - JMPENV_JUMP(2); + dTHX; + dJMPENV; + JMPENV_JUMP(2); } void PerlProc_Exit(struct IPerlProc* piPerl, int status) { // _exit(status); - dTHX; - dJMPENV; - JMPENV_JUMP(2); + dTHX; + dJMPENV; + JMPENV_JUMP(2); } int PerlProcExecl(struct IPerlProc* piPerl, const char *cmdname, const char *arg0, const char *arg1, const char *arg2, const char *arg3) { - dTHX; + dTHX; Perl_croak(aTHX_ "execl not implemented!\n"); - return 0; + return 0; } int @@ -881,31 +881,31 @@ PerlProcExecvp(struct IPerlProc* piPerl, const char *cmdname, const char *const uid_t PerlProcGetuid(struct IPerlProc* piPerl) { - return 0; + return 0; } uid_t PerlProcGeteuid(struct IPerlProc* piPerl) { - return 0; + return 0; } gid_t PerlProcGetgid(struct IPerlProc* piPerl) { - return 0; + return 0; } gid_t PerlProcGetegid(struct IPerlProc* piPerl) { - return 0; + return 0; } char * PerlProcGetlogin(struct IPerlProc* piPerl) { - return NULL; + return NULL; } int @@ -934,7 +934,7 @@ PerlProcPopen(struct IPerlProc* piPerl, const char *command, const char *mode) dTHX; PERL_FLUSHALL_FOR_CHILD; - return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); + return (PerlIO*)nw_Popen((char *)command, (char *)mode, (int *)errno); } int @@ -952,13 +952,13 @@ PerlProcPipe(struct IPerlProc* piPerl, int *phandles) int PerlProcSetuid(struct IPerlProc* piPerl, uid_t u) { - return 0; + return 0; } int PerlProcSetgid(struct IPerlProc* piPerl, gid_t g) { - return 0; + return 0; } int @@ -994,7 +994,7 @@ PerlProcSignal(struct IPerlProc* piPerl, int sig, Sighandler_t subcode) int PerlProcFork(struct IPerlProc* piPerl) { - return 0; + return 0; } int @@ -1068,42 +1068,42 @@ struct IPerlProc perlProc = u_long PerlSockHtonl(struct IPerlSock* piPerl, u_long hostlong) { - return(nw_htonl(hostlong)); + return(nw_htonl(hostlong)); } u_short PerlSockHtons(struct IPerlSock* piPerl, u_short hostshort) { - return(nw_htons(hostshort)); + return(nw_htons(hostshort)); } u_long PerlSockNtohl(struct IPerlSock* piPerl, u_long netlong) { - return nw_ntohl(netlong); + return nw_ntohl(netlong); } u_short PerlSockNtohs(struct IPerlSock* piPerl, u_short netshort) { - return nw_ntohs(netshort); + return nw_ntohs(netshort); } SOCKET PerlSockAccept(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* addr, int* addrlen) { - return nw_accept(s, addr, addrlen); + return nw_accept(s, addr, addrlen); } int PerlSockBind(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) { - return nw_bind(s, name, namelen); + return nw_bind(s, name, namelen); } int PerlSockConnect(struct IPerlSock* piPerl, SOCKET s, const struct sockaddr* name, int namelen) { - return nw_connect(s, name, namelen); + return nw_connect(s, name, namelen); } void @@ -1133,7 +1133,7 @@ PerlSockEndservent(struct IPerlSock* piPerl) struct hostent* PerlSockGethostbyaddr(struct IPerlSock* piPerl, const char* addr, int len, int type) { - return(nw_gethostbyaddr(addr,len,type)); + return(nw_gethostbyaddr(addr,len,type)); } struct hostent* @@ -1145,13 +1145,13 @@ PerlSockGethostbyname(struct IPerlSock* piPerl, const char* name) struct hostent* PerlSockGethostent(struct IPerlSock* piPerl) { - return(nw_gethostent()); + return(nw_gethostent()); } int PerlSockGethostname(struct IPerlSock* piPerl, char* name, int namelen) { - return nw_gethostname(name,namelen); + return nw_gethostname(name,namelen); } struct netent * @@ -1204,115 +1204,115 @@ PerlSockGetservbyname(struct IPerlSock* piPerl, const char* name, const char* pr struct servent* PerlSockGetservbyport(struct IPerlSock* piPerl, int port, const char* proto) { - return nw_getservbyport(port, proto); + return nw_getservbyport(port, proto); } struct servent* PerlSockGetservent(struct IPerlSock* piPerl) { - return nw_getservent(); + return nw_getservent(); } int PerlSockGetsockname(struct IPerlSock* piPerl, SOCKET s, struct sockaddr* name, int* namelen) { - return nw_getsockname(s, name, namelen); + return nw_getsockname(s, name, namelen); } int PerlSockGetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, char* optval, int* optlen) { - return nw_getsockopt(s, level, optname, optval, optlen); + return nw_getsockopt(s, level, optname, optval, optlen); } unsigned long PerlSockInetAddr(struct IPerlSock* piPerl, const char* cp) { - return(nw_inet_addr(cp)); + return(nw_inet_addr(cp)); } char* PerlSockInetNtoa(struct IPerlSock* piPerl, struct in_addr in) { - return NULL; + return NULL; } int PerlSockListen(struct IPerlSock* piPerl, SOCKET s, int backlog) { - return (nw_listen(s, backlog)); + return (nw_listen(s, backlog)); } int PerlSockRecv(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags) { - return (nw_recv(s, buffer, len, flags)); + return (nw_recv(s, buffer, len, flags)); } int PerlSockRecvfrom(struct IPerlSock* piPerl, SOCKET s, char* buffer, int len, int flags, struct sockaddr* from, int* fromlen) { - return nw_recvfrom(s, buffer, len, flags, from, fromlen); + return nw_recvfrom(s, buffer, len, flags, from, fromlen); } int PerlSockSelect(struct IPerlSock* piPerl, int nfds, char* readfds, char* writefds, char* exceptfds, const struct timeval* timeout) { - return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); + return nw_select(nfds, (fd_set*) readfds, (fd_set*) writefds, (fd_set*) exceptfds, timeout); } int PerlSockSend(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags) { - return (nw_send(s, buffer, len, flags)); + return (nw_send(s, buffer, len, flags)); } int PerlSockSendto(struct IPerlSock* piPerl, SOCKET s, const char* buffer, int len, int flags, const struct sockaddr* to, int tolen) { - return(nw_sendto(s, buffer, len, flags, to, tolen)); + return(nw_sendto(s, buffer, len, flags, to, tolen)); } void PerlSockSethostent(struct IPerlSock* piPerl, int stayopen) { - nw_sethostent(stayopen); + nw_sethostent(stayopen); } void PerlSockSetnetent(struct IPerlSock* piPerl, int stayopen) { - nw_setnetent(stayopen); + nw_setnetent(stayopen); } void PerlSockSetprotoent(struct IPerlSock* piPerl, int stayopen) { - nw_setprotoent(stayopen); + nw_setprotoent(stayopen); } void PerlSockSetservent(struct IPerlSock* piPerl, int stayopen) { - nw_setservent(stayopen); + nw_setservent(stayopen); } int PerlSockSetsockopt(struct IPerlSock* piPerl, SOCKET s, int level, int optname, const char* optval, int optlen) { - return nw_setsockopt(s, level, optname, optval, optlen); + return nw_setsockopt(s, level, optname, optval, optlen); } int PerlSockShutdown(struct IPerlSock* piPerl, SOCKET s, int how) { - return nw_shutdown(s, how); + return nw_shutdown(s, how); } SOCKET PerlSockSocket(struct IPerlSock* piPerl, int af, int type, int protocol) { - return nw_socket(af, type, protocol); + return nw_socket(af, type, protocol); } int @@ -1326,14 +1326,14 @@ PerlSockSocketpair(struct IPerlSock* piPerl, int domain, int type, int protocol, int PerlSockIoctlsocket(struct IPerlSock* piPerl, SOCKET s, long cmd, u_long *argp) { - dTHX; + dTHX; Perl_croak(aTHX_ "ioctlsocket not implemented!\n"); - return 0; + return 0; } struct IPerlSock perlSock = { - PerlSockHtonl, + PerlSockHtonl, PerlSockHtons, PerlSockNtohl, PerlSockNtohs, @@ -1361,8 +1361,8 @@ struct IPerlSock perlSock = PerlSockGetsockname, PerlSockGetsockopt, PerlSockInetAddr, - PerlSockInetNtoa, - PerlSockListen, + PerlSockInetNtoa, + PerlSockListen, PerlSockRecv, PerlSockRecvfrom, PerlSockSelect, @@ -1374,7 +1374,7 @@ struct IPerlSock perlSock = PerlSockSetservent, PerlSockSetsockopt, PerlSockShutdown, - PerlSockSocket, + PerlSockSocket, PerlSockSocketpair, }; diff --git a/NetWare/nwpipe.h b/NetWare/nwpipe.h index 462a73dcf42c..1cf58706c13f 100644 --- a/NetWare/nwpipe.h +++ b/NetWare/nwpipe.h @@ -29,24 +29,24 @@ typedef struct tagTempPipeFile { - BOOL m_mode; // FALSE - Read mode ; TRUE - Write mode - BOOL m_launchPerl; - BOOL m_doPerlGlob; + BOOL m_mode; // FALSE - Read mode ; TRUE - Write mode + BOOL m_launchPerl; + BOOL m_doPerlGlob; - int m_argv_len; + int m_argv_len; - char * m_fileName; - char** m_argv; - char * m_redirect; + char * m_fileName; + char** m_argv; + char * m_redirect; - #ifdef MPK_ON - SEMAPHORE m_perlSynchSemaphore; - #else - long m_perlSynchSemaphore; - #endif + #ifdef MPK_ON + SEMAPHORE m_perlSynchSemaphore; + #else + long m_perlSynchSemaphore; + #endif - FILE* m_file; - PCOMMANDLINEPARSER m_pipeCommand; + FILE* m_file; + PCOMMANDLINEPARSER m_pipeCommand; } TEMPPIPEFILE, *PTEMPPIPEFILE; diff --git a/NetWare/nwplglob.c b/NetWare/nwplglob.c index 6810fd5e6973..fba55da7abce 100644 --- a/NetWare/nwplglob.c +++ b/NetWare/nwplglob.c @@ -36,7 +36,7 @@ Description : Perl globbing support: Takes an array of wildcard descriptors and produces from it a list of files that the wildcards expand into. - The list of files is written to the temporary file named by fileName. + The list of files is written to the temporary file named by fileName. Parameters : argv (IN) - Input argument vector. fileName (IN) - Input file name for storing globed file names. @@ -47,44 +47,44 @@ void fnDoPerlGlob(char** argv, char* fileName) { - FILE * redirOut = NULL; + FILE * redirOut = NULL; - if (*argv) - argv++; - if (*argv == NULL) - return; + if (*argv) + argv++; + if (*argv == NULL) + return; - redirOut = fopen((const char *)fileName, (const char *)"w"); - if (!redirOut) - return; + redirOut = fopen((const char *)fileName, (const char *)"w"); + if (!redirOut) + return; - do - { - DIR* dir = NULL; - DIR* fil = NULL; - char* pattern = NULL; + do + { + DIR* dir = NULL; + DIR* fil = NULL; + char* pattern = NULL; - pattern = *argv++; + pattern = *argv++; - dir = opendir((const char *)pattern); - if (!dir) - continue; + dir = opendir((const char *)pattern); + if (!dir) + continue; - /* find the last separator in pattern, NetWare has three: /\: */ - while (fil = readdir(dir)) - { - // The below displays the files separated by tab character. - // Also, it displays only the file names and not directories. - // If any other format is desired, it needs to be done here. - fprintf(redirOut, "%s\t", fil->d_name); - } + /* find the last separator in pattern, NetWare has three: /\: */ + while (fil = readdir(dir)) + { + // The below displays the files separated by tab character. + // Also, it displays only the file names and not directories. + // If any other format is desired, it needs to be done here. + fprintf(redirOut, "%s\t", fil->d_name); + } - closedir(dir); + closedir(dir); - } while (*argv); + } while (*argv); - fclose(redirOut); + fclose(redirOut); - return; + return; } diff --git a/NetWare/nwtinfo.h b/NetWare/nwtinfo.h index a08d060422c2..d8503d28112d 100644 --- a/NetWare/nwtinfo.h +++ b/NetWare/nwtinfo.h @@ -25,10 +25,10 @@ typedef struct tagThreadInfo { - int tid; - struct tagThreadInfo *next; - BOOL m_dontTouchHashLists; - void* m_allocList; + int tid; + struct tagThreadInfo *next; + BOOL m_dontTouchHashLists; + void* m_allocList; }ThreadInfo; void fnInitializeThreadInfo(void); @@ -39,17 +39,17 @@ BOOL fnRemoveThreadInfo(int tid); ThreadInfo* fnGetThreadInfo(int tid); #ifdef __cplusplus - //For storing and retrieving Watcom Hash list address - extern "C" BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); - //Registering with the Thread table - extern "C" BOOL fnRegisterWithThreadTable(void); - extern "C" BOOL fnUnregisterWithThreadTable(void); + //For storing and retrieving Watcom Hash list address + extern "C" BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); + //Registering with the Thread table + extern "C" BOOL fnRegisterWithThreadTable(void); + extern "C" BOOL fnUnregisterWithThreadTable(void); #else - //For storing and retrieving Watcom Hash list address - BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); - //Registering with the Thread table - BOOL fnRegisterWithThreadTable(void); - BOOL fnUnregisterWithThreadTable(void); + //For storing and retrieving Watcom Hash list address + BOOL fnInsertHashListAddrs(void *addrs, BOOL dontTouchHashList); + //Registering with the Thread table + BOOL fnRegisterWithThreadTable(void); + BOOL fnUnregisterWithThreadTable(void); #endif BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList); @@ -58,9 +58,9 @@ BOOL fnGetHashListAddrs(void **addrs, BOOL *dontTouchHashList); //or see if the above portion can be removed once this works properly typedef struct tagThreadCtx { - long tid; - void *tInfo; - struct tagThreadCtx *next; + long tid; + void *tInfo; + struct tagThreadCtx *next; }ThreadContext; diff --git a/NetWare/nwutil.h b/NetWare/nwutil.h index ff05d1830f35..a27161147ddf 100644 --- a/NetWare/nwutil.h +++ b/NetWare/nwutil.h @@ -27,10 +27,10 @@ #ifdef MPK_ON - #include - #include + #include + #include #else - #include + #include #endif //MPK_ON @@ -43,28 +43,28 @@ typedef struct tagCommandLineParser { - BOOL m_noScreen; - BOOL m_AutoDestroy; - BOOL m_isValid; - - int m_argc; - int m_argv_len; - - #ifdef MPK_ON - SEMAPHORE m_qSemaphore; - #else - long m_qSemaphore; - #endif - - char* m_redirInName; - char* m_redirOutName; - char* m_redirErrName; - char* m_redirBothName; - char* nextarg; - char* sSkippedToken; - - char** m_argv; - char** new_argv; + BOOL m_noScreen; + BOOL m_AutoDestroy; + BOOL m_isValid; + + int m_argc; + int m_argv_len; + + #ifdef MPK_ON + SEMAPHORE m_qSemaphore; + #else + long m_qSemaphore; + #endif + + char* m_redirInName; + char* m_redirOutName; + char* m_redirErrName; + char* m_redirBothName; + char* nextarg; + char* sSkippedToken; + + char** m_argv; + char** new_argv; }COMMANDLINEPARSER, *PCOMMANDLINEPARSER; diff --git a/NetWare/nwvmem.h b/NetWare/nwvmem.h index e82eaeef8b50..98b287304419 100644 --- a/NetWare/nwvmem.h +++ b/NetWare/nwvmem.h @@ -38,12 +38,12 @@ class VMem virtual void* Malloc(size_t size); virtual void* Realloc(void* pMem, size_t size); virtual void Free(void* pMem); - virtual void* Calloc(size_t num, size_t size); + virtual void* Calloc(size_t num, size_t size); protected: - BOOL m_dontTouchHashLists; + BOOL m_dontTouchHashLists; // WCValHashTable* m_allocList; - NWPerlHashList *m_allocList; // CW changes + NWPerlHashList *m_allocList; // CW changes }; @@ -73,10 +73,10 @@ unsigned fnAllocListHash(void* const& invalue) Function : fnFreeMemEntry Description : Called for each outstanding memory allocation at the end of a script run. - Frees the outstanding allocations + Frees the outstanding allocations Parameters : ptr (IN). - context (IN) + context (IN) Returns : Nothing. @@ -84,15 +84,15 @@ unsigned fnAllocListHash(void* const& invalue) void fnFreeMemEntry(void* ptr, void* context) { - VMem* pVMem = (VMem*) context; - - if(ptr && pVMem) - { - pVMem->Free(ptr); - ptr=NULL; - pVMem = NULL; - context = NULL; - } + VMem* pVMem = (VMem*) context; + + if(ptr && pVMem) + { + pVMem->Free(ptr); + ptr=NULL; + pVMem = NULL; + context = NULL; + } } @@ -111,11 +111,11 @@ void fnFreeMemEntry(void* ptr, void* context) VMem::VMem() { - //Constructor - m_dontTouchHashLists = FALSE; - m_allocList = NULL; - // m_allocList = new WCValHashTable (fnAllocListHash, 256); - m_allocList = new NWPerlHashList(); // CW changes + //Constructor + m_dontTouchHashLists = FALSE; + m_allocList = NULL; + // m_allocList = new WCValHashTable (fnAllocListHash, 256); + m_allocList = new NWPerlHashList(); // CW changes } @@ -134,16 +134,16 @@ VMem::VMem() VMem::~VMem(void) { - //Destructor - m_dontTouchHashLists = TRUE; - if (m_allocList) - { - m_allocList->forAll(fnFreeMemEntry, (void*) this); - - delete m_allocList; - m_allocList = NULL; - } - m_dontTouchHashLists = FALSE; + //Destructor + m_dontTouchHashLists = TRUE; + if (m_allocList) + { + m_allocList->forAll(fnFreeMemEntry, (void*) this); + + delete m_allocList; + m_allocList = NULL; + } + m_dontTouchHashLists = FALSE; } @@ -162,33 +162,33 @@ VMem::~VMem(void) void* VMem::Malloc(size_t size) { - void *ptr = NULL; - - if (size <= 0) - return NULL; - - ptr = malloc(size); - if (ptr) - { - if(m_allocList) - m_allocList->insert(ptr); - } - else - { - m_dontTouchHashLists = TRUE; - if (m_allocList) - { - m_allocList->forAll(fnFreeMemEntry, (void*) this); - delete m_allocList; - m_allocList = NULL; - } - m_dontTouchHashLists = FALSE; - - // Serious error since memory allocation falied. So, exiting... - ExitThread(TSR_THREAD, 1); - } - - return(ptr); + void *ptr = NULL; + + if (size <= 0) + return NULL; + + ptr = malloc(size); + if (ptr) + { + if(m_allocList) + m_allocList->insert(ptr); + } + else + { + m_dontTouchHashLists = TRUE; + if (m_allocList) + { + m_allocList->forAll(fnFreeMemEntry, (void*) this); + delete m_allocList; + m_allocList = NULL; + } + m_dontTouchHashLists = FALSE; + + // Serious error since memory allocation falied. So, exiting... + ExitThread(TSR_THREAD, 1); + } + + return(ptr); } @@ -200,7 +200,7 @@ void* VMem::Malloc(size_t size) Description : Reallocates block of memory. Parameters : block (IN) - Points to a previously allocated memory block. - size (IN) - Size of memory to be allocated. + size (IN) - Size of memory to be allocated. Returns : Pointer to the allocated memory block. @@ -208,38 +208,38 @@ void* VMem::Malloc(size_t size) void* VMem::Realloc(void* block, size_t size) { - void *ptr = NULL; - - if (size <= 0) - return NULL; - - ptr = realloc(block, size); - if (ptr) - { - if (block) - { - if (m_allocList) - m_allocList->remove(block); - } - if (m_allocList) - m_allocList->insert(ptr); - } - else - { - m_dontTouchHashLists = TRUE; - if (m_allocList) - { - m_allocList->forAll(fnFreeMemEntry, (void*) this); - delete m_allocList; - m_allocList = NULL; - } - m_dontTouchHashLists = FALSE; - - // Serious error since memory allocation falied. So, exiting... - ExitThread(TSR_THREAD, 1); - } - - return(ptr); + void *ptr = NULL; + + if (size <= 0) + return NULL; + + ptr = realloc(block, size); + if (ptr) + { + if (block) + { + if (m_allocList) + m_allocList->remove(block); + } + if (m_allocList) + m_allocList->insert(ptr); + } + else + { + m_dontTouchHashLists = TRUE; + if (m_allocList) + { + m_allocList->forAll(fnFreeMemEntry, (void*) this); + delete m_allocList; + m_allocList = NULL; + } + m_dontTouchHashLists = FALSE; + + // Serious error since memory allocation falied. So, exiting... + ExitThread(TSR_THREAD, 1); + } + + return(ptr); } @@ -251,7 +251,7 @@ void* VMem::Realloc(void* block, size_t size) Description : Allocates and clears memory space for an array of objects. Parameters : num (IN) - Specifies the number of objects. - size (IN) - Size of each object. + size (IN) - Size of each object. Returns : Pointer to the allocated memory block. @@ -259,33 +259,33 @@ void* VMem::Realloc(void* block, size_t size) void* VMem::Calloc(size_t num, size_t size) { - void *ptr = NULL; - - if (size <= 0) - return NULL; - - ptr = calloc(num, size); - if (ptr) - { - if(m_allocList) - m_allocList->insert(ptr); - } - else - { - m_dontTouchHashLists = TRUE; - if (m_allocList) - { - m_allocList->forAll(fnFreeMemEntry, (void*) this); - delete m_allocList; - m_allocList = NULL; - } - m_dontTouchHashLists = FALSE; - - // Serious error since memory allocation falied. So, exiting... - ExitThread(TSR_THREAD, 1); - } - - return(ptr); + void *ptr = NULL; + + if (size <= 0) + return NULL; + + ptr = calloc(num, size); + if (ptr) + { + if(m_allocList) + m_allocList->insert(ptr); + } + else + { + m_dontTouchHashLists = TRUE; + if (m_allocList) + { + m_allocList->forAll(fnFreeMemEntry, (void*) this); + delete m_allocList; + m_allocList = NULL; + } + m_dontTouchHashLists = FALSE; + + // Serious error since memory allocation falied. So, exiting... + ExitThread(TSR_THREAD, 1); + } + + return(ptr); } @@ -304,35 +304,35 @@ void* VMem::Calloc(size_t num, size_t size) void VMem::Free(void* p) { - // Final clean up, free all the nodes from the hash list - if (m_dontTouchHashLists) - { - if(p) - { - free(p); - p = NULL; - } - } - else - { - if(p && m_allocList) - { - if (m_allocList->remove(p)) - { - free(p); - p = NULL; - } - else - { - // If it comes here, that means that the memory pointer is not contained in the hash list. - // But no need to free now, since if is deleted here, it will result in an abend!! - // If the memory is still there, it will be cleaned during final cleanup anyway. - } - } - } - - - return; + // Final clean up, free all the nodes from the hash list + if (m_dontTouchHashLists) + { + if(p) + { + free(p); + p = NULL; + } + } + else + { + if(p && m_allocList) + { + if (m_allocList->remove(p)) + { + free(p); + p = NULL; + } + else + { + // If it comes here, that means that the memory pointer is not contained in the hash list. + // But no need to free now, since if is deleted here, it will result in an abend!! + // If the memory is still there, it will be cleaned during final cleanup anyway. + } + } + } + + + return; } diff --git a/NetWare/win32ish.h b/NetWare/win32ish.h index f6603d50f447..7e94a1c0c2d1 100644 --- a/NetWare/win32ish.h +++ b/NetWare/win32ish.h @@ -22,11 +22,11 @@ #ifndef BOOL - typedef unsigned int BOOL; + typedef unsigned int BOOL; #endif #ifndef DWORD - typedef unsigned long DWORD; + typedef unsigned long DWORD; #endif typedef DWORD LCID; @@ -34,11 +34,11 @@ typedef long HRESULT; typedef void* LPVOID; #ifndef TRUE - #define TRUE 1 + #define TRUE 1 #endif #ifndef FALSE - #define FALSE 0 + #define FALSE 0 #endif diff --git a/Porting/timecheck.c b/Porting/timecheck.c index 87a252d631e5..9d977ca9f3f2 100644 --- a/Porting/timecheck.c +++ b/Porting/timecheck.c @@ -17,9 +17,9 @@ static char hexbuf[80]; char *hex (time_t t) { if ((long long)t < 0) - sprintf (hexbuf, " -0x%016lx", -t); + sprintf (hexbuf, " -0x%016lx", -t); else - sprintf (hexbuf, " 0x%016lx", t); + sprintf (hexbuf, " 0x%016lx", t); return (hexbuf); } /* hex */ @@ -27,19 +27,19 @@ void gm_check (time_t t, int min_year, int max_year) { tmp = gmtime (&t); if ( tmp == NULL || - /* Check tm_year overflow */ - tmp->tm_year < min_year || tmp->tm_year > max_year) { - if (opt_v) - fprintf (stderr, "gmtime (%ld) failed with errno %d\n", t, errno); - } + /* Check tm_year overflow */ + tmp->tm_year < min_year || tmp->tm_year > max_year) { + if (opt_v) + fprintf (stderr, "gmtime (%ld) failed with errno %d\n", t, errno); + } else { - if (opt_v) - fprintf (stderr, "%3d:%s: %12ld-%02d-%02d %02d:%02d:%02d\n", - i, hex (t), - (long)(tmp->tm_year) + 1900, tmp->tm_mon + 1, tmp->tm_mday, - tmp->tm_hour, tmp->tm_min, tmp->tm_sec); - pt = t; - } + if (opt_v) + fprintf (stderr, "%3d:%s: %12ld-%02d-%02d %02d:%02d:%02d\n", + i, hex (t), + (long)(tmp->tm_year) + 1900, tmp->tm_mon + 1, tmp->tm_mday, + tmp->tm_hour, tmp->tm_min, tmp->tm_sec); + pt = t; + } } /* gm_check */ int check_gm_max () @@ -47,12 +47,12 @@ int check_gm_max () tmp = NULL; pt = 0; if (tmp == NULL || tmp->tm_year < 0) { - for (i = 63; i >= 0; i--) { - time_t x = pt | ((time_t)1 << i); - if (x < 0 || x < pt) continue; - gm_check (x, 69, 0x7fffffff); - } - } + for (i = 63; i >= 0; i--) { + time_t x = pt | ((time_t)1 << i); + if (x < 0 || x < pt) continue; + gm_check (x, 69, 0x7fffffff); + } + } pt_max = pt; return (0); } /* check_gm_max */ @@ -62,12 +62,12 @@ int check_gm_min () tmp = NULL; pt = 0; if (tmp == NULL) { - for (i = 36; i >= 0; i--) { - time_t x = pt - ((time_t)1 << i); - if (x > 0) continue; - gm_check (x, -1900, 70); - } - } + for (i = 36; i >= 0; i--) { + time_t x = pt - ((time_t)1 << i); + if (x > 0) continue; + gm_check (x, -1900, 70); + } + } pt_min = pt; return (0); } /* check_gm_min */ @@ -75,23 +75,23 @@ int check_gm_min () void lt_check (time_t t, int min_year, int max_year) { if (sizeof (time_t) > 4 && t > 0x7ffffffffffff000LL) - tmp = NULL; + tmp = NULL; else - tmp = localtime (&t); + tmp = localtime (&t); if ( tmp == NULL || - /* Check tm_year overflow */ - tmp->tm_year < min_year || tmp->tm_year > max_year) { - if (opt_v) - fprintf (stderr, "localtime (%ld) failed with errno %d\n", t, errno); - } + /* Check tm_year overflow */ + tmp->tm_year < min_year || tmp->tm_year > max_year) { + if (opt_v) + fprintf (stderr, "localtime (%ld) failed with errno %d\n", t, errno); + } else { - if (opt_v) - fprintf (stderr, "%3d:%s: %12ld-%02d-%02d %02d:%02d:%02d\n", - i, hex (t), - (long)(tmp->tm_year) + 1900, tmp->tm_mon + 1, tmp->tm_mday, - tmp->tm_hour, tmp->tm_min, tmp->tm_sec); - pt = t; - } + if (opt_v) + fprintf (stderr, "%3d:%s: %12ld-%02d-%02d %02d:%02d:%02d\n", + i, hex (t), + (long)(tmp->tm_year) + 1900, tmp->tm_mon + 1, tmp->tm_mday, + tmp->tm_hour, tmp->tm_min, tmp->tm_sec); + pt = t; + } } /* lt_check */ int check_lt_max () @@ -99,12 +99,12 @@ int check_lt_max () tmp = NULL; pt = 0; if (tmp == NULL || tmp->tm_year < 0) { - for (i = 63; i >= 0; i--) { - time_t x = pt | ((time_t)1 << i); - if (x < 0 || x < pt) continue; - lt_check (x, 69, 0x7fffffff); - } - } + for (i = 63; i >= 0; i--) { + time_t x = pt | ((time_t)1 << i); + if (x < 0 || x < pt) continue; + lt_check (x, 69, 0x7fffffff); + } + } pt_max = pt; return (0); } /* check_lt_max */ @@ -114,12 +114,12 @@ int check_lt_min () tmp = NULL; pt = 0; if (tmp == NULL) { - for (i = 36; i >= 0; i--) { - time_t x = pt - ((time_t)1 << i); - if (x > 0) continue; - lt_check (x, -1900, 70); - } - } + for (i = 36; i >= 0; i--) { + time_t x = pt - ((time_t)1 << i); + if (x > 0) continue; + lt_check (x, -1900, 70); + } + } pt_min = pt; return (0); } /* check_lt_min */ diff --git a/Porting/timecheck2.c b/Porting/timecheck2.c index 06d4a66cff9d..483e152a23b9 100644 --- a/Porting/timecheck2.c +++ b/Porting/timecheck2.c @@ -10,8 +10,8 @@ time_t Time_Zero = 0; /* Visual C++ 2008's difftime() can't do negative times */ double my_difftime(time_t left, time_t right) { - double diff = (double)left - (double)right; - return diff; + double diff = (double)left - (double)right; + return diff; } void check_date_max( struct tm * (*date_func)(const time_t *), char *func_name ) { diff --git a/amigaos4/amigaio.c b/amigaos4/amigaio.c index 3b5ce0e035a8..3b2cdcd5e024 100644 --- a/amigaos4/amigaio.c +++ b/amigaos4/amigaio.c @@ -28,244 +28,244 @@ extern int32 myruncommand(BPTR seglist, int stack, char *command, int length, ch void amigaos_stdio_get(pTHX_ StdioStore *store) { - store->astdin = - amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv)))); - store->astderr = - amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv)))); - store->astdout = amigaos_get_file( - PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO))))); + store->astdin = + amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stdingv)))); + store->astderr = + amigaos_get_file(PerlIO_fileno(IoIFP(GvIO(PL_stderrgv)))); + store->astdout = amigaos_get_file( + PerlIO_fileno(IoIFP(GvIO(gv_fetchpv("STDOUT", TRUE, SVt_PVIO))))); } void amigaos_stdio_save(pTHX_ StdioStore *store) { - amigaos_stdio_get(aTHX_ store); - store->oldstdin = IDOS->SelectInput(store->astdin); - store->oldstderr = IDOS->SelectErrorOutput(store->astderr); - store->oldstdout = IDOS->SelectOutput(store->astdout); + amigaos_stdio_get(aTHX_ store); + store->oldstdin = IDOS->SelectInput(store->astdin); + store->oldstderr = IDOS->SelectErrorOutput(store->astderr); + store->oldstdout = IDOS->SelectOutput(store->astdout); } void amigaos_stdio_restore(pTHX_ const StdioStore *store) { - IDOS->SelectInput(store->oldstdin); - IDOS->SelectErrorOutput(store->oldstderr); - IDOS->SelectOutput(store->oldstdout); + IDOS->SelectInput(store->oldstdin); + IDOS->SelectErrorOutput(store->oldstderr); + IDOS->SelectOutput(store->oldstdout); } void amigaos_post_exec(int fd, int do_report) { - /* We *must* write something to our pipe or else - * the other end hangs */ - if (do_report) - { - int e = errno; - PerlLIO_write(fd, (void *)&e, sizeof(e)); - PerlLIO_close(fd); - } + /* We *must* write something to our pipe or else + * the other end hangs */ + if (do_report) + { + int e = errno; + PerlLIO_write(fd, (void *)&e, sizeof(e)); + PerlLIO_close(fd); + } } struct popen_data { - struct Task *parent; - STRPTR command; + struct Task *parent; + STRPTR command; }; static int popen_result = 0; int popen_child() { - struct Task *thisTask = IExec->FindTask(0); - struct popen_data *pd = (struct popen_data *)thisTask->tc_UserData; - const char *argv[4]; + struct Task *thisTask = IExec->FindTask(0); + struct popen_data *pd = (struct popen_data *)thisTask->tc_UserData; + const char *argv[4]; - argv[0] = "sh"; - argv[1] = "-c"; - argv[2] = pd->command ? pd->command : NULL; - argv[3] = NULL; + argv[0] = "sh"; + argv[1] = "-c"; + argv[2] = pd->command ? pd->command : NULL; + argv[3] = NULL; - // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,command?command:"NULL"); + // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,command?command:"NULL"); - /* We need to give this to sh via execvp, execvp expects filename, - * argv[] - */ - IExec->ObtainSemaphore(&popen_sema); + /* We need to give this to sh via execvp, execvp expects filename, + * argv[] + */ + IExec->ObtainSemaphore(&popen_sema); - IExec->Signal(pd->parent,SIGBREAKF_CTRL_F); + IExec->Signal(pd->parent,SIGBREAKF_CTRL_F); - popen_result = myexecvp(FALSE, argv[0], (char **)argv); - if (pd->command) - IExec->FreeVec(pd->command); - IExec->FreeVec(pd); + popen_result = myexecvp(FALSE, argv[0], (char **)argv); + if (pd->command) + IExec->FreeVec(pd->command); + IExec->FreeVec(pd); - IExec->ReleaseSemaphore(&popen_sema); - IExec->Forbid(); - return 0; + IExec->ReleaseSemaphore(&popen_sema); + IExec->Forbid(); + return 0; } PerlIO *Perl_my_popen(pTHX_ const char *cmd, const char *mode) { - PERL_FLUSHALL_FOR_CHILD; - PerlIO *result = NULL; - char pipe_name[50]; - char unix_pipe[50]; - char ami_pipe[50]; - BPTR input = 0; - BPTR output = 0; - struct Process *proc = NULL; - struct Task *thisTask = IExec->FindTask(0); - struct popen_data * pd = NULL; - - /* First we need to check the mode - * We can only have unidirectional pipes - */ - // adebug("%s %ld cmd %s mode %s \n",__FUNCTION__,__LINE__,cmd, - // mode); - - switch (mode[0]) - { - case 'r': - case 'w': - break; - - default: - - errno = EINVAL; - return result; - } - - /* Make a unique pipe name - * we need a unix one and an amigaos version (of the same pipe!) - * as were linking with libunix. - */ - - sprintf(pipe_name, "%x%08lx/4096/0", pipenum++, - IUtility->GetUniqueID()); - sprintf(unix_pipe, "/PIPE/%s", pipe_name); - sprintf(ami_pipe, "PIPE:%s", pipe_name); - - /* Now we open the AmigaOs Filehandles That we wil pass to our - * Sub process - */ - - if (mode[0] == 'r') - { - /* A read mode pipe: Output from pipe input from Output() or NIL:*/ - /* First attempt to DUP Output() */ - input = IDOS->DupFileHandle(IDOS->Input()); - if(input == 0) - { - input = IDOS->Open("NIL:", MODE_READWRITE); - } - if (input != 0) - { - output = IDOS->Open(ami_pipe, MODE_NEWFILE); - } - result = PerlIO_open(unix_pipe, mode); - } - else - { - /* Open the write end first! */ - - result = PerlIO_open(unix_pipe, mode); - - input = IDOS->Open(ami_pipe, MODE_OLDFILE); - if (input != 0) - { - output = IDOS->DupFileHandle(IDOS->Output()); - if(output == 0) - { - output = IDOS->Open("NIL:", MODE_READWRITE); - } - } - } - if ((input == 0) || (output == 0) || (result == NULL)) - { - /* Ouch stream opening failed */ - /* Close and bail */ - if (input) - IDOS->Close(input); - if (output) - IDOS->Close(output); - if(result) - { - PerlIO_close(result); - result = NULL; - } - return result; - } - - /* We have our streams now start our new process - * We're using a new process so that execve can modify the environment - * with messing things up for the shell that launched perl - * Copy cmd before we launch the subprocess as perl seems to waste - * no time in overwriting it! The subprocess will free the copy. - */ - - if((pd = (struct popen_data*)IExec->AllocVecTags(sizeof(struct popen_data),AVT_Type,MEMF_SHARED,TAG_DONE))) - { - pd->parent = thisTask; - if ((pd->command = mystrdup(cmd))) - { - // adebug("%s %ld - // %s\n",__FUNCTION__,__LINE__,cmd_copy?cmd_copy:"NULL"); - proc = IDOS->CreateNewProcTags( - NP_Entry, popen_child, NP_Child, TRUE, NP_StackSize, - ((struct Process *)thisTask)->pr_StackSize, NP_Input, input, - NP_Output, output, NP_Error, IDOS->ErrorOutput(), - NP_CloseError, FALSE, NP_Cli, TRUE, NP_Name, - "Perl: popen process", NP_UserData, (int)pd, - TAG_DONE); - } - } - if(proc) - { - /* wait for the child be setup right */ - IExec->Wait(SIGBREAKF_CTRL_F); - } - if (!proc) - { - /* New Process Failed to start - * Close and bail out - */ - if(pd) - { - if(pd->command) - { - IExec->FreeVec(pd->command); - } - IExec->FreeVec(pd); - } - if (input) - IDOS->Close(input); - if (output) - IDOS->Close(output); - if(result) - { - PerlIO_close(result); - result = NULL; - } - } - - /* Our new process is running and will close it streams etc - * once its done. All we need to is open the pipe via stdio - */ - - return result; + PERL_FLUSHALL_FOR_CHILD; + PerlIO *result = NULL; + char pipe_name[50]; + char unix_pipe[50]; + char ami_pipe[50]; + BPTR input = 0; + BPTR output = 0; + struct Process *proc = NULL; + struct Task *thisTask = IExec->FindTask(0); + struct popen_data * pd = NULL; + + /* First we need to check the mode + * We can only have unidirectional pipes + */ + // adebug("%s %ld cmd %s mode %s \n",__FUNCTION__,__LINE__,cmd, + // mode); + + switch (mode[0]) + { + case 'r': + case 'w': + break; + + default: + + errno = EINVAL; + return result; + } + + /* Make a unique pipe name + * we need a unix one and an amigaos version (of the same pipe!) + * as were linking with libunix. + */ + + sprintf(pipe_name, "%x%08lx/4096/0", pipenum++, + IUtility->GetUniqueID()); + sprintf(unix_pipe, "/PIPE/%s", pipe_name); + sprintf(ami_pipe, "PIPE:%s", pipe_name); + + /* Now we open the AmigaOs Filehandles That we wil pass to our + * Sub process + */ + + if (mode[0] == 'r') + { + /* A read mode pipe: Output from pipe input from Output() or NIL:*/ + /* First attempt to DUP Output() */ + input = IDOS->DupFileHandle(IDOS->Input()); + if(input == 0) + { + input = IDOS->Open("NIL:", MODE_READWRITE); + } + if (input != 0) + { + output = IDOS->Open(ami_pipe, MODE_NEWFILE); + } + result = PerlIO_open(unix_pipe, mode); + } + else + { + /* Open the write end first! */ + + result = PerlIO_open(unix_pipe, mode); + + input = IDOS->Open(ami_pipe, MODE_OLDFILE); + if (input != 0) + { + output = IDOS->DupFileHandle(IDOS->Output()); + if(output == 0) + { + output = IDOS->Open("NIL:", MODE_READWRITE); + } + } + } + if ((input == 0) || (output == 0) || (result == NULL)) + { + /* Ouch stream opening failed */ + /* Close and bail */ + if (input) + IDOS->Close(input); + if (output) + IDOS->Close(output); + if(result) + { + PerlIO_close(result); + result = NULL; + } + return result; + } + + /* We have our streams now start our new process + * We're using a new process so that execve can modify the environment + * with messing things up for the shell that launched perl + * Copy cmd before we launch the subprocess as perl seems to waste + * no time in overwriting it! The subprocess will free the copy. + */ + + if((pd = (struct popen_data*)IExec->AllocVecTags(sizeof(struct popen_data),AVT_Type,MEMF_SHARED,TAG_DONE))) + { + pd->parent = thisTask; + if ((pd->command = mystrdup(cmd))) + { + // adebug("%s %ld + // %s\n",__FUNCTION__,__LINE__,cmd_copy?cmd_copy:"NULL"); + proc = IDOS->CreateNewProcTags( + NP_Entry, popen_child, NP_Child, TRUE, NP_StackSize, + ((struct Process *)thisTask)->pr_StackSize, NP_Input, input, + NP_Output, output, NP_Error, IDOS->ErrorOutput(), + NP_CloseError, FALSE, NP_Cli, TRUE, NP_Name, + "Perl: popen process", NP_UserData, (int)pd, + TAG_DONE); + } + } + if(proc) + { + /* wait for the child be setup right */ + IExec->Wait(SIGBREAKF_CTRL_F); + } + if (!proc) + { + /* New Process Failed to start + * Close and bail out + */ + if(pd) + { + if(pd->command) + { + IExec->FreeVec(pd->command); + } + IExec->FreeVec(pd); + } + if (input) + IDOS->Close(input); + if (output) + IDOS->Close(output); + if(result) + { + PerlIO_close(result); + result = NULL; + } + } + + /* Our new process is running and will close it streams etc + * once its done. All we need to is open the pipe via stdio + */ + + return result; } I32 Perl_my_pclose(pTHX_ PerlIO *ptr) { - int result = -1; - /* close the file before obtaining the semaphore else we might end up - hanging waiting for the child to read the last bit from the pipe */ - PerlIO_close(ptr); - IExec->ObtainSemaphore(&popen_sema); - result = popen_result; - IExec->ReleaseSemaphore(&popen_sema); - return result; + int result = -1; + /* close the file before obtaining the semaphore else we might end up + hanging waiting for the child to read the last bit from the pipe */ + PerlIO_close(ptr); + IExec->ObtainSemaphore(&popen_sema); + result = popen_result; + IExec->ReleaseSemaphore(&popen_sema); + return result; } @@ -284,11 +284,11 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) struct thread_info { - pthread_t ti_pid; - int ti_children; - pthread_t ti_parent; - struct MsgPort *ti_port; - struct Process *ti_Process; + pthread_t ti_pid; + int ti_children; + pthread_t ti_parent; + struct MsgPort *ti_port; + struct Process *ti_Process; }; static struct thread_info pseudo_children[MAX_THREADS]; @@ -297,61 +297,61 @@ static struct SignalSemaphore fork_array_sema; void amigaos4_init_fork_array() { - IExec->InitSemaphore(&fork_array_sema); - pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0); - pseudo_children[0].ti_parent = -1; - pseudo_children[0].ti_port = - (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE); + IExec->InitSemaphore(&fork_array_sema); + pseudo_children[0].ti_pid = (pthread_t)IExec->FindTask(0); + pseudo_children[0].ti_parent = -1; + pseudo_children[0].ti_port = + (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE); } void amigaos4_dispose_fork_array() { - while (pseudo_children[0].ti_children > 0) - { - void *msg; - IExec->WaitPort(pseudo_children[0].ti_port); - msg = IExec->GetMsg(pseudo_children[0].ti_port); - if (msg) - IExec->FreeSysObject(ASOT_MESSAGE, msg); - pseudo_children[0].ti_children--; - } - IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port); + while (pseudo_children[0].ti_children > 0) + { + void *msg; + IExec->WaitPort(pseudo_children[0].ti_port); + msg = IExec->GetMsg(pseudo_children[0].ti_port); + if (msg) + IExec->FreeSysObject(ASOT_MESSAGE, msg); + pseudo_children[0].ti_children--; + } + IExec->FreeSysObject(ASOT_PORT, pseudo_children[0].ti_port); } struct thread_exit_message { - struct Message tem_Message; - pthread_t tem_pid; - int tem_status; + struct Message tem_Message; + pthread_t tem_pid; + int tem_status; }; int getnextchild() { - int i; - for (i = 0; i < MAX_THREADS; i++) - { - if (pseudo_children[i].ti_pid == 0) - return i; - } - return -1; + int i; + for (i = 0; i < MAX_THREADS; i++) + { + if (pseudo_children[i].ti_pid == 0) + return i; + } + return -1; } int findparent(pthread_t pid) { - int i; - for (i = 0; i < MAX_THREADS; i++) - { - if (pseudo_children[i].ti_pid == pid) - return i; - } - return -1; + int i; + for (i = 0; i < MAX_THREADS; i++) + { + if (pseudo_children[i].ti_pid == pid) + return i; + } + return -1; } struct child_arg { - struct Task *ca_parent_task; - pthread_t ca_parent; - PerlInterpreter *ca_interp; + struct Task *ca_parent_task; + pthread_t ca_parent; + PerlInterpreter *ca_interp; }; #undef kill @@ -362,202 +362,202 @@ struct child_arg int amigaos_kill(Pid_t pid, int signal) { - int i; - BOOL thistask = FALSE; - Pid_t realpid = pid; // Perhaps we have a real pid from else where? - /* Look for our DOS pid */ - IExec->ObtainSemaphore(&fork_array_sema); - for (i = 0; i < MAX_THREADS; i++) - { - if (pseudo_children[i].ti_pid == pid) - { - realpid = (Pid_t)IDOS->GetPID(pseudo_children[i].ti_Process,GPID_PROCESS); - if(pseudo_children[i].ti_Process == (struct Process *)IExec->FindTask(NULL)) - { - thistask = TRUE; - } - break; - } - } - IExec->ReleaseSemaphore(&fork_array_sema); - /* Allow the C library to work out which signals are realy valid */ - if(thistask) - { - /* A quirk in newlib kill handling means it's better to call raise() rather than kill on out own task. */ - return raise(signal); - } - else - { - return kill(realpid,signal); - } + int i; + BOOL thistask = FALSE; + Pid_t realpid = pid; // Perhaps we have a real pid from else where? + /* Look for our DOS pid */ + IExec->ObtainSemaphore(&fork_array_sema); + for (i = 0; i < MAX_THREADS; i++) + { + if (pseudo_children[i].ti_pid == pid) + { + realpid = (Pid_t)IDOS->GetPID(pseudo_children[i].ti_Process,GPID_PROCESS); + if(pseudo_children[i].ti_Process == (struct Process *)IExec->FindTask(NULL)) + { + thistask = TRUE; + } + break; + } + } + IExec->ReleaseSemaphore(&fork_array_sema); + /* Allow the C library to work out which signals are realy valid */ + if(thistask) + { + /* A quirk in newlib kill handling means it's better to call raise() rather than kill on out own task. */ + return raise(signal); + } + else + { + return kill(realpid,signal); + } } static THREAD_RET_TYPE amigaos4_start_child(void *arg) { - PerlInterpreter *my_perl = - (PerlInterpreter *)((struct child_arg *)arg)->ca_interp; - ; + PerlInterpreter *my_perl = + (PerlInterpreter *)((struct child_arg *)arg)->ca_interp; + ; - GV *tmpgv; - int status; - int parent; - int nextchild; - pthread_t pseudo_id = pthread_self(); + GV *tmpgv; + int status; + int parent; + int nextchild; + pthread_t pseudo_id = pthread_self(); #ifdef PERL_SYNC_FORK - static long sync_fork_id = 0; - long id = ++sync_fork_id; + static long sync_fork_id = 0; + long id = ++sync_fork_id; #endif - /* before we do anything set up our process semaphore and add - a new entry to the pseudochildren */ + /* before we do anything set up our process semaphore and add + a new entry to the pseudochildren */ - /* get next available slot */ - /* should not fail here! */ + /* get next available slot */ + /* should not fail here! */ - IExec->ObtainSemaphore(&fork_array_sema); + IExec->ObtainSemaphore(&fork_array_sema); - nextchild = getnextchild(); + nextchild = getnextchild(); - pseudo_children[nextchild].ti_pid = pseudo_id; - pseudo_children[nextchild].ti_Process = (struct Process *)IExec->FindTask(NULL); - pseudo_children[nextchild].ti_parent = - ((struct child_arg *)arg)->ca_parent; - pseudo_children[nextchild].ti_port = - (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE); + pseudo_children[nextchild].ti_pid = pseudo_id; + pseudo_children[nextchild].ti_Process = (struct Process *)IExec->FindTask(NULL); + pseudo_children[nextchild].ti_parent = + ((struct child_arg *)arg)->ca_parent; + pseudo_children[nextchild].ti_port = + (struct MsgPort *)IExec->AllocSysObjectTags(ASOT_PORT, TAG_DONE); - num_pseudo_children++; - IExec->ReleaseSemaphore(&fork_array_sema); + num_pseudo_children++; + IExec->ReleaseSemaphore(&fork_array_sema); - /* We're set up let the parent continue */ + /* We're set up let the parent continue */ - IExec->Signal(((struct child_arg *)arg)->ca_parent_task, - SIGBREAKF_CTRL_F); + IExec->Signal(((struct child_arg *)arg)->ca_parent_task, + SIGBREAKF_CTRL_F); - PERL_SET_THX(my_perl); - if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) - { - SV *sv = GvSV(tmpgv); - SvREADONLY_off(sv); - sv_setiv(sv, (IV)pseudo_id); - SvREADONLY_on(sv); - } - hv_clear(PL_pidstatus); + PERL_SET_THX(my_perl); + if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV))) + { + SV *sv = GvSV(tmpgv); + SvREADONLY_off(sv); + sv_setiv(sv, (IV)pseudo_id); + SvREADONLY_on(sv); + } + hv_clear(PL_pidstatus); - /* push a zero on the stack (we are the child) */ - { - dSP; - dTARGET; - PUSHi(0); - PUTBACK; - } + /* push a zero on the stack (we are the child) */ + { + dSP; + dTARGET; + PUSHi(0); + PUTBACK; + } - /* continue from next op */ - PL_op = PL_op->op_next; + /* continue from next op */ + PL_op = PL_op->op_next; - { - dJMPENV; - volatile int oldscope = PL_scopestack_ix; + { + dJMPENV; + volatile int oldscope = PL_scopestack_ix; restart: - JMPENV_PUSH(status); - switch (status) - { - case 0: - CALLRUNOPS(aTHX); - status = 0; - break; - case 2: - while (PL_scopestack_ix > oldscope) - { - LEAVE; - } - FREETMPS; - PL_curstash = PL_defstash; - if (PL_endav && !PL_minus_c) - call_list(oldscope, PL_endav); - status = STATUS_EXIT; - break; - case 3: - if (PL_restartop) - { - POPSTACK_TO(PL_mainstack); - PL_op = PL_restartop; - PL_restartop = (OP *)NULL; - ; - goto restart; - } - PerlIO_printf(Perl_error_log, "panic: restartop\n"); - FREETMPS; - status = 1; - break; - } - JMPENV_POP; - - /* XXX hack to avoid perl_destruct() freeing optree */ - PL_main_root = (OP *)NULL; - } - - { - do_close(PL_stdingv, FALSE); - do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), - FALSE); /* PL_stdoutgv - ISAGN */ - do_close(PL_stderrgv, FALSE); - } - - /* destroy everything (waits for any pseudo-forked children) */ - - /* wait for any remaining children */ - - while (pseudo_children[nextchild].ti_children > 0) - { - if (IExec->WaitPort(pseudo_children[nextchild].ti_port)) - { - void *msg = - IExec->GetMsg(pseudo_children[nextchild].ti_port); - IExec->FreeSysObject(ASOT_MESSAGE, msg); - pseudo_children[nextchild].ti_children--; - } - } - if (PL_scopestack_ix <= 1) - { - perl_destruct(my_perl); - } - perl_free(my_perl); - - IExec->ObtainSemaphore(&fork_array_sema); - parent = findparent(pseudo_children[nextchild].ti_parent); - pseudo_children[nextchild].ti_pid = 0; - pseudo_children[nextchild].ti_parent = 0; - IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port); - pseudo_children[nextchild].ti_port = NULL; - - IExec->ReleaseSemaphore(&fork_array_sema); - - { - if (parent >= 0) - { - struct thread_exit_message *tem = - (struct thread_exit_message *) - IExec->AllocSysObjectTags( - ASOT_MESSAGE, ASOMSG_Size, - sizeof(struct thread_exit_message), - ASOMSG_Length, - sizeof(struct thread_exit_message)); - if (tem) - { - tem->tem_pid = pseudo_id; - tem->tem_status = status; - IExec->PutMsg(pseudo_children[parent].ti_port, - (struct Message *)tem); - } - } - } + JMPENV_PUSH(status); + switch (status) + { + case 0: + CALLRUNOPS(aTHX); + status = 0; + break; + case 2: + while (PL_scopestack_ix > oldscope) + { + LEAVE; + } + FREETMPS; + PL_curstash = PL_defstash; + if (PL_endav && !PL_minus_c) + call_list(oldscope, PL_endav); + status = STATUS_EXIT; + break; + case 3: + if (PL_restartop) + { + POPSTACK_TO(PL_mainstack); + PL_op = PL_restartop; + PL_restartop = (OP *)NULL; + ; + goto restart; + } + PerlIO_printf(Perl_error_log, "panic: restartop\n"); + FREETMPS; + status = 1; + break; + } + JMPENV_POP; + + /* XXX hack to avoid perl_destruct() freeing optree */ + PL_main_root = (OP *)NULL; + } + + { + do_close(PL_stdingv, FALSE); + do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), + FALSE); /* PL_stdoutgv - ISAGN */ + do_close(PL_stderrgv, FALSE); + } + + /* destroy everything (waits for any pseudo-forked children) */ + + /* wait for any remaining children */ + + while (pseudo_children[nextchild].ti_children > 0) + { + if (IExec->WaitPort(pseudo_children[nextchild].ti_port)) + { + void *msg = + IExec->GetMsg(pseudo_children[nextchild].ti_port); + IExec->FreeSysObject(ASOT_MESSAGE, msg); + pseudo_children[nextchild].ti_children--; + } + } + if (PL_scopestack_ix <= 1) + { + perl_destruct(my_perl); + } + perl_free(my_perl); + + IExec->ObtainSemaphore(&fork_array_sema); + parent = findparent(pseudo_children[nextchild].ti_parent); + pseudo_children[nextchild].ti_pid = 0; + pseudo_children[nextchild].ti_parent = 0; + IExec->FreeSysObject(ASOT_PORT, pseudo_children[nextchild].ti_port); + pseudo_children[nextchild].ti_port = NULL; + + IExec->ReleaseSemaphore(&fork_array_sema); + + { + if (parent >= 0) + { + struct thread_exit_message *tem = + (struct thread_exit_message *) + IExec->AllocSysObjectTags( + ASOT_MESSAGE, ASOMSG_Size, + sizeof(struct thread_exit_message), + ASOMSG_Length, + sizeof(struct thread_exit_message)); + if (tem) + { + tem->tem_pid = pseudo_id; + tem->tem_status = status; + IExec->PutMsg(pseudo_children[parent].ti_port, + (struct Message *)tem); + } + } + } #ifdef PERL_SYNC_FORK - return id; + return id; #else - return (void *)status; + return (void *)status; #endif } @@ -565,61 +565,61 @@ static THREAD_RET_TYPE amigaos4_start_child(void *arg) Pid_t amigaos_fork() { - dTHX; - pthread_t id; - int handle; - struct child_arg arg; - if (num_pseudo_children >= MAX_THREADS) - { - errno = EAGAIN; - return -1; - } - arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS); - arg.ca_parent_task = IExec->FindTask(NULL); - arg.ca_parent = - pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0); - - handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg); - pseudo_children[findparent(arg.ca_parent)].ti_children++; - - IExec->Wait(SIGBREAKF_CTRL_F); - - PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */ - if (handle) - { - errno = EAGAIN; - return -1; - } - return id; + dTHX; + pthread_t id; + int handle; + struct child_arg arg; + if (num_pseudo_children >= MAX_THREADS) + { + errno = EAGAIN; + return -1; + } + arg.ca_interp = perl_clone((PerlInterpreter *)aTHX, CLONEf_COPY_STACKS); + arg.ca_parent_task = IExec->FindTask(NULL); + arg.ca_parent = + pthread_self() ? pthread_self() : (pthread_t)IExec->FindTask(0); + + handle = pthread_create(&id, NULL, amigaos4_start_child, (void *)&arg); + pseudo_children[findparent(arg.ca_parent)].ti_children++; + + IExec->Wait(SIGBREAKF_CTRL_F); + + PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */ + if (handle) + { + errno = EAGAIN; + return -1; + } + return id; } Pid_t amigaos_waitpid(pTHX_ int optype, Pid_t pid, void *argflags) { - int result; - if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) - { - result = pthread_join(pid, (void **)argflags); - } - else - { - while ((result = pthread_join(pid, (void **)argflags)) == -1 && - errno == EINTR) - { - // PERL_ASYNC_CHECK(); - } - } - return result; + int result; + if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) + { + result = pthread_join(pid, (void **)argflags); + } + else + { + while ((result = pthread_join(pid, (void **)argflags)) == -1 && + errno == EINTR) + { + // PERL_ASYNC_CHECK(); + } + } + return result; } void amigaos_fork_set_userdata( pTHX_ struct UserData *userdata, I32 did_pipes, int pp, SV **sp, SV **mark) { - userdata->parent = IExec->FindTask(0); - userdata->did_pipes = did_pipes; - userdata->pp = pp; - userdata->sp = sp; - userdata->mark = mark; - userdata->my_perl = aTHX; + userdata->parent = IExec->FindTask(0); + userdata->did_pipes = did_pipes; + userdata->pp = pp; + userdata->sp = sp; + userdata->mark = mark; + userdata->my_perl = aTHX; } /* AmigaOS specific versions of #?exec#? solely for use in amigaos_system_child @@ -627,275 +627,275 @@ void amigaos_fork_set_userdata( static void S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) { - const int e = errno; + const int e = errno; // PERL_ARGS_ASSERT_EXEC_FAILED; - if (e) - { - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), - "Can't exec \"%s\": %s", cmd, Strerror(e)); - } - if (do_report) - { - /* XXX silently ignore failures */ - PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int))); - PerlLIO_close(fd); - } + if (e) + { + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), + "Can't exec \"%s\": %s", cmd, Strerror(e)); + } + if (do_report) + { + /* XXX silently ignore failures */ + PERL_UNUSED_RESULT(PerlLIO_write(fd, (void *)&e, sizeof(int))); + PerlLIO_close(fd); + } } static I32 S_do_amigaos_exec3(pTHX_ const char *incmd, int fd, int do_report) { - const char **argv, **a; - char *s; - char *buf; - char *cmd; - /* Make a copy so we can change it */ - const Size_t cmdlen = strlen(incmd) + 1; - I32 result = -1; - - PERL_ARGS_ASSERT_DO_EXEC3; - - ENTER; - Newx(buf, cmdlen, char); - SAVEFREEPV(buf); - cmd = buf; - memcpy(cmd, incmd, cmdlen); - - while (*cmd && isSPACE(*cmd)) - cmd++; - - /* see if there are shell metacharacters in it */ - - if (*cmd == '.' && isSPACE(cmd[1])) - goto doshell; - - if (strBEGINs(cmd, "exec") && isSPACE(cmd[4])) - goto doshell; - - s = cmd; - while (isWORDCHAR(*s)) - s++; /* catch VAR=val gizmo */ - if (*s == '=') - goto doshell; - - for (s = cmd; *s; s++) - { - if (*s != ' ' && !isALPHA(*s) && - memCHRs("$&*(){}[]'\";\\|?<>~`\n", *s)) - { - if (*s == '\n' && !s[1]) - { - *s = '\0'; - break; - } - /* handle the 2>&1 construct at the end */ - if (*s == '>' && s[1] == '&' && s[2] == '1' && - s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) && - (!s[3] || isSPACE(s[3]))) - { - const char *t = s + 3; - - while (*t && isSPACE(*t)) - ++t; - if (!*t && (PerlLIO_dup2(1, 2) != -1)) - { - s[-2] = '\0'; - break; - } - } + const char **argv, **a; + char *s; + char *buf; + char *cmd; + /* Make a copy so we can change it */ + const Size_t cmdlen = strlen(incmd) + 1; + I32 result = -1; + + PERL_ARGS_ASSERT_DO_EXEC3; + + ENTER; + Newx(buf, cmdlen, char); + SAVEFREEPV(buf); + cmd = buf; + memcpy(cmd, incmd, cmdlen); + + while (*cmd && isSPACE(*cmd)) + cmd++; + + /* see if there are shell metacharacters in it */ + + if (*cmd == '.' && isSPACE(cmd[1])) + goto doshell; + + if (strBEGINs(cmd, "exec") && isSPACE(cmd[4])) + goto doshell; + + s = cmd; + while (isWORDCHAR(*s)) + s++; /* catch VAR=val gizmo */ + if (*s == '=') + goto doshell; + + for (s = cmd; *s; s++) + { + if (*s != ' ' && !isALPHA(*s) && + memCHRs("$&*(){}[]'\";\\|?<>~`\n", *s)) + { + if (*s == '\n' && !s[1]) + { + *s = '\0'; + break; + } + /* handle the 2>&1 construct at the end */ + if (*s == '>' && s[1] == '&' && s[2] == '1' && + s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) && + (!s[3] || isSPACE(s[3]))) + { + const char *t = s + 3; + + while (*t && isSPACE(*t)) + ++t; + if (!*t && (PerlLIO_dup2(1, 2) != -1)) + { + s[-2] = '\0'; + break; + } + } doshell: - PERL_FPU_PRE_EXEC - result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd, - (char *)NULL); - PERL_FPU_POST_EXEC - S_exec_failed(aTHX_ PL_sh_path, fd, do_report); - amigaos_post_exec(fd, do_report); - goto leave; - } - } - - Newx(argv, (s - cmd) / 2 + 2, const char *); - SAVEFREEPV(argv); - cmd = savepvn(cmd, s - cmd); - SAVEFREEPV(cmd); - a = argv; - for (s = cmd; *s;) - { - while (isSPACE(*s)) - s++; - if (*s) - *(a++) = s; - while (*s && !isSPACE(*s)) - s++; - if (*s) - *s++ = '\0'; - } - *a = NULL; - if (argv[0]) - { - PERL_FPU_PRE_EXEC - result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv)); - PERL_FPU_POST_EXEC - if (errno == ENOEXEC) /* for system V NIH syndrome */ - goto doshell; - S_exec_failed(aTHX_ argv[0], fd, do_report); - amigaos_post_exec(fd, do_report); - } + PERL_FPU_PRE_EXEC + result = myexecl(FALSE, PL_sh_path, "sh", "-c", cmd, + (char *)NULL); + PERL_FPU_POST_EXEC + S_exec_failed(aTHX_ PL_sh_path, fd, do_report); + amigaos_post_exec(fd, do_report); + goto leave; + } + } + + Newx(argv, (s - cmd) / 2 + 2, const char *); + SAVEFREEPV(argv); + cmd = savepvn(cmd, s - cmd); + SAVEFREEPV(cmd); + a = argv; + for (s = cmd; *s;) + { + while (isSPACE(*s)) + s++; + if (*s) + *(a++) = s; + while (*s && !isSPACE(*s)) + s++; + if (*s) + *s++ = '\0'; + } + *a = NULL; + if (argv[0]) + { + PERL_FPU_PRE_EXEC + result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv)); + PERL_FPU_POST_EXEC + if (errno == ENOEXEC) /* for system V NIH syndrome */ + goto doshell; + S_exec_failed(aTHX_ argv[0], fd, do_report); + amigaos_post_exec(fd, do_report); + } leave: - LEAVE; - return result; + LEAVE; + return result; } I32 S_do_amigaos_aexec5( pTHX_ SV *really, SV **mark, SV **sp, int fd, int do_report) { - I32 result = -1; - PERL_ARGS_ASSERT_DO_AEXEC5; - ENTER; - if (sp > mark) - { - const char **argv, **a; - const char *tmps = NULL; - Newx(argv, sp - mark + 1, const char *); - SAVEFREEPV(argv); - a = argv; - - while (++mark <= sp) - { - if (*mark) { - char *arg = savepv(SvPV_nolen_const(*mark)); - SAVEFREEPV(arg); - *a++ = arg; - } else - *a++ = ""; - } - *a = NULL; - if (really) { - tmps = savepv(SvPV_nolen_const(really)); - SAVEFREEPV(tmps); - } - if ((!really && *argv[0] != '/') || - (really && *tmps != '/')) /* will execvp use PATH? */ - TAINT_ENV(); /* testing IFS here is overkill, probably + I32 result = -1; + PERL_ARGS_ASSERT_DO_AEXEC5; + ENTER; + if (sp > mark) + { + const char **argv, **a; + const char *tmps = NULL; + Newx(argv, sp - mark + 1, const char *); + SAVEFREEPV(argv); + a = argv; + + while (++mark <= sp) + { + if (*mark) { + char *arg = savepv(SvPV_nolen_const(*mark)); + SAVEFREEPV(arg); + *a++ = arg; + } else + *a++ = ""; + } + *a = NULL; + if (really) { + tmps = savepv(SvPV_nolen_const(really)); + SAVEFREEPV(tmps); + } + if ((!really && *argv[0] != '/') || + (really && *tmps != '/')) /* will execvp use PATH? */ + TAINT_ENV(); /* testing IFS here is overkill, probably */ - PERL_FPU_PRE_EXEC - if (really && *tmps) - { - result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(argv)); - } - else - { - result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv)); - } - PERL_FPU_POST_EXEC - S_exec_failed(aTHX_(really ? tmps : argv[0]), fd, do_report); - } - amigaos_post_exec(fd, do_report); - LEAVE; - return result; + PERL_FPU_PRE_EXEC + if (really && *tmps) + { + result = myexecvp(FALSE, tmps, EXEC_ARGV_CAST(argv)); + } + else + { + result = myexecvp(FALSE, argv[0], EXEC_ARGV_CAST(argv)); + } + PERL_FPU_POST_EXEC + S_exec_failed(aTHX_(really ? tmps : argv[0]), fd, do_report); + } + amigaos_post_exec(fd, do_report); + LEAVE; + return result; } void *amigaos_system_child(void *userdata) { - struct Task *parent; - I32 did_pipes; - int pp; - I32 value; - STRLEN n_a; - /* these next are declared by macros else where but I may be - * passing modified values here so declare them explictly but - * still referred to by macro below */ - - register SV **sp; - register SV **mark; - register PerlInterpreter *my_perl; - - StdioStore store; - - struct UserData *ud = (struct UserData *)userdata; - - did_pipes = ud->did_pipes; - parent = ud->parent; - pp = ud->pp; - SP = ud->sp; - MARK = ud->mark; - my_perl = ud->my_perl; - PERL_SET_THX(my_perl); - - amigaos_stdio_save(aTHX_ & store); - - if (did_pipes) - { - // PerlLIO_close(pp[0]); - } - if (PL_op->op_flags & OPf_STACKED) - { - SV *really = *++MARK; - value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp, - did_pipes); - } - else if (SP - MARK != 1) - { - value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp, - did_pipes); - } - else - { - value = (I32)S_do_amigaos_exec3( - aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes); - } - - // Forbid(); - // Signal(parent, SIGBREAKF_CTRL_F); - - amigaos_stdio_restore(aTHX_ & store); - - return (void *)value; + struct Task *parent; + I32 did_pipes; + int pp; + I32 value; + STRLEN n_a; + /* these next are declared by macros else where but I may be + * passing modified values here so declare them explictly but + * still referred to by macro below */ + + register SV **sp; + register SV **mark; + register PerlInterpreter *my_perl; + + StdioStore store; + + struct UserData *ud = (struct UserData *)userdata; + + did_pipes = ud->did_pipes; + parent = ud->parent; + pp = ud->pp; + SP = ud->sp; + MARK = ud->mark; + my_perl = ud->my_perl; + PERL_SET_THX(my_perl); + + amigaos_stdio_save(aTHX_ & store); + + if (did_pipes) + { + // PerlLIO_close(pp[0]); + } + if (PL_op->op_flags & OPf_STACKED) + { + SV *really = *++MARK; + value = (I32)S_do_amigaos_aexec5(aTHX_ really, MARK, SP, pp, + did_pipes); + } + else if (SP - MARK != 1) + { + value = (I32)S_do_amigaos_aexec5(aTHX_ NULL, MARK, SP, pp, + did_pipes); + } + else + { + value = (I32)S_do_amigaos_exec3( + aTHX_ SvPVx(sv_mortalcopy(*SP), n_a), pp, did_pipes); + } + + // Forbid(); + // Signal(parent, SIGBREAKF_CTRL_F); + + amigaos_stdio_restore(aTHX_ & store); + + return (void *)value; } static BOOL contains_whitespace(char *string) { - if (string) - { - - if (strchr(string, ' ')) - return TRUE; - if (strchr(string, '\t')) - return TRUE; - if (strchr(string, '\n')) - return TRUE; - if (strchr(string, 0xA0)) - return TRUE; - if (strchr(string, '"')) - return TRUE; - } - return FALSE; + if (string) + { + + if (strchr(string, ' ')) + return TRUE; + if (strchr(string, '\t')) + return TRUE; + if (strchr(string, '\n')) + return TRUE; + if (strchr(string, 0xA0)) + return TRUE; + if (strchr(string, '"')) + return TRUE; + } + return FALSE; } static int no_of_escapes(char *string) { - int cnt = 0; - char *p; - for (p = string; p < string + strlen(string); p++) - { - if (*p == '"') - cnt++; - if (*p == '*') - cnt++; - if (*p == '\n') - cnt++; - if (*p == '\t') - cnt++; - } - return cnt; + int cnt = 0; + char *p; + for (p = string; p < string + strlen(string); p++) + { + if (*p == '"') + cnt++; + if (*p == '*') + cnt++; + if (*p == '\n') + cnt++; + if (*p == '\t') + cnt++; + } + return cnt; } struct command_data { - STRPTR args; - BPTR seglist; - struct Task *parent; + STRPTR args; + BPTR seglist; + struct Task *parent; }; #undef fopen @@ -910,262 +910,262 @@ int myexecve(bool isperlthread, char *argv[], char *envp[]) { - FILE *fh; - char buffer[1000]; - int size = 0; - char **cur; - char *interpreter = 0; - char *interpreter_args = 0; - char *full = 0; - char *filename_conv = 0; - char *interpreter_conv = 0; - // char *tmp = 0; - char *fname; - // int tmpint; - // struct Task *thisTask = IExec->FindTask(0); - int result = -1; - - StdioStore store; - - pTHX = NULL; - - if (isperlthread) - { - aTHX = PERL_GET_THX; - /* Save away our stdio */ - amigaos_stdio_save(aTHX_ & store); - } - - // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL"); - - /* Calculate the size of filename and all args, including spaces and - * quotes */ - size = 0; // strlen(filename) + 1; - for (cur = (char **)argv /* +1 */; *cur; cur++) - { - size += - strlen(*cur) + 1 + - (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0); - } - /* Check if it's a script file */ - IExec->DebugPrintF("%s %ld %08lx %c %c\n",__FILE__,__LINE__,filename,filename[0],filename[1]); - fh = fopen(filename, "r"); - if (fh) - { - if (fgetc(fh) == '#' && fgetc(fh) == '!') - { - char *p; - char *q; - fgets(buffer, 999, fh); - p = buffer; - while (*p == ' ' || *p == '\t') - p++; - if (buffer[strlen(buffer) - 1] == '\n') - buffer[strlen(buffer) - 1] = '\0'; - if ((q = strchr(p, ' '))) - { - *q++ = '\0'; - if (*q != '\0') - { - interpreter_args = mystrdup(q); - } - } - else - interpreter_args = mystrdup(""); - - interpreter = mystrdup(p); - size += strlen(interpreter) + 1; - size += strlen(interpreter_args) + 1; - } - - fclose(fh); - } - else - { - /* We couldn't open this why not? */ - if (errno == ENOENT) - { - /* file didn't exist! */ - goto out; - } - } - - /* Allocate the command line */ - filename_conv = convert_path_u2a(filename); - - if (filename_conv) - size += strlen(filename_conv); - size += 1; - full = (char *)IExec->AllocVecTags(size + 10, AVT_ClearWithValue, 0 ,TAG_DONE); - if (full) - { - if (interpreter) - { - interpreter_conv = convert_path_u2a(interpreter); + FILE *fh; + char buffer[1000]; + int size = 0; + char **cur; + char *interpreter = 0; + char *interpreter_args = 0; + char *full = 0; + char *filename_conv = 0; + char *interpreter_conv = 0; + // char *tmp = 0; + char *fname; + // int tmpint; + // struct Task *thisTask = IExec->FindTask(0); + int result = -1; + + StdioStore store; + + pTHX = NULL; + + if (isperlthread) + { + aTHX = PERL_GET_THX; + /* Save away our stdio */ + amigaos_stdio_save(aTHX_ & store); + } + + // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,filename?filename:"NULL"); + + /* Calculate the size of filename and all args, including spaces and + * quotes */ + size = 0; // strlen(filename) + 1; + for (cur = (char **)argv /* +1 */; *cur; cur++) + { + size += + strlen(*cur) + 1 + + (contains_whitespace(*cur) ? (2 + no_of_escapes(*cur)) : 0); + } + /* Check if it's a script file */ + IExec->DebugPrintF("%s %ld %08lx %c %c\n",__FILE__,__LINE__,filename,filename[0],filename[1]); + fh = fopen(filename, "r"); + if (fh) + { + if (fgetc(fh) == '#' && fgetc(fh) == '!') + { + char *p; + char *q; + fgets(buffer, 999, fh); + p = buffer; + while (*p == ' ' || *p == '\t') + p++; + if (buffer[strlen(buffer) - 1] == '\n') + buffer[strlen(buffer) - 1] = '\0'; + if ((q = strchr(p, ' '))) + { + *q++ = '\0'; + if (*q != '\0') + { + interpreter_args = mystrdup(q); + } + } + else + interpreter_args = mystrdup(""); + + interpreter = mystrdup(p); + size += strlen(interpreter) + 1; + size += strlen(interpreter_args) + 1; + } + + fclose(fh); + } + else + { + /* We couldn't open this why not? */ + if (errno == ENOENT) + { + /* file didn't exist! */ + goto out; + } + } + + /* Allocate the command line */ + filename_conv = convert_path_u2a(filename); + + if (filename_conv) + size += strlen(filename_conv); + size += 1; + full = (char *)IExec->AllocVecTags(size + 10, AVT_ClearWithValue, 0 ,TAG_DONE); + if (full) + { + if (interpreter) + { + interpreter_conv = convert_path_u2a(interpreter); #if !defined(__USE_RUNCOMMAND__) #warning(using system!) - sprintf(full, "%s %s %s ", interpreter_conv, - interpreter_args, filename_conv); + sprintf(full, "%s %s %s ", interpreter_conv, + interpreter_args, filename_conv); #else - sprintf(full, "%s %s ", interpreter_args, - filename_conv); + sprintf(full, "%s %s ", interpreter_args, + filename_conv); #endif - IExec->FreeVec(interpreter); - IExec->FreeVec(interpreter_args); - - if (filename_conv) - IExec->FreeVec(filename_conv); - fname = mystrdup(interpreter_conv); - - if (interpreter_conv) - IExec->FreeVec(interpreter_conv); - } - else - { + IExec->FreeVec(interpreter); + IExec->FreeVec(interpreter_args); + + if (filename_conv) + IExec->FreeVec(filename_conv); + fname = mystrdup(interpreter_conv); + + if (interpreter_conv) + IExec->FreeVec(interpreter_conv); + } + else + { #ifndef __USE_RUNCOMMAND__ - sprintf(full, "%s ", filename_conv); + sprintf(full, "%s ", filename_conv); #else - sprintf(full, ""); + sprintf(full, ""); #endif - fname = mystrdup(filename_conv); - if (filename_conv) - IExec->FreeVec(filename_conv); - } - - for (cur = (char **)(argv + 1); *cur != 0; cur++) - { - if (contains_whitespace(*cur)) - { - int esc = no_of_escapes(*cur); - - if (esc > 0) - { - char *buff = (char *)IExec->AllocVecTags( - strlen(*cur) + 4 + esc, - AVT_ClearWithValue,0, - TAG_DONE); - char *p = *cur; - char *q = buff; - - *q++ = '"'; - while (*p != '\0') - { - - if (*p == '\n') - { - *q++ = '*'; - *q++ = 'N'; - p++; - continue; - } - else if (*p == '"') - { - *q++ = '*'; - *q++ = '"'; - p++; - continue; - } - else if (*p == '*') - { - *q++ = '*'; - } - *q++ = *p++; - } - *q++ = '"'; - *q++ = ' '; - *q = '\0'; - strcat(full, buff); - IExec->FreeVec(buff); - } - else - { - strcat(full, "\""); - strcat(full, *cur); - strcat(full, "\" "); - } - } - else - { - strcat(full, *cur); - strcat(full, " "); - } - } - strcat(full, "\n"); + fname = mystrdup(filename_conv); + if (filename_conv) + IExec->FreeVec(filename_conv); + } + + for (cur = (char **)(argv + 1); *cur != 0; cur++) + { + if (contains_whitespace(*cur)) + { + int esc = no_of_escapes(*cur); + + if (esc > 0) + { + char *buff = (char *)IExec->AllocVecTags( + strlen(*cur) + 4 + esc, + AVT_ClearWithValue,0, + TAG_DONE); + char *p = *cur; + char *q = buff; + + *q++ = '"'; + while (*p != '\0') + { + + if (*p == '\n') + { + *q++ = '*'; + *q++ = 'N'; + p++; + continue; + } + else if (*p == '"') + { + *q++ = '*'; + *q++ = '"'; + p++; + continue; + } + else if (*p == '*') + { + *q++ = '*'; + } + *q++ = *p++; + } + *q++ = '"'; + *q++ = ' '; + *q = '\0'; + strcat(full, buff); + IExec->FreeVec(buff); + } + else + { + strcat(full, "\""); + strcat(full, *cur); + strcat(full, "\" "); + } + } + else + { + strcat(full, *cur); + strcat(full, " "); + } + } + strcat(full, "\n"); // if(envp) // createvars(envp); #ifndef __USE_RUNCOMMAND__ - result = IDOS->SystemTags( - full, SYS_UserShell, TRUE, NP_StackSize, - ((struct Process *)thisTask)->pr_StackSize, SYS_Input, - ((struct Process *)thisTask)->pr_CIS, SYS_Output, - ((struct Process *)thisTask)->pr_COS, SYS_Error, - ((struct Process *)thisTask)->pr_CES, TAG_DONE); + result = IDOS->SystemTags( + full, SYS_UserShell, TRUE, NP_StackSize, + ((struct Process *)thisTask)->pr_StackSize, SYS_Input, + ((struct Process *)thisTask)->pr_CIS, SYS_Output, + ((struct Process *)thisTask)->pr_COS, SYS_Error, + ((struct Process *)thisTask)->pr_CES, TAG_DONE); #else - if (fname) - { - BPTR seglist = IDOS->LoadSeg(fname); - if (seglist) - { - /* check if we have an executable! */ - struct PseudoSegList *ps = NULL; - if (!IDOS->GetSegListInfoTags( - seglist, GSLI_Native, &ps, TAG_DONE)) - { - IDOS->GetSegListInfoTags( - seglist, GSLI_68KPS, &ps, TAG_DONE); - } - if (ps != NULL) - { - // adebug("%s %ld %s - // %s\n",__FUNCTION__,__LINE__,fname,full); - IDOS->SetCliProgramName(fname); - // result=RunCommand(seglist,8*1024,full,strlen(full)); - // result=myruncommand(seglist,8*1024,full,strlen(full),envp); - result = myruncommand(seglist, 8 * 1024, - full, -1, envp); - errno = 0; - } - else - { - errno = ENOEXEC; - } - IDOS->UnLoadSeg(seglist); - } - else - { - errno = ENOEXEC; - } - IExec->FreeVec(fname); - } + if (fname) + { + BPTR seglist = IDOS->LoadSeg(fname); + if (seglist) + { + /* check if we have an executable! */ + struct PseudoSegList *ps = NULL; + if (!IDOS->GetSegListInfoTags( + seglist, GSLI_Native, &ps, TAG_DONE)) + { + IDOS->GetSegListInfoTags( + seglist, GSLI_68KPS, &ps, TAG_DONE); + } + if (ps != NULL) + { + // adebug("%s %ld %s + // %s\n",__FUNCTION__,__LINE__,fname,full); + IDOS->SetCliProgramName(fname); + // result=RunCommand(seglist,8*1024,full,strlen(full)); + // result=myruncommand(seglist,8*1024,full,strlen(full),envp); + result = myruncommand(seglist, 8 * 1024, + full, -1, envp); + errno = 0; + } + else + { + errno = ENOEXEC; + } + IDOS->UnLoadSeg(seglist); + } + else + { + errno = ENOEXEC; + } + IExec->FreeVec(fname); + } #endif /* USE_RUNCOMMAND */ - IExec->FreeVec(full); - if (errno == ENOEXEC) - { - result = -1; - } - goto out; - } + IExec->FreeVec(full); + if (errno == ENOEXEC) + { + result = -1; + } + goto out; + } - if (interpreter) - IExec->FreeVec(interpreter); - if (filename_conv) - IExec->FreeVec(filename_conv); + if (interpreter) + IExec->FreeVec(interpreter); + if (filename_conv) + IExec->FreeVec(filename_conv); - errno = ENOMEM; + errno = ENOMEM; out: - if (isperlthread) - { - amigaos_stdio_restore(aTHX_ & store); - STATUS_NATIVE_CHILD_SET(result); - PL_exit_flags |= PERL_EXIT_EXPECTED; - if (result != -1) - my_exit(result); - } - return (result); + if (isperlthread) + { + amigaos_stdio_restore(aTHX_ & store); + STATUS_NATIVE_CHILD_SET(result); + PL_exit_flags |= PERL_EXIT_EXPECTED; + if (result != -1) + my_exit(result); + } + return (result); } diff --git a/amigaos4/amigaio.h b/amigaos4/amigaio.h index 1f1a53a0dee0..0385ce14bd55 100644 --- a/amigaos4/amigaio.h +++ b/amigaos4/amigaio.h @@ -7,14 +7,14 @@ struct StdioStore { - /* astdin...astderr are the amigaos file descriptors */ - long astdin; - long astdout; - long astderr; - /* oldstdin...oldstderr are the amigados file handles */ - long oldstdin; - long oldstdout; - long oldstderr; + /* astdin...astderr are the amigaos file descriptors */ + long astdin; + long astdout; + long astderr; + /* oldstdin...oldstderr are the amigados file handles */ + long oldstdin; + long oldstdout; + long oldstderr; }; typedef struct StdioStore StdioStore; @@ -32,12 +32,12 @@ void amigaos_stdio_restore(pTHX_ const StdioStore *store); * then pass it through task->tc_UserData or as arg to new pthread */ struct UserData { - struct Task *parent; - I32 did_pipes; - int pp; - SV **sp; - SV **mark; - PerlInterpreter *my_perl; + struct Task *parent; + I32 did_pipes; + int pp; + SV **sp; + SV **mark; + PerlInterpreter *my_perl; }; void amigaos_fork_set_userdata( diff --git a/amigaos4/amigaos.c b/amigaos4/amigaos.c index 7d432d9dfc2f..cf5967315fe0 100644 --- a/amigaos4/amigaos.c +++ b/amigaos4/amigaos.c @@ -36,28 +36,28 @@ struct UtilityIFace *IUtility = NULL; struct Interface *OpenInterface(CONST_STRPTR libname, uint32 libver) { - struct Library *base = IExec->OpenLibrary(libname, libver); - struct Interface *iface = IExec->GetInterface(base, "main", 1, NULL); - if (iface == NULL) - { - // We should probably post some kind of error message here. + struct Library *base = IExec->OpenLibrary(libname, libver); + struct Interface *iface = IExec->GetInterface(base, "main", 1, NULL); + if (iface == NULL) + { + // We should probably post some kind of error message here. - IExec->CloseLibrary(base); - } + IExec->CloseLibrary(base); + } - return iface; + return iface; } /***************************************************************************/ void CloseInterface(struct Interface *iface) { - if (iface != NULL) - { - struct Library *base = iface->Data.LibBase; - IExec->DropInterface(iface); - IExec->CloseLibrary(base); - } + if (iface != NULL) + { + struct Library *base = iface->Data.LibBase; + IExec->DropInterface(iface); + IExec->CloseLibrary(base); + } } BOOL __unlink_retries = FALSE; @@ -70,17 +70,17 @@ void ___closeinterfaces() __attribute__((destructor)); void ___openinterfaces() { - if (!IDOS) - IDOS = (struct DOSIFace *)OpenInterface("dos.library", 53); - if (!IUtility) - IUtility = - (struct UtilityIFace *)OpenInterface("utility.library", 53); + if (!IDOS) + IDOS = (struct DOSIFace *)OpenInterface("dos.library", 53); + if (!IUtility) + IUtility = + (struct UtilityIFace *)OpenInterface("utility.library", 53); } void ___closeinterfaces() { - CloseInterface((struct Interface *)IDOS); - CloseInterface((struct Interface *)IUtility); + CloseInterface((struct Interface *)IDOS); + CloseInterface((struct Interface *)IUtility); } int VARARGS68K araddebug(UBYTE *fmt, ...); int VARARGS68K adebug(UBYTE *fmt, ...); @@ -94,150 +94,150 @@ static void createvars(char **envp); struct args { - BPTR seglist; - int stack; - char *command; - int length; - int result; - char **envp; + BPTR seglist; + int stack; + char *command; + int length; + int result; + char **envp; }; int __myrc(__attribute__((unused))char *arg) { - struct Task *thisTask = IExec->FindTask(0); - struct args *myargs = (struct args *)thisTask->tc_UserData; - if (myargs->envp) - createvars(myargs->envp); - // adebug("%s %ld %s \n",__FUNCTION__,__LINE__,myargs->command); - myargs->result = IDOS->RunCommand(myargs->seglist, myargs->stack, - myargs->command, myargs->length); - return 0; + struct Task *thisTask = IExec->FindTask(0); + struct args *myargs = (struct args *)thisTask->tc_UserData; + if (myargs->envp) + createvars(myargs->envp); + // adebug("%s %ld %s \n",__FUNCTION__,__LINE__,myargs->command); + myargs->result = IDOS->RunCommand(myargs->seglist, myargs->stack, + myargs->command, myargs->length); + return 0; } int32 myruncommand( BPTR seglist, int stack, char *command, int length, char **envp) { - struct args myargs; - struct Task *thisTask = IExec->FindTask(0); - struct Process *proc; - - // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,command?command:"NULL"); - - myargs.seglist = seglist; - myargs.stack = stack; - myargs.command = command; - myargs.length = length; - myargs.result = -1; - myargs.envp = envp; - - if ((proc = IDOS->CreateNewProcTags( - NP_Entry, __myrc, NP_Child, TRUE, NP_Input, IDOS->Input(), - NP_Output, IDOS->Output(), NP_Error, IDOS->ErrorOutput(), - NP_CloseInput, FALSE, NP_CloseOutput, FALSE, NP_CloseError, - FALSE, NP_CopyVars, FALSE, - - // NP_StackSize, ((struct Process - // *)myargs.parent)->pr_StackSize, - NP_Cli, TRUE, NP_UserData, (int)&myargs, - NP_NotifyOnDeathSigTask, thisTask, TAG_DONE))) - - { - IExec->Wait(SIGF_CHILD); - } - return myargs.result; + struct args myargs; + struct Task *thisTask = IExec->FindTask(0); + struct Process *proc; + + // adebug("%s %ld %s\n",__FUNCTION__,__LINE__,command?command:"NULL"); + + myargs.seglist = seglist; + myargs.stack = stack; + myargs.command = command; + myargs.length = length; + myargs.result = -1; + myargs.envp = envp; + + if ((proc = IDOS->CreateNewProcTags( + NP_Entry, __myrc, NP_Child, TRUE, NP_Input, IDOS->Input(), + NP_Output, IDOS->Output(), NP_Error, IDOS->ErrorOutput(), + NP_CloseInput, FALSE, NP_CloseOutput, FALSE, NP_CloseError, + FALSE, NP_CopyVars, FALSE, + + // NP_StackSize, ((struct Process + // *)myargs.parent)->pr_StackSize, + NP_Cli, TRUE, NP_UserData, (int)&myargs, + NP_NotifyOnDeathSigTask, thisTask, TAG_DONE))) + + { + IExec->Wait(SIGF_CHILD); + } + return myargs.result; } char *mystrdup(const char *s) { - char *result = NULL; - size_t size; + char *result = NULL; + size_t size; - size = strlen(s) + 1; + size = strlen(s) + 1; - if ((result = (char *)IExec->AllocVecTags(size, TAG_DONE))) - { - memmove(result, s, size); - } - return result; + if ((result = (char *)IExec->AllocVecTags(size, TAG_DONE))) + { + memmove(result, s, size); + } + return result; } unsigned int pipenum = 0; int pipe(int filedes[2]) { - char pipe_name[1024]; + char pipe_name[1024]; // adebug("%s %ld \n",__FUNCTION__,__LINE__); #ifdef USE_TEMPFILES - sprintf(pipe_name, "/T/%x.%08lx", pipenum++, IUtility->GetUniqueID()); + sprintf(pipe_name, "/T/%x.%08lx", pipenum++, IUtility->GetUniqueID()); #else - sprintf(pipe_name, "/PIPE/%x%08lx/4096/0", pipenum++, - IUtility->GetUniqueID()); + sprintf(pipe_name, "/PIPE/%x%08lx/4096/0", pipenum++, + IUtility->GetUniqueID()); #endif - /* printf("pipe: %s \n", pipe_name);*/ - - filedes[1] = open(pipe_name, O_WRONLY | O_CREAT); - filedes[0] = open(pipe_name, O_RDONLY); - if (filedes[0] == -1 || filedes[1] == -1) - { - if (filedes[0] != -1) - close(filedes[0]); - if (filedes[1] != -1) - close(filedes[1]); - return -1; - } - /* printf("filedes %d %d\n", filedes[0], - * filedes[1]);fflush(stdout);*/ - - return 0; + /* printf("pipe: %s \n", pipe_name);*/ + + filedes[1] = open(pipe_name, O_WRONLY | O_CREAT); + filedes[0] = open(pipe_name, O_RDONLY); + if (filedes[0] == -1 || filedes[1] == -1) + { + if (filedes[0] != -1) + close(filedes[0]); + if (filedes[1] != -1) + close(filedes[1]); + return -1; + } + /* printf("filedes %d %d\n", filedes[0], + * filedes[1]);fflush(stdout);*/ + + return 0; } int fork(void) { - fprintf(stderr, "Can not bloody fork\n"); - errno = ENOMEM; - return -1; + fprintf(stderr, "Can not bloody fork\n"); + errno = ENOMEM; + return -1; } int wait(__attribute__((unused))int *status) { - fprintf(stderr, "No wait try waitpid instead\n"); - errno = ECHILD; - return -1; + fprintf(stderr, "No wait try waitpid instead\n"); + errno = ECHILD; + return -1; } char *convert_path_a2u(const char *filename) { - struct NameTranslationInfo nti; + struct NameTranslationInfo nti; - if (!filename) - { - return 0; - } + if (!filename) + { + return 0; + } - __translate_amiga_to_unix_path_name(&filename, &nti); + __translate_amiga_to_unix_path_name(&filename, &nti); - return mystrdup(filename); + return mystrdup(filename); } char *convert_path_u2a(const char *filename) { - struct NameTranslationInfo nti; + struct NameTranslationInfo nti; - if (!filename) - { - return 0; - } + if (!filename) + { + return 0; + } - if (strcmp(filename, "/dev/tty") == 0) - { - return mystrdup("CONSOLE:"); - ; - } + if (strcmp(filename, "/dev/tty") == 0) + { + return mystrdup("CONSOLE:"); + ; + } - __translate_unix_to_amiga_path_name(&filename, &nti); + __translate_unix_to_amiga_path_name(&filename, &nti); - return mystrdup(filename); + return mystrdup(filename); } struct SignalSemaphore environ_sema; @@ -246,278 +246,278 @@ struct SignalSemaphore popen_sema; void amigaos4_init_environ_sema() { - IExec->InitSemaphore(&environ_sema); - IExec->InitSemaphore(&popen_sema); + IExec->InitSemaphore(&environ_sema); + IExec->InitSemaphore(&popen_sema); } void amigaos4_obtain_environ() { - IExec->ObtainSemaphore(&environ_sema); + IExec->ObtainSemaphore(&environ_sema); } void amigaos4_release_environ() { - IExec->ReleaseSemaphore(&environ_sema); + IExec->ReleaseSemaphore(&environ_sema); } static void createvars(char **envp) { - if (envp) - { - /* Set a local var to indicate to any subsequent sh that it is - * not - * the top level shell and so should only inherit local amigaos - * vars */ - IDOS->SetVar("ABCSH_IMPORT_LOCAL", "TRUE", 5, GVF_LOCAL_ONLY); - - amigaos4_obtain_environ(); - - envp = myenviron; - - while ((envp != NULL) && (*envp != NULL)) - { - int len; - char *var; - char *val; - if ((len = strlen(*envp))) - { - if ((var = (char *)IExec->AllocVecTags(len + 1, AVT_ClearWithValue,0,TAG_DONE))) - { - strcpy(var, *envp); - - val = strchr(var, '='); - if (val) - { - *val++ = '\0'; - if (*val) - { - IDOS->SetVar( - var, val, - strlen(val) + 1, - GVF_LOCAL_ONLY); - } - } - IExec->FreeVec(var); - } - } - envp++; - } - amigaos4_release_environ(); - } + if (envp) + { + /* Set a local var to indicate to any subsequent sh that it is + * not + * the top level shell and so should only inherit local amigaos + * vars */ + IDOS->SetVar("ABCSH_IMPORT_LOCAL", "TRUE", 5, GVF_LOCAL_ONLY); + + amigaos4_obtain_environ(); + + envp = myenviron; + + while ((envp != NULL) && (*envp != NULL)) + { + int len; + char *var; + char *val; + if ((len = strlen(*envp))) + { + if ((var = (char *)IExec->AllocVecTags(len + 1, AVT_ClearWithValue,0,TAG_DONE))) + { + strcpy(var, *envp); + + val = strchr(var, '='); + if (val) + { + *val++ = '\0'; + if (*val) + { + IDOS->SetVar( + var, val, + strlen(val) + 1, + GVF_LOCAL_ONLY); + } + } + IExec->FreeVec(var); + } + } + envp++; + } + amigaos4_release_environ(); + } } struct command_data { - STRPTR args; - BPTR seglist; - struct Task *parent; + STRPTR args; + BPTR seglist; + struct Task *parent; }; int myexecvp(bool isperlthread, const char *filename, char *argv[]) { - // adebug("%s %ld - //%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL"); - /* if there's a slash or a colon consider filename a path and skip - * search */ - int res; - char *name = NULL; - char *pathpart = NULL; - if ((strchr(filename, '/') == NULL) && (strchr(filename, ':') == NULL)) - { - const char *path; - const char *p; - size_t len; - struct stat st; - - if (!(path = getenv("PATH"))) - { - path = ".:/bin:/usr/bin:/c"; - } - - len = strlen(filename) + 1; - name = (char *)IExec->AllocVecTags(strlen(path) + len, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE); - pathpart = (char *)IExec->AllocVecTags(strlen(path) + 1, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE); - p = path; - do - { - path = p; - - if (!(p = strchr(path, ':'))) - { - p = strchr(path, '\0'); - } - - memcpy(pathpart, path, p - path); - pathpart[p - path] = '\0'; - if (!(strlen(pathpart) == 0)) - { - sprintf(name, "%s/%s", pathpart, filename); - } - else - sprintf(name, "%s", filename); - - if ((stat(name, &st) == 0) && (S_ISREG(st.st_mode))) - { - /* we stated it and it's a regular file */ - /* let's boogie! */ - filename = name; - break; - } - - } - while (*p++ != '\0'); - } - - res = myexecve(isperlthread, filename, argv, myenviron); - - if(name) - { - IExec->FreeVec((APTR)name); - name = NULL; - } - if(pathpart) - { - IExec->FreeVec((APTR)pathpart); - pathpart = NULL; - } - return res; + // adebug("%s %ld + //%s\n",__FUNCTION__,__LINE__,filename?filename:"NULL"); + /* if there's a slash or a colon consider filename a path and skip + * search */ + int res; + char *name = NULL; + char *pathpart = NULL; + if ((strchr(filename, '/') == NULL) && (strchr(filename, ':') == NULL)) + { + const char *path; + const char *p; + size_t len; + struct stat st; + + if (!(path = getenv("PATH"))) + { + path = ".:/bin:/usr/bin:/c"; + } + + len = strlen(filename) + 1; + name = (char *)IExec->AllocVecTags(strlen(path) + len, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE); + pathpart = (char *)IExec->AllocVecTags(strlen(path) + 1, AVT_ClearWithValue,0,AVT_Type,MEMF_SHARED,TAG_DONE); + p = path; + do + { + path = p; + + if (!(p = strchr(path, ':'))) + { + p = strchr(path, '\0'); + } + + memcpy(pathpart, path, p - path); + pathpart[p - path] = '\0'; + if (!(strlen(pathpart) == 0)) + { + sprintf(name, "%s/%s", pathpart, filename); + } + else + sprintf(name, "%s", filename); + + if ((stat(name, &st) == 0) && (S_ISREG(st.st_mode))) + { + /* we stated it and it's a regular file */ + /* let's boogie! */ + filename = name; + break; + } + + } + while (*p++ != '\0'); + } + + res = myexecve(isperlthread, filename, argv, myenviron); + + if(name) + { + IExec->FreeVec((APTR)name); + name = NULL; + } + if(pathpart) + { + IExec->FreeVec((APTR)pathpart); + pathpart = NULL; + } + return res; } int myexecv(bool isperlthread, const char *path, char *argv[]) { - return myexecve(isperlthread, path, argv, myenviron); + return myexecve(isperlthread, path, argv, myenviron); } int myexecl(bool isperlthread, const char *path, ...) { - va_list va; - char *argv[1024]; /* 1024 enough? let's hope so! */ - int i = 0; - // adebug("%s %ld\n",__FUNCTION__,__LINE__); - - va_start(va, path); - i = 0; - - do - { - argv[i] = va_arg(va, char *); - } - while (argv[i++] != NULL); - - va_end(va); - return myexecve(isperlthread, path, argv, myenviron); + va_list va; + char *argv[1024]; /* 1024 enough? let's hope so! */ + int i = 0; + // adebug("%s %ld\n",__FUNCTION__,__LINE__); + + va_start(va, path); + i = 0; + + do + { + argv[i] = va_arg(va, char *); + } + while (argv[i++] != NULL); + + va_end(va); + return myexecve(isperlthread, path, argv, myenviron); } int pause(void) { - fprintf(stderr, "Pause not implemented\n"); + fprintf(stderr, "Pause not implemented\n"); - errno = EINTR; - return -1; + errno = EINTR; + return -1; } uint32 size_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message) { - if (strlen(message->sv_GDir) <= 4) - { - hook->h_Data = (APTR)(((uint32)hook->h_Data) + 1); - } - return 0; + if (strlen(message->sv_GDir) <= 4) + { + hook->h_Data = (APTR)(((uint32)hook->h_Data) + 1); + } + return 0; } uint32 copy_env(struct Hook *hook, __attribute__((unused))APTR userdata, struct ScanVarsMsg *message) { - if (strlen(message->sv_GDir) <= 4) - { - char **env = (char **)hook->h_Data; - uint32 size = - strlen(message->sv_Name) + 1 + message->sv_VarLen + 1 + 1; - char *buffer = (char *)IExec->AllocVecTags((uint32)size,AVT_ClearWithValue,0,TAG_DONE); - - - snprintf(buffer, size - 1, "%s=%s", message->sv_Name, - message->sv_Var); - - *env = buffer; - env++; - hook->h_Data = env; - } - return 0; + if (strlen(message->sv_GDir) <= 4) + { + char **env = (char **)hook->h_Data; + uint32 size = + strlen(message->sv_Name) + 1 + message->sv_VarLen + 1 + 1; + char *buffer = (char *)IExec->AllocVecTags((uint32)size,AVT_ClearWithValue,0,TAG_DONE); + + + snprintf(buffer, size - 1, "%s=%s", message->sv_Name, + message->sv_Var); + + *env = buffer; + env++; + hook->h_Data = env; + } + return 0; } void ___makeenviron() { - struct Hook *hook = (struct Hook *)IExec->AllocSysObjectTags(ASOT_HOOK,TAG_DONE); - - if(hook) - { - char varbuf[8]; - uint32 flags = 0; - - struct DOSIFace *myIDOS = - (struct DOSIFace *)OpenInterface("dos.library", 53); - if (myIDOS) - { - uint32 size = 0; - if (myIDOS->GetVar("ABCSH_IMPORT_LOCAL", varbuf, 8, - GVF_LOCAL_ONLY) > 0) - { - flags = GVF_LOCAL_ONLY; - } - else - { - flags = GVF_GLOBAL_ONLY; - } - - hook->h_Entry = size_env; - hook->h_Data = 0; - - myIDOS->ScanVars(hook, flags, 0); - size = ((uint32)hook->h_Data) + 1; - - myenviron = (char **)IExec->AllocVecTags(size * - sizeof(char **), - AVT_ClearWithValue,0,TAG_DONE); - origenviron = myenviron; - if (!myenviron) - { - IExec->FreeSysObject(ASOT_HOOK,hook); - CloseInterface((struct Interface *)myIDOS); - return; - } - hook->h_Entry = copy_env; - hook->h_Data = myenviron; - - myIDOS->ScanVars(hook, flags, 0); - IExec->FreeSysObject(ASOT_HOOK,hook); - CloseInterface((struct Interface *)myIDOS); - } - } + struct Hook *hook = (struct Hook *)IExec->AllocSysObjectTags(ASOT_HOOK,TAG_DONE); + + if(hook) + { + char varbuf[8]; + uint32 flags = 0; + + struct DOSIFace *myIDOS = + (struct DOSIFace *)OpenInterface("dos.library", 53); + if (myIDOS) + { + uint32 size = 0; + if (myIDOS->GetVar("ABCSH_IMPORT_LOCAL", varbuf, 8, + GVF_LOCAL_ONLY) > 0) + { + flags = GVF_LOCAL_ONLY; + } + else + { + flags = GVF_GLOBAL_ONLY; + } + + hook->h_Entry = size_env; + hook->h_Data = 0; + + myIDOS->ScanVars(hook, flags, 0); + size = ((uint32)hook->h_Data) + 1; + + myenviron = (char **)IExec->AllocVecTags(size * + sizeof(char **), + AVT_ClearWithValue,0,TAG_DONE); + origenviron = myenviron; + if (!myenviron) + { + IExec->FreeSysObject(ASOT_HOOK,hook); + CloseInterface((struct Interface *)myIDOS); + return; + } + hook->h_Entry = copy_env; + hook->h_Data = myenviron; + + myIDOS->ScanVars(hook, flags, 0); + IExec->FreeSysObject(ASOT_HOOK,hook); + CloseInterface((struct Interface *)myIDOS); + } + } } void ___freeenviron() { - char **i; - /* perl might change environ, it puts it back except for ctrl-c */ - /* so restore our own copy here */ - struct DOSIFace *myIDOS = - (struct DOSIFace *)OpenInterface("dos.library", 53); - if (myIDOS) - { - myenviron = origenviron; - - if (myenviron) - { - for (i = myenviron; *i != NULL; i++) - { - IExec->FreeVec(*i); - } - IExec->FreeVec(myenviron); - myenviron = NULL; - } - CloseInterface((struct Interface *)myIDOS); - } + char **i; + /* perl might change environ, it puts it back except for ctrl-c */ + /* so restore our own copy here */ + struct DOSIFace *myIDOS = + (struct DOSIFace *)OpenInterface("dos.library", 53); + if (myIDOS) + { + myenviron = origenviron; + + if (myenviron) + { + for (i = myenviron; *i != NULL; i++) + { + IExec->FreeVec(*i); + } + IExec->FreeVec(myenviron); + myenviron = NULL; + } + CloseInterface((struct Interface *)myIDOS); + } } @@ -530,126 +530,126 @@ void ___freeenviron() int afstat(int fd, struct stat *statb) { - int result; - BPTR fh; - int mode; - BOOL input; - /* In the first instance pass it to fstat */ - // adebug("fd %ld ad %ld\n",fd,amigaos_get_file(fd)); + int result; + BPTR fh; + int mode; + BOOL input; + /* In the first instance pass it to fstat */ + // adebug("fd %ld ad %ld\n",fd,amigaos_get_file(fd)); - if ((result = fstat(fd, statb) >= 0)) - return result; + if ((result = fstat(fd, statb) >= 0)) + return result; - /* Now we've got a file descriptor but we failed to stat it */ - /* Could be a nil: or could be a std#? */ + /* Now we've got a file descriptor but we failed to stat it */ + /* Could be a nil: or could be a std#? */ - /* if get_default_file fails we had a dud fd so return failure */ + /* if get_default_file fails we had a dud fd so return failure */ #if !defined(__CLIB2__) - fh = amigaos_get_file(fd); - - /* if nil: return failure*/ - if (fh == 0) - return -1; - - /* Now compare with our process Input() Output() etc */ - /* if these were regular files sockets or pipes we had already - * succeeded */ - /* so we can guess they a character special console.... I hope */ - - struct ExamineData *data; - char name[120]; - name[0] = '\0'; - - data = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, TAG_END); - if (data != NULL) - { - - IUtility->Strlcpy(name, data->Name, sizeof(name)); - - IDOS->FreeDosObject(DOS_EXAMINEDATA, data); - } - - // adebug("ad %ld '%s'\n",amigaos_get_file(fd),name); - mode = S_IFCHR; - - if (fh == IDOS->Input()) - { - input = TRUE; - SET_FLAG(mode, S_IRUSR); - SET_FLAG(mode, S_IRGRP); - SET_FLAG(mode, S_IROTH); - } - else if (fh == IDOS->Output() || fh == IDOS->ErrorOutput()) - { - input = FALSE; - SET_FLAG(mode, S_IWUSR); - SET_FLAG(mode, S_IWGRP); - SET_FLAG(mode, S_IWOTH); - } - else - { - /* we got a filehandle not handle by fstat or the above */ - /* most likely it's NIL: but lets check */ - struct ExamineData *exd = NULL; - if ((exd = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, - TAG_DONE))) - { - BOOL isnil = FALSE; - if (exd->Type == - (20060920)) // Ugh yes I know nasty..... - { - isnil = TRUE; - } - IDOS->FreeDosObject(DOS_EXAMINEDATA, exd); - if (isnil) - { - /* yep we got NIL: */ - SET_FLAG(mode, S_IRUSR); - SET_FLAG(mode, S_IRGRP); - SET_FLAG(mode, S_IROTH); - SET_FLAG(mode, S_IWUSR); - SET_FLAG(mode, S_IWGRP); - SET_FLAG(mode, S_IWOTH); - } - else - { - IExec->DebugPrintF( - "unhandled filehandle in afstat()\n"); - return -1; - } - } - } - - memset(statb, 0, sizeof(statb)); - - statb->st_mode = mode; + fh = amigaos_get_file(fd); + + /* if nil: return failure*/ + if (fh == 0) + return -1; + + /* Now compare with our process Input() Output() etc */ + /* if these were regular files sockets or pipes we had already + * succeeded */ + /* so we can guess they a character special console.... I hope */ + + struct ExamineData *data; + char name[120]; + name[0] = '\0'; + + data = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, TAG_END); + if (data != NULL) + { + + IUtility->Strlcpy(name, data->Name, sizeof(name)); + + IDOS->FreeDosObject(DOS_EXAMINEDATA, data); + } + + // adebug("ad %ld '%s'\n",amigaos_get_file(fd),name); + mode = S_IFCHR; + + if (fh == IDOS->Input()) + { + input = TRUE; + SET_FLAG(mode, S_IRUSR); + SET_FLAG(mode, S_IRGRP); + SET_FLAG(mode, S_IROTH); + } + else if (fh == IDOS->Output() || fh == IDOS->ErrorOutput()) + { + input = FALSE; + SET_FLAG(mode, S_IWUSR); + SET_FLAG(mode, S_IWGRP); + SET_FLAG(mode, S_IWOTH); + } + else + { + /* we got a filehandle not handle by fstat or the above */ + /* most likely it's NIL: but lets check */ + struct ExamineData *exd = NULL; + if ((exd = IDOS->ExamineObjectTags(EX_FileHandleInput, fh, + TAG_DONE))) + { + BOOL isnil = FALSE; + if (exd->Type == + (20060920)) // Ugh yes I know nasty..... + { + isnil = TRUE; + } + IDOS->FreeDosObject(DOS_EXAMINEDATA, exd); + if (isnil) + { + /* yep we got NIL: */ + SET_FLAG(mode, S_IRUSR); + SET_FLAG(mode, S_IRGRP); + SET_FLAG(mode, S_IROTH); + SET_FLAG(mode, S_IWUSR); + SET_FLAG(mode, S_IWGRP); + SET_FLAG(mode, S_IWOTH); + } + else + { + IExec->DebugPrintF( + "unhandled filehandle in afstat()\n"); + return -1; + } + } + } + + memset(statb, 0, sizeof(statb)); + + statb->st_mode = mode; #endif - return 0; + return 0; } BPTR amigaos_get_file(int fd) { - BPTR fh = (BPTR)NULL; - if (!(fh = _get_osfhandle(fd))) - { - switch (fd) - { - case 0: - fh = IDOS->Input(); - break; - case 1: - fh = IDOS->Output(); - break; - case 2: - fh = IDOS->ErrorOutput(); - break; - default: - break; - } - } - return fh; + BPTR fh = (BPTR)NULL; + if (!(fh = _get_osfhandle(fd))) + { + switch (fd) + { + case 0: + fh = IDOS->Input(); + break; + case 1: + fh = IDOS->Output(); + break; + case 2: + fh = IDOS->ErrorOutput(); + break; + default: + break; + } + } + return fh; } /*########################################################################*/ @@ -662,78 +662,78 @@ BPTR amigaos_get_file(int fd) int amigaos_flock(int fd, int oper) { - BPTR fh; - int32 success = -1; - - if (!(fh = amigaos_get_file(fd))) - { - errno = EBADF; - return -1; - } - - switch (oper) - { - case LOCK_SH: - { - if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, - REC_SHARED | RECF_DOS_METHOD_ONLY, - TIMEOUT)) - { - success = 0; - } - break; - } - case LOCK_EX: - { - if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, - REC_EXCLUSIVE | RECF_DOS_METHOD_ONLY, - TIMEOUT)) - { - success = 0; - } - break; - } - case LOCK_SH | LOCK_NB: - { - if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, - REC_SHARED_IMMED | RECF_DOS_METHOD_ONLY, - TIMEOUT)) - { - success = 0; - } - else - { - errno = EWOULDBLOCK; - } - break; - } - case LOCK_EX | LOCK_NB: - { - if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, - REC_EXCLUSIVE_IMMED | RECF_DOS_METHOD_ONLY, - TIMEOUT)) - { - success = 0; - } - else - { - errno = EWOULDBLOCK; - } - break; - } - case LOCK_UN: - { - if (IDOS->UnLockRecord(fh, LOCK_START, LOCK_LENGTH)) - { - success = 0; - } - break; - } - default: - { - errno = EINVAL; - return -1; - } - } - return success; + BPTR fh; + int32 success = -1; + + if (!(fh = amigaos_get_file(fd))) + { + errno = EBADF; + return -1; + } + + switch (oper) + { + case LOCK_SH: + { + if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, + REC_SHARED | RECF_DOS_METHOD_ONLY, + TIMEOUT)) + { + success = 0; + } + break; + } + case LOCK_EX: + { + if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, + REC_EXCLUSIVE | RECF_DOS_METHOD_ONLY, + TIMEOUT)) + { + success = 0; + } + break; + } + case LOCK_SH | LOCK_NB: + { + if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, + REC_SHARED_IMMED | RECF_DOS_METHOD_ONLY, + TIMEOUT)) + { + success = 0; + } + else + { + errno = EWOULDBLOCK; + } + break; + } + case LOCK_EX | LOCK_NB: + { + if (IDOS->LockRecord(fh, LOCK_START, LOCK_LENGTH, + REC_EXCLUSIVE_IMMED | RECF_DOS_METHOD_ONLY, + TIMEOUT)) + { + success = 0; + } + else + { + errno = EWOULDBLOCK; + } + break; + } + case LOCK_UN: + { + if (IDOS->UnLockRecord(fh, LOCK_START, LOCK_LENGTH)) + { + success = 0; + } + break; + } + default: + { + errno = EINVAL; + return -1; + } + } + return success; } diff --git a/av.c b/av.c index 67815fce90bc..ff0cb2340c4d 100644 --- a/av.c +++ b/av.c @@ -28,22 +28,22 @@ Perl_av_reify(pTHX_ AV *av) assert(SvTYPE(av) == SVt_PVAV); if (AvREAL(av)) - return; + return; #ifdef DEBUGGING if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "av_reify called on tied array"); #endif key = AvMAX(av) + 1; while (key > AvFILLp(av) + 1) - AvARRAY(av)[--key] = NULL; + AvARRAY(av)[--key] = NULL; while (key) { - SV * const sv = AvARRAY(av)[--key]; - if (sv != &PL_sv_undef) - SvREFCNT_inc_simple_void(sv); + SV * const sv = AvARRAY(av)[--key]; + if (sv != &PL_sv_undef) + SvREFCNT_inc_simple_void(sv); } key = AvARRAY(av) - AvALLOC(av); while (key) - AvALLOC(av)[--key] = NULL; + AvALLOC(av)[--key] = NULL; AvREIFY_off(av); AvREAL_on(av); } @@ -72,7 +72,7 @@ Perl_av_extend(pTHX_ AV *av, SSize_t key) mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied); if (mg) { - SV *arg1 = sv_newmortal(); + SV *arg1 = sv_newmortal(); /* NOTE: the API for av_extend() is NOT the same as the tie method EXTEND. * * The C function takes an *index* (assumes 0 indexed arrays) and ensures @@ -82,10 +82,10 @@ Perl_av_extend(pTHX_ AV *av, SSize_t key) * is at least that many elements large. Thus we have to +1 the key when * we call the tied method. */ - sv_setiv(arg1, (IV)(key + 1)); - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1, - arg1); - return; + sv_setiv(arg1, (IV)(key + 1)); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1, + arg1); + return; } av_extend_guts(av,key,&AvMAX(av),&AvALLOC(av),&AvARRAY(av)); } @@ -225,23 +225,23 @@ S_adjust_index(pTHX_ AV *av, const MAGIC *mg, SSize_t *keyp) { bool adjust_index = 1; if (mg) { - /* Handle negative array indices 20020222 MJD */ - SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg); - SvGETMAGIC(ref); - if (SvROK(ref) && SvOBJECT(SvRV(ref))) { - SV * const * const negative_indices_glob = - hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0); - - if (negative_indices_glob && isGV(*negative_indices_glob) - && SvTRUE(GvSV(*negative_indices_glob))) - adjust_index = 0; - } + /* Handle negative array indices 20020222 MJD */ + SV * const ref = SvTIED_obj(MUTABLE_SV(av), mg); + SvGETMAGIC(ref); + if (SvROK(ref) && SvOBJECT(SvRV(ref))) { + SV * const * const negative_indices_glob = + hv_fetchs(SvSTASH(SvRV(ref)), NEGATIVE_INDICES_VAR, 0); + + if (negative_indices_glob && isGV(*negative_indices_glob) + && SvTRUE(GvSV(*negative_indices_glob))) + adjust_index = 0; + } } if (adjust_index) { - *keyp += AvFILL(av) + 1; - if (*keyp < 0) - return FALSE; + *keyp += AvFILL(av) + 1; + if (*keyp < 0) + return FALSE; } return TRUE; } @@ -257,22 +257,22 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval) if (UNLIKELY(SvRMAGICAL(av))) { const MAGIC * const tied_magic - = mg_find((const SV *)av, PERL_MAGIC_tied); + = mg_find((const SV *)av, PERL_MAGIC_tied); if (tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata)) { - SV *sv; - if (key < 0) { - if (!S_adjust_index(aTHX_ av, tied_magic, &key)) - return NULL; - } + SV *sv; + if (key < 0) { + if (!S_adjust_index(aTHX_ av, tied_magic, &key)) + return NULL; + } sv = sv_newmortal(); - sv_upgrade(sv, SVt_PVLV); - mg_copy(MUTABLE_SV(av), sv, 0, key); - if (!tied_magic) /* for regdata, force leavesub to make copies */ - SvTEMP_off(sv); - LvTYPE(sv) = 't'; - LvTARG(sv) = sv; /* fake (SV**) */ - return &(LvTARG(sv)); + sv_upgrade(sv, SVt_PVLV); + mg_copy(MUTABLE_SV(av), sv, 0, key); + if (!tied_magic) /* for regdata, force leavesub to make copies */ + SvTEMP_off(sv); + LvTYPE(sv) = 't'; + LvTARG(sv) = sv; /* fake (SV**) */ + return &(LvTARG(sv)); } } @@ -283,14 +283,14 @@ Perl_av_fetch(pTHX_ AV *av, SSize_t key, I32 lval) /* the cast from SSize_t to Size_t allows both (key < 0) and (key >= size) * to be tested as a single condition */ if ((Size_t)key >= (Size_t)size) { - if (UNLIKELY(neg)) - return NULL; + if (UNLIKELY(neg)) + return NULL; goto emptyness; } if (!AvARRAY(av)[key]) { emptyness: - return lval ? av_store(av,key,newSV(0)) : NULL; + return lval ? av_store(av,key,newSV(0)) : NULL; } return &AvARRAY(av)[key]; @@ -334,59 +334,59 @@ Perl_av_store(pTHX_ AV *av, SSize_t key, SV *val) const MAGIC * const tied_magic = mg_find((const SV *)av, PERL_MAGIC_tied); if (tied_magic) { if (key < 0) { - if (!S_adjust_index(aTHX_ av, tied_magic, &key)) + if (!S_adjust_index(aTHX_ av, tied_magic, &key)) return 0; } - if (val) { - mg_copy(MUTABLE_SV(av), val, 0, key); - } - return NULL; + if (val) { + mg_copy(MUTABLE_SV(av), val, 0, key); + } + return NULL; } } if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return NULL; + key += AvFILL(av) + 1; + if (key < 0) + return NULL; } if (SvREADONLY(av) && key >= AvFILL(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if (!AvREAL(av) && AvREIFY(av)) - av_reify(av); + av_reify(av); if (key > AvMAX(av)) - av_extend(av,key); + av_extend(av,key); ary = AvARRAY(av); if (AvFILLp(av) < key) { - if (!AvREAL(av)) { - if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) - PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ - do { - ary[++AvFILLp(av)] = NULL; - } while (AvFILLp(av) < key); - } - AvFILLp(av) = key; + if (!AvREAL(av)) { + if (av == PL_curstack && key > PL_stack_sp - PL_stack_base) + PL_stack_sp = PL_stack_base + key; /* XPUSH in disguise */ + do { + ary[++AvFILLp(av)] = NULL; + } while (AvFILLp(av) < key); + } + AvFILLp(av) = key; } else if (AvREAL(av)) - SvREFCNT_dec(ary[key]); + SvREFCNT_dec(ary[key]); ary[key] = val; if (SvSMAGICAL(av)) { - const MAGIC *mg = SvMAGIC(av); - bool set = TRUE; - for (; mg; mg = mg->mg_moremagic) { - if (!isUPPER(mg->mg_type)) continue; - if (val) { - sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key); - } - if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) { - PL_delaymagic |= DM_ARRAY_ISA; - set = FALSE; - } - } - if (set) - mg_set(MUTABLE_SV(av)); + const MAGIC *mg = SvMAGIC(av); + bool set = TRUE; + for (; mg; mg = mg->mg_moremagic) { + if (!isUPPER(mg->mg_type)) continue; + if (val) { + sv_magic(val, MUTABLE_SV(av), toLOWER(mg->mg_type), 0, key); + } + if (PL_delaymagic && mg->mg_type == PERL_MAGIC_isa) { + PL_delaymagic |= DM_ARRAY_ISA; + set = FALSE; + } + } + if (set) + mg_set(MUTABLE_SV(av)); } return &ary[key]; } @@ -416,29 +416,29 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp) SSize_t i; SSize_t orig_ix; - Newx(ary,size,SV*); - AvALLOC(av) = ary; - AvARRAY(av) = ary; - AvMAX(av) = size - 1; + Newx(ary,size,SV*); + AvALLOC(av) = ary; + AvARRAY(av) = ary; + AvMAX(av) = size - 1; /* avoid av being leaked if croak when calling magic below */ EXTEND_MORTAL(1); PL_tmps_stack[++PL_tmps_ix] = (SV*)av; orig_ix = PL_tmps_ix; - for (i = 0; i < size; i++) { - assert (*strp); + for (i = 0; i < size; i++) { + assert (*strp); - /* Don't let sv_setsv swipe, since our source array might - have multiple references to the same temp scalar (e.g. - from a list slice) */ + /* Don't let sv_setsv swipe, since our source array might + have multiple references to the same temp scalar (e.g. + from a list slice) */ - SvGETMAGIC(*strp); /* before newSV, in case it dies */ - AvFILLp(av)++; - ary[i] = newSV(0); - sv_setsv_flags(ary[i], *strp, - SV_DO_COW_SVSETSV|SV_NOSTEAL); - strp++; - } + SvGETMAGIC(*strp); /* before newSV, in case it dies */ + AvFILLp(av)++; + ary[i] = newSV(0); + sv_setsv_flags(ary[i], *strp, + SV_DO_COW_SVSETSV|SV_NOSTEAL); + strp++; + } /* disarm av's leak guard */ if (LIKELY(PL_tmps_ix == orig_ix)) PL_tmps_ix--; @@ -476,46 +476,46 @@ Perl_av_clear(pTHX_ AV *av) #ifdef DEBUGGING if (SvREFCNT(av) == 0) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "Attempt to clear deleted array"); } #endif if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); /* Give any tie a chance to cleanup first */ if (SvRMAGICAL(av)) { - const MAGIC* const mg = SvMAGIC(av); - if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa) - PL_delaymagic |= DM_ARRAY_ISA; + const MAGIC* const mg = SvMAGIC(av); + if (PL_delaymagic && mg && mg->mg_type == PERL_MAGIC_isa) + PL_delaymagic |= DM_ARRAY_ISA; else - mg_clear(MUTABLE_SV(av)); + mg_clear(MUTABLE_SV(av)); } if (AvMAX(av) < 0) - return; + return; if ((real = cBOOL(AvREAL(av)))) { - SV** const ary = AvARRAY(av); - SSize_t index = AvFILLp(av) + 1; + SV** const ary = AvARRAY(av); + SSize_t index = AvFILLp(av) + 1; /* avoid av being freed when calling destructors below */ EXTEND_MORTAL(1); PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av); orig_ix = PL_tmps_ix; - while (index) { - SV * const sv = ary[--index]; - /* undef the slot before freeing the value, because a - * destructor might try to modify this array */ - ary[index] = NULL; - SvREFCNT_dec(sv); - } + while (index) { + SV * const sv = ary[--index]; + /* undef the slot before freeing the value, because a + * destructor might try to modify this array */ + ary[index] = NULL; + SvREFCNT_dec(sv); + } } extra = AvARRAY(av) - AvALLOC(av); if (extra) { - AvMAX(av) += extra; - AvARRAY(av) = AvALLOC(av); + AvMAX(av) += extra; + AvARRAY(av) = AvALLOC(av); } AvFILLp(av) = -1; if (real) { @@ -553,19 +553,19 @@ Perl_av_undef(pTHX_ AV *av) /* Give any tie a chance to cleanup first */ if (SvTIED_mg((const SV *)av, PERL_MAGIC_tied)) - av_fill(av, -1); + av_fill(av, -1); real = cBOOL(AvREAL(av)); if (real) { - SSize_t key = AvFILLp(av) + 1; + SSize_t key = AvFILLp(av) + 1; /* avoid av being freed when calling destructors below */ EXTEND_MORTAL(1); PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(av); orig_ix = PL_tmps_ix; - while (key) - SvREFCNT_dec(AvARRAY(av)[--key]); + while (key) + SvREFCNT_dec(AvARRAY(av)[--key]); } Safefree(AvALLOC(av)); @@ -600,7 +600,7 @@ Perl_av_create_and_push(pTHX_ AV **const avp, SV *const val) PERL_ARGS_ASSERT_AV_CREATE_AND_PUSH; if (!*avp) - *avp = newAV(); + *avp = newAV(); av_push(*avp, val); } @@ -624,12 +624,12 @@ Perl_av_push(pTHX_ AV *av, SV *val) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1, - val); - return; + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1, + val); + return; } av_store(av,AvFILLp(av)+1,val); } @@ -656,19 +656,19 @@ Perl_av_pop(pTHX_ AV *av) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0); - if (retval) - retval = newSVsv(retval); - return retval; + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0); + if (retval) + retval = newSVsv(retval); + return retval; } if (AvFILL(av) < 0) - return &PL_sv_undef; + return &PL_sv_undef; retval = AvARRAY(av)[AvFILLp(av)]; AvARRAY(av)[AvFILLp(av)--] = NULL; if (SvSMAGICAL(av)) - mg_set(MUTABLE_SV(av)); + mg_set(MUTABLE_SV(av)); return retval ? retval : &PL_sv_undef; } @@ -689,7 +689,7 @@ Perl_av_create_and_unshift_one(pTHX_ AV **const avp, SV *const val) PERL_ARGS_ASSERT_AV_CREATE_AND_UNSHIFT_ONE; if (!*avp) - *avp = newAV(); + *avp = newAV(); av_unshift(*avp, 1); return av_store(*avp, 0, val); } @@ -715,45 +715,45 @@ Perl_av_unshift(pTHX_ AV *av, SSize_t num) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT), - G_DISCARD | G_UNDEF_FILL, num); - return; + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT), + G_DISCARD | G_UNDEF_FILL, num); + return; } if (num <= 0) return; if (!AvREAL(av) && AvREIFY(av)) - av_reify(av); + av_reify(av); i = AvARRAY(av) - AvALLOC(av); if (i) { - if (i > num) - i = num; - num -= i; + if (i > num) + i = num; + num -= i; - AvMAX(av) += i; - AvFILLp(av) += i; - AvARRAY(av) = AvARRAY(av) - i; + AvMAX(av) += i; + AvFILLp(av) += i; + AvARRAY(av) = AvARRAY(av) - i; } if (num) { - SV **ary; - const SSize_t i = AvFILLp(av); - /* Create extra elements */ - const SSize_t slide = i > 0 ? i : 0; - num += slide; - av_extend(av, i + num); - AvFILLp(av) += num; - ary = AvARRAY(av); - Move(ary, ary + num, i + 1, SV*); - do { - ary[--num] = NULL; - } while (num); - /* Make extra elements into a buffer */ - AvMAX(av) -= slide; - AvFILLp(av) -= slide; - AvARRAY(av) = AvARRAY(av) + slide; + SV **ary; + const SSize_t i = AvFILLp(av); + /* Create extra elements */ + const SSize_t slide = i > 0 ? i : 0; + num += slide; + av_extend(av, i + num); + AvFILLp(av) += num; + ary = AvARRAY(av); + Move(ary, ary + num, i + 1, SV*); + do { + ary[--num] = NULL; + } while (num); + /* Make extra elements into a buffer */ + AvMAX(av) -= slide; + AvFILLp(av) -= slide; + AvARRAY(av) = AvARRAY(av) + slide; } } @@ -779,23 +779,23 @@ Perl_av_shift(pTHX_ AV *av) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0); - if (retval) - retval = newSVsv(retval); - return retval; + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0); + if (retval) + retval = newSVsv(retval); + return retval; } if (AvFILL(av) < 0) return &PL_sv_undef; retval = *AvARRAY(av); if (AvREAL(av)) - *AvARRAY(av) = NULL; + *AvARRAY(av) = NULL; AvARRAY(av) = AvARRAY(av) + 1; AvMAX(av)--; AvFILLp(av)--; if (SvSMAGICAL(av)) - mg_set(MUTABLE_SV(av)); + mg_set(MUTABLE_SV(av)); return retval ? retval : &PL_sv_undef; } @@ -856,35 +856,35 @@ Perl_av_fill(pTHX_ AV *av, SSize_t fill) assert(SvTYPE(av) == SVt_PVAV); if (fill < 0) - fill = -1; + fill = -1; if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - SV *arg1 = sv_newmortal(); - sv_setiv(arg1, (IV)(fill + 1)); - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD, - 1, arg1); - return; + SV *arg1 = sv_newmortal(); + sv_setiv(arg1, (IV)(fill + 1)); + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD, + 1, arg1); + return; } if (fill <= AvMAX(av)) { - SSize_t key = AvFILLp(av); - SV** const ary = AvARRAY(av); - - if (AvREAL(av)) { - while (key > fill) { - SvREFCNT_dec(ary[key]); - ary[key--] = NULL; - } - } - else { - while (key < fill) - ary[++key] = NULL; - } - - AvFILLp(av) = fill; - if (SvSMAGICAL(av)) - mg_set(MUTABLE_SV(av)); + SSize_t key = AvFILLp(av); + SV** const ary = AvARRAY(av); + + if (AvREAL(av)) { + while (key > fill) { + SvREFCNT_dec(ary[key]); + ary[key--] = NULL; + } + } + else { + while (key < fill) + ary[++key] = NULL; + } + + AvFILLp(av) = fill; + if (SvSMAGICAL(av)) + mg_set(MUTABLE_SV(av)); } else - (void)av_store(av,fill,NULL); + (void)av_store(av,fill,NULL); } /* @@ -909,16 +909,16 @@ Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags) assert(SvTYPE(av) == SVt_PVAV); if (SvREADONLY(av)) - Perl_croak_no_modify(); + Perl_croak_no_modify(); if (SvRMAGICAL(av)) { const MAGIC * const tied_magic - = mg_find((const SV *)av, PERL_MAGIC_tied); + = mg_find((const SV *)av, PERL_MAGIC_tied); if ((tied_magic || mg_find((const SV *)av, PERL_MAGIC_regdata))) { SV **svp; if (key < 0) { - if (!S_adjust_index(aTHX_ av, tied_magic, &key)) - return NULL; + if (!S_adjust_index(aTHX_ av, tied_magic, &key)) + return NULL; } svp = av_fetch(av, key, TRUE); if (svp) { @@ -928,39 +928,39 @@ Perl_av_delete(pTHX_ AV *av, SSize_t key, I32 flags) sv_unmagic(sv, PERL_MAGIC_tiedelem); /* No longer an element */ return sv; } - return NULL; + return NULL; } } } if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return NULL; + key += AvFILL(av) + 1; + if (key < 0) + return NULL; } if (key > AvFILLp(av)) - return NULL; + return NULL; else { - if (!AvREAL(av) && AvREIFY(av)) - av_reify(av); - sv = AvARRAY(av)[key]; - AvARRAY(av)[key] = NULL; - if (key == AvFILLp(av)) { - do { - AvFILLp(av)--; - } while (--key >= 0 && !AvARRAY(av)[key]); - } - if (SvSMAGICAL(av)) - mg_set(MUTABLE_SV(av)); + if (!AvREAL(av) && AvREIFY(av)) + av_reify(av); + sv = AvARRAY(av)[key]; + AvARRAY(av)[key] = NULL; + if (key == AvFILLp(av)) { + do { + AvFILLp(av)--; + } while (--key >= 0 && !AvARRAY(av)[key]); + } + if (SvSMAGICAL(av)) + mg_set(MUTABLE_SV(av)); } if(sv != NULL) { - if (flags & G_DISCARD) { - SvREFCNT_dec_NN(sv); - return NULL; - } - else if (AvREAL(av)) - sv_2mortal(sv); + if (flags & G_DISCARD) { + SvREFCNT_dec_NN(sv); + return NULL; + } + else if (AvREAL(av)) + sv_2mortal(sv); } return sv; } @@ -985,14 +985,14 @@ Perl_av_exists(pTHX_ AV *av, SSize_t key) if (SvRMAGICAL(av)) { const MAGIC * const tied_magic - = mg_find((const SV *)av, PERL_MAGIC_tied); + = mg_find((const SV *)av, PERL_MAGIC_tied); const MAGIC * const regdata_magic = mg_find((const SV *)av, PERL_MAGIC_regdata); if (tied_magic || regdata_magic) { MAGIC *mg; /* Handle negative array indices 20020222 MJD */ if (key < 0) { - if (!S_adjust_index(aTHX_ av, tied_magic, &key)) + if (!S_adjust_index(aTHX_ av, tied_magic, &key)) return FALSE; } @@ -1002,36 +1002,36 @@ Perl_av_exists(pTHX_ AV *av, SSize_t key) else return FALSE; } - { - SV * const sv = sv_newmortal(); - mg_copy(MUTABLE_SV(av), sv, 0, key); - mg = mg_find(sv, PERL_MAGIC_tiedelem); - if (mg) { - magic_existspack(sv, mg); - { - I32 retbool = SvTRUE_nomg_NN(sv); - return cBOOL(retbool); - } - } - } + { + SV * const sv = sv_newmortal(); + mg_copy(MUTABLE_SV(av), sv, 0, key); + mg = mg_find(sv, PERL_MAGIC_tiedelem); + if (mg) { + magic_existspack(sv, mg); + { + I32 retbool = SvTRUE_nomg_NN(sv); + return cBOOL(retbool); + } + } + } } } if (key < 0) { - key += AvFILL(av) + 1; - if (key < 0) - return FALSE; + key += AvFILL(av) + 1; + if (key < 0) + return FALSE; } if (key <= AvFILLp(av) && AvARRAY(av)[key]) { - if (SvSMAGICAL(AvARRAY(av)[key]) - && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem)) - return FALSE; - return TRUE; + if (SvSMAGICAL(AvARRAY(av)[key]) + && mg_find(AvARRAY(av)[key], PERL_MAGIC_nonelem)) + return FALSE; + return TRUE; } else - return FALSE; + return FALSE; } static MAGIC * @@ -1044,11 +1044,11 @@ S_get_aux_mg(pTHX_ AV *av) { mg = mg_find((const SV *)av, PERL_MAGIC_arylen_p); if (!mg) { - mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p, - &PL_vtbl_arylen_p, 0, 0); - assert(mg); - /* sv_magicext won't set this for us because we pass in a NULL obj */ - mg->mg_flags |= MGf_REFCOUNTED; + mg = sv_magicext(MUTABLE_SV(av), 0, PERL_MAGIC_arylen_p, + &PL_vtbl_arylen_p, 0, 0); + assert(mg); + /* sv_magicext won't set this for us because we pass in a NULL obj */ + mg->mg_flags |= MGf_REFCOUNTED; } return mg; } @@ -1071,15 +1071,15 @@ Perl_av_iter_p(pTHX_ AV *av) { assert(SvTYPE(av) == SVt_PVAV); if (sizeof(IV) == sizeof(SSize_t)) { - return (IV *)&(mg->mg_len); + return (IV *)&(mg->mg_len); } else { - if (!mg->mg_ptr) { - IV *temp; - mg->mg_len = IVSIZE; - Newxz(temp, 1, IV); - mg->mg_ptr = (char *) temp; - } - return (IV *)mg->mg_ptr; + if (!mg->mg_ptr) { + IV *temp; + mg->mg_len = IVSIZE; + Newxz(temp, 1, IV); + mg->mg_ptr = (char *) temp; + } + return (IV *)mg->mg_ptr; } } @@ -1088,7 +1088,7 @@ Perl_av_nonelem(pTHX_ AV *av, SSize_t ix) { SV * const sv = newSV(0); PERL_ARGS_ASSERT_AV_NONELEM; if (!av_store(av,ix,sv)) - return sv_2mortal(sv); /* has tie magic */ + return sv_2mortal(sv); /* has tie magic */ sv_magic(sv, NULL, PERL_MAGIC_nonelem, NULL, 0); return sv; } diff --git a/av.h b/av.h index 6903db6dbf45..41cb6fefd896 100644 --- a/av.h +++ b/av.h @@ -83,7 +83,7 @@ If all you need is to look up an array element, then prefer C. #define AvREALISH(av) (SvFLAGS(av) & (SVpav_REAL|SVpav_REIFY)) #define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \ - ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) + ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) #define av_top_index(av) AvFILL(av) #define av_tindex(av) av_top_index(av) diff --git a/cv.h b/cv.h index 5a3a25f8b9e4..435dee626126 100644 --- a/cv.h +++ b/cv.h @@ -63,7 +63,7 @@ See L. /* these CvPADLIST/CvRESERVED asserts can be reverted one day, once stabilized */ #define CvPADLIST(sv) (*(assert_(!CvISXSUB((CV*)(sv))) \ - &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist))) + &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist))) /* CvPADLIST_set is not public API, it can be removed one day, once stabilized */ #ifdef DEBUGGING # define CvPADLIST_set(sv, padlist) Perl_set_padlist((CV*)sv, padlist) @@ -71,7 +71,7 @@ See L. # define CvPADLIST_set(sv, padlist) (CvPADLIST(sv) = (padlist)) #endif #define CvHSCXT(sv) *(assert_(CvISXSUB((CV*)(sv))) \ - &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_hscxt)) + &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_hscxt)) #ifdef DEBUGGING # if PTRSIZE == 8 # define PoisonPADLIST(sv) \ @@ -92,20 +92,20 @@ See L. /* These two are sometimes called on non-CVs */ #define CvPROTO(sv) \ - ( \ - SvPOK(sv) \ - ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ - ? SvEND(sv)+1 : SvPVX_const(sv) \ - : NULL \ - ) + ( \ + SvPOK(sv) \ + ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ + ? SvEND(sv)+1 : SvPVX_const(sv) \ + : NULL \ + ) #define CvPROTOLEN(sv) \ - ( \ - SvPOK(sv) \ - ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ - ? SvLEN(sv)-SvCUR(sv)-2 \ - : SvCUR(sv) \ - : 0 \ - ) + ( \ + SvPOK(sv) \ + ? SvTYPE(sv) == SVt_PVCV && CvAUTOLOAD(sv) \ + ? SvLEN(sv)-SvCUR(sv)-2 \ + : SvCUR(sv) \ + : 0 \ + ) #define CVf_METHOD 0x0001 /* CV is explicitly marked as a method */ #define CVf_LVALUE 0x0002 /* CV return value can be used as lvalue */ @@ -117,9 +117,9 @@ See L. #define CVf_CLONED 0x0040 /* a clone of one of those */ #define CVf_ANON 0x0080 /* CV is not pointed to by a GV */ #define CVf_UNIQUE 0x0100 /* sub is only called once (eg PL_main_cv, - * require, eval). */ + * require, eval). */ #define CVf_NODEBUG 0x0200 /* no DB::sub indirection for this CV - (esp. useful for special XSUBs) */ + (esp. useful for special XSUBs) */ #define CVf_CVGV_RC 0x0400 /* CvGV is reference counted */ #if defined(PERL_CORE) || defined(PERL_EXT) # define CVf_SLABBED 0x0800 /* Holds refcount on op slab */ @@ -226,8 +226,8 @@ PERL_STATIC_INLINE HEK * CvNAME_HEK(CV *sv) { return CvNAMED(sv) - ? ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_hek - : 0; + ? ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_hek + : 0; } /* helper for the common pattern: @@ -242,11 +242,11 @@ CvNAME_HEK(CV *sv) /* This lowers the reference count of the previous value, but does *not* increment the reference count of the new value. */ #define CvNAME_HEK_set(cv, hek) ( \ - CvNAME_HEK((CV *)(cv)) \ - ? unshare_hek(SvANY((CV *)(cv))->xcv_gv_u.xcv_hek) \ - : (void)0, \ - ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_gv_u.xcv_hek = (hek), \ - CvNAMED_on(cv) \ + CvNAME_HEK((CV *)(cv)) \ + ? unshare_hek(SvANY((CV *)(cv))->xcv_gv_u.xcv_hek) \ + : (void)0, \ + ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_gv_u.xcv_hek = (hek), \ + CvNAMED_on(cv) \ ) /* diff --git a/cygwin/cygwin.c b/cygwin/cygwin.c index bbb3e1a8298d..53b04c67e66a 100644 --- a/cygwin/cygwin.c +++ b/cygwin/cygwin.c @@ -35,16 +35,16 @@ do_spawnvp (const char *path, const char * const *argv) rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand); childpid = spawnvp(_P_NOWAIT,path,argv); if (childpid < 0) { - status = -1; - if(ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s", - path,Strerror (errno)); + status = -1; + if(ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn \"%s\": %s", + path,Strerror (errno)); } else { - do { - result = wait4pid(childpid, &status, 0); - } while (result == -1 && errno == EINTR); - if(result < 0) - status = -1; + do { + result = wait4pid(childpid, &status, 0); + } while (result == -1 && errno == EINTR); + if(result < 0) + status = -1; } (void)rsignal_restore(SIGINT, &ihand); (void)rsignal_restore(SIGQUIT, &qhand); @@ -98,7 +98,7 @@ do_spawn (char *cmd) ENTER; while (*cmd && isSPACE(*cmd)) - cmd++; + cmd++; if (strBEGINs (cmd,"/bin/sh") && isSPACE (cmd[7])) cmd+=5; @@ -106,32 +106,32 @@ do_spawn (char *cmd) /* save an extra exec if possible */ /* see if there are shell metacharacters in it */ if (strstr (cmd,"...")) - goto doshell; + goto doshell; if (*cmd=='.' && isSPACE (cmd[1])) - goto doshell; + goto doshell; if (strBEGINs (cmd,"exec") && isSPACE (cmd[4])) - goto doshell; + goto doshell; for (s=cmd; *s && isALPHA (*s); s++) ; /* catch VAR=val gizmo */ if (*s=='=') goto doshell; for (s=cmd; *s; s++) - if (strchr (metachars,*s)) - { - if (*s=='\n' && s[1]=='\0') - { - *s='\0'; - break; - } - doshell: - command[0] = "sh"; - command[1] = "-c"; - command[2] = cmd; - command[3] = NULL; - - result = do_spawnvp("sh",command); - goto leave; - } + if (strchr (metachars,*s)) + { + if (*s=='\n' && s[1]=='\0') + { + *s='\0'; + break; + } + doshell: + command[0] = "sh"; + command[1] = "-c"; + command[2] = cmd; + command[3] = NULL; + + result = do_spawnvp("sh",command); + goto leave; + } Newx (argv, (s-cmd)/2+2, const char*); SAVEFREEPV(argv); @@ -139,18 +139,18 @@ do_spawn (char *cmd) SAVEFREEPV(cmd); a=argv; for (s=cmd; *s;) { - while (*s && isSPACE (*s)) s++; - if (*s) - *(a++)=s; - while (*s && !isSPACE (*s)) s++; - if (*s) - *s++='\0'; + while (*s && isSPACE (*s)) s++; + if (*s) + *(a++)=s; + while (*s && !isSPACE (*s)) s++; + if (*s) + *s++='\0'; } *a = (char*)NULL; if (!argv[0]) result = -1; else - result = do_spawnvp(argv[0],(const char * const *)argv); + result = do_spawnvp(argv[0],(const char * const *)argv); leave: LEAVE; return result; @@ -221,12 +221,12 @@ XS(Cygwin_cwd) There is Cwd->cwd() usage in the wild, and previous versions didn't die. */ if(items > 1) - Perl_croak(aTHX_ "Usage: Cwd::cwd()"); + Perl_croak(aTHX_ "Usage: Cwd::cwd()"); if((cwd = getcwd(NULL, -1))) { - ST(0) = sv_2mortal(newSVpv(cwd, 0)); - free(cwd); - SvTAINTED_on(ST(0)); - XSRETURN(1); + ST(0) = sv_2mortal(newSVpv(cwd, 0)); + free(cwd); + SvTAINTED_on(ST(0)); + XSRETURN(1); } XSRETURN_UNDEF; } @@ -243,7 +243,7 @@ XS(XS_Cygwin_pid_to_winpid) pid = (pid_t)SvIV(ST(0)); if ((RETVAL = cygwin_internal(CW_CYGWIN_PID_TO_WINPID, pid)) > 0) { - XSprePUSH; PUSHi((IV)RETVAL); + XSprePUSH; PUSHi((IV)RETVAL); XSRETURN(1); } XSRETURN_UNDEF; @@ -288,10 +288,10 @@ XS(XS_Cygwin_win_to_posix_path) src_path = SvPV(ST(0), len); if (items == 2) - absolute_flag = SvTRUE(ST(1)); + absolute_flag = SvTRUE(ST(1)); if (!len) - Perl_croak(aTHX_ "can't convert empty path"); + Perl_croak(aTHX_ "can't convert empty path"); isutf8 = SvUTF8(ST(0)); #if (CYGWIN_VERSION_API_MINOR >= 181) @@ -299,72 +299,72 @@ XS(XS_Cygwin_win_to_posix_path) Size calculation: On overflow let cygwin_conv_path calculate the final size. */ if (isutf8) { - int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE; - STRLEN wlen = sizeof(wchar_t)*(len + 260 + 1001); - wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len); - wchar_t *wbuf = (wchar_t *) safemalloc(wlen); - if (!IN_BYTES) { - mbstate_t mbs; + int what = absolute_flag ? CCP_WIN_W_TO_POSIX : CCP_WIN_W_TO_POSIX | CCP_RELATIVE; + STRLEN wlen = sizeof(wchar_t)*(len + 260 + 1001); + wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len); + wchar_t *wbuf = (wchar_t *) safemalloc(wlen); + if (!IN_BYTES) { + mbstate_t mbs; char *oldlocale; SETLOCALE_LOCK; oldlocale = setlocale(LC_CTYPE, NULL); setlocale(LC_CTYPE, "utf-8"); - /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */ - wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs); - if (wlen > 0) - err = cygwin_conv_path(what, wpath, wbuf, wlen); + /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */ + wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs); + if (wlen > 0) + err = cygwin_conv_path(what, wpath, wbuf, wlen); if (oldlocale) setlocale(LC_CTYPE, oldlocale); else setlocale(LC_CTYPE, "C"); SETLOCALE_UNLOCK; - } else { /* use bytes; assume already ucs-2 encoded bytestream */ - err = cygwin_conv_path(what, src_path, wbuf, wlen); - } - if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ - int newlen = cygwin_conv_path(what, wpath, wbuf, 0); - wbuf = (wchar_t *) realloc(&wbuf, newlen); - err = cygwin_conv_path(what, wpath, wbuf, newlen); - wlen = newlen; - } - /* utf16_to_utf8(*p, *d, bytlen, *newlen) */ - posix_path = (char *) safemalloc(wlen*3); - Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, wlen*2, &len); - /* - wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL); - posix_path = (char *) safemalloc(wlen+1); - wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL); - */ + } else { /* use bytes; assume already ucs-2 encoded bytestream */ + err = cygwin_conv_path(what, src_path, wbuf, wlen); + } + if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ + int newlen = cygwin_conv_path(what, wpath, wbuf, 0); + wbuf = (wchar_t *) realloc(&wbuf, newlen); + err = cygwin_conv_path(what, wpath, wbuf, newlen); + wlen = newlen; + } + /* utf16_to_utf8(*p, *d, bytlen, *newlen) */ + posix_path = (char *) safemalloc(wlen*3); + Perl_utf16_to_utf8(aTHX_ (U8*)&wpath, (U8*)posix_path, wlen*2, &len); + /* + wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL); + posix_path = (char *) safemalloc(wlen+1); + wcsrtombs(posix_path, (const wchar_t **)&wbuf, wlen, NULL); + */ } else { - int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE; - posix_path = (char *) safemalloc (len + 260 + 1001); - err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001); - if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ - int newlen = cygwin_conv_path(what, src_path, posix_path, 0); - posix_path = (char *) realloc(&posix_path, newlen); - err = cygwin_conv_path(what, src_path, posix_path, newlen); - } + int what = absolute_flag ? CCP_WIN_A_TO_POSIX : CCP_WIN_A_TO_POSIX | CCP_RELATIVE; + posix_path = (char *) safemalloc (len + 260 + 1001); + err = cygwin_conv_path(what, src_path, posix_path, len + 260 + 1001); + if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ + int newlen = cygwin_conv_path(what, src_path, posix_path, 0); + posix_path = (char *) realloc(&posix_path, newlen); + err = cygwin_conv_path(what, src_path, posix_path, newlen); + } } #else posix_path = (char *) safemalloc (len + 260 + 1001); if (absolute_flag) - err = cygwin_conv_to_full_posix_path(src_path, posix_path); + err = cygwin_conv_to_full_posix_path(src_path, posix_path); else - err = cygwin_conv_to_posix_path(src_path, posix_path); + err = cygwin_conv_to_posix_path(src_path, posix_path); #endif if (!err) { - EXTEND(SP, 1); - ST(0) = sv_2mortal(newSVpv(posix_path, 0)); - if (isutf8) { /* src was utf-8, so result should also */ - /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */ - SvUTF8_on(ST(0)); - } - safefree(posix_path); + EXTEND(SP, 1); + ST(0) = sv_2mortal(newSVpv(posix_path, 0)); + if (isutf8) { /* src was utf-8, so result should also */ + /* TODO: convert ANSI (local windows encoding) to utf-8 on cygwin-1.5 */ + SvUTF8_on(ST(0)); + } + safefree(posix_path); XSRETURN(1); } else { - safefree(posix_path); - XSRETURN_UNDEF; + safefree(posix_path); + XSRETURN_UNDEF; } } @@ -382,79 +382,79 @@ XS(XS_Cygwin_posix_to_win_path) src_path = SvPVx(ST(0), len); if (items == 2) - absolute_flag = SvTRUE(ST(1)); + absolute_flag = SvTRUE(ST(1)); if (!len) - Perl_croak(aTHX_ "can't convert empty path"); + Perl_croak(aTHX_ "can't convert empty path"); isutf8 = SvUTF8(ST(0)); #if (CYGWIN_VERSION_API_MINOR >= 181) /* Check utf8 flag and use wide api then. Size calculation: On overflow let cygwin_conv_path calculate the final size. */ if (isutf8) { - int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE; - int wlen = sizeof(wchar_t)*(len + 260 + 1001); - wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len); - wchar_t *wbuf = (wchar_t *) safemalloc(wlen); - char *oldlocale; + int what = absolute_flag ? CCP_POSIX_TO_WIN_W : CCP_POSIX_TO_WIN_W | CCP_RELATIVE; + int wlen = sizeof(wchar_t)*(len + 260 + 1001); + wchar_t *wpath = (wchar_t *) safemalloc(sizeof(wchar_t)*len); + wchar_t *wbuf = (wchar_t *) safemalloc(wlen); + char *oldlocale; SETLOCALE_LOCK; - oldlocale = setlocale(LC_CTYPE, NULL); - setlocale(LC_CTYPE, "utf-8"); - if (!IN_BYTES) { - mbstate_t mbs; - /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */ - wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs); - if (wlen > 0) - err = cygwin_conv_path(what, wpath, wbuf, wlen); - } else { /* use bytes; assume already ucs-2 encoded bytestream */ - err = cygwin_conv_path(what, src_path, wbuf, wlen); - } - if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ - int newlen = cygwin_conv_path(what, wpath, wbuf, 0); - wbuf = (wchar_t *) realloc(&wbuf, newlen); - err = cygwin_conv_path(what, wpath, wbuf, newlen); - wlen = newlen; - } - /* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */ - wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL); - win_path = (char *) safemalloc(wlen+1); - wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL); - if (oldlocale) setlocale(LC_CTYPE, oldlocale); - else setlocale(LC_CTYPE, "C"); + oldlocale = setlocale(LC_CTYPE, NULL); + setlocale(LC_CTYPE, "utf-8"); + if (!IN_BYTES) { + mbstate_t mbs; + /* utf8_to_uvchr_buf(src_path, src_path + wlen, wpath) or Encoding::_utf8_to_bytes(sv, "UCS-2BE"); */ + wlen = mbsrtowcs(wpath, (const char**)&src_path, wlen, &mbs); + if (wlen > 0) + err = cygwin_conv_path(what, wpath, wbuf, wlen); + } else { /* use bytes; assume already ucs-2 encoded bytestream */ + err = cygwin_conv_path(what, src_path, wbuf, wlen); + } + if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ + int newlen = cygwin_conv_path(what, wpath, wbuf, 0); + wbuf = (wchar_t *) realloc(&wbuf, newlen); + err = cygwin_conv_path(what, wpath, wbuf, newlen); + wlen = newlen; + } + /* also see utf8.c: Perl_utf16_to_utf8() or Encoding::_bytes_to_utf8(sv, "UCS-2BE"); */ + wlen = wcsrtombs(NULL, (const wchar_t **)&wbuf, wlen, NULL); + win_path = (char *) safemalloc(wlen+1); + wcsrtombs(win_path, (const wchar_t **)&wbuf, wlen, NULL); + if (oldlocale) setlocale(LC_CTYPE, oldlocale); + else setlocale(LC_CTYPE, "C"); SETLOCALE_UNLOCK; } else { - int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE; - win_path = (char *) safemalloc(len + 260 + 1001); - err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001); - if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ - int newlen = cygwin_conv_path(what, src_path, win_path, 0); - win_path = (char *) realloc(&win_path, newlen); - err = cygwin_conv_path(what, src_path, win_path, newlen); - } + int what = absolute_flag ? CCP_POSIX_TO_WIN_A : CCP_POSIX_TO_WIN_A | CCP_RELATIVE; + win_path = (char *) safemalloc(len + 260 + 1001); + err = cygwin_conv_path(what, src_path, win_path, len + 260 + 1001); + if (err == ENOSPC) { /* our space assumption was wrong, not enough space */ + int newlen = cygwin_conv_path(what, src_path, win_path, 0); + win_path = (char *) realloc(&win_path, newlen); + err = cygwin_conv_path(what, src_path, win_path, newlen); + } } #else if (isutf8) - Perl_warn(aTHX_ "can't convert utf8 path"); + Perl_warn(aTHX_ "can't convert utf8 path"); win_path = (char *) safemalloc(len + 260 + 1001); if (absolute_flag) - err = cygwin_conv_to_full_win32_path(src_path, win_path); + err = cygwin_conv_to_full_win32_path(src_path, win_path); else - err = cygwin_conv_to_win32_path(src_path, win_path); + err = cygwin_conv_to_win32_path(src_path, win_path); #endif if (!err) { - EXTEND(SP, 1); - ST(0) = sv_2mortal(newSVpv(win_path, 0)); - if (isutf8) { - SvUTF8_on(ST(0)); - } - safefree(win_path); - XSRETURN(1); + EXTEND(SP, 1); + ST(0) = sv_2mortal(newSVpv(win_path, 0)); + if (isutf8) { + SvUTF8_on(ST(0)); + } + safefree(win_path); + XSRETURN(1); } else { - safefree(win_path); - XSRETURN_UNDEF; + safefree(win_path); + XSRETURN_UNDEF; } } @@ -469,12 +469,12 @@ XS(XS_Cygwin_mount_table) setmntent (0, 0); while ((mnt = getmntent (0))) { - AV* av = newAV(); - av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir))); - av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname))); - av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type))); - av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts))); - XPUSHs(sv_2mortal(newRV_noinc((SV*)av))); + AV* av = newAV(); + av_push(av, newSVpvn(mnt->mnt_dir, strlen(mnt->mnt_dir))); + av_push(av, newSVpvn(mnt->mnt_fsname, strlen(mnt->mnt_fsname))); + av_push(av, newSVpvn(mnt->mnt_type, strlen(mnt->mnt_type))); + av_push(av, newSVpvn(mnt->mnt_opts, strlen(mnt->mnt_opts))); + XPUSHs(sv_2mortal(newRV_noinc((SV*)av))); } endmntent (0); PUTBACK; @@ -493,13 +493,13 @@ XS(XS_Cygwin_mount_flags) pathname = SvPV_nolen(ST(0)); if (strEQ(pathname, "/cygdrive")) { - char user[PATH_MAX]; - char system[PATH_MAX]; - char user_flags[PATH_MAX]; - char system_flags[PATH_MAX]; + char user[PATH_MAX]; + char system[PATH_MAX]; + char user_flags[PATH_MAX]; + char system_flags[PATH_MAX]; - cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, - user_flags, system_flags); + cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, + user_flags, system_flags); if (strlen(user) > 0) { sprintf(flags, "%s,cygdrive,%s", user_flags, user); @@ -507,56 +507,56 @@ XS(XS_Cygwin_mount_flags) sprintf(flags, "%s,cygdrive,%s", system_flags, system); } - ST(0) = sv_2mortal(newSVpv(flags, 0)); - XSRETURN(1); + ST(0) = sv_2mortal(newSVpv(flags, 0)); + XSRETURN(1); } else { - struct mntent *mnt; - int found = 0; - setmntent (0, 0); - while ((mnt = getmntent (0))) { - if (strEQ(pathname, mnt->mnt_dir)) { - strcpy(flags, mnt->mnt_type); - if (strlen(mnt->mnt_opts) > 0) { - strcat(flags, ","); - strcat(flags, mnt->mnt_opts); - } - found++; - break; - } - } - endmntent (0); - - /* Check if arg is the current volume moint point if not default, - * and then use CW_GET_CYGDRIVE_INFO also. - */ - if (!found) { - char user[PATH_MAX]; - char system[PATH_MAX]; - char user_flags[PATH_MAX]; - char system_flags[PATH_MAX]; - - cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, - user_flags, system_flags); - - if (strlen(user) > 0) { - if (strNE(user,pathname)) { - sprintf(flags, "%s,cygdrive,%s", user_flags, user); - found++; - } - } else { - if (strNE(user,pathname)) { - sprintf(flags, "%s,cygdrive,%s", system_flags, system); - found++; - } - } - } - if (found) { - ST(0) = sv_2mortal(newSVpv(flags, 0)); - XSRETURN(1); - } else { - XSRETURN_UNDEF; - } + struct mntent *mnt; + int found = 0; + setmntent (0, 0); + while ((mnt = getmntent (0))) { + if (strEQ(pathname, mnt->mnt_dir)) { + strcpy(flags, mnt->mnt_type); + if (strlen(mnt->mnt_opts) > 0) { + strcat(flags, ","); + strcat(flags, mnt->mnt_opts); + } + found++; + break; + } + } + endmntent (0); + + /* Check if arg is the current volume moint point if not default, + * and then use CW_GET_CYGDRIVE_INFO also. + */ + if (!found) { + char user[PATH_MAX]; + char system[PATH_MAX]; + char user_flags[PATH_MAX]; + char system_flags[PATH_MAX]; + + cygwin_internal (CW_GET_CYGDRIVE_INFO, user, system, + user_flags, system_flags); + + if (strlen(user) > 0) { + if (strNE(user,pathname)) { + sprintf(flags, "%s,cygdrive,%s", user_flags, user); + found++; + } + } else { + if (strNE(user,pathname)) { + sprintf(flags, "%s,cygdrive,%s", system_flags, system); + found++; + } + } + } + if (found) { + ST(0) = sv_2mortal(newSVpv(flags, 0)); + XSRETURN(1); + } else { + XSRETURN_UNDEF; + } } } diff --git a/deb.c b/deb.c index bd6e538977bc..e2d734135c2e 100644 --- a/deb.c +++ b/deb.c @@ -66,10 +66,10 @@ Perl_vdeb(pTHX_ const char *pat, va_list *args) PERL_ARGS_ASSERT_VDEB; if (DEBUG_v_TEST) - PerlIO_printf(Perl_debug_log, "(%ld:%s:%ld)\t", - (long)PerlProc_getpid(), display_file, line); + PerlIO_printf(Perl_debug_log, "(%ld:%s:%ld)\t", + (long)PerlProc_getpid(), display_file, line); else - PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", display_file, line); + PerlIO_printf(Perl_debug_log, "(%s:%ld)\t", display_file, line); (void) PerlIO_vprintf(Perl_debug_log, pat, *args); #else PERL_UNUSED_CONTEXT; @@ -83,15 +83,15 @@ Perl_debstackptrs(pTHX) { #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, - "%8" UVxf " %8" UVxf " %8" IVdf " %8" IVdf " %8" IVdf "\n", - PTR2UV(PL_curstack), PTR2UV(PL_stack_base), - (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base), - (IV)(PL_stack_max-PL_stack_base)); + "%8" UVxf " %8" UVxf " %8" IVdf " %8" IVdf " %8" IVdf "\n", + PTR2UV(PL_curstack), PTR2UV(PL_stack_base), + (IV)*PL_markstack_ptr, (IV)(PL_stack_sp-PL_stack_base), + (IV)(PL_stack_max-PL_stack_base)); PerlIO_printf(Perl_debug_log, - "%8" UVxf " %8" UVxf " %8" UVuf " %8" UVuf " %8" UVuf "\n", - PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)), - PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)), - PTR2UV(AvMAX(PL_curstack))); + "%8" UVxf " %8" UVxf " %8" UVuf " %8" UVuf " %8" UVuf "\n", + PTR2UV(PL_mainstack), PTR2UV(AvARRAY(PL_curstack)), + PTR2UV(PL_mainstack), PTR2UV(AvFILLp(PL_curstack)), + PTR2UV(AvMAX(PL_curstack))); #else PERL_UNUSED_CONTEXT; #endif /* DEBUGGING */ @@ -110,7 +110,7 @@ Perl_debstackptrs(pTHX) STATIC void S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, - I32 mark_min, I32 mark_max) + I32 mark_min, I32 mark_max) { #ifdef DEBUGGING I32 i = stack_max - 30; @@ -119,30 +119,30 @@ S_deb_stack_n(pTHX_ SV** stack_base, I32 stack_min, I32 stack_max, PERL_ARGS_ASSERT_DEB_STACK_N; if (i < stack_min) - i = stack_min; + i = stack_min; while (++markscan <= PL_markstack + mark_max) - if (*markscan >= i) - break; + if (*markscan >= i) + break; if (i > stack_min) - PerlIO_printf(Perl_debug_log, "... "); + PerlIO_printf(Perl_debug_log, "... "); if (stack_base[0] != &PL_sv_undef || stack_max < 0) - PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); + PerlIO_printf(Perl_debug_log, " [STACK UNDERFLOW!!!]\n"); do { - ++i; - if (markscan <= PL_markstack + mark_max && *markscan < i) { - do { - ++markscan; - (void)PerlIO_putc(Perl_debug_log, '*'); - } - while (markscan <= PL_markstack + mark_max && *markscan < i); - PerlIO_printf(Perl_debug_log, " "); - } - if (i > stack_max) - break; - PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i])); + ++i; + if (markscan <= PL_markstack + mark_max && *markscan < i) { + do { + ++markscan; + (void)PerlIO_putc(Perl_debug_log, '*'); + } + while (markscan <= PL_markstack + mark_max && *markscan < i); + PerlIO_printf(Perl_debug_log, " "); + } + if (i > stack_max) + break; + PerlIO_printf(Perl_debug_log, "%-4s ", SvPEEK(stack_base[i])); } while (1); PerlIO_printf(Perl_debug_log, "\n"); @@ -164,14 +164,14 @@ Perl_debstack(pTHX) { #ifndef SKIP_DEBUGGING if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) - return 0; + return 0; PerlIO_printf(Perl_debug_log, " => "); deb_stack_n(PL_stack_base, - 0, - PL_stack_sp - PL_stack_base, - PL_curstackinfo->si_markoff, - PL_markstack_ptr - PL_markstack); + 0, + PL_stack_sp - PL_stack_base, + PL_curstackinfo->si_markoff, + PL_markstack_ptr - PL_markstack); #endif /* SKIP_DEBUGGING */ @@ -209,7 +209,7 @@ Perl_deb_stack_all(pTHX) /* rewind to start of chain */ si = PL_curstackinfo; while (si->si_prev) - si = si->si_prev; + si = si->si_prev; si_ix=0; for (;;) @@ -218,107 +218,107 @@ Perl_deb_stack_all(pTHX) const char * const si_name = si_name_ix < C_ARRAY_LENGTH(si_names) ? si_names[si_name_ix] : "????"; - I32 ix; - PerlIO_printf(Perl_debug_log, "STACK %" IVdf ": %s\n", - (IV)si_ix, si_name); - - for (ix=0; ix<=si->si_cxix; ix++) { - - const PERL_CONTEXT * const cx = &(si->si_cxstack[ix]); - PerlIO_printf(Perl_debug_log, - " CX %" IVdf ": %-6s => ", - (IV)ix, PL_block_type[CxTYPE(cx)] - ); - /* substitution contexts don't save stack pointers etc) */ - if (CxTYPE(cx) == CXt_SUBST) - PerlIO_printf(Perl_debug_log, "\n"); - else { - - /* Find the current context's stack range by searching - * forward for any higher contexts using this stack; failing - * that, it will be equal to the size of the stack for old - * stacks, or PL_stack_sp for the current stack - */ - - I32 i, stack_min, stack_max, mark_min, mark_max; - const PERL_CONTEXT *cx_n = NULL; - const PERL_SI *si_n; + I32 ix; + PerlIO_printf(Perl_debug_log, "STACK %" IVdf ": %s\n", + (IV)si_ix, si_name); + + for (ix=0; ix<=si->si_cxix; ix++) { + + const PERL_CONTEXT * const cx = &(si->si_cxstack[ix]); + PerlIO_printf(Perl_debug_log, + " CX %" IVdf ": %-6s => ", + (IV)ix, PL_block_type[CxTYPE(cx)] + ); + /* substitution contexts don't save stack pointers etc) */ + if (CxTYPE(cx) == CXt_SUBST) + PerlIO_printf(Perl_debug_log, "\n"); + else { + + /* Find the current context's stack range by searching + * forward for any higher contexts using this stack; failing + * that, it will be equal to the size of the stack for old + * stacks, or PL_stack_sp for the current stack + */ + + I32 i, stack_min, stack_max, mark_min, mark_max; + const PERL_CONTEXT *cx_n = NULL; + const PERL_SI *si_n; /* there's a separate argument stack per SI, so only * search this one */ - for (i=ix+1; i<=si->si_cxix; i++) { + for (i=ix+1; i<=si->si_cxix; i++) { const PERL_CONTEXT *this_cx = &(si->si_cxstack[i]); if (CxTYPE(this_cx) == CXt_SUBST) - continue; - cx_n = this_cx; - break; - } - - stack_min = cx->blk_oldsp; - - if (cx_n) { - stack_max = cx_n->blk_oldsp; - } - else if (si == PL_curstackinfo) { - stack_max = PL_stack_sp - AvARRAY(si->si_stack); - } - else { - stack_max = AvFILLp(si->si_stack); - } + continue; + cx_n = this_cx; + break; + } + + stack_min = cx->blk_oldsp; + + if (cx_n) { + stack_max = cx_n->blk_oldsp; + } + else if (si == PL_curstackinfo) { + stack_max = PL_stack_sp - AvARRAY(si->si_stack); + } + else { + stack_max = AvFILLp(si->si_stack); + } /* for the markstack, there's only one stack shared * between all SIs */ - si_n = si; - i = ix; - cx_n = NULL; - for (;;) { - i++; - if (i > si_n->si_cxix) { - if (si_n == PL_curstackinfo) - break; - else { - si_n = si_n->si_next; - i = 0; - } - } - if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST) - continue; - cx_n = &(si_n->si_cxstack[i]); - break; - } - - mark_min = cx->blk_oldmarksp; - if (cx_n) { - mark_max = cx_n->blk_oldmarksp; - } - else { - mark_max = PL_markstack_ptr - PL_markstack; - } - - deb_stack_n(AvARRAY(si->si_stack), - stack_min, stack_max, mark_min, mark_max); - - if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB - || CxTYPE(cx) == CXt_FORMAT) - { - const OP * const retop = cx->blk_sub.retop; - - PerlIO_printf(Perl_debug_log, " retop=%s\n", - retop ? OP_NAME(retop) : "(null)" - ); - } - } - } /* next context */ - - - if (si == PL_curstackinfo) - break; - si = si->si_next; - si_ix++; - if (!si) - break; /* shouldn't happen, but just in case.. */ + si_n = si; + i = ix; + cx_n = NULL; + for (;;) { + i++; + if (i > si_n->si_cxix) { + if (si_n == PL_curstackinfo) + break; + else { + si_n = si_n->si_next; + i = 0; + } + } + if (CxTYPE(&(si_n->si_cxstack[i])) == CXt_SUBST) + continue; + cx_n = &(si_n->si_cxstack[i]); + break; + } + + mark_min = cx->blk_oldmarksp; + if (cx_n) { + mark_max = cx_n->blk_oldmarksp; + } + else { + mark_max = PL_markstack_ptr - PL_markstack; + } + + deb_stack_n(AvARRAY(si->si_stack), + stack_min, stack_max, mark_min, mark_max); + + if (CxTYPE(cx) == CXt_EVAL || CxTYPE(cx) == CXt_SUB + || CxTYPE(cx) == CXt_FORMAT) + { + const OP * const retop = cx->blk_sub.retop; + + PerlIO_printf(Perl_debug_log, " retop=%s\n", + retop ? OP_NAME(retop) : "(null)" + ); + } + } + } /* next context */ + + + if (si == PL_curstackinfo) + break; + si = si->si_next; + si_ix++; + if (!si) + break; /* shouldn't happen, but just in case.. */ } /* next stackinfo */ PerlIO_printf(Perl_debug_log, "\n"); diff --git a/dist/IO/poll.c b/dist/IO/poll.c index 344a406b529c..3ddaa22db4f2 100644 --- a/dist/IO/poll.c +++ b/dist/IO/poll.c @@ -61,74 +61,74 @@ poll(struct pollfd *fds, unsigned long nfds, int timeout) FD_ZERO(&efd); for(i = 0 ; i < (int)nfds ; i++) { - int events = fds[i].events; - int fd = fds[i].fd; + int events = fds[i].events; + int fd = fds[i].fd; - fds[i].revents = 0; + fds[i].revents = 0; - if(fd < 0 || FD_ISSET(fd, &ifd)) - continue; + if(fd < 0 || FD_ISSET(fd, &ifd)) + continue; - if(fd > n) - n = fd; + if(fd > n) + n = fd; - if(events & POLL_CAN_READ) - FD_SET(fd, &rfd); + if(events & POLL_CAN_READ) + FD_SET(fd, &rfd); - if(events & POLL_CAN_WRITE) - FD_SET(fd, &wfd); + if(events & POLL_CAN_WRITE) + FD_SET(fd, &wfd); - if(events & POLL_HAS_EXCP) - FD_SET(fd, &efd); + if(events & POLL_HAS_EXCP) + FD_SET(fd, &efd); } if(timeout >= 0) { - timebuf.tv_sec = timeout / 1000; - timebuf.tv_usec = (timeout % 1000) * 1000; - tbuf = &timebuf; + timebuf.tv_sec = timeout / 1000; + timebuf.tv_usec = (timeout % 1000) * 1000; + tbuf = &timebuf; } err = select(n+1,&rfd,&wfd,&efd,tbuf); if(err < 0) { #ifdef HAS_FSTAT - if(errno == EBADF) { - for(i = 0 ; i < nfds ; i++) { - struct stat buf; - if((fstat(fds[i].fd,&buf) < 0) && (errno == EBADF)) { - FD_SET(fds[i].fd, &ifd); - goto again; - } - } - } + if(errno == EBADF) { + for(i = 0 ; i < nfds ; i++) { + struct stat buf; + if((fstat(fds[i].fd,&buf) < 0) && (errno == EBADF)) { + FD_SET(fds[i].fd, &ifd); + goto again; + } + } + } #endif /* HAS_FSTAT */ - return err; + return err; } count = 0; for(i = 0 ; i < (int)nfds ; i++) { - int revents = (fds[i].events & POLL_EVENTS_MASK); - int fd = fds[i].fd; + int revents = (fds[i].events & POLL_EVENTS_MASK); + int fd = fds[i].fd; - if(fd < 0) - continue; + if(fd < 0) + continue; - if(FD_ISSET(fd, &ifd)) - revents = POLLNVAL; - else { - if(!FD_ISSET(fd, &rfd)) - revents &= ~POLL_CAN_READ; + if(FD_ISSET(fd, &ifd)) + revents = POLLNVAL; + else { + if(!FD_ISSET(fd, &rfd)) + revents &= ~POLL_CAN_READ; - if(!FD_ISSET(fd, &wfd)) - revents &= ~POLL_CAN_WRITE; + if(!FD_ISSET(fd, &wfd)) + revents &= ~POLL_CAN_WRITE; - if(!FD_ISSET(fd, &efd)) - revents &= ~POLL_HAS_EXCP; - } + if(!FD_ISSET(fd, &efd)) + revents &= ~POLL_HAS_EXCP; + } - if((fds[i].revents = revents) != 0) - count++; + if((fds[i].revents = revents) != 0) + count++; } return count; diff --git a/djgpp/djgpp.c b/djgpp/djgpp.c index 24d12f254b25..ddadeb7d53c2 100644 --- a/djgpp/djgpp.c +++ b/djgpp/djgpp.c @@ -107,7 +107,7 @@ convretcode (pTHX_ int rc,char *prog,int fl) { if (rc < 0 && ckWARN(WARN_EXEC)) Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't %s \"%s\": %s", - fl ? "exec" : "spawn",prog,Strerror (errno)); + fl ? "exec" : "spawn",prog,Strerror (errno)); if (rc >= 0) return rc << 8; return -1; @@ -155,13 +155,13 @@ do_spawn2 (pTHX_ char *cmd,int execf) ENTER; if ((shell=getenv("SHELL"))==NULL && (shell=getenv("COMSPEC"))==NULL) - shell="c:\\command.com" EXTRA; + shell="c:\\command.com" EXTRA; unixysh=_is_unixy_shell (shell); metachars=unixysh ? "$&*(){}[]'\";\\?>|<~`\n" EXTRA : "*?[|<>\"\\" EXTRA; while (*cmd && isSPACE(*cmd)) - cmd++; + cmd++; if (strBEGINs (cmd,"/bin/sh") && isSPACE (cmd[7])) cmd+=5; @@ -181,20 +181,20 @@ do_spawn2 (pTHX_ char *cmd,int execf) goto doshell; } for (s=cmd; *s; s++) - if (strchr (metachars,*s)) - { - if (*s=='\n' && s[1]=='\0') - { - *s='\0'; - break; - } + if (strchr (metachars,*s)) + { + if (*s=='\n' && s[1]=='\0') + { + *s='\0'; + break; + } doshell: - if (execf==EXECF_EXEC) + if (execf==EXECF_EXEC) result = convretcode (execl (shell,shell,unixysh ? "-c" : "/c",cmd,NULL),cmd,execf); - else - result = convretcode (system (cmd),cmd,execf); - goto leave; - } + else + result = convretcode (system (cmd),cmd,execf); + goto leave; + } Newx (argv,(s-cmd)/2+2,char*); SAVEFREEPV(argv); @@ -202,17 +202,17 @@ do_spawn2 (pTHX_ char *cmd,int execf) SAVEFREEPV(cmd); a=argv; for (s=cmd; *s;) { - while (*s && isSPACE (*s)) s++; - if (*s) - *(a++)=s; - while (*s && !isSPACE (*s)) s++; - if (*s) - *s++='\0'; + while (*s && isSPACE (*s)) s++; + if (*s) + *(a++)=s; + while (*s && !isSPACE (*s)) s++; + if (*s) + *s++='\0'; } *a=NULL; if (!argv[0]) { result = -1; - goto leave; + goto leave; } if (execf==EXECF_EXEC) @@ -362,7 +362,7 @@ XS(dos_GetCwd) ST(0)=sv_newmortal (); if (getcwd (tmp,PATH_MAX+1)!=NULL) sv_setpv ((SV*)ST(0),tmp); - SvTAINTED_on(ST(0)); + SvTAINTED_on(ST(0)); } XSRETURN (1); } @@ -378,14 +378,14 @@ XS(XS_Cwd_sys_cwd) { dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: Cwd::sys_cwd()"); + Perl_croak_nocontext("Usage: Cwd::sys_cwd()"); { - char p[MAXPATHLEN]; - char * RETVAL; - RETVAL = getcwd(p, MAXPATHLEN); - ST(0) = sv_newmortal(); - sv_setpv((SV*)ST(0), RETVAL); - SvTAINTED_on(ST(0)); + char p[MAXPATHLEN]; + char * RETVAL; + RETVAL = getcwd(p, MAXPATHLEN); + ST(0) = sv_newmortal(); + sv_setpv((SV*)ST(0), RETVAL); + SvTAINTED_on(ST(0)); } XSRETURN(1); } @@ -453,9 +453,9 @@ djgpp_fflush (FILE *fp) int res; if ((res = fflush(fp)) == 0 && fp) { - Stat_t s; - if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode)) - res = fsync(fileno(fp)); + Stat_t s; + if (Fstat(fileno(fp), &s) == 0 && !S_ISSOCK(s.st_mode)) + res = fsync(fileno(fp)); } /* * If the flush succeeded but set end-of-file, we need to clear diff --git a/doio.c b/doio.c index 439f2d096a57..baca499d102a 100644 --- a/doio.c +++ b/doio.c @@ -83,7 +83,7 @@ Perl_setfd_cloexec_for_nonsysfd(pTHX_ int fd) { assert(fd >= 0); if(fd > PL_maxsysfd) - setfd_cloexec(fd); + setfd_cloexec(fd); } void @@ -91,96 +91,96 @@ Perl_setfd_inhexec_for_sysfd(pTHX_ int fd) { assert(fd >= 0); if(fd <= PL_maxsysfd) - setfd_inhexec(fd); + setfd_inhexec(fd); } void Perl_setfd_cloexec_or_inhexec_by_sysfdness(pTHX_ int fd) { assert(fd >= 0); if(fd <= PL_maxsysfd) - setfd_inhexec(fd); + setfd_inhexec(fd); else - setfd_cloexec(fd); + setfd_cloexec(fd); } #define DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ - do { \ - int res = (GENOPEN_NORMAL); \ - if(LIKELY(res != -1)) GENSETFD_CLOEXEC; \ - return res; \ - } while(0) + do { \ + int res = (GENOPEN_NORMAL); \ + if(LIKELY(res != -1)) GENSETFD_CLOEXEC; \ + return res; \ + } while(0) #if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC) && \ - defined(F_GETFD) + defined(F_GETFD) enum { CLOEXEC_EXPERIMENT = 0, CLOEXEC_AT_OPEN, CLOEXEC_AFTER_OPEN }; # define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_CLOEXEC, \ - GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ - do { \ - switch (strategy) { \ - case CLOEXEC_EXPERIMENT: default: { \ - int res = (GENOPEN_CLOEXEC), eno; \ - if (LIKELY(res != -1)) { \ - int fdflags = fcntl((TESTFD), F_GETFD); \ - if (LIKELY(fdflags != -1) && \ - LIKELY(fdflags & FD_CLOEXEC)) { \ - strategy = CLOEXEC_AT_OPEN; \ - } else { \ - strategy = CLOEXEC_AFTER_OPEN; \ - GENSETFD_CLOEXEC; \ - } \ - } else if (UNLIKELY((eno = errno) == EINVAL || \ - eno == ENOSYS)) { \ - res = (GENOPEN_NORMAL); \ - if (LIKELY(res != -1)) { \ - strategy = CLOEXEC_AFTER_OPEN; \ - GENSETFD_CLOEXEC; \ - } else if (!LIKELY((eno = errno) == EINVAL || \ - eno == ENOSYS)) { \ - strategy = CLOEXEC_AFTER_OPEN; \ - } \ - } \ - return res; \ - } \ - case CLOEXEC_AT_OPEN: \ - return (GENOPEN_CLOEXEC); \ - case CLOEXEC_AFTER_OPEN: \ - DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC); \ - } \ - } while(0) + GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ + do { \ + switch (strategy) { \ + case CLOEXEC_EXPERIMENT: default: { \ + int res = (GENOPEN_CLOEXEC), eno; \ + if (LIKELY(res != -1)) { \ + int fdflags = fcntl((TESTFD), F_GETFD); \ + if (LIKELY(fdflags != -1) && \ + LIKELY(fdflags & FD_CLOEXEC)) { \ + strategy = CLOEXEC_AT_OPEN; \ + } else { \ + strategy = CLOEXEC_AFTER_OPEN; \ + GENSETFD_CLOEXEC; \ + } \ + } else if (UNLIKELY((eno = errno) == EINVAL || \ + eno == ENOSYS)) { \ + res = (GENOPEN_NORMAL); \ + if (LIKELY(res != -1)) { \ + strategy = CLOEXEC_AFTER_OPEN; \ + GENSETFD_CLOEXEC; \ + } else if (!LIKELY((eno = errno) == EINVAL || \ + eno == ENOSYS)) { \ + strategy = CLOEXEC_AFTER_OPEN; \ + } \ + } \ + return res; \ + } \ + case CLOEXEC_AT_OPEN: \ + return (GENOPEN_CLOEXEC); \ + case CLOEXEC_AFTER_OPEN: \ + DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC); \ + } \ + } while(0) #else # define DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, TESTFD, GENOPEN_CLOEXEC, \ - GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ - DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) + GENOPEN_NORMAL, GENSETFD_CLOEXEC) \ + DO_GENOPEN_THEN_CLOEXEC(GENOPEN_NORMAL, GENSETFD_CLOEXEC) #endif #define DO_ONEOPEN_THEN_CLOEXEC(ONEOPEN_NORMAL) \ - do { \ - int fd; \ - DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \ - setfd_cloexec(fd)); \ - } while(0) + do { \ + int fd; \ + DO_GENOPEN_THEN_CLOEXEC(fd = (ONEOPEN_NORMAL), \ + setfd_cloexec(fd)); \ + } while(0) #define DO_ONEOPEN_EXPERIMENTING_CLOEXEC(strategy, \ ONEOPEN_CLOEXEC, ONEOPEN_NORMAL) \ - do { \ - int fd; \ - DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \ + do { \ + int fd; \ + DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \ fd, \ fd = (ONEOPEN_CLOEXEC), \ - fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \ - } while(0) + fd = (ONEOPEN_NORMAL), setfd_cloexec(fd)); \ + } while(0) #define DO_PIPESETFD_CLOEXEC(PIPEFD) \ - do { \ - setfd_cloexec((PIPEFD)[0]); \ - setfd_cloexec((PIPEFD)[1]); \ - } while(0) + do { \ + setfd_cloexec((PIPEFD)[0]); \ + setfd_cloexec((PIPEFD)[1]); \ + } while(0) #define DO_PIPEOPEN_THEN_CLOEXEC(PIPEFD, PIPEOPEN_NORMAL) \ - DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) + DO_GENOPEN_THEN_CLOEXEC(PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) #define DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(strategy, PIPEFD, PIPEOPEN_CLOEXEC, \ - PIPEOPEN_NORMAL) \ - DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \ + PIPEOPEN_NORMAL) \ + DO_GENOPEN_EXPERIMENTING_CLOEXEC(strategy, \ (PIPEFD)[0], PIPEOPEN_CLOEXEC, \ - PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) + PIPEOPEN_NORMAL, DO_PIPESETFD_CLOEXEC(PIPEFD)) int Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd) @@ -193,8 +193,8 @@ Perl_PerlLIO_dup_cloexec(pTHX_ int oldfd) */ DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_dup, - fcntl(oldfd, F_DUPFD_CLOEXEC, 0), - PerlLIO_dup(oldfd)); + fcntl(oldfd, F_DUPFD_CLOEXEC, 0), + PerlLIO_dup(oldfd)); #else DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_dup(oldfd)); #endif @@ -211,8 +211,8 @@ Perl_PerlLIO_dup2_cloexec(pTHX_ int oldfd, int newfd) */ DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_dup2, - dup3(oldfd, newfd, O_CLOEXEC), - PerlLIO_dup2(oldfd, newfd)); + dup3(oldfd, newfd, O_CLOEXEC), + PerlLIO_dup2(oldfd, newfd)); #else DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_dup2(oldfd, newfd)); #endif @@ -225,8 +225,8 @@ Perl_PerlLIO_open_cloexec(pTHX_ const char *file, int flag) #if defined(O_CLOEXEC) DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_open, - PerlLIO_open(file, flag | O_CLOEXEC), - PerlLIO_open(file, flag)); + PerlLIO_open(file, flag | O_CLOEXEC), + PerlLIO_open(file, flag)); #else DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_open(file, flag)); #endif @@ -239,8 +239,8 @@ Perl_PerlLIO_open3_cloexec(pTHX_ const char *file, int flag, int perm) #if defined(O_CLOEXEC) DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_open3, - PerlLIO_open3(file, flag | O_CLOEXEC, perm), - PerlLIO_open3(file, flag, perm)); + PerlLIO_open3(file, flag | O_CLOEXEC, perm), + PerlLIO_open3(file, flag, perm)); #else DO_ONEOPEN_THEN_CLOEXEC(PerlLIO_open3(file, flag, perm)); #endif @@ -253,8 +253,8 @@ Perl_my_mkstemp_cloexec(char *templte) #if defined(O_CLOEXEC) DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_mkstemp, - Perl_my_mkostemp(templte, O_CLOEXEC), - Perl_my_mkstemp(templte)); + Perl_my_mkostemp(templte, O_CLOEXEC), + Perl_my_mkstemp(templte)); #else DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkstemp(templte)); #endif @@ -267,8 +267,8 @@ Perl_my_mkostemp_cloexec(char *templte, int flags) #if defined(O_CLOEXEC) DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_mkstemp, - Perl_my_mkostemp(templte, flags | O_CLOEXEC), - Perl_my_mkostemp(templte, flags)); + Perl_my_mkostemp(templte, flags | O_CLOEXEC), + Perl_my_mkostemp(templte, flags)); #else DO_ONEOPEN_THEN_CLOEXEC(Perl_my_mkostemp(templte, flags)); #endif @@ -286,8 +286,8 @@ Perl_PerlProc_pipe_cloexec(pTHX_ int *pipefd) */ # if !defined(PERL_IMPLICIT_SYS) && defined(HAS_PIPE2) && defined(O_CLOEXEC) DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_pipe, pipefd, - pipe2(pipefd, O_CLOEXEC), - PerlProc_pipe(pipefd)); + pipe2(pipefd, O_CLOEXEC), + PerlProc_pipe(pipefd)); # else DO_PIPEOPEN_THEN_CLOEXEC(pipefd, PerlProc_pipe(pipefd)); # endif @@ -302,8 +302,8 @@ Perl_PerlSock_socket_cloexec(pTHX_ int domain, int type, int protocol) # if defined(SOCK_CLOEXEC) DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_socket, - PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol), - PerlSock_socket(domain, type, protocol)); + PerlSock_socket(domain, type | SOCK_CLOEXEC, protocol), + PerlSock_socket(domain, type, protocol)); # else DO_ONEOPEN_THEN_CLOEXEC(PerlSock_socket(domain, type, protocol)); # endif @@ -314,7 +314,7 @@ Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr, Sock_size_t *addrlen) { # if !defined(PERL_IMPLICIT_SYS) && \ - defined(HAS_ACCEPT4) && defined(SOCK_CLOEXEC) + defined(HAS_ACCEPT4) && defined(SOCK_CLOEXEC) /* * struct IPerlSock doesn't cover accept4(), and there's no clear * way to extend it, so for the time being this just isn't available @@ -322,8 +322,8 @@ Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr, */ DO_ONEOPEN_EXPERIMENTING_CLOEXEC( PL_strategy_accept, - accept4(listenfd, addr, addrlen, SOCK_CLOEXEC), - PerlSock_accept(listenfd, addr, addrlen)); + accept4(listenfd, addr, addrlen, SOCK_CLOEXEC), + PerlSock_accept(listenfd, addr, addrlen)); # else DO_ONEOPEN_THEN_CLOEXEC(PerlSock_accept(listenfd, addr, addrlen)); # endif @@ -333,7 +333,7 @@ Perl_PerlSock_accept_cloexec(pTHX_ int listenfd, struct sockaddr *addr, #if defined (HAS_SOCKETPAIR) || \ (defined (HAS_SOCKET) && defined(SOCK_DGRAM) && \ - defined(AF_INET) && defined(PF_INET)) + defined(AF_INET) && defined(PF_INET)) int Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol, int *pairfd) @@ -341,11 +341,11 @@ Perl_PerlSock_socketpair_cloexec(pTHX_ int domain, int type, int protocol, PERL_ARGS_ASSERT_PERLSOCK_SOCKETPAIR_CLOEXEC; # ifdef SOCK_CLOEXEC DO_PIPEOPEN_EXPERIMENTING_CLOEXEC(PL_strategy_socketpair, pairfd, - PerlSock_socketpair(domain, type | SOCK_CLOEXEC, protocol, pairfd), - PerlSock_socketpair(domain, type, protocol, pairfd)); + PerlSock_socketpair(domain, type | SOCK_CLOEXEC, protocol, pairfd), + PerlSock_socketpair(domain, type, protocol, pairfd)); # else DO_PIPEOPEN_THEN_CLOEXEC(pairfd, - PerlSock_socketpair(domain, type, protocol, pairfd)); + PerlSock_socketpair(domain, type, protocol, pairfd)); # endif } #endif @@ -368,10 +368,10 @@ S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, /* If currently open - close before we re-open */ if (IoIFP(io)) { - if (IoTYPE(io) == IoTYPE_STD) { - /* This is a clone of one of STD* handles */ - } - else { + if (IoTYPE(io) == IoTYPE_STD) { + /* This is a clone of one of STD* handles */ + } + else { const int old_fd = PerlIO_fileno(IoIFP(io)); if (inRANGE(old_fd, 0, PL_maxsysfd)) { @@ -407,25 +407,25 @@ S_openn_setup(pTHX_ GV *gv, char *mode, PerlIO **saveifp, PerlIO **saveofp, } } } - IoOFP(io) = IoIFP(io) = NULL; + IoOFP(io) = IoIFP(io) = NULL; } return io; } bool Perl_do_openn(pTHX_ GV *gv, const char *oname, I32 len, int as_raw, - int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, - I32 num_svs) + int rawmode, int rawperm, PerlIO *supplied_fp, SV **svp, + I32 num_svs) { PERL_ARGS_ASSERT_DO_OPENN; if (as_raw) { /* sysopen style args, i.e. integer mode and permissions */ - if (num_svs != 0) { - Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld", - (long) num_svs); - } + if (num_svs != 0) { + Perl_croak(aTHX_ "panic: sysopen with multiple args, num_svs=%ld", + (long) num_svs); + } return do_open_raw(gv, oname, len, rawmode, rawperm, NULL); } return do_open6(gv, oname, len, supplied_fp, svp, num_svs); @@ -449,52 +449,52 @@ Perl_do_open_raw(pTHX_ GV *gv, const char *oname, STRLEN len, /* For ease of blame back to 5.000, keep the existing indenting. */ { /* sysopen style args, i.e. integer mode and permissions */ - STRLEN ix = 0; - const int appendtrunc = - 0 + STRLEN ix = 0; + const int appendtrunc = + 0 #ifdef O_APPEND /* Not fully portable. */ - |O_APPEND + |O_APPEND #endif #ifdef O_TRUNC /* Not fully portable. */ - |O_TRUNC + |O_TRUNC #endif - ; - const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; - int ismodifying; + ; + const int modifyingmode = O_WRONLY|O_RDWR|O_CREAT|appendtrunc; + int ismodifying; SV *namesv; - /* It's not always + /* It's not always - O_RDONLY 0 - O_WRONLY 1 - O_RDWR 2 + O_RDONLY 0 + O_WRONLY 1 + O_RDWR 2 - It might be (in OS/390 and Mac OS Classic it is) + It might be (in OS/390 and Mac OS Classic it is) - O_WRONLY 1 - O_RDONLY 2 - O_RDWR 3 + O_WRONLY 1 + O_RDONLY 2 + O_RDWR 3 - This means that simple & with O_RDWR would look - like O_RDONLY is present. Therefore we have to - be more careful. - */ - if ((ismodifying = (rawmode & modifyingmode))) { - if ((ismodifying & O_WRONLY) == O_WRONLY || - (ismodifying & O_RDWR) == O_RDWR || - (ismodifying & (O_CREAT|appendtrunc))) - TAINT_PROPER("sysopen"); - } - mode[ix++] = IoTYPE_NUMERIC; /* Marker to openn to use numeric "sysopen" */ + This means that simple & with O_RDWR would look + like O_RDONLY is present. Therefore we have to + be more careful. + */ + if ((ismodifying = (rawmode & modifyingmode))) { + if ((ismodifying & O_WRONLY) == O_WRONLY || + (ismodifying & O_RDWR) == O_RDWR || + (ismodifying & (O_CREAT|appendtrunc))) + TAINT_PROPER("sysopen"); + } + mode[ix++] = IoTYPE_NUMERIC; /* Marker to openn to use numeric "sysopen" */ #if defined(USE_64_BIT_RAWIO) && defined(O_LARGEFILE) - rawmode |= O_LARGEFILE; /* Transparently largefiley. */ + rawmode |= O_LARGEFILE; /* Transparently largefiley. */ #endif IoTYPE(io) = PerlIO_intmode2str(rawmode, &mode[ix], &writing); - namesv = newSVpvn_flags(oname, len, SVs_TEMP); - fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1, &namesv); + namesv = newSVpvn_flags(oname, len, SVs_TEMP); + fp = PerlIO_openn(aTHX_ NULL, mode, -1, rawmode, rawperm, NULL, 1, &namesv); } return openn_cleanup(gv, io, fp, mode, oname, saveifp, saveofp, savefd, savetype, writing, 0, NULL, statbufp); @@ -519,11 +519,11 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, /* For ease of blame back to 5.000, keep the existing indenting. */ { - /* Regular (non-sys) open */ - char *name; - STRLEN olen = len; - char *tend; - int dodup = 0; + /* Regular (non-sys) open */ + char *name; + STRLEN olen = len; + char *tend; + int dodup = 0; bool in_raw = 0, in_crlf = 0, out_raw = 0, out_crlf = 0; /* Collect default raw/crlf info from the op */ @@ -536,29 +536,29 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, out_crlf = (flags & OPpOPEN_OUT_CRLF); } - type = savepvn(oname, len); - tend = type+len; - SAVEFREEPV(type); + type = savepvn(oname, len); + tend = type+len; + SAVEFREEPV(type); /* Lose leading and trailing white space */ - while (isSPACE(*type)) - type++; + while (isSPACE(*type)) + type++; while (tend > type && isSPACE(tend[-1])) - *--tend = '\0'; + *--tend = '\0'; - if (num_svs) { + if (num_svs) { const char *p; STRLEN nlen = 0; - /* New style explicit name, type is just mode and layer info */ + /* New style explicit name, type is just mode and layer info */ #ifdef USE_STDIO - if (SvROK(*svp) && !memchr(oname, '&', len)) { - if (ckWARN(WARN_IO)) - Perl_warner(aTHX_ packWARN(WARN_IO), - "Can't open a reference"); - SETERRNO(EINVAL, LIB_INVARG); + if (SvROK(*svp) && !memchr(oname, '&', len)) { + if (ckWARN(WARN_IO)) + Perl_warner(aTHX_ packWARN(WARN_IO), + "Can't open a reference"); + SETERRNO(EINVAL, LIB_INVARG); fp = NULL; - goto say_false; - } + goto say_false; + } #endif /* USE_STDIO */ p = (SvOK(*svp) || SvGMAGICAL(*svp)) ? SvPV(*svp, nlen) : NULL; @@ -567,331 +567,331 @@ Perl_do_open6(pTHX_ GV *gv, const char *oname, STRLEN len, goto say_false; } - name = p ? savepvn(p, nlen) : savepvs(""); + name = p ? savepvn(p, nlen) : savepvs(""); - SAVEFREEPV(name); - } - else { - name = type; - len = tend-type; - } - IoTYPE(io) = *type; - if ((*type == IoTYPE_RDWR) && /* scary */ + SAVEFREEPV(name); + } + else { + name = type; + len = tend-type; + } + IoTYPE(io) = *type; + if ((*type == IoTYPE_RDWR) && /* scary */ (*(type+1) == IoTYPE_RDONLY || *(type+1) == IoTYPE_WRONLY) && - ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) { - TAINT_PROPER("open"); - mode[1] = *type++; - writing = 1; - } - - if (*type == IoTYPE_PIPE) { - if (num_svs) { - if (type[1] != IoTYPE_STD) { - unknown_open_mode: - Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname); - } - type++; - } - do { - type++; - } while (isSPACE(*type)); - if (!num_svs) { - name = type; - len = tend-type; - } - if (*name == '\0') { - /* command is missing 19990114 */ - if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); - errno = EPIPE; + ((!num_svs || (tend > type+1 && tend[-1] != IoTYPE_PIPE)))) { + TAINT_PROPER("open"); + mode[1] = *type++; + writing = 1; + } + + if (*type == IoTYPE_PIPE) { + if (num_svs) { + if (type[1] != IoTYPE_STD) { + unknown_open_mode: + Perl_croak(aTHX_ "Unknown open() mode '%.*s'", (int)olen, oname); + } + type++; + } + do { + type++; + } while (isSPACE(*type)); + if (!num_svs) { + name = type; + len = tend-type; + } + if (*name == '\0') { + /* command is missing 19990114 */ + if (ckWARN(WARN_PIPE)) + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); + errno = EPIPE; fp = NULL; - goto say_false; - } - if (!(*name == '-' && name[1] == '\0') || num_svs) - TAINT_ENV(); - TAINT_PROPER("piped open"); - if (!num_svs && name[len-1] == '|') { - name[--len] = '\0' ; - if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe"); - } - mode[0] = 'w'; - writing = 1; + goto say_false; + } + if (!(*name == '-' && name[1] == '\0') || num_svs) + TAINT_ENV(); + TAINT_PROPER("piped open"); + if (!num_svs && name[len-1] == '|') { + name[--len] = '\0' ; + if (ckWARN(WARN_PIPE)) + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Can't open bidirectional pipe"); + } + mode[0] = 'w'; + writing = 1; if (out_raw) - mode[1] = 'b'; + mode[1] = 'b'; else if (out_crlf) - mode[1] = 't'; - if (num_svs > 1) { - fp = PerlProc_popen_list(mode, num_svs, svp); - } - else { - fp = PerlProc_popen(name,mode); - } - if (num_svs) { - if (*type) { - if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { + mode[1] = 't'; + if (num_svs > 1) { + fp = PerlProc_popen_list(mode, num_svs, svp); + } + else { + fp = PerlProc_popen(name,mode); + } + if (num_svs) { + if (*type) { + if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { fp = NULL; - goto say_false; - } - } - } - } /* IoTYPE_PIPE */ - else if (*type == IoTYPE_WRONLY) { - TAINT_PROPER("open"); - type++; - if (*type == IoTYPE_WRONLY) { - /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */ - mode[0] = IoTYPE(io) = IoTYPE_APPEND; - type++; - } - else { - mode[0] = 'w'; - } - writing = 1; + goto say_false; + } + } + } + } /* IoTYPE_PIPE */ + else if (*type == IoTYPE_WRONLY) { + TAINT_PROPER("open"); + type++; + if (*type == IoTYPE_WRONLY) { + /* Two IoTYPE_WRONLYs in a row make for an IoTYPE_APPEND. */ + mode[0] = IoTYPE(io) = IoTYPE_APPEND; + type++; + } + else { + mode[0] = 'w'; + } + writing = 1; if (out_raw) - mode[1] = 'b'; + mode[1] = 'b'; else if (out_crlf) - mode[1] = 't'; - if (*type == '&') { - duplicity: - dodup = PERLIO_DUP_FD; - type++; - if (*type == '=') { - dodup = 0; - type++; - } - if (!num_svs && !*type && supplied_fp) { - /* "<+&" etc. is used by typemaps */ - fp = supplied_fp; - } - else { - PerlIO *that_fp = NULL; + mode[1] = 't'; + if (*type == '&') { + duplicity: + dodup = PERLIO_DUP_FD; + type++; + if (*type == '=') { + dodup = 0; + type++; + } + if (!num_svs && !*type && supplied_fp) { + /* "<+&" etc. is used by typemaps */ + fp = supplied_fp; + } + else { + PerlIO *that_fp = NULL; int wanted_fd; UV uv; - if (num_svs > 1) { - /* diag_listed_as: More than one argument to '%s' open */ - Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io)); - } - while (isSPACE(*type)) - type++; - if (num_svs && ( - SvIOK(*svp) - || (SvPOKp(*svp) && looks_like_number(*svp)) - )) { + if (num_svs > 1) { + /* diag_listed_as: More than one argument to '%s' open */ + Perl_croak(aTHX_ "More than one argument to '%c&' open",IoTYPE(io)); + } + while (isSPACE(*type)) + type++; + if (num_svs && ( + SvIOK(*svp) + || (SvPOKp(*svp) && looks_like_number(*svp)) + )) { wanted_fd = SvUV(*svp); - num_svs = 0; - } - else if (isDIGIT(*type) + num_svs = 0; + } + else if (isDIGIT(*type) && grok_atoUV(type, &uv, NULL) && uv <= INT_MAX ) { wanted_fd = (int)uv; - } - else { - const IO* thatio; - if (num_svs) { - thatio = sv_2io(*svp); - } - else { - GV * const thatgv = gv_fetchpvn_flags(type, tend - type, - 0, SVt_PVIO); - thatio = GvIO(thatgv); - } - if (!thatio) { + } + else { + const IO* thatio; + if (num_svs) { + thatio = sv_2io(*svp); + } + else { + GV * const thatgv = gv_fetchpvn_flags(type, tend - type, + 0, SVt_PVIO); + thatio = GvIO(thatgv); + } + if (!thatio) { #ifdef EINVAL - SETERRNO(EINVAL,SS_IVCHAN); + SETERRNO(EINVAL,SS_IVCHAN); #endif fp = NULL; - goto say_false; - } - if ((that_fp = IoIFP(thatio))) { - /* Flush stdio buffer before dup. --mjd - * Unfortunately SEEK_CURing 0 seems to - * be optimized away on most platforms; - * only Solaris and Linux seem to flush - * on that. --jhi */ - /* On the other hand, do all platforms - * take gracefully to flushing a read-only - * filehandle? Perhaps we should do - * fsetpos(src)+fgetpos(dst)? --nik */ - PerlIO_flush(that_fp); - wanted_fd = PerlIO_fileno(that_fp); - /* When dup()ing STDIN, STDOUT or STDERR - * explicitly set appropriate access mode */ - if (that_fp == PerlIO_stdout() - || that_fp == PerlIO_stderr()) - IoTYPE(io) = IoTYPE_WRONLY; - else if (that_fp == PerlIO_stdin()) + goto say_false; + } + if ((that_fp = IoIFP(thatio))) { + /* Flush stdio buffer before dup. --mjd + * Unfortunately SEEK_CURing 0 seems to + * be optimized away on most platforms; + * only Solaris and Linux seem to flush + * on that. --jhi */ + /* On the other hand, do all platforms + * take gracefully to flushing a read-only + * filehandle? Perhaps we should do + * fsetpos(src)+fgetpos(dst)? --nik */ + PerlIO_flush(that_fp); + wanted_fd = PerlIO_fileno(that_fp); + /* When dup()ing STDIN, STDOUT or STDERR + * explicitly set appropriate access mode */ + if (that_fp == PerlIO_stdout() + || that_fp == PerlIO_stderr()) + IoTYPE(io) = IoTYPE_WRONLY; + else if (that_fp == PerlIO_stdin()) IoTYPE(io) = IoTYPE_RDONLY; - /* When dup()ing a socket, say result is - * one as well */ - else if (IoTYPE(thatio) == IoTYPE_SOCKET) - IoTYPE(io) = IoTYPE_SOCKET; - } + /* When dup()ing a socket, say result is + * one as well */ + else if (IoTYPE(thatio) == IoTYPE_SOCKET) + IoTYPE(io) = IoTYPE_SOCKET; + } else { SETERRNO(EBADF, RMS_IFI); fp = NULL; goto say_false; } - } - if (!num_svs) - type = NULL; - if (that_fp) { - fp = PerlIO_fdupopen(aTHX_ that_fp, NULL, dodup); - } - else { - if (dodup) + } + if (!num_svs) + type = NULL; + if (that_fp) { + fp = PerlIO_fdupopen(aTHX_ that_fp, NULL, dodup); + } + else { + if (dodup) wanted_fd = PerlLIO_dup_cloexec(wanted_fd); - else - was_fdopen = TRUE; + else + was_fdopen = TRUE; if (!(fp = PerlIO_openn(aTHX_ type,mode,wanted_fd,0,0,NULL,num_svs,svp))) { if (dodup && wanted_fd >= 0) PerlLIO_close(wanted_fd); - } - } - } - } /* & */ - else { - while (isSPACE(*type)) - type++; - if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { - type++; - fp = PerlIO_stdout(); - IoTYPE(io) = IoTYPE_STD; - if (num_svs > 1) { - /* diag_listed_as: More than one argument to '%s' open */ - Perl_croak(aTHX_ "More than one argument to '>%c' open",IoTYPE_STD); - } - } - else { - if (num_svs) { + } + } + } + } /* & */ + else { + while (isSPACE(*type)) + type++; + if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { + type++; + fp = PerlIO_stdout(); + IoTYPE(io) = IoTYPE_STD; + if (num_svs > 1) { + /* diag_listed_as: More than one argument to '%s' open */ + Perl_croak(aTHX_ "More than one argument to '>%c' open",IoTYPE_STD); + } + } + else { + if (num_svs) { fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } else { SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); - type = NULL; + type = NULL; fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv); - } - } - } /* !& */ - if (!fp && type && *type && *type != ':' && !isIDFIRST(*type)) - goto unknown_open_mode; - } /* IoTYPE_WRONLY */ - else if (*type == IoTYPE_RDONLY) { - do { - type++; - } while (isSPACE(*type)); - mode[0] = 'r'; + } + } + } /* !& */ + if (!fp && type && *type && *type != ':' && !isIDFIRST(*type)) + goto unknown_open_mode; + } /* IoTYPE_WRONLY */ + else if (*type == IoTYPE_RDONLY) { + do { + type++; + } while (isSPACE(*type)); + mode[0] = 'r'; if (in_raw) - mode[1] = 'b'; + mode[1] = 'b'; else if (in_crlf) - mode[1] = 't'; - if (*type == '&') { - goto duplicity; - } - if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { - type++; - fp = PerlIO_stdin(); - IoTYPE(io) = IoTYPE_STD; - if (num_svs > 1) { - /* diag_listed_as: More than one argument to '%s' open */ - Perl_croak(aTHX_ "More than one argument to '<%c' open",IoTYPE_STD); - } - } - else { - if (num_svs) { + mode[1] = 't'; + if (*type == '&') { + goto duplicity; + } + if (*type == IoTYPE_STD && (!type[1] || isSPACE(type[1]) || type[1] == ':')) { + type++; + fp = PerlIO_stdin(); + IoTYPE(io) = IoTYPE_STD; + if (num_svs > 1) { + /* diag_listed_as: More than one argument to '%s' open */ + Perl_croak(aTHX_ "More than one argument to '<%c' open",IoTYPE_STD); + } + } + else { + if (num_svs) { fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } else { SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); - type = NULL; + type = NULL; fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv); - } - } - if (!fp && type && *type && *type != ':' && !isIDFIRST(*type)) - goto unknown_open_mode; - } /* IoTYPE_RDONLY */ - else if ((num_svs && /* '-|...' or '...|' */ - type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) || - (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) { - if (num_svs) { - type += 2; /* skip over '-|' */ - } - else { - *--tend = '\0'; - while (tend > type && isSPACE(tend[-1])) - *--tend = '\0'; - for (; isSPACE(*type); type++) - ; - name = type; - len = tend-type; - } - if (*name == '\0') { - /* command is missing 19990114 */ - if (ckWARN(WARN_PIPE)) - Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); - errno = EPIPE; + } + } + if (!fp && type && *type && *type != ':' && !isIDFIRST(*type)) + goto unknown_open_mode; + } /* IoTYPE_RDONLY */ + else if ((num_svs && /* '-|...' or '...|' */ + type[0] == IoTYPE_STD && type[1] == IoTYPE_PIPE) || + (!num_svs && tend > type+1 && tend[-1] == IoTYPE_PIPE)) { + if (num_svs) { + type += 2; /* skip over '-|' */ + } + else { + *--tend = '\0'; + while (tend > type && isSPACE(tend[-1])) + *--tend = '\0'; + for (; isSPACE(*type); type++) + ; + name = type; + len = tend-type; + } + if (*name == '\0') { + /* command is missing 19990114 */ + if (ckWARN(WARN_PIPE)) + Perl_warner(aTHX_ packWARN(WARN_PIPE), "Missing command in piped open"); + errno = EPIPE; fp = NULL; - goto say_false; - } - if (!(*name == '-' && name[1] == '\0') || num_svs) - TAINT_ENV(); - TAINT_PROPER("piped open"); - mode[0] = 'r'; + goto say_false; + } + if (!(*name == '-' && name[1] == '\0') || num_svs) + TAINT_ENV(); + TAINT_PROPER("piped open"); + mode[0] = 'r'; if (in_raw) - mode[1] = 'b'; + mode[1] = 'b'; else if (in_crlf) - mode[1] = 't'; - - if (num_svs > 1) { - fp = PerlProc_popen_list(mode,num_svs,svp); - } - else { - fp = PerlProc_popen(name,mode); - } - IoTYPE(io) = IoTYPE_PIPE; - if (num_svs) { - while (isSPACE(*type)) - type++; - if (*type) { - if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { + mode[1] = 't'; + + if (num_svs > 1) { + fp = PerlProc_popen_list(mode,num_svs,svp); + } + else { + fp = PerlProc_popen(name,mode); + } + IoTYPE(io) = IoTYPE_PIPE; + if (num_svs) { + while (isSPACE(*type)) + type++; + if (*type) { + if (PerlIO_apply_layers(aTHX_ fp, mode, type) != 0) { fp = NULL; - goto say_false; - } - } - } - } - else { /* layer(Args) */ - if (num_svs) - goto unknown_open_mode; - name = type; - IoTYPE(io) = IoTYPE_RDONLY; - for (; isSPACE(*name); name++) - ; - mode[0] = 'r'; + goto say_false; + } + } + } + } + else { /* layer(Args) */ + if (num_svs) + goto unknown_open_mode; + name = type; + IoTYPE(io) = IoTYPE_RDONLY; + for (; isSPACE(*name); name++) + ; + mode[0] = 'r'; if (in_raw) - mode[1] = 'b'; + mode[1] = 'b'; else if (in_crlf) - mode[1] = 't'; - - if (*name == '-' && name[1] == '\0') { - fp = PerlIO_stdin(); - IoTYPE(io) = IoTYPE_STD; - } - else { - if (num_svs) { + mode[1] = 't'; + + if (*name == '-' && name[1] == '\0') { + fp = PerlIO_stdin(); + IoTYPE(io) = IoTYPE_STD; + } + else { + if (num_svs) { fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,num_svs,svp); } else { - SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); - type = NULL; + SV *namesv = newSVpvn_flags(type, tend - type, SVs_TEMP); + type = NULL; fp = PerlIO_openn(aTHX_ type,mode,-1,0,0,NULL,1,&namesv); - } - } - } + } + } + } } say_false: @@ -914,33 +914,33 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, Zero(&statbuf, 1, Stat_t); if (!fp) { - if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) - && should_warn_nl(oname) - - ) + if (IoTYPE(io) == IoTYPE_RDONLY && ckWARN(WARN_NEWLINE) + && should_warn_nl(oname) + + ) { GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */ - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); GCC_DIAG_RESTORE_STMT; } - goto say_false; + goto say_false; } if (ckWARN(WARN_IO)) { - if ((IoTYPE(io) == IoTYPE_RDONLY) && - (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STD%s reopened as %" HEKf - " only for input", - ((fp == PerlIO_stdout()) ? "OUT" : "ERR"), - HEKfARG(GvENAME_HEK(gv))); - } - else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle STDIN reopened as %" HEKf " only for output", - HEKfARG(GvENAME_HEK(gv)) - ); - } + if ((IoTYPE(io) == IoTYPE_RDONLY) && + (fp == PerlIO_stdout() || fp == PerlIO_stderr())) { + Perl_warner(aTHX_ packWARN(WARN_IO), + "Filehandle STD%s reopened as %" HEKf + " only for input", + ((fp == PerlIO_stdout()) ? "OUT" : "ERR"), + HEKfARG(GvENAME_HEK(gv))); + } + else if ((IoTYPE(io) == IoTYPE_WRONLY) && fp == PerlIO_stdin()) { + Perl_warner(aTHX_ packWARN(WARN_IO), + "Filehandle STDIN reopened as %" HEKf " only for output", + HEKfARG(GvENAME_HEK(gv)) + ); + } } fd = PerlIO_fileno(fp); @@ -949,27 +949,27 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, * otherwise unless we "know" the type probe for socket-ness. */ if (IoTYPE(io) && IoTYPE(io) != IoTYPE_PIPE && IoTYPE(io) != IoTYPE_STD && fd >= 0) { - if (PerlLIO_fstat(fd,&statbuf) < 0) { - /* If PerlIO claims to have fd we had better be able to fstat() it. */ - (void) PerlIO_close(fp); - goto say_false; - } + if (PerlLIO_fstat(fd,&statbuf) < 0) { + /* If PerlIO claims to have fd we had better be able to fstat() it. */ + (void) PerlIO_close(fp); + goto say_false; + } #ifndef PERL_MICRO - if (S_ISSOCK(statbuf.st_mode)) - IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */ + if (S_ISSOCK(statbuf.st_mode)) + IoTYPE(io) = IoTYPE_SOCKET; /* in case a socket was passed in to us */ #ifdef HAS_SOCKET - else if ( - !(statbuf.st_mode & S_IFMT) - && IoTYPE(io) != IoTYPE_WRONLY /* Dups of STD* filehandles already have */ - && IoTYPE(io) != IoTYPE_RDONLY /* type so they aren't marked as sockets */ - ) { /* on OS's that return 0 on fstat()ed pipe */ - char tmpbuf[256]; - Sock_size_t buflen = sizeof tmpbuf; - if (PerlSock_getsockname(fd, (struct sockaddr *)tmpbuf, &buflen) >= 0 - || errno != ENOTSOCK) - IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */ - /* but some return 0 for streams too, sigh */ - } + else if ( + !(statbuf.st_mode & S_IFMT) + && IoTYPE(io) != IoTYPE_WRONLY /* Dups of STD* filehandles already have */ + && IoTYPE(io) != IoTYPE_RDONLY /* type so they aren't marked as sockets */ + ) { /* on OS's that return 0 on fstat()ed pipe */ + char tmpbuf[256]; + Sock_size_t buflen = sizeof tmpbuf; + if (PerlSock_getsockname(fd, (struct sockaddr *)tmpbuf, &buflen) >= 0 + || errno != ENOTSOCK) + IoTYPE(io) = IoTYPE_SOCKET; /* some OS's return 0 on fstat()ed socket */ + /* but some return 0 for streams too, sigh */ + } #endif /* HAS_SOCKET */ #endif /* !PERL_MICRO */ } @@ -983,26 +983,26 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, /* If fd is less that PL_maxsysfd i.e. STDIN..STDERR then dup the new fileno down */ - if (saveofp) { - PerlIO_flush(saveofp); /* emulate PerlIO_close() */ - if (saveofp != saveifp) { /* was a socket? */ - PerlIO_close(saveofp); - } - } - if (savefd != fd) { - /* Still a small can-of-worms here if (say) PerlIO::scalar - is assigned to (say) STDOUT - for now let dup2() fail - and provide the error - */ - if (fd < 0) { + if (saveofp) { + PerlIO_flush(saveofp); /* emulate PerlIO_close() */ + if (saveofp != saveifp) { /* was a socket? */ + PerlIO_close(saveofp); + } + } + if (savefd != fd) { + /* Still a small can-of-worms here if (say) PerlIO::scalar + is assigned to (say) STDOUT - for now let dup2() fail + and provide the error + */ + if (fd < 0) { SETERRNO(EBADF,RMS_IFI); - goto say_false; + goto say_false; } else if (PerlLIO_dup2(fd, savefd) < 0) { - (void)PerlIO_close(fp); - goto say_false; - } + (void)PerlIO_close(fp); + goto say_false; + } #ifdef VMS - if (savefd != PerlIO_fileno(PerlIO_stdin())) { + if (savefd != PerlIO_fileno(PerlIO_stdin())) { char newname[FILENAME_MAX+1]; if (PerlIO_getname(fp, newname)) { if (fd == PerlIO_fileno(PerlIO_stdout())) @@ -1010,7 +1010,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, if (fd == PerlIO_fileno(PerlIO_stderr())) vmssetuserlnm("SYS$ERROR", newname); } - } + } #endif #if !defined(WIN32) @@ -1030,7 +1030,7 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, } #endif - if (was_fdopen) { + if (was_fdopen) { /* need to close fp without closing underlying fd */ int ofd = PerlIO_fileno(fp); int dupfd = ofd >= 0 ? PerlLIO_dup_cloexec(ofd) : -1; @@ -1043,31 +1043,31 @@ S_openn_cleanup(pTHX_ GV *gv, IO *io, PerlIO *fp, char *mode, const char *oname, PerlLIO_dup2_cloexec(dupfd, ofd); setfd_inhexec_for_sysfd(ofd); PerlLIO_close(dupfd); - } + } else - PerlIO_close(fp); - } - fp = saveifp; - PerlIO_clearerr(fp); - fd = PerlIO_fileno(fp); + PerlIO_close(fp); + } + fp = saveifp; + PerlIO_clearerr(fp); + fd = PerlIO_fileno(fp); } IoIFP(io) = fp; IoFLAGS(io) &= ~IOf_NOLINE; if (writing) { - if (IoTYPE(io) == IoTYPE_SOCKET - || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(statbuf.st_mode)) ) { - char *s = mode; - if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC) - s++; - *s = 'w'; - if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,NULL))) { - PerlIO_close(fp); - goto say_false; - } - } - else - IoOFP(io) = fp; + if (IoTYPE(io) == IoTYPE_SOCKET + || (IoTYPE(io) == IoTYPE_WRONLY && fd >= 0 && S_ISCHR(statbuf.st_mode)) ) { + char *s = mode; + if (*s == IoTYPE_IMPLICIT || *s == IoTYPE_NUMERIC) + s++; + *s = 'w'; + if (!(IoOFP(io) = PerlIO_openn(aTHX_ type,s,fd,0,0,NULL,0,NULL))) { + PerlIO_close(fp); + goto say_false; + } + } + else + IoOFP(io) = fp; } if (statbufp) *statbufp = statbuf; @@ -1291,14 +1291,14 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) SAVEFREESV(old_out_name); if (!PL_argvoutgv) - PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); + PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) { - IoFLAGS(io) &= ~IOf_START; - if (PL_inplace) { - assert(PL_defoutgv); - Perl_av_create_and_push(aTHX_ &PL_argvout_stack, - SvREFCNT_inc_simple_NN(PL_defoutgv)); - } + IoFLAGS(io) &= ~IOf_START; + if (PL_inplace) { + assert(PL_defoutgv); + Perl_av_create_and_push(aTHX_ &PL_argvout_stack, + SvREFCNT_inc_simple_NN(PL_defoutgv)); + } } { @@ -1311,15 +1311,15 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) PL_lastfd = -1; PL_filemode = 0; if (!GvAV(gv)) - return NULL; + return NULL; while (av_count(GvAV(gv)) > 0) { - STRLEN oldlen; + STRLEN oldlen; SV *const sv = av_shift(GvAV(gv)); - SAVEFREESV(sv); - SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */ - sv_setsv(GvSVn(gv),sv); - SvSETMAGIC(GvSV(gv)); - PL_oldname = SvPVx(GvSV(gv), oldlen); + SAVEFREESV(sv); + SvTAINTED_off(GvSVn(gv)); /* previous tainting irrelevant */ + sv_setsv(GvSVn(gv),sv); + SvSETMAGIC(GvSV(gv)); + PL_oldname = SvPVx(GvSV(gv), oldlen); if (LIKELY(!PL_inplace)) { if (nomagicopen ? do_open6(gv, "<", 1, NULL, &GvSV(gv), 1) @@ -1348,77 +1348,77 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) SV *temp_name_sv = NULL; MAGIC *mg; - TAINT_PROPER("inplace open"); - if (oldlen == 1 && *PL_oldname == '-') { - setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, - SVt_PVIO)); - return IoIFP(GvIOp(gv)); - } + TAINT_PROPER("inplace open"); + if (oldlen == 1 && *PL_oldname == '-') { + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, + SVt_PVIO)); + return IoIFP(GvIOp(gv)); + } #ifndef FLEXFILENAMES - filedev = statbuf.st_dev; - fileino = statbuf.st_ino; -#endif - PL_filemode = statbuf.st_mode; - fileuid = statbuf.st_uid; - filegid = statbuf.st_gid; - if (!S_ISREG(PL_filemode)) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %s is not a regular file", - PL_oldname ); - do_close(gv,FALSE); - continue; - } + filedev = statbuf.st_dev; + fileino = statbuf.st_ino; +#endif + PL_filemode = statbuf.st_mode; + fileuid = statbuf.st_uid; + filegid = statbuf.st_gid; + if (!S_ISREG(PL_filemode)) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't do inplace edit: %s is not a regular file", + PL_oldname ); + do_close(gv,FALSE); + continue; + } magic_av = newAV(); - if (*PL_inplace && strNE(PL_inplace, "*")) { - const char *star = strchr(PL_inplace, '*'); - if (star) { - const char *begin = PL_inplace; + if (*PL_inplace && strNE(PL_inplace, "*")) { + const char *star = strchr(PL_inplace, '*'); + if (star) { + const char *begin = PL_inplace; SvPVCLEAR(sv); - do { - sv_catpvn(sv, begin, star - begin); - sv_catpvn(sv, PL_oldname, oldlen); - begin = ++star; - } while ((star = strchr(begin, '*'))); - if (*begin) - sv_catpv(sv,begin); - } - else { - sv_catpv(sv,PL_inplace); - } + do { + sv_catpvn(sv, begin, star - begin); + sv_catpvn(sv, PL_oldname, oldlen); + begin = ++star; + } while ((star = strchr(begin, '*'))); + if (*begin) + sv_catpv(sv,begin); + } + else { + sv_catpv(sv,PL_inplace); + } #ifndef FLEXFILENAMES - if ((PerlLIO_stat(SvPVX_const(sv),&statbuf) >= 0 - && statbuf.st_dev == filedev - && statbuf.st_ino == fileino) + if ((PerlLIO_stat(SvPVX_const(sv),&statbuf) >= 0 + && statbuf.st_dev == filedev + && statbuf.st_ino == fileino) #ifdef DJGPP - || ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0) + || ((_djstat_fail_bits & _STFAIL_TRUENAME)!=0) #endif ) - { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), - "Can't do inplace edit: %" + { + Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), + "Can't do inplace edit: %" SVf " would not be unique", - SVfARG(sv)); + SVfARG(sv)); goto cleanup_argv; - } + } #endif av_store(magic_av, ARGVMG_BACKUP_NAME, newSVsv(sv)); - } + } - sv_setpvn(sv,PL_oldname,oldlen); - SETERRNO(0,0); /* in case sprintf set errno */ + sv_setpvn(sv,PL_oldname,oldlen); + SETERRNO(0,0); /* in case sprintf set errno */ temp_name_sv = newSV(0); if (!S_openindirtemp(aTHX_ PL_argvoutgv, GvSV(gv), temp_name_sv)) { SvREFCNT_dec(temp_name_sv); /* diag_listed_as: Can't do inplace edit on %s: %s */ Perl_ck_warner_d(aTHX_ packWARN(WARN_INPLACE), "Can't do inplace edit on %s: Cannot make temp name: %s", - PL_oldname, Strerror(errno) ); + PL_oldname, Strerror(errno) ); #ifndef FLEXFILENAMES cleanup_argv: #endif do_close(gv,FALSE); SvREFCNT_dec(magic_av); continue; - } + } av_store(magic_av, ARGVMG_TEMP_NAME, temp_name_sv); av_store(magic_av, ARGVMG_ORIG_NAME, newSVsv(sv)); av_store(magic_av, ARGVMG_ORIG_MODE, newSVuv(PL_filemode)); @@ -1432,12 +1432,12 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) newSVpvn((char *)&statbuf, sizeof(statbuf))); } #endif - setdefout(PL_argvoutgv); + setdefout(PL_argvoutgv); sv_setsv(GvSVn(PL_argvoutgv), temp_name_sv); mg = sv_magicext((SV*)GvIOp(PL_argvoutgv), (SV*)magic_av, PERL_MAGIC_uvar, &argvout_vtbl, NULL, 0); mg->mg_flags |= MGf_DUP; SvREFCNT_dec(magic_av); - PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); + PL_lastfd = PerlIO_fileno(IoIFP(GvIOp(PL_argvoutgv))); if (PL_lastfd >= 0) { (void)PerlLIO_fstat(PL_lastfd,&statbuf); #ifdef HAS_FCHMOD @@ -1453,10 +1453,10 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) PERL_UNUSED_RESULT(PerlLIO_chown(PL_oldname,fileuid,filegid)); #endif } - } + } return IoIFP(GvIOp(gv)); - } - } /* successful do_open_raw(), PL_inplace non-NULL */ + } + } /* successful do_open_raw(), PL_inplace non-NULL */ if (ckWARN_d(WARN_INPLACE)) { const int eno = errno; @@ -1471,20 +1471,20 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) Perl_warner(aTHX_ packWARN(WARN_INPLACE), "Can't open %s: %s", PL_oldname, Strerror(eno)); } - } + } } if (io && (IoFLAGS(io) & IOf_ARGV)) - IoFLAGS(io) |= IOf_START; + IoFLAGS(io) |= IOf_START; if (PL_inplace) { - if (io && (IoFLAGS(io) & IOf_ARGV) - && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0) - { - GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack)); - setdefout(oldout); - SvREFCNT_dec_NN(oldout); - return NULL; - } - setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO)); + if (io && (IoFLAGS(io) & IOf_ARGV) + && PL_argvout_stack && AvFILLp(PL_argvout_stack) >= 0) + { + GV * const oldout = MUTABLE_GV(av_pop(PL_argvout_stack)); + setdefout(oldout); + SvREFCNT_dec_NN(oldout); + return NULL; + } + setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO)); } return NULL; } @@ -1687,7 +1687,7 @@ S_argvout_final(pTHX_ MAGIC *mg, IO *io, bool not_implicit) { #if !defined(HAS_RENAME) link(SvPVX(*temp_psv), orig_pv) < 0 #elif defined(ARGV_USE_ATFUNCTIONS) - S_my_renameat(dfd, SvPVX(*temp_psv), dfd, orig_pv) < 0 && + S_my_renameat(dfd, SvPVX(*temp_psv), dfd, orig_pv) < 0 && !(UNLIKELY(NotSupported(errno)) && dir_unchanged(orig_pv, mg) && PerlLIO_rename(SvPVX(*temp_psv), orig_pv) == 0) @@ -1744,19 +1744,19 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) MAGIC *mg; if (!gv) - gv = PL_argvgv; + gv = PL_argvgv; if (!gv || !isGV_with_GP(gv)) { - if (not_implicit) - SETERRNO(EBADF,SS_IVCHAN); - return FALSE; + if (not_implicit) + SETERRNO(EBADF,SS_IVCHAN); + return FALSE; } io = GvIO(gv); if (!io) { /* never opened */ - if (not_implicit) { - report_evil_fh(gv); - SETERRNO(EBADF,SS_IVCHAN); - } - return FALSE; + if (not_implicit) { + report_evil_fh(gv); + SETERRNO(EBADF,SS_IVCHAN); + } + return FALSE; } if ((mg = mg_findext((SV*)io, PERL_MAGIC_uvar, &argvout_vtbl)) && mg->mg_obj) { @@ -1767,9 +1767,9 @@ Perl_do_close(pTHX_ GV *gv, bool not_implicit) retval = io_close(io, NULL, not_implicit, FALSE); } if (not_implicit) { - IoLINES(io) = 0; - IoPAGE(io) = 0; - IoLINES_LEFT(io) = IoPAGE_LEN(io); + IoLINES(io) = 0; + IoPAGE(io) = 0; + IoLINES_LEFT(io) = IoPAGE_LEN(io); } IoTYPE(io) = IoTYPE_CLOSED; return retval; @@ -1783,7 +1783,7 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail) PERL_ARGS_ASSERT_IO_CLOSE; if (IoIFP(io)) { - if (IoTYPE(io) == IoTYPE_PIPE) { + if (IoTYPE(io) == IoTYPE_PIPE) { PerlIO *fh = IoIFP(io); int status; @@ -1794,54 +1794,54 @@ Perl_io_close(pTHX_ IO *io, GV *gv, bool not_implicit, bool warn_on_fail) So NULL it early. */ IoOFP(io) = IoIFP(io) = NULL; - status = PerlProc_pclose(fh); - if (not_implicit) { - STATUS_NATIVE_CHILD_SET(status); - retval = (STATUS_UNIX == 0); - } - else { - retval = (status != -1); - } - } - else if (IoTYPE(io) == IoTYPE_STD) - retval = TRUE; - else { - if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ - const bool prev_err = PerlIO_error(IoOFP(io)); + status = PerlProc_pclose(fh); + if (not_implicit) { + STATUS_NATIVE_CHILD_SET(status); + retval = (STATUS_UNIX == 0); + } + else { + retval = (status != -1); + } + } + else if (IoTYPE(io) == IoTYPE_STD) + retval = TRUE; + else { + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { /* a socket */ + const bool prev_err = PerlIO_error(IoOFP(io)); #ifdef USE_PERLIO - if (prev_err) - PerlIO_restore_errno(IoOFP(io)); -#endif - retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err); - PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ - } - else { - const bool prev_err = PerlIO_error(IoIFP(io)); + if (prev_err) + PerlIO_restore_errno(IoOFP(io)); +#endif + retval = (PerlIO_close(IoOFP(io)) != EOF && !prev_err); + PerlIO_close(IoIFP(io)); /* clear stdio, fd already closed */ + } + else { + const bool prev_err = PerlIO_error(IoIFP(io)); #ifdef USE_PERLIO - if (prev_err) - PerlIO_restore_errno(IoIFP(io)); -#endif - retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err); - } - } - IoOFP(io) = IoIFP(io) = NULL; - - if (warn_on_fail && !retval) { - if (gv) - Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), - "Warning: unable to close filehandle %" - HEKf " properly: %" SVf, - HEKfARG(GvNAME_HEK(gv)), + if (prev_err) + PerlIO_restore_errno(IoIFP(io)); +#endif + retval = (PerlIO_close(IoIFP(io)) != EOF && !prev_err); + } + } + IoOFP(io) = IoIFP(io) = NULL; + + if (warn_on_fail && !retval) { + if (gv) + Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), + "Warning: unable to close filehandle %" + HEKf " properly: %" SVf, + HEKfARG(GvNAME_HEK(gv)), SVfARG(get_sv("!",GV_ADD))); - else - Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), - "Warning: unable to close filehandle " - "properly: %" SVf, - SVfARG(get_sv("!",GV_ADD))); - } + else + Perl_ck_warner_d(aTHX_ packWARN(WARN_IO), + "Warning: unable to close filehandle " + "properly: %" SVf, + SVfARG(get_sv("!",GV_ADD))); + } } else if (not_implicit) { - SETERRNO(EBADF,SS_IVCHAN); + SETERRNO(EBADF,SS_IVCHAN); } return retval; @@ -1855,38 +1855,38 @@ Perl_do_eof(pTHX_ GV *gv) PERL_ARGS_ASSERT_DO_EOF; if (!io) - return TRUE; + return TRUE; else if (IoTYPE(io) == IoTYPE_WRONLY) - report_wrongway_fh(gv, '>'); + report_wrongway_fh(gv, '>'); while (IoIFP(io)) { if (PerlIO_has_cntptr(IoIFP(io))) { /* (the code works without this) */ - if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */ - return FALSE; /* this is the most usual case */ - } - - { - /* getc and ungetc can stomp on errno */ - dSAVE_ERRNO; - const int ch = PerlIO_getc(IoIFP(io)); - if (ch != EOF) { - (void)PerlIO_ungetc(IoIFP(io),ch); - RESTORE_ERRNO; - return FALSE; - } - RESTORE_ERRNO; - } + if (PerlIO_get_cnt(IoIFP(io)) > 0) /* cheat a little, since */ + return FALSE; /* this is the most usual case */ + } + + { + /* getc and ungetc can stomp on errno */ + dSAVE_ERRNO; + const int ch = PerlIO_getc(IoIFP(io)); + if (ch != EOF) { + (void)PerlIO_ungetc(IoIFP(io),ch); + RESTORE_ERRNO; + return FALSE; + } + RESTORE_ERRNO; + } if (PerlIO_has_cntptr(IoIFP(io)) && PerlIO_canset_cnt(IoIFP(io))) { - if (PerlIO_get_cnt(IoIFP(io)) < -1) - PerlIO_set_cnt(IoIFP(io),-1); - } - if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */ - if (gv != PL_argvgv || !nextargv(gv, FALSE)) /* get another fp handy */ - return TRUE; - } - else - return TRUE; /* normal fp, definitely end of file */ + if (PerlIO_get_cnt(IoIFP(io)) < -1) + PerlIO_set_cnt(IoIFP(io),-1); + } + if (PL_op->op_flags & OPf_SPECIAL) { /* not necessarily a real EOF yet? */ + if (gv != PL_argvgv || !nextargv(gv, FALSE)) /* get another fp handy */ + return TRUE; + } + else + return TRUE; /* normal fp, definitely end of file */ } return TRUE; } @@ -1900,7 +1900,7 @@ Perl_do_tell(pTHX_ GV *gv) PERL_ARGS_ASSERT_DO_TELL; if (io && (fp = IoIFP(io))) { - return PerlIO_tell(fp); + return PerlIO_tell(fp); } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); @@ -1914,7 +1914,7 @@ Perl_do_seek(pTHX_ GV *gv, Off_t pos, int whence) PerlIO *fp; if (io && (fp = IoIFP(io))) { - return PerlIO_seek(fp, pos, whence) >= 0; + return PerlIO_seek(fp, pos, whence) >= 0; } report_evil_fh(gv); SETERRNO(EBADF,RMS_IFI); @@ -1949,51 +1949,51 @@ Perl_mode_from_discipline(pTHX_ const char *s, STRLEN len) int mode = O_BINARY; PERL_UNUSED_CONTEXT; if (s) { - while (*s) { - if (*s == ':') { - switch (s[1]) { - case 'r': - if (s[2] == 'a' && s[3] == 'w' - && (!s[4] || s[4] == ':' || isSPACE(s[4]))) - { - mode = O_BINARY; - s += 4; - len -= 4; - break; - } - /* FALLTHROUGH */ - case 'c': - if (s[2] == 'r' && s[3] == 'l' && s[4] == 'f' - && (!s[5] || s[5] == ':' || isSPACE(s[5]))) - { - mode = O_TEXT; - s += 5; - len -= 5; - break; - } - /* FALLTHROUGH */ - default: - goto fail_discipline; - } - } - else if (isSPACE(*s)) { - ++s; - --len; - } - else { - const char *end; + while (*s) { + if (*s == ':') { + switch (s[1]) { + case 'r': + if (s[2] == 'a' && s[3] == 'w' + && (!s[4] || s[4] == ':' || isSPACE(s[4]))) + { + mode = O_BINARY; + s += 4; + len -= 4; + break; + } + /* FALLTHROUGH */ + case 'c': + if (s[2] == 'r' && s[3] == 'l' && s[4] == 'f' + && (!s[5] || s[5] == ':' || isSPACE(s[5]))) + { + mode = O_TEXT; + s += 5; + len -= 5; + break; + } + /* FALLTHROUGH */ + default: + goto fail_discipline; + } + } + else if (isSPACE(*s)) { + ++s; + --len; + } + else { + const char *end; fail_discipline: - end = (char *) memchr(s+1, ':', len); - if (!end) - end = s+len; + end = (char *) memchr(s+1, ':', len); + if (!end) + end = s+len; #ifndef PERLIO_LAYERS - Perl_croak(aTHX_ "IO layers (like '%.*s') unavailable", end-s, s); + Perl_croak(aTHX_ "IO layers (like '%.*s') unavailable", end-s, s); #else - len -= end-s; - s = end; + len -= end-s; + s = end; #endif - } - } + } + } } return mode; } @@ -2003,44 +2003,44 @@ I32 my_chsize(int fd, Off_t length) { #ifdef F_FREESP - /* code courtesy of William Kucharski */ + /* code courtesy of William Kucharski */ #define HAS_CHSIZE Stat_t filebuf; if (PerlLIO_fstat(fd, &filebuf) < 0) - return -1; + return -1; if (filebuf.st_size < length) { - /* extend file length */ + /* extend file length */ - if ((PerlLIO_lseek(fd, (length - 1), 0)) < 0) - return -1; + if ((PerlLIO_lseek(fd, (length - 1), 0)) < 0) + return -1; - /* write a "0" byte */ + /* write a "0" byte */ - if ((PerlLIO_write(fd, "", 1)) != 1) - return -1; + if ((PerlLIO_write(fd, "", 1)) != 1) + return -1; } else { - /* truncate length */ - struct flock fl; - fl.l_whence = 0; - fl.l_len = 0; - fl.l_start = length; - fl.l_type = F_WRLCK; /* write lock on file space */ - - /* - * This relies on the UNDOCUMENTED F_FREESP argument to - * fcntl(2), which truncates the file so that it ends at the - * position indicated by fl.l_start. - * - * Will minor miracles never cease? - */ + /* truncate length */ + struct flock fl; + fl.l_whence = 0; + fl.l_len = 0; + fl.l_start = length; + fl.l_type = F_WRLCK; /* write lock on file space */ + + /* + * This relies on the UNDOCUMENTED F_FREESP argument to + * fcntl(2), which truncates the file so that it ends at the + * position indicated by fl.l_start. + * + * Will minor miracles never cease? + */ - if (fcntl(fd, F_FREESP, &fl) < 0) - return -1; + if (fcntl(fd, F_FREESP, &fl) < 0) + return -1; } return 0; @@ -2058,67 +2058,67 @@ Perl_do_print(pTHX_ SV *sv, PerlIO *fp) /* assuming fp is checked earlier */ if (!sv) - return TRUE; + return TRUE; if (SvTYPE(sv) == SVt_IV && SvIOK(sv)) { - assert(!SvGMAGICAL(sv)); - if (SvIsUV(sv)) - PerlIO_printf(fp, "%" UVuf, (UV)SvUVX(sv)); - else - PerlIO_printf(fp, "%" IVdf, (IV)SvIVX(sv)); - return !PerlIO_error(fp); + assert(!SvGMAGICAL(sv)); + if (SvIsUV(sv)) + PerlIO_printf(fp, "%" UVuf, (UV)SvUVX(sv)); + else + PerlIO_printf(fp, "%" IVdf, (IV)SvIVX(sv)); + return !PerlIO_error(fp); } else { - STRLEN len; - /* Do this first to trigger any overloading. */ - const char *tmps = SvPV_const(sv, len); - U8 *tmpbuf = NULL; - bool happy = TRUE; - - if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */ - if (!SvUTF8(sv)) { /* Convert to utf8 if necessary */ - /* We don't modify the original scalar. */ - tmpbuf = bytes_to_utf8((const U8*) tmps, &len); - tmps = (char *) tmpbuf; - } - else if (ckWARN4_d(WARN_UTF8, WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR)) { - (void) check_utf8_print((const U8*) tmps, len); - } - } /* else stream isn't utf8 */ - else if (DO_UTF8(sv)) { /* But if is utf8 internally, attempt to - convert to bytes */ - STRLEN tmplen = len; - bool utf8 = TRUE; - U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8); - if (!utf8) { - - /* Here, succeeded in downgrading from utf8. Set up to below - * output the converted value */ - tmpbuf = result; - tmps = (char *) tmpbuf; - len = tmplen; - } - else { /* Non-utf8 output stream, but string only representable in - utf8 */ - assert((char *)result == tmps); - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "Wide character in %s", - PL_op ? OP_DESC(PL_op) : "print" - ); - /* Could also check that isn't one of the things to avoid - * in utf8 by using check_utf8_print(), but not doing so, - * since the stream isn't a UTF8 stream */ - } - } - /* To detect whether the process is about to overstep its - * filesize limit we would need getrlimit(). We could then - * also transparently raise the limit with setrlimit() -- - * but only until the system hard limit/the filesystem limit, - * at which we would get EPERM. Note that when using buffered - * io the write failure can be delayed until the flush/close. --jhi */ - if (len && (PerlIO_write(fp,tmps,len) == 0)) - happy = FALSE; - Safefree(tmpbuf); - return happy ? !PerlIO_error(fp) : FALSE; + STRLEN len; + /* Do this first to trigger any overloading. */ + const char *tmps = SvPV_const(sv, len); + U8 *tmpbuf = NULL; + bool happy = TRUE; + + if (PerlIO_isutf8(fp)) { /* If the stream is utf8 ... */ + if (!SvUTF8(sv)) { /* Convert to utf8 if necessary */ + /* We don't modify the original scalar. */ + tmpbuf = bytes_to_utf8((const U8*) tmps, &len); + tmps = (char *) tmpbuf; + } + else if (ckWARN4_d(WARN_UTF8, WARN_SURROGATE, WARN_NON_UNICODE, WARN_NONCHAR)) { + (void) check_utf8_print((const U8*) tmps, len); + } + } /* else stream isn't utf8 */ + else if (DO_UTF8(sv)) { /* But if is utf8 internally, attempt to + convert to bytes */ + STRLEN tmplen = len; + bool utf8 = TRUE; + U8 * const result = bytes_from_utf8((const U8*) tmps, &tmplen, &utf8); + if (!utf8) { + + /* Here, succeeded in downgrading from utf8. Set up to below + * output the converted value */ + tmpbuf = result; + tmps = (char *) tmpbuf; + len = tmplen; + } + else { /* Non-utf8 output stream, but string only representable in + utf8 */ + assert((char *)result == tmps); + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "Wide character in %s", + PL_op ? OP_DESC(PL_op) : "print" + ); + /* Could also check that isn't one of the things to avoid + * in utf8 by using check_utf8_print(), but not doing so, + * since the stream isn't a UTF8 stream */ + } + } + /* To detect whether the process is about to overstep its + * filesize limit we would need getrlimit(). We could then + * also transparently raise the limit with setrlimit() -- + * but only until the system hard limit/the filesystem limit, + * at which we would get EPERM. Note that when using buffered + * io the write failure can be delayed until the flush/close. --jhi */ + if (len && (PerlIO_write(fp,tmps,len) == 0)) + happy = FALSE; + Safefree(tmpbuf); + return happy ? !PerlIO_error(fp) : FALSE; } } @@ -2130,24 +2130,24 @@ Perl_my_stat_flags(pTHX_ const U32 flags) GV* gv; if (PL_op->op_flags & OPf_REF) { - gv = cGVOP_gv; + gv = cGVOP_gv; do_fstat: if (gv == PL_defgv) { - if (PL_laststatval < 0) - SETERRNO(EBADF,RMS_IFI); + if (PL_laststatval < 0) + SETERRNO(EBADF,RMS_IFI); return PL_laststatval; - } - io = GvIO(gv); + } + io = GvIO(gv); do_fstat_have_io: PL_laststype = OP_STAT; PL_statgv = gv ? gv : (GV *)io; SvPVCLEAR(PL_statname); if (io) { - if (IoIFP(io)) { + if (IoIFP(io)) { int fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) { /* E.g. PerlIO::scalar has no real fd. */ - SETERRNO(EBADF,RMS_IFI); + SETERRNO(EBADF,RMS_IFI); return (PL_laststatval = -1); } else { return (PL_laststatval = PerlLIO_fstat(fd, &PL_statcache)); @@ -2156,44 +2156,44 @@ Perl_my_stat_flags(pTHX_ const U32 flags) return (PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache)); } } - PL_laststatval = -1; - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - return -1; + PL_laststatval = -1; + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + return -1; } else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t)) - == OPpFT_STACKED) - return PL_laststatval; + == OPpFT_STACKED) + return PL_laststatval; else { - SV* const sv = TOPs; - const char *s, *d; - STRLEN len; - if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) { - goto do_fstat; - } + SV* const sv = TOPs; + const char *s, *d; + STRLEN len; + if ((gv = MAYBE_DEREF_GV_flags(sv,flags))) { + goto do_fstat; + } else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { io = MUTABLE_IO(SvRV(sv)); - gv = NULL; + gv = NULL; goto do_fstat_have_io; } - s = SvPV_flags_const(sv, len, flags); - PL_statgv = NULL; - sv_setpvn(PL_statname, s, len); - d = SvPVX_const(PL_statname); /* s now NUL-terminated */ - PL_laststype = OP_STAT; + s = SvPV_flags_const(sv, len, flags); + PL_statgv = NULL; + sv_setpvn(PL_statname, s, len); + d = SvPVX_const(PL_statname); /* s now NUL-terminated */ + PL_laststype = OP_STAT; if (!IS_SAFE_PATHNAME(s, len, OP_NAME(PL_op))) { PL_laststatval = -1; } else { PL_laststatval = PerlLIO_stat(d, &PL_statcache); } - if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) { + if (PL_laststatval < 0 && ckWARN(WARN_NEWLINE) && should_warn_nl(s)) { GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); /* PL_warn_nl is constant */ - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); GCC_DIAG_RESTORE_STMT; } - return PL_laststatval; + return PL_laststatval; } } @@ -2208,27 +2208,27 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) SV* const sv = TOPs; bool isio = FALSE; if (PL_op->op_flags & OPf_REF) { - if (cGVOP_gv == PL_defgv) { - if (PL_laststype != OP_LSTAT) - Perl_croak(aTHX_ "%s", no_prev_lstat); - if (PL_laststatval < 0) - SETERRNO(EBADF,RMS_IFI); - return PL_laststatval; - } - PL_laststatval = -1; - if (ckWARN(WARN_IO)) { - /* diag_listed_as: Use of -l on filehandle%s */ - Perl_warner(aTHX_ packWARN(WARN_IO), - "Use of -l on filehandle %" HEKf, - HEKfARG(GvENAME_HEK(cGVOP_gv))); - } - SETERRNO(EBADF,RMS_IFI); - return -1; + if (cGVOP_gv == PL_defgv) { + if (PL_laststype != OP_LSTAT) + Perl_croak(aTHX_ "%s", no_prev_lstat); + if (PL_laststatval < 0) + SETERRNO(EBADF,RMS_IFI); + return PL_laststatval; + } + PL_laststatval = -1; + if (ckWARN(WARN_IO)) { + /* diag_listed_as: Use of -l on filehandle%s */ + Perl_warner(aTHX_ packWARN(WARN_IO), + "Use of -l on filehandle %" HEKf, + HEKfARG(GvENAME_HEK(cGVOP_gv))); + } + SETERRNO(EBADF,RMS_IFI); + return -1; } if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t)) - == OPpFT_STACKED) { + == OPpFT_STACKED) { if (PL_laststype != OP_LSTAT) - Perl_croak(aTHX_ "%s", no_prev_lstat); + Perl_croak(aTHX_ "%s", no_prev_lstat); return PL_laststatval; } @@ -2241,11 +2241,11 @@ Perl_my_lstat_flags(pTHX_ const U32 flags) ) && ckWARN(WARN_IO)) { if (isio) - /* diag_listed_as: Use of -l on filehandle%s */ + /* diag_listed_as: Use of -l on filehandle%s */ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle"); else - /* diag_listed_as: Use of -l on filehandle%s */ + /* diag_listed_as: Use of -l on filehandle%s */ Perl_warner(aTHX_ packWARN(WARN_IO), "Use of -l on filehandle %" HEKf, HEKfARG(GvENAME_HEK((const GV *) @@ -2279,13 +2279,13 @@ S_exec_failed(pTHX_ const char *cmd, int fd, int do_report) if (do_report) { /* XXX silently ignore failures */ PERL_UNUSED_RESULT(PerlLIO_write(fd, (void*)&e, sizeof(int))); - PerlLIO_close(fd); + PerlLIO_close(fd); } } bool Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp, - int fd, int do_report) + int fd, int do_report) { PERL_ARGS_ASSERT_DO_AEXEC5; #if defined(__LIBCATAMOUNT__) @@ -2294,37 +2294,37 @@ Perl_do_aexec5(pTHX_ SV *really, SV **mark, SV **sp, assert(sp >= mark); ENTER; { - const char **argv, **a; - const char *tmps = NULL; - Newx(argv, sp - mark + 1, const char*); - SAVEFREEPV(argv); - a = argv; - - while (++mark <= sp) { - if (*mark) { - char *arg = savepv(SvPV_nolen_const(*mark)); - SAVEFREEPV(arg); - *a++ = arg; - } else - *a++ = ""; - } - *a = NULL; - if (really) { - tmps = savepv(SvPV_nolen_const(really)); - SAVEFREEPV(tmps); - } + const char **argv, **a; + const char *tmps = NULL; + Newx(argv, sp - mark + 1, const char*); + SAVEFREEPV(argv); + a = argv; + + while (++mark <= sp) { + if (*mark) { + char *arg = savepv(SvPV_nolen_const(*mark)); + SAVEFREEPV(arg); + *a++ = arg; + } else + *a++ = ""; + } + *a = NULL; + if (really) { + tmps = savepv(SvPV_nolen_const(really)); + SAVEFREEPV(tmps); + } if ((!really && argv[0] && *argv[0] != '/') || - (really && *tmps != '/')) /* will execvp use PATH? */ - TAINT_ENV(); /* testing IFS here is overkill, probably */ - PERL_FPU_PRE_EXEC - if (really && *tmps) { + (really && *tmps != '/')) /* will execvp use PATH? */ + TAINT_ENV(); /* testing IFS here is overkill, probably */ + PERL_FPU_PRE_EXEC + if (really && *tmps) { PerlProc_execvp(tmps,EXEC_ARGV_CAST(argv)); } else if (argv[0]) { PerlProc_execvp(argv[0],EXEC_ARGV_CAST(argv)); } else { SETERRNO(ENOENT,RMS_FNF); } - PERL_FPU_POST_EXEC + PERL_FPU_POST_EXEC S_exec_failed(aTHX_ (really ? tmps : argv[0] ? argv[0] : ""), fd, do_report); } LEAVE; @@ -2353,86 +2353,86 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) memcpy(cmd, incmd, cmdlen); while (*cmd && isSPACE(*cmd)) - cmd++; + cmd++; /* save an extra exec if possible */ #ifdef CSH { char flags[PERL_FLAGS_MAX]; - if (strnEQ(cmd,PL_cshname,PL_cshlen) && - strBEGINs(cmd+PL_cshlen," -c")) { + if (strnEQ(cmd,PL_cshname,PL_cshlen) && + strBEGINs(cmd+PL_cshlen," -c")) { my_strlcpy(flags, "-c", PERL_FLAGS_MAX); - s = cmd+PL_cshlen+3; - if (*s == 'f') { - s++; + s = cmd+PL_cshlen+3; + if (*s == 'f') { + s++; my_strlcat(flags, "f", PERL_FLAGS_MAX - 2); - } - if (*s == ' ') - s++; - if (*s++ == '\'') { - char * const ncmd = s; - - while (*s) - s++; - if (s[-1] == '\n') - *--s = '\0'; - if (s[-1] == '\'') { - *--s = '\0'; - PERL_FPU_PRE_EXEC - PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); - PERL_FPU_POST_EXEC - *s = '\''; - S_exec_failed(aTHX_ PL_cshname, fd, do_report); - goto leave; - } - } - } + } + if (*s == ' ') + s++; + if (*s++ == '\'') { + char * const ncmd = s; + + while (*s) + s++; + if (s[-1] == '\n') + *--s = '\0'; + if (s[-1] == '\'') { + *--s = '\0'; + PERL_FPU_PRE_EXEC + PerlProc_execl(PL_cshname, "csh", flags, ncmd, (char*)NULL); + PERL_FPU_POST_EXEC + *s = '\''; + S_exec_failed(aTHX_ PL_cshname, fd, do_report); + goto leave; + } + } + } } #endif /* CSH */ /* see if there are shell metacharacters in it */ if (*cmd == '.' && isSPACE(cmd[1])) - goto doshell; + goto doshell; if (strBEGINs(cmd,"exec") && isSPACE(cmd[4])) - goto doshell; + goto doshell; s = cmd; while (isWORDCHAR(*s)) - s++; /* catch VAR=val gizmo */ + s++; /* catch VAR=val gizmo */ if (*s == '=') - goto doshell; + goto doshell; for (s = cmd; *s; s++) { - if (*s != ' ' && !isALPHA(*s) && - memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) { - if (*s == '\n' && !s[1]) { - *s = '\0'; - break; - } - /* handle the 2>&1 construct at the end */ - if (*s == '>' && s[1] == '&' && s[2] == '1' - && s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) - && (!s[3] || isSPACE(s[3]))) - { + if (*s != ' ' && !isALPHA(*s) && + memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) { + if (*s == '\n' && !s[1]) { + *s = '\0'; + break; + } + /* handle the 2>&1 construct at the end */ + if (*s == '>' && s[1] == '&' && s[2] == '1' + && s > cmd + 1 && s[-1] == '2' && isSPACE(s[-2]) + && (!s[3] || isSPACE(s[3]))) + { const char *t = s + 3; - while (*t && isSPACE(*t)) - ++t; - if (!*t && (PerlLIO_dup2(1,2) != -1)) { - s[-2] = '\0'; - break; - } - } - doshell: - PERL_FPU_PRE_EXEC + while (*t && isSPACE(*t)) + ++t; + if (!*t && (PerlLIO_dup2(1,2) != -1)) { + s[-2] = '\0'; + break; + } + } + doshell: + PERL_FPU_PRE_EXEC PerlProc_execl(PL_sh_path, "sh", "-c", cmd, (char *)NULL); - PERL_FPU_POST_EXEC - S_exec_failed(aTHX_ PL_sh_path, fd, do_report); - goto leave; - } + PERL_FPU_POST_EXEC + S_exec_failed(aTHX_ PL_sh_path, fd, do_report); + goto leave; + } } Newx(argv, (s - cmd) / 2 + 2, const char*); @@ -2441,23 +2441,23 @@ Perl_do_exec3(pTHX_ const char *incmd, int fd, int do_report) SAVEFREEPV(cmd); a = argv; for (s = cmd; *s;) { - while (isSPACE(*s)) - s++; - if (*s) - *(a++) = s; - while (*s && !isSPACE(*s)) - s++; - if (*s) - *s++ = '\0'; + while (isSPACE(*s)) + s++; + if (*s) + *(a++) = s; + while (*s && !isSPACE(*s)) + s++; + if (*s) + *s++ = '\0'; } *a = NULL; if (argv[0]) { - PERL_FPU_PRE_EXEC + PERL_FPU_PRE_EXEC PerlProc_execvp(argv[0],EXEC_ARGV_CAST(argv)); - PERL_FPU_POST_EXEC - if (errno == ENOEXEC) /* for system V NIH syndrome */ - goto doshell; - S_exec_failed(aTHX_ argv[0], fd, do_report); + PERL_FPU_POST_EXEC + if (errno == ENOEXEC) /* for system V NIH syndrome */ + goto doshell; + S_exec_failed(aTHX_ argv[0], fd, do_report); } leave: LEAVE; @@ -2486,109 +2486,109 @@ Perl_apply(pTHX_ I32 type, SV **mark, SV **sp) platforms where kill was not defined. */ #ifndef HAS_KILL if (type == OP_KILL) - Perl_die(aTHX_ PL_no_func, what); + Perl_die(aTHX_ PL_no_func, what); #endif #ifndef HAS_CHOWN if (type == OP_CHOWN) - Perl_die(aTHX_ PL_no_func, what); + Perl_die(aTHX_ PL_no_func, what); #endif #define APPLY_TAINT_PROPER() \ STMT_START { \ - if (TAINT_get) { TAINT_PROPER(what); } \ + if (TAINT_get) { TAINT_PROPER(what); } \ } STMT_END /* This is a first heuristic; it doesn't catch tainting magic. */ if (TAINTING_get) { - while (++mark <= sp) { - if (SvTAINTED(*mark)) { - TAINT; - break; - } - } - mark = oldmark; + while (++mark <= sp) { + if (SvTAINTED(*mark)) { + TAINT; + break; + } + } + mark = oldmark; } switch (type) { case OP_CHMOD: - APPLY_TAINT_PROPER(); - if (++mark <= sp) { - val = SvIV(*mark); - APPLY_TAINT_PROPER(); - tot = sp - mark; - while (++mark <= sp) { + APPLY_TAINT_PROPER(); + if (++mark <= sp) { + val = SvIV(*mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; + while (++mark <= sp) { GV* gv; if ((gv = MAYBE_DEREF_GV(*mark))) { - if (GvIO(gv) && IoIFP(GvIOp(gv))) { + if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHMOD int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); - APPLY_TAINT_PROPER(); + APPLY_TAINT_PROPER(); if (fd < 0) { SETERRNO(EBADF,RMS_IFI); tot--; } else if (fchmod(fd, val)) tot--; #else - Perl_die(aTHX_ PL_no_func, "fchmod"); + Perl_die(aTHX_ PL_no_func, "fchmod"); #endif - } - else { + } + else { SETERRNO(EBADF,RMS_IFI); - tot--; - } - } - else { - const char *name = SvPV_nomg_const(*mark, len); - APPLY_TAINT_PROPER(); + tot--; + } + } + else { + const char *name = SvPV_nomg_const(*mark, len); + APPLY_TAINT_PROPER(); if (!IS_SAFE_PATHNAME(name, len, "chmod") || PerlLIO_chmod(name, val)) { tot--; } - } - } - } - break; + } + } + } + break; #ifdef HAS_CHOWN case OP_CHOWN: - APPLY_TAINT_PROPER(); - if (sp - mark > 2) { + APPLY_TAINT_PROPER(); + if (sp - mark > 2) { I32 val2; - val = SvIVx(*++mark); - val2 = SvIVx(*++mark); - APPLY_TAINT_PROPER(); - tot = sp - mark; - while (++mark <= sp) { + val = SvIVx(*++mark); + val2 = SvIVx(*++mark); + APPLY_TAINT_PROPER(); + tot = sp - mark; + while (++mark <= sp) { GV* gv; - if ((gv = MAYBE_DEREF_GV(*mark))) { - if (GvIO(gv) && IoIFP(GvIOp(gv))) { + if ((gv = MAYBE_DEREF_GV(*mark))) { + if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FCHOWN int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); - APPLY_TAINT_PROPER(); + APPLY_TAINT_PROPER(); if (fd < 0) { SETERRNO(EBADF,RMS_IFI); - tot--; + tot--; } else if (fchown(fd, val, val2)) - tot--; + tot--; #else - Perl_die(aTHX_ PL_no_func, "fchown"); + Perl_die(aTHX_ PL_no_func, "fchown"); #endif - } - else { + } + else { SETERRNO(EBADF,RMS_IFI); - tot--; - } - } - else { - const char *name = SvPV_nomg_const(*mark, len); - APPLY_TAINT_PROPER(); + tot--; + } + } + else { + const char *name = SvPV_nomg_const(*mark, len); + APPLY_TAINT_PROPER(); if (!IS_SAFE_PATHNAME(name, len, "chown") || PerlLIO_chown(name, val, val2)) { - tot--; + tot--; } - } - } - } - break; + } + } + } + break; #endif /* XXX Should we make lchown() directly available from perl? @@ -2598,44 +2598,44 @@ nothing in the core. */ #ifdef HAS_KILL case OP_KILL: - APPLY_TAINT_PROPER(); - if (mark == sp) - break; - s = SvPVx_const(*++mark, len); - if (*s == '-' && isALPHA(s[1])) - { - s++; - len--; + APPLY_TAINT_PROPER(); + if (mark == sp) + break; + s = SvPVx_const(*++mark, len); + if (*s == '-' && isALPHA(s[1])) + { + s++; + len--; killgp = TRUE; - } - if (isALPHA(*s)) { - if (*s == 'S' && s[1] == 'I' && s[2] == 'G') { - s += 3; + } + if (isALPHA(*s)) { + if (*s == 'S' && s[1] == 'I' && s[2] == 'G') { + s += 3; len -= 3; } if ((val = whichsig_pvn(s, len)) < 0) Perl_croak(aTHX_ "Unrecognized signal name \"%" SVf "\"", SVfARG(*mark)); - } - else - { - val = SvIV(*mark); - if (val < 0) - { - killgp = TRUE; + } + else + { + val = SvIV(*mark); + if (val < 0) + { + killgp = TRUE; val = -val; - } - } - APPLY_TAINT_PROPER(); - tot = sp - mark; - - while (++mark <= sp) { - Pid_t proc; - SvGETMAGIC(*mark); - if (!(SvNIOK(*mark) || looks_like_number(*mark))) - Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); - proc = SvIV_nomg(*mark); - APPLY_TAINT_PROPER(); + } + } + APPLY_TAINT_PROPER(); + tot = sp - mark; + + while (++mark <= sp) { + Pid_t proc; + SvGETMAGIC(*mark); + if (!(SvNIOK(*mark) || looks_like_number(*mark))) + Perl_croak(aTHX_ "Can't kill a non-numeric process ID"); + proc = SvIV_nomg(*mark); + APPLY_TAINT_PROPER(); #ifdef HAS_KILLPG /* use killpg in preference, as the killpg() wrapper for Win32 * understands process groups, but the kill() wrapper doesn't */ @@ -2644,28 +2644,28 @@ nothing in the core. #else if (PerlProc_kill(killgp ? -proc: proc, val)) #endif - tot--; - } - PERL_ASYNC_CHECK(); - break; + tot--; + } + PERL_ASYNC_CHECK(); + break; #endif case OP_UNLINK: - APPLY_TAINT_PROPER(); - tot = sp - mark; - while (++mark <= sp) { - s = SvPV_const(*mark, len); - APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(s, len, "unlink")) { + APPLY_TAINT_PROPER(); + tot = sp - mark; + while (++mark <= sp) { + s = SvPV_const(*mark, len); + APPLY_TAINT_PROPER(); + if (!IS_SAFE_PATHNAME(s, len, "unlink")) { tot--; } - else if (PL_unsafe) { - if (UNLINK(s)) - { - tot--; - } + else if (PL_unsafe) { + if (UNLINK(s)) + { + tot--; + } #if defined(__amigaos4__) && defined(NEWLIB) - else - { + else + { /* Under AmigaOS4 unlink only 'fails' if the * filename is invalid. It may not remove the file * if it's locked, so check if it's still around. */ @@ -2673,58 +2673,58 @@ nothing in the core. { tot--; } - } -#endif - } - else { /* don't let root wipe out directories without -U */ - Stat_t statbuf; - if (PerlLIO_lstat(s, &statbuf) < 0) - tot--; - else if (S_ISDIR(statbuf.st_mode)) { - SETERRNO(EISDIR, SS_NOPRIV); - tot--; - } - else { - if (UNLINK(s)) - { - tot--; - } + } +#endif + } + else { /* don't let root wipe out directories without -U */ + Stat_t statbuf; + if (PerlLIO_lstat(s, &statbuf) < 0) + tot--; + else if (S_ISDIR(statbuf.st_mode)) { + SETERRNO(EISDIR, SS_NOPRIV); + tot--; + } + else { + if (UNLINK(s)) + { + tot--; + } #if defined(__amigaos4__) && defined(NEWLIB) - else - { - /* Under AmigaOS4 unlink only 'fails' if the filename is invalid */ - /* It may not remove the file if it's Locked, so check if it's still */ - /* arround */ - if((access(s,F_OK) != -1)) - { - tot--; - } - } -#endif - } - } - } - break; + else + { + /* Under AmigaOS4 unlink only 'fails' if the filename is invalid */ + /* It may not remove the file if it's Locked, so check if it's still */ + /* arround */ + if((access(s,F_OK) != -1)) + { + tot--; + } + } +#endif + } + } + } + break; #if defined(HAS_UTIME) || defined(HAS_FUTIMES) case OP_UTIME: - APPLY_TAINT_PROPER(); - if (sp - mark > 2) { + APPLY_TAINT_PROPER(); + if (sp - mark > 2) { #if defined(HAS_FUTIMES) - struct timeval utbuf[2]; - void *utbufp = utbuf; + struct timeval utbuf[2]; + void *utbufp = utbuf; #elif defined(I_UTIME) || defined(VMS) - struct utimbuf utbuf; - struct utimbuf *utbufp = &utbuf; + struct utimbuf utbuf; + struct utimbuf *utbufp = &utbuf; #else - struct { - Time_t actime; - Time_t modtime; - } utbuf; - void *utbufp = &utbuf; + struct { + Time_t actime; + Time_t modtime; + } utbuf; + void *utbufp = &utbuf; #endif - SV* const accessed = *++mark; - SV* const modified = *++mark; + SV* const accessed = *++mark; + SV* const modified = *++mark; /* Be like C, and if both times are undefined, let the C * library figure out what to do. This usually means @@ -2735,10 +2735,10 @@ nothing in the core. else { Zero(&utbuf, sizeof utbuf, char); #ifdef HAS_FUTIMES - utbuf[0].tv_sec = (long)SvIV(accessed); /* time accessed */ - utbuf[0].tv_usec = 0; - utbuf[1].tv_sec = (long)SvIV(modified); /* time modified */ - utbuf[1].tv_usec = 0; + utbuf[0].tv_sec = (long)SvIV(accessed); /* time accessed */ + utbuf[0].tv_usec = 0; + utbuf[1].tv_sec = (long)SvIV(modified); /* time modified */ + utbuf[1].tv_usec = 0; #elif defined(BIG_TIME) utbuf.actime = (Time_t)SvNV(accessed); /* time accessed */ utbuf.modtime = (Time_t)SvNV(modified); /* time modified */ @@ -2747,48 +2747,48 @@ nothing in the core. utbuf.modtime = (Time_t)SvIV(modified); /* time modified */ #endif } - APPLY_TAINT_PROPER(); - tot = sp - mark; - while (++mark <= sp) { + APPLY_TAINT_PROPER(); + tot = sp - mark; + while (++mark <= sp) { GV* gv; if ((gv = MAYBE_DEREF_GV(*mark))) { - if (GvIO(gv) && IoIFP(GvIOp(gv))) { + if (GvIO(gv) && IoIFP(GvIOp(gv))) { #ifdef HAS_FUTIMES int fd = PerlIO_fileno(IoIFP(GvIOn(gv))); - APPLY_TAINT_PROPER(); + APPLY_TAINT_PROPER(); if (fd < 0) { SETERRNO(EBADF,RMS_IFI); tot--; - } else if (futimes(fd, (struct timeval *) utbufp)) - tot--; + } else if (futimes(fd, (struct timeval *) utbufp)) + tot--; #else - Perl_die(aTHX_ PL_no_func, "futimes"); -#endif - } - else { - tot--; - } - } - else { - const char * const name = SvPV_nomg_const(*mark, len); - APPLY_TAINT_PROPER(); - if (!IS_SAFE_PATHNAME(name, len, "utime")) { + Perl_die(aTHX_ PL_no_func, "futimes"); +#endif + } + else { + tot--; + } + } + else { + const char * const name = SvPV_nomg_const(*mark, len); + APPLY_TAINT_PROPER(); + if (!IS_SAFE_PATHNAME(name, len, "utime")) { tot--; } else #ifdef HAS_FUTIMES - if (utimes(name, (struct timeval *)utbufp)) + if (utimes(name, (struct timeval *)utbufp)) #else - if (PerlLIO_utime(name, utbufp)) + if (PerlLIO_utime(name, utbufp)) #endif - tot--; - } + tot--; + } - } - } - else - tot = 0; - break; + } + } + else + tot = 0; + break; #endif } return tot; @@ -2837,24 +2837,24 @@ Perl_cando(pTHX_ Mode_t mode, bool effective, const Stat_t *statbufp) # else if ((effective ? PerlProc_geteuid() : PerlProc_getuid()) == 0) { /* root is special */ # endif - if (mode == S_IXUSR) { - if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode)) - return TRUE; - } - else - return TRUE; /* root reads and writes anything */ - return FALSE; + if (mode == S_IXUSR) { + if (statbufp->st_mode & 0111 || S_ISDIR(statbufp->st_mode)) + return TRUE; + } + else + return TRUE; /* root reads and writes anything */ + return FALSE; } if (statbufp->st_uid == (effective ? PerlProc_geteuid() : PerlProc_getuid()) ) { - if (statbufp->st_mode & mode) - return TRUE; /* ok as "user" */ + if (statbufp->st_mode & mode) + return TRUE; /* ok as "user" */ } else if (ingroup(statbufp->st_gid,effective)) { - if (statbufp->st_mode & mode >> 3) - return TRUE; /* ok as "group" */ + if (statbufp->st_mode & mode >> 3) + return TRUE; /* ok as "group" */ } else if (statbufp->st_mode & mode >> 6) - return TRUE; /* ok as "other" */ + return TRUE; /* ok as "other" */ return FALSE; #endif /* ! DOSISH */ } @@ -2868,14 +2868,14 @@ S_ingroup(pTHX_ Gid_t testgid, bool effective) PERL_UNUSED_CONTEXT; #endif if (testgid == (effective ? PerlProc_getegid() : PerlProc_getgid())) - return TRUE; + return TRUE; #ifdef HAS_GETGROUPS { - Groups_t *gary = NULL; - I32 anum; + Groups_t *gary = NULL; + I32 anum; bool rc = FALSE; - anum = getgroups(0, gary); + anum = getgroups(0, gary); if (anum > 0) { Newx(gary, anum, Groups_t); anum = getgroups(anum, gary); @@ -2911,20 +2911,20 @@ Perl_do_ipcget(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_MSG case OP_MSGGET: - return msgget(key, flags); + return msgget(key, flags); #endif #ifdef HAS_SEM case OP_SEMGET: - return semget(key, (int) SvIV(nsv), flags); + return semget(key, (int) SvIV(nsv), flags); #endif #ifdef HAS_SHM case OP_SHMGET: - return shmget(key, (size_t) SvUV(nsv), flags); + return shmget(key, (size_t) SvUV(nsv), flags); #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: /* diag_listed_as: msg%s not implemented */ - Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); + Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); #endif } return -1; /* should never happen */ @@ -2951,71 +2951,71 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_MSG case OP_MSGCTL: - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct msqid_ds); - break; + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct msqid_ds); + break; #endif #ifdef HAS_SHM case OP_SHMCTL: - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct shmid_ds); - break; + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct shmid_ds); + break; #endif #ifdef HAS_SEM case OP_SEMCTL: #ifdef Semctl - if (cmd == IPC_STAT || cmd == IPC_SET) - infosize = sizeof(struct semid_ds); - else if (cmd == GETALL || cmd == SETALL) - { - struct semid_ds semds; - union semun semun; + if (cmd == IPC_STAT || cmd == IPC_SET) + infosize = sizeof(struct semid_ds); + else if (cmd == GETALL || cmd == SETALL) + { + struct semid_ds semds; + union semun semun; #ifdef EXTRA_F_IN_SEMUN_BUF semun.buff = &semds; #else semun.buf = &semds; #endif - getinfo = (cmd == GETALL); - if (Semctl(id, 0, IPC_STAT, semun) == -1) - return -1; - infosize = semds.sem_nsems * sizeof(short); - /* "short" is technically wrong but much more portable - than guessing about u_?short(_t)? */ - } + getinfo = (cmd == GETALL); + if (Semctl(id, 0, IPC_STAT, semun) == -1) + return -1; + infosize = semds.sem_nsems * sizeof(short); + /* "short" is technically wrong but much more portable + than guessing about u_?short(_t)? */ + } #else /* diag_listed_as: sem%s not implemented */ - Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); + Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); #endif - break; + break; #endif #if !defined(HAS_MSG) || !defined(HAS_SEM) || !defined(HAS_SHM) default: /* diag_listed_as: shm%s not implemented */ - Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); + Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); #endif } if (infosize) { - if (getinfo) - { + if (getinfo) + { /* we're not using the value here, so don't SvPVanything */ SvUPGRADE(astr, SVt_PV); SvGETMAGIC(astr); if (SvTHINKFIRST(astr)) sv_force_normal_flags(astr, 0); - a = SvGROW(astr, infosize+1); - } - else - { - STRLEN len; - a = SvPVbyte(astr, len); - if (len != infosize) - Perl_croak(aTHX_ "Bad arg length for %s, is %lu, should be %ld", - PL_op_desc[optype], - (unsigned long)len, - (long)infosize); - } + a = SvGROW(astr, infosize+1); + } + else + { + STRLEN len; + a = SvPVbyte(astr, len); + if (len != infosize) + Perl_croak(aTHX_ "Bad arg length for %s, is %lu, should be %ld", + PL_op_desc[optype], + (unsigned long)len, + (long)infosize); + } } else { @@ -3037,8 +3037,8 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) { #ifdef HAS_MSG case OP_MSGCTL: - ret = msgctl(id, cmd, (struct msqid_ds *)a); - break; + ret = msgctl(id, cmd, (struct msqid_ds *)a); + break; #endif #ifdef HAS_SEM case OP_SEMCTL: { @@ -3055,25 +3055,25 @@ Perl_do_ipcctl(pTHX_ I32 optype, SV **mark, SV **sp) unsemds.buf = (struct semid_ds *)a; #endif } - ret = Semctl(id, n, cmd, unsemds); + ret = Semctl(id, n, cmd, unsemds); #else - /* diag_listed_as: sem%s not implemented */ - Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); + /* diag_listed_as: sem%s not implemented */ + Perl_croak(aTHX_ "%s not implemented", PL_op_desc[optype]); #endif } - break; + break; #endif #ifdef HAS_SHM case OP_SHMCTL: - ret = shmctl(id, cmd, (struct shmid_ds *)a); - break; + ret = shmctl(id, cmd, (struct shmid_ds *)a); + break; #endif } if (getinfo && ret >= 0) { - SvCUR_set(astr, infosize); - *SvEND(astr) = '\0'; + SvCUR_set(astr, infosize); + *SvEND(astr) = '\0'; SvPOK_only(astr); - SvSETMAGIC(astr); + SvSETMAGIC(astr); } return ret; } @@ -3093,7 +3093,7 @@ Perl_do_msgsnd(pTHX_ SV **mark, SV **sp) PERL_UNUSED_ARG(sp); if (msize < 0) - Perl_croak(aTHX_ "Arg too short for msgsnd"); + Perl_croak(aTHX_ "Arg too short for msgsnd"); SETERRNO(0,0); if (id >= 0 && flags >= 0) { return msgsnd(id, (struct msgbuf *)mbuf, msize, flags); @@ -3140,11 +3140,11 @@ Perl_do_msgrcv(pTHX_ SV **mark, SV **sp) ret = -1; } if (ret >= 0) { - SvCUR_set(mstr, sizeof(long)+ret); + SvCUR_set(mstr, sizeof(long)+ret); SvPOK_only(mstr); - *SvEND(mstr) = '\0'; - /* who knows who has been playing with this message? */ - SvTAINTED_on(mstr); + *SvEND(mstr) = '\0'; + /* who knows who has been playing with this message? */ + SvTAINTED_on(mstr); } return ret; #else @@ -3169,9 +3169,9 @@ Perl_do_semop(pTHX_ SV **mark, SV **sp) PERL_UNUSED_ARG(sp); if (opsize < 3 * SHORTSIZE - || (opsize % (3 * SHORTSIZE))) { - SETERRNO(EINVAL,LIB_INVARG); - return -1; + || (opsize % (3 * SHORTSIZE))) { + SETERRNO(EINVAL,LIB_INVARG); + return -1; } SETERRNO(0,0); /* We can't assume that sizeof(struct sembuf) == 3 * sizeof(short). */ @@ -3217,11 +3217,11 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) SETERRNO(0,0); if (shmctl(id, IPC_STAT, &shmds) == -1) - return -1; + return -1; if (mpos < 0 || msize < 0 - || (size_t)mpos + msize > (size_t)shmds.shm_segsz) { - SETERRNO(EFAULT,SS_ACCVIO); /* can't do as caller requested */ - return -1; + || (size_t)mpos + msize > (size_t)shmds.shm_segsz) { + SETERRNO(EFAULT,SS_ACCVIO); /* can't do as caller requested */ + return -1; } if (id >= 0) { shm = (char *)shmat(id, NULL, (optype == OP_SHMREAD) ? SHM_RDONLY : 0); @@ -3230,32 +3230,32 @@ Perl_do_shmio(pTHX_ I32 optype, SV **mark, SV **sp) return -1; } if (shm == (char *)-1) /* I hate System V IPC, I really do */ - return -1; + return -1; if (optype == OP_SHMREAD) { - char *mbuf; - /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ - SvGETMAGIC(mstr); - SvUPGRADE(mstr, SVt_PV); - if (! SvOK(mstr)) + char *mbuf; + /* suppress warning when reading into undef var (tchrist 3/Mar/00) */ + SvGETMAGIC(mstr); + SvUPGRADE(mstr, SVt_PV); + if (! SvOK(mstr)) SvPVCLEAR(mstr); - SvPOK_only(mstr); - mbuf = SvGROW(mstr, (STRLEN)msize+1); + SvPOK_only(mstr); + mbuf = SvGROW(mstr, (STRLEN)msize+1); - Copy(shm + mpos, mbuf, msize, char); - SvCUR_set(mstr, msize); - *SvEND(mstr) = '\0'; - SvSETMAGIC(mstr); - /* who knows who has been playing with this shared memory? */ - SvTAINTED_on(mstr); + Copy(shm + mpos, mbuf, msize, char); + SvCUR_set(mstr, msize); + *SvEND(mstr) = '\0'; + SvSETMAGIC(mstr); + /* who knows who has been playing with this shared memory? */ + SvTAINTED_on(mstr); } else { - STRLEN len; + STRLEN len; - const char *mbuf = SvPVbyte(mstr, len); - const I32 n = ((I32)len > msize) ? msize : (I32)len; - Copy(mbuf, shm + mpos, n, char); - if (n < msize) - memzero(shm + mpos + n, msize - n); + const char *mbuf = SvPVbyte(mstr, len); + const I32 n = ((I32)len > msize) ? msize : (I32)len; + Copy(mbuf, shm + mpos, n, char); + if (n < msize) + memzero(shm + mpos + n, msize - n); } return shmdt(shm); #else diff --git a/doop.c b/doop.c index 822ad3c2aaea..fe1d44aa7a3b 100644 --- a/doop.c +++ b/doop.c @@ -53,57 +53,57 @@ S_do_trans_simple(pTHX_ SV * const sv, const OPtrans_map * const tbl) /* First, take care of non-UTF-8 input strings, because they're easy */ if (!SvUTF8(sv)) { - while (s < send) { - const short ch = tbl->map[*s]; - if (ch >= 0) { - matches++; - *s = (U8)ch; - } - s++; - } - SvSETMAGIC(sv); + while (s < send) { + const short ch = tbl->map[*s]; + if (ch >= 0) { + matches++; + *s = (U8)ch; + } + s++; + } + SvSETMAGIC(sv); } else { - const bool grows = cBOOL(PL_op->op_private & OPpTRANS_GROWS); - U8 *d; - U8 *dstart; + const bool grows = cBOOL(PL_op->op_private & OPpTRANS_GROWS); + U8 *d; + U8 *dstart; /* Allow for worst-case expansion: Each input byte can become 2. For a * given input character, this happens when it occupies a single byte * under UTF-8, but is to be translated to something that occupies two: * $_="a".chr(400); tr/a/\xFE/, FE needs encoding. */ - if (grows) - Newx(d, len*2+1, U8); - else - d = s; - dstart = d; - while (s < send) { - STRLEN ulen; - short ch; - - /* Need to check this, otherwise 128..255 won't match */ - const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); - if (c < 0x100 && (ch = tbl->map[c]) >= 0) { - matches++; - d = uvchr_to_utf8(d, (UV)ch); - s += ulen; - } - else { /* No match -> copy */ - Move(s, d, ulen, U8); - d += ulen; - s += ulen; - } - } - if (grows) { - sv_setpvn(sv, (char*)dstart, d - dstart); - Safefree(dstart); - } - else { - *d = '\0'; - SvCUR_set(sv, d - dstart); - } - SvUTF8_on(sv); - SvSETMAGIC(sv); + if (grows) + Newx(d, len*2+1, U8); + else + d = s; + dstart = d; + while (s < send) { + STRLEN ulen; + short ch; + + /* Need to check this, otherwise 128..255 won't match */ + const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); + if (c < 0x100 && (ch = tbl->map[c]) >= 0) { + matches++; + d = uvchr_to_utf8(d, (UV)ch); + s += ulen; + } + else { /* No match -> copy */ + Move(s, d, ulen, U8); + d += ulen; + s += ulen; + } + } + if (grows) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); + } + else { + *d = '\0'; + SvCUR_set(sv, d - dstart); + } + SvUTF8_on(sv); + SvSETMAGIC(sv); } DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n", __FILE__, __LINE__, matches)); @@ -140,23 +140,23 @@ S_do_trans_count(pTHX_ SV * const sv, const OPtrans_map * const tbl) DEBUG_y(sv_dump(sv)); if (!SvUTF8(sv)) { - while (s < send) { + while (s < send) { if (tbl->map[*s++] >= 0) matches++; - } + } } else { - const bool complement = cBOOL(PL_op->op_private & OPpTRANS_COMPLEMENT); - while (s < send) { - STRLEN ulen; - const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); - if (c < 0x100) { - if (tbl->map[c] >= 0) - matches++; - } else if (complement) - matches++; - s += ulen; - } + const bool complement = cBOOL(PL_op->op_private & OPpTRANS_COMPLEMENT); + while (s < send) { + STRLEN ulen; + const UV c = utf8n_to_uvchr(s, send - s, &ulen, UTF8_ALLOW_DEFAULT); + if (c < 0x100) { + if (tbl->map[c] >= 0) + matches++; + } else if (complement) + matches++; + s += ulen; + } } DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: count returning %zu\n", @@ -190,26 +190,26 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl) DEBUG_y(sv_dump(sv)); if (!SvUTF8(sv)) { - U8 *d = s; - U8 * const dstart = d; + U8 *d = s; + U8 * const dstart = d; - if (PL_op->op_private & OPpTRANS_SQUASH) { + if (PL_op->op_private & OPpTRANS_SQUASH) { /* What the mapping of the previous character was to. If the new * character has the same mapping, it is squashed from the output * (but still is included in the count) */ short previous_map = (short) TR_OOB; - while (s < send) { - const short this_map = tbl->map[*s]; - if (this_map >= 0) { + while (s < send) { + const short this_map = tbl->map[*s]; + if (this_map >= 0) { matches++; if (this_map != previous_map) { *d++ = (U8)this_map; previous_map = this_map; } - } - else { + } + else { if (this_map == (short) TR_UNMAPPED) { *d++ = *s; previous_map = (short) TR_OOB; @@ -220,47 +220,47 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl) } } - s++; - } - } - else { /* Not to squash */ - while (s < send) { - const short this_map = tbl->map[*s]; - if (this_map >= 0) { - matches++; - *d++ = (U8)this_map; - } - else if (this_map == (short) TR_UNMAPPED) - *d++ = *s; - else if (this_map == (short) TR_DELETE) - matches++; - s++; - } - } - *d = '\0'; - SvCUR_set(sv, d - dstart); + s++; + } + } + else { /* Not to squash */ + while (s < send) { + const short this_map = tbl->map[*s]; + if (this_map >= 0) { + matches++; + *d++ = (U8)this_map; + } + else if (this_map == (short) TR_UNMAPPED) + *d++ = *s; + else if (this_map == (short) TR_DELETE) + matches++; + s++; + } + } + *d = '\0'; + SvCUR_set(sv, d - dstart); } else { /* is utf8 */ - const bool squash = cBOOL(PL_op->op_private & OPpTRANS_SQUASH); - const bool grows = cBOOL(PL_op->op_private & OPpTRANS_GROWS); - U8 *d; - U8 *dstart; - Size_t size = tbl->size; + const bool squash = cBOOL(PL_op->op_private & OPpTRANS_SQUASH); + const bool grows = cBOOL(PL_op->op_private & OPpTRANS_GROWS); + U8 *d; + U8 *dstart; + Size_t size = tbl->size; /* What the mapping of the previous character was to. If the new * character has the same mapping, it is squashed from the output (but * still is included in the count) */ UV pch = TR_OOB; - if (grows) + if (grows) /* Allow for worst-case expansion: Each input byte can become 2. * For a given input character, this happens when it occupies a * single byte under UTF-8, but is to be translated to something * that occupies two: */ - Newx(d, len*2+1, U8); - else - d = s; - dstart = d; + Newx(d, len*2+1, U8); + else + d = s; + dstart = d; while (s < send) { STRLEN len; @@ -302,15 +302,15 @@ S_do_trans_complex(pTHX_ SV * const sv, const OPtrans_map * const tbl) s += len; } - if (grows) { - sv_setpvn(sv, (char*)dstart, d - dstart); - Safefree(dstart); - } - else { - *d = '\0'; - SvCUR_set(sv, d - dstart); - } - SvUTF8_on(sv); + if (grows) { + sv_setpvn(sv, (char*)dstart, d - dstart); + Safefree(dstart); + } + else { + *d = '\0'; + SvCUR_set(sv, d - dstart); + } + SvUTF8_on(sv); } SvSETMAGIC(sv); DEBUG_y(PerlIO_printf(Perl_debug_log, "%s: %d: returning %zu\n", @@ -459,7 +459,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap) * transliterations are longer than the input. If none can, we just edit * in place. */ if (inplace) { - d0 = d = s; + d0 = d = s; } else { /* Here, we can't edit in place. We have no idea how much, if any, @@ -467,8 +467,8 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap) * calculated the maximum expansion possible. Use that to allocate * based on the worst case scenario. (First +1 is to round up; 2nd is * for \0) */ - Newx(d, (STRLEN) (len * max_expansion + 1 + 1), U8); - d0 = d; + Newx(d, (STRLEN) (len * max_expansion + 1 + 1), U8); + d0 = d; } restart: @@ -514,7 +514,7 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap) previous_map = to; s += s_len; continue; - } + } /* Everything else is counted as a match */ matches++; @@ -558,12 +558,12 @@ S_do_trans_invmap(pTHX_ SV * const sv, AV * const invmap) s_len = 0; s += s_len; if (! inplace) { - sv_setpvn(sv, (char*)d0, d - d0); + sv_setpvn(sv, (char*)d0, d - d0); Safefree(d0); } else { - *d = '\0'; - SvCUR_set(sv, d - d0); + *d = '\0'; + SvCUR_set(sv, d - d0); } if (! SvUTF8(sv) && out_is_utf8) { @@ -599,11 +599,11 @@ Perl_do_trans(pTHX_ SV *sv) } (void)SvPV_const(sv, len); if (!len) - return 0; + return 0; if (! identical) { - if (!SvPOKp(sv) || SvTHINKFIRST(sv)) - (void)SvPV_force_nomg(sv, len); - (void)SvPOK_only_UTF8(sv); + if (!SvPOKp(sv) || SvTHINKFIRST(sv)) + (void)SvPV_force_nomg(sv, len); + (void)SvPOK_only_UTF8(sv); } if (use_utf8_fcns) { @@ -650,19 +650,19 @@ Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp) len = (items > 0 ? (delimlen * (items - 1) ) : 0); SvUPGRADE(sv, SVt_PV); if (SvLEN(sv) < len + items) { /* current length is way too short */ - while (items-- > 0) { - if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { - STRLEN tmplen; - SvPV_const(*mark, tmplen); - len += tmplen; - } - mark++; - } - SvGROW(sv, len + 1); /* so try to pre-extend */ - - mark = oldmark; - items = sp - mark; - ++mark; + while (items-- > 0) { + if (*mark && !SvGAMAGIC(*mark) && SvOK(*mark)) { + STRLEN tmplen; + SvPV_const(*mark, tmplen); + len += tmplen; + } + mark++; + } + SvGROW(sv, len + 1); /* so try to pre-extend */ + + mark = oldmark; + items = sp - mark; + ++mark; } SvPVCLEAR(sv); @@ -670,33 +670,33 @@ Perl_do_join(pTHX_ SV *sv, SV *delim, SV **mark, SV **sp) SvUTF8_off(sv); if (TAINTING_get && SvMAGICAL(sv)) - SvTAINTED_off(sv); + SvTAINTED_off(sv); if (items-- > 0) { - if (*mark) - sv_catsv(sv, *mark); - mark++; + if (*mark) + sv_catsv(sv, *mark); + mark++; } if (delimlen) { - const U32 delimflag = DO_UTF8(delim) ? SV_CATUTF8 : SV_CATBYTES; - for (; items > 0; items--,mark++) { - STRLEN len; - const char *s; - sv_catpvn_flags(sv,delims,delimlen,delimflag); - s = SvPV_const(*mark,len); - sv_catpvn_flags(sv,s,len, - DO_UTF8(*mark) ? SV_CATUTF8 : SV_CATBYTES); - } + const U32 delimflag = DO_UTF8(delim) ? SV_CATUTF8 : SV_CATBYTES; + for (; items > 0; items--,mark++) { + STRLEN len; + const char *s; + sv_catpvn_flags(sv,delims,delimlen,delimflag); + s = SvPV_const(*mark,len); + sv_catpvn_flags(sv,s,len, + DO_UTF8(*mark) ? SV_CATUTF8 : SV_CATBYTES); + } } else { - for (; items > 0; items--,mark++) - { - STRLEN len; - const char *s = SvPV_const(*mark,len); - sv_catpvn_flags(sv,s,len, - DO_UTF8(*mark) ? SV_CATUTF8 : SV_CATBYTES); - } + for (; items > 0; items--,mark++) + { + STRLEN len; + const char *s = SvPV_const(*mark,len); + sv_catpvn_flags(sv,s,len, + DO_UTF8(*mark) ? SV_CATUTF8 : SV_CATBYTES); + } } SvSETMAGIC(sv); } @@ -712,20 +712,20 @@ Perl_do_sprintf(pTHX_ SV *sv, SSize_t len, SV **sarg) assert(len >= 1); if (SvTAINTED(*sarg)) - TAINT_PROPER( - (PL_op && PL_op->op_type < OP_max) - ? (PL_op->op_type == OP_PRTF) - ? "printf" - : PL_op_name[PL_op->op_type] - : "(unknown)" - ); + TAINT_PROPER( + (PL_op && PL_op->op_type < OP_max) + ? (PL_op->op_type == OP_PRTF) + ? "printf" + : PL_op_name[PL_op->op_type] + : "(unknown)" + ); SvUTF8_off(sv); if (DO_UTF8(*sarg)) SvUTF8_on(sv); sv_vsetpvfn(sv, pat, patlen, NULL, sarg + 1, (Size_t)(len - 1), &do_taint); SvSETMAGIC(sv); if (do_taint) - SvTAINTED_on(sv); + SvTAINTED_on(sv); } UV @@ -745,10 +745,10 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size) PERL_ARGS_ASSERT_DO_VECGET; if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ - Perl_croak(aTHX_ "Illegal number of bits in vec"); + Perl_croak(aTHX_ "Illegal number of bits in vec"); if (SvUTF8(sv)) { - if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) { + if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) { /* PVX may have changed */ s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags); } @@ -759,17 +759,17 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size) } if (size < 8) { - bitoffs = ((offset%8)*size)%8; - uoffset = offset/(8/size); + bitoffs = ((offset%8)*size)%8; + uoffset = offset/(8/size); } else if (size > 8) { - int n = size/8; + int n = size/8; if (offset > Size_t_MAX / n - 1) /* would overflow */ return 0; - uoffset = offset*n; + uoffset = offset*n; } else - uoffset = offset; + uoffset = offset; if (uoffset >= srclen) return 0; @@ -780,108 +780,108 @@ Perl_do_vecget(pTHX_ SV *sv, STRLEN offset, int size) /* Does the byte range overlap the end of the string? If so, * handle specially. */ if (avail < len) { - if (size <= 8) - retnum = 0; - else { - if (size == 16) { + if (size <= 8) + retnum = 0; + else { + if (size == 16) { assert(avail == 1); retnum = (UV) s[uoffset] << 8; - } - else if (size == 32) { + } + else if (size == 32) { assert(avail >= 1 && avail <= 3); - if (avail == 1) - retnum = - ((UV) s[uoffset ] << 24); - else if (avail == 2) - retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16); - else - retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16) + - ( s[uoffset + 2] << 8); - } + if (avail == 1) + retnum = + ((UV) s[uoffset ] << 24); + else if (avail == 2) + retnum = + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16); + else + retnum = + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16) + + ( s[uoffset + 2] << 8); + } #ifdef UV_IS_QUAD - else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); + else if (size == 64) { + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); assert(avail >= 1 && avail <= 7); - if (avail == 1) - retnum = - (UV) s[uoffset ] << 56; - else if (avail == 2) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48); - else if (avail == 3) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40); - else if (avail == 4) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40) + - ((UV) s[uoffset + 3] << 32); - else if (avail == 5) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40) + - ((UV) s[uoffset + 3] << 32) + - ((UV) s[uoffset + 4] << 24); - else if (avail == 6) - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40) + - ((UV) s[uoffset + 3] << 32) + - ((UV) s[uoffset + 4] << 24) + - ((UV) s[uoffset + 5] << 16); - else - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40) + - ((UV) s[uoffset + 3] << 32) + - ((UV) s[uoffset + 4] << 24) + - ((UV) s[uoffset + 5] << 16) + - ((UV) s[uoffset + 6] << 8); - } + if (avail == 1) + retnum = + (UV) s[uoffset ] << 56; + else if (avail == 2) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48); + else if (avail == 3) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40); + else if (avail == 4) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40) + + ((UV) s[uoffset + 3] << 32); + else if (avail == 5) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40) + + ((UV) s[uoffset + 3] << 32) + + ((UV) s[uoffset + 4] << 24); + else if (avail == 6) + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40) + + ((UV) s[uoffset + 3] << 32) + + ((UV) s[uoffset + 4] << 24) + + ((UV) s[uoffset + 5] << 16); + else + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40) + + ((UV) s[uoffset + 3] << 32) + + ((UV) s[uoffset + 4] << 24) + + ((UV) s[uoffset + 5] << 16) + + ((UV) s[uoffset + 6] << 8); + } #endif - } + } } else if (size < 8) - retnum = (s[uoffset] >> bitoffs) & nBIT_MASK(size); + retnum = (s[uoffset] >> bitoffs) & nBIT_MASK(size); else { - if (size == 8) - retnum = s[uoffset]; - else if (size == 16) - retnum = - ((UV) s[uoffset] << 8) + - s[uoffset + 1]; - else if (size == 32) - retnum = - ((UV) s[uoffset ] << 24) + - ((UV) s[uoffset + 1] << 16) + - ( s[uoffset + 2] << 8) + - s[uoffset + 3]; + if (size == 8) + retnum = s[uoffset]; + else if (size == 16) + retnum = + ((UV) s[uoffset] << 8) + + s[uoffset + 1]; + else if (size == 32) + retnum = + ((UV) s[uoffset ] << 24) + + ((UV) s[uoffset + 1] << 16) + + ( s[uoffset + 2] << 8) + + s[uoffset + 3]; #ifdef UV_IS_QUAD - else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); - retnum = - ((UV) s[uoffset ] << 56) + - ((UV) s[uoffset + 1] << 48) + - ((UV) s[uoffset + 2] << 40) + - ((UV) s[uoffset + 3] << 32) + - ((UV) s[uoffset + 4] << 24) + - ((UV) s[uoffset + 5] << 16) + - ( s[uoffset + 6] << 8) + - s[uoffset + 7]; - } + else if (size == 64) { + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); + retnum = + ((UV) s[uoffset ] << 56) + + ((UV) s[uoffset + 1] << 48) + + ((UV) s[uoffset + 2] << 40) + + ((UV) s[uoffset + 3] << 32) + + ((UV) s[uoffset + 4] << 24) + + ((UV) s[uoffset + 5] << 16) + + ( s[uoffset + 6] << 8) + + s[uoffset + 7]; + } #endif } @@ -917,15 +917,15 @@ Perl_do_vecset(pTHX_ SV *sv) } if (!targ) - return; + return; s = (unsigned char*)SvPV_force_flags(targ, targlen, SV_GMAGIC | SV_UNDEF_RETURNS_NULL); if (SvUTF8(targ)) { - /* This is handled by the SvPOK_only below... - if (!Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0)) - SvUTF8_off(targ); - */ - (void) Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0); + /* This is handled by the SvPOK_only below... + if (!Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0)) + SvUTF8_off(targ); + */ + (void) Perl_sv_utf8_downgrade_flags(aTHX_ targ, TRUE, 0); } (void)SvPOK_only(targ); @@ -934,60 +934,60 @@ Perl_do_vecset(pTHX_ SV *sv) size = LvTARGLEN(sv); if (size < 1 || (size & (size-1))) /* size < 1 or not a power of two */ - Perl_croak(aTHX_ "Illegal number of bits in vec"); + Perl_croak(aTHX_ "Illegal number of bits in vec"); if (size < 8) { - bitoffs = ((offset%8)*size)%8; - offset /= 8/size; + bitoffs = ((offset%8)*size)%8; + offset /= 8/size; } else if (size > 8) { - int n = size/8; + int n = size/8; if (offset > Size_t_MAX / n - 1) /* would overflow */ Perl_croak_nocontext("Out of memory!"); - offset *= n; + offset *= n; } len = (bitoffs + size + 7)/8; /* required number of bytes */ if (targlen < offset || targlen - offset < len) { STRLEN newlen = offset > Size_t_MAX - len - 1 ? /* avoid overflow */ Size_t_MAX : offset + len + 1; - s = (unsigned char*)SvGROW(targ, newlen); - (void)memzero((char *)(s + targlen), newlen - targlen); - SvCUR_set(targ, newlen - 1); + s = (unsigned char*)SvGROW(targ, newlen); + (void)memzero((char *)(s + targlen), newlen - targlen); + SvCUR_set(targ, newlen - 1); } if (size < 8) { - mask = nBIT_MASK(size); - lval &= mask; - s[offset] &= ~(mask << bitoffs); - s[offset] |= lval << bitoffs; + mask = nBIT_MASK(size); + lval &= mask; + s[offset] &= ~(mask << bitoffs); + s[offset] |= lval << bitoffs; } else { - if (size == 8) - s[offset ] = (U8)( lval & 0xff); - else if (size == 16) { - s[offset ] = (U8)((lval >> 8) & 0xff); - s[offset+1] = (U8)( lval & 0xff); - } - else if (size == 32) { - s[offset ] = (U8)((lval >> 24) & 0xff); - s[offset+1] = (U8)((lval >> 16) & 0xff); - s[offset+2] = (U8)((lval >> 8) & 0xff); - s[offset+3] = (U8)( lval & 0xff); - } + if (size == 8) + s[offset ] = (U8)( lval & 0xff); + else if (size == 16) { + s[offset ] = (U8)((lval >> 8) & 0xff); + s[offset+1] = (U8)( lval & 0xff); + } + else if (size == 32) { + s[offset ] = (U8)((lval >> 24) & 0xff); + s[offset+1] = (U8)((lval >> 16) & 0xff); + s[offset+2] = (U8)((lval >> 8) & 0xff); + s[offset+3] = (U8)( lval & 0xff); + } #ifdef UV_IS_QUAD - else if (size == 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), - "Bit vector size > 32 non-portable"); - s[offset ] = (U8)((lval >> 56) & 0xff); - s[offset+1] = (U8)((lval >> 48) & 0xff); - s[offset+2] = (U8)((lval >> 40) & 0xff); - s[offset+3] = (U8)((lval >> 32) & 0xff); - s[offset+4] = (U8)((lval >> 24) & 0xff); - s[offset+5] = (U8)((lval >> 16) & 0xff); - s[offset+6] = (U8)((lval >> 8) & 0xff); - s[offset+7] = (U8)( lval & 0xff); - } + else if (size == 64) { + Perl_ck_warner(aTHX_ packWARN(WARN_PORTABLE), + "Bit vector size > 32 non-portable"); + s[offset ] = (U8)((lval >> 56) & 0xff); + s[offset+1] = (U8)((lval >> 48) & 0xff); + s[offset+2] = (U8)((lval >> 40) & 0xff); + s[offset+3] = (U8)((lval >> 32) & 0xff); + s[offset+4] = (U8)((lval >> 24) & 0xff); + s[offset+5] = (U8)((lval >> 16) & 0xff); + s[offset+6] = (U8)((lval >> 8) & 0xff); + s[offset+7] = (U8)( lval & 0xff); + } #endif } SvSETMAGIC(targ); @@ -1024,11 +1024,11 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) if (sv != left || (optype != OP_BIT_AND && !SvOK(sv))) SvPVCLEAR(sv); /* avoid undef warning on |= and ^= */ if (sv == left) { - lc = SvPV_force_nomg(left, leftlen); + lc = SvPV_force_nomg(left, leftlen); } else { - lc = SvPV_nomg_const(left, leftlen); - SvPV_force_nomg_nolen(sv); + lc = SvPV_nomg_const(left, leftlen); + SvPV_force_nomg_nolen(sv); } rc = SvPV_nomg_const(right, rightlen); @@ -1089,64 +1089,64 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) (void)SvPOK_only(sv); if (SvOK(sv) || SvTYPE(sv) > SVt_PVMG) { - dc = SvPV_force_nomg_nolen(sv); - if (SvLEN(sv) < len + 1) { - dc = SvGROW(sv, len + 1); - (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); - } + dc = SvPV_force_nomg_nolen(sv); + if (SvLEN(sv) < len + 1) { + dc = SvGROW(sv, len + 1); + (void)memzero(dc + SvCUR(sv), len - SvCUR(sv) + 1); + } } else { - needlen = optype == OP_BIT_AND - ? len : (leftlen > rightlen ? leftlen : rightlen); - Newxz(dc, needlen + 1, char); - sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL); - dc = SvPVX(sv); /* sv_usepvn() calls Renew() */ + needlen = optype == OP_BIT_AND + ? len : (leftlen > rightlen ? leftlen : rightlen); + Newxz(dc, needlen + 1, char); + sv_usepvn_flags(sv, dc, needlen, SV_HAS_TRAILING_NUL); + dc = SvPVX(sv); /* sv_usepvn() calls Renew() */ } SvCUR_set(sv, len); if (len >= sizeof(long)*4 && - !(PTR2nat(dc) % sizeof(long)) && - !(PTR2nat(lc) % sizeof(long)) && - !(PTR2nat(rc) % sizeof(long))) /* It's almost always aligned... */ + !(PTR2nat(dc) % sizeof(long)) && + !(PTR2nat(lc) % sizeof(long)) && + !(PTR2nat(rc) % sizeof(long))) /* It's almost always aligned... */ { - const STRLEN remainder = len % (sizeof(long)*4); - len /= (sizeof(long)*4); - - dl = (long*)dc; - ll = (long*)lc; - rl = (long*)rc; - - switch (optype) { - case OP_BIT_AND: - while (len--) { - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - *dl++ = *ll++ & *rl++; - } - break; - case OP_BIT_XOR: - while (len--) { - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - *dl++ = *ll++ ^ *rl++; - } - break; - case OP_BIT_OR: - while (len--) { - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - *dl++ = *ll++ | *rl++; - } - } - - dc = (char*)dl; - lc = (char*)ll; - rc = (char*)rl; - - len = remainder; + const STRLEN remainder = len % (sizeof(long)*4); + len /= (sizeof(long)*4); + + dl = (long*)dc; + ll = (long*)lc; + rl = (long*)rc; + + switch (optype) { + case OP_BIT_AND: + while (len--) { + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + *dl++ = *ll++ & *rl++; + } + break; + case OP_BIT_XOR: + while (len--) { + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + *dl++ = *ll++ ^ *rl++; + } + break; + case OP_BIT_OR: + while (len--) { + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + *dl++ = *ll++ | *rl++; + } + } + + dc = (char*)dl; + lc = (char*)ll; + rc = (char*)rl; + + len = remainder; } switch (optype) { @@ -1242,42 +1242,42 @@ Perl_do_kv(pTHX) (void)hv_iterinit(keys); /* always reset iterator regardless */ if (gimme == G_VOID) - RETURN; + RETURN; if (gimme == G_SCALAR) { - if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ - SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ - sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0); - LvTYPE(ret) = 'k'; - LvTARG(ret) = SvREFCNT_inc_simple(keys); - PUSHs(ret); - } - else { - IV i; - dTARGET; + if (PL_op->op_flags & OPf_MOD || LVRET) { /* lvalue */ + SV * const ret = sv_2mortal(newSV_type(SVt_PVLV)); /* Not TARG RT#67838 */ + sv_magic(ret, NULL, PERL_MAGIC_nkeys, NULL, 0); + LvTYPE(ret) = 'k'; + LvTARG(ret) = SvREFCNT_inc_simple(keys); + PUSHs(ret); + } + else { + IV i; + dTARGET; /* note that in 'scalar(keys %h)' the OP_KEYS is usually * optimised away and the action is performed directly by the * padhv or rv2hv op. We now only get here via OP_AVHVSWITCH * and \&CORE::keys */ - if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) { - i = HvUSEDKEYS(keys); - } - else { - i = 0; - while (hv_iternext(keys)) i++; - } - PUSHi( i ); - } - RETURN; + if (! SvTIED_mg((const SV *)keys, PERL_MAGIC_tied) ) { + i = HvUSEDKEYS(keys); + } + else { + i = 0; + while (hv_iternext(keys)) i++; + } + PUSHi( i ); + } + RETURN; } if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { - const I32 flags = is_lvalue_sub(); - if (flags && !(flags & OPpENTERSUB_INARGS)) - /* diag_listed_as: Can't modify %s in %s */ - Perl_croak(aTHX_ "Can't modify keys in list assignment"); + const I32 flags = is_lvalue_sub(); + if (flags && !(flags & OPpENTERSUB_INARGS)) + /* diag_listed_as: Can't modify %s in %s */ + Perl_croak(aTHX_ "Can't modify keys in list assignment"); } PUTBACK; diff --git a/dosish.h b/dosish.h index 3580693c90c1..74aa1270556e 100644 --- a/dosish.h +++ b/dosish.h @@ -17,7 +17,7 @@ # define BIT_BUCKET "nul" # define OP_BINARY O_BINARY # define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v); PERLIO_INIT + MALLOC_CHECK_TAINT2(*c,*v) Perl_DJGPP_init(c,v); PERLIO_INIT # define init_os_extras Perl_init_os_extras # define HAS_UTIME # define HAS_KILL @@ -30,8 +30,8 @@ # define PERL_FS_VER_FMT "%d_%d_%d" # endif # define PERL_FS_VERSION STRINGIFY(PERL_REVISION) "_" \ - STRINGIFY(PERL_VERSION) "_" \ - STRINGIFY(PERL_SUBVERSION) + STRINGIFY(PERL_VERSION) "_" \ + STRINGIFY(PERL_SUBVERSION) #elif defined(WIN32) # define PERL_SYS_INIT_BODY(c,v) \ MALLOC_CHECK_TAINT2(*c,*v) Perl_win32_init(c,v); PERLIO_INIT diff --git a/dquote.c b/dquote.c index dcbd8c93ac03..8fc4e689fb5a 100644 --- a/dquote.c +++ b/dquote.c @@ -117,7 +117,7 @@ Perl_form_alien_digit_msg(pTHX_ /* It also isn't a UTF-8 invariant character, so no display shortcuts * are available. Use \\x{...} */ - Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad); + Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad); } /* Ready to start building the message */ @@ -286,8 +286,8 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, (*s)++; if (send <= *s || **s != '{') { - *message = "Missing braces on \\o{}"; - return FALSE; + *message = "Missing braces on \\o{}"; + return FALSE; } e = (char *) memchr(*s, '}', send - *s); @@ -297,7 +297,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, (*s)++; } *message = "Missing right brace on \\o{}"; - return FALSE; + return FALSE; } (*s)++; /* Point to expected first digit (could be first byte of utf8 @@ -305,8 +305,8 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, numbers_len = e - *s; if (numbers_len == 0) { (*s)++; /* Move past the '}' */ - *message = "Empty \\o{}"; - return FALSE; + *message = "Empty \\o{}"; + return FALSE; } *uv = grok_oct(*s, &numbers_len, &flags, NULL); @@ -423,8 +423,8 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, if (**s != '{') { numbers_len = (strict) ? 3 : 2; - *uv = grok_hex(*s, &numbers_len, &flags, NULL); - *s += numbers_len; + *uv = grok_hex(*s, &numbers_len, &flags, NULL); + *s += numbers_len; if (numbers_len != 2 && (strict || (flags & PERL_SCAN_NOTIFY_ILLDIGIT))) { if (numbers_len == 3) { /* numbers_len 3 only happens with strict */ @@ -449,7 +449,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, } } } - return TRUE; + return TRUE; } e = (char *) memchr(*s, '}', send - *s); @@ -458,8 +458,8 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, while (*s < send && isXDIGIT(**s)) { /* Position beyond legal digits */ (*s)++; } - *message = "Missing right brace on \\x{}"; - return FALSE; + *message = "Missing right brace on \\x{}"; + return FALSE; } (*s)++; /* Point to expected first digit (could be first byte of utf8 diff --git a/dump.c b/dump.c index 0004f4995914..21dd53a65afa 100644 --- a/dump.c +++ b/dump.c @@ -75,11 +75,11 @@ struct flag_to_name { static void S_append_flags(pTHX_ SV *sv, U32 flags, const struct flag_to_name *start, - const struct flag_to_name *const end) + const struct flag_to_name *const end) { do { - if (flags & start->flag) - sv_catpv(sv, start->name); + if (flags & start->flag) + sv_catpv(sv, start->name); } while (++start < end); } @@ -172,7 +172,7 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, PERL_ARGS_ASSERT_PV_ESCAPE; if (dsv && !(flags & PERL_PV_ESCAPE_NOCLEAR)) { - /* This won't alter the UTF-8 flag */ + /* This won't alter the UTF-8 flag */ SvPVCLEAR(dsv); } @@ -184,9 +184,9 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, const U8 c = (U8)u & 0xFF; if ( ( u > 255 ) - || (flags & PERL_PV_ESCAPE_ALL) - || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM)))) - { + || (flags & PERL_PV_ESCAPE_ALL) + || (( ! isASCII(u) ) && (flags & (PERL_PV_ESCAPE_NONASCII|PERL_PV_ESCAPE_DWIM)))) + { if (flags & PERL_PV_ESCAPE_FIRSTCHAR) chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, "%" UVxf, u); @@ -200,28 +200,28 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, chsize = 1; } else { if ( (c == dq) || (c == esc) || !isPRINT(c) ) { - chsize = 2; + chsize = 2; switch (c) { - case '\\' : /* FALLTHROUGH */ - case '%' : if ( c == esc ) { - octbuf[1] = esc; - } else { - chsize = 1; - } - break; - case '\v' : octbuf[1] = 'v'; break; - case '\t' : octbuf[1] = 't'; break; - case '\r' : octbuf[1] = 'r'; break; - case '\n' : octbuf[1] = 'n'; break; - case '\f' : octbuf[1] = 'f'; break; + case '\\' : /* FALLTHROUGH */ + case '%' : if ( c == esc ) { + octbuf[1] = esc; + } else { + chsize = 1; + } + break; + case '\v' : octbuf[1] = 'v'; break; + case '\t' : octbuf[1] = 't'; break; + case '\r' : octbuf[1] = 'r'; break; + case '\n' : octbuf[1] = 'n'; break; + case '\f' : octbuf[1] = 'f'; break; case '"' : if ( dq == '"' ) - octbuf[1] = '"'; + octbuf[1] = '"'; else chsize = 1; break; - default: + default: if ( (flags & PERL_PV_ESCAPE_DWIM) && c != '\0' ) { chsize = my_snprintf( octbuf, PV_ESCAPE_OCTBUFSIZE, isuni ? "%cx{%02" UVxf "}" : "%cx%02" UVxf, @@ -237,24 +237,24 @@ Perl_pv_escape( pTHX_ SV *dsv, char const * const str, } else { chsize = 1; } - } - if ( max && (wrote + chsize > max) ) { - break; + } + if ( max && (wrote + chsize > max) ) { + break; } else if (chsize > 1) { if (dsv) sv_catpvn(dsv, octbuf, chsize); wrote += chsize; - } else { - /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes - can be appended raw to the dsv. If dsv happens to be - UTF-8 then we need catpvf to upgrade them for us. - Or add a new API call sv_catpvc(). Think about that name, and - how to keep it clear that it's unlike the s of catpvs, which is - really an array of octets, not a string. */ + } else { + /* If PERL_PV_ESCAPE_NOBACKSLASH is set then non-ASCII bytes + can be appended raw to the dsv. If dsv happens to be + UTF-8 then we need catpvf to upgrade them for us. + Or add a new API call sv_catpvc(). Think about that name, and + how to keep it clear that it's unlike the s of catpvs, which is + really an array of octets, not a string. */ if (dsv) Perl_sv_catpvf( aTHX_ dsv, "%c", c); - wrote++; - } + wrote++; + } if ( flags & PERL_PV_ESCAPE_FIRSTCHAR ) break; } @@ -335,7 +335,7 @@ Perl_pv_pretty( pTHX_ SV *dsv, char const * const str, const STRLEN count, Perl_sv_catpvf(aTHX_ dsv, "%c", quotes[1]); if ( (flags & PERL_PV_PRETTY_ELLIPSES) && ( escaped < count ) ) - sv_catpvs(dsv, "..."); + sv_catpvs(dsv, "..."); if ((flags & PERL_PV_PRETTY_EXACTSIZE)) { while( SvCUR(dsv) - orig_cur < max ) @@ -381,80 +381,80 @@ Perl_sv_peek(pTHX_ SV *sv) SvPVCLEAR(t); retry: if (!sv) { - sv_catpvs(t, "VOID"); - goto finish; + sv_catpvs(t, "VOID"); + goto finish; } else if (sv == (const SV *)0x55555555 || ((char)SvTYPE(sv)) == 'U') { /* detect data corruption under memory poisoning */ - sv_catpvs(t, "WILD"); - goto finish; + sv_catpvs(t, "WILD"); + goto finish; } else if ( sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_zero || sv == &PL_sv_placeholder) { - if (sv == &PL_sv_undef) { - sv_catpvs(t, "SV_UNDEF"); - if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| - SVs_GMG|SVs_SMG|SVs_RMG)) && - SvREADONLY(sv)) - goto finish; - } - else if (sv == &PL_sv_no) { - sv_catpvs(t, "SV_NO"); - if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| - SVs_GMG|SVs_SMG|SVs_RMG)) && - !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| - SVp_POK|SVp_NOK)) && - SvCUR(sv) == 0 && - SvNVX(sv) == 0.0) - goto finish; - } - else if (sv == &PL_sv_yes) { - sv_catpvs(t, "SV_YES"); - if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| - SVs_GMG|SVs_SMG|SVs_RMG)) && - !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| - SVp_POK|SVp_NOK)) && - SvCUR(sv) == 1 && - SvPVX_const(sv) && *SvPVX_const(sv) == '1' && - SvNVX(sv) == 1.0) - goto finish; - } - else if (sv == &PL_sv_zero) { - sv_catpvs(t, "SV_ZERO"); - if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| - SVs_GMG|SVs_SMG|SVs_RMG)) && - !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| - SVp_POK|SVp_NOK)) && - SvCUR(sv) == 1 && - SvPVX_const(sv) && *SvPVX_const(sv) == '0' && - SvNVX(sv) == 0.0) - goto finish; - } - else { - sv_catpvs(t, "SV_PLACEHOLDER"); - if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| - SVs_GMG|SVs_SMG|SVs_RMG)) && - SvREADONLY(sv)) - goto finish; - } - sv_catpvs(t, ":"); + if (sv == &PL_sv_undef) { + sv_catpvs(t, "SV_UNDEF"); + if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + SvREADONLY(sv)) + goto finish; + } + else if (sv == &PL_sv_no) { + sv_catpvs(t, "SV_NO"); + if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| + SVp_POK|SVp_NOK)) && + SvCUR(sv) == 0 && + SvNVX(sv) == 0.0) + goto finish; + } + else if (sv == &PL_sv_yes) { + sv_catpvs(t, "SV_YES"); + if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| + SVp_POK|SVp_NOK)) && + SvCUR(sv) == 1 && + SvPVX_const(sv) && *SvPVX_const(sv) == '1' && + SvNVX(sv) == 1.0) + goto finish; + } + else if (sv == &PL_sv_zero) { + sv_catpvs(t, "SV_ZERO"); + if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + !(~SvFLAGS(sv) & (SVf_POK|SVf_NOK|SVf_READONLY| + SVp_POK|SVp_NOK)) && + SvCUR(sv) == 1 && + SvPVX_const(sv) && *SvPVX_const(sv) == '0' && + SvNVX(sv) == 0.0) + goto finish; + } + else { + sv_catpvs(t, "SV_PLACEHOLDER"); + if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + SvREADONLY(sv)) + goto finish; + } + sv_catpvs(t, ":"); } else if (SvREFCNT(sv) == 0) { - sv_catpvs(t, "("); - unref++; + sv_catpvs(t, "("); + unref++; } else if (DEBUG_R_TEST_) { - int is_tmp = 0; - SSize_t ix; - /* is this SV on the tmps stack? */ - for (ix=PL_tmps_ix; ix>=0; ix--) { - if (PL_tmps_stack[ix] == sv) { - is_tmp = 1; - break; - } - } - if (is_tmp || SvREFCNT(sv) > 1) { + int is_tmp = 0; + SSize_t ix; + /* is this SV on the tmps stack? */ + for (ix=PL_tmps_ix; ix>=0; ix--) { + if (PL_tmps_stack[ix] == sv) { + is_tmp = 1; + break; + } + } + if (is_tmp || SvREFCNT(sv) > 1) { Perl_sv_catpvf(aTHX_ t, "<"); if (SvREFCNT(sv) > 1) Perl_sv_catpvf(aTHX_ t, "%" UVuf, (UV)SvREFCNT(sv)); @@ -465,15 +465,15 @@ Perl_sv_peek(pTHX_ SV *sv) } if (SvROK(sv)) { - sv_catpvs(t, "\\"); - if (SvCUR(t) + unref > 10) { - SvCUR_set(t, unref + 3); - *SvEND(t) = '\0'; - sv_catpvs(t, "..."); - goto finish; - } - sv = SvRV(sv); - goto retry; + sv_catpvs(t, "\\"); + if (SvCUR(t) + unref > 10) { + SvCUR_set(t, unref + 3); + *SvEND(t) = '\0'; + sv_catpvs(t, "..."); + goto finish; + } + sv = SvRV(sv); + goto retry; } type = SvTYPE(sv); if (type == SVt_PVCV) { @@ -482,56 +482,56 @@ Perl_sv_peek(pTHX_ SV *sv) Perl_sv_catpvf(aTHX_ t, "CV(%s)", gvcv ? generic_pv_escape( tmp, GvNAME(gvcv), GvNAMELEN(gvcv), GvNAMEUTF8(gvcv)) : ""); - goto finish; + goto finish; } else if (type < SVt_LAST) { - sv_catpv(t, svshorttypenames[type]); + sv_catpv(t, svshorttypenames[type]); - if (type == SVt_NULL) - goto finish; + if (type == SVt_NULL) + goto finish; } else { - sv_catpvs(t, "FREED"); - goto finish; + sv_catpvs(t, "FREED"); + goto finish; } if (SvPOKp(sv)) { - if (!SvPVX_const(sv)) - sv_catpvs(t, "(null)"); - else { - SV * const tmp = newSVpvs(""); - sv_catpvs(t, "("); - if (SvOOK(sv)) { - STRLEN delta; - SvOOK_offset(sv, delta); - Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127)); - } - Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); - if (SvUTF8(sv)) - Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", - sv_uni_display(tmp, sv, 6 * SvCUR(sv), - UNI_DISPLAY_QQ)); - SvREFCNT_dec_NN(tmp); - } + if (!SvPVX_const(sv)) + sv_catpvs(t, "(null)"); + else { + SV * const tmp = newSVpvs(""); + sv_catpvs(t, "("); + if (SvOOK(sv)) { + STRLEN delta; + SvOOK_offset(sv, delta); + Perl_sv_catpvf(aTHX_ t, "[%s]", pv_display(tmp, SvPVX_const(sv)-delta, delta, 0, 127)); + } + Perl_sv_catpvf(aTHX_ t, "%s)", pv_display(tmp, SvPVX_const(sv), SvCUR(sv), SvLEN(sv), 127)); + if (SvUTF8(sv)) + Perl_sv_catpvf(aTHX_ t, " [UTF8 \"%s\"]", + sv_uni_display(tmp, sv, 6 * SvCUR(sv), + UNI_DISPLAY_QQ)); + SvREFCNT_dec_NN(tmp); + } } else if (SvNOKp(sv)) { DECLARATION_FOR_LC_NUMERIC_MANIPULATION; STORE_LC_NUMERIC_SET_STANDARD(); - Perl_sv_catpvf(aTHX_ t, "(%" NVgf ")",SvNVX(sv)); + Perl_sv_catpvf(aTHX_ t, "(%" NVgf ")",SvNVX(sv)); RESTORE_LC_NUMERIC(); } else if (SvIOKp(sv)) { - if (SvIsUV(sv)) - Perl_sv_catpvf(aTHX_ t, "(%" UVuf ")", (UV)SvUVX(sv)); - else + if (SvIsUV(sv)) + Perl_sv_catpvf(aTHX_ t, "(%" UVuf ")", (UV)SvUVX(sv)); + else Perl_sv_catpvf(aTHX_ t, "(%" IVdf ")", (IV)SvIVX(sv)); } else - sv_catpvs(t, "()"); + sv_catpvs(t, "()"); finish: while (unref--) - sv_catpvs(t, ")"); + sv_catpvs(t, ")"); if (TAINTING_get && sv && SvTAINTED(sv)) - sv_catpvs(t, " [tainted]"); + sv_catpvs(t, " [tainted]"); return SvPV_nolen(t); } @@ -609,7 +609,7 @@ S_opdump_indent(pTHX_ const OP *o, I32 level, UV bar, PerlIO *file, } else - PerlIO_printf(file, " "); + PerlIO_printf(file, " "); for (i = level-1; i >= 0; i--) PerlIO_puts(file, @@ -660,7 +660,7 @@ Perl_dump_all_perl(pTHX_ bool justperl) { PerlIO_setlinebuf(Perl_debug_log); if (PL_main_root) - op_dump(PL_main_root); + op_dump(PL_main_root); dump_packsubs_perl(PL_defstash, justperl); } @@ -687,26 +687,26 @@ Perl_dump_packsubs_perl(pTHX_ const HV *stash, bool justperl) PERL_ARGS_ASSERT_DUMP_PACKSUBS_PERL; if (!HvARRAY(stash)) - return; + return; for (i = 0; i <= (I32) HvMAX(stash); i++) { const HE *entry; - for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { - GV * gv = (GV *)HeVAL(entry); + for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { + GV * gv = (GV *)HeVAL(entry); if (SvROK(gv) && SvTYPE(SvRV(gv)) == SVt_PVCV) /* unfake a fake GV */ (void)CvGV(SvRV(gv)); - if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) - continue; - if (GvCVu(gv)) - dump_sub_perl(gv, justperl); - if (GvFORM(gv)) - dump_form(gv); - if (HeKEY(entry)[HeKLEN(entry)-1] == ':') { - const HV * const hv = GvHV(gv); - if (hv && (hv != PL_defstash)) - dump_packsubs_perl(hv, justperl); /* nested package */ - } - } + if (SvTYPE(gv) != SVt_PVGV || !GvGP(gv)) + continue; + if (GvCVu(gv)) + dump_sub_perl(gv, justperl); + if (GvFORM(gv)) + dump_form(gv); + if (HeKEY(entry)[HeKLEN(entry)-1] == ':') { + const HV * const hv = GvHV(gv); + if (hv && (hv != PL_defstash)) + dump_packsubs_perl(hv, justperl); /* nested package */ + } + } } } @@ -725,30 +725,30 @@ Perl_dump_sub_perl(pTHX_ const GV *gv, bool justperl) PERL_ARGS_ASSERT_DUMP_SUB_PERL; cv = isGV_with_GP(gv) ? GvCV(gv) : - (assert(SvROK((SV*)gv)), (CV*)SvRV((SV*)gv)); + (assert(SvROK((SV*)gv)), (CV*)SvRV((SV*)gv)); if (justperl && (CvISXSUB(cv) || !CvROOT(cv))) - return; + return; if (isGV_with_GP(gv)) { - SV * const namesv = newSVpvs_flags("", SVs_TEMP); - SV *escsv = newSVpvs_flags("", SVs_TEMP); - const char *namepv; - STRLEN namelen; - gv_fullname3(namesv, gv, NULL); - namepv = SvPV_const(namesv, namelen); - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", - generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv))); + SV * const namesv = newSVpvs_flags("", SVs_TEMP); + SV *escsv = newSVpvs_flags("", SVs_TEMP); + const char *namepv; + STRLEN namelen; + gv_fullname3(namesv, gv, NULL); + namepv = SvPV_const(namesv, namelen); + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB %s = ", + generic_pv_escape(escsv, namepv, namelen, SvUTF8(namesv))); } else { - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = "); + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nSUB = "); } if (CvISXSUB(cv)) - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n", - PTR2UV(CvXSUB(cv)), - (int)CvXSUBANY(cv).any_i32); + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "(xsub 0x%" UVxf " %d)\n", + PTR2UV(CvXSUB(cv)), + (int)CvXSUBANY(cv).any_i32); else if (CvROOT(cv)) - op_dump(CvROOT(cv)); + op_dump(CvROOT(cv)); else - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n"); + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n"); } void @@ -761,9 +761,9 @@ Perl_dump_form(pTHX_ const GV *gv) gv_fullname3(sv, gv, NULL); Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\nFORMAT %s = ", SvPVX_const(sv)); if (CvROOT(GvFORM(gv))) - op_dump(CvROOT(GvFORM(gv))); + op_dump(CvROOT(GvFORM(gv))); else - Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n"); + Perl_dump_indent(aTHX_ 0, Perl_debug_log, "\n"); } void @@ -815,23 +815,23 @@ S_do_pmop_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const PMOP *pm) UV kidbar; if (!pm) - return; + return; kidbar = ((bar << 1) | cBOOL(pm->op_flags & OPf_KIDS)) << 1; if (PM_GETRE(pm)) { char ch = (pm->op_pmflags & PMf_ONCE) ? '?' : '/'; - S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE %c%.*s%c\n", - ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch); + S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE %c%.*s%c\n", + ch,(int)RX_PRELEN(PM_GETRE(pm)), RX_PRECOMP(PM_GETRE(pm)), ch); } else - S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE (RUNTIME)\n"); + S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_PRE (RUNTIME)\n"); if (pm->op_pmflags || (PM_GETRE(pm) && RX_CHECK_SUBSTR(PM_GETRE(pm)))) { - SV * const tmpsv = pm_description(pm); - S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMFLAGS = (%s)\n", + SV * const tmpsv = pm_description(pm); + S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMFLAGS = (%s)\n", SvCUR(tmpsv) ? SvPVX_const(tmpsv) + 1 : ""); - SvREFCNT_dec_NN(tmpsv); + SvREFCNT_dec_NN(tmpsv); } if (pm->op_type == OP_SPLIT) @@ -841,21 +841,21 @@ S_do_pmop_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const PMOP *pm) else { if (pm->op_pmreplrootu.op_pmreplroot) { S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "PMf_REPL =\n"); - S_do_op_dump_bar(aTHX_ level + 2, + S_do_op_dump_bar(aTHX_ level + 2, (kidbar|cBOOL(OpHAS_SIBLING(pm->op_pmreplrootu.op_pmreplroot))), file, pm->op_pmreplrootu.op_pmreplroot); } } if (pm->op_code_list) { - if (pm->op_pmflags & PMf_CODELIST_PRIVATE) { - S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "CODE_LIST =\n"); - S_do_op_dump_bar(aTHX_ level + 2, + if (pm->op_pmflags & PMf_CODELIST_PRIVATE) { + S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "CODE_LIST =\n"); + S_do_op_dump_bar(aTHX_ level + 2, (kidbar | cBOOL(OpHAS_SIBLING(pm->op_code_list))), file, pm->op_code_list); - } - else - S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, + } + else + S_opdump_indent(aTHX_ (OP*)pm, level, bar, file, "CODE_LIST = 0x%" UVxf "\n", PTR2UV(pm->op_code_list)); } } @@ -892,7 +892,7 @@ S_pm_description(pTHX_ const PMOP *pm) PERL_ARGS_ASSERT_PM_DESCRIPTION; if (pmflags & PMf_ONCE) - sv_catpvs(desc, ",ONCE"); + sv_catpvs(desc, ",ONCE"); #ifdef USE_ITHREADS if (SvREADONLY(PL_regex_pad[pm->op_pmoffset])) sv_catpvs(desc, ":USED"); @@ -937,15 +937,15 @@ S_sequence_num(pTHX_ const OP *o) const char *key; STRLEN len; if (!o) - return 0; + return 0; op = newSVuv(PTR2UV(o)); sv_2mortal(op); key = SvPV_const(op, len); if (!PL_op_sequence) - PL_op_sequence = newHV(); + PL_op_sequence = newHV(); seq = hv_fetch(PL_op_sequence, key, len, 0); if (seq) - return SvUV(*seq); + return SvUV(*seq); (void)hv_store(PL_op_sequence, key, len, newSVuv(++PL_op_seq), 0); return PL_op_seq; } @@ -1042,7 +1042,7 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) } if (o->op_targ && optype != OP_NULL) - S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n", + S_opdump_indent(aTHX_ o, level, bar, file, "TARG = %ld\n", (long)o->op_targ); if (o->op_flags || o->op_slabbed || o->op_savefree || o->op_static) { @@ -1150,10 +1150,10 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) Perl_sv_catpvf(aTHX_ tmpsv, "0x%" UVxf, (UV)oppriv); } } - if (tmpsv && SvCUR(tmpsv)) { + if (tmpsv && SvCUR(tmpsv)) { S_opdump_indent(aTHX_ o, level, bar, file, "PRIVATE = (%s)\n", SvPVX_const(tmpsv) + 1); - } else + } else S_opdump_indent(aTHX_ o, level, bar, file, "PRIVATE = (0x%" UVxf ")\n", (UV)oppriv); } @@ -1163,36 +1163,36 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_GVSV: case OP_GV: #ifdef USE_ITHREADS - S_opdump_indent(aTHX_ o, level, bar, file, + S_opdump_indent(aTHX_ o, level, bar, file, "PADIX = %" IVdf "\n", (IV)cPADOPo->op_padix); #else S_opdump_indent(aTHX_ o, level, bar, file, "GV = %" SVf " (0x%" UVxf ")\n", SVfARG(S_gv_display(aTHX_ cGVOPo_gv)), PTR2UV(cGVOPo_gv)); #endif - break; + break; case OP_MULTIDEREF: { UNOP_AUX_item *items = cUNOP_AUXo->op_aux; UV i, count = items[-1].uv; - S_opdump_indent(aTHX_ o, level, bar, file, "ARGS = \n"); + S_opdump_indent(aTHX_ o, level, bar, file, "ARGS = \n"); for (i=0; i < count; i++) S_opdump_indent(aTHX_ o, level+1, (bar << 1), file, "%" UVuf " => 0x%" UVxf "\n", i, items[i].uv); - break; + break; } case OP_MULTICONCAT: - S_opdump_indent(aTHX_ o, level, bar, file, "NARGS = %" IVdf "\n", + S_opdump_indent(aTHX_ o, level, bar, file, "NARGS = %" IVdf "\n", (IV)cUNOP_AUXo->op_aux[PERL_MULTICONCAT_IX_NARGS].ssize); /* XXX really ought to dump each field individually, * but that's too much like hard work */ - S_opdump_indent(aTHX_ o, level, bar, file, "CONSTS = (%" SVf ")\n", + S_opdump_indent(aTHX_ o, level, bar, file, "CONSTS = (%" SVf ")\n", SVfARG(multiconcat_stringify(o))); - break; + break; case OP_CONST: case OP_HINTSEVAL: @@ -1201,21 +1201,21 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_METHOD_REDIR: case OP_METHOD_REDIR_SUPER: #ifndef USE_ITHREADS - /* with ITHREADS, consts are stored in the pad, and the right pad - * may not be active here, so skip */ - S_opdump_indent(aTHX_ o, level, bar, file, "SV = %s\n", + /* with ITHREADS, consts are stored in the pad, and the right pad + * may not be active here, so skip */ + S_opdump_indent(aTHX_ o, level, bar, file, "SV = %s\n", SvPEEK(cMETHOPx_meth(o))); #endif - break; + break; case OP_NULL: - if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE) - break; - /* FALLTHROUGH */ + if (o->op_targ != OP_NEXTSTATE && o->op_targ != OP_DBSTATE) + break; + /* FALLTHROUGH */ case OP_NEXTSTATE: case OP_DBSTATE: - if (CopLINE(cCOPo)) - S_opdump_indent(aTHX_ o, level, bar, file, "LINE = %" UVuf "\n", - (UV)CopLINE(cCOPo)); + if (CopLINE(cCOPo)) + S_opdump_indent(aTHX_ o, level, bar, file, "LINE = %" UVuf "\n", + (UV)CopLINE(cCOPo)); if (CopSTASHPV(cCOPo)) { SV* tmpsv = newSVpvs_flags("", SVs_TEMP); @@ -1240,17 +1240,17 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) S_opdump_indent(aTHX_ o, level, bar, file, "SEQ = %u\n", (unsigned int)cCOPo->cop_seq); - break; + break; case OP_ENTERITER: case OP_ENTERLOOP: - S_opdump_indent(aTHX_ o, level, bar, file, "REDO"); + S_opdump_indent(aTHX_ o, level, bar, file, "REDO"); S_opdump_link(aTHX_ o, cLOOPo->op_redoop, file); - S_opdump_indent(aTHX_ o, level, bar, file, "NEXT"); + S_opdump_indent(aTHX_ o, level, bar, file, "NEXT"); S_opdump_link(aTHX_ o, cLOOPo->op_nextop, file); - S_opdump_indent(aTHX_ o, level, bar, file, "LAST"); + S_opdump_indent(aTHX_ o, level, bar, file, "LAST"); S_opdump_link(aTHX_ o, cLOOPo->op_lastop, file); - break; + break; case OP_REGCOMP: case OP_SUBSTCONT: @@ -1269,33 +1269,33 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) case OP_ENTERWHEN: case OP_ENTERTRY: case OP_ONCE: - S_opdump_indent(aTHX_ o, level, bar, file, "OTHER"); + S_opdump_indent(aTHX_ o, level, bar, file, "OTHER"); S_opdump_link(aTHX_ o, cLOGOPo->op_other, file); - break; + break; case OP_SPLIT: case OP_MATCH: case OP_QR: case OP_SUBST: - S_do_pmop_dump_bar(aTHX_ level, bar, file, cPMOPo); - break; + S_do_pmop_dump_bar(aTHX_ level, bar, file, cPMOPo); + break; case OP_LEAVE: case OP_LEAVEEVAL: case OP_LEAVESUB: case OP_LEAVESUBLV: case OP_LEAVEWRITE: case OP_SCOPE: - if (o->op_private & OPpREFCOUNTED) - S_opdump_indent(aTHX_ o, level, bar, file, + if (o->op_private & OPpREFCOUNTED) + S_opdump_indent(aTHX_ o, level, bar, file, "REFCNT = %" UVuf "\n", (UV)o->op_targ); - break; + break; case OP_DUMP: case OP_GOTO: case OP_NEXT: case OP_LAST: case OP_REDO: - if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) - break; + if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS)) + break; { SV * const label = newSVpvs_flags("", SVs_TEMP); generic_pv_escape(label, cPVOPo->op_pv, strlen(cPVOPo->op_pv), 0); @@ -1310,8 +1310,8 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) if (o->op_private & OPpTRANS_USE_SVOP) { /* utf8: table stored as an inversion map */ #ifndef USE_ITHREADS - /* with ITHREADS, it is stored in the pad, and the right pad - * may not be active here, so skip */ + /* with ITHREADS, it is stored in the pad, and the right pad + * may not be active here, so skip */ S_opdump_indent(aTHX_ o, level, bar, file, "INVMAP = 0x%" UVxf "\n", PTR2UV(MUTABLE_SV(cSVOPo->op_sv))); @@ -1346,14 +1346,14 @@ S_do_op_dump_bar(pTHX_ I32 level, UV bar, PerlIO *file, const OP *o) default: - break; + break; } if (o->op_flags & OPf_KIDS) { - OP *kid; + OP *kid; level++; bar <<= 1; - for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) - S_do_op_dump_bar(aTHX_ level, + for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) + S_do_op_dump_bar(aTHX_ level, (bar | cBOOL(OpHAS_SIBLING(kid))), file, kid); } @@ -1390,8 +1390,8 @@ Perl_gv_dump(pTHX_ GV *gv) SV *sv, *tmp = newSVpvs_flags("", SVs_TEMP); if (!gv) { - PerlIO_printf(Perl_debug_log, "{}\n"); - return; + PerlIO_printf(Perl_debug_log, "{}\n"); + return; } sv = sv_newmortal(); PerlIO_printf(Perl_debug_log, "{\n"); @@ -1400,7 +1400,7 @@ Perl_gv_dump(pTHX_ GV *gv) Perl_dump_indent(aTHX_ 1, Perl_debug_log, "GV_NAME = %s", generic_pv_escape( tmp, name, len, SvUTF8(sv) )); if (gv != GvEGV(gv)) { - gv_efullname3(sv, GvEGV(gv), NULL); + gv_efullname3(sv, GvEGV(gv), NULL); name = SvPV_const(sv, len); Perl_dump_indent(aTHX_ 1, Perl_debug_log, "-> %s", generic_pv_escape( tmp, name, len, SvUTF8(sv) )); @@ -1416,8 +1416,8 @@ Perl_gv_dump(pTHX_ GV *gv) static const struct { const char type; const char *name; } magic_names[] = { #include "mg_names.inc" - /* this null string terminates the list */ - { 0, NULL }, + /* this null string terminates the list */ + { 0, NULL }, }; void @@ -1427,120 +1427,120 @@ Perl_do_magic_dump(pTHX_ I32 level, PerlIO *file, const MAGIC *mg, I32 nest, I32 for (; mg; mg = mg->mg_moremagic) { Perl_dump_indent(aTHX_ level, file, - " MAGIC = 0x%" UVxf "\n", PTR2UV(mg)); + " MAGIC = 0x%" UVxf "\n", PTR2UV(mg)); if (mg->mg_virtual) { const MGVTBL * const v = mg->mg_virtual; - if (v >= PL_magic_vtables - && v < PL_magic_vtables + magic_vtable_max) { - const U32 i = v - PL_magic_vtables; - Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]); - } - else - Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%" + if (v >= PL_magic_vtables + && v < PL_magic_vtables + magic_vtable_max) { + const U32 i = v - PL_magic_vtables; + Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = &PL_vtbl_%s\n", PL_magic_vtable_names[i]); + } + else + Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0x%" UVxf "\n", PTR2UV(v)); } - else - Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n"); - - if (mg->mg_private) - Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private); - - { - int n; - const char *name = NULL; - for (n = 0; magic_names[n].name; n++) { - if (mg->mg_type == magic_names[n].type) { - name = magic_names[n].name; - break; - } - } - if (name) - Perl_dump_indent(aTHX_ level, file, - " MG_TYPE = PERL_MAGIC_%s\n", name); - else - Perl_dump_indent(aTHX_ level, file, - " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type); - } + else + Perl_dump_indent(aTHX_ level, file, " MG_VIRTUAL = 0\n"); + + if (mg->mg_private) + Perl_dump_indent(aTHX_ level, file, " MG_PRIVATE = %d\n", mg->mg_private); + + { + int n; + const char *name = NULL; + for (n = 0; magic_names[n].name; n++) { + if (mg->mg_type == magic_names[n].type) { + name = magic_names[n].name; + break; + } + } + if (name) + Perl_dump_indent(aTHX_ level, file, + " MG_TYPE = PERL_MAGIC_%s\n", name); + else + Perl_dump_indent(aTHX_ level, file, + " MG_TYPE = UNKNOWN(\\%o)\n", mg->mg_type); + } if (mg->mg_flags) { Perl_dump_indent(aTHX_ level, file, " MG_FLAGS = 0x%02X\n", mg->mg_flags); - if (mg->mg_type == PERL_MAGIC_envelem && - mg->mg_flags & MGf_TAINTEDDIR) - Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n"); - if (mg->mg_type == PERL_MAGIC_regex_global && - mg->mg_flags & MGf_MINMATCH) - Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); - if (mg->mg_flags & MGf_REFCOUNTED) - Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n"); + if (mg->mg_type == PERL_MAGIC_envelem && + mg->mg_flags & MGf_TAINTEDDIR) + Perl_dump_indent(aTHX_ level, file, " TAINTEDDIR\n"); + if (mg->mg_type == PERL_MAGIC_regex_global && + mg->mg_flags & MGf_MINMATCH) + Perl_dump_indent(aTHX_ level, file, " MINMATCH\n"); + if (mg->mg_flags & MGf_REFCOUNTED) + Perl_dump_indent(aTHX_ level, file, " REFCOUNTED\n"); if (mg->mg_flags & MGf_GSKIP) - Perl_dump_indent(aTHX_ level, file, " GSKIP\n"); - if (mg->mg_flags & MGf_COPY) - Perl_dump_indent(aTHX_ level, file, " COPY\n"); - if (mg->mg_flags & MGf_DUP) - Perl_dump_indent(aTHX_ level, file, " DUP\n"); - if (mg->mg_flags & MGf_LOCAL) - Perl_dump_indent(aTHX_ level, file, " LOCAL\n"); - if (mg->mg_type == PERL_MAGIC_regex_global && - mg->mg_flags & MGf_BYTES) - Perl_dump_indent(aTHX_ level, file, " BYTES\n"); + Perl_dump_indent(aTHX_ level, file, " GSKIP\n"); + if (mg->mg_flags & MGf_COPY) + Perl_dump_indent(aTHX_ level, file, " COPY\n"); + if (mg->mg_flags & MGf_DUP) + Perl_dump_indent(aTHX_ level, file, " DUP\n"); + if (mg->mg_flags & MGf_LOCAL) + Perl_dump_indent(aTHX_ level, file, " LOCAL\n"); + if (mg->mg_type == PERL_MAGIC_regex_global && + mg->mg_flags & MGf_BYTES) + Perl_dump_indent(aTHX_ level, file, " BYTES\n"); } - if (mg->mg_obj) { - Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%" UVxf "\n", - PTR2UV(mg->mg_obj)); + if (mg->mg_obj) { + Perl_dump_indent(aTHX_ level, file, " MG_OBJ = 0x%" UVxf "\n", + PTR2UV(mg->mg_obj)); if (mg->mg_type == PERL_MAGIC_qr) { - REGEXP* const re = (REGEXP *)mg->mg_obj; - SV * const dsv = sv_newmortal(); + REGEXP* const re = (REGEXP *)mg->mg_obj; + SV * const dsv = sv_newmortal(); const char * const s - = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re), + = pv_pretty(dsv, RX_WRAPPED(re), RX_WRAPLEN(re), 60, NULL, NULL, ( PERL_PV_PRETTY_QUOTE | PERL_PV_ESCAPE_RE | PERL_PV_PRETTY_ELLIPSES | (RX_UTF8(re) ? PERL_PV_ESCAPE_UNI : 0)) ); - Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s); - Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %" IVdf "\n", - (IV)RX_REFCNT(re)); + Perl_dump_indent(aTHX_ level+1, file, " PAT = %s\n", s); + Perl_dump_indent(aTHX_ level+1, file, " REFCNT = %" IVdf "\n", + (IV)RX_REFCNT(re)); } if (mg->mg_flags & MGf_REFCOUNTED) - do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ - } + do_sv_dump(level+2, file, mg->mg_obj, nest+1, maxnest, dumpops, pvlim); /* MG is already +1 */ + } if (mg->mg_len) - Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len); + Perl_dump_indent(aTHX_ level, file, " MG_LEN = %ld\n", (long)mg->mg_len); if (mg->mg_ptr) { - Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%" UVxf, PTR2UV(mg->mg_ptr)); - if (mg->mg_len >= 0) { - if (mg->mg_type != PERL_MAGIC_utf8) { - SV * const sv = newSVpvs(""); - PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); - SvREFCNT_dec_NN(sv); - } + Perl_dump_indent(aTHX_ level, file, " MG_PTR = 0x%" UVxf, PTR2UV(mg->mg_ptr)); + if (mg->mg_len >= 0) { + if (mg->mg_type != PERL_MAGIC_utf8) { + SV * const sv = newSVpvs(""); + PerlIO_printf(file, " %s", pv_display(sv, mg->mg_ptr, mg->mg_len, 0, pvlim)); + SvREFCNT_dec_NN(sv); + } + } + else if (mg->mg_len == HEf_SVKEY) { + PerlIO_puts(file, " => HEf_SVKEY\n"); + do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1, + maxnest, dumpops, pvlim); /* MG is already +1 */ + continue; } - else if (mg->mg_len == HEf_SVKEY) { - PerlIO_puts(file, " => HEf_SVKEY\n"); - do_sv_dump(level+2, file, MUTABLE_SV(((mg)->mg_ptr)), nest+1, - maxnest, dumpops, pvlim); /* MG is already +1 */ - continue; - } - else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8); - else - PerlIO_puts( - file, - " ???? - " __FILE__ - " does not know how to handle this MG_LEN" - ); + else if (mg->mg_len == -1 && mg->mg_type == PERL_MAGIC_utf8); + else + PerlIO_puts( + file, + " ???? - " __FILE__ + " does not know how to handle this MG_LEN" + ); (void)PerlIO_putc(file, '\n'); } - if (mg->mg_type == PERL_MAGIC_utf8) { - const STRLEN * const cache = (STRLEN *) mg->mg_ptr; - if (cache) { - IV i; - for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++) - Perl_dump_indent(aTHX_ level, file, - " %2" IVdf ": %" UVuf " -> %" UVuf "\n", - i, - (UV)cache[i * 2], - (UV)cache[i * 2 + 1]); - } - } + if (mg->mg_type == PERL_MAGIC_utf8) { + const STRLEN * const cache = (STRLEN *) mg->mg_ptr; + if (cache) { + IV i; + for (i = 0; i < PERL_MAGIC_UTF8_CACHESIZE; i++) + Perl_dump_indent(aTHX_ level, file, + " %2" IVdf ": %" UVuf " -> %" UVuf "\n", + i, + (UV)cache[i * 2], + (UV)cache[i * 2 + 1]); + } + } } } @@ -1560,7 +1560,7 @@ Perl_do_hv_dump(pTHX_ I32 level, PerlIO *file, const char *name, HV *sv) Perl_dump_indent(aTHX_ level, file, "%s = 0x%" UVxf, name, PTR2UV(sv)); if (sv && (hvname = HvNAME_get(sv))) { - /* we have to use pv_display and HvNAMELEN_get() so that we display the real package + /* we have to use pv_display and HvNAMELEN_get() so that we display the real package name which quite legally could contain insane things like tabs, newlines, nulls or other scary crap - this should produce sane results - except maybe for unicode package names - but we will wait for someone to file a bug on that - demerphq */ @@ -1596,11 +1596,11 @@ Perl_do_gvgv_dump(pTHX_ I32 level, PerlIO *file, const char *name, GV *sv) Perl_dump_indent(aTHX_ level, file, "%s = 0x%" UVxf, name, PTR2UV(sv)); if (sv && GvNAME(sv)) { SV *tmp = newSVpvs_flags("", SVs_TEMP); - const char *hvname; + const char *hvname; HV * const stash = GvSTASH(sv); - PerlIO_printf(file, "\t"); + PerlIO_printf(file, "\t"); /* TODO might have an extra \" here */ - if (stash && (hvname = HvNAME_get(stash))) { + if (stash && (hvname = HvNAME_get(stash))) { PerlIO_printf(file, "\"%s\" :: \"", generic_pv_escape(tmp, hvname, HvNAMELEN(stash), HvNAMEUTF8(stash))); @@ -1743,8 +1743,8 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo PERL_ARGS_ASSERT_DO_SV_DUMP; if (!sv) { - Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); - return; + Perl_dump_indent(aTHX_ level, file, "SV = 0\n"); + return; } flags = SvFLAGS(sv); @@ -1753,28 +1753,28 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo /* process general SV flags */ d = Perl_newSVpvf(aTHX_ - "(0x%" UVxf ") at 0x%" UVxf "\n%*s REFCNT = %" IVdf "\n%*s FLAGS = (", - PTR2UV(SvANY(sv)), PTR2UV(sv), - (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), - (int)(PL_dumpindent*level), ""); + "(0x%" UVxf ") at 0x%" UVxf "\n%*s REFCNT = %" IVdf "\n%*s FLAGS = (", + PTR2UV(SvANY(sv)), PTR2UV(sv), + (int)(PL_dumpindent*level), "", (IV)SvREFCNT(sv), + (int)(PL_dumpindent*level), ""); if ((flags & SVs_PADSTALE)) - sv_catpvs(d, "PADSTALE,"); + sv_catpvs(d, "PADSTALE,"); if ((flags & SVs_PADTMP)) - sv_catpvs(d, "PADTMP,"); + sv_catpvs(d, "PADTMP,"); append_flags(d, flags, first_sv_flags_names); if (flags & SVf_ROK) { sv_catpvs(d, "ROK,"); - if (SvWEAKREF(sv)) sv_catpvs(d, "WEAKREF,"); + if (SvWEAKREF(sv)) sv_catpvs(d, "WEAKREF,"); } if (flags & SVf_IsCOW && type != SVt_PVHV) sv_catpvs(d, "IsCOW,"); append_flags(d, flags, second_sv_flags_names); if (flags & SVp_SCREAM && type != SVt_PVHV && !isGV_with_GP(sv) - && type != SVt_PVAV) { - if (SvPCS_IMPORTED(sv)) - sv_catpvs(d, "PCS_IMPORTED,"); - else - sv_catpvs(d, "SCREAM,"); + && type != SVt_PVAV) { + if (SvPCS_IMPORTED(sv)) + sv_catpvs(d, "PCS_IMPORTED,"); + else + sv_catpvs(d, "SCREAM,"); } /* process type-specific SV flags */ @@ -1782,34 +1782,34 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo switch (type) { case SVt_PVCV: case SVt_PVFM: - append_flags(d, CvFLAGS(sv), cv_flags_names); - break; + append_flags(d, CvFLAGS(sv), cv_flags_names); + break; case SVt_PVHV: - append_flags(d, flags, hv_flags_names); - break; + append_flags(d, flags, hv_flags_names); + break; case SVt_PVGV: case SVt_PVLV: - if (isGV_with_GP(sv)) { - append_flags(d, GvFLAGS(sv), gp_flags_names); - } - if (isGV_with_GP(sv) && GvIMPORTED(sv)) { - sv_catpvs(d, "IMPORT"); - if (GvIMPORTED(sv) == GVf_IMPORTED) - sv_catpvs(d, "ALL,"); - else { - sv_catpvs(d, "("); - append_flags(d, GvFLAGS(sv), gp_flags_imported_names); - sv_catpvs(d, " ),"); - } - } - /* FALLTHROUGH */ + if (isGV_with_GP(sv)) { + append_flags(d, GvFLAGS(sv), gp_flags_names); + } + if (isGV_with_GP(sv) && GvIMPORTED(sv)) { + sv_catpvs(d, "IMPORT"); + if (GvIMPORTED(sv) == GVf_IMPORTED) + sv_catpvs(d, "ALL,"); + else { + sv_catpvs(d, "("); + append_flags(d, GvFLAGS(sv), gp_flags_imported_names); + sv_catpvs(d, " ),"); + } + } + /* FALLTHROUGH */ case SVt_PVMG: default: - if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpvs(d, "IsUV,"); - break; + if (SvIsUV(sv) && !(flags & SVf_ROK)) sv_catpvs(d, "IsUV,"); + break; case SVt_PVAV: - break; + break; } /* SVphv_SHAREKEYS is also 0x20000000 */ if ((type != SVt_PVHV) && SvUTF8(sv)) @@ -1817,7 +1817,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo if (*(SvEND(d) - 1) == ',') { SvCUR_set(d, SvCUR(d) - 1); - SvPVX(d)[SvCUR(d)] = '\0'; + SvPVX(d)[SvCUR(d)] = '\0'; } sv_catpvs(d, ")"); s = SvPVX_const(d); @@ -1826,13 +1826,13 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo #ifdef DEBUG_LEAKING_SCALARS Perl_dump_indent(aTHX_ level, file, - "ALLOCATED at %s:%d %s %s (parent 0x%" UVxf "); serial %" UVuf "\n", - sv->sv_debug_file ? sv->sv_debug_file : "(unknown)", - sv->sv_debug_line, - sv->sv_debug_inpad ? "for" : "by", - sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)", - PTR2UV(sv->sv_debug_parent), - sv->sv_debug_serial + "ALLOCATED at %s:%d %s %s (parent 0x%" UVxf "); serial %" UVuf "\n", + sv->sv_debug_file ? sv->sv_debug_file : "(unknown)", + sv->sv_debug_line, + sv->sv_debug_inpad ? "for" : "by", + sv->sv_debug_optype ? PL_op_name[sv->sv_debug_optype]: "(none)", + PTR2UV(sv->sv_debug_parent), + sv->sv_debug_serial ); #endif Perl_dump_indent(aTHX_ level, file, "SV = "); @@ -1840,77 +1840,77 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo /* Dump SV type */ if (type < SVt_LAST) { - PerlIO_printf(file, "%s%s\n", svtypenames[type], s); + PerlIO_printf(file, "%s%s\n", svtypenames[type], s); - if (type == SVt_NULL) { - SvREFCNT_dec_NN(d); - return; - } + if (type == SVt_NULL) { + SvREFCNT_dec_NN(d); + return; + } } else { - PerlIO_printf(file, "UNKNOWN(0x%" UVxf ") %s\n", (UV)type, s); - SvREFCNT_dec_NN(d); - return; + PerlIO_printf(file, "UNKNOWN(0x%" UVxf ") %s\n", (UV)type, s); + SvREFCNT_dec_NN(d); + return; } /* Dump general SV fields */ if ((type >= SVt_PVIV && type != SVt_PVAV && type != SVt_PVHV - && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO - && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv)) - || (type == SVt_IV && !SvROK(sv))) { - if (SvIsUV(sv) - ) - Perl_dump_indent(aTHX_ level, file, " UV = %" UVuf, (UV)SvUVX(sv)); - else - Perl_dump_indent(aTHX_ level, file, " IV = %" IVdf, (IV)SvIVX(sv)); - (void)PerlIO_putc(file, '\n'); + && type != SVt_PVCV && type != SVt_PVFM && type != SVt_PVIO + && type != SVt_REGEXP && !isGV_with_GP(sv) && !SvVALID(sv)) + || (type == SVt_IV && !SvROK(sv))) { + if (SvIsUV(sv) + ) + Perl_dump_indent(aTHX_ level, file, " UV = %" UVuf, (UV)SvUVX(sv)); + else + Perl_dump_indent(aTHX_ level, file, " IV = %" IVdf, (IV)SvIVX(sv)); + (void)PerlIO_putc(file, '\n'); } if ((type >= SVt_PVNV && type != SVt_PVAV && type != SVt_PVHV - && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP - && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv)) - || type == SVt_NV) { + && type != SVt_PVCV && type != SVt_PVFM && type != SVt_REGEXP + && type != SVt_PVIO && !isGV_with_GP(sv) && !SvVALID(sv)) + || type == SVt_NV) { DECLARATION_FOR_LC_NUMERIC_MANIPULATION; STORE_LC_NUMERIC_SET_STANDARD(); - Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv)); + Perl_dump_indent(aTHX_ level, file, " NV = %.*" NVgf "\n", NV_DIG, SvNVX(sv)); RESTORE_LC_NUMERIC(); } if (SvROK(sv)) { - Perl_dump_indent(aTHX_ level, file, " RV = 0x%" UVxf "\n", + Perl_dump_indent(aTHX_ level, file, " RV = 0x%" UVxf "\n", PTR2UV(SvRV(sv))); - if (nest < maxnest) - do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); + if (nest < maxnest) + do_sv_dump(level+1, file, SvRV(sv), nest+1, maxnest, dumpops, pvlim); } if (type < SVt_PV) { - SvREFCNT_dec_NN(d); - return; + SvREFCNT_dec_NN(d); + return; } if ((type <= SVt_PVLV && !isGV_with_GP(sv)) || (type == SVt_PVIO && IoFLAGS(sv) & IOf_FAKE_DIRP)) { - const bool re = isREGEXP(sv); - const char * const ptr = - re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv); - if (ptr) { - STRLEN delta; - if (SvOOK(sv)) { - SvOOK_offset(sv, delta); - Perl_dump_indent(aTHX_ level, file," OFFSET = %" UVuf "\n", - (UV) delta); - } else { - delta = 0; - } - Perl_dump_indent(aTHX_ level, file," PV = 0x%" UVxf " ", + const bool re = isREGEXP(sv); + const char * const ptr = + re ? RX_WRAPPED((REGEXP*)sv) : SvPVX_const(sv); + if (ptr) { + STRLEN delta; + if (SvOOK(sv)) { + SvOOK_offset(sv, delta); + Perl_dump_indent(aTHX_ level, file," OFFSET = %" UVuf "\n", + (UV) delta); + } else { + delta = 0; + } + Perl_dump_indent(aTHX_ level, file," PV = 0x%" UVxf " ", PTR2UV(ptr)); - if (SvOOK(sv)) { - PerlIO_printf(file, "( %s . ) ", - pv_display(d, ptr - delta, delta, 0, - pvlim)); - } + if (SvOOK(sv)) { + PerlIO_printf(file, "( %s . ) ", + pv_display(d, ptr - delta, delta, 0, + pvlim)); + } if (type == SVt_INVLIST) { - PerlIO_printf(file, "\n"); + PerlIO_printf(file, "\n"); /* 4 blanks indents 2 beyond the PV, etc */ _invlist_dump(file, level, " ", sv); } @@ -1924,139 +1924,139 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo UNI_DISPLAY_QQ)); PerlIO_printf(file, "\n"); } - Perl_dump_indent(aTHX_ level, file, " CUR = %" IVdf "\n", (IV)SvCUR(sv)); - if (re && type == SVt_PVLV) + Perl_dump_indent(aTHX_ level, file, " CUR = %" IVdf "\n", (IV)SvCUR(sv)); + if (re && type == SVt_PVLV) /* LV-as-REGEXP usurps len field to store pointer to * regexp struct */ - Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%" UVxf "\n", + Perl_dump_indent(aTHX_ level, file, " REGEXP = 0x%" UVxf "\n", PTR2UV(((XPV*)SvANY(sv))->xpv_len_u.xpvlenu_rx)); else - Perl_dump_indent(aTHX_ level, file, " LEN = %" IVdf "\n", - (IV)SvLEN(sv)); + Perl_dump_indent(aTHX_ level, file, " LEN = %" IVdf "\n", + (IV)SvLEN(sv)); #ifdef PERL_COPY_ON_WRITE - if (SvIsCOW(sv) && SvLEN(sv)) - Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n", - CowREFCNT(sv)); + if (SvIsCOW(sv) && SvLEN(sv)) + Perl_dump_indent(aTHX_ level, file, " COW_REFCNT = %d\n", + CowREFCNT(sv)); #endif - } - else - Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); + } + else + Perl_dump_indent(aTHX_ level, file, " PV = 0\n"); } if (type >= SVt_PVMG) { - if (SvMAGIC(sv)) - do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim); - if (SvSTASH(sv)) - do_hv_dump(level, file, " STASH", SvSTASH(sv)); + if (SvMAGIC(sv)) + do_magic_dump(level, file, SvMAGIC(sv), nest+1, maxnest, dumpops, pvlim); + if (SvSTASH(sv)) + do_hv_dump(level, file, " STASH", SvSTASH(sv)); - if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) { - Perl_dump_indent(aTHX_ level, file, " USEFUL = %" IVdf "\n", + if ((type == SVt_PVMG || type == SVt_PVLV) && SvVALID(sv)) { + Perl_dump_indent(aTHX_ level, file, " USEFUL = %" IVdf "\n", (IV)BmUSEFUL(sv)); - } + } } /* Dump type-specific SV fields */ switch (type) { case SVt_PVAV: - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf, + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf, PTR2UV(AvARRAY(sv))); - if (AvARRAY(sv) != AvALLOC(sv)) { - PerlIO_printf(file, " (offset=%" IVdf ")\n", + if (AvARRAY(sv) != AvALLOC(sv)) { + PerlIO_printf(file, " (offset=%" IVdf ")\n", (IV)(AvARRAY(sv) - AvALLOC(sv))); - Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%" UVxf "\n", + Perl_dump_indent(aTHX_ level, file, " ALLOC = 0x%" UVxf "\n", PTR2UV(AvALLOC(sv))); - } - else + } + else (void)PerlIO_putc(file, '\n'); - Perl_dump_indent(aTHX_ level, file, " FILL = %" IVdf "\n", + Perl_dump_indent(aTHX_ level, file, " FILL = %" IVdf "\n", (IV)AvFILLp(sv)); - Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n", + Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n", (IV)AvMAX(sv)); SvPVCLEAR(d); - if (AvREAL(sv)) sv_catpvs(d, ",REAL"); - if (AvREIFY(sv)) sv_catpvs(d, ",REIFY"); - Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", - SvCUR(d) ? SvPVX_const(d) + 1 : ""); - if (nest < maxnest && AvARRAY(MUTABLE_AV(sv))) { - SSize_t count; + if (AvREAL(sv)) sv_catpvs(d, ",REAL"); + if (AvREIFY(sv)) sv_catpvs(d, ",REIFY"); + Perl_dump_indent(aTHX_ level, file, " FLAGS = (%s)\n", + SvCUR(d) ? SvPVX_const(d) + 1 : ""); + if (nest < maxnest && AvARRAY(MUTABLE_AV(sv))) { + SSize_t count; SV **svp = AvARRAY(MUTABLE_AV(sv)); - for (count = 0; + for (count = 0; count <= AvFILLp(MUTABLE_AV(sv)) && count < maxnest; count++, svp++) { - SV* const elt = *svp; - Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %" IVdf "\n", + SV* const elt = *svp; + Perl_dump_indent(aTHX_ level + 1, file, "Elt No. %" IVdf "\n", (IV)count); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); - } - } - break; + } + } + break; case SVt_PVHV: { - U32 usedkeys; + U32 usedkeys; if (SvOOK(sv)) { struct xpvhv_aux *const aux = HvAUX(sv); Perl_dump_indent(aTHX_ level, file, " AUX_FLAGS = %" UVuf "\n", (UV)aux->xhv_aux_flags); } - Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf, PTR2UV(HvARRAY(sv))); - usedkeys = HvUSEDKEYS(MUTABLE_HV(sv)); - if (HvARRAY(sv) && usedkeys) { - /* Show distribution of HEs in the ARRAY */ - int freq[200]; + Perl_dump_indent(aTHX_ level, file, " ARRAY = 0x%" UVxf, PTR2UV(HvARRAY(sv))); + usedkeys = HvUSEDKEYS(MUTABLE_HV(sv)); + if (HvARRAY(sv) && usedkeys) { + /* Show distribution of HEs in the ARRAY */ + int freq[200]; #define FREQ_MAX ((int)(C_ARRAY_LENGTH(freq) - 1)) - int i; - int max = 0; - U32 pow2 = 2, keys = usedkeys; - NV theoret, sum = 0; - - PerlIO_printf(file, " ("); - Zero(freq, FREQ_MAX + 1, int); - for (i = 0; (STRLEN)i <= HvMAX(sv); i++) { - HE* h; - int count = 0; + int i; + int max = 0; + U32 pow2 = 2, keys = usedkeys; + NV theoret, sum = 0; + + PerlIO_printf(file, " ("); + Zero(freq, FREQ_MAX + 1, int); + for (i = 0; (STRLEN)i <= HvMAX(sv); i++) { + HE* h; + int count = 0; for (h = HvARRAY(sv)[i]; h; h = HeNEXT(h)) - count++; - if (count > FREQ_MAX) - count = FREQ_MAX; - freq[count]++; - if (max < count) - max = count; - } - for (i = 0; i <= max; i++) { - if (freq[i]) { - PerlIO_printf(file, "%d%s:%d", i, - (i == FREQ_MAX) ? "+" : "", - freq[i]); - if (i != max) - PerlIO_printf(file, ", "); - } + count++; + if (count > FREQ_MAX) + count = FREQ_MAX; + freq[count]++; + if (max < count) + max = count; + } + for (i = 0; i <= max; i++) { + if (freq[i]) { + PerlIO_printf(file, "%d%s:%d", i, + (i == FREQ_MAX) ? "+" : "", + freq[i]); + if (i != max) + PerlIO_printf(file, ", "); + } } - (void)PerlIO_putc(file, ')'); - /* The "quality" of a hash is defined as the total number of - comparisons needed to access every element once, relative - to the expected number needed for a random hash. - - The total number of comparisons is equal to the sum of - the squares of the number of entries in each bucket. - For a random hash of n keys into k buckets, the expected - value is - n + n(n-1)/2k - */ - - for (i = max; i > 0; i--) { /* Precision: count down. */ - sum += freq[i] * i * i; + (void)PerlIO_putc(file, ')'); + /* The "quality" of a hash is defined as the total number of + comparisons needed to access every element once, relative + to the expected number needed for a random hash. + + The total number of comparisons is equal to the sum of + the squares of the number of entries in each bucket. + For a random hash of n keys into k buckets, the expected + value is + n + n(n-1)/2k + */ + + for (i = max; i > 0; i--) { /* Precision: count down. */ + sum += freq[i] * i * i; } - while ((keys = keys >> 1)) - pow2 = pow2 << 1; - theoret = usedkeys; - theoret += theoret * (theoret-1)/pow2; - (void)PerlIO_putc(file, '\n'); - Perl_dump_indent(aTHX_ level, file, " hash quality = %.1" + while ((keys = keys >> 1)) + pow2 = pow2 << 1; + theoret = usedkeys; + theoret += theoret * (theoret-1)/pow2; + (void)PerlIO_putc(file, '\n'); + Perl_dump_indent(aTHX_ level, file, " hash quality = %.1" NVff "%%", theoret/sum*100); - } - (void)PerlIO_putc(file, '\n'); - Perl_dump_indent(aTHX_ level, file, " KEYS = %" IVdf "\n", + } + (void)PerlIO_putc(file, '\n'); + Perl_dump_indent(aTHX_ level, file, " KEYS = %" IVdf "\n", (IV)usedkeys); { STRLEN count = 0; @@ -2075,15 +2075,15 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo Perl_dump_indent(aTHX_ level, file, " FILL = %" UVuf "\n", (UV)count); } - Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n", + Perl_dump_indent(aTHX_ level, file, " MAX = %" IVdf "\n", (IV)HvMAX(sv)); if (SvOOK(sv)) { - Perl_dump_indent(aTHX_ level, file, " RITER = %" IVdf "\n", + Perl_dump_indent(aTHX_ level, file, " RITER = %" IVdf "\n", (IV)HvRITER_get(sv)); - Perl_dump_indent(aTHX_ level, file, " EITER = 0x%" UVxf "\n", + Perl_dump_indent(aTHX_ level, file, " EITER = 0x%" UVxf "\n", PTR2UV(HvEITER_get(sv))); #ifdef PERL_HASH_RANDOMIZE_KEYS - Perl_dump_indent(aTHX_ level, file, " RAND = 0x%" UVxf, + Perl_dump_indent(aTHX_ level, file, " RAND = 0x%" UVxf, (UV)HvRAND_get(sv)); if (HvRAND_get(sv) != HvLASTRAND_get(sv) && HvRITER_get(sv) != -1 ) { PerlIO_printf(file, " (LAST = 0x%" UVxf ")", @@ -2092,254 +2092,254 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo #endif (void)PerlIO_putc(file, '\n'); } - { - MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab); - if (mg && mg->mg_obj) { - Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%" UVxf "\n", PTR2UV(mg->mg_obj)); - } - } - { - const char * const hvname = HvNAME_get(sv); - if (hvname) { + { + MAGIC * const mg = mg_find(sv, PERL_MAGIC_symtab); + if (mg && mg->mg_obj) { + Perl_dump_indent(aTHX_ level, file, " PMROOT = 0x%" UVxf "\n", PTR2UV(mg->mg_obj)); + } + } + { + const char * const hvname = HvNAME_get(sv); + if (hvname) { SV* tmpsv = newSVpvs_flags("", SVs_TEMP); Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", generic_pv_escape( tmpsv, hvname, HvNAMELEN(sv), HvNAMEUTF8(sv))); } - } - if (SvOOK(sv)) { - AV * const backrefs - = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv)); - struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta; - if (HvAUX(sv)->xhv_name_count) - Perl_dump_indent(aTHX_ - level, file, " NAMECOUNT = %" IVdf "\n", - (IV)HvAUX(sv)->xhv_name_count - ); - if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) { - const I32 count = HvAUX(sv)->xhv_name_count; - if (count) { - SV * const names = newSVpvs_flags("", SVs_TEMP); - /* The starting point is the first element if count is - positive and the second element if count is negative. */ - HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names - + (count < 0 ? 1 : 0); - HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names - + (count < 0 ? -count : count); - while (hekp < endp) { - if (*hekp) { + } + if (SvOOK(sv)) { + AV * const backrefs + = *Perl_hv_backreferences_p(aTHX_ MUTABLE_HV(sv)); + struct mro_meta * const meta = HvAUX(sv)->xhv_mro_meta; + if (HvAUX(sv)->xhv_name_count) + Perl_dump_indent(aTHX_ + level, file, " NAMECOUNT = %" IVdf "\n", + (IV)HvAUX(sv)->xhv_name_count + ); + if (HvAUX(sv)->xhv_name_u.xhvnameu_name && HvENAME_HEK_NN(sv)) { + const I32 count = HvAUX(sv)->xhv_name_count; + if (count) { + SV * const names = newSVpvs_flags("", SVs_TEMP); + /* The starting point is the first element if count is + positive and the second element if count is negative. */ + HEK *const *hekp = HvAUX(sv)->xhv_name_u.xhvnameu_names + + (count < 0 ? 1 : 0); + HEK *const *const endp = HvAUX(sv)->xhv_name_u.xhvnameu_names + + (count < 0 ? -count : count); + while (hekp < endp) { + if (*hekp) { SV *tmp = newSVpvs_flags("", SVs_TEMP); - Perl_sv_catpvf(aTHX_ names, ", \"%s\"", + Perl_sv_catpvf(aTHX_ names, ", \"%s\"", generic_pv_escape(tmp, HEK_KEY(*hekp), HEK_LEN(*hekp), HEK_UTF8(*hekp))); - } else { - /* This should never happen. */ - sv_catpvs(names, ", (null)"); - } - ++hekp; - } - Perl_dump_indent(aTHX_ - level, file, " ENAME = %s\n", SvPV_nolen(names)+2 - ); - } - else { + } else { + /* This should never happen. */ + sv_catpvs(names, ", (null)"); + } + ++hekp; + } + Perl_dump_indent(aTHX_ + level, file, " ENAME = %s\n", SvPV_nolen(names)+2 + ); + } + else { SV * const tmp = newSVpvs_flags("", SVs_TEMP); const char *const hvename = HvENAME_get(sv); - Perl_dump_indent(aTHX_ - level, file, " ENAME = \"%s\"\n", + Perl_dump_indent(aTHX_ + level, file, " ENAME = \"%s\"\n", generic_pv_escape(tmp, hvename, HvENAMELEN_get(sv), HvENAMEUTF8(sv))); } - } - if (backrefs) { - Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%" UVxf "\n", - PTR2UV(backrefs)); - do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest, - dumpops, pvlim); - } - if (meta) { - SV* tmpsv = newSVpvs_flags("", SVs_TEMP); - Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%" + } + if (backrefs) { + Perl_dump_indent(aTHX_ level, file, " BACKREFS = 0x%" UVxf "\n", + PTR2UV(backrefs)); + do_sv_dump(level+1, file, MUTABLE_SV(backrefs), nest+1, maxnest, + dumpops, pvlim); + } + if (meta) { + SV* tmpsv = newSVpvs_flags("", SVs_TEMP); + Perl_dump_indent(aTHX_ level, file, " MRO_WHICH = \"%s\" (0x%" UVxf ")\n", - generic_pv_escape( tmpsv, meta->mro_which->name, + generic_pv_escape( tmpsv, meta->mro_which->name, meta->mro_which->length, (meta->mro_which->kflags & HVhek_UTF8)), - PTR2UV(meta->mro_which)); - Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%" + PTR2UV(meta->mro_which)); + Perl_dump_indent(aTHX_ level, file, " CACHE_GEN = 0x%" UVxf "\n", - (UV)meta->cache_gen); - Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%" UVxf "\n", - (UV)meta->pkg_gen); - if (meta->mro_linear_all) { - Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%" + (UV)meta->cache_gen); + Perl_dump_indent(aTHX_ level, file, " PKG_GEN = 0x%" UVxf "\n", + (UV)meta->pkg_gen); + if (meta->mro_linear_all) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_ALL = 0x%" UVxf "\n", - PTR2UV(meta->mro_linear_all)); - do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest, - dumpops, pvlim); - } - if (meta->mro_linear_current) { - Perl_dump_indent(aTHX_ level, file, + PTR2UV(meta->mro_linear_all)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_all), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_linear_current) { + Perl_dump_indent(aTHX_ level, file, " MRO_LINEAR_CURRENT = 0x%" UVxf "\n", - PTR2UV(meta->mro_linear_current)); - do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest, - dumpops, pvlim); - } - if (meta->mro_nextmethod) { - Perl_dump_indent(aTHX_ level, file, + PTR2UV(meta->mro_linear_current)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_linear_current), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->mro_nextmethod) { + Perl_dump_indent(aTHX_ level, file, " MRO_NEXTMETHOD = 0x%" UVxf "\n", - PTR2UV(meta->mro_nextmethod)); - do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest, - dumpops, pvlim); - } - if (meta->isa) { - Perl_dump_indent(aTHX_ level, file, " ISA = 0x%" UVxf "\n", - PTR2UV(meta->isa)); - do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest, - dumpops, pvlim); - } - } - } - if (nest < maxnest) { - HV * const hv = MUTABLE_HV(sv); - STRLEN i; - HE *he; - - if (HvARRAY(hv)) { - int count = maxnest - nest; - for (i=0; i <= HvMAX(hv); i++) { - for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) { - U32 hash; - SV * keysv; - const char * keypv; - SV * elt; + PTR2UV(meta->mro_nextmethod)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->mro_nextmethod), nest+1, maxnest, + dumpops, pvlim); + } + if (meta->isa) { + Perl_dump_indent(aTHX_ level, file, " ISA = 0x%" UVxf "\n", + PTR2UV(meta->isa)); + do_sv_dump(level+1, file, MUTABLE_SV(meta->isa), nest+1, maxnest, + dumpops, pvlim); + } + } + } + if (nest < maxnest) { + HV * const hv = MUTABLE_HV(sv); + STRLEN i; + HE *he; + + if (HvARRAY(hv)) { + int count = maxnest - nest; + for (i=0; i <= HvMAX(hv); i++) { + for (he = HvARRAY(hv)[i]; he; he = HeNEXT(he)) { + U32 hash; + SV * keysv; + const char * keypv; + SV * elt; STRLEN len; - if (count-- <= 0) goto DONEHV; + if (count-- <= 0) goto DONEHV; - hash = HeHASH(he); - keysv = hv_iterkeysv(he); - keypv = SvPV_const(keysv, len); - elt = HeVAL(he); + hash = HeHASH(he); + keysv = hv_iterkeysv(he); + keypv = SvPV_const(keysv, len); + elt = HeVAL(he); Perl_dump_indent(aTHX_ level+1, file, "Elt %s ", pv_display(d, keypv, len, 0, pvlim)); if (SvUTF8(keysv)) PerlIO_printf(file, "[UTF8 \"%s\"] ", sv_uni_display(d, keysv, 6 * SvCUR(keysv), UNI_DISPLAY_QQ)); - if (HvEITER_get(hv) == he) - PerlIO_printf(file, "[CURRENT] "); + if (HvEITER_get(hv) == he) + PerlIO_printf(file, "[CURRENT] "); PerlIO_printf(file, "HASH = 0x%" UVxf "\n", (UV) hash); do_sv_dump(level+1, file, elt, nest+1, maxnest, dumpops, pvlim); } - } - DONEHV:; - } - } - break; + } + DONEHV:; + } + } + break; } /* case SVt_PVHV */ case SVt_PVCV: - if (CvAUTOLOAD(sv)) { - SV* tmpsv = newSVpvs_flags("", SVs_TEMP); + if (CvAUTOLOAD(sv)) { + SV* tmpsv = newSVpvs_flags("", SVs_TEMP); STRLEN len; - const char *const name = SvPV_const(sv, len); - Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n", - generic_pv_escape(tmpsv, name, len, SvUTF8(sv))); - } - if (SvPOK(sv)) { + const char *const name = SvPV_const(sv, len); + Perl_dump_indent(aTHX_ level, file, " AUTOLOAD = \"%s\"\n", + generic_pv_escape(tmpsv, name, len, SvUTF8(sv))); + } + if (SvPOK(sv)) { SV* tmpsv = newSVpvs_flags("", SVs_TEMP); const char *const proto = CvPROTO(sv); - Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", - generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv), + Perl_dump_indent(aTHX_ level, file, " PROTOTYPE = \"%s\"\n", + generic_pv_escape(tmpsv, proto, CvPROTOLEN(sv), SvUTF8(sv))); - } - /* FALLTHROUGH */ + } + /* FALLTHROUGH */ case SVt_PVFM: - do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); - if (!CvISXSUB(sv)) { - if (CvSTART(sv)) { + do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv)); + if (!CvISXSUB(sv)) { + if (CvSTART(sv)) { if (CvSLABBED(sv)) Perl_dump_indent(aTHX_ level, file, - " SLAB = 0x%" UVxf "\n", - PTR2UV(CvSTART(sv))); + " SLAB = 0x%" UVxf "\n", + PTR2UV(CvSTART(sv))); else Perl_dump_indent(aTHX_ level, file, - " START = 0x%" UVxf " ===> %" IVdf "\n", - PTR2UV(CvSTART(sv)), - (IV)sequence_num(CvSTART(sv))); - } - Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%" UVxf "\n", - PTR2UV(CvROOT(sv))); - if (CvROOT(sv) && dumpops) { - do_op_dump(level+1, file, CvROOT(sv)); - } - } else { - SV * const constant = cv_const_sv((const CV *)sv); - - Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%" UVxf "\n", PTR2UV(CvXSUB(sv))); - - if (constant) { - Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%" UVxf - " (CONST SV)\n", - PTR2UV(CvXSUBANY(sv).any_ptr)); - do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops, - pvlim); - } else { - Perl_dump_indent(aTHX_ level, file, " XSUBANY = %" IVdf "\n", - (IV)CvXSUBANY(sv).any_i32); - } - } - if (CvNAMED(sv)) - Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", - HEK_KEY(CvNAME_HEK((CV *)sv))); - else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); - Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); - Perl_dump_indent(aTHX_ level, file, " DEPTH = %" + " START = 0x%" UVxf " ===> %" IVdf "\n", + PTR2UV(CvSTART(sv)), + (IV)sequence_num(CvSTART(sv))); + } + Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%" UVxf "\n", + PTR2UV(CvROOT(sv))); + if (CvROOT(sv) && dumpops) { + do_op_dump(level+1, file, CvROOT(sv)); + } + } else { + SV * const constant = cv_const_sv((const CV *)sv); + + Perl_dump_indent(aTHX_ level, file, " XSUB = 0x%" UVxf "\n", PTR2UV(CvXSUB(sv))); + + if (constant) { + Perl_dump_indent(aTHX_ level, file, " XSUBANY = 0x%" UVxf + " (CONST SV)\n", + PTR2UV(CvXSUBANY(sv).any_ptr)); + do_sv_dump(level+1, file, constant, nest+1, maxnest, dumpops, + pvlim); + } else { + Perl_dump_indent(aTHX_ level, file, " XSUBANY = %" IVdf "\n", + (IV)CvXSUBANY(sv).any_i32); + } + } + if (CvNAMED(sv)) + Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", + HEK_KEY(CvNAME_HEK((CV *)sv))); + else do_gvgv_dump(level, file, " GVGV::GV", CvGV(sv)); + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", CvFILE(sv)); + Perl_dump_indent(aTHX_ level, file, " DEPTH = %" IVdf "\n", (IV)CvDEPTH(sv)); - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)CvFLAGS(sv)); - Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %" UVuf "\n", (UV)CvOUTSIDE_SEQ(sv)); - if (!CvISXSUB(sv)) { - Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%" UVxf "\n", PTR2UV(CvPADLIST(sv))); - if (nest < maxnest) { - do_dump_pad(level+1, file, CvPADLIST(sv), 0); - } - } - else - Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv)); - { - const CV * const outside = CvOUTSIDE(sv); - Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%" UVxf " (%s)\n", - PTR2UV(outside), - (!outside ? "null" - : CvANON(outside) ? "ANON" - : (outside == PL_main_cv) ? "MAIN" - : CvUNIQUE(outside) ? "UNIQUE" - : CvGV(outside) ? - generic_pv_escape( - newSVpvs_flags("", SVs_TEMP), - GvNAME(CvGV(outside)), - GvNAMELEN(CvGV(outside)), - GvNAMEUTF8(CvGV(outside))) - : "UNDEFINED")); - } - if (CvOUTSIDE(sv) - && (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))) - do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim); - break; + Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %" UVuf "\n", (UV)CvOUTSIDE_SEQ(sv)); + if (!CvISXSUB(sv)) { + Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%" UVxf "\n", PTR2UV(CvPADLIST(sv))); + if (nest < maxnest) { + do_dump_pad(level+1, file, CvPADLIST(sv), 0); + } + } + else + Perl_dump_indent(aTHX_ level, file, " HSCXT = 0x%p\n", CvHSCXT(sv)); + { + const CV * const outside = CvOUTSIDE(sv); + Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%" UVxf " (%s)\n", + PTR2UV(outside), + (!outside ? "null" + : CvANON(outside) ? "ANON" + : (outside == PL_main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" + : CvGV(outside) ? + generic_pv_escape( + newSVpvs_flags("", SVs_TEMP), + GvNAME(CvGV(outside)), + GvNAMELEN(CvGV(outside)), + GvNAMEUTF8(CvGV(outside))) + : "UNDEFINED")); + } + if (CvOUTSIDE(sv) + && (nest < maxnest && (CvCLONE(sv) || CvCLONED(sv)))) + do_sv_dump(level+1, file, MUTABLE_SV(CvOUTSIDE(sv)), nest+1, maxnest, dumpops, pvlim); + break; case SVt_PVGV: case SVt_PVLV: - if (type == SVt_PVLV) { - Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGOFF = %" IVdf "\n", (IV)LvTARGOFF(sv)); - Perl_dump_indent(aTHX_ level, file, " TARGLEN = %" IVdf "\n", (IV)LvTARGLEN(sv)); - Perl_dump_indent(aTHX_ level, file, " TARG = 0x%" UVxf "\n", PTR2UV(LvTARG(sv))); - Perl_dump_indent(aTHX_ level, file, " FLAGS = %" IVdf "\n", (IV)LvFLAGS(sv)); - if (isALPHA_FOLD_NE(LvTYPE(sv), 't')) - do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest, - dumpops, pvlim); - } - if (isREGEXP(sv)) goto dumpregexp; - if (!isGV_with_GP(sv)) - break; + if (type == SVt_PVLV) { + Perl_dump_indent(aTHX_ level, file, " TYPE = %c\n", LvTYPE(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGOFF = %" IVdf "\n", (IV)LvTARGOFF(sv)); + Perl_dump_indent(aTHX_ level, file, " TARGLEN = %" IVdf "\n", (IV)LvTARGLEN(sv)); + Perl_dump_indent(aTHX_ level, file, " TARG = 0x%" UVxf "\n", PTR2UV(LvTARG(sv))); + Perl_dump_indent(aTHX_ level, file, " FLAGS = %" IVdf "\n", (IV)LvFLAGS(sv)); + if (isALPHA_FOLD_NE(LvTYPE(sv), 't')) + do_sv_dump(level+1, file, LvTARG(sv), nest+1, maxnest, + dumpops, pvlim); + } + if (isREGEXP(sv)) goto dumpregexp; + if (!isGV_with_GP(sv)) + break; { SV* tmpsv = newSVpvs_flags("", SVs_TEMP); Perl_dump_indent(aTHX_ level, file, " NAME = \"%s\"\n", @@ -2347,78 +2347,78 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo GvNAMELEN(sv), GvNAMEUTF8(sv))); } - Perl_dump_indent(aTHX_ level, file, " NAMELEN = %" IVdf "\n", (IV)GvNAMELEN(sv)); - do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)GvFLAGS(sv)); - Perl_dump_indent(aTHX_ level, file, " GP = 0x%" UVxf "\n", PTR2UV(GvGP(sv))); - if (!GvGP(sv)) - break; - Perl_dump_indent(aTHX_ level, file, " SV = 0x%" UVxf "\n", PTR2UV(GvSV(sv))); - Perl_dump_indent(aTHX_ level, file, " REFCNT = %" IVdf "\n", (IV)GvREFCNT(sv)); - Perl_dump_indent(aTHX_ level, file, " IO = 0x%" UVxf "\n", PTR2UV(GvIOp(sv))); - Perl_dump_indent(aTHX_ level, file, " FORM = 0x%" UVxf " \n", PTR2UV(GvFORM(sv))); - Perl_dump_indent(aTHX_ level, file, " AV = 0x%" UVxf "\n", PTR2UV(GvAV(sv))); - Perl_dump_indent(aTHX_ level, file, " HV = 0x%" UVxf "\n", PTR2UV(GvHV(sv))); - Perl_dump_indent(aTHX_ level, file, " CV = 0x%" UVxf "\n", PTR2UV(GvCV(sv))); - Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%" UVxf "\n", (UV)GvCVGEN(sv)); - Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%" UVxf - " (%s)\n", - (UV)GvGPFLAGS(sv), - ""); - Perl_dump_indent(aTHX_ level, file, " LINE = %" IVdf "\n", (IV)GvLINE(sv)); - Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); - do_gv_dump (level, file, " EGV", GvEGV(sv)); - break; + Perl_dump_indent(aTHX_ level, file, " NAMELEN = %" IVdf "\n", (IV)GvNAMELEN(sv)); + do_hv_dump (level, file, " GvSTASH", GvSTASH(sv)); + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)GvFLAGS(sv)); + Perl_dump_indent(aTHX_ level, file, " GP = 0x%" UVxf "\n", PTR2UV(GvGP(sv))); + if (!GvGP(sv)) + break; + Perl_dump_indent(aTHX_ level, file, " SV = 0x%" UVxf "\n", PTR2UV(GvSV(sv))); + Perl_dump_indent(aTHX_ level, file, " REFCNT = %" IVdf "\n", (IV)GvREFCNT(sv)); + Perl_dump_indent(aTHX_ level, file, " IO = 0x%" UVxf "\n", PTR2UV(GvIOp(sv))); + Perl_dump_indent(aTHX_ level, file, " FORM = 0x%" UVxf " \n", PTR2UV(GvFORM(sv))); + Perl_dump_indent(aTHX_ level, file, " AV = 0x%" UVxf "\n", PTR2UV(GvAV(sv))); + Perl_dump_indent(aTHX_ level, file, " HV = 0x%" UVxf "\n", PTR2UV(GvHV(sv))); + Perl_dump_indent(aTHX_ level, file, " CV = 0x%" UVxf "\n", PTR2UV(GvCV(sv))); + Perl_dump_indent(aTHX_ level, file, " CVGEN = 0x%" UVxf "\n", (UV)GvCVGEN(sv)); + Perl_dump_indent(aTHX_ level, file, " GPFLAGS = 0x%" UVxf + " (%s)\n", + (UV)GvGPFLAGS(sv), + ""); + Perl_dump_indent(aTHX_ level, file, " LINE = %" IVdf "\n", (IV)GvLINE(sv)); + Perl_dump_indent(aTHX_ level, file, " FILE = \"%s\"\n", GvFILE(sv)); + do_gv_dump (level, file, " EGV", GvEGV(sv)); + break; case SVt_PVIO: - Perl_dump_indent(aTHX_ level, file, " IFP = 0x%" UVxf "\n", PTR2UV(IoIFP(sv))); - Perl_dump_indent(aTHX_ level, file, " OFP = 0x%" UVxf "\n", PTR2UV(IoOFP(sv))); - Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%" UVxf "\n", PTR2UV(IoDIRP(sv))); - Perl_dump_indent(aTHX_ level, file, " LINES = %" IVdf "\n", (IV)IoLINES(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE = %" IVdf "\n", (IV)IoPAGE(sv)); - Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %" IVdf "\n", (IV)IoPAGE_LEN(sv)); - Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %" IVdf "\n", (IV)IoLINES_LEFT(sv)); + Perl_dump_indent(aTHX_ level, file, " IFP = 0x%" UVxf "\n", PTR2UV(IoIFP(sv))); + Perl_dump_indent(aTHX_ level, file, " OFP = 0x%" UVxf "\n", PTR2UV(IoOFP(sv))); + Perl_dump_indent(aTHX_ level, file, " DIRP = 0x%" UVxf "\n", PTR2UV(IoDIRP(sv))); + Perl_dump_indent(aTHX_ level, file, " LINES = %" IVdf "\n", (IV)IoLINES(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE = %" IVdf "\n", (IV)IoPAGE(sv)); + Perl_dump_indent(aTHX_ level, file, " PAGE_LEN = %" IVdf "\n", (IV)IoPAGE_LEN(sv)); + Perl_dump_indent(aTHX_ level, file, " LINES_LEFT = %" IVdf "\n", (IV)IoLINES_LEFT(sv)); if (IoTOP_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " TOP_NAME = \"%s\"\n", IoTOP_NAME(sv)); - if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV) - do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); - else { - Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%" UVxf "\n", - PTR2UV(IoTOP_GV(sv))); - do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1, - maxnest, dumpops, pvlim); - } - /* Source filters hide things that are not GVs in these three, so let's - be careful out there. */ + if (!IoTOP_GV(sv) || SvTYPE(IoTOP_GV(sv)) == SVt_PVGV) + do_gv_dump (level, file, " TOP_GV", IoTOP_GV(sv)); + else { + Perl_dump_indent(aTHX_ level, file, " TOP_GV = 0x%" UVxf "\n", + PTR2UV(IoTOP_GV(sv))); + do_sv_dump (level+1, file, MUTABLE_SV(IoTOP_GV(sv)), nest+1, + maxnest, dumpops, pvlim); + } + /* Source filters hide things that are not GVs in these three, so let's + be careful out there. */ if (IoFMT_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " FMT_NAME = \"%s\"\n", IoFMT_NAME(sv)); - if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV) - do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv)); - else { - Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%" UVxf "\n", - PTR2UV(IoFMT_GV(sv))); - do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1, - maxnest, dumpops, pvlim); - } + if (!IoFMT_GV(sv) || SvTYPE(IoFMT_GV(sv)) == SVt_PVGV) + do_gv_dump (level, file, " FMT_GV", IoFMT_GV(sv)); + else { + Perl_dump_indent(aTHX_ level, file, " FMT_GV = 0x%" UVxf "\n", + PTR2UV(IoFMT_GV(sv))); + do_sv_dump (level+1, file, MUTABLE_SV(IoFMT_GV(sv)), nest+1, + maxnest, dumpops, pvlim); + } if (IoBOTTOM_NAME(sv)) Perl_dump_indent(aTHX_ level, file, " BOTTOM_NAME = \"%s\"\n", IoBOTTOM_NAME(sv)); - if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV) - do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); - else { - Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%" UVxf "\n", - PTR2UV(IoBOTTOM_GV(sv))); - do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1, - maxnest, dumpops, pvlim); - } - if (isPRINT(IoTYPE(sv))) + if (!IoBOTTOM_GV(sv) || SvTYPE(IoBOTTOM_GV(sv)) == SVt_PVGV) + do_gv_dump (level, file, " BOTTOM_GV", IoBOTTOM_GV(sv)); + else { + Perl_dump_indent(aTHX_ level, file, " BOTTOM_GV = 0x%" UVxf "\n", + PTR2UV(IoBOTTOM_GV(sv))); + do_sv_dump (level+1, file, MUTABLE_SV(IoBOTTOM_GV(sv)), nest+1, + maxnest, dumpops, pvlim); + } + if (isPRINT(IoTYPE(sv))) Perl_dump_indent(aTHX_ level, file, " TYPE = '%c'\n", IoTYPE(sv)); - else + else Perl_dump_indent(aTHX_ level, file, " TYPE = '\\%o'\n", IoTYPE(sv)); - Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)IoFLAGS(sv)); - break; + Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%" UVxf "\n", (UV)IoFLAGS(sv)); + break; case SVt_REGEXP: dumpregexp: - { - struct regexp * const r = ReANY((REGEXP*)sv); + { + struct regexp * const r = ReANY((REGEXP*)sv); #define SV_SET_STRINGIFY_REGEXP_FLAGS(d,flags,names) STMT_START { \ sv_setpv(d,""); \ @@ -2433,7 +2433,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo (UV)(r->compflags), SvPVX_const(d)); SV_SET_STRINGIFY_REGEXP_FLAGS(d,r->extflags,regexp_extflags_names); - Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%" UVxf " (%s)\n", + Perl_dump_indent(aTHX_ level, file, " EXTFLAGS = 0x%" UVxf " (%s)\n", (UV)(r->extflags), SvPVX_const(d)); Perl_dump_indent(aTHX_ level, file, " ENGINE = 0x%" UVxf " (%s)\n", @@ -2444,56 +2444,56 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, I32 nest, I32 maxnest, bo (UV)(r->intflags), SvPVX_const(d)); } else { Perl_dump_indent(aTHX_ level, file, " INTFLAGS = 0x%" UVxf "\n", - (UV)(r->intflags)); + (UV)(r->intflags)); } #undef SV_SET_STRINGIFY_REGEXP_FLAGS - Perl_dump_indent(aTHX_ level, file, " NPARENS = %" UVuf "\n", - (UV)(r->nparens)); - Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %" UVuf "\n", - (UV)(r->lastparen)); - Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %" UVuf "\n", - (UV)(r->lastcloseparen)); - Perl_dump_indent(aTHX_ level, file, " MINLEN = %" IVdf "\n", - (IV)(r->minlen)); - Perl_dump_indent(aTHX_ level, file, " MINLENRET = %" IVdf "\n", - (IV)(r->minlenret)); - Perl_dump_indent(aTHX_ level, file, " GOFS = %" UVuf "\n", - (UV)(r->gofs)); - Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %" UVuf "\n", - (UV)(r->pre_prefix)); - Perl_dump_indent(aTHX_ level, file, " SUBLEN = %" IVdf "\n", - (IV)(r->sublen)); - Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %" IVdf "\n", - (IV)(r->suboffset)); - Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %" IVdf "\n", - (IV)(r->subcoffset)); - if (r->subbeg) - Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%" UVxf " %s\n", - PTR2UV(r->subbeg), - pv_display(d, r->subbeg, r->sublen, 50, pvlim)); - else - Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n"); - Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%" UVxf "\n", - PTR2UV(r->mother_re)); - if (nest < maxnest && r->mother_re) - do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1, - maxnest, dumpops, pvlim); - Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%" UVxf "\n", - PTR2UV(r->paren_names)); - Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%" UVxf "\n", - PTR2UV(r->substrs)); - Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%" UVxf "\n", - PTR2UV(r->pprivate)); - Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%" UVxf "\n", - PTR2UV(r->offs)); - Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%" UVxf "\n", - PTR2UV(r->qr_anoncv)); + Perl_dump_indent(aTHX_ level, file, " NPARENS = %" UVuf "\n", + (UV)(r->nparens)); + Perl_dump_indent(aTHX_ level, file, " LASTPAREN = %" UVuf "\n", + (UV)(r->lastparen)); + Perl_dump_indent(aTHX_ level, file, " LASTCLOSEPAREN = %" UVuf "\n", + (UV)(r->lastcloseparen)); + Perl_dump_indent(aTHX_ level, file, " MINLEN = %" IVdf "\n", + (IV)(r->minlen)); + Perl_dump_indent(aTHX_ level, file, " MINLENRET = %" IVdf "\n", + (IV)(r->minlenret)); + Perl_dump_indent(aTHX_ level, file, " GOFS = %" UVuf "\n", + (UV)(r->gofs)); + Perl_dump_indent(aTHX_ level, file, " PRE_PREFIX = %" UVuf "\n", + (UV)(r->pre_prefix)); + Perl_dump_indent(aTHX_ level, file, " SUBLEN = %" IVdf "\n", + (IV)(r->sublen)); + Perl_dump_indent(aTHX_ level, file, " SUBOFFSET = %" IVdf "\n", + (IV)(r->suboffset)); + Perl_dump_indent(aTHX_ level, file, " SUBCOFFSET = %" IVdf "\n", + (IV)(r->subcoffset)); + if (r->subbeg) + Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x%" UVxf " %s\n", + PTR2UV(r->subbeg), + pv_display(d, r->subbeg, r->sublen, 50, pvlim)); + else + Perl_dump_indent(aTHX_ level, file, " SUBBEG = 0x0\n"); + Perl_dump_indent(aTHX_ level, file, " MOTHER_RE = 0x%" UVxf "\n", + PTR2UV(r->mother_re)); + if (nest < maxnest && r->mother_re) + do_sv_dump(level+1, file, (SV *)r->mother_re, nest+1, + maxnest, dumpops, pvlim); + Perl_dump_indent(aTHX_ level, file, " PAREN_NAMES = 0x%" UVxf "\n", + PTR2UV(r->paren_names)); + Perl_dump_indent(aTHX_ level, file, " SUBSTRS = 0x%" UVxf "\n", + PTR2UV(r->substrs)); + Perl_dump_indent(aTHX_ level, file, " PPRIVATE = 0x%" UVxf "\n", + PTR2UV(r->pprivate)); + Perl_dump_indent(aTHX_ level, file, " OFFS = 0x%" UVxf "\n", + PTR2UV(r->offs)); + Perl_dump_indent(aTHX_ level, file, " QR_ANONCV = 0x%" UVxf "\n", + PTR2UV(r->qr_anoncv)); #ifdef PERL_ANY_COW - Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%" UVxf "\n", - PTR2UV(r->saved_copy)); + Perl_dump_indent(aTHX_ level, file, " SAVED_COPY = 0x%" UVxf "\n", + PTR2UV(r->saved_copy)); #endif - } - break; + } + break; } SvREFCNT_dec_NN(d); } @@ -2512,9 +2512,9 @@ void Perl_sv_dump(pTHX_ SV *sv) { if (sv && SvROK(sv)) - do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0); + do_sv_dump(0, Perl_debug_log, sv, 0, 4, 0, 0); else - do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0); + do_sv_dump(0, Perl_debug_log, sv, 0, 0, 0, 0); } int @@ -2527,8 +2527,8 @@ Perl_runops_debug(pTHX) #endif if (!PL_op) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); - return 0; + Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); + return 0; } DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n")); do { @@ -2544,29 +2544,29 @@ Perl_runops_debug(pTHX) PL_stack_base + PL_curstackinfo->si_stack_hwm); PL_curstackinfo->si_stack_hwm = PL_stack_sp - PL_stack_base; #endif - if (PL_debug) { + if (PL_debug) { ENTER; SAVETMPS; - if (PL_watchaddr && (*PL_watchaddr != PL_watchok)) - PerlIO_printf(Perl_debug_log, - "WARNING: %" UVxf " changed from %" UVxf " to %" UVxf "\n", - PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), - PTR2UV(*PL_watchaddr)); - if (DEBUG_s_TEST_) { - if (DEBUG_v_TEST_) { - PerlIO_printf(Perl_debug_log, "\n"); - deb_stack_all(); - } - else - debstack(); - } - - - if (DEBUG_t_TEST_) debop(PL_op); - if (DEBUG_P_TEST_) debprof(PL_op); + if (PL_watchaddr && (*PL_watchaddr != PL_watchok)) + PerlIO_printf(Perl_debug_log, + "WARNING: %" UVxf " changed from %" UVxf " to %" UVxf "\n", + PTR2UV(PL_watchaddr), PTR2UV(PL_watchok), + PTR2UV(*PL_watchaddr)); + if (DEBUG_s_TEST_) { + if (DEBUG_v_TEST_) { + PerlIO_printf(Perl_debug_log, "\n"); + deb_stack_all(); + } + else + debstack(); + } + + + if (DEBUG_t_TEST_) debop(PL_op); + if (DEBUG_P_TEST_) debprof(PL_op); FREETMPS; LEAVE; - } + } PERL_DTRACE_PROBE_OP(PL_op); } while ((PL_op = PL_op->op_ppaddr(aTHX))); @@ -2861,26 +2861,26 @@ Perl_debop(pTHX_ const OP *o) PERL_ARGS_ASSERT_DEBOP; if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_) - return 0; + return 0; Perl_deb(aTHX_ "%s", OP_NAME(o)); switch (o->op_type) { case OP_CONST: case OP_HINTSEVAL: - /* With ITHREADS, consts are stored in the pad, and the right pad - * may not be active here, so check. - * Looks like only during compiling the pads are illegal. - */ + /* With ITHREADS, consts are stored in the pad, and the right pad + * may not be active here, so check. + * Looks like only during compiling the pads are illegal. + */ #ifdef USE_ITHREADS - if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME) + if ((((SVOP*)o)->op_sv) || !IN_PERL_COMPILETIME) #endif - PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); - break; + PerlIO_printf(Perl_debug_log, "(%s)", SvPEEK(cSVOPo_sv)); + break; case OP_GVSV: case OP_GV: PerlIO_printf(Perl_debug_log, "(%" SVf ")", SVfARG(S_gv_display(aTHX_ cGVOPo_gv))); - break; + break; case OP_PADSV: case OP_PADAV: @@ -2905,7 +2905,7 @@ Perl_debop(pTHX_ const OP *o) break; default: - break; + break; } PerlIO_printf(Perl_debug_log, "\n"); return 0; @@ -2928,29 +2928,29 @@ Perl_op_class(pTHX_ const OP *o) bool custom = 0; if (!o) - return OPclass_NULL; + return OPclass_NULL; if (o->op_type == 0) { - if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) - return OPclass_COP; - return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP; + if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE) + return OPclass_COP; + return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP; } if (o->op_type == OP_SASSIGN) - return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPclass_UNOP : OPclass_BINOP); + return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPclass_UNOP : OPclass_BINOP); if (o->op_type == OP_AELEMFAST) { #ifdef USE_ITHREADS - return OPclass_PADOP; + return OPclass_PADOP; #else - return OPclass_SVOP; + return OPclass_SVOP; #endif } #ifdef USE_ITHREADS if (o->op_type == OP_GV || o->op_type == OP_GVSV || - o->op_type == OP_RCATLINE) - return OPclass_PADOP; + o->op_type == OP_RCATLINE) + return OPclass_PADOP; #endif if (o->op_type == OP_CUSTOM) @@ -2958,28 +2958,28 @@ Perl_op_class(pTHX_ const OP *o) switch (OP_CLASS(o)) { case OA_BASEOP: - return OPclass_BASEOP; + return OPclass_BASEOP; case OA_UNOP: - return OPclass_UNOP; + return OPclass_UNOP; case OA_BINOP: - return OPclass_BINOP; + return OPclass_BINOP; case OA_LOGOP: - return OPclass_LOGOP; + return OPclass_LOGOP; case OA_LISTOP: - return OPclass_LISTOP; + return OPclass_LISTOP; case OA_PMOP: - return OPclass_PMOP; + return OPclass_PMOP; case OA_SVOP: - return OPclass_SVOP; + return OPclass_SVOP; case OA_PADOP: - return OPclass_PADOP; + return OPclass_PADOP; case OA_PVOP_OR_SVOP: /* @@ -2989,70 +2989,70 @@ Perl_op_class(pTHX_ const OP *o) * the OP is an SVOP (or, under threads, a PADOP), * and the SV is an AV. */ - return (!custom && - (o->op_private & OPpTRANS_USE_SVOP) - ) + return (!custom && + (o->op_private & OPpTRANS_USE_SVOP) + ) #if defined(USE_ITHREADS) - ? OPclass_PADOP : OPclass_PVOP; + ? OPclass_PADOP : OPclass_PVOP; #else - ? OPclass_SVOP : OPclass_PVOP; + ? OPclass_SVOP : OPclass_PVOP; #endif case OA_LOOP: - return OPclass_LOOP; + return OPclass_LOOP; case OA_COP: - return OPclass_COP; + return OPclass_COP; case OA_BASEOP_OR_UNOP: - /* - * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on - * whether parens were seen. perly.y uses OPf_SPECIAL to - * signal whether a BASEOP had empty parens or none. - * Some other UNOPs are created later, though, so the best - * test is OPf_KIDS, which is set in newUNOP. - */ - return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP; + /* + * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on + * whether parens were seen. perly.y uses OPf_SPECIAL to + * signal whether a BASEOP had empty parens or none. + * Some other UNOPs are created later, though, so the best + * test is OPf_KIDS, which is set in newUNOP. + */ + return (o->op_flags & OPf_KIDS) ? OPclass_UNOP : OPclass_BASEOP; case OA_FILESTATOP: - /* - * The file stat OPs are created via UNI(OP_foo) in toke.c but use - * the OPf_REF flag to distinguish between OP types instead of the - * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we - * return OPclass_UNOP so that walkoptree can find our children. If - * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set - * (no argument to the operator) it's an OP; with OPf_REF set it's - * an SVOP (and op_sv is the GV for the filehandle argument). - */ - return ((o->op_flags & OPf_KIDS) ? OPclass_UNOP : + /* + * The file stat OPs are created via UNI(OP_foo) in toke.c but use + * the OPf_REF flag to distinguish between OP types instead of the + * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we + * return OPclass_UNOP so that walkoptree can find our children. If + * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set + * (no argument to the operator) it's an OP; with OPf_REF set it's + * an SVOP (and op_sv is the GV for the filehandle argument). + */ + return ((o->op_flags & OPf_KIDS) ? OPclass_UNOP : #ifdef USE_ITHREADS - (o->op_flags & OPf_REF) ? OPclass_PADOP : OPclass_BASEOP); + (o->op_flags & OPf_REF) ? OPclass_PADOP : OPclass_BASEOP); #else - (o->op_flags & OPf_REF) ? OPclass_SVOP : OPclass_BASEOP); + (o->op_flags & OPf_REF) ? OPclass_SVOP : OPclass_BASEOP); #endif case OA_LOOPEXOP: - /* - * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a - * label was omitted (in which case it's a BASEOP) or else a term was - * seen. In this last case, all except goto are definitely PVOP but - * goto is either a PVOP (with an ordinary constant label), an UNOP - * with OPf_STACKED (with a non-constant non-sub) or an UNOP for - * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to - * get set. - */ - if (o->op_flags & OPf_STACKED) - return OPclass_UNOP; - else if (o->op_flags & OPf_SPECIAL) - return OPclass_BASEOP; - else - return OPclass_PVOP; + /* + * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a + * label was omitted (in which case it's a BASEOP) or else a term was + * seen. In this last case, all except goto are definitely PVOP but + * goto is either a PVOP (with an ordinary constant label), an UNOP + * with OPf_STACKED (with a non-constant non-sub) or an UNOP for + * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to + * get set. + */ + if (o->op_flags & OPf_STACKED) + return OPclass_UNOP; + else if (o->op_flags & OPf_SPECIAL) + return OPclass_BASEOP; + else + return OPclass_PVOP; case OA_METHOP: - return OPclass_METHOP; + return OPclass_METHOP; case OA_UNOP_AUX: - return OPclass_UNOP_AUX; + return OPclass_UNOP_AUX; } Perl_warn(aTHX_ "Can't determine class of operator %s, assuming BASEOP\n", - OP_NAME(o)); + OP_NAME(o)); return OPclass_BASEOP; } @@ -3090,7 +3090,7 @@ Perl_watch(pTHX_ char **addr) PL_watchaddr = addr; PL_watchok = *addr; PerlIO_printf(Perl_debug_log, "WATCHING, %" UVxf " is currently %" UVxf "\n", - PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); + PTR2UV(PL_watchaddr), PTR2UV(PL_watchok)); } STATIC void @@ -3099,9 +3099,9 @@ S_debprof(pTHX_ const OP *o) PERL_ARGS_ASSERT_DEBPROF; if (!DEBUG_J_TEST_ && CopSTASH_eq(PL_curcop, PL_debstash)) - return; + return; if (!PL_profiledata) - Newxz(PL_profiledata, MAXO, U32); + Newxz(PL_profiledata, MAXO, U32); ++PL_profiledata[o->op_type]; } @@ -3110,11 +3110,11 @@ Perl_debprofdump(pTHX) { unsigned i; if (!PL_profiledata) - return; + return; for (i = 0; i < MAXO; i++) { - if (PL_profiledata[i]) - PerlIO_printf(Perl_debug_log, - "%5lu %s\n", (unsigned long)PL_profiledata[i], + if (PL_profiledata[i]) + PerlIO_printf(Perl_debug_log, + "%5lu %s\n", (unsigned long)PL_profiledata[i], PL_op_name[i]); } } diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 1a27fbdd207d..a818e7ac5cc7 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -27,10 +27,10 @@ typedef struct { SV* x_dl_last_error; /* pointer to allocated memory for - last error message */ + last error message */ #if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) int x_dl_nonlazy; /* flag for immediate rather than lazy - linking (spots unresolved symbol) */ + linking (spots unresolved symbol) */ #endif #ifdef DL_LOADONCEONLY HV * x_dl_loaded_files; /* only needed on a few systems */ @@ -62,8 +62,8 @@ START_MY_CXT #ifdef DEBUGGING #define DLDEBUG(level,code) \ STMT_START { \ - dMY_CXT; \ - if (dl_debug>=level) { code; } \ + dMY_CXT; \ + if (dl_debug>=level) { code; } \ } STMT_END #else #define DLDEBUG(level,code) NOOP @@ -109,25 +109,25 @@ dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */ #endif #ifdef DEBUGGING { - SV *sv = get_sv("DynaLoader::dl_debug", 0); - dl_debug = sv ? SvIV(sv) : 0; + SV *sv = get_sv("DynaLoader::dl_debug", 0); + dl_debug = sv ? SvIV(sv) : 0; } #endif #if defined(PERL_IN_DL_HPUX_XS) || defined(PERL_IN_DL_DLOPEN_XS) if ( (perl_dl_nonlazy = PerlEnv_getenv("PERL_DL_NONLAZY")) != NULL - && grok_atoUV(perl_dl_nonlazy, &uv, NULL) - && uv <= INT_MAX + && grok_atoUV(perl_dl_nonlazy, &uv, NULL) + && uv <= INT_MAX ) { - dl_nonlazy = (int)uv; + dl_nonlazy = (int)uv; } else - dl_nonlazy = 0; + dl_nonlazy = 0; if (dl_nonlazy) - DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); + DLDEBUG(1,PerlIO_printf(Perl_debug_log, "DynaLoader bind mode is 'non-lazy'\n")); #endif #ifdef DL_LOADONCEONLY if (!dl_loaded_files) - dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ + dl_loaded_files = newHV(); /* provide cache for dl_*.xs if needed */ #endif #ifdef DL_UNLOAD_ALL_AT_EXIT call_atexit(&dl_unload_all_files, (void*)0); @@ -155,10 +155,10 @@ SaveError(pTHX_ const char* pat, ...) len++; /* include terminating null char */ { - dMY_CXT; + dMY_CXT; /* Copy message into dl_last_error (including terminating null char) */ - sv_setpvn(MY_CXT.x_dl_last_error, message, len) ; - DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); + sv_setpvn(MY_CXT.x_dl_last_error, message, len) ; + DLDEBUG(2,PerlIO_printf(Perl_debug_log, "DynaLoader: stored error msg '%s'\n",dl_last_error)); } } #endif diff --git a/ext/File-Glob/bsd_glob.c b/ext/File-Glob/bsd_glob.c index b038dd117a32..7a810db93ff9 100644 --- a/ext/File-Glob/bsd_glob.c +++ b/ext/File-Glob/bsd_glob.c @@ -74,8 +74,8 @@ static char sscsid[]= "$OpenBSD: glob.c,v 1.8.10.1 2001/04/10 jason Exp $"; # include #else #if defined(HAS_PASSWD) && !defined(VMS) - struct passwd *getpwnam(char *); - struct passwd *getpwuid(Uid_t); + struct passwd *getpwnam(char *); + struct passwd *getpwuid(Uid_t); #endif #endif @@ -168,12 +168,12 @@ static int g_stat(Char *, Stat_t *, glob_t *); static int glob0(const Char *, glob_t *); static int glob1(Char *, Char *, glob_t *, size_t *); static int glob2(Char *, Char *, Char *, Char *, Char *, Char *, - glob_t *, size_t *); + glob_t *, size_t *); static int glob3(Char *, Char *, Char *, Char *, Char *, - Char *, Char *, glob_t *, size_t *); + Char *, Char *, glob_t *, size_t *); static int globextend(const Char *, glob_t *, size_t *); static const Char * - globtilde(const Char *, Char *, size_t, glob_t *); + globtilde(const Char *, Char *, size_t, glob_t *); static int globexp1(const Char *, glob_t *); static int globexp2(const Char *, const Char *, glob_t *, int *); static int match(Char *, Char *, Char *, int); @@ -216,82 +216,82 @@ my_readdir(DIR *d) int bsd_glob(const char *pattern, int flags, - int (*errfunc)(const char *, int), glob_t *pglob) + int (*errfunc)(const char *, int), glob_t *pglob) { - const U8 *patnext; - int c; - Char *bufnext, *bufend, patbuf[MAXPATHLEN]; - patnext = (U8 *) pattern; - /* TODO: GLOB_APPEND / GLOB_DOOFFS aren't supported yet */ + const U8 *patnext; + int c; + Char *bufnext, *bufend, patbuf[MAXPATHLEN]; + patnext = (U8 *) pattern; + /* TODO: GLOB_APPEND / GLOB_DOOFFS aren't supported yet */ #if 0 - if (!(flags & GLOB_APPEND)) { - pglob->gl_pathc = 0; - pglob->gl_pathv = NULL; - if (!(flags & GLOB_DOOFFS)) - pglob->gl_offs = 0; - } + if (!(flags & GLOB_APPEND)) { + pglob->gl_pathc = 0; + pglob->gl_pathv = NULL; + if (!(flags & GLOB_DOOFFS)) + pglob->gl_offs = 0; + } #else - pglob->gl_pathc = 0; - pglob->gl_pathv = NULL; - pglob->gl_offs = 0; + pglob->gl_pathc = 0; + pglob->gl_pathv = NULL; + pglob->gl_offs = 0; #endif - pglob->gl_flags = flags & ~GLOB_MAGCHAR; - pglob->gl_errfunc = errfunc; - pglob->gl_matchc = 0; + pglob->gl_flags = flags & ~GLOB_MAGCHAR; + pglob->gl_errfunc = errfunc; + pglob->gl_matchc = 0; - bufnext = patbuf; - bufend = bufnext + MAXPATHLEN - 1; + bufnext = patbuf; + bufend = bufnext + MAXPATHLEN - 1; #ifdef DOSISH - /* Nasty hack to treat patterns like "C:*" correctly. In this - * case, the * should match any file in the current directory - * on the C: drive. However, the glob code does not treat the - * colon specially, so it looks for files beginning "C:" in - * the current directory. To fix this, change the pattern to - * add an explicit "./" at the start (just after the drive - * letter and colon - ie change to "C:./"). - */ - if (isalpha(pattern[0]) && pattern[1] == ':' && - pattern[2] != BG_SEP && pattern[2] != BG_SEP2 && - bufend - bufnext > 4) { - *bufnext++ = pattern[0]; - *bufnext++ = ':'; - *bufnext++ = '.'; - *bufnext++ = BG_SEP; - patnext += 2; - } + /* Nasty hack to treat patterns like "C:*" correctly. In this + * case, the * should match any file in the current directory + * on the C: drive. However, the glob code does not treat the + * colon specially, so it looks for files beginning "C:" in + * the current directory. To fix this, change the pattern to + * add an explicit "./" at the start (just after the drive + * letter and colon - ie change to "C:./"). + */ + if (isalpha(pattern[0]) && pattern[1] == ':' && + pattern[2] != BG_SEP && pattern[2] != BG_SEP2 && + bufend - bufnext > 4) { + *bufnext++ = pattern[0]; + *bufnext++ = ':'; + *bufnext++ = '.'; + *bufnext++ = BG_SEP; + patnext += 2; + } #endif - if (flags & GLOB_QUOTE) { - /* Protect the quoted characters. */ - while (bufnext < bufend && (c = *patnext++) != BG_EOS) - if (c == BG_QUOTE) { + if (flags & GLOB_QUOTE) { + /* Protect the quoted characters. */ + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + if (c == BG_QUOTE) { #ifdef DOSISH - /* To avoid backslashitis on Win32, - * we only treat \ as a quoting character - * if it precedes one of the - * metacharacters []-{}~\ - */ - if ((c = *patnext++) != '[' && c != ']' && - c != '-' && c != '{' && c != '}' && - c != '~' && c != '\\') { + /* To avoid backslashitis on Win32, + * we only treat \ as a quoting character + * if it precedes one of the + * metacharacters []-{}~\ + */ + if ((c = *patnext++) != '[' && c != ']' && + c != '-' && c != '{' && c != '}' && + c != '~' && c != '\\') { #else - if ((c = *patnext++) == BG_EOS) { + if ((c = *patnext++) == BG_EOS) { #endif - c = BG_QUOTE; - --patnext; - } - *bufnext++ = c | M_PROTECT; - } else - *bufnext++ = c; - } else - while (bufnext < bufend && (c = *patnext++) != BG_EOS) - *bufnext++ = c; - *bufnext = BG_EOS; - - if (flags & GLOB_BRACE) - return globexp1(patbuf, pglob); - else - return glob0(patbuf, pglob); + c = BG_QUOTE; + --patnext; + } + *bufnext++ = c | M_PROTECT; + } else + *bufnext++ = c; + } else + while (bufnext < bufend && (c = *patnext++) != BG_EOS) + *bufnext++ = c; + *bufnext = BG_EOS; + + if (flags & GLOB_BRACE) + return globexp1(patbuf, pglob); + else + return glob0(patbuf, pglob); } /* @@ -302,18 +302,18 @@ bsd_glob(const char *pattern, int flags, static int globexp1(const Char *pattern, glob_t *pglob) { - const Char* ptr = pattern; - int rv; + const Char* ptr = pattern; + int rv; - /* Protect a single {}, for find(1), like csh */ - if (pattern[0] == BG_LBRACE && pattern[1] == BG_RBRACE && pattern[2] == BG_EOS) - return glob0(pattern, pglob); + /* Protect a single {}, for find(1), like csh */ + if (pattern[0] == BG_LBRACE && pattern[1] == BG_RBRACE && pattern[2] == BG_EOS) + return glob0(pattern, pglob); - while ((ptr = (const Char *) g_strchr((Char *) ptr, BG_LBRACE)) != NULL) - if (!globexp2(ptr, pattern, pglob, &rv)) - return rv; + while ((ptr = (const Char *) g_strchr((Char *) ptr, BG_LBRACE)) != NULL) + if (!globexp2(ptr, pattern, pglob, &rv)) + return rv; - return glob0(pattern, pglob); + return glob0(pattern, pglob); } @@ -324,103 +324,103 @@ globexp1(const Char *pattern, glob_t *pglob) */ static int globexp2(const Char *ptr, const Char *pattern, - glob_t *pglob, int *rv) + glob_t *pglob, int *rv) { - int i; - Char *lm, *ls; - const Char *pe, *pm, *pm1, *pl; - Char patbuf[MAXPATHLEN]; - - /* copy part up to the brace */ - for (lm = patbuf, pm = pattern; pm != ptr; *lm++ = *pm++) - ; - *lm = BG_EOS; - ls = lm; - - /* Find the balanced brace */ - for (i = 0, pe = ++ptr; *pe; pe++) - if (*pe == BG_LBRACKET) { - /* Ignore everything between [] */ - for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++) - ; - if (*pe == BG_EOS) { - /* - * We could not find a matching BG_RBRACKET. - * Ignore and just look for BG_RBRACE - */ - pe = pm; - } - } else if (*pe == BG_LBRACE) - i++; - else if (*pe == BG_RBRACE) { - if (i == 0) - break; - i--; - } - - /* Non matching braces; just glob the pattern */ - if (i != 0 || *pe == BG_EOS) { - *rv = glob0(patbuf, pglob); - return 0; - } - - for (i = 0, pl = pm = ptr; pm <= pe; pm++) { - switch (*pm) { - case BG_LBRACKET: - /* Ignore everything between [] */ - for (pm1 = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++) - ; - if (*pm == BG_EOS) { - /* - * We could not find a matching BG_RBRACKET. - * Ignore and just look for BG_RBRACE - */ - pm = pm1; - } - break; - - case BG_LBRACE: - i++; - break; - - case BG_RBRACE: - if (i) { - i--; - break; - } - /* FALLTHROUGH */ - case BG_COMMA: - if (i && *pm == BG_COMMA) - break; - else { - /* Append the current string */ - for (lm = ls; (pl < pm); *lm++ = *pl++) - ; - - /* - * Append the rest of the pattern after the - * closing brace - */ - for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS; ) - ; - - /* Expand the current pattern */ + int i; + Char *lm, *ls; + const Char *pe, *pm, *pm1, *pl; + Char patbuf[MAXPATHLEN]; + + /* copy part up to the brace */ + for (lm = patbuf, pm = pattern; pm != ptr; *lm++ = *pm++) + ; + *lm = BG_EOS; + ls = lm; + + /* Find the balanced brace */ + for (i = 0, pe = ++ptr; *pe; pe++) + if (*pe == BG_LBRACKET) { + /* Ignore everything between [] */ + for (pm = pe++; *pe != BG_RBRACKET && *pe != BG_EOS; pe++) + ; + if (*pe == BG_EOS) { + /* + * We could not find a matching BG_RBRACKET. + * Ignore and just look for BG_RBRACE + */ + pe = pm; + } + } else if (*pe == BG_LBRACE) + i++; + else if (*pe == BG_RBRACE) { + if (i == 0) + break; + i--; + } + + /* Non matching braces; just glob the pattern */ + if (i != 0 || *pe == BG_EOS) { + *rv = glob0(patbuf, pglob); + return 0; + } + + for (i = 0, pl = pm = ptr; pm <= pe; pm++) { + switch (*pm) { + case BG_LBRACKET: + /* Ignore everything between [] */ + for (pm1 = pm++; *pm != BG_RBRACKET && *pm != BG_EOS; pm++) + ; + if (*pm == BG_EOS) { + /* + * We could not find a matching BG_RBRACKET. + * Ignore and just look for BG_RBRACE + */ + pm = pm1; + } + break; + + case BG_LBRACE: + i++; + break; + + case BG_RBRACE: + if (i) { + i--; + break; + } + /* FALLTHROUGH */ + case BG_COMMA: + if (i && *pm == BG_COMMA) + break; + else { + /* Append the current string */ + for (lm = ls; (pl < pm); *lm++ = *pl++) + ; + + /* + * Append the rest of the pattern after the + * closing brace + */ + for (pl = pe + 1; (*lm++ = *pl++) != BG_EOS; ) + ; + + /* Expand the current pattern */ #ifdef GLOB_DEBUG - qprintf("globexp2:", patbuf); + qprintf("globexp2:", patbuf); #endif /* GLOB_DEBUG */ - *rv = globexp1(patbuf, pglob); - - /* move after the comma, to the next string */ - pl = pm + 1; - } - break; - - default: - break; - } - } - *rv = 0; - return 0; + *rv = globexp1(patbuf, pglob); + + /* move after the comma, to the next string */ + pl = pm + 1; + } + break; + + default: + break; + } + } + *rv = 0; + return 0; } @@ -431,76 +431,76 @@ globexp2(const Char *ptr, const Char *pattern, static const Char * globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) { - char *h; - const Char *p; - Char *b, *eb; + char *h; + const Char *p; + Char *b, *eb; - if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE)) - return pattern; + if (*pattern != BG_TILDE || !(pglob->gl_flags & GLOB_TILDE)) + return pattern; - /* Copy up to the end of the string or / */ - eb = &patbuf[patbuf_len - 1]; - for (p = pattern + 1, h = (char *) patbuf; - h < (char*)eb && *p && *p != BG_SLASH; *h++ = (char)*p++) - ; + /* Copy up to the end of the string or / */ + eb = &patbuf[patbuf_len - 1]; + for (p = pattern + 1, h = (char *) patbuf; + h < (char*)eb && *p && *p != BG_SLASH; *h++ = (char)*p++) + ; - *h = BG_EOS; + *h = BG_EOS; #if 0 - if (h == (char *)eb) - return what; + if (h == (char *)eb) + return what; #endif - if (((char *) patbuf)[0] == BG_EOS) { - /* - * handle a plain ~ or ~/ by expanding $HOME - * first and then trying the password file - * or $USERPROFILE on DOSISH systems - */ - if ((h = PerlEnv_getenv("HOME")) == NULL) { + if (((char *) patbuf)[0] == BG_EOS) { + /* + * handle a plain ~ or ~/ by expanding $HOME + * first and then trying the password file + * or $USERPROFILE on DOSISH systems + */ + if ((h = PerlEnv_getenv("HOME")) == NULL) { #ifdef HAS_PASSWD - struct passwd *pwd; - if ((pwd = getpwuid(getuid())) == NULL) - return pattern; - else - h = pwd->pw_dir; + struct passwd *pwd; + if ((pwd = getpwuid(getuid())) == NULL) + return pattern; + else + h = pwd->pw_dir; #elif DOSISH - /* - * When no passwd file, fallback to the USERPROFILE - * environment variable on DOSish systems. - */ - if ((h = PerlEnv_getenv("USERPROFILE")) == NULL) { - return pattern; - } + /* + * When no passwd file, fallback to the USERPROFILE + * environment variable on DOSish systems. + */ + if ((h = PerlEnv_getenv("USERPROFILE")) == NULL) { + return pattern; + } #else return pattern; #endif - } - } else { - /* - * Expand a ~user - */ + } + } else { + /* + * Expand a ~user + */ #ifdef HAS_PASSWD - struct passwd *pwd; - if ((pwd = getpwnam((char*) patbuf)) == NULL) - return pattern; - else - h = pwd->pw_dir; + struct passwd *pwd; + if ((pwd = getpwnam((char*) patbuf)) == NULL) + return pattern; + else + h = pwd->pw_dir; #else return pattern; #endif - } + } - /* Copy the home directory */ - for (b = patbuf; b < eb && *h; *b++ = *h++) - ; + /* Copy the home directory */ + for (b = patbuf; b < eb && *h; *b++ = *h++) + ; - /* Append the rest of the pattern */ - while (b < eb && (*b++ = *p++) != BG_EOS) - ; - *b = BG_EOS; + /* Append the rest of the pattern */ + while (b < eb && (*b++ = *p++) != BG_EOS) + ; + *b = BG_EOS; - return patbuf; + return patbuf; } @@ -514,142 +514,142 @@ globtilde(const Char *pattern, Char *patbuf, size_t patbuf_len, glob_t *pglob) static int glob0(const Char *pattern, glob_t *pglob) { - const Char *qpat, *qpatnext; - int c, err, oldflags, oldpathc; - Char *bufnext, patbuf[MAXPATHLEN]; - size_t limit = 0; - - qpat = globtilde(pattern, patbuf, MAXPATHLEN, pglob); - qpatnext = qpat; - oldflags = pglob->gl_flags; - oldpathc = pglob->gl_pathc; - bufnext = patbuf; - - /* We don't need to check for buffer overflow any more. */ - while ((c = *qpatnext++) != BG_EOS) { - switch (c) { - case BG_LBRACKET: - c = *qpatnext; - if (c == BG_NOT) - ++qpatnext; - if (*qpatnext == BG_EOS || - g_strchr((Char *) qpatnext+1, BG_RBRACKET) == NULL) { - *bufnext++ = BG_LBRACKET; - if (c == BG_NOT) - --qpatnext; - break; - } - *bufnext++ = M_SET; - if (c == BG_NOT) - *bufnext++ = M_NOT; - c = *qpatnext++; - do { - *bufnext++ = CHAR(c); - if (*qpatnext == BG_RANGE && - (c = qpatnext[1]) != BG_RBRACKET) { - *bufnext++ = M_RNG; - *bufnext++ = CHAR(c); - qpatnext += 2; - } - } while ((c = *qpatnext++) != BG_RBRACKET); - pglob->gl_flags |= GLOB_MAGCHAR; - *bufnext++ = M_END; - break; - case BG_QUESTION: - pglob->gl_flags |= GLOB_MAGCHAR; - *bufnext++ = M_ONE; - break; - case BG_STAR: - pglob->gl_flags |= GLOB_MAGCHAR; + const Char *qpat, *qpatnext; + int c, err, oldflags, oldpathc; + Char *bufnext, patbuf[MAXPATHLEN]; + size_t limit = 0; + + qpat = globtilde(pattern, patbuf, MAXPATHLEN, pglob); + qpatnext = qpat; + oldflags = pglob->gl_flags; + oldpathc = pglob->gl_pathc; + bufnext = patbuf; + + /* We don't need to check for buffer overflow any more. */ + while ((c = *qpatnext++) != BG_EOS) { + switch (c) { + case BG_LBRACKET: + c = *qpatnext; + if (c == BG_NOT) + ++qpatnext; + if (*qpatnext == BG_EOS || + g_strchr((Char *) qpatnext+1, BG_RBRACKET) == NULL) { + *bufnext++ = BG_LBRACKET; + if (c == BG_NOT) + --qpatnext; + break; + } + *bufnext++ = M_SET; + if (c == BG_NOT) + *bufnext++ = M_NOT; + c = *qpatnext++; + do { + *bufnext++ = CHAR(c); + if (*qpatnext == BG_RANGE && + (c = qpatnext[1]) != BG_RBRACKET) { + *bufnext++ = M_RNG; + *bufnext++ = CHAR(c); + qpatnext += 2; + } + } while ((c = *qpatnext++) != BG_RBRACKET); + pglob->gl_flags |= GLOB_MAGCHAR; + *bufnext++ = M_END; + break; + case BG_QUESTION: + pglob->gl_flags |= GLOB_MAGCHAR; + *bufnext++ = M_ONE; + break; + case BG_STAR: + pglob->gl_flags |= GLOB_MAGCHAR; /* Collapse adjacent stars to one. * This is required to ensure that a pattern like * "a**" matches a name like "a", as without this * check when the first star matched everything it would * cause the second star to return a match fail. * As long ** is folded here this does not happen. - */ - if (bufnext == patbuf || bufnext[-1] != M_ALL) - *bufnext++ = M_ALL; - break; - default: - *bufnext++ = CHAR(c); - break; - } - } - *bufnext = BG_EOS; + */ + if (bufnext == patbuf || bufnext[-1] != M_ALL) + *bufnext++ = M_ALL; + break; + default: + *bufnext++ = CHAR(c); + break; + } + } + *bufnext = BG_EOS; #ifdef GLOB_DEBUG - qprintf("glob0:", patbuf); + qprintf("glob0:", patbuf); #endif /* GLOB_DEBUG */ - if ((err = glob1(patbuf, patbuf+MAXPATHLEN-1, pglob, &limit)) != 0) { - pglob->gl_flags = oldflags; - return(err); - } - - /* - * If there was no match we are going to append the pattern - * if GLOB_NOCHECK was specified or if GLOB_NOMAGIC was specified - * and the pattern did not contain any magic characters - * GLOB_NOMAGIC is there just for compatibility with csh. - */ - if (pglob->gl_pathc == oldpathc && - ((pglob->gl_flags & GLOB_NOCHECK) || - ((pglob->gl_flags & GLOB_NOMAGIC) && - !(pglob->gl_flags & GLOB_MAGCHAR)))) - { + if ((err = glob1(patbuf, patbuf+MAXPATHLEN-1, pglob, &limit)) != 0) { + pglob->gl_flags = oldflags; + return(err); + } + + /* + * If there was no match we are going to append the pattern + * if GLOB_NOCHECK was specified or if GLOB_NOMAGIC was specified + * and the pattern did not contain any magic characters + * GLOB_NOMAGIC is there just for compatibility with csh. + */ + if (pglob->gl_pathc == oldpathc && + ((pglob->gl_flags & GLOB_NOCHECK) || + ((pglob->gl_flags & GLOB_NOMAGIC) && + !(pglob->gl_flags & GLOB_MAGCHAR)))) + { #ifdef GLOB_DEBUG - printf("calling globextend from glob0\n"); + printf("calling globextend from glob0\n"); #endif /* GLOB_DEBUG */ - pglob->gl_flags = oldflags; - return(globextend(qpat, pglob, &limit)); + pglob->gl_flags = oldflags; + return(globextend(qpat, pglob, &limit)); } - else if (!(pglob->gl_flags & GLOB_NOSORT)) + else if (!(pglob->gl_flags & GLOB_NOSORT)) if (pglob->gl_pathv) - qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, - pglob->gl_pathc - oldpathc, sizeof(char *), - (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE)) - ? ci_compare : compare); - pglob->gl_flags = oldflags; - return(0); + qsort(pglob->gl_pathv + pglob->gl_offs + oldpathc, + pglob->gl_pathc - oldpathc, sizeof(char *), + (pglob->gl_flags & (GLOB_ALPHASORT|GLOB_NOCASE)) + ? ci_compare : compare); + pglob->gl_flags = oldflags; + return(0); } static int ci_compare(const void *p, const void *q) { - const char *pp = *(const char **)p; - const char *qq = *(const char **)q; - int ci; - while (*pp && *qq) { - if (toFOLD(*pp) != toFOLD(*qq)) - break; - ++pp; - ++qq; - } - ci = toFOLD(*pp) - toFOLD(*qq); - if (ci == 0) - return compare(p, q); - return ci; + const char *pp = *(const char **)p; + const char *qq = *(const char **)q; + int ci; + while (*pp && *qq) { + if (toFOLD(*pp) != toFOLD(*qq)) + break; + ++pp; + ++qq; + } + ci = toFOLD(*pp) - toFOLD(*qq); + if (ci == 0) + return compare(p, q); + return ci; } static int compare(const void *p, const void *q) { - return(strcmp(*(char **)p, *(char **)q)); + return(strcmp(*(char **)p, *(char **)q)); } static int glob1(Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { - Char pathbuf[MAXPATHLEN]; + Char pathbuf[MAXPATHLEN]; assert(pattern < pattern_last); - /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */ - if (*pattern == BG_EOS) - return(0); - return(glob2(pathbuf, pathbuf+MAXPATHLEN-1, - pathbuf, pathbuf+MAXPATHLEN-1, - pattern, pattern_last, pglob, limitp)); + /* A null pathname is invalid -- POSIX 1003.1 sect. 2.4. */ + if (*pattern == BG_EOS) + return(0); + return(glob2(pathbuf, pathbuf+MAXPATHLEN-1, + pathbuf, pathbuf+MAXPATHLEN-1, + pattern, pattern_last, pglob, limitp)); } /* @@ -661,79 +661,79 @@ static int glob2(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, Char *pattern, Char *pattern_last, glob_t *pglob, size_t *limitp) { - Stat_t sb; - Char *p, *q; - int anymeta; + Stat_t sb; + Char *p, *q; + int anymeta; assert(pattern < pattern_last); - /* - * Loop over pattern segments until end of pattern or until - * segment with meta character found. - */ - for (anymeta = 0;;) { - if (*pattern == BG_EOS) { /* End of pattern? */ - *pathend = BG_EOS; - if (g_lstat(pathbuf, &sb, pglob)) - return(0); - - if (((pglob->gl_flags & GLOB_MARK) && - pathend[-1] != BG_SEP + /* + * Loop over pattern segments until end of pattern or until + * segment with meta character found. + */ + for (anymeta = 0;;) { + if (*pattern == BG_EOS) { /* End of pattern? */ + *pathend = BG_EOS; + if (g_lstat(pathbuf, &sb, pglob)) + return(0); + + if (((pglob->gl_flags & GLOB_MARK) && + pathend[-1] != BG_SEP #ifdef DOSISH - && pathend[-1] != BG_SEP2 + && pathend[-1] != BG_SEP2 #endif - ) && (S_ISDIR(sb.st_mode) || - (S_ISLNK(sb.st_mode) && - (g_stat(pathbuf, &sb, pglob) == 0) && - S_ISDIR(sb.st_mode)))) { - if (pathend+1 > pathend_last) - return (1); - *pathend++ = BG_SEP; - *pathend = BG_EOS; - } - ++pglob->gl_matchc; + ) && (S_ISDIR(sb.st_mode) || + (S_ISLNK(sb.st_mode) && + (g_stat(pathbuf, &sb, pglob) == 0) && + S_ISDIR(sb.st_mode)))) { + if (pathend+1 > pathend_last) + return (1); + *pathend++ = BG_SEP; + *pathend = BG_EOS; + } + ++pglob->gl_matchc; #ifdef GLOB_DEBUG printf("calling globextend from glob2\n"); #endif /* GLOB_DEBUG */ - return(globextend(pathbuf, pglob, limitp)); - } + return(globextend(pathbuf, pglob, limitp)); + } - /* Find end of next segment, copy tentatively to pathend. */ - q = pathend; - p = pattern; - while (*p != BG_EOS && *p != BG_SEP + /* Find end of next segment, copy tentatively to pathend. */ + q = pathend; + p = pattern; + while (*p != BG_EOS && *p != BG_SEP #ifdef DOSISH - && *p != BG_SEP2 + && *p != BG_SEP2 #endif - ) { + ) { assert(p < pattern_last); - if (ismeta(*p)) - anymeta = 1; - if (q+1 > pathend_last) - return (1); - *q++ = *p++; - } - - if (!anymeta) { /* No expansion, do next segment. */ - pathend = q; - pattern = p; - while (*pattern == BG_SEP + if (ismeta(*p)) + anymeta = 1; + if (q+1 > pathend_last) + return (1); + *q++ = *p++; + } + + if (!anymeta) { /* No expansion, do next segment. */ + pathend = q; + pattern = p; + while (*pattern == BG_SEP #ifdef DOSISH - || *pattern == BG_SEP2 + || *pattern == BG_SEP2 #endif - ) { + ) { assert(p < pattern_last); - if (pathend+1 > pathend_last) - return (1); - *pathend++ = *pattern++; - } - } else - /* Need expansion, recurse. */ - return(glob3(pathbuf, pathbuf_last, pathend, - pathend_last, pattern, - p, pattern_last, pglob, limitp)); - } - /* NOTREACHED */ + if (pathend+1 > pathend_last) + return (1); + *pathend++ = *pattern++; + } + } else + /* Need expansion, recurse. */ + return(glob3(pathbuf, pathbuf_last, pathend, + pathend_last, pattern, + p, pattern_last, pglob, limitp)); + } + /* NOTREACHED */ } static int @@ -741,97 +741,97 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, Char *pattern, Char *restpattern, Char *restpattern_last, glob_t *pglob, size_t *limitp) { - Direntry_t *dp; - DIR *dirp; - int err; - int nocase; - char buf[MAXPATHLEN]; - - /* - * The readdirfunc declaration can't be prototyped, because it is - * assigned, below, to two functions which are prototyped in glob.h - * and dirent.h as taking pointers to differently typed opaque - * structures. - */ - Direntry_t *(*readdirfunc)(DIR*); + Direntry_t *dp; + DIR *dirp; + int err; + int nocase; + char buf[MAXPATHLEN]; + + /* + * The readdirfunc declaration can't be prototyped, because it is + * assigned, below, to two functions which are prototyped in glob.h + * and dirent.h as taking pointers to differently typed opaque + * structures. + */ + Direntry_t *(*readdirfunc)(DIR*); assert(pattern < restpattern_last); assert(restpattern < restpattern_last); - if (pathend > pathend_last) - return (1); - *pathend = BG_EOS; - errno = 0; + if (pathend > pathend_last) + return (1); + *pathend = BG_EOS; + errno = 0; #ifdef VMS { - Char *q = pathend; - if (q - pathbuf > 5) { - q -= 5; - if (q[0] == '.' && - tolower(q[1]) == 'd' && tolower(q[2]) == 'i' && - tolower(q[3]) == 'r' && q[4] == '/') - { - q[0] = '/'; - q[1] = BG_EOS; - pathend = q+1; - } - } + Char *q = pathend; + if (q - pathbuf > 5) { + q -= 5; + if (q[0] == '.' && + tolower(q[1]) == 'd' && tolower(q[2]) == 'i' && + tolower(q[3]) == 'r' && q[4] == '/') + { + q[0] = '/'; + q[1] = BG_EOS; + pathend = q+1; + } + } } #endif - if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { - /* TODO: don't call for ENOENT or ENOTDIR? */ - if (pglob->gl_errfunc) { - if (g_Ctoc(pathbuf, buf, sizeof(buf))) - return (GLOB_ABEND); - if (pglob->gl_errfunc(buf, errno) || - (pglob->gl_flags & GLOB_ERR)) - return (GLOB_ABEND); - } - return(0); - } - - err = 0; - nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0); - - /* Search directory for matching names. */ - if (pglob->gl_flags & GLOB_ALTDIRFUNC) - readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; - else - readdirfunc = (Direntry_t *(*)(DIR *))my_readdir; - while ((dp = (*readdirfunc)(dirp))) { - U8 *sc; - Char *dc; - - /* Initial BG_DOT must be matched literally. */ - if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT) - continue; - dc = pathend; - sc = (U8 *) dp->d_name; - while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS) - ; - if (dc >= pathend_last) { - *dc = BG_EOS; - err = 1; - break; - } - - if (!match(pathend, pattern, restpattern, nocase)) { - *pathend = BG_EOS; - continue; - } - err = glob2(pathbuf, pathbuf_last, --dc, pathend_last, - restpattern, restpattern_last, pglob, limitp); - if (err) - break; - } - - if (pglob->gl_flags & GLOB_ALTDIRFUNC) - (*pglob->gl_closedir)(dirp); - else - PerlDir_close(dirp); - return(err); + if ((dirp = g_opendir(pathbuf, pglob)) == NULL) { + /* TODO: don't call for ENOENT or ENOTDIR? */ + if (pglob->gl_errfunc) { + if (g_Ctoc(pathbuf, buf, sizeof(buf))) + return (GLOB_ABEND); + if (pglob->gl_errfunc(buf, errno) || + (pglob->gl_flags & GLOB_ERR)) + return (GLOB_ABEND); + } + return(0); + } + + err = 0; + nocase = ((pglob->gl_flags & GLOB_NOCASE) != 0); + + /* Search directory for matching names. */ + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + readdirfunc = (Direntry_t *(*)(DIR *))pglob->gl_readdir; + else + readdirfunc = (Direntry_t *(*)(DIR *))my_readdir; + while ((dp = (*readdirfunc)(dirp))) { + U8 *sc; + Char *dc; + + /* Initial BG_DOT must be matched literally. */ + if (dp->d_name[0] == BG_DOT && *pattern != BG_DOT) + continue; + dc = pathend; + sc = (U8 *) dp->d_name; + while (dc < pathend_last && (*dc++ = *sc++) != BG_EOS) + ; + if (dc >= pathend_last) { + *dc = BG_EOS; + err = 1; + break; + } + + if (!match(pathend, pattern, restpattern, nocase)) { + *pathend = BG_EOS; + continue; + } + err = glob2(pathbuf, pathbuf_last, --dc, pathend_last, + restpattern, restpattern_last, pglob, limitp); + if (err) + break; + } + + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + (*pglob->gl_closedir)(dirp); + else + PerlDir_close(dirp); + return(err); } @@ -852,61 +852,61 @@ glob3(Char *pathbuf, Char *pathbuf_last, Char *pathend, Char *pathend_last, static int globextend(const Char *path, glob_t *pglob, size_t *limitp) { - char **pathv; - int i; - STRLEN newsize, len; - char *copy; - const Char *p; + char **pathv; + int i; + STRLEN newsize, len; + char *copy; + const Char *p; #ifdef GLOB_DEBUG - printf("Adding "); + printf("Adding "); for (p = path; *p; p++) (void)printf("%c", CHAR(*p)); printf("\n"); #endif /* GLOB_DEBUG */ - newsize = sizeof(*pathv) * (2 + pglob->gl_pathc + pglob->gl_offs); - if (pglob->gl_pathv) - pathv = Renew(pglob->gl_pathv,newsize,char*); - else - Newx(pathv,newsize,char*); - if (pathv == NULL) { - if (pglob->gl_pathv) { - Safefree(pglob->gl_pathv); - pglob->gl_pathv = NULL; - } - return(GLOB_NOSPACE); - } - - if (pglob->gl_pathv == NULL && pglob->gl_offs > 0) { - /* first time around -- clear initial gl_offs items */ - pathv += pglob->gl_offs; - for (i = pglob->gl_offs; --i >= 0; ) - *--pathv = NULL; - } - pglob->gl_pathv = pathv; - - for (p = path; *p++;) - ; - len = (STRLEN)(p - path); - *limitp += len; - Newx(copy, p-path, char); - if (copy != NULL) { - if (g_Ctoc(path, copy, len)) { - Safefree(copy); - return(GLOB_NOSPACE); - } - pathv[pglob->gl_offs + pglob->gl_pathc++] = copy; - } - pathv[pglob->gl_offs + pglob->gl_pathc] = NULL; - - if ((pglob->gl_flags & GLOB_LIMIT) && - newsize + *limitp >= (unsigned long)ARG_MAX) { - errno = 0; - return(GLOB_NOSPACE); - } - - return(copy == NULL ? GLOB_NOSPACE : 0); + newsize = sizeof(*pathv) * (2 + pglob->gl_pathc + pglob->gl_offs); + if (pglob->gl_pathv) + pathv = Renew(pglob->gl_pathv,newsize,char*); + else + Newx(pathv,newsize,char*); + if (pathv == NULL) { + if (pglob->gl_pathv) { + Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; + } + return(GLOB_NOSPACE); + } + + if (pglob->gl_pathv == NULL && pglob->gl_offs > 0) { + /* first time around -- clear initial gl_offs items */ + pathv += pglob->gl_offs; + for (i = pglob->gl_offs; --i >= 0; ) + *--pathv = NULL; + } + pglob->gl_pathv = pathv; + + for (p = path; *p++;) + ; + len = (STRLEN)(p - path); + *limitp += len; + Newx(copy, p-path, char); + if (copy != NULL) { + if (g_Ctoc(path, copy, len)) { + Safefree(copy); + return(GLOB_NOSPACE); + } + pathv[pglob->gl_offs + pglob->gl_pathc++] = copy; + } + pathv[pglob->gl_offs + pglob->gl_pathc] = NULL; + + if ((pglob->gl_flags & GLOB_LIMIT) && + newsize + *limitp >= (unsigned long)ARG_MAX) { + errno = 0; + return(GLOB_NOSPACE); + } + + return(copy == NULL ? GLOB_NOSPACE : 0); } @@ -930,171 +930,171 @@ globextend(const Char *path, glob_t *pglob, size_t *limitp) static int match(Char *name, Char *pat, Char *patend, int nocase) { - int ok, negate_range; - Char c, k; - Char *nextp = NULL; - Char *nextn = NULL; + int ok, negate_range; + Char c, k; + Char *nextp = NULL; + Char *nextn = NULL; redo: - while (pat < patend) { - c = *pat++; - switch (c & M_MASK) { - case M_ALL: - if (pat == patend) - return(1); - if (*name == BG_EOS) - return 0; - nextn = name + 1; - nextp = pat - 1; - break; - case M_ONE: + while (pat < patend) { + c = *pat++; + switch (c & M_MASK) { + case M_ALL: + if (pat == patend) + return(1); + if (*name == BG_EOS) + return 0; + nextn = name + 1; + nextp = pat - 1; + break; + case M_ONE: /* since * matches leftmost-shortest first * * if we encounter the EOS then backtracking * * will not help, so we can exit early here. */ - if (*name++ == BG_EOS) + if (*name++ == BG_EOS) return 0; - break; - case M_SET: - ok = 0; + break; + case M_SET: + ok = 0; /* since * matches leftmost-shortest first * * if we encounter the EOS then backtracking * * will not help, so we can exit early here. */ - if ((k = *name++) == BG_EOS) + if ((k = *name++) == BG_EOS) return 0; - if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS) - ++pat; - while (((c = *pat++) & M_MASK) != M_END) - if ((*pat & M_MASK) == M_RNG) { - if (nocase) { - if (tolower(c) <= tolower(k) && tolower(k) <= tolower(pat[1])) - ok = 1; - } else { - if (c <= k && k <= pat[1]) - ok = 1; - } - pat += 2; - } else if (nocase ? (tolower(c) == tolower(k)) : (c == k)) - ok = 1; - if (ok == negate_range) - goto fail; - break; - default: - k = *name++; - if (nocase ? (tolower(k) != tolower(c)) : (k != c)) - goto fail; - break; - } - } - if (*name == BG_EOS) - return 1; + if ((negate_range = ((*pat & M_MASK) == M_NOT)) != BG_EOS) + ++pat; + while (((c = *pat++) & M_MASK) != M_END) + if ((*pat & M_MASK) == M_RNG) { + if (nocase) { + if (tolower(c) <= tolower(k) && tolower(k) <= tolower(pat[1])) + ok = 1; + } else { + if (c <= k && k <= pat[1]) + ok = 1; + } + pat += 2; + } else if (nocase ? (tolower(c) == tolower(k)) : (c == k)) + ok = 1; + if (ok == negate_range) + goto fail; + break; + default: + k = *name++; + if (nocase ? (tolower(k) != tolower(c)) : (k != c)) + goto fail; + break; + } + } + if (*name == BG_EOS) + return 1; fail: - if (nextn) { - pat = nextp; - name = nextn; - goto redo; - } - return 0; + if (nextn) { + pat = nextp; + name = nextn; + goto redo; + } + return 0; } /* Free allocated data belonging to a glob_t structure. */ void bsd_globfree(glob_t *pglob) { - int i; - char **pp; - - if (pglob->gl_pathv != NULL) { - pp = pglob->gl_pathv + pglob->gl_offs; - for (i = pglob->gl_pathc; i--; ++pp) - if (*pp) - Safefree(*pp); - Safefree(pglob->gl_pathv); - pglob->gl_pathv = NULL; - } + int i; + char **pp; + + if (pglob->gl_pathv != NULL) { + pp = pglob->gl_pathv + pglob->gl_offs; + for (i = pglob->gl_pathc; i--; ++pp) + if (*pp) + Safefree(*pp); + Safefree(pglob->gl_pathv); + pglob->gl_pathv = NULL; + } } static DIR * g_opendir(Char *str, glob_t *pglob) { - char buf[MAXPATHLEN]; + char buf[MAXPATHLEN]; - if (!*str) { - my_strlcpy(buf, ".", sizeof(buf)); - } else { - if (g_Ctoc(str, buf, sizeof(buf))) - return(NULL); - } + if (!*str) { + my_strlcpy(buf, ".", sizeof(buf)); + } else { + if (g_Ctoc(str, buf, sizeof(buf))) + return(NULL); + } - if (pglob->gl_flags & GLOB_ALTDIRFUNC) - return((DIR*)(*pglob->gl_opendir)(buf)); + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((DIR*)(*pglob->gl_opendir)(buf)); - return(PerlDir_open(buf)); + return(PerlDir_open(buf)); } static int g_lstat(Char *fn, Stat_t *sb, glob_t *pglob) { - char buf[MAXPATHLEN]; + char buf[MAXPATHLEN]; - if (g_Ctoc(fn, buf, sizeof(buf))) - return(-1); - if (pglob->gl_flags & GLOB_ALTDIRFUNC) - return((*pglob->gl_lstat)(buf, sb)); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((*pglob->gl_lstat)(buf, sb)); #ifdef HAS_LSTAT - return(PerlLIO_lstat(buf, sb)); + return(PerlLIO_lstat(buf, sb)); #else - return(PerlLIO_stat(buf, sb)); + return(PerlLIO_stat(buf, sb)); #endif /* HAS_LSTAT */ } static int g_stat(Char *fn, Stat_t *sb, glob_t *pglob) { - char buf[MAXPATHLEN]; + char buf[MAXPATHLEN]; - if (g_Ctoc(fn, buf, sizeof(buf))) - return(-1); - if (pglob->gl_flags & GLOB_ALTDIRFUNC) - return((*pglob->gl_stat)(buf, sb)); - return(PerlLIO_stat(buf, sb)); + if (g_Ctoc(fn, buf, sizeof(buf))) + return(-1); + if (pglob->gl_flags & GLOB_ALTDIRFUNC) + return((*pglob->gl_stat)(buf, sb)); + return(PerlLIO_stat(buf, sb)); } static Char * g_strchr(Char *str, int ch) { - do { - if (*str == ch) - return (str); - } while (*str++); - return (NULL); + do { + if (*str == ch) + return (str); + } while (*str++); + return (NULL); } static int g_Ctoc(const Char *str, char *buf, STRLEN len) { - while (len--) { - if ((*buf++ = (char)*str++) == BG_EOS) - return (0); - } - return (1); + while (len--) { + if ((*buf++ = (char)*str++) == BG_EOS) + return (0); + } + return (1); } #ifdef GLOB_DEBUG static void qprintf(const char *str, Char *s) { - Char *p; - - (void)printf("%s:\n", str); - for (p = s; *p; p++) - (void)printf("%c", CHAR(*p)); - (void)printf("\n"); - for (p = s; *p; p++) - (void)printf("%c", *p & M_PROTECT ? '"' : ' '); - (void)printf("\n"); - for (p = s; *p; p++) - (void)printf("%c", ismeta(*p) ? '_' : ' '); - (void)printf("\n"); + Char *p; + + (void)printf("%s:\n", str); + for (p = s; *p; p++) + (void)printf("%c", CHAR(*p)); + (void)printf("\n"); + for (p = s; *p; p++) + (void)printf("%c", *p & M_PROTECT ? '"' : ' '); + (void)printf("\n"); + for (p = s; *p; p++) + (void)printf("%c", ismeta(*p) ? '_' : ' '); + (void)printf("\n"); } #endif /* GLOB_DEBUG */ diff --git a/ext/File-Glob/bsd_glob.h b/ext/File-Glob/bsd_glob.h index c913cff9d836..424591c925dd 100644 --- a/ext/File-Glob/bsd_glob.h +++ b/ext/File-Glob/bsd_glob.h @@ -39,24 +39,24 @@ /* #include */ typedef struct { - int gl_pathc; /* Count of total paths so far. */ - int gl_matchc; /* Count of paths matching pattern. */ - int gl_offs; /* Reserved at beginning of gl_pathv. */ - int gl_flags; /* Copy of flags parameter to glob. */ - char **gl_pathv; /* List of paths matching pattern. */ - /* Copy of errfunc parameter to glob. */ - int (*gl_errfunc)(const char *, int); + int gl_pathc; /* Count of total paths so far. */ + int gl_matchc; /* Count of paths matching pattern. */ + int gl_offs; /* Reserved at beginning of gl_pathv. */ + int gl_flags; /* Copy of flags parameter to glob. */ + char **gl_pathv; /* List of paths matching pattern. */ + /* Copy of errfunc parameter to glob. */ + int (*gl_errfunc)(const char *, int); - /* - * Alternate filesystem access methods for glob; replacement - * versions of closedir(3), readdir(3), opendir(3), stat(2) - * and lstat(2). - */ - void (*gl_closedir)(void *); - Direntry_t *(*gl_readdir)(void *); - void *(*gl_opendir)(const char *); - int (*gl_lstat)(const char *, Stat_t *); - int (*gl_stat)(const char *, Stat_t *); + /* + * Alternate filesystem access methods for glob; replacement + * versions of closedir(3), readdir(3), opendir(3), stat(2) + * and lstat(2). + */ + void (*gl_closedir)(void *); + Direntry_t *(*gl_readdir)(void *); + void *(*gl_opendir)(const char *); + int (*gl_lstat)(const char *, Stat_t *); + int (*gl_stat)(const char *, Stat_t *); } glob_t; #define GLOB_APPEND 0x0001 /* Append to output from previous call. */ @@ -75,7 +75,7 @@ typedef struct { #define GLOB_NOCASE 0x1000 /* Treat filenames without regard for case. */ #define GLOB_ALPHASORT 0x2000 /* Alphabetic, not ASCII sort, like csh. */ #define GLOB_LIMIT 0x4000 /* Limit pattern match output to ARG_MAX - (usually from limits.h). */ + (usually from limits.h). */ #define GLOB_NOSPACE (-1) /* Malloc call failed. */ #define GLOB_ABEND (-2) /* Unignored error. */ diff --git a/ext/SDBM_File/dba.c b/ext/SDBM_File/dba.c index b27c3e66a47b..84622137245e 100644 --- a/ext/SDBM_File/dba.c +++ b/ext/SDBM_File/dba.c @@ -13,75 +13,75 @@ extern void oops(); int main(int argc, char **argv) { - int n; - char *p; - char *name; - int pagf; + int n; + char *p; + char *name; + int pagf; - progname = argv[0]; + progname = argv[0]; - if (p = argv[1]) { - name = (char *) malloc((n = strlen(p)) + 5); - if (!name) - oops("cannot get memory"); + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + if (!name) + oops("cannot get memory"); - strcpy(name, p); - strcpy(name + n, ".pag"); + strcpy(name, p); + strcpy(name + n, ".pag"); - if ((pagf = open(name, O_RDONLY)) < 0) - oops("cannot open %s.", name); + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); - sdump(pagf); - } - else - oops("usage: %s dbname", progname); + sdump(pagf); + } + else + oops("usage: %s dbname", progname); - return 0; + return 0; } void sdump(int pagf) { - int b; - int n = 0; - int t = 0; - int o = 0; - int e; - char pag[PBLKSIZ]; + int b; + int n = 0; + int t = 0; + int o = 0; + int e; + char pag[PBLKSIZ]; - while ((b = read(pagf, pag, PBLKSIZ)) > 0) { - printf("#%d: ", n); - if (!okpage(pag)) - printf("bad\n"); - else { - printf("ok. "); - if (!(e = pagestat(pag))) - o++; - else - t += e; - } - n++; - } + while ((b = read(pagf, pag, PBLKSIZ)) > 0) { + printf("#%d: ", n); + if (!okpage(pag)) + printf("bad\n"); + else { + printf("ok. "); + if (!(e = pagestat(pag))) + o++; + else + t += e; + } + n++; + } - if (b == 0) - printf("%d pages (%d holes): %d entries\n", n, o, t); - else - oops("read failed: block %d", n); + if (b == 0) + printf("%d pages (%d holes): %d entries\n", n, o, t); + else + oops("read failed: block %d", n); } int pagestat(char *pag) { - int n; - int free; - short *ino = (short *) pag; + int n; + int free; + short *ino = (short *) pag; - if (!(n = ino[0])) - printf("no entries.\n"); - else { - free = ino[n] - (n + 1) * sizeof(short); - printf("%3d entries %2d%% used free %d.\n", - n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); - } - return n / 2; + if (!(n = ino[0])) + printf("no entries.\n"); + else { + free = ino[n] - (n + 1) * sizeof(short); + printf("%3d entries %2d%% used free %d.\n", + n / 2, ((PBLKSIZ - free) * 100) / PBLKSIZ, free); + } + return n / 2; } diff --git a/ext/SDBM_File/dbd.c b/ext/SDBM_File/dbd.c index df27d174a800..bd64d90a18a8 100644 --- a/ext/SDBM_File/dbd.c +++ b/ext/SDBM_File/dbd.c @@ -16,53 +16,53 @@ extern void oops(); int main(int argc, char **argv) { - int n; - char *p; - char *name; - int pagf; + int n; + char *p; + char *name; + int pagf; - progname = argv[0]; + progname = argv[0]; - if (p = argv[1]) { - name = (char *) malloc((n = strlen(p)) + 5); - if (!name) - oops("cannot get memory"); + if (p = argv[1]) { + name = (char *) malloc((n = strlen(p)) + 5); + if (!name) + oops("cannot get memory"); - strcpy(name, p); - strcpy(name + n, ".pag"); + strcpy(name, p); + strcpy(name + n, ".pag"); - if ((pagf = open(name, O_RDONLY)) < 0) - oops("cannot open %s.", name); + if ((pagf = open(name, O_RDONLY)) < 0) + oops("cannot open %s.", name); - sdump(pagf); - } - else - oops("usage: %s dbname", progname); - return 0; + sdump(pagf); + } + else + oops("usage: %s dbname", progname); + return 0; } void sdump(int pagf) { - int r; - int n = 0; - int o = 0; - char pag[PBLKSIZ]; - - while ((r = read(pagf, pag, PBLKSIZ)) > 0) { - if (!okpage(pag)) - fprintf(stderr, "%d: bad page.\n", n); - else if (empty(pag)) - o++; - else - dispage(pag); - n++; - } - - if (r == 0) - fprintf(stderr, "%d pages (%d holes).\n", n, o); - else - oops("read failed: block %d", n); + int r; + int n = 0; + int o = 0; + char pag[PBLKSIZ]; + + while ((r = read(pagf, pag, PBLKSIZ)) > 0) { + if (!okpage(pag)) + fprintf(stderr, "%d: bad page.\n", n); + else if (empty(pag)) + o++; + else + dispage(pag); + n++; + } + + if (r == 0) + fprintf(stderr, "%d pages (%d holes).\n", n, o); + else + oops("read failed: block %d", n); } @@ -70,44 +70,44 @@ sdump(int pagf) int dispage(char *pag) { - int i, n; - int off; - int short *ino = (short *) pag; - - off = PBLKSIZ; - for (i = 1; i < ino[0]; i += 2) { - printf("\t[%d]: ", ino[i]); - for (n = ino[i]; n < off; n++) - putchar(pag[n]); - putchar(' '); - off = ino[i]; - printf("[%d]: ", ino[i + 1]); - for (n = ino[i + 1]; n < off; n++) - putchar(pag[n]); - off = ino[i + 1]; - putchar('\n'); - } + int i, n; + int off; + int short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + printf("\t[%d]: ", ino[i]); + for (n = ino[i]; n < off; n++) + putchar(pag[n]); + putchar(' '); + off = ino[i]; + printf("[%d]: ", ino[i + 1]); + for (n = ino[i + 1]; n < off; n++) + putchar(pag[n]); + off = ino[i + 1]; + putchar('\n'); + } } #else void dispage(char *pag) { - int i, n; - int off; - short *ino = (short *) pag; - - off = PBLKSIZ; - for (i = 1; i < ino[0]; i += 2) { - for (n = ino[i]; n < off; n++) - if (pag[n] != 0) - putchar(pag[n]); - putchar('\t'); - off = ino[i]; - for (n = ino[i + 1]; n < off; n++) - if (pag[n] != 0) - putchar(pag[n]); - putchar('\n'); - off = ino[i + 1]; - } + int i, n; + int off; + short *ino = (short *) pag; + + off = PBLKSIZ; + for (i = 1; i < ino[0]; i += 2) { + for (n = ino[i]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\t'); + off = ino[i]; + for (n = ino[i + 1]; n < off; n++) + if (pag[n] != 0) + putchar(pag[n]); + putchar('\n'); + off = ino[i + 1]; + } } #endif diff --git a/ext/SDBM_File/dbe.c b/ext/SDBM_File/dbe.c index d1e3bd5e77c9..a53346b67e90 100644 --- a/ext/SDBM_File/dbe.c +++ b/ext/SDBM_File/dbe.c @@ -51,381 +51,381 @@ char *optarg; /* Global argument pointer. */ char getopt(int argc, char **argv, char *optstring) { - int c; - char *place; - static int optind = 0; - static char *scan = NULL; - - optarg = NULL; - - if (scan == NULL || *scan == '\0') { - - if (optind == 0) - optind++; - if (optind >= argc) - return ':'; - - optarg = place = argv[optind++]; - if (place[0] != '-' || place[1] == '\0') - return '?'; - if (place[1] == '-' && place[2] == '\0') - return '?'; - scan = place + 1; - } - - c = *scan++; - place = strchr(optstring, c); - if (place == NULL || c == ':' || c == ';') { - - (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); - scan = NULL; - return '!'; - } - if (*++place == ':') { - - if (*scan != '\0') { - - optarg = scan; - scan = NULL; - - } - else { - - if (optind >= argc) { - - (void) fprintf(stderr, "%s: %c requires an argument\n", - argv[0], c); - return '!'; - } - optarg = argv[optind]; - optind++; - } - } - else if (*place == ';') { - - if (*scan != '\0') { - - optarg = scan; - scan = NULL; - - } - else { - - if (optind >= argc || *argv[optind] == '-') - optarg = NULL; - else { - optarg = argv[optind]; - optind++; - } - } - } - return c; + int c; + char *place; + static int optind = 0; + static char *scan = NULL; + + optarg = NULL; + + if (scan == NULL || *scan == '\0') { + + if (optind == 0) + optind++; + if (optind >= argc) + return ':'; + + optarg = place = argv[optind++]; + if (place[0] != '-' || place[1] == '\0') + return '?'; + if (place[1] == '-' && place[2] == '\0') + return '?'; + scan = place + 1; + } + + c = *scan++; + place = strchr(optstring, c); + if (place == NULL || c == ':' || c == ';') { + + (void) fprintf(stderr, "%s: unknown option %c\n", argv[0], c); + scan = NULL; + return '!'; + } + if (*++place == ':') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc) { + + (void) fprintf(stderr, "%s: %c requires an argument\n", + argv[0], c); + return '!'; + } + optarg = argv[optind]; + optind++; + } + } + else if (*place == ';') { + + if (*scan != '\0') { + + optarg = scan; + scan = NULL; + + } + else { + + if (optind >= argc || *argv[optind] == '-') + optarg = NULL; + else { + optarg = argv[optind]; + optind++; + } + } + } + return c; } void print_datum(datum db) { - int i; - - putchar('"'); - for (i = 0; i < db.dsize; i++) { - if (isprint((unsigned char)db.dptr[i])) - putchar(db.dptr[i]); - else { - putchar('\\'); - putchar('0' + ((db.dptr[i] >> 6) & 0x07)); - putchar('0' + ((db.dptr[i] >> 3) & 0x07)); - putchar('0' + (db.dptr[i] & 0x07)); - } - } - putchar('"'); + int i; + + putchar('"'); + for (i = 0; i < db.dsize; i++) { + if (isprint((unsigned char)db.dptr[i])) + putchar(db.dptr[i]); + else { + putchar('\\'); + putchar('0' + ((db.dptr[i] >> 6) & 0x07)); + putchar('0' + ((db.dptr[i] >> 3) & 0x07)); + putchar('0' + (db.dptr[i] & 0x07)); + } + } + putchar('"'); } datum read_datum(char *s) { - datum db; - char *p; - int i; - - db.dsize = 0; - db.dptr = (char *) malloc(strlen(s) * sizeof(char)); - if (!db.dptr) - oops("cannot get memory"); - - for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { - if (*s == '\\') { - if (*++s == 'n') - *p = '\n'; - else if (*s == 'r') - *p = '\r'; - else if (*s == 'f') - *p = '\f'; - else if (*s == 't') - *p = '\t'; - else if (isdigit((unsigned char)*s) - && isdigit((unsigned char)*(s + 1)) - && isdigit((unsigned char)*(s + 2))) - { - i = (*s++ - '0') << 6; - i |= (*s++ - '0') << 3; - i |= *s - '0'; - *p = i; - } - else if (*s == '0') - *p = '\0'; - else - *p = *s; - } - else - *p = *s; - } - - return db; + datum db; + char *p; + int i; + + db.dsize = 0; + db.dptr = (char *) malloc(strlen(s) * sizeof(char)); + if (!db.dptr) + oops("cannot get memory"); + + for (p = db.dptr; *s != '\0'; p++, db.dsize++, s++) { + if (*s == '\\') { + if (*++s == 'n') + *p = '\n'; + else if (*s == 'r') + *p = '\r'; + else if (*s == 'f') + *p = '\f'; + else if (*s == 't') + *p = '\t'; + else if (isdigit((unsigned char)*s) + && isdigit((unsigned char)*(s + 1)) + && isdigit((unsigned char)*(s + 2))) + { + i = (*s++ - '0') << 6; + i |= (*s++ - '0') << 3; + i |= *s - '0'; + *p = i; + } + else if (*s == '0') + *p = '\0'; + else + *p = *s; + } + else + *p = *s; + } + + return db; } char * key2s(datum db) { - char *buf; - char *p1, *p2; - - buf = (char *) malloc((db.dsize + 1) * sizeof(char)); - if (!buf) - oops("cannot get memory"); - for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); - *p1 = '\0'; - return buf; + char *buf; + char *p1, *p2; + + buf = (char *) malloc((db.dsize + 1) * sizeof(char)); + if (!buf) + oops("cannot get memory"); + for (p1 = buf, p2 = db.dptr; *p2 != '\0'; *p1++ = *p2++); + *p1 = '\0'; + return buf; } int main(int argc, char **argv) { - typedef enum { - YOW, FETCH, STORE, DELETE, SCAN, REGEXP - } commands; - char opt; - int flags; - int giveusage = 0; - int verbose = 0; - commands what = YOW; - char *comarg[3]; - int st_flag = DBM_INSERT; - int argn; - DBM *db; - datum key; - datum content; - - flags = O_RDWR; - argn = 0; - - while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { - switch (opt) { - case 'a': - what = SCAN; - break; - case 'c': - flags |= O_CREAT; - break; - case 'd': - what = DELETE; - break; - case 'f': - what = FETCH; - break; - case 'F': - what = REGEXP; - break; - case 'm': - flags &= ~(000007); - if (strcmp(optarg, "r") == 0) - flags |= O_RDONLY; - else if (strcmp(optarg, "w") == 0) - flags |= O_WRONLY; - else if (strcmp(optarg, "rw") == 0) - flags |= O_RDWR; - else { - fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); - giveusage = 1; - } - break; - case 'r': - st_flag = DBM_REPLACE; - break; - case 's': - what = STORE; - break; - case 't': - flags |= O_TRUNC; - break; - case 'v': - verbose = 1; - break; - case 'x': - flags |= O_EXCL; - break; - case '!': - giveusage = 1; - break; - case '?': - if (argn < 3) - comarg[argn++] = optarg; - else { - fprintf(stderr, "Too many arguments.\n"); - giveusage = 1; - } - break; - } - } - - if (giveusage || what == YOW || argn < 1) { - fprintf(stderr, "Usage: %s database [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); - exit(-1); - } - - if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { - fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); - exit(-1); - } - - if (argn > 1) - key = read_datum(comarg[1]); - if (argn > 2) - content = read_datum(comarg[2]); - - switch (what) { - - case SCAN: - key = dbm_firstkey(db); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching first key\n"); - goto db_exit; - } - while (key.dptr != NULL) { - content = dbm_fetch(db, key); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching "); - print_datum(key); - printf("\n"); - goto db_exit; - } - print_datum(key); - printf(": "); - print_datum(content); - printf("\n"); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching next key\n"); - goto db_exit; - } - key = dbm_nextkey(db); - } - break; - - case REGEXP: - if (argn < 2) { - fprintf(stderr, "Missing regular expression.\n"); - goto db_exit; - } - if (re_comp(comarg[1])) { - fprintf(stderr, "Invalid regular expression\n"); - goto db_exit; - } - key = dbm_firstkey(db); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching first key\n"); - goto db_exit; - } - while (key.dptr != NULL) { - if (re_exec(key2s(key))) { - content = dbm_fetch(db, key); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching "); - print_datum(key); - printf("\n"); - goto db_exit; - } - print_datum(key); - printf(": "); - print_datum(content); - printf("\n"); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching next key\n"); - goto db_exit; - } - } - key = dbm_nextkey(db); - } - break; - - case FETCH: - if (argn < 2) { - fprintf(stderr, "Missing fetch key.\n"); - goto db_exit; - } - content = dbm_fetch(db, key); - if (dbm_error(db)) { - fprintf(stderr, "Error when fetching "); - print_datum(key); - printf("\n"); - goto db_exit; - } - if (content.dptr == NULL) { - fprintf(stderr, "Cannot find "); - print_datum(key); - printf("\n"); - goto db_exit; - } - print_datum(key); - printf(": "); - print_datum(content); - printf("\n"); - break; - - case DELETE: - if (argn < 2) { - fprintf(stderr, "Missing delete key.\n"); - goto db_exit; - } - if (dbm_delete(db, key) || dbm_error(db)) { - fprintf(stderr, "Error when deleting "); - print_datum(key); - printf("\n"); - goto db_exit; - } - if (verbose) { - print_datum(key); - printf(": DELETED\n"); - } - break; - - case STORE: - if (argn < 3) { - fprintf(stderr, "Missing key and/or content.\n"); - goto db_exit; - } - if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { - fprintf(stderr, "Error when storing "); - print_datum(key); - printf("\n"); - goto db_exit; - } - if (verbose) { - print_datum(key); - printf(": "); - print_datum(content); - printf(" STORED\n"); - } - break; - } + typedef enum { + YOW, FETCH, STORE, DELETE, SCAN, REGEXP + } commands; + char opt; + int flags; + int giveusage = 0; + int verbose = 0; + commands what = YOW; + char *comarg[3]; + int st_flag = DBM_INSERT; + int argn; + DBM *db; + datum key; + datum content; + + flags = O_RDWR; + argn = 0; + + while ((opt = getopt(argc, argv, "acdfFm:rstvx")) != ':') { + switch (opt) { + case 'a': + what = SCAN; + break; + case 'c': + flags |= O_CREAT; + break; + case 'd': + what = DELETE; + break; + case 'f': + what = FETCH; + break; + case 'F': + what = REGEXP; + break; + case 'm': + flags &= ~(000007); + if (strcmp(optarg, "r") == 0) + flags |= O_RDONLY; + else if (strcmp(optarg, "w") == 0) + flags |= O_WRONLY; + else if (strcmp(optarg, "rw") == 0) + flags |= O_RDWR; + else { + fprintf(stderr, "Invalid mode: \"%s\"\n", optarg); + giveusage = 1; + } + break; + case 'r': + st_flag = DBM_REPLACE; + break; + case 's': + what = STORE; + break; + case 't': + flags |= O_TRUNC; + break; + case 'v': + verbose = 1; + break; + case 'x': + flags |= O_EXCL; + break; + case '!': + giveusage = 1; + break; + case '?': + if (argn < 3) + comarg[argn++] = optarg; + else { + fprintf(stderr, "Too many arguments.\n"); + giveusage = 1; + } + break; + } + } + + if (giveusage || what == YOW || argn < 1) { + fprintf(stderr, "Usage: %s database [-m r|w|rw] [-crtx] -a|-d|-f|-F|-s [key [content]]\n", argv[0]); + exit(-1); + } + + if ((db = dbm_open(comarg[0], flags, 0777)) == NULL) { + fprintf(stderr, "Error opening database \"%s\"\n", comarg[0]); + exit(-1); + } + + if (argn > 1) + key = read_datum(comarg[1]); + if (argn > 2) + content = read_datum(comarg[2]); + + switch (what) { + + case SCAN: + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + key = dbm_nextkey(db); + } + break; + + case REGEXP: + if (argn < 2) { + fprintf(stderr, "Missing regular expression.\n"); + goto db_exit; + } + if (re_comp(comarg[1])) { + fprintf(stderr, "Invalid regular expression\n"); + goto db_exit; + } + key = dbm_firstkey(db); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching first key\n"); + goto db_exit; + } + while (key.dptr != NULL) { + if (re_exec(key2s(key))) { + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching next key\n"); + goto db_exit; + } + } + key = dbm_nextkey(db); + } + break; + + case FETCH: + if (argn < 2) { + fprintf(stderr, "Missing fetch key.\n"); + goto db_exit; + } + content = dbm_fetch(db, key); + if (dbm_error(db)) { + fprintf(stderr, "Error when fetching "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (content.dptr == NULL) { + fprintf(stderr, "Cannot find "); + print_datum(key); + printf("\n"); + goto db_exit; + } + print_datum(key); + printf(": "); + print_datum(content); + printf("\n"); + break; + + case DELETE: + if (argn < 2) { + fprintf(stderr, "Missing delete key.\n"); + goto db_exit; + } + if (dbm_delete(db, key) || dbm_error(db)) { + fprintf(stderr, "Error when deleting "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": DELETED\n"); + } + break; + + case STORE: + if (argn < 3) { + fprintf(stderr, "Missing key and/or content.\n"); + goto db_exit; + } + if (dbm_store(db, key, content, st_flag) || dbm_error(db)) { + fprintf(stderr, "Error when storing "); + print_datum(key); + printf("\n"); + goto db_exit; + } + if (verbose) { + print_datum(key); + printf(": "); + print_datum(content); + printf(" STORED\n"); + } + break; + } db_exit: - dbm_clearerr(db); - dbm_close(db); - if (dbm_error(db)) { - fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); - exit(-1); - } + dbm_clearerr(db); + dbm_close(db); + if (dbm_error(db)) { + fprintf(stderr, "Error closing database \"%s\"\n", comarg[0]); + exit(-1); + } } diff --git a/ext/SDBM_File/dbu.c b/ext/SDBM_File/dbu.c index ef1963d3501f..9cf48fa39777 100644 --- a/ext/SDBM_File/dbu.c +++ b/ext/SDBM_File/dbu.c @@ -28,30 +28,30 @@ static char *usage = "%s [-R] cat | look |... dbmname"; #define LINEMAX 8192 typedef struct { - char *sname; - int scode; - int flags; + char *sname; + int scode; + int flags; } cmd; static cmd cmds[] = { - "fetch", DLOOK, O_RDONLY, - "get", DLOOK, O_RDONLY, - "look", DLOOK, O_RDONLY, - "add", DINSERT, O_RDWR, - "insert", DINSERT, O_RDWR, - "store", DINSERT, O_RDWR, - "delete", DDELETE, O_RDWR, - "remove", DDELETE, O_RDWR, - "dump", DCAT, O_RDONLY, - "list", DCAT, O_RDONLY, - "cat", DCAT, O_RDONLY, - "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, - "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, - "build", DBUILD, O_RDWR | O_CREAT, - "squash", DPRESS, O_RDWR, - "compact", DPRESS, O_RDWR, - "compress", DPRESS, O_RDWR + "fetch", DLOOK, O_RDONLY, + "get", DLOOK, O_RDONLY, + "look", DLOOK, O_RDONLY, + "add", DINSERT, O_RDWR, + "insert", DINSERT, O_RDWR, + "store", DINSERT, O_RDWR, + "delete", DDELETE, O_RDWR, + "remove", DDELETE, O_RDWR, + "dump", DCAT, O_RDONLY, + "list", DCAT, O_RDONLY, + "cat", DCAT, O_RDONLY, + "creat", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "new", DCREAT, O_RDWR | O_CREAT | O_TRUNC, + "build", DBUILD, O_RDWR | O_CREAT, + "squash", DPRESS, O_RDWR, + "compact", DPRESS, O_RDWR, + "compress", DPRESS, O_RDWR }; #define CTABSIZ (sizeof (cmds)/sizeof (cmd)) @@ -62,173 +62,173 @@ static void badk(), doit(), prdatum(); int main(int argc, char **argv) { - int c; - cmd *act; - extern int optind; - extern char *optarg; - - progname = argv[0]; - - while ((c = getopt(argc, argv, "R")) != EOF) - switch (c) { - case 'R': /* raw processing */ - rflag++; - break; - - default: - oops("usage: %s", usage); - break; - } - - if ((argc -= optind) < 2) - oops("usage: %s", usage); - - if ((act = parse(argv[optind])) == NULL) - badk(argv[optind]); - optind++; - doit(act, argv[optind]); - return 0; + int c; + cmd *act; + extern int optind; + extern char *optarg; + + progname = argv[0]; + + while ((c = getopt(argc, argv, "R")) != EOF) + switch (c) { + case 'R': /* raw processing */ + rflag++; + break; + + default: + oops("usage: %s", usage); + break; + } + + if ((argc -= optind) < 2) + oops("usage: %s", usage); + + if ((act = parse(argv[optind])) == NULL) + badk(argv[optind]); + optind++; + doit(act, argv[optind]); + return 0; } static void doit(cmd *act, char *file) { - datum key; - datum val; - DBM *db; - char *op; - int n; - char *line; + datum key; + datum val; + DBM *db; + char *op; + int n; + char *line; #ifdef TIME - long start; - extern long time(); + long start; + extern long time(); #endif - if ((db = dbm_open(file, act->flags, 0644)) == NULL) - oops("cannot open: %s", file); - - if ((line = (char *) malloc(LINEMAX)) == NULL) - oops("%s: cannot get memory", "line alloc"); - - switch (act->scode) { - - case DLOOK: - while (fgets(line, LINEMAX, stdin) != NULL) { - n = strlen(line) - 1; - line[n] = 0; - key.dptr = line; - key.dsize = n; - val = dbm_fetch(db, key); - if (val.dptr != NULL) { - prdatum(stdout, val); - putchar('\n'); - continue; - } - prdatum(stderr, key); - fprintf(stderr, ": not found.\n"); - } - break; - case DINSERT: - break; - case DDELETE: - while (fgets(line, LINEMAX, stdin) != NULL) { - n = strlen(line) - 1; - line[n] = 0; - key.dptr = line; - key.dsize = n; - if (dbm_delete(db, key) == -1) { - prdatum(stderr, key); - fprintf(stderr, ": not found.\n"); - } - } - break; - case DCAT: - for (key = dbm_firstkey(db); key.dptr != 0; - key = dbm_nextkey(db)) { - prdatum(stdout, key); - putchar('\t'); - prdatum(stdout, dbm_fetch(db, key)); - putchar('\n'); - } - break; - case DBUILD: + if ((db = dbm_open(file, act->flags, 0644)) == NULL) + oops("cannot open: %s", file); + + if ((line = (char *) malloc(LINEMAX)) == NULL) + oops("%s: cannot get memory", "line alloc"); + + switch (act->scode) { + + case DLOOK: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + val = dbm_fetch(db, key); + if (val.dptr != NULL) { + prdatum(stdout, val); + putchar('\n'); + continue; + } + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + break; + case DINSERT: + break; + case DDELETE: + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + key.dsize = n; + if (dbm_delete(db, key) == -1) { + prdatum(stderr, key); + fprintf(stderr, ": not found.\n"); + } + } + break; + case DCAT: + for (key = dbm_firstkey(db); key.dptr != 0; + key = dbm_nextkey(db)) { + prdatum(stdout, key); + putchar('\t'); + prdatum(stdout, dbm_fetch(db, key)); + putchar('\n'); + } + break; + case DBUILD: #ifdef TIME - start = time(0); + start = time(0); #endif - while (fgets(line, LINEMAX, stdin) != NULL) { - n = strlen(line) - 1; - line[n] = 0; - key.dptr = line; - if ((op = strchr(line, '\t')) != 0) { - key.dsize = op - line; - *op++ = 0; - val.dptr = op; - val.dsize = line + n - op; - } - else - oops("bad input; %s", line); - - if (dbm_store(db, key, val, DBM_REPLACE) < 0) { - prdatum(stderr, key); - fprintf(stderr, ": "); - oops("store: %s", "failed"); - } - } + while (fgets(line, LINEMAX, stdin) != NULL) { + n = strlen(line) - 1; + line[n] = 0; + key.dptr = line; + if ((op = strchr(line, '\t')) != 0) { + key.dsize = op - line; + *op++ = 0; + val.dptr = op; + val.dsize = line + n - op; + } + else + oops("bad input; %s", line); + + if (dbm_store(db, key, val, DBM_REPLACE) < 0) { + prdatum(stderr, key); + fprintf(stderr, ": "); + oops("store: %s", "failed"); + } + } #ifdef TIME - printf("done: %d seconds.\n", time(0) - start); + printf("done: %d seconds.\n", time(0) - start); #endif - break; - case DPRESS: - break; - case DCREAT: - break; - } - - dbm_close(db); + break; + case DPRESS: + break; + case DCREAT: + break; + } + + dbm_close(db); } static void badk(char *word) { - int i; - - if (progname) - fprintf(stderr, "%s: ", progname); - fprintf(stderr, "bad keywd %s. use one of\n", word); - for (i = 0; i < (int)CTABSIZ; i++) - fprintf(stderr, "%-8s%c", cmds[i].sname, - ((i + 1) % 6 == 0) ? '\n' : ' '); - fprintf(stderr, "\n"); - exit(1); - /*NOTREACHED*/ + int i; + + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, "bad keywd %s. use one of\n", word); + for (i = 0; i < (int)CTABSIZ; i++) + fprintf(stderr, "%-8s%c", cmds[i].sname, + ((i + 1) % 6 == 0) ? '\n' : ' '); + fprintf(stderr, "\n"); + exit(1); + /*NOTREACHED*/ } static cmd * parse(char *str) { - int i = CTABSIZ; - cmd *p; - - for (p = cmds; i--; p++) - if (strcmp(p->sname, str) == 0) - return p; - return NULL; + int i = CTABSIZ; + cmd *p; + + for (p = cmds; i--; p++) + if (strcmp(p->sname, str) == 0) + return p; + return NULL; } static void prdatum(FILE *stream, datum d) { - int c; - U8 *p = (U8 *) d.dptr; - int n = d.dsize; + int c; + U8 *p = (U8 *) d.dptr; + int n = d.dsize; - while (n--) { - c = *p++; + while (n--) { + c = *p++; #ifndef EBCDIC /* Meta notation doesn't make sense on EBCDIC systems*/ - if (c & 0200) { + if (c & 0200) { fprintf(stream, "M-"); c &= 0177; - } + } #endif /* \c notation applies for \0 . \x1f, plus \c? */ if (c <= 0x1F || c == QUESTION_MARK_CTRL) { @@ -237,12 +237,12 @@ prdatum(FILE *stream, datum d) #ifdef EBCDIC /* Instead of meta, use \x{} for non-printables */ else if (! isPRINT_A(c)) { fprintf(stream, "\\x{%02x}", c); - } + } #endif - else { /* must be an ASCII printable */ + else { /* must be an ASCII printable */ putc(c, stream); } - } + } } diff --git a/ext/SDBM_File/sdbm.c b/ext/SDBM_File/sdbm.c index d7839aa8c201..b81d1e30c1ac 100644 --- a/ext/SDBM_File/sdbm.c +++ b/ext/SDBM_File/sdbm.c @@ -29,7 +29,7 @@ */ #include /* See notes in perl.h about avoiding - extern int errno; */ + extern int errno; */ #ifdef __cplusplus extern "C" { #endif @@ -63,58 +63,58 @@ static int makroom(DBM *, long, int); #define OFF_DIR(off) (long) (off) * DBLKSIZ static const long masks[] = { - 000000000000, 000000000001, 000000000003, 000000000007, - 000000000017, 000000000037, 000000000077, 000000000177, - 000000000377, 000000000777, 000000001777, 000000003777, - 000000007777, 000000017777, 000000037777, 000000077777, - 000000177777, 000000377777, 000000777777, 000001777777, - 000003777777, 000007777777, 000017777777, 000037777777, - 000077777777, 000177777777, 000377777777, 000777777777, - 001777777777, 003777777777, 007777777777, 017777777777 + 000000000000, 000000000001, 000000000003, 000000000007, + 000000000017, 000000000037, 000000000077, 000000000177, + 000000000377, 000000000777, 000000001777, 000000003777, + 000000007777, 000000017777, 000000037777, 000000077777, + 000000177777, 000000377777, 000000777777, 000001777777, + 000003777777, 000007777777, 000017777777, 000037777777, + 000077777777, 000177777777, 000377777777, 000777777777, + 001777777777, 003777777777, 007777777777, 017777777777 }; DBM * sdbm_open(char *file, int flags, int mode) { - DBM *db; - char *dirname; - char *pagname; - size_t filelen; - const size_t dirfext_size = sizeof(DIRFEXT ""); - const size_t pagfext_size = sizeof(PAGFEXT ""); - - if (file == NULL || !*file) - return errno = EINVAL, (DBM *) NULL; + DBM *db; + char *dirname; + char *pagname; + size_t filelen; + const size_t dirfext_size = sizeof(DIRFEXT ""); + const size_t pagfext_size = sizeof(PAGFEXT ""); + + if (file == NULL || !*file) + return errno = EINVAL, (DBM *) NULL; /* * need space for two separate filenames */ - filelen = strlen(file); + filelen = strlen(file); - if ((dirname = (char *) malloc(filelen + dirfext_size - + filelen + pagfext_size)) == NULL) - return errno = ENOMEM, (DBM *) NULL; + if ((dirname = (char *) malloc(filelen + dirfext_size + + filelen + pagfext_size)) == NULL) + return errno = ENOMEM, (DBM *) NULL; /* * build the file names */ - memcpy(dirname, file, filelen); - memcpy(dirname + filelen, DIRFEXT, dirfext_size); - pagname = dirname + filelen + dirfext_size; - memcpy(pagname, file, filelen); - memcpy(pagname + filelen, PAGFEXT, pagfext_size); - - db = sdbm_prep(dirname, pagname, flags, mode); - free((char *) dirname); - return db; + memcpy(dirname, file, filelen); + memcpy(dirname + filelen, DIRFEXT, dirfext_size); + pagname = dirname + filelen + dirfext_size; + memcpy(pagname, file, filelen); + memcpy(pagname + filelen, PAGFEXT, pagfext_size); + + db = sdbm_prep(dirname, pagname, flags, mode); + free((char *) dirname); + return db; } DBM * sdbm_prep(char *dirname, char *pagname, int flags, int mode) { - DBM *db; - struct stat dstat; + DBM *db; + struct stat dstat; - if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) - return errno = ENOMEM, (DBM *) NULL; + if ((db = (DBM *) malloc(sizeof(DBM))) == NULL) + return errno = ENOMEM, (DBM *) NULL; db->flags = 0; db->hmask = 0; @@ -125,158 +125,158 @@ sdbm_prep(char *dirname, char *pagname, int flags, int mode) * as required by this package. Also set our internal * flag for RDONLY if needed. */ - if (flags & O_WRONLY) - flags = (flags & ~O_WRONLY) | O_RDWR; + if (flags & O_WRONLY) + flags = (flags & ~O_WRONLY) | O_RDWR; - else if ((flags & 03) == O_RDONLY) - db->flags = DBM_RDONLY; + else if ((flags & 03) == O_RDONLY) + db->flags = DBM_RDONLY; /* * open the files in sequence, and stat the dirfile. * If we fail anywhere, undo everything, return NULL. */ #if defined(OS2) || defined(MSDOS) || defined(WIN32) || defined(__CYGWIN__) - flags |= O_BINARY; + flags |= O_BINARY; # endif - if ((db->pagf = open(pagname, flags, mode)) > -1) { - if ((db->dirf = open(dirname, flags, mode)) > -1) { + if ((db->pagf = open(pagname, flags, mode)) > -1) { + if ((db->dirf = open(dirname, flags, mode)) > -1) { /* * need the dirfile size to establish max bit number. */ - if (fstat(db->dirf, &dstat) == 0) { + if (fstat(db->dirf, &dstat) == 0) { /* * zero size: either a fresh database, or one with a single, * unsplit data page: dirpage is all zeros. */ - db->dirbno = (!dstat.st_size) ? 0 : -1; - db->pagbno = -1; - db->maxbno = dstat.st_size * BYTESIZ; - - (void) memset(db->pagbuf, 0, PBLKSIZ); - (void) memset(db->dirbuf, 0, DBLKSIZ); - /* - * success - */ - return db; - } - (void) close(db->dirf); - } - (void) close(db->pagf); - } - free((char *) db); - return (DBM *) NULL; + db->dirbno = (!dstat.st_size) ? 0 : -1; + db->pagbno = -1; + db->maxbno = dstat.st_size * BYTESIZ; + + (void) memset(db->pagbuf, 0, PBLKSIZ); + (void) memset(db->dirbuf, 0, DBLKSIZ); + /* + * success + */ + return db; + } + (void) close(db->dirf); + } + (void) close(db->pagf); + } + free((char *) db); + return (DBM *) NULL; } void sdbm_close(DBM *db) { - if (db == NULL) - errno = EINVAL; - else { - (void) close(db->dirf); - (void) close(db->pagf); - free((char *) db); - } + if (db == NULL) + errno = EINVAL; + else { + (void) close(db->dirf); + (void) close(db->pagf); + free((char *) db); + } } datum sdbm_fetch(DBM *db, datum key) { - if (db == NULL || bad(key)) - return errno = EINVAL, nullitem; + if (db == NULL || bad(key)) + return errno = EINVAL, nullitem; - if (getpage(db, exhash(key))) - return getpair(db->pagbuf, key); + if (getpage(db, exhash(key))) + return getpair(db->pagbuf, key); - return ioerr(db), nullitem; + return ioerr(db), nullitem; } int sdbm_exists(DBM *db, datum key) { - if (db == NULL || bad(key)) - return errno = EINVAL, -1; + if (db == NULL || bad(key)) + return errno = EINVAL, -1; - if (getpage(db, exhash(key))) - return exipair(db->pagbuf, key); + if (getpage(db, exhash(key))) + return exipair(db->pagbuf, key); - return ioerr(db), -1; + return ioerr(db), -1; } int sdbm_delete(DBM *db, datum key) { - if (db == NULL || bad(key)) - return errno = EINVAL, -1; - if (sdbm_rdonly(db)) - return errno = EPERM, -1; - - if (getpage(db, exhash(key))) { - if (!delpair(db->pagbuf, key)) - return -1; + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; + + if (getpage(db, exhash(key))) { + if (!delpair(db->pagbuf, key)) + return -1; /* * update the page file */ - if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 - || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return ioerr(db), -1; + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; - return 0; - } + return 0; + } - return ioerr(db), -1; + return ioerr(db), -1; } int sdbm_store(DBM *db, datum key, datum val, int flags) { - int need; - long hash; + int need; + long hash; - if (db == NULL || bad(key)) - return errno = EINVAL, -1; - if (sdbm_rdonly(db)) - return errno = EPERM, -1; + if (db == NULL || bad(key)) + return errno = EINVAL, -1; + if (sdbm_rdonly(db)) + return errno = EPERM, -1; - need = key.dsize + val.dsize; + need = key.dsize + val.dsize; /* * is the pair too big (or too small) for this database ?? */ - if (need < 0 || need > PAIRMAX) - return errno = EINVAL, -1; + if (need < 0 || need > PAIRMAX) + return errno = EINVAL, -1; - if (getpage(db, (hash = exhash(key)))) { + if (getpage(db, (hash = exhash(key)))) { /* * if we need to replace, delete the key/data pair * first. If it is not there, ignore. */ - if (flags == DBM_REPLACE) - (void) delpair(db->pagbuf, key); + if (flags == DBM_REPLACE) + (void) delpair(db->pagbuf, key); #ifdef SEEDUPS - else if (duppair(db->pagbuf, key)) - return 1; + else if (duppair(db->pagbuf, key)) + return 1; #endif /* * if we do not have enough room, we have to split. */ - if (!fitpair(db->pagbuf, need)) - if (!makroom(db, hash, need)) - return ioerr(db), -1; + if (!fitpair(db->pagbuf, need)) + if (!makroom(db, hash, need)) + return ioerr(db), -1; /* * we have enough room or split is successful. insert the key, * and update the page file. */ - (void) putpair(db->pagbuf, key, val); - - if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 - || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return ioerr(db), -1; - /* - * success - */ - return 0; - } - - return ioerr(db), -1; + (void) putpair(db->pagbuf, key, val); + + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), -1; + /* + * success + */ + return 0; + } + + return ioerr(db), -1; } /* @@ -287,28 +287,28 @@ sdbm_store(DBM *db, datum key, datum val, int flags) static int makroom(DBM *db, long int hash, int need) { - long newp; - char twin[PBLKSIZ]; + long newp; + char twin[PBLKSIZ]; #if defined(DOSISH) || defined(WIN32) - char zer[PBLKSIZ]; - long oldtail; + char zer[PBLKSIZ]; + long oldtail; #endif - char *pag = db->pagbuf; - char *New = twin; - int smax = SPLTMAX; + char *pag = db->pagbuf; + char *New = twin; + int smax = SPLTMAX; #ifdef BADMESS - int rc; + int rc; #endif - do { + do { /* * split the current page */ - (void) splpage(pag, New, db->hmask + 1); + (void) splpage(pag, New, db->hmask + 1); /* * address of the new page */ - newp = (hash & db->hmask) | (db->hmask + 1); + newp = (hash & db->hmask) | (db->hmask + 1); /* * write delay, read avoidance/cache shuffle: @@ -320,65 +320,65 @@ makroom(DBM *db, long int hash, int need) */ #if defined(DOSISH) || defined(WIN32) - /* - * Fill hole with 0 if made it. - * (hole is NOT read as 0) - */ - oldtail = lseek(db->pagf, 0L, SEEK_END); - memset(zer, 0, PBLKSIZ); - while (OFF_PAG(newp) > oldtail) { - if (lseek(db->pagf, 0L, SEEK_END) < 0 || - write(db->pagf, zer, PBLKSIZ) < 0) { - - return 0; - } - oldtail += PBLKSIZ; - } + /* + * Fill hole with 0 if made it. + * (hole is NOT read as 0) + */ + oldtail = lseek(db->pagf, 0L, SEEK_END); + memset(zer, 0, PBLKSIZ); + while (OFF_PAG(newp) > oldtail) { + if (lseek(db->pagf, 0L, SEEK_END) < 0 || + write(db->pagf, zer, PBLKSIZ) < 0) { + + return 0; + } + oldtail += PBLKSIZ; + } #endif - if (hash & (db->hmask + 1)) { - if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 - || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return 0; - db->pagbno = newp; - (void) memcpy(pag, New, PBLKSIZ); - } - else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 - || write(db->pagf, New, PBLKSIZ) < 0) - return 0; - - if (!setdbit(db, db->curbit)) - return 0; + if (hash & (db->hmask + 1)) { + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + db->pagbno = newp; + (void) memcpy(pag, New, PBLKSIZ); + } + else if (lseek(db->pagf, OFF_PAG(newp), SEEK_SET) < 0 + || write(db->pagf, New, PBLKSIZ) < 0) + return 0; + + if (!setdbit(db, db->curbit)) + return 0; /* * see if we have enough room now */ - if (fitpair(pag, need)) - return 1; + if (fitpair(pag, need)) + return 1; /* * try again... update curbit and hmask as getpage would have * done. because of our update of the current page, we do not * need to read in anything. BUT we have to write the current * [deferred] page out, as the window of failure is too great. */ - db->curbit = 2 * db->curbit + - ((hash & (db->hmask + 1)) ? 2 : 1); - db->hmask |= db->hmask + 1; + db->curbit = 2 * db->curbit + + ((hash & (db->hmask + 1)) ? 2 : 1); + db->hmask |= db->hmask + 1; - if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 - || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return 0; + if (lseek(db->pagf, OFF_PAG(db->pagbno), SEEK_SET) < 0 + || write(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; - } while (--smax); + } while (--smax); /* * if we are here, this is real bad news. After SPLTMAX splits, * we still cannot fit the key. say goodnight. */ #ifdef BADMESS - rc = write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); - /* PERL_UNUSED_VAR() or PERL_UNUSED_RESULT() would be - * useful here but that would mean pulling in perl.h */ - (void)rc; + rc = write(2, "sdbm: cannot insert after SPLTMAX attempts.\n", 44); + /* PERL_UNUSED_VAR() or PERL_UNUSED_RESULT() would be + * useful here but that would mean pulling in perl.h */ + (void)rc; #endif - return 0; + return 0; } @@ -389,33 +389,33 @@ makroom(DBM *db, long int hash, int need) datum sdbm_firstkey(DBM *db) { - if (db == NULL) - return errno = EINVAL, nullitem; + if (db == NULL) + return errno = EINVAL, nullitem; /* * start at page 0 */ - if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 - || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return ioerr(db), nullitem; + if (lseek(db->pagf, OFF_PAG(0), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return ioerr(db), nullitem; if (!chkpage(db->pagbuf)) { errno = EINVAL; ioerr(db); db->pagbno = -1; return nullitem; } - db->pagbno = 0; - db->blkptr = 0; - db->keyptr = 0; + db->pagbno = 0; + db->blkptr = 0; + db->keyptr = 0; - return getnext(db); + return getnext(db); } datum sdbm_nextkey(DBM *db) { - if (db == NULL) - return errno = EINVAL, nullitem; - return getnext(db); + if (db == NULL) + return errno = EINVAL, nullitem; + return getnext(db); } /* @@ -424,106 +424,106 @@ sdbm_nextkey(DBM *db) static int getpage(DBM *db, long int hash) { - int hbit; - long dbit; - long pagb; + int hbit; + long dbit; + long pagb; - dbit = 0; - hbit = 0; - while (dbit < db->maxbno && getdbit(db, dbit)) - dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); + dbit = 0; + hbit = 0; + while (dbit < db->maxbno && getdbit(db, dbit)) + dbit = 2 * dbit + ((hash & (1 << hbit++)) ? 2 : 1); - debug(("dbit: %d...", dbit)); + debug(("dbit: %d...", dbit)); - db->curbit = dbit; - db->hmask = masks[hbit]; + db->curbit = dbit; + db->hmask = masks[hbit]; - pagb = hash & db->hmask; + pagb = hash & db->hmask; /* * see if the block we need is already in memory. * note: this lookaside cache has about 10% hit rate. */ - if (pagb != db->pagbno) { + if (pagb != db->pagbno) { /* * note: here, we assume a "hole" is read as 0s. * if not, must zero pagbuf first. */ - if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 - || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) - return 0; - if (!chkpage(db->pagbuf)) { + if (lseek(db->pagf, OFF_PAG(pagb), SEEK_SET) < 0 + || read(db->pagf, db->pagbuf, PBLKSIZ) < 0) + return 0; + if (!chkpage(db->pagbuf)) { errno = EINVAL; db->pagbno = -1; ioerr(db); return 0; } - db->pagbno = pagb; + db->pagbno = pagb; - debug(("pag read: %d\n", pagb)); - } - return 1; + debug(("pag read: %d\n", pagb)); + } + return 1; } static int getdbit(DBM *db, long int dbit) { - long c; - long dirb; - - c = dbit / BYTESIZ; - dirb = c / DBLKSIZ; - - if (dirb != db->dirbno) { - int got; - if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 - || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) - return 0; - if (got==0) - memset(db->dirbuf,0,DBLKSIZ); - db->dirbno = dirb; - - debug(("dir read: %d\n", dirb)); - } + long c; + long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + int got; + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) + return 0; + if (got==0) + memset(db->dirbuf,0,DBLKSIZ); + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } - return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); + return db->dirbuf[c % DBLKSIZ] & (1 << dbit % BYTESIZ); } static int setdbit(DBM *db, long int dbit) { - long c; - long dirb; - - c = dbit / BYTESIZ; - dirb = c / DBLKSIZ; - - if (dirb != db->dirbno) { - int got; - if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 - || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) - return 0; - if (got==0) - memset(db->dirbuf,0,DBLKSIZ); - db->dirbno = dirb; - - debug(("dir read: %d\n", dirb)); - } + long c; + long dirb; + + c = dbit / BYTESIZ; + dirb = c / DBLKSIZ; + + if (dirb != db->dirbno) { + int got; + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || (got=read(db->dirf, db->dirbuf, DBLKSIZ)) < 0) + return 0; + if (got==0) + memset(db->dirbuf,0,DBLKSIZ); + db->dirbno = dirb; + + debug(("dir read: %d\n", dirb)); + } - db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); + db->dirbuf[c % DBLKSIZ] |= (1 << dbit % BYTESIZ); #if 0 - if (dbit >= db->maxbno) - db->maxbno += DBLKSIZ * BYTESIZ; + if (dbit >= db->maxbno) + db->maxbno += DBLKSIZ * BYTESIZ; #else - if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) - db->maxbno=OFF_DIR((dirb+1))*BYTESIZ; + if (OFF_DIR((dirb+1))*BYTESIZ > db->maxbno) + db->maxbno=OFF_DIR((dirb+1))*BYTESIZ; #endif - if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 - || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) - return 0; + if (lseek(db->dirf, OFF_DIR(dirb), SEEK_SET) < 0 + || write(db->dirf, db->dirbuf, DBLKSIZ) < 0) + return 0; - return 1; + return 1; } /* @@ -533,33 +533,33 @@ setdbit(DBM *db, long int dbit) static datum getnext(DBM *db) { - datum key; + datum key; - for (;;) { - db->keyptr++; - key = getnkey(db->pagbuf, db->keyptr); - if (key.dptr != NULL) - return key; + for (;;) { + db->keyptr++; + key = getnkey(db->pagbuf, db->keyptr); + if (key.dptr != NULL) + return key; /* * we either run out, or there is nothing on this page.. * try the next one... If we lost our position on the * file, we will have to seek. */ - db->keyptr = 0; - if (db->pagbno != db->blkptr++) - if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) - break; - db->pagbno = db->blkptr; - if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) - break; - if (!chkpage(db->pagbuf)) { + db->keyptr = 0; + if (db->pagbno != db->blkptr++) + if (lseek(db->pagf, OFF_PAG(db->blkptr), SEEK_SET) < 0) + break; + db->pagbno = db->blkptr; + if (read(db->pagf, db->pagbuf, PBLKSIZ) <= 0) + break; + if (!chkpage(db->pagbuf)) { errno = EINVAL; db->pagbno = -1; ioerr(db); break; } - } + } - return ioerr(db), nullitem; + return ioerr(db), nullitem; } diff --git a/ext/SDBM_File/sdbm.h b/ext/SDBM_File/sdbm.h index 428303d30721..199a2eec0c22 100644 --- a/ext/SDBM_File/sdbm.h +++ b/ext/SDBM_File/sdbm.h @@ -11,7 +11,7 @@ #define PBLKSIZ 1024 #define PAIRMAX 1008 /* arbitrary on PBLKSIZ-N */ #define SPLTMAX 10 /* maximum allowed splits */ - /* for a single insertion */ + /* for a single insertion */ #ifdef VMS #define DIRFEXT ".sdbm_dir" #else @@ -20,19 +20,19 @@ #define PAGFEXT ".pag" typedef struct { - int dirf; /* directory file descriptor */ - int pagf; /* page file descriptor */ - int flags; /* status/error flags, see below */ - long maxbno; /* size of dirfile in bits */ - long curbit; /* current bit number */ - long hmask; /* current hash mask */ - long blkptr; /* current block for nextkey */ - int keyptr; /* current key for nextkey */ - long blkno; /* current page to read/write */ - long pagbno; /* current page in pagbuf */ - char pagbuf[PBLKSIZ]; /* page file block buffer */ - long dirbno; /* current block in dirbuf */ - char dirbuf[DBLKSIZ]; /* directory file block buffer */ + int dirf; /* directory file descriptor */ + int pagf; /* page file descriptor */ + int flags; /* status/error flags, see below */ + long maxbno; /* size of dirfile in bits */ + long curbit; /* current bit number */ + long hmask; /* current hash mask */ + long blkptr; /* current block for nextkey */ + int keyptr; /* current key for nextkey */ + long blkno; /* current page to read/write */ + long pagbno; /* current page in pagbuf */ + char pagbuf[PBLKSIZ]; /* page file block buffer */ + long dirbno; /* current block in dirbuf */ + char dirbuf[DBLKSIZ]; /* directory file block buffer */ } DBM; #define DBM_RDONLY 0x1 /* data base open read-only */ @@ -50,8 +50,8 @@ typedef struct { #define sdbm_pagfno(db) ((db)->pagf) typedef struct { - const char *dptr; - int dsize; + const char *dptr; + int dsize; } datum; extern const datum nullitem; diff --git a/ext/SDBM_File/tune.h b/ext/SDBM_File/tune.h index b95c8c8634ae..c4b36a058040 100644 --- a/ext/SDBM_File/tune.h +++ b/ext/SDBM_File/tune.h @@ -12,7 +12,7 @@ #define SEEDUPS /* always detect duplicates */ #define BADMESS /* generate a message for worst case: - cannot make room after SPLTMAX splits */ + cannot make room after SPLTMAX splits */ /* * misc */ diff --git a/ext/SDBM_File/util.c b/ext/SDBM_File/util.c index a58085d559ae..0fa93ef34134 100644 --- a/ext/SDBM_File/util.c +++ b/ext/SDBM_File/util.c @@ -8,40 +8,40 @@ void oops(char *s1, char *s2) { - extern int errno, sys_nerr; - extern char *sys_errlist[]; - extern char *progname; + extern int errno, sys_nerr; + extern char *sys_errlist[]; + extern char *progname; - if (progname) - fprintf(stderr, "%s: ", progname); - fprintf(stderr, s1, s2); - if (errno > 0 && errno < sys_nerr) - fprintf(stderr, " (%s)", sys_errlist[errno]); - fprintf(stderr, "\n"); - exit(1); + if (progname) + fprintf(stderr, "%s: ", progname); + fprintf(stderr, s1, s2); + if (errno > 0 && errno < sys_nerr) + fprintf(stderr, " (%s)", sys_errlist[errno]); + fprintf(stderr, "\n"); + exit(1); } int okpage(char *pag) { - unsigned n; - int off; - short *ino = (short *) pag; + unsigned n; + int off; + short *ino = (short *) pag; - if ((n = ino[0]) > PBLKSIZ / sizeof(short)) - return 0; + if ((n = ino[0]) > PBLKSIZ / sizeof(short)) + return 0; - if (!n) - return 1; + if (!n) + return 1; - off = PBLKSIZ; - for (ino++; n; ino += 2) { - if (ino[0] > off || ino[1] > off || - ino[1] > ino[0]) - return 0; - off = ino[1]; - n -= 2; - } + off = PBLKSIZ; + for (ino++; n; ino += 2) { + if (ino[0] > off || ino[1] > off || + ino[1] > ino[0]) + return 0; + off = ino[1]; + n -= 2; + } - return 1; + return 1; } diff --git a/ext/Win32CORE/Win32CORE.c b/ext/Win32CORE/Win32CORE.c index 6e5e1cec013d..6784e460feeb 100644 --- a/ext/Win32CORE/Win32CORE.c +++ b/ext/Win32CORE/Win32CORE.c @@ -64,78 +64,78 @@ init_Win32CORE(pTHX) */ static const struct { - char Win32__GetCwd [sizeof("Win32::GetCwd")]; - char Win32__SetCwd [sizeof("Win32::SetCwd")]; - char Win32__GetNextAvailDrive [sizeof("Win32::GetNextAvailDrive")]; - char Win32__GetLastError [sizeof("Win32::GetLastError")]; - char Win32__SetLastError [sizeof("Win32::SetLastError")]; - char Win32__LoginName [sizeof("Win32::LoginName")]; - char Win32__NodeName [sizeof("Win32::NodeName")]; - char Win32__DomainName [sizeof("Win32::DomainName")]; - char Win32__FsType [sizeof("Win32::FsType")]; - char Win32__GetOSVersion [sizeof("Win32::GetOSVersion")]; - char Win32__IsWinNT [sizeof("Win32::IsWinNT")]; - char Win32__IsWin95 [sizeof("Win32::IsWin95")]; - char Win32__FormatMessage [sizeof("Win32::FormatMessage")]; - char Win32__Spawn [sizeof("Win32::Spawn")]; - char Win32__GetTickCount [sizeof("Win32::GetTickCount")]; - char Win32__GetShortPathName [sizeof("Win32::GetShortPathName")]; - char Win32__GetFullPathName [sizeof("Win32::GetFullPathName")]; - char Win32__GetLongPathName [sizeof("Win32::GetLongPathName")]; - char Win32__CopyFile [sizeof("Win32::CopyFile")]; - char Win32__Sleep [sizeof("Win32::Sleep")]; + char Win32__GetCwd [sizeof("Win32::GetCwd")]; + char Win32__SetCwd [sizeof("Win32::SetCwd")]; + char Win32__GetNextAvailDrive [sizeof("Win32::GetNextAvailDrive")]; + char Win32__GetLastError [sizeof("Win32::GetLastError")]; + char Win32__SetLastError [sizeof("Win32::SetLastError")]; + char Win32__LoginName [sizeof("Win32::LoginName")]; + char Win32__NodeName [sizeof("Win32::NodeName")]; + char Win32__DomainName [sizeof("Win32::DomainName")]; + char Win32__FsType [sizeof("Win32::FsType")]; + char Win32__GetOSVersion [sizeof("Win32::GetOSVersion")]; + char Win32__IsWinNT [sizeof("Win32::IsWinNT")]; + char Win32__IsWin95 [sizeof("Win32::IsWin95")]; + char Win32__FormatMessage [sizeof("Win32::FormatMessage")]; + char Win32__Spawn [sizeof("Win32::Spawn")]; + char Win32__GetTickCount [sizeof("Win32::GetTickCount")]; + char Win32__GetShortPathName [sizeof("Win32::GetShortPathName")]; + char Win32__GetFullPathName [sizeof("Win32::GetFullPathName")]; + char Win32__GetLongPathName [sizeof("Win32::GetLongPathName")]; + char Win32__CopyFile [sizeof("Win32::CopyFile")]; + char Win32__Sleep [sizeof("Win32::Sleep")]; } fnname_table = { - "Win32::GetCwd", - "Win32::SetCwd", - "Win32::GetNextAvailDrive", - "Win32::GetLastError", - "Win32::SetLastError", - "Win32::LoginName", - "Win32::NodeName", - "Win32::DomainName", - "Win32::FsType", - "Win32::GetOSVersion", - "Win32::IsWinNT", - "Win32::IsWin95", - "Win32::FormatMessage", - "Win32::Spawn", - "Win32::GetTickCount", - "Win32::GetShortPathName", - "Win32::GetFullPathName", - "Win32::GetLongPathName", - "Win32::CopyFile", - "Win32::Sleep" + "Win32::GetCwd", + "Win32::SetCwd", + "Win32::GetNextAvailDrive", + "Win32::GetLastError", + "Win32::SetLastError", + "Win32::LoginName", + "Win32::NodeName", + "Win32::DomainName", + "Win32::FsType", + "Win32::GetOSVersion", + "Win32::IsWinNT", + "Win32::IsWin95", + "Win32::FormatMessage", + "Win32::Spawn", + "Win32::GetTickCount", + "Win32::GetShortPathName", + "Win32::GetFullPathName", + "Win32::GetLongPathName", + "Win32::CopyFile", + "Win32::Sleep" }; static const unsigned char fnname_lens [] = { - sizeof("Win32::GetCwd"), - sizeof("Win32::SetCwd"), - sizeof("Win32::GetNextAvailDrive"), - sizeof("Win32::GetLastError"), - sizeof("Win32::SetLastError"), - sizeof("Win32::LoginName"), - sizeof("Win32::NodeName"), - sizeof("Win32::DomainName"), - sizeof("Win32::FsType"), - sizeof("Win32::GetOSVersion"), - sizeof("Win32::IsWinNT"), - sizeof("Win32::IsWin95"), - sizeof("Win32::FormatMessage"), - sizeof("Win32::Spawn"), - sizeof("Win32::GetTickCount"), - sizeof("Win32::GetShortPathName"), - sizeof("Win32::GetFullPathName"), - sizeof("Win32::GetLongPathName"), - sizeof("Win32::CopyFile"), - sizeof("Win32::Sleep") + sizeof("Win32::GetCwd"), + sizeof("Win32::SetCwd"), + sizeof("Win32::GetNextAvailDrive"), + sizeof("Win32::GetLastError"), + sizeof("Win32::SetLastError"), + sizeof("Win32::LoginName"), + sizeof("Win32::NodeName"), + sizeof("Win32::DomainName"), + sizeof("Win32::FsType"), + sizeof("Win32::GetOSVersion"), + sizeof("Win32::IsWinNT"), + sizeof("Win32::IsWin95"), + sizeof("Win32::FormatMessage"), + sizeof("Win32::Spawn"), + sizeof("Win32::GetTickCount"), + sizeof("Win32::GetShortPathName"), + sizeof("Win32::GetFullPathName"), + sizeof("Win32::GetLongPathName"), + sizeof("Win32::CopyFile"), + sizeof("Win32::Sleep") }; const unsigned char * len = (const unsigned char *)&fnname_lens; const char * function = (char *)&fnname_table; while (function < (char *)&fnname_table + sizeof(fnname_table)) { - const char * const file = __FILE__; - CV * const cv = newXS(function, w32_CORE_all, file); - XSANY.any_ptr = (void *)function; - function += *len++; + const char * const file = __FILE__; + CV * const cv = newXS(function, w32_CORE_all, file); + XSANY.any_ptr = (void *)function; + function += *len++; } diff --git a/generate_uudmap.c b/generate_uudmap.c index 5ab7d8197f16..b5f84a76959f 100644 --- a/generate_uudmap.c +++ b/generate_uudmap.c @@ -71,13 +71,13 @@ format_mg_data(FILE *out, const void *thing, size_t count) { while (1) { if (p->value) { - fprintf(out, " %s\n %s", p->comment, p->value); + fprintf(out, " %s\n %s", p->comment, p->value); } else { - fputs(" 0", out); + fputs(" 0", out); } ++p; if (!--count) - break; + break; fputs(",\n", out); } fputc('\n', out); @@ -94,7 +94,7 @@ format_char_block(FILE *out, const void *thing, size_t count) { if (count) { fputs(", ", out); if (!(count & 15)) { - fputs("\n ", out); + fputs("\n ", out); } } } @@ -103,15 +103,15 @@ format_char_block(FILE *out, const void *thing, size_t count) { static void output_to_file(const char *progname, const char *filename, - void (format_function)(FILE *out, const void *thing, size_t count), - const void *thing, size_t count, + void (format_function)(FILE *out, const void *thing, size_t count), + const void *thing, size_t count, const char *header ) { FILE *const out = fopen(filename, "w"); if (!out) { fprintf(stderr, "%s: Could not open '%s': %s\n", progname, filename, - strerror(errno)); + strerror(errno)); exit(1); } @@ -124,7 +124,7 @@ output_to_file(const char *progname, const char *filename, if (fclose(out)) { fprintf(stderr, "%s: Could not close '%s': %s\n", progname, filename, - strerror(errno)); + strerror(errno)); exit(1); } } @@ -159,7 +159,7 @@ int main(int argc, char **argv) { PL_uudmap[(U8)' '] = 0; output_to_file(argv[0], argv[1], &format_char_block, - (const void *)PL_uudmap, sizeof(PL_uudmap), + (const void *)PL_uudmap, sizeof(PL_uudmap), " * These values will populate PL_uumap[], as used by unpack('u')" ); @@ -175,7 +175,7 @@ int main(int argc, char **argv) { } output_to_file(argv[0], argv[2], &format_char_block, - (const void *)PL_bitcount, sizeof(PL_bitcount), + (const void *)PL_bitcount, sizeof(PL_bitcount), " * These values will populate PL_bitcount[]:\n" " * this is a count of bits for each U8 value 0..255" ); @@ -187,7 +187,7 @@ int main(int argc, char **argv) { } output_to_file(argv[0], argv[3], &format_mg_data, - (const void *)mg_data, sizeof(mg_data)/sizeof(mg_data[0]), + (const void *)mg_data, sizeof(mg_data)/sizeof(mg_data[0]), " * These values will populate PL_magic_data[]: this is an array of\n" " * per-magic U8 values containing an index into PL_magic_vtables[]\n" " * plus two flags:\n" diff --git a/gv.c b/gv.c index 7c758a63e0ac..92bada56b1ad 100644 --- a/gv.c +++ b/gv.c @@ -55,39 +55,39 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type) && SvTYPE((const SV *)gv) != SVt_PVLV ) ) { - const char *what; - if (type == SVt_PVIO) { - /* - * if it walks like a dirhandle, then let's assume that - * this is a dirhandle. - */ - what = OP_IS_DIRHOP(PL_op->op_type) ? - "dirhandle" : "filehandle"; - } else if (type == SVt_PVHV) { - what = "hash"; - } else { - what = type == SVt_PVAV ? "array" : "scalar"; - } - /* diag_listed_as: Bad symbol for filehandle */ - Perl_croak(aTHX_ "Bad symbol for %s", what); + const char *what; + if (type == SVt_PVIO) { + /* + * if it walks like a dirhandle, then let's assume that + * this is a dirhandle. + */ + what = OP_IS_DIRHOP(PL_op->op_type) ? + "dirhandle" : "filehandle"; + } else if (type == SVt_PVHV) { + what = "hash"; + } else { + what = type == SVt_PVAV ? "array" : "scalar"; + } + /* diag_listed_as: Bad symbol for filehandle */ + Perl_croak(aTHX_ "Bad symbol for %s", what); } if (type == SVt_PVHV) { - where = (SV **)&GvHV(gv); + where = (SV **)&GvHV(gv); } else if (type == SVt_PVAV) { - where = (SV **)&GvAV(gv); + where = (SV **)&GvAV(gv); } else if (type == SVt_PVIO) { - where = (SV **)&GvIOp(gv); + where = (SV **)&GvIOp(gv); } else { - where = &GvSV(gv); + where = &GvSV(gv); } if (!*where) { - *where = newSV_type(type); - if (type == SVt_PVAV - && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA")) - sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0); + *where = newSV_type(type); + if (type == SVt_PVAV + && memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA")) + sv_magic(*where, (SV *)gv, PERL_MAGIC_isa, NULL, 0); } return gv; } @@ -122,7 +122,7 @@ Perl_gv_fetchfile(pTHX_ const char *name) GV * Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, - const U32 flags) + const U32 flags) { char smallbuf[128]; char *tmpbuf; @@ -133,29 +133,29 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen, PERL_UNUSED_ARG(flags); if (!PL_defstash) - return NULL; + return NULL; if (tmplen <= sizeof smallbuf) - tmpbuf = smallbuf; + tmpbuf = smallbuf; else - Newx(tmpbuf, tmplen, char); + Newx(tmpbuf, tmplen, char); /* This is where the debugger's %{"::_<$filename"} hash is created */ tmpbuf[0] = '_'; tmpbuf[1] = '<'; memcpy(tmpbuf + 2, name, namelen); gv = *(GV**)hv_fetch(PL_defstash, tmpbuf, tmplen, TRUE); if (!isGV(gv)) { - gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); + gv_init(gv, PL_defstash, tmpbuf, tmplen, FALSE); #ifdef PERL_DONT_CREATE_GVSV - GvSV(gv) = newSVpvn(name, namelen); + GvSV(gv) = newSVpvn(name, namelen); #else - sv_setpvn(GvSV(gv), name, namelen); + sv_setpvn(GvSV(gv), name, namelen); #endif } if (PERLDB_LINE_OR_SAVESRC && !GvAV(gv)) - hv_magic(GvHVn(gv), GvAVn(gv), PERL_MAGIC_dbfile); + hv_magic(GvHVn(gv), GvAVn(gv), PERL_MAGIC_dbfile); if (tmpbuf != smallbuf) - Safefree(tmpbuf); + Safefree(tmpbuf); return gv; } @@ -177,7 +177,7 @@ Perl_gv_const_sv(pTHX_ GV *gv) PERL_UNUSED_CONTEXT; if (SvTYPE(gv) == SVt_PVGV) - return cv_const_sv(GvCVu(gv)); + return cv_const_sv(GvCVu(gv)); return SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVAV && SvTYPE(SvRV(gv)) != SVt_PVCV ? SvRV(gv) : NULL; } @@ -200,29 +200,29 @@ Perl_newGP(pTHX_ GV *const gv) #endif /* PL_curcop may be null here. E.g., - INIT { bless {} and exit } + INIT { bless {} and exit } frees INIT before looking up DESTROY (and creating *DESTROY) */ if (PL_curcop) { - gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */ + gp->gp_line = CopLINE(PL_curcop); /* 0 otherwise Newxz */ #ifdef USE_ITHREADS - if (CopFILE(PL_curcop)) { - file = CopFILE(PL_curcop); - len = strlen(file); - } + if (CopFILE(PL_curcop)) { + file = CopFILE(PL_curcop); + len = strlen(file); + } #else - filegv = CopFILEGV(PL_curcop); - if (filegv) { - file = GvNAME(filegv)+2; - len = GvNAMELEN(filegv)-2; - } + filegv = CopFILEGV(PL_curcop); + if (filegv) { + file = GvNAME(filegv)+2; + len = GvNAMELEN(filegv)-2; + } #endif - else goto no_file; + else goto no_file; } else { - no_file: - file = ""; - len = 0; + no_file: + file = ""; + len = 0; } PERL_HASH(hash, file, len); @@ -243,20 +243,20 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv) PERL_ARGS_ASSERT_CVGV_SET; if (oldgv == gv) - return; + return; if (oldgv) { - if (CvCVGV_RC(cv)) { - SvREFCNT_dec_NN(oldgv); - CvCVGV_RC_off(cv); - } - else { - sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv)); - } + if (CvCVGV_RC(cv)) { + SvREFCNT_dec_NN(oldgv); + CvCVGV_RC_off(cv); + } + else { + sv_del_backref(MUTABLE_SV(oldgv), MUTABLE_SV(cv)); + } } else if ((hek = CvNAME_HEK(cv))) { - unshare_hek(hek); - CvLEXICAL_off(cv); + unshare_hek(hek); + CvLEXICAL_off(cv); } CvNAMED_off(cv); @@ -264,13 +264,13 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv) assert(!CvCVGV_RC(cv)); if (!gv) - return; + return; if (isGV_with_GP(gv) && GvGP(gv) && (GvCV(gv) == cv || GvFORM(gv) == cv)) - Perl_sv_add_backref(aTHX_ MUTABLE_SV(gv), MUTABLE_SV(cv)); + Perl_sv_add_backref(aTHX_ MUTABLE_SV(gv), MUTABLE_SV(cv)); else { - CvCVGV_RC_on(cv); - SvREFCNT_inc_simple_void_NN(gv); + CvCVGV_RC_on(cv); + SvREFCNT_inc_simple_void_NN(gv); } } @@ -290,12 +290,12 @@ Perl_cvgv_from_hek(pTHX_ CV *cv) svp = hv_fetchhek(CvSTASH(cv), CvNAME_HEK(cv), 0); gv = MUTABLE_GV(svp && *svp ? *svp : newSV(0)); if (!isGV(gv)) - gv_init_pvn(gv, CvSTASH(cv), HEK_KEY(CvNAME_HEK(cv)), - HEK_LEN(CvNAME_HEK(cv)), - SVf_UTF8 * !!HEK_UTF8(CvNAME_HEK(cv))); + gv_init_pvn(gv, CvSTASH(cv), HEK_KEY(CvNAME_HEK(cv)), + HEK_LEN(CvNAME_HEK(cv)), + SVf_UTF8 * !!HEK_UTF8(CvNAME_HEK(cv))); if (!CvNAMED(cv)) { /* gv_init took care of it */ - assert (SvANY(cv)->xcv_gv_u.xcv_gv == gv); - return gv; + assert (SvANY(cv)->xcv_gv_u.xcv_gv == gv); + return gv; } unshare_hek(CvNAME_HEK(cv)); CvNAMED_off(cv); @@ -313,12 +313,12 @@ Perl_cvstash_set(pTHX_ CV *cv, HV *st) HV *oldst = CvSTASH(cv); PERL_ARGS_ASSERT_CVSTASH_SET; if (oldst == st) - return; + return; if (oldst) - sv_del_backref(MUTABLE_SV(oldst), MUTABLE_SV(cv)); + sv_del_backref(MUTABLE_SV(oldst), MUTABLE_SV(cv)); SvANY(cv)->xcv_stash = st; if (st) - Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv)); + Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv)); } /* @@ -391,102 +391,102 @@ Perl_gv_init_pvn(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, U32 flag const U32 old_type = SvTYPE(gv); const bool doproto = old_type > SVt_NULL; char * const proto = (doproto && SvPOK(gv)) - ? ((void)(SvIsCOW(gv) && (sv_force_normal((SV *)gv), 0)), SvPVX(gv)) - : NULL; + ? ((void)(SvIsCOW(gv) && (sv_force_normal((SV *)gv), 0)), SvPVX(gv)) + : NULL; const STRLEN protolen = proto ? SvCUR(gv) : 0; const U32 proto_utf8 = proto ? SvUTF8(gv) : 0; SV *const has_constant = doproto && SvROK(gv) ? SvRV(gv) : NULL; const U32 exported_constant = has_constant ? SvPCS_IMPORTED(gv) : 0; const bool really_sub = - has_constant && SvTYPE(has_constant) == SVt_PVCV; + has_constant && SvTYPE(has_constant) == SVt_PVCV; COP * const old = PL_curcop; PERL_ARGS_ASSERT_GV_INIT_PVN; assert (!(proto && has_constant)); if (has_constant) { - /* The constant has to be a scalar, array or subroutine. */ - switch (SvTYPE(has_constant)) { - case SVt_PVHV: - case SVt_PVFM: - case SVt_PVIO: + /* The constant has to be a scalar, array or subroutine. */ + switch (SvTYPE(has_constant)) { + case SVt_PVHV: + case SVt_PVFM: + case SVt_PVIO: Perl_croak(aTHX_ "Cannot convert a reference to %s to typeglob", - sv_reftype(has_constant, 0)); + sv_reftype(has_constant, 0)); NOT_REACHED; /* NOTREACHED */ break; - default: NOOP; - } - SvRV_set(gv, NULL); - SvROK_off(gv); + default: NOOP; + } + SvRV_set(gv, NULL); + SvROK_off(gv); } if (old_type < SVt_PVGV) { - if (old_type >= SVt_PV) - SvCUR_set(gv, 0); - sv_upgrade(MUTABLE_SV(gv), SVt_PVGV); + if (old_type >= SVt_PV) + SvCUR_set(gv, 0); + sv_upgrade(MUTABLE_SV(gv), SVt_PVGV); } if (SvLEN(gv)) { - if (proto) { - SvPV_set(gv, NULL); - SvLEN_set(gv, 0); - SvPOK_off(gv); - } else - Safefree(SvPVX_mutable(gv)); + if (proto) { + SvPV_set(gv, NULL); + SvLEN_set(gv, 0); + SvPOK_off(gv); + } else + Safefree(SvPVX_mutable(gv)); } SvIOK_off(gv); isGV_with_GP_on(gv); if (really_sub && !CvISXSUB(has_constant) && CvSTART(has_constant) && ( CvSTART(has_constant)->op_type == OP_NEXTSTATE - || CvSTART(has_constant)->op_type == OP_DBSTATE)) - PL_curcop = (COP *)CvSTART(has_constant); + || CvSTART(has_constant)->op_type == OP_DBSTATE)) + PL_curcop = (COP *)CvSTART(has_constant); GvGP_set(gv, Perl_newGP(aTHX_ gv)); PL_curcop = old; GvSTASH(gv) = stash; if (stash) - Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv)); + Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(gv)); gv_name_set(gv, name, len, GV_ADD | ( flags & SVf_UTF8 ? SVf_UTF8 : 0 )); if (flags & GV_ADDMULTI || doproto) /* doproto means it */ - GvMULTI_on(gv); /* _was_ mentioned */ + GvMULTI_on(gv); /* _was_ mentioned */ if (really_sub) { - /* Not actually a constant. Just a regular sub. */ - CV * const cv = (CV *)has_constant; - GvCV_set(gv,cv); - if (CvNAMED(cv) && CvSTASH(cv) == stash && ( - CvNAME_HEK(cv) == GvNAME_HEK(gv) - || ( HEK_LEN(CvNAME_HEK(cv)) == HEK_LEN(GvNAME_HEK(gv)) - && HEK_FLAGS(CvNAME_HEK(cv)) != HEK_FLAGS(GvNAME_HEK(gv)) - && HEK_UTF8(CvNAME_HEK(cv)) == HEK_UTF8(GvNAME_HEK(gv)) - && memEQ(HEK_KEY(CvNAME_HEK(cv)), GvNAME(gv), GvNAMELEN(gv)) - ) - )) - CvGV_set(cv,gv); + /* Not actually a constant. Just a regular sub. */ + CV * const cv = (CV *)has_constant; + GvCV_set(gv,cv); + if (CvNAMED(cv) && CvSTASH(cv) == stash && ( + CvNAME_HEK(cv) == GvNAME_HEK(gv) + || ( HEK_LEN(CvNAME_HEK(cv)) == HEK_LEN(GvNAME_HEK(gv)) + && HEK_FLAGS(CvNAME_HEK(cv)) != HEK_FLAGS(GvNAME_HEK(gv)) + && HEK_UTF8(CvNAME_HEK(cv)) == HEK_UTF8(GvNAME_HEK(gv)) + && memEQ(HEK_KEY(CvNAME_HEK(cv)), GvNAME(gv), GvNAMELEN(gv)) + ) + )) + CvGV_set(cv,gv); } else if (doproto) { - CV *cv; - if (has_constant) { - /* newCONSTSUB takes ownership of the reference from us. */ - cv = newCONSTSUB_flags(stash, name, len, flags, has_constant); - /* In case op.c:S_process_special_blocks stole it: */ - if (!GvCV(gv)) - GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv)); - assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */ - /* If this reference was a copy of another, then the subroutine - must have been "imported", by a Perl space assignment to a GV - from a reference to CV. */ - if (exported_constant) - GvIMPORTED_CV_on(gv); - CvSTASH_set(cv, PL_curstash); /* XXX Why is this needed? */ - } else { - cv = newSTUB(gv,1); - } - if (proto) { - sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen, - SV_HAS_TRAILING_NUL); + CV *cv; + if (has_constant) { + /* newCONSTSUB takes ownership of the reference from us. */ + cv = newCONSTSUB_flags(stash, name, len, flags, has_constant); + /* In case op.c:S_process_special_blocks stole it: */ + if (!GvCV(gv)) + GvCV_set(gv, (CV *)SvREFCNT_inc_simple_NN(cv)); + assert(GvCV(gv) == cv); /* newCONSTSUB should have set this */ + /* If this reference was a copy of another, then the subroutine + must have been "imported", by a Perl space assignment to a GV + from a reference to CV. */ + if (exported_constant) + GvIMPORTED_CV_on(gv); + CvSTASH_set(cv, PL_curstash); /* XXX Why is this needed? */ + } else { + cv = newSTUB(gv,1); + } + if (proto) { + sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen, + SV_HAS_TRAILING_NUL); if ( proto_utf8 ) SvUTF8_on(MUTABLE_SV(cv)); - } + } } } @@ -497,26 +497,26 @@ S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type) switch (sv_type) { case SVt_PVIO: - (void)GvIOn(gv); - break; + (void)GvIOn(gv); + break; case SVt_PVAV: - (void)GvAVn(gv); - break; + (void)GvAVn(gv); + break; case SVt_PVHV: - (void)GvHVn(gv); - break; + (void)GvHVn(gv); + break; #ifdef PERL_DONT_CREATE_GVSV case SVt_NULL: case SVt_PVCV: case SVt_PVFM: case SVt_PVGV: - break; + break; default: - if(GvSVn(gv)) { - /* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13 - If we just cast GvSVn(gv) to void, it ignores evaluating it for - its side effect */ - } + if(GvSVn(gv)) { + /* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13 + If we just cast GvSVn(gv) to void, it ignores evaluating it for + its side effect */ + } #endif } } @@ -562,7 +562,7 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, case KEY_tr : case KEY_UNITCHECK: case KEY_unless: case KEY_until: case KEY_use : case KEY_when : case KEY_while : case KEY_x : case KEY_xor : case KEY_y : - return NULL; + return NULL; case KEY_chdir: case KEY_chomp: case KEY_chop: case KEY_defined: case KEY_delete: case KEY_eof : case KEY_exec: case KEY_exists : @@ -571,33 +571,33 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, case KEY_stat: case KEY_system: case KEY_truncate: case KEY_unlink: - ampable = FALSE; + ampable = FALSE; } if (!gv) { - gv = (GV *)newSV(0); - gv_init(gv, stash, name, len, TRUE); + gv = (GV *)newSV(0); + gv_init(gv, stash, name, len, TRUE); } GvMULTI_on(gv); if (ampable) { - ENTER; - oldcurcop = PL_curcop; - oldparser = PL_parser; - lex_start(NULL, NULL, 0); - oldcompcv = PL_compcv; - PL_compcv = NULL; /* Prevent start_subparse from setting - CvOUTSIDE. */ - oldsavestack_ix = start_subparse(FALSE,0); - cv = PL_compcv; + ENTER; + oldcurcop = PL_curcop; + oldparser = PL_parser; + lex_start(NULL, NULL, 0); + oldcompcv = PL_compcv; + PL_compcv = NULL; /* Prevent start_subparse from setting + CvOUTSIDE. */ + oldsavestack_ix = start_subparse(FALSE,0); + cv = PL_compcv; } else { - /* Avoid calling newXS, as it calls us, and things start to - get hairy. */ - cv = MUTABLE_CV(newSV_type(SVt_PVCV)); - GvCV_set(gv,cv); - GvCVGEN(gv) = 0; - CvISXSUB_on(cv); - CvXSUB(cv) = core_xsub; - PoisonPADLIST(cv); + /* Avoid calling newXS, as it calls us, and things start to + get hairy. */ + cv = MUTABLE_CV(newSV_type(SVt_PVCV)); + GvCV_set(gv,cv); + GvCVGEN(gv) = 0; + CvISXSUB_on(cv); + CvXSUB(cv) = core_xsub; + PoisonPADLIST(cv); } CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE from PL_curcop. */ @@ -611,42 +611,42 @@ S_maybe_add_coresub(pTHX_ HV * const stash, GV *gv, new ATTRSUB. */ (void)core_prototype((SV *)cv, name, code, &opnum); if (stash) - (void)hv_store(stash,name,len,(SV *)gv,0); + (void)hv_store(stash,name,len,(SV *)gv,0); if (ampable) { #ifdef DEBUGGING CV *orig_cv = cv; #endif - CvLVALUE_on(cv); + CvLVALUE_on(cv); /* newATTRSUB will free the CV and return NULL if we're still compiling after a syntax error */ - if ((cv = newATTRSUB_x( - oldsavestack_ix, (OP *)gv, - NULL,NULL, - coresub_op( - opnum - ? newSVuv((UV)opnum) - : newSVpvn(name,len), - code, opnum - ), - TRUE + if ((cv = newATTRSUB_x( + oldsavestack_ix, (OP *)gv, + NULL,NULL, + coresub_op( + opnum + ? newSVuv((UV)opnum) + : newSVpvn(name,len), + code, opnum + ), + TRUE )) != NULL) { assert(GvCV(gv) == orig_cv); if (opnum != OP_VEC && opnum != OP_SUBSTR && opnum != OP_POS && opnum != OP_UNDEF && opnum != OP_KEYS) CvLVALUE_off(cv); /* Now *that* was a neat trick. */ } - LEAVE; - PL_parser = oldparser; - PL_curcop = oldcurcop; - PL_compcv = oldcompcv; + LEAVE; + PL_parser = oldparser; + PL_curcop = oldcurcop; + PL_compcv = oldcompcv; } if (cv) { - SV *opnumsv = newSViv( - (opnum == OP_ENTEREVAL && len == 9 && memEQ(name, "evalbytes", 9)) ? - (OP_ENTEREVAL | (1<<16)) - : opnum ? opnum : (((I32)name[2]) << 16)); + SV *opnumsv = newSViv( + (opnum == OP_ENTEREVAL && len == 9 && memEQ(name, "evalbytes", 9)) ? + (OP_ENTEREVAL | (1<<16)) + : opnum ? opnum : (((I32)name[2]) << 16)); cv_set_call_checker_flags(cv, Perl_ck_entersub_args_core, opnumsv, 0); - SvREFCNT_dec_NN(opnumsv); + SvREFCNT_dec_NN(opnumsv); } return gv; @@ -746,9 +746,9 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, /* UNIVERSAL methods should be callable without a stash */ if (!stash) { - create = 0; /* probably appropriate */ - if(!(stash = gv_stashpvs("UNIVERSAL", 0))) - return 0; + create = 0; /* probably appropriate */ + if(!(stash = gv_stashpvs("UNIVERSAL", 0))) + return 0; } assert(stash); @@ -762,15 +762,15 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, assert(name || meth); DEBUG_o( Perl_deb(aTHX_ "Looking for %smethod %s in package %s\n", - flags & GV_SUPER ? "SUPER " : "", - name ? name : SvPV_nolen(meth), hvname) ); + flags & GV_SUPER ? "SUPER " : "", + name ? name : SvPV_nolen(meth), hvname) ); topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation; if (flags & GV_SUPER) { - if (!HvAUX(stash)->xhv_mro_meta->super) - HvAUX(stash)->xhv_mro_meta->super = newHV(); - cachestash = HvAUX(stash)->xhv_mro_meta->super; + if (!HvAUX(stash)->xhv_mro_meta->super) + HvAUX(stash)->xhv_mro_meta->super = newHV(); + cachestash = HvAUX(stash)->xhv_mro_meta->super; } else cachestash = stash; @@ -798,21 +798,21 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, } else { /* stale cache entry, junk it and move on */ - SvREFCNT_dec_NN(cand_cv); - GvCV_set(topgv, NULL); - cand_cv = NULL; - GvCVGEN(topgv) = 0; + SvREFCNT_dec_NN(cand_cv); + GvCV_set(topgv, NULL); + cand_cv = NULL; + GvCVGEN(topgv) = 0; } } else if (GvCVGEN(topgv) == topgen_cmp) { /* cache indicates no such method definitively */ return 0; } - else if (stash == cachestash - && len > 1 /* shortest is uc */ + else if (stash == cachestash + && len > 1 /* shortest is uc */ && memEQs(hvname, HvNAMELEN_get(stash), "CORE") && S_maybe_add_coresub(aTHX_ NULL,topgv,name,len)) - goto have_gv; + goto have_gv; } linear_av = mro_get_linear_isa(stash); /* has ourselves at the top of the list */ @@ -885,7 +885,7 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, GvCV_set(topgv, cand_cv); GvCVGEN(topgv) = topgen_cmp; } - return candidate; + return candidate; } } @@ -986,26 +986,26 @@ Perl_gv_fetchmeth_pvn_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I3 PERL_ARGS_ASSERT_GV_FETCHMETH_PVN_AUTOLOAD; if (!gv) { - CV *cv; - GV **gvp; - - if (!stash) - return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */ - if (len == S_autolen && memEQ(name, S_autoload, S_autolen)) - return NULL; - if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, flags))) - return NULL; - cv = GvCV(gv); - if (!(CvROOT(cv) || CvXSUB(cv))) - return NULL; - /* Have an autoload */ - if (level < 0) /* Cannot do without a stub */ - gv_fetchmeth_pvn(stash, name, len, 0, flags); - gvp = (GV**)hv_fetch(stash, name, + CV *cv; + GV **gvp; + + if (!stash) + return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */ + if (len == S_autolen && memEQ(name, S_autoload, S_autolen)) + return NULL; + if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, flags))) + return NULL; + cv = GvCV(gv); + if (!(CvROOT(cv) || CvXSUB(cv))) + return NULL; + /* Have an autoload */ + if (level < 0) /* Cannot do without a stub */ + gv_fetchmeth_pvn(stash, name, len, 0, flags); + gvp = (GV**)hv_fetch(stash, name, (flags & SVf_UTF8) ? -(I32)len : (I32)len, (level >= 0)); - if (!gvp) - return NULL; - return *gvp; + if (!gvp) + return NULL; + return *gvp; } return gv; } @@ -1081,11 +1081,11 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le PERL_ARGS_ASSERT_GV_FETCHMETHOD_PVN_FLAGS; if (SvTYPE(stash) < SVt_PVHV) - stash = NULL; + stash = NULL; else { - /* The only way stash can become NULL later on is if last_separator is set, - which in turn means that there is no need for a SVt_PVHV case - the error reporting code. */ + /* The only way stash can become NULL later on is if last_separator is set, + which in turn means that there is no need for a SVt_PVHV case + the error reporting code. */ } { @@ -1118,100 +1118,100 @@ Perl_gv_fetchmethod_pvn_flags(pTHX_ HV *stash, const char *name, const STRLEN le if (last_separator) { STRLEN sep_len= last_separator - origname; if ( memEQs(origname, sep_len, "SUPER")) { - /* ->SUPER::method should really be looked up in original stash */ - stash = CopSTASH(PL_curcop); - flags |= GV_SUPER; - DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", - origname, HvENAME_get(stash), name) ); - } + /* ->SUPER::method should really be looked up in original stash */ + stash = CopSTASH(PL_curcop); + flags |= GV_SUPER; + DEBUG_o( Perl_deb(aTHX_ "Treating %s as %s::%s\n", + origname, HvENAME_get(stash), name) ); + } else if ( sep_len >= 7 && - strBEGINs(last_separator - 7, "::SUPER")) { + strBEGINs(last_separator - 7, "::SUPER")) { /* don't autovifify if ->NoSuchStash::SUPER::method */ stash = gv_stashpvn(origname, sep_len - 7, is_utf8); - if (stash) flags |= GV_SUPER; - } - else { + if (stash) flags |= GV_SUPER; + } + else { /* don't autovifify if ->NoSuchStash::method */ stash = gv_stashpvn(origname, sep_len, is_utf8); - } - ostash = stash; + } + ostash = stash; } gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags); if (!gv) { - /* This is the special case that exempts Foo->import and - Foo->unimport from being an error even if there's no - import/unimport subroutine */ - if (strEQ(name,"import") || strEQ(name,"unimport")) { - gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL, - NULL, 0, 0, NULL)); - } else if (autoload) - gv = gv_autoload_pvn( - ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags - ); - if (!gv && do_croak) { - /* Right now this is exclusively for the benefit of S_method_common - in pp_hot.c */ - if (stash) { - /* If we can't find an IO::File method, it might be a call on - * a filehandle. If IO:File has not been loaded, try to - * require it first instead of croaking */ - const char *stash_name = HvNAME_get(stash); - if (stash_name && memEQs(stash_name, HvNAMELEN_get(stash), "IO::File") - && !Perl_hv_common(aTHX_ GvHVn(PL_incgv), NULL, - STR_WITH_LEN("IO/File.pm"), 0, - HV_FETCH_ISEXISTS, NULL, 0) - ) { - require_pv("IO/File.pm"); - gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags); - if (gv) - return gv; - } - Perl_croak(aTHX_ - "Can't locate object method \"%" UTF8f - "\" via package \"%" HEKf "\"", - UTF8fARG(is_utf8, name_end - name, name), + /* This is the special case that exempts Foo->import and + Foo->unimport from being an error even if there's no + import/unimport subroutine */ + if (strEQ(name,"import") || strEQ(name,"unimport")) { + gv = (GV*)sv_2mortal((SV*)newCONSTSUB_flags(NULL, + NULL, 0, 0, NULL)); + } else if (autoload) + gv = gv_autoload_pvn( + ostash, name, name_end - name, GV_AUTOLOAD_ISMETHOD|flags + ); + if (!gv && do_croak) { + /* Right now this is exclusively for the benefit of S_method_common + in pp_hot.c */ + if (stash) { + /* If we can't find an IO::File method, it might be a call on + * a filehandle. If IO:File has not been loaded, try to + * require it first instead of croaking */ + const char *stash_name = HvNAME_get(stash); + if (stash_name && memEQs(stash_name, HvNAMELEN_get(stash), "IO::File") + && !Perl_hv_common(aTHX_ GvHVn(PL_incgv), NULL, + STR_WITH_LEN("IO/File.pm"), 0, + HV_FETCH_ISEXISTS, NULL, 0) + ) { + require_pv("IO/File.pm"); + gv = gv_fetchmeth_pvn(stash, name, name_end - name, 0, flags); + if (gv) + return gv; + } + Perl_croak(aTHX_ + "Can't locate object method \"%" UTF8f + "\" via package \"%" HEKf "\"", + UTF8fARG(is_utf8, name_end - name, name), HEKfARG(HvNAME_HEK(stash))); - } - else { + } + else { SV* packnamesv; - if (last_separator) { - packnamesv = newSVpvn_flags(origname, last_separator - origname, + if (last_separator) { + packnamesv = newSVpvn_flags(origname, last_separator - origname, SVs_TEMP | is_utf8); - } else { - packnamesv = error_report; - } - - Perl_croak(aTHX_ - "Can't locate object method \"%" UTF8f - "\" via package \"%" SVf "\"" - " (perhaps you forgot to load \"%" SVf "\"?)", - UTF8fARG(is_utf8, name_end - name, name), + } else { + packnamesv = error_report; + } + + Perl_croak(aTHX_ + "Can't locate object method \"%" UTF8f + "\" via package \"%" SVf "\"" + " (perhaps you forgot to load \"%" SVf "\"?)", + UTF8fARG(is_utf8, name_end - name, name), SVfARG(packnamesv), SVfARG(packnamesv)); - } - } + } + } } else if (autoload) { - CV* const cv = GvCV(gv); - if (!CvROOT(cv) && !CvXSUB(cv)) { - GV* stubgv; - GV* autogv; - - if (CvANON(cv) || CvLEXICAL(cv)) - stubgv = gv; - else { - stubgv = CvGV(cv); - if (GvCV(stubgv) != cv) /* orphaned import */ - stubgv = gv; - } + CV* const cv = GvCV(gv); + if (!CvROOT(cv) && !CvXSUB(cv)) { + GV* stubgv; + GV* autogv; + + if (CvANON(cv) || CvLEXICAL(cv)) + stubgv = gv; + else { + stubgv = CvGV(cv); + if (GvCV(stubgv) != cv) /* orphaned import */ + stubgv = gv; + } autogv = gv_autoload_pvn(GvSTASH(stubgv), GvNAME(stubgv), GvNAMELEN(stubgv), GV_AUTOLOAD_ISMETHOD | (GvNAMEUTF8(stubgv) ? SVf_UTF8 : 0)); - if (autogv) - gv = autogv; - } + if (autogv) + gv = autogv; + } } return gv; @@ -1250,26 +1250,26 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) PERL_ARGS_ASSERT_GV_AUTOLOAD_PVN; if (len == S_autolen && memEQ(name, S_autoload, S_autolen)) - return NULL; + return NULL; if (stash) { - if (SvTYPE(stash) < SVt_PVHV) { + if (SvTYPE(stash) < SVt_PVHV) { STRLEN packname_len = 0; const char * const packname_ptr = SvPV_const(MUTABLE_SV(stash), packname_len); packname = newSVpvn_flags(packname_ptr, packname_len, SVs_TEMP | SvUTF8(stash)); - stash = NULL; - } - else - packname = sv_2mortal(newSVhek(HvNAME_HEK(stash))); - if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER"); + stash = NULL; + } + else + packname = sv_2mortal(newSVhek(HvNAME_HEK(stash))); + if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER"); } if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, - is_utf8 | (flags & GV_SUPER)))) - return NULL; + is_utf8 | (flags & GV_SUPER)))) + return NULL; cv = GvCV(gv); if (!(CvROOT(cv) || CvXSUB(cv))) - return NULL; + return NULL; /* * Inheriting AUTOLOAD for non-methods no longer works @@ -1280,7 +1280,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) ) Perl_croak(aTHX_ "Use of inherited AUTOLOAD for non-method %" SVf "::%" UTF8f "() is no longer allowed", - SVfARG(packname), + SVfARG(packname), UTF8fARG(is_utf8, len, name)); if (CvISXSUB(cv)) { @@ -1306,34 +1306,34 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) * We use SvUTF8 for both prototypes and sub names, so if one is * UTF8, the other must be upgraded. */ - CvSTASH_set(cv, stash); - if (SvPOK(cv)) { /* Ouch! */ - SV * const tmpsv = newSVpvn_flags(name, len, is_utf8); - STRLEN ulen; - const char *proto = CvPROTO(cv); - assert(proto); - if (SvUTF8(cv)) - sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2); - ulen = SvCUR(tmpsv); - SvCUR_set(tmpsv, SvCUR(tmpsv) + 1); /* include null in string */ - sv_catpvn_flags( - tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv) - ); - SvTEMP_on(tmpsv); /* Allow theft */ - sv_setsv_nomg((SV *)cv, tmpsv); - SvTEMP_off(tmpsv); - SvREFCNT_dec_NN(tmpsv); - SvLEN_set(cv, SvCUR(cv) + 1); - SvCUR_set(cv, ulen); - } - else { - sv_setpvn((SV *)cv, name, len); - SvPOK_off(cv); - if (is_utf8) + CvSTASH_set(cv, stash); + if (SvPOK(cv)) { /* Ouch! */ + SV * const tmpsv = newSVpvn_flags(name, len, is_utf8); + STRLEN ulen; + const char *proto = CvPROTO(cv); + assert(proto); + if (SvUTF8(cv)) + sv_utf8_upgrade_flags_grow(tmpsv, 0, CvPROTOLEN(cv) + 2); + ulen = SvCUR(tmpsv); + SvCUR_set(tmpsv, SvCUR(tmpsv) + 1); /* include null in string */ + sv_catpvn_flags( + tmpsv, proto, CvPROTOLEN(cv), SV_CATBYTES*!SvUTF8(cv) + ); + SvTEMP_on(tmpsv); /* Allow theft */ + sv_setsv_nomg((SV *)cv, tmpsv); + SvTEMP_off(tmpsv); + SvREFCNT_dec_NN(tmpsv); + SvLEN_set(cv, SvCUR(cv) + 1); + SvCUR_set(cv, ulen); + } + else { + sv_setpvn((SV *)cv, name, len); + SvPOK_off(cv); + if (is_utf8) SvUTF8_on(cv); - else SvUTF8_off(cv); - } - CvAUTOLOAD_on(cv); + else SvUTF8_off(cv); + } + CvAUTOLOAD_on(cv); } /* @@ -1347,9 +1347,9 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) ENTER; if (!isGV(vargv)) { - gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0); + gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0); #ifdef PERL_DONT_CREATE_GVSV - GvSV(vargv) = newSV(0); + GvSV(vargv) = newSV(0); #endif } LEAVE; @@ -1361,8 +1361,8 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) /* Ensure SvSETMAGIC() is called if necessary. In particular, to clear tainting if $FOO::AUTOLOAD was previously tainted, but is not now. */ sv_catpvn_flags( - varsv, name, len, - SV_SMAGIC|(is_utf8 ? SV_CATUTF8 : SV_CATBYTES) + varsv, name, len, + SV_SMAGIC|(is_utf8 ? SV_CATUTF8 : SV_CATBYTES) ); if (is_utf8) SvUTF8_on(varsv); @@ -1413,19 +1413,19 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char * name, if (!(stash = gv_stashpvn(name, len, 0)) || ! GET_HV_FETCH_TIE_FUNC) { - SV * const module = newSVpvn(name, len); - const char type = varname == '[' ? '$' : '%'; - if ( flags & 1 ) - save_scalar(gv); - Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL); - assert(sp == PL_stack_sp); - stash = gv_stashpvn(name, len, 0); - if (!stash) - Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available", - type, varname, name); - else if (! GET_HV_FETCH_TIE_FUNC) - Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it", - type, varname, name); + SV * const module = newSVpvn(name, len); + const char type = varname == '[' ? '$' : '%'; + if ( flags & 1 ) + save_scalar(gv); + Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, module, NULL); + assert(sp == PL_stack_sp); + stash = gv_stashpvn(name, len, 0); + if (!stash) + Perl_croak(aTHX_ "panic: Can't use %c%c because %s is not available", + type, varname, name); + else if (! GET_HV_FETCH_TIE_FUNC) + Perl_croak(aTHX_ "panic: Can't use %c%c because %s does not define _tie_it", + type, varname, name); } /* Now call the tie function. It should be in *gvp. */ assert(gvp); assert(*gvp); @@ -1516,28 +1516,28 @@ S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags) PERL_ARGS_ASSERT_GV_STASHPVN_INTERNAL; if (tmplen <= sizeof smallbuf) - tmpbuf = smallbuf; + tmpbuf = smallbuf; else - Newx(tmpbuf, tmplen, char); + Newx(tmpbuf, tmplen, char); Copy(name, tmpbuf, namelen, char); tmpbuf[namelen] = ':'; tmpbuf[namelen+1] = ':'; tmpgv = gv_fetchpvn_flags(tmpbuf, tmplen, flags, SVt_PVHV); if (tmpbuf != smallbuf) - Safefree(tmpbuf); + Safefree(tmpbuf); if (!tmpgv || !isGV_with_GP(tmpgv)) - return NULL; + return NULL; stash = GvHV(tmpgv); if (!(flags & ~GV_NOADD_MASK) && !stash) return NULL; assert(stash); if (!HvNAME_get(stash)) { - hv_name_set(stash, name, namelen, flags & SVf_UTF8 ? SVf_UTF8 : 0 ); - - /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */ - /* If the containing stash has multiple effective - names, see that this one gets them, too. */ - if (HvAUX(GvSTASH(tmpgv))->xhv_name_count) - mro_package_moved(stash, NULL, tmpgv, 1); + hv_name_set(stash, name, namelen, flags & SVf_UTF8 ? SVf_UTF8 : 0 ); + + /* FIXME: This is a repeat of logic in gv_fetchpvn_flags */ + /* If the containing stash has multiple effective + names, see that this one gets them, too. */ + if (HvAUX(GvSTASH(tmpgv))->xhv_name_count) + mro_package_moved(stash, NULL, tmpgv, 1); } return stash; } @@ -1653,7 +1653,7 @@ S_gv_magicalize_isa(pTHX_ GV *gv) av = GvAVn(gv); GvMULTI_on(gv); sv_magic(MUTABLE_SV(av), MUTABLE_SV(gv), PERL_MAGIC_isa, - NULL, 0); + NULL, 0); } /* This function grabs name and tries to split a stash and glob @@ -1753,14 +1753,14 @@ S_parse_gv_stash_name(pTHX_ HV **stash, GV **gv, const char **name, *name = name_cursor+1; if (*name == name_end) { if (!*gv) { - *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE)); - if (SvTYPE(*gv) != SVt_PVGV) { - gv_init_pvn(*gv, PL_defstash, "main::", 6, - GV_ADDMULTI); - GvHV(*gv) = - MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); - } - } + *gv = MUTABLE_GV(*hv_fetchs(PL_defstash, "main::", TRUE)); + if (SvTYPE(*gv) != SVt_PVGV) { + gv_init_pvn(*gv, PL_defstash, "main::", 6, + GV_ADDMULTI); + GvHV(*gv) = + MUTABLE_HV(SvREFCNT_inc_simple(PL_defstash)); + } + } goto ok; } } @@ -1954,12 +1954,12 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, PERL_ARGS_ASSERT_GV_MAGICALIZE; if (stash != PL_defstash) { /* not the main stash */ - /* We only have to check for a few names here: a, b, EXPORT, ISA - and VERSION. All the others apply only to the main stash or to - CORE (which is checked right after this). */ - if (len) { - switch (*name) { - case 'E': + /* We only have to check for a few names here: a, b, EXPORT, ISA + and VERSION. All the others apply only to the main stash or to + CORE (which is checked right after this). */ + if (len) { + switch (*name) { + case 'E': if ( len >= 6 && name[1] == 'X' && (memEQs(name, len, "EXPORT") @@ -1967,46 +1967,46 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, ||memEQs(name, len, "EXPORT_FAIL") ||memEQs(name, len, "EXPORT_TAGS")) ) - GvMULTI_on(gv); - break; - case 'I': + GvMULTI_on(gv); + break; + case 'I': if (memEQs(name, len, "ISA")) - gv_magicalize_isa(gv); - break; - case 'V': + gv_magicalize_isa(gv); + break; + case 'V': if (memEQs(name, len, "VERSION")) - GvMULTI_on(gv); - break; - case 'a': + GvMULTI_on(gv); + break; + case 'a': if (stash == PL_debstash && memEQs(name, len, "args")) { - GvMULTI_on(gv_AVadd(gv)); - break; + GvMULTI_on(gv_AVadd(gv)); + break; } /* FALLTHROUGH */ - case 'b': - if (len == 1 && sv_type == SVt_PV) - GvMULTI_on(gv); - /* FALLTHROUGH */ - default: - goto try_core; - } - goto ret; - } + case 'b': + if (len == 1 && sv_type == SVt_PV) + GvMULTI_on(gv); + /* FALLTHROUGH */ + default: + goto try_core; + } + goto ret; + } try_core: - if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) { - /* Avoid null warning: */ - const char * const stashname = HvNAME(stash); assert(stashname); - if (strBEGINs(stashname, "CORE")) - S_maybe_add_coresub(aTHX_ 0, gv, name, len); - } + if (len > 1 /* shortest is uc */ && HvNAMELEN_get(stash) == 4) { + /* Avoid null warning: */ + const char * const stashname = HvNAME(stash); assert(stashname); + if (strBEGINs(stashname, "CORE")) + S_maybe_add_coresub(aTHX_ 0, gv, name, len); + } } else if (len > 1) { #ifndef EBCDIC - if (*name > 'V' ) { - NOOP; - /* Nothing else to do. - The compiler will probably turn the switch statement into a - branch table. Make sure we avoid even that small overhead for + if (*name > 'V' ) { + NOOP; + /* Nothing else to do. + The compiler will probably turn the switch statement into a + branch table. Make sure we avoid even that small overhead for the common case of lower case variable names. (On EBCDIC platforms, we can't just do: if (NATIVE_TO_ASCII(*name) > NATIVE_TO_ASCII('V') ) { @@ -2014,19 +2014,19 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, C1 (non-ASCII) controls on those platforms, so the remapping would make them larger than 'V') */ - } else + } else #endif - { - switch (*name) { - case 'A': + { + switch (*name) { + case 'A': if (memEQs(name, len, "ARGV")) { - IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; - } + IoFLAGS(GvIOn(gv)) |= IOf_ARGV|IOf_START; + } else if (memEQs(name, len, "ARGVOUT")) { - GvMULTI_on(gv); - } - break; - case 'E': + GvMULTI_on(gv); + } + break; + case 'E': if ( len >= 6 && name[1] == 'X' && (memEQs(name, len, "EXPORT") @@ -2034,51 +2034,51 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, ||memEQs(name, len, "EXPORT_FAIL") ||memEQs(name, len, "EXPORT_TAGS")) ) - GvMULTI_on(gv); - break; - case 'I': + GvMULTI_on(gv); + break; + case 'I': if (memEQs(name, len, "ISA")) { - gv_magicalize_isa(gv); - } - break; - case 'S': + gv_magicalize_isa(gv); + } + break; + case 'S': if (memEQs(name, len, "SIG")) { - HV *hv; - I32 i; - if (!PL_psig_name) { - Newxz(PL_psig_name, 2 * SIG_SIZE, SV*); - Newxz(PL_psig_pend, SIG_SIZE, int); - PL_psig_ptr = PL_psig_name + SIG_SIZE; - } else { - /* I think that the only way to get here is to re-use an - embedded perl interpreter, where the previous - use didn't clean up fully because - PL_perl_destruct_level was 0. I'm not sure that we - "support" that, in that I suspect in that scenario - there are sufficient other garbage values left in the - interpreter structure that something else will crash - before we get here. I suspect that this is one of - those "doctor, it hurts when I do this" bugs. */ - Zero(PL_psig_name, 2 * SIG_SIZE, SV*); - Zero(PL_psig_pend, SIG_SIZE, int); - } - GvMULTI_on(gv); - hv = GvHVn(gv); - hv_magic(hv, NULL, PERL_MAGIC_sig); - for (i = 1; i < SIG_SIZE; i++) { - SV * const * const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); - if (init) - sv_setsv(*init, &PL_sv_undef); - } - } - break; - case 'V': + HV *hv; + I32 i; + if (!PL_psig_name) { + Newxz(PL_psig_name, 2 * SIG_SIZE, SV*); + Newxz(PL_psig_pend, SIG_SIZE, int); + PL_psig_ptr = PL_psig_name + SIG_SIZE; + } else { + /* I think that the only way to get here is to re-use an + embedded perl interpreter, where the previous + use didn't clean up fully because + PL_perl_destruct_level was 0. I'm not sure that we + "support" that, in that I suspect in that scenario + there are sufficient other garbage values left in the + interpreter structure that something else will crash + before we get here. I suspect that this is one of + those "doctor, it hurts when I do this" bugs. */ + Zero(PL_psig_name, 2 * SIG_SIZE, SV*); + Zero(PL_psig_pend, SIG_SIZE, int); + } + GvMULTI_on(gv); + hv = GvHVn(gv); + hv_magic(hv, NULL, PERL_MAGIC_sig); + for (i = 1; i < SIG_SIZE; i++) { + SV * const * const init = hv_fetch(hv, PL_sig_name[i], strlen(PL_sig_name[i]), 1); + if (init) + sv_setsv(*init, &PL_sv_undef); + } + } + break; + case 'V': if (memEQs(name, len, "VERSION")) - GvMULTI_on(gv); - break; + GvMULTI_on(gv); + break; case '\003': /* $^CHILD_ERROR_NATIVE */ if (memEQs(name, len, "\003HILD_ERROR_NATIVE")) - goto magicalize; + goto magicalize; /* @{^CAPTURE} %{^CAPTURE} */ if (memEQs(name, len, "\003APTURE")) { AV* const av = GvAVn(gv); @@ -2093,30 +2093,30 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, if (memEQs(name, len, "\003APTURE_ALL")) { require_tie_mod_s(gv, '-', "Tie::Hash::NamedCapture",0); } - break; - case '\005': /* $^ENCODING */ + break; + case '\005': /* $^ENCODING */ if (memEQs(name, len, "\005NCODING")) - goto magicalize; - break; - case '\007': /* $^GLOBAL_PHASE */ + goto magicalize; + break; + case '\007': /* $^GLOBAL_PHASE */ if (memEQs(name, len, "\007LOBAL_PHASE")) - goto ro_magicalize; - break; - case '\014': /* $^LAST_FH */ + goto ro_magicalize; + break; + case '\014': /* $^LAST_FH */ if (memEQs(name, len, "\014AST_FH")) - goto ro_magicalize; - break; + goto ro_magicalize; + break; case '\015': /* $^MATCH */ if (memEQs(name, len, "\015ATCH")) { paren = RX_BUFF_IDX_CARET_FULLMATCH; goto storeparen; } break; - case '\017': /* $^OPEN */ + case '\017': /* $^OPEN */ if (memEQs(name, len, "\017PEN")) - goto magicalize; - break; - case '\020': /* $^PREMATCH $^POSTMATCH */ + goto magicalize; + break; + case '\020': /* $^PREMATCH $^POSTMATCH */ if (memEQs(name, len, "\020REMATCH")) { paren = RX_BUFF_IDX_CARET_PREMATCH; goto storeparen; @@ -2125,73 +2125,73 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, paren = RX_BUFF_IDX_CARET_POSTMATCH; goto storeparen; } - break; + break; case '\023': if (memEQs(name, len, "\023AFE_LOCALES")) - goto ro_magicalize; - break; - case '\024': /* ${^TAINT} */ + goto ro_magicalize; + break; + case '\024': /* ${^TAINT} */ if (memEQs(name, len, "\024AINT")) - goto ro_magicalize; - break; - case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */ + goto ro_magicalize; + break; + case '\025': /* ${^UNICODE}, ${^UTF8LOCALE} */ if (memEQs(name, len, "\025NICODE")) - goto ro_magicalize; + goto ro_magicalize; if (memEQs(name, len, "\025TF8LOCALE")) - goto ro_magicalize; + goto ro_magicalize; if (memEQs(name, len, "\025TF8CACHE")) - goto magicalize; - break; - case '\027': /* $^WARNING_BITS */ + goto magicalize; + break; + case '\027': /* $^WARNING_BITS */ if (memEQs(name, len, "\027ARNING_BITS")) - goto magicalize; + goto magicalize; #ifdef WIN32 else if (memEQs(name, len, "\027IN32_SLOPPY_STAT")) - goto magicalize; + goto magicalize; #endif - break; - case '1': - case '2': - case '3': - case '4': - case '5': - case '6': - case '7': - case '8': - case '9': - { - /* Ensures that we have an all-digit variable, ${"1foo"} fails - this test */ + break; + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + { + /* Ensures that we have an all-digit variable, ${"1foo"} fails + this test */ UV uv; if (!grok_atoUV(name, &uv, NULL) || uv > I32_MAX) goto ret; /* XXX why are we using a SSize_t? */ paren = (SSize_t)(I32)uv; goto storeparen; - } - } - } + } + } + } } else { - /* Names of length 1. (Or 0. But name is NUL terminated, so that will - be case '\0' in this switch statement (ie a default case) */ - switch (*name) { - case '&': /* $& */ + /* Names of length 1. (Or 0. But name is NUL terminated, so that will + be case '\0' in this switch statement (ie a default case) */ + switch (*name) { + case '&': /* $& */ paren = RX_BUFF_IDX_FULLMATCH; goto sawampersand; - case '`': /* $` */ + case '`': /* $` */ paren = RX_BUFF_IDX_PREMATCH; goto sawampersand; - case '\'': /* $' */ + case '\'': /* $' */ paren = RX_BUFF_IDX_POSTMATCH; sawampersand: #ifdef PERL_SAWAMPERSAND - if (!( - sv_type == SVt_PVAV || - sv_type == SVt_PVHV || - sv_type == SVt_PVCV || - sv_type == SVt_PVFM || - sv_type == SVt_PVIO - )) { PL_sawampersand |= + if (!( + sv_type == SVt_PVAV || + sv_type == SVt_PVHV || + sv_type == SVt_PVCV || + sv_type == SVt_PVFM || + sv_type == SVt_PVIO + )) { PL_sawampersand |= (*name == '`') ? SAWAMPERSAND_LEFT : (*name == '&') @@ -2217,29 +2217,29 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, paren); break; - case ':': /* $: */ - sv_setpv(GvSVn(gv),PL_chopset); - goto magicalize; + case ':': /* $: */ + sv_setpv(GvSVn(gv),PL_chopset); + goto magicalize; - case '?': /* $? */ + case '?': /* $? */ #ifdef COMPLEX_STATUS - SvUPGRADE(GvSVn(gv), SVt_PVLV); + SvUPGRADE(GvSVn(gv), SVt_PVLV); #endif - goto magicalize; + goto magicalize; - case '!': /* $! */ - GvMULTI_on(gv); - /* If %! has been used, automatically load Errno.pm. */ + case '!': /* $! */ + GvMULTI_on(gv); + /* If %! has been used, automatically load Errno.pm. */ - sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); + sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); /* magicalization must be done before require_tie_mod_s is called */ - if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) + if (sv_type == SVt_PVHV || sv_type == SVt_PVGV) require_tie_mod_s(gv, '!', "Errno", 1); - break; - case '-': /* $-, %-, @- */ - case '+': /* $+, %+, @+ */ + break; + case '-': /* $-, %-, @- */ + case '+': /* $+, %+, @+ */ GvMULTI_on(gv); /* no used once warnings here */ { /* $- $+ */ sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); @@ -2258,81 +2258,81 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, SvREADONLY_on(av); } break; - case '*': /* $* */ - case '#': /* $# */ + case '*': /* $* */ + case '#': /* $# */ if (sv_type == SVt_PV) /* diag_listed_as: $* is no longer supported as of Perl 5.30 */ Perl_croak(aTHX_ "$%c is no longer supported as of Perl 5.30", *name); break; - case '\010': /* $^H */ - { - HV *const hv = GvHVn(gv); - hv_magic(hv, NULL, PERL_MAGIC_hints); - } - goto magicalize; - case '\023': /* $^S */ - ro_magicalize: - SvREADONLY_on(GvSVn(gv)); - /* FALLTHROUGH */ - case '0': /* $0 */ - case '^': /* $^ */ - case '~': /* $~ */ - case '=': /* $= */ - case '%': /* $% */ - case '.': /* $. */ - case '(': /* $( */ - case ')': /* $) */ - case '<': /* $< */ - case '>': /* $> */ - case '\\': /* $\ */ - case '/': /* $/ */ - case '|': /* $| */ - case '$': /* $$ */ - case '[': /* $[ */ - case '\001': /* $^A */ - case '\003': /* $^C */ - case '\004': /* $^D */ - case '\005': /* $^E */ - case '\006': /* $^F */ - case '\011': /* $^I, NOT \t in EBCDIC */ - case '\016': /* $^N */ - case '\017': /* $^O */ - case '\020': /* $^P */ - case '\024': /* $^T */ - case '\027': /* $^W */ - magicalize: - sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); - break; - - case '\014': /* $^L */ - sv_setpvs(GvSVn(gv),"\f"); - break; - case ';': /* $; */ - sv_setpvs(GvSVn(gv),"\034"); - break; - case ']': /* $] */ - { - SV * const sv = GvSV(gv); - if (!sv_derived_from(PL_patchlevel, "version")) - upg_version(PL_patchlevel, TRUE); - GvSV(gv) = vnumify(PL_patchlevel); - SvREADONLY_on(GvSV(gv)); - SvREFCNT_dec(sv); - } - break; - case '\026': /* $^V */ - { - SV * const sv = GvSV(gv); - GvSV(gv) = new_version(PL_patchlevel); - SvREADONLY_on(GvSV(gv)); - SvREFCNT_dec(sv); - } - break; - case 'a': - case 'b': - if (sv_type == SVt_PV) - GvMULTI_on(gv); - } + case '\010': /* $^H */ + { + HV *const hv = GvHVn(gv); + hv_magic(hv, NULL, PERL_MAGIC_hints); + } + goto magicalize; + case '\023': /* $^S */ + ro_magicalize: + SvREADONLY_on(GvSVn(gv)); + /* FALLTHROUGH */ + case '0': /* $0 */ + case '^': /* $^ */ + case '~': /* $~ */ + case '=': /* $= */ + case '%': /* $% */ + case '.': /* $. */ + case '(': /* $( */ + case ')': /* $) */ + case '<': /* $< */ + case '>': /* $> */ + case '\\': /* $\ */ + case '/': /* $/ */ + case '|': /* $| */ + case '$': /* $$ */ + case '[': /* $[ */ + case '\001': /* $^A */ + case '\003': /* $^C */ + case '\004': /* $^D */ + case '\005': /* $^E */ + case '\006': /* $^F */ + case '\011': /* $^I, NOT \t in EBCDIC */ + case '\016': /* $^N */ + case '\017': /* $^O */ + case '\020': /* $^P */ + case '\024': /* $^T */ + case '\027': /* $^W */ + magicalize: + sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len); + break; + + case '\014': /* $^L */ + sv_setpvs(GvSVn(gv),"\f"); + break; + case ';': /* $; */ + sv_setpvs(GvSVn(gv),"\034"); + break; + case ']': /* $] */ + { + SV * const sv = GvSV(gv); + if (!sv_derived_from(PL_patchlevel, "version")) + upg_version(PL_patchlevel, TRUE); + GvSV(gv) = vnumify(PL_patchlevel); + SvREADONLY_on(GvSV(gv)); + SvREFCNT_dec(sv); + } + break; + case '\026': /* $^V */ + { + SV * const sv = GvSV(gv); + GvSV(gv) = new_version(PL_patchlevel); + SvREADONLY_on(GvSV(gv)); + SvREFCNT_dec(sv); + } + break; + case 'a': + case 'b': + if (sv_type == SVt_PV) + GvMULTI_on(gv); + } } ret: @@ -2461,7 +2461,7 @@ to C makes it behave identically to C. GV * Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, - const svtype sv_type) + const svtype sv_type) { const char *name = nambeg; GV *gv = NULL; @@ -2500,8 +2500,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, /* By this point we should have a stash and a name */ gvp = (GV**)hv_fetch(stash,name,is_utf8 ? -(I32)len : (I32)len,add); if (!gvp || *gvp == (const GV *)&PL_sv_undef) { - if (addmg) gv = (GV *)newSV(0); /* tentatively */ - else return NULL; + if (addmg) gv = (GV *)newSV(0); /* tentatively */ + else return NULL; } else gv = *gvp, addmg = 0; /* From this point on, addmg means gv has not been inserted in the @@ -2511,7 +2511,7 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, /* The GV already exists, so return it, but check if we need to do * anything else with it before that. */ - if (add) { + if (add) { /* This is the heuristic that handles if a variable triggers the * 'used only once' warning. If there's already a GV in the stash * with this name, then we assume that the variable has been used @@ -2520,24 +2520,24 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, * BEGIN { $a = 1; $::{foo} = *a }; () = $foo * not warning about $main::foo being used just once */ - GvMULTI_on(gv); - gv_init_svtype(gv, sv_type); + GvMULTI_on(gv); + gv_init_svtype(gv, sv_type); /* You reach this path once the typeglob has already been created, either by the same or a different sigil. If this path didn't exist, then (say) referencing $! first, and %! second would mean that %! was not handled correctly. */ - if (len == 1 && stash == PL_defstash) { + if (len == 1 && stash == PL_defstash) { maybe_multimagic_gv(gv, name, sv_type); - } + } else if (sv_type == SVt_PVAV - && memEQs(name, len, "ISA") - && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv)))) - gv_magicalize_isa(gv); - } - return gv; + && memEQs(name, len, "ISA") + && (!GvAV(gv) || !SvSMAGICAL(GvAV(gv)))) + gv_magicalize_isa(gv); + } + return gv; } else if (no_init) { - assert(!addmg); - return gv; + assert(!addmg); + return gv; } /* If GV_NOEXPAND is true and what we got off the stash is a ref, * don't expand it to a glob. This is an optimization so that things @@ -2546,8 +2546,8 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, * stashes. */ else if (no_expand && SvROK(gv)) { - assert(!addmg); - return gv; + assert(!addmg); + return gv; } /* Adding a new symbol. @@ -2560,9 +2560,9 @@ Perl_gv_fetchpvn_flags(pTHX_ const char *nambeg, STRLEN full_len, I32 flags, faking_it = SvOK(gv); if (add & GV_ADDWARN) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Had to create %" UTF8f " unexpectedly", - UTF8fARG(is_utf8, name_end-nambeg, nambeg)); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Had to create %" UTF8f " unexpectedly", + UTF8fARG(is_utf8, name_end-nambeg, nambeg)); gv_init_pvn(gv, stash, name, len, (add & GV_ADDMULTI)|is_utf8); if ( full_len != 0 @@ -2607,8 +2607,8 @@ Perl_gv_fullname4(pTHX_ SV *sv, const GV *gv, const char *prefix, bool keepmain) if (hv && (name = HvNAME(hv))) { const STRLEN len = HvNAMELEN(hv); if (keepmain || ! memBEGINs(name, len, "main")) { - sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES); - sv_catpvs(sv,"::"); + sv_catpvn_flags(sv,name,len,HvNAMEUTF8(hv)?SV_CATUTF8:SV_CATBYTES); + sv_catpvs(sv,"::"); } } else sv_catpvs(sv,"__ANON__::"); @@ -2638,7 +2638,7 @@ Perl_gv_check(pTHX_ HV *stash) PERL_ARGS_ASSERT_GV_CHECK; if (!SvOOK(stash)) - return; + return; assert(HvARRAY(stash)); @@ -2646,21 +2646,21 @@ Perl_gv_check(pTHX_ HV *stash) const HE *entry; /* mark stash is being scanned, to avoid recursing */ HvAUX(stash)->xhv_aux_flags |= HvAUXf_SCAN_STASH; - for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { + for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) { GV *gv; HV *hv; - STRLEN keylen = HeKLEN(entry); + STRLEN keylen = HeKLEN(entry); const char * const key = HeKEY(entry); - if (keylen >= 2 && key[keylen-2] == ':' && key[keylen-1] == ':' && - (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv))) - { - if (hv != PL_defstash && hv != stash + if (keylen >= 2 && key[keylen-2] == ':' && key[keylen-1] == ':' && + (gv = MUTABLE_GV(HeVAL(entry))) && isGV(gv) && (hv = GvHV(gv))) + { + if (hv != PL_defstash && hv != stash && !(SvOOK(hv) && (HvAUX(hv)->xhv_aux_flags & HvAUXf_SCAN_STASH)) ) - gv_check(hv); /* nested package */ - } + gv_check(hv); /* nested package */ + } else if ( HeKLEN(entry) != 0 && *HeKEY(entry) != '_' && isIDFIRST_lazy_if_safe(HeKEY(entry), @@ -2668,24 +2668,24 @@ Perl_gv_check(pTHX_ HV *stash) HeUTF8(entry)) ) { const char *file; - gv = MUTABLE_GV(HeVAL(entry)); - if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) - continue; - file = GvFILE(gv); - CopLINE_set(PL_curcop, GvLINE(gv)); + gv = MUTABLE_GV(HeVAL(entry)); + if (SvTYPE(gv) != SVt_PVGV || GvMULTI(gv)) + continue; + file = GvFILE(gv); + CopLINE_set(PL_curcop, GvLINE(gv)); #ifdef USE_ITHREADS - CopFILE(PL_curcop) = (char *)file; /* set for warning */ + CopFILE(PL_curcop) = (char *)file; /* set for warning */ #else - CopFILEGV(PL_curcop) - = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0); + CopFILEGV(PL_curcop) + = gv_fetchfile_flags(file, HEK_LEN(GvFILE_HEK(gv)), 0); #endif - Perl_warner(aTHX_ packWARN(WARN_ONCE), - "Name \"%" HEKf "::%" HEKf - "\" used only once: possible typo", + Perl_warner(aTHX_ packWARN(WARN_ONCE), + "Name \"%" HEKf "::%" HEKf + "\" used only once: possible typo", HEKfARG(HvNAME_HEK(stash)), HEKfARG(GvNAME_HEK(gv))); - } - } + } + } HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_SCAN_STASH; } } @@ -2708,17 +2708,17 @@ GP* Perl_gp_ref(pTHX_ GP *gp) { if (!gp) - return NULL; + return NULL; gp->gp_refcnt++; if (gp->gp_cv) { - if (gp->gp_cvgen) { - /* If the GP they asked for a reference to contains + if (gp->gp_cvgen) { + /* If the GP they asked for a reference to contains a method cache entry, clear it first, so that we don't infect them with our cached entry */ - SvREFCNT_dec_NN(gp->gp_cv); - gp->gp_cv = NULL; - gp->gp_cvgen = 0; - } + SvREFCNT_dec_NN(gp->gp_cv); + gp->gp_cv = NULL; + gp->gp_cvgen = 0; + } } return gp; } @@ -2730,19 +2730,19 @@ Perl_gp_free(pTHX_ GV *gv) int attempts = 100; if (!gv || !isGV_with_GP(gv) || !(gp = GvGP(gv))) - return; + return; if (gp->gp_refcnt == 0) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free unreferenced glob pointers" - pTHX__FORMAT pTHX__VALUE); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free unreferenced glob pointers" + pTHX__FORMAT pTHX__VALUE); return; } if (gp->gp_refcnt > 1) { borrowed: - if (gp->gp_egv == gv) - gp->gp_egv = 0; - gp->gp_refcnt--; - GvGP_set(gv, NULL); + if (gp->gp_egv == gv) + gp->gp_egv = 0; + gp->gp_refcnt--; + GvGP_set(gv, NULL); return; } @@ -2766,7 +2766,7 @@ Perl_gp_free(pTHX_ GV *gv) gp->gp_form = NULL; if (file_hek) - unshare_hek(file_hek); + unshare_hek(file_hek); SvREFCNT_dec(sv); SvREFCNT_dec(av); @@ -2780,18 +2780,18 @@ Perl_gp_free(pTHX_ GV *gv) HEKfARG(hvname_hek))); (void)hv_deletehek(PL_stashcache, hvname_hek, G_DISCARD); } - SvREFCNT_dec(hv); + SvREFCNT_dec(hv); } if (io && SvREFCNT(io) == 1 && IoIFP(io) - && (IoTYPE(io) == IoTYPE_WRONLY || - IoTYPE(io) == IoTYPE_RDWR || - IoTYPE(io) == IoTYPE_APPEND) - && ckWARN_d(WARN_IO) - && IoIFP(io) != PerlIO_stdin() - && IoIFP(io) != PerlIO_stdout() - && IoIFP(io) != PerlIO_stderr() - && !(IoFLAGS(io) & IOf_FAKE_DIRP)) - io_close(io, gv, FALSE, TRUE); + && (IoTYPE(io) == IoTYPE_WRONLY || + IoTYPE(io) == IoTYPE_RDWR || + IoTYPE(io) == IoTYPE_APPEND) + && ckWARN_d(WARN_IO) + && IoIFP(io) != PerlIO_stdin() + && IoIFP(io) != PerlIO_stdout() + && IoIFP(io) != PerlIO_stderr() + && !(IoFLAGS(io) & IOf_FAKE_DIRP)) + io_close(io, gv, FALSE, TRUE); SvREFCNT_dec(io); SvREFCNT_dec(cv); SvREFCNT_dec(form); @@ -2808,10 +2808,10 @@ Perl_gp_free(pTHX_ GV *gv) && !gp->gp_form) break; if (--attempts == 0) { - Perl_die(aTHX_ - "panic: gp_free failed to free glob pointer - " - "something is repeatedly re-creating entries" - ); + Perl_die(aTHX_ + "panic: gp_free failed to free glob pointer - " + "something is repeatedly re-creating entries" + ); } } @@ -2830,14 +2830,14 @@ Perl_magic_freeovrld(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_FREEOVRLD; if (amtp && AMT_AMAGIC(amtp)) { - int i; - for (i = 1; i < NofAMmeth; i++) { - CV * const cv = amtp->table[i]; - if (cv) { - SvREFCNT_dec_NN(MUTABLE_SV(cv)); - amtp->table[i] = NULL; - } - } + int i; + for (i = 1; i < NofAMmeth; i++) { + CV * const cv = amtp->table[i]; + if (cv) { + SvREFCNT_dec_NN(MUTABLE_SV(cv)); + amtp->table[i] = NULL; + } + } } return 0; } @@ -2863,7 +2863,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (mg) { const AMT * const amtp = (AMT*)mg->mg_ptr; if (amtp->was_ok_sub == newgen) { - return AMT_AMAGIC(amtp) ? 1 : 0; + return AMT_AMAGIC(amtp) ? 1 : 0; } sv_unmagic(MUTABLE_SV(stash), PERL_MAGIC_overload_table); } @@ -2891,19 +2891,19 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (!gv) { if (!gv_fetchmeth_pvn(stash, "((", 2, -1, 0)) - goto no_table; + goto no_table; } #ifdef PERL_DONT_CREATE_GVSV else if (!sv) { - NOOP; /* Equivalent to !SvTRUE and !SvOK */ + NOOP; /* Equivalent to !SvTRUE and !SvOK */ } #endif else if (SvTRUE(sv)) /* don't need to set overloading here because fallback => 1 * is the default setting for classes without overloading */ - amt.fallback=AMGfallYES; + amt.fallback=AMGfallYES; else if (SvOK(sv)) { - amt.fallback=AMGfallNEVER; + amt.fallback=AMGfallNEVER; filled = 1; } else { @@ -2915,21 +2915,21 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF; for (i = 1; i < NofAMmeth; i++) { - const char * const cooky = PL_AMG_names[i]; - /* Human-readable form, for debugging: */ - const char * const cp = AMG_id2name(i); - const STRLEN l = PL_AMG_namelens[i]; - - DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n", - cp, HvNAME_get(stash)) ); - /* don't fill the cache while looking up! - Creation of inheritance stubs in intermediate packages may - conflict with the logic of runtime method substitution. - Indeed, for inheritance A -> B -> C, if C overloads "+0", - then we could have created stubs for "(+0" in A and C too. - But if B overloads "bool", we may want to use it for - numifying instead of C's "+0". */ - gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0); + const char * const cooky = PL_AMG_names[i]; + /* Human-readable form, for debugging: */ + const char * const cp = AMG_id2name(i); + const STRLEN l = PL_AMG_namelens[i]; + + DEBUG_o( Perl_deb(aTHX_ "Checking overloading of \"%s\" in package \"%.256s\"\n", + cp, HvNAME_get(stash)) ); + /* don't fill the cache while looking up! + Creation of inheritance stubs in intermediate packages may + conflict with the logic of runtime method substitution. + Indeed, for inheritance A -> B -> C, if C overloads "+0", + then we could have created stubs for "(+0" in A and C too. + But if B overloads "bool", we may want to use it for + numifying instead of C's "+0". */ + gv = Perl_gv_fetchmeth_pvn(aTHX_ stash, cooky, l, -1, 0); cv = 0; if (gv && (cv = GvCV(gv)) && CvHASGV(cv)) { const HEK * const gvhek = CvGvNAME_HEK(cv); @@ -2938,49 +2938,49 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (memEQs(HEK_KEY(gvhek), HEK_LEN(gvhek), "nil") && stashek && memEQs(HEK_KEY(stashek), HEK_LEN(stashek), "overload")) { - /* This is a hack to support autoloading..., while - knowing *which* methods were declared as overloaded. */ - /* GvSV contains the name of the method. */ - GV *ngv = NULL; - SV *gvsv = GvSV(gv); - - DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%" SVf256\ - "\" for overloaded \"%s\" in package \"%.256s\"\n", - (void*)GvSV(gv), cp, HvNAME(stash)) ); - if (!gvsv || !SvPOK(gvsv) - || !(ngv = gv_fetchmethod_sv_flags(stash, gvsv, 0))) - { - /* Can be an import stub (created by "can"). */ - if (destructing) { - return -1; - } - else { - const SV * const name = (gvsv && SvPOK(gvsv)) + /* This is a hack to support autoloading..., while + knowing *which* methods were declared as overloaded. */ + /* GvSV contains the name of the method. */ + GV *ngv = NULL; + SV *gvsv = GvSV(gv); + + DEBUG_o( Perl_deb(aTHX_ "Resolving method \"%" SVf256\ + "\" for overloaded \"%s\" in package \"%.256s\"\n", + (void*)GvSV(gv), cp, HvNAME(stash)) ); + if (!gvsv || !SvPOK(gvsv) + || !(ngv = gv_fetchmethod_sv_flags(stash, gvsv, 0))) + { + /* Can be an import stub (created by "can"). */ + if (destructing) { + return -1; + } + else { + const SV * const name = (gvsv && SvPOK(gvsv)) ? gvsv : newSVpvs_flags("???", SVs_TEMP); - /* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */ - Perl_croak(aTHX_ "%s method \"%" SVf256 - "\" overloading \"%s\" "\ - "in package \"%" HEKf256 "\"", - (GvCVGEN(gv) ? "Stub found while resolving" - : "Can't resolve"), - SVfARG(name), cp, + /* diag_listed_as: Can't resolve method "%s" overloading "%s" in package "%s" */ + Perl_croak(aTHX_ "%s method \"%" SVf256 + "\" overloading \"%s\" "\ + "in package \"%" HEKf256 "\"", + (GvCVGEN(gv) ? "Stub found while resolving" + : "Can't resolve"), + SVfARG(name), cp, HEKfARG( - HvNAME_HEK(stash) - )); - } - } - cv = GvCV(gv = ngv); - } - DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n", - cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))), - GvNAME(CvGV(cv))) ); - filled = 1; - } else if (gv) { /* Autoloaded... */ - cv = MUTABLE_CV(gv); - filled = 1; - } - amt.table[i]=MUTABLE_CV(SvREFCNT_inc_simple(cv)); + HvNAME_HEK(stash) + )); + } + } + cv = GvCV(gv = ngv); + } + DEBUG_o( Perl_deb(aTHX_ "Overloading \"%s\" in package \"%.256s\" via \"%.256s::%.256s\"\n", + cp, HvNAME_get(stash), HvNAME_get(GvSTASH(CvGV(cv))), + GvNAME(CvGV(cv))) ); + filled = 1; + } else if (gv) { /* Autoloaded... */ + cv = MUTABLE_CV(gv); + filled = 1; + } + amt.table[i]=MUTABLE_CV(SvREFCNT_inc_simple(cv)); if (gv) { switch (i) { @@ -3004,7 +3004,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) if (filled) { AMT_AMAGIC_on(&amt); sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table, - (char*)&amt, sizeof(AMT)); + (char*)&amt, sizeof(AMT)); return TRUE; } } @@ -3012,7 +3012,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash, bool destructing) no_table: AMT_AMAGIC_off(&amt); sv_magic(MUTABLE_SV(stash), 0, PERL_MAGIC_overload_table, - (char*)&amt, sizeof(AMTS)); + (char*)&amt, sizeof(AMTS)); return 0; } @@ -3034,27 +3034,27 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); if (!mg) { do_update: - if (Gv_AMupdate(stash, 0) == -1) - return NULL; - mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); + if (Gv_AMupdate(stash, 0) == -1) + return NULL; + mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table); } assert(mg); amtp = (AMT*)mg->mg_ptr; if ( amtp->was_ok_sub != newgen ) - goto do_update; + goto do_update; if (AMT_AMAGIC(amtp)) { - CV * const ret = amtp->table[id]; - if (ret && isGV(ret)) { /* Autoloading stab */ - /* Passing it through may have resulted in a warning - "Inherited AUTOLOAD for a non-method deprecated", since - our caller is going through a function call, not a method call. - So return the CV for AUTOLOAD, setting $AUTOLOAD. */ - GV * const gv = gv_fetchmethod(stash, PL_AMG_names[id]); - - if (gv && GvCV(gv)) - return GvCV(gv); - } - return ret; + CV * const ret = amtp->table[id]; + if (ret && isGV(ret)) { /* Autoloading stab */ + /* Passing it through may have resulted in a warning + "Inherited AUTOLOAD for a non-method deprecated", since + our caller is going through a function call, not a method call. + So return the CV for AUTOLOAD, setting $AUTOLOAD. */ + GV * const gv = gv_fetchmethod(stash, PL_AMG_names[id]); + + if (gv && GvCV(gv)) + return GvCV(gv); + } + return ret; } return NULL; @@ -3064,7 +3064,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id) /* Implement tryAMAGICun_MG macro. Do get magic, then see if the stack arg is overloaded and if so call it. Flags: - AMGf_numeric apply sv_2num to the stack arg. + AMGf_numeric apply sv_2num to the stack arg. */ bool @@ -3076,8 +3076,8 @@ Perl_try_amagic_un(pTHX_ int method, int flags) { SvGETMAGIC(arg); if (SvAMAGIC(arg) && (tmpsv = amagic_call(arg, &PL_sv_undef, method, - AMGf_noright | AMGf_unary - | (flags & AMGf_numarg)))) + AMGf_noright | AMGf_unary + | (flags & AMGf_numarg)))) { /* where the op is of the form: * $lex = $x op $y (where the assign is optimised away) @@ -3094,12 +3094,12 @@ Perl_try_amagic_un(pTHX_ int method, int flags) { else SETs(tmpsv); - PUTBACK; - return TRUE; + PUTBACK; + return TRUE; } if ((flags & AMGf_numeric) && SvROK(arg)) - *sp = sv_2num(arg); + *sp = sv_2num(arg); return FALSE; } @@ -3108,8 +3108,8 @@ Perl_try_amagic_un(pTHX_ int method, int flags) { Do get magic, then see if the two stack args are overloaded and if so call it. Flags: - AMGf_assign op may be called as mutator (eg +=) - AMGf_numeric apply sv_2num to the stack arg. + AMGf_assign op may be called as mutator (eg +=) + AMGf_numeric apply sv_2num to the stack arg. */ bool @@ -3120,17 +3120,17 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) { SvGETMAGIC(left); if (left != right) - SvGETMAGIC(right); + SvGETMAGIC(right); if (SvAMAGIC(left) || SvAMAGIC(right)) { - SV * tmpsv; + SV * tmpsv; /* STACKED implies mutator variant, e.g. $x += 1 */ bool mutator = (flags & AMGf_assign) && (PL_op->op_flags & OPf_STACKED); - tmpsv = amagic_call(left, right, method, - (mutator ? AMGf_assign: 0) - | (flags & AMGf_numarg)); - if (tmpsv) { + tmpsv = amagic_call(left, right, method, + (mutator ? AMGf_assign: 0) + | (flags & AMGf_numarg)); + if (tmpsv) { (void)POPs; /* where the op is one of the two forms: * $x op= $y @@ -3150,28 +3150,28 @@ Perl_try_amagic_bin(pTHX_ int method, int flags) { else SETs(tmpsv); - PUTBACK; - return TRUE; - } + PUTBACK; + return TRUE; + } } if(left==right && SvGMAGICAL(left)) { - SV * const left = sv_newmortal(); - *(sp-1) = left; - /* Print the uninitialized warning now, so it includes the vari- - able name. */ - if (!SvOK(right)) { - if (ckWARN(WARN_UNINITIALIZED)) report_uninit(right); - sv_setsv_flags(left, &PL_sv_no, 0); - } - else sv_setsv_flags(left, right, 0); - SvGETMAGIC(right); + SV * const left = sv_newmortal(); + *(sp-1) = left; + /* Print the uninitialized warning now, so it includes the vari- + able name. */ + if (!SvOK(right)) { + if (ckWARN(WARN_UNINITIALIZED)) report_uninit(right); + sv_setsv_flags(left, &PL_sv_no, 0); + } + else sv_setsv_flags(left, right, 0); + SvGETMAGIC(right); } if (flags & AMGf_numeric) { - if (SvROK(TOPm1s)) - *(sp-1) = sv_2num(TOPm1s); - if (SvROK(right)) - *sp = sv_2num(right); + if (SvROK(TOPm1s)) + *(sp-1) = sv_2num(TOPm1s); + if (SvROK(right)) + *sp = sv_2num(right); } return FALSE; } @@ -3192,14 +3192,14 @@ Perl_amagic_deref_call(pTHX_ SV *ref, int method) { return ref; while ((tmpsv = amagic_call(ref, &PL_sv_undef, method, - AMGf_noright | AMGf_unary))) { - if (!SvROK(tmpsv)) - Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); - if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) { - /* Bail out if it returns us the same reference. */ - return tmpsv; - } - ref = tmpsv; + AMGf_noright | AMGf_unary))) { + if (!SvROK(tmpsv)) + Perl_croak(aTHX_ "Overloaded dereference did not return a reference"); + if (tmpsv == ref || SvRV(tmpsv) == SvRV(ref)) { + /* Bail out if it returns us the same reference. */ + return tmpsv; + } + ref = tmpsv; if (!SvAMAGIC(ref)) break; } @@ -3214,19 +3214,19 @@ Perl_amagic_is_enabled(pTHX_ int method) assert(PL_curcop->cop_hints & HINT_NO_AMAGIC); if ( !lex_mask || !SvOK(lex_mask) ) - /* overloading lexically disabled */ - return FALSE; + /* overloading lexically disabled */ + return FALSE; else if ( lex_mask && SvPOK(lex_mask) ) { - /* we have an entry in the hints hash, check if method has been - * masked by overloading.pm */ - STRLEN len; - const int offset = method / 8; - const int bit = method % 8; - char *pv = SvPV(lex_mask, len); - - /* Bit set, so this overloading operator is disabled */ - if ( (STRLEN)offset < len && pv[offset] & ( 1 << bit ) ) - return FALSE; + /* we have an entry in the hints hash, check if method has been + * masked by overloading.pm */ + STRLEN len; + const int offset = method / 8; + const int bit = method % 8; + char *pv = SvPV(lex_mask, len); + + /* Bit set, so this overloading operator is disabled */ + if ( (STRLEN)offset < len && pv[offset] & ( 1 << bit ) ) + return FALSE; } return TRUE; } @@ -3259,16 +3259,16 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) && (stash = SvSTASH(SvRV(left))) && Gv_AMG(stash) && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table)) && (ocvp = cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) - ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table - : NULL)) + ? (oamtp = amtp = (AMT*)mg->mg_ptr)->table + : NULL)) && ((cv = cvp[off=method+assignshift]) - || (assign && amtp->fallback > AMGfallNEVER && /* fallback to - * usual method */ - ( + || (assign && amtp->fallback > AMGfallNEVER && /* fallback to + * usual method */ + ( #ifdef DEBUGGING - fl = 1, + fl = 1, #endif - cv = cvp[off=method])))) { + cv = cvp[off=method])))) { lr = -1; /* Call method for left argument */ } else { if (cvp && amtp->fallback > AMGfallNEVER && flags & AMGf_unary) { @@ -3276,30 +3276,30 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) /* look for substituted methods */ /* In all the covered cases we should be called with assign==0. */ - switch (method) { - case inc_amg: - force_cpy = 1; - if ((cv = cvp[off=add_ass_amg]) - || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) { - right = &PL_sv_yes; lr = -1; assign = 1; - } - break; - case dec_amg: - force_cpy = 1; - if ((cv = cvp[off = subtr_ass_amg]) - || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) { - right = &PL_sv_yes; lr = -1; assign = 1; - } - break; - case bool__amg: - (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg])); - break; - case numer_amg: - (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg])); - break; - case string_amg: - (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg])); - break; + switch (method) { + case inc_amg: + force_cpy = 1; + if ((cv = cvp[off=add_ass_amg]) + || ((cv = cvp[off = add_amg]) && (force_cpy = 0, postpr = 1))) { + right = &PL_sv_yes; lr = -1; assign = 1; + } + break; + case dec_amg: + force_cpy = 1; + if ((cv = cvp[off = subtr_ass_amg]) + || ((cv = cvp[off = subtr_amg]) && (force_cpy = 0, postpr=1))) { + right = &PL_sv_yes; lr = -1; assign = 1; + } + break; + case bool__amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=string_amg])); + break; + case numer_amg: + (void)((cv = cvp[off=string_amg]) || (cv = cvp[off=bool__amg])); + break; + case string_amg: + (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg])); + break; case not_amg: (void)((cv = cvp[off=bool__amg]) || (cv = cvp[off=numer_amg]) @@ -3307,115 +3307,115 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) if (cv) postpr = 1; break; - case copy_amg: - { - /* - * SV* ref causes confusion with the interpreter variable of - * the same name - */ - SV* const tmpRef=SvRV(left); - if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) { - /* - * Just to be extra cautious. Maybe in some - * additional cases sv_setsv is safe, too. - */ - SV* const newref = newSVsv(tmpRef); - SvOBJECT_on(newref); - /* No need to do SvAMAGIC_on here, as SvAMAGIC macros - delegate to the stash. */ - SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef)))); - return newref; - } - } - break; - case abs_amg: - if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) - && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) { - SV* const nullsv=&PL_sv_zero; - if (off1==lt_amg) { - SV* const lessp = amagic_call(left,nullsv, - lt_amg,AMGf_noright); - logic = SvTRUE_NN(lessp); - } else { - SV* const lessp = amagic_call(left,nullsv, - ncmp_amg,AMGf_noright); - logic = (SvNV(lessp) < 0); - } - if (logic) { - if (off==subtr_amg) { - right = left; - left = nullsv; - lr = 1; - } - } else { - return left; - } - } - break; - case neg_amg: - if ((cv = cvp[off=subtr_amg])) { - right = left; - left = &PL_sv_zero; - lr = 1; - } - break; - case int_amg: - case iter_amg: /* XXXX Eventually should do to_gv. */ - case ftest_amg: /* XXXX Eventually should do to_gv. */ - case regexp_amg: - /* FAIL safe */ - return NULL; /* Delegate operation to standard mechanisms. */ - - case to_sv_amg: - case to_av_amg: - case to_hv_amg: - case to_gv_amg: - case to_cv_amg: - /* FAIL safe */ - return left; /* Delegate operation to standard mechanisms. */ - - default: - goto not_found; - } - if (!cv) goto not_found; + case copy_amg: + { + /* + * SV* ref causes confusion with the interpreter variable of + * the same name + */ + SV* const tmpRef=SvRV(left); + if (!SvROK(tmpRef) && SvTYPE(tmpRef) <= SVt_PVMG) { + /* + * Just to be extra cautious. Maybe in some + * additional cases sv_setsv is safe, too. + */ + SV* const newref = newSVsv(tmpRef); + SvOBJECT_on(newref); + /* No need to do SvAMAGIC_on here, as SvAMAGIC macros + delegate to the stash. */ + SvSTASH_set(newref, MUTABLE_HV(SvREFCNT_inc(SvSTASH(tmpRef)))); + return newref; + } + } + break; + case abs_amg: + if ((cvp[off1=lt_amg] || cvp[off1=ncmp_amg]) + && ((cv = cvp[off=neg_amg]) || (cv = cvp[off=subtr_amg]))) { + SV* const nullsv=&PL_sv_zero; + if (off1==lt_amg) { + SV* const lessp = amagic_call(left,nullsv, + lt_amg,AMGf_noright); + logic = SvTRUE_NN(lessp); + } else { + SV* const lessp = amagic_call(left,nullsv, + ncmp_amg,AMGf_noright); + logic = (SvNV(lessp) < 0); + } + if (logic) { + if (off==subtr_amg) { + right = left; + left = nullsv; + lr = 1; + } + } else { + return left; + } + } + break; + case neg_amg: + if ((cv = cvp[off=subtr_amg])) { + right = left; + left = &PL_sv_zero; + lr = 1; + } + break; + case int_amg: + case iter_amg: /* XXXX Eventually should do to_gv. */ + case ftest_amg: /* XXXX Eventually should do to_gv. */ + case regexp_amg: + /* FAIL safe */ + return NULL; /* Delegate operation to standard mechanisms. */ + + case to_sv_amg: + case to_av_amg: + case to_hv_amg: + case to_gv_amg: + case to_cv_amg: + /* FAIL safe */ + return left; /* Delegate operation to standard mechanisms. */ + + default: + goto not_found; + } + if (!cv) goto not_found; } else if (!(AMGf_noright & flags) && SvAMAGIC(right) - && (stash = SvSTASH(SvRV(right))) && Gv_AMG(stash) - && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table)) - && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) - ? (amtp = (AMT*)mg->mg_ptr)->table - : NULL)) - && (cv = cvp[off=method])) { /* Method for right - * argument found */ + && (stash = SvSTASH(SvRV(right))) && Gv_AMG(stash) + && (mg = mg_find((const SV *)stash, PERL_MAGIC_overload_table)) + && (cvp = (AMT_AMAGIC((AMT*)mg->mg_ptr) + ? (amtp = (AMT*)mg->mg_ptr)->table + : NULL)) + && (cv = cvp[off=method])) { /* Method for right + * argument found */ lr=1; } else if (((cvp && amtp->fallback > AMGfallNEVER) || (ocvp && oamtp->fallback > AMGfallNEVER)) - && !(flags & AMGf_unary)) { - /* We look for substitution for - * comparison operations and - * concatenation */ + && !(flags & AMGf_unary)) { + /* We look for substitution for + * comparison operations and + * concatenation */ if (method==concat_amg || method==concat_ass_amg - || method==repeat_amg || method==repeat_ass_amg) { - return NULL; /* Delegate operation to string conversion */ + || method==repeat_amg || method==repeat_ass_amg) { + return NULL; /* Delegate operation to string conversion */ } off = -1; switch (method) { - case lt_amg: - case le_amg: - case gt_amg: - case ge_amg: - case eq_amg: - case ne_amg: + case lt_amg: + case le_amg: + case gt_amg: + case ge_amg: + case eq_amg: + case ne_amg: off = ncmp_amg; break; - case slt_amg: - case sle_amg: - case sgt_amg: - case sge_amg: - case seq_amg: - case sne_amg: + case slt_amg: + case sle_amg: + case sgt_amg: + case sge_amg: + case seq_amg: + case sne_amg: off = scmp_amg; break; - } + } if (off != -1) { if (ocvp && (oamtp->fallback > AMGfallNEVER)) { cv = ocvp[off]; @@ -3433,51 +3433,51 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) } else { not_found: /* No method found, either report or croak */ switch (method) { - case to_sv_amg: - case to_av_amg: - case to_hv_amg: - case to_gv_amg: - case to_cv_amg: - /* FAIL safe */ - return left; /* Delegate operation to standard mechanisms. */ + case to_sv_amg: + case to_av_amg: + case to_hv_amg: + case to_gv_amg: + case to_cv_amg: + /* FAIL safe */ + return left; /* Delegate operation to standard mechanisms. */ } if (ocvp && (cv=ocvp[nomethod_amg])) { /* Call report method */ - notfound = 1; lr = -1; + notfound = 1; lr = -1; } else if (cvp && (cv=cvp[nomethod_amg])) { - notfound = 1; lr = 1; + notfound = 1; lr = 1; } else if ((use_default_op = (!ocvp || oamtp->fallback >= AMGfallYES) && (!cvp || amtp->fallback >= AMGfallYES)) && !DEBUG_o_TEST) { - /* Skip generating the "no method found" message. */ - return NULL; + /* Skip generating the "no method found" message. */ + return NULL; } else { - SV *msg; - if (off==-1) off=method; - msg = sv_2mortal(Perl_newSVpvf(aTHX_ - "Operation \"%s\": no method found,%sargument %s%" SVf "%s%" SVf, - AMG_id2name(method + assignshift), - (flags & AMGf_unary ? " " : "\n\tleft "), - SvAMAGIC(left)? - "in overloaded package ": - "has no overloaded magic", - SvAMAGIC(left)? - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(left)))))): - SVfARG(&PL_sv_no), - SvAMAGIC(right)? - ",\n\tright argument in overloaded package ": - (flags & AMGf_unary - ? "" - : ",\n\tright argument has no overloaded magic"), - SvAMAGIC(right)? - SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))): - SVfARG(&PL_sv_no))); + SV *msg; + if (off==-1) off=method; + msg = sv_2mortal(Perl_newSVpvf(aTHX_ + "Operation \"%s\": no method found,%sargument %s%" SVf "%s%" SVf, + AMG_id2name(method + assignshift), + (flags & AMGf_unary ? " " : "\n\tleft "), + SvAMAGIC(left)? + "in overloaded package ": + "has no overloaded magic", + SvAMAGIC(left)? + SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(left)))))): + SVfARG(&PL_sv_no), + SvAMAGIC(right)? + ",\n\tright argument in overloaded package ": + (flags & AMGf_unary + ? "" + : ",\n\tright argument has no overloaded magic"), + SvAMAGIC(right)? + SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(SvSTASH(SvRV(right)))))): + SVfARG(&PL_sv_no))); if (use_default_op) { - DEBUG_o( Perl_deb(aTHX_ "%" SVf, SVfARG(msg)) ); - } else { - Perl_croak(aTHX_ "%" SVf, SVfARG(msg)); - } - return NULL; + DEBUG_o( Perl_deb(aTHX_ "%" SVf, SVfARG(msg)) ); + } else { + Perl_croak(aTHX_ "%" SVf, SVfARG(msg)); + } + return NULL; } force_cpy = force_cpy || assign; } @@ -3546,18 +3546,18 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) #ifdef DEBUGGING if (!notfound) { DEBUG_o(Perl_deb(aTHX_ - "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %" SVf "%s\n", - AMG_id2name(off), - method+assignshift==off? "" : - " (initially \"", - method+assignshift==off? "" : - AMG_id2name(method+assignshift), - method+assignshift==off? "" : "\")", - flags & AMGf_unary? "" : - lr==1 ? " for right argument": " for left argument", - flags & AMGf_unary? " for argument" : "", - stash ? SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))) : SVfARG(newSVpvs_flags("null", SVs_TEMP)), - fl? ",\n\tassignment variant used": "") ); + "Overloaded operator \"%s\"%s%s%s:\n\tmethod%s found%s in package %" SVf "%s\n", + AMG_id2name(off), + method+assignshift==off? "" : + " (initially \"", + method+assignshift==off? "" : + AMG_id2name(method+assignshift), + method+assignshift==off? "" : "\")", + flags & AMGf_unary? "" : + lr==1 ? " for right argument": " for left argument", + flags & AMGf_unary? " for argument" : "", + stash ? SVfARG(sv_2mortal(newSVhek(HvNAME_HEK(stash)))) : SVfARG(newSVpvs_flags("null", SVs_TEMP)), + fl? ",\n\tassignment variant used": "") ); } #endif /* Since we use shallow copy during assignment, we need @@ -3583,7 +3583,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) * In the latter case assignshift==0, so only notfound case is important. */ if ( (lr == -1) && ( ( (method + assignshift == off) - && (assign || (method == inc_amg) || (method == dec_amg))) + && (assign || (method == inc_amg) || (method == dec_amg))) || force_cpy) ) { /* newSVsv does not behave as advertised, so we copy missing @@ -3591,9 +3591,9 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) SV *tmpRef = SvRV(left); SV *rv_copy; if (SvREFCNT(tmpRef) > 1 && (rv_copy = AMG_CALLunary(left,copy_amg))) { - SvRV_set(left, rv_copy); - SvSETMAGIC(left); - SvREFCNT_dec_NN(tmpRef); + SvRV_set(left, rv_copy); + SvSETMAGIC(left); + SvREFCNT_dec_NN(tmpRef); } } @@ -3636,7 +3636,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) SAVEOP(); PL_op = (OP *) &myop; if (PERLDB_SUB && PL_curstash != PL_debstash) - PL_op->op_private |= OPpENTERSUB_DB; + PL_op->op_private |= OPpENTERSUB_DB; Perl_pp_pushmark(aTHX); EXTEND(SP, notfound + 5); @@ -3645,7 +3645,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) PUSHs( lr > 0 ? &PL_sv_yes : ( assign ? &PL_sv_undef : &PL_sv_no )); if (notfound) { PUSHs(newSVpvn_flags(AMG_id2name(method + assignshift), - AMG_id2namelen(method + assignshift), SVs_TEMP)); + AMG_id2namelen(method + assignshift), SVs_TEMP)); } else if (flags & AMGf_numarg) PUSHs(&PL_sv_undef); @@ -3692,34 +3692,34 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags) switch (method) { case le_amg: case sle_amg: - ans=SvIV(res)<=0; break; + ans=SvIV(res)<=0; break; case lt_amg: case slt_amg: - ans=SvIV(res)<0; break; + ans=SvIV(res)<0; break; case ge_amg: case sge_amg: - ans=SvIV(res)>=0; break; + ans=SvIV(res)>=0; break; case gt_amg: case sgt_amg: - ans=SvIV(res)>0; break; + ans=SvIV(res)>0; break; case eq_amg: case seq_amg: - ans=SvIV(res)==0; break; + ans=SvIV(res)==0; break; case ne_amg: case sne_amg: - ans=SvIV(res)!=0; break; + ans=SvIV(res)!=0; break; case inc_amg: case dec_amg: - SvSetSV(left,res); return left; + SvSetSV(left,res); return left; case not_amg: - ans=!SvTRUE_NN(res); break; + ans=!SvTRUE_NN(res); break; default: ans=0; break; } return boolSV(ans); } else if (method==copy_amg) { if (!SvROK(res)) { - Perl_croak(aTHX_ "Copy method did not return a reference"); + Perl_croak(aTHX_ "Copy method did not return a reference"); } return SvREFCNT_inc(SvRV(res)); } else { @@ -3736,10 +3736,10 @@ Perl_gv_name_set(pTHX_ GV *gv, const char *name, U32 len, U32 flags) PERL_ARGS_ASSERT_GV_NAME_SET; if (len > I32_MAX) - Perl_croak(aTHX_ "panic: gv name too long (%" UVuf ")", (UV) len); + Perl_croak(aTHX_ "panic: gv name too long (%" UVuf ")", (UV) len); if (!(flags & GV_ADD) && GvNAME_HEK(gv)) { - unshare_hek(GvNAME_HEK(gv)); + unshare_hek(GvNAME_HEK(gv)); } PERL_HASH(hash, name, len); @@ -3780,47 +3780,47 @@ Perl_gv_try_downgrade(pTHX_ GV *gv) if (PL_phase == PERL_PHASE_DESTRUCT) return; if (!(SvREFCNT(gv) == 1 && SvTYPE(gv) == SVt_PVGV && !SvFAKE(gv) && - !SvOBJECT(gv) && !SvREADONLY(gv) && - isGV_with_GP(gv) && GvGP(gv) && - !GvINTRO(gv) && GvREFCNT(gv) == 1 && - !GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) && - GvEGVx(gv) == gv && (stash = GvSTASH(gv)))) - return; + !SvOBJECT(gv) && !SvREADONLY(gv) && + isGV_with_GP(gv) && GvGP(gv) && + !GvINTRO(gv) && GvREFCNT(gv) == 1 && + !GvSV(gv) && !GvAV(gv) && !GvHV(gv) && !GvIOp(gv) && !GvFORM(gv) && + GvEGVx(gv) == gv && (stash = GvSTASH(gv)))) + return; if (gv == PL_statgv || gv == PL_last_in_gv || gv == PL_stderrgv) - return; + return; if (SvMAGICAL(gv)) { MAGIC *mg; - /* only backref magic is allowed */ - if (SvGMAGICAL(gv) || SvSMAGICAL(gv)) - return; + /* only backref magic is allowed */ + if (SvGMAGICAL(gv) || SvSMAGICAL(gv)) + return; for (mg = SvMAGIC(gv); mg; mg = mg->mg_moremagic) { if (mg->mg_type != PERL_MAGIC_backref) return; - } + } } cv = GvCV(gv); if (!cv) { - HEK *gvnhek = GvNAME_HEK(gv); - (void)hv_deletehek(stash, gvnhek, G_DISCARD); + HEK *gvnhek = GvNAME_HEK(gv); + (void)hv_deletehek(stash, gvnhek, G_DISCARD); } else if (GvMULTI(gv) && cv && SvREFCNT(cv) == 1 && - !SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) && - CvSTASH(cv) == stash && !CvNAMED(cv) && CvGV(cv) == gv && - CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) && - !CvNODEBUG(cv) && !CvCLONE(cv) && !CvCLONED(cv) && !CvANON(cv) && - (namehek = GvNAME_HEK(gv)) && - (gvp = hv_fetchhek(stash, namehek, 0)) && - *gvp == (SV*)gv) { - SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr); - const bool imported = !!GvIMPORTED_CV(gv); - SvREFCNT(gv) = 0; - sv_clear((SV*)gv); - SvREFCNT(gv) = 1; - SvFLAGS(gv) = SVt_IV|SVf_ROK|SVprv_PCS_IMPORTED * imported; + !SvOBJECT(cv) && !SvMAGICAL(cv) && !SvREADONLY(cv) && + CvSTASH(cv) == stash && !CvNAMED(cv) && CvGV(cv) == gv && + CvCONST(cv) && !CvMETHOD(cv) && !CvLVALUE(cv) && !CvUNIQUE(cv) && + !CvNODEBUG(cv) && !CvCLONE(cv) && !CvCLONED(cv) && !CvANON(cv) && + (namehek = GvNAME_HEK(gv)) && + (gvp = hv_fetchhek(stash, namehek, 0)) && + *gvp == (SV*)gv) { + SV *value = SvREFCNT_inc(CvXSUBANY(cv).any_ptr); + const bool imported = !!GvIMPORTED_CV(gv); + SvREFCNT(gv) = 0; + sv_clear((SV*)gv); + SvREFCNT(gv) = 1; + SvFLAGS(gv) = SVt_IV|SVf_ROK|SVprv_PCS_IMPORTED * imported; /* See also: 'SET_SVANY_FOR_BODYLESS_IV' in sv.c */ - SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) - - STRUCT_OFFSET(XPVIV, xiv_iv)); - SvRV_set(gv, value); + SvANY(gv) = (XPVGV*)((char*)&(gv->sv_u.svu_iv) - + STRUCT_OFFSET(XPVIV, xiv_iv)); + SvRV_set(gv, value); } } @@ -3834,9 +3834,9 @@ Perl_gv_override(pTHX_ const char * const name, const STRLEN len) gvp = (GV**)hv_fetch(PL_globalstash, name, len, FALSE); gv = gvp ? *gvp : NULL; if (gv && !isGV(gv)) { - if (!SvPCS_IMPORTED(gv)) return NULL; - gv_init(gv, PL_globalstash, name, len, 0); - return gv; + if (!SvPCS_IMPORTED(gv)) return NULL; + gv_init(gv, PL_globalstash, name, len, 0); + return gv; } return gv && GvCVu(gv) && GvIMPORTED_CV(gv) ? gv : NULL; } diff --git a/gv.h b/gv.h index 2589b53ac760..514bac18713e 100644 --- a/gv.h +++ b/gv.h @@ -28,32 +28,32 @@ struct gp { #if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) && !defined(__INTEL_COMPILER) # define GvGP(gv) \ - (0+(*({GV *const _gvgp = (GV *) (gv); \ - assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ - assert(isGV_with_GP(_gvgp)); \ - &((_gvgp)->sv_u.svu_gp);}))) + (0+(*({GV *const _gvgp = (GV *) (gv); \ + assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ + assert(isGV_with_GP(_gvgp)); \ + &((_gvgp)->sv_u.svu_gp);}))) # define GvGP_set(gv,gp) \ - {GV *const _gvgp = (GV *) (gv); \ - assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ - assert(isGV_with_GP(_gvgp)); \ - (_gvgp)->sv_u.svu_gp = (gp); } + {GV *const _gvgp = (GV *) (gv); \ + assert(SvTYPE(_gvgp) == SVt_PVGV || SvTYPE(_gvgp) == SVt_PVLV); \ + assert(isGV_with_GP(_gvgp)); \ + (_gvgp)->sv_u.svu_gp = (gp); } # define GvFLAGS(gv) \ - (*({GV *const _gvflags = (GV *) (gv); \ - assert(SvTYPE(_gvflags) == SVt_PVGV || SvTYPE(_gvflags) == SVt_PVLV); \ - assert(isGV_with_GP(_gvflags)); \ - &(GvXPVGV(_gvflags)->xpv_cur);})) + (*({GV *const _gvflags = (GV *) (gv); \ + assert(SvTYPE(_gvflags) == SVt_PVGV || SvTYPE(_gvflags) == SVt_PVLV); \ + assert(isGV_with_GP(_gvflags)); \ + &(GvXPVGV(_gvflags)->xpv_cur);})) # define GvSTASH(gv) \ - (*({ GV * const _gvstash = (GV *) (gv); \ - assert(isGV_with_GP(_gvstash)); \ - assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \ - &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \ - })) + (*({ GV * const _gvstash = (GV *) (gv); \ + assert(isGV_with_GP(_gvstash)); \ + assert(SvTYPE(_gvstash) == SVt_PVGV || SvTYPE(_gvstash) >= SVt_PVLV); \ + &(GvXPVGV(_gvstash)->xnv_u.xgv_stash); \ + })) # define GvNAME_HEK(gv) \ (*({ GV * const _gvname_hek = (GV *) (gv); \ - assert(isGV_with_GP(_gvname_hek)); \ - assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ - &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ - })) + assert(isGV_with_GP(_gvname_hek)); \ + assert(SvTYPE(_gvname_hek) == SVt_PVGV || SvTYPE(_gvname_hek) >= SVt_PVLV); \ + &(GvXPVGV(_gvname_hek)->xiv_u.xivu_namehek); \ + })) # define GvNAME_get(gv) ({ assert(GvNAME_HEK(gv)); (char *)HEK_KEY(GvNAME_HEK(gv)); }) # define GvNAMELEN_get(gv) ({ assert(GvNAME_HEK(gv)); HEK_LEN(GvNAME_HEK(gv)); }) # define GvNAMEUTF8(gv) ({ assert(GvNAME_HEK(gv)); HEK_UTF8(GvNAME_HEK(gv)); }) @@ -101,8 +101,8 @@ Return the CV from the GV. #define GvSV(gv) (GvGP(gv)->gp_sv) #ifdef PERL_DONT_CREATE_GVSV #define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \ - &(GvGP(gv)->gp_sv) : \ - &(GvGP(gv_SVadd(gv))->gp_sv))) + &(GvGP(gv)->gp_sv) : \ + &(GvGP(gv_SVadd(gv))->gp_sv))) #else #define GvSVn(gv) GvSV(gv) #endif @@ -126,13 +126,13 @@ Return the CV from the GV. #define GvAV(gv) (GvGP(gv)->gp_av) #define GvAVn(gv) (GvGP(gv)->gp_av ? \ - GvGP(gv)->gp_av : \ - GvGP(gv_AVadd(gv))->gp_av) + GvGP(gv)->gp_av : \ + GvGP(gv_AVadd(gv))->gp_av) #define GvHV(gv) ((GvGP(gv))->gp_hv) #define GvHVn(gv) (GvGP(gv)->gp_hv ? \ - GvGP(gv)->gp_hv : \ - GvGP(gv_HVadd(gv))->gp_hv) + GvGP(gv)->gp_hv : \ + GvGP(gv_HVadd(gv))->gp_hv) #define GvCV(gv) (0+GvGP(gv)->gp_cv) #define GvCV_set(gv,cv) (GvGP(gv)->gp_cv = (cv)) @@ -221,27 +221,27 @@ Return the CV from the GV. * symbol creation flags, for use in gv_fetchpv() and get_*v() */ #define GV_ADD 0x01 /* add, if symbol not already there - For gv_name_set, adding a HEK for the first - time, so don't try to free what's there. */ + For gv_name_set, adding a HEK for the first + time, so don't try to free what's there. */ #define GV_ADDMULTI 0x02 /* add, pretending it has been added - already; used also by gv_init_* */ + already; used also by gv_init_* */ #define GV_ADDWARN 0x04 /* add, but warn if symbol wasn't already there */ - /* 0x08 UNUSED */ + /* 0x08 UNUSED */ #define GV_NOINIT 0x10 /* add, but don't init symbol, if type != PVGV */ /* This is used by toke.c to avoid turing placeholder constants in the symbol table into full PVGVs with attached constant subroutines. */ #define GV_NOADD_NOINIT 0x20 /* Don't add the symbol if it's not there. - Don't init it if it is there but ! PVGV */ + Don't init it if it is there but ! PVGV */ #define GV_NOEXPAND 0x40 /* Don't expand SvOK() entries to PVGV */ #define GV_NOTQUAL 0x80 /* A plain symbol name, not qualified with a - package (so skip checks for :: and ') */ + package (so skip checks for :: and ') */ #define GV_AUTOLOAD 0x100 /* gv_fetchmethod_flags() should AUTOLOAD */ #define GV_CROAK 0x200 /* gv_fetchmethod_flags() should croak */ #define GV_ADDMG 0x400 /* add if magical */ #define GV_NO_SVGMAGIC 0x800 /* Skip get-magic on an SV argument; - used only by gv_fetchsv(_nomg) */ + used only by gv_fetchsv(_nomg) */ #define GV_CACHE_ONLY 0x1000 /* return stash only if found in cache; - used only in flags parameter to gv_stash* family */ + used only in flags parameter to gv_stash* family */ /* Flags for gv_fetchmeth_pvn and gv_autoload_pvn*/ #define GV_SUPER 0x1000 /* SUPER::method */ @@ -250,8 +250,8 @@ Return the CV from the GV. #define GV_AUTOLOAD_ISMETHOD 1 /* autoloading a method? */ /* SVf_UTF8 (more accurately the return value from SvUTF8) is also valid - as a flag to various gv_* functions, so ensure it lies - outside this range. + as a flag to various gv_* functions, so ensure it lies + outside this range. */ #define GV_NOADD_MASK \ @@ -265,7 +265,7 @@ Return the CV from the GV. #define gv_fetchmethod(stash, name) gv_fetchmethod_autoload(stash, name, TRUE) #define gv_fetchsv_nomg(n,f,t) gv_fetchsv(n,(f)|GV_NO_SVGMAGIC,t) #define gv_init(gv,stash,name,len,multi) \ - gv_init_pvn(gv,stash,name,len,GV_ADDMULTI*!!(multi)) + gv_init_pvn(gv,stash,name,len,GV_ADDMULTI*!!(multi)) #define gv_fetchmeth(stash,name,len,level) gv_fetchmeth_pvn(stash, name, len, level, 0) #define gv_fetchmeth_autoload(stash,name,len,level) gv_fetchmeth_pvn_autoload(stash, name, len, level, 0) #define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags) @@ -277,14 +277,14 @@ Equivalent to C>. =cut */ #define gv_autoload4(stash, name, len, autoload) \ - gv_autoload_pvn(stash, name, len, !!(autoload)) + gv_autoload_pvn(stash, name, len, !!(autoload)) #define newGVgen(pack) newGVgen_flags(pack, 0) #define gv_method_changed(gv) \ ( \ - assert_(isGV_with_GP(gv)) \ - GvREFCNT(gv) > 1 \ - ? (void)++PL_sub_generation \ - : mro_method_changed_in(GvSTASH(gv)) \ + assert_(isGV_with_GP(gv)) \ + GvREFCNT(gv) > 1 \ + ? (void)++PL_sub_generation \ + : mro_method_changed_in(GvSTASH(gv)) \ ) #define gv_AVadd(gv) gv_add_by_type((gv), SVt_PVAV) diff --git a/handy.h b/handy.h index 27c6edb1e2ec..674bdf72dcaa 100644 --- a/handy.h +++ b/handy.h @@ -183,13 +183,13 @@ C<(bool)!!(cbool)> in a ternary triggers a bug in xlc on AIX For dealing with issues that may arise from various 32/64-bit systems, we will ask Configure to check out - SHORTSIZE == sizeof(short) - INTSIZE == sizeof(int) - LONGSIZE == sizeof(long) - LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG) - PTRSIZE == sizeof(void *) - DOUBLESIZE == sizeof(double) - LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). + SHORTSIZE == sizeof(short) + INTSIZE == sizeof(int) + LONGSIZE == sizeof(long) + LONGLONGSIZE == sizeof(long long) (if HAS_LONG_LONG) + PTRSIZE == sizeof(void *) + DOUBLESIZE == sizeof(double) + LONG_DOUBLESIZE == sizeof(long double) (if HAS_LONG_DOUBLE). */ @@ -494,7 +494,7 @@ Perl_xxx(aTHX_ ...) form for any API calls where it's used. #define lex_stuff_pvs(pv,flags) Perl_lex_stuff_pvn(aTHX_ STR_WITH_LEN(pv), flags) #define get_cvs(str, flags) \ - Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags)) + Perl_get_cvn_flags(aTHX_ STR_WITH_LEN(str), (flags)) /* internal helpers */ /* Transitional */ @@ -2442,16 +2442,16 @@ typedef U32 line_t; /* Helpful alias for version prescan */ #define is_LAX_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) + (a != Perl_prescan_version(aTHX_ a, FALSE, b, NULL, NULL, NULL, NULL)) #define is_STRICT_VERSION(a,b) \ - (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) + (a != Perl_prescan_version(aTHX_ a, TRUE, b, NULL, NULL, NULL, NULL)) #define BADVERSION(a,b,c) \ - if (b) { \ - *b = c; \ - } \ - return a; + if (b) { \ + *b = c; \ + } \ + return a; /* Converts a character KNOWN to represent a hexadecimal digit (0-9, A-F, or * a-f) to its numeric value without using any branches. The input is @@ -2639,17 +2639,17 @@ PoisonWith(0xEF) for catching access to freed memory. MEM_SIZE_MAX/sizeof(t)) > MEM_SIZE_MAX/sizeof(t)) # define MEM_WRAP_CHECK(n,t) \ - (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ + (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ && (croak_memory_wrap(),0)) # define MEM_WRAP_CHECK_1(n,t,a) \ - (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ - && (Perl_croak_nocontext("%s",(a)),0)) + (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ + && (Perl_croak_nocontext("%s",(a)),0)) /* "a" arg must be a string literal */ # define MEM_WRAP_CHECK_s(n,t,a) \ - (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ - && (Perl_croak_nocontext("" a ""),0)) + (void)(UNLIKELY(_MEM_WRAP_WILL_WRAP(n,t)) \ + && (Perl_croak_nocontext("" a ""),0)) #define MEM_WRAP_CHECK_(n,t) MEM_WRAP_CHECK(n,t), @@ -2744,9 +2744,9 @@ void Perl_mem_log_del_sv(const SV *sv, const char *filename, const int linenumbe #endif #define Renew(v,n,t) \ - (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) + (v = (MEM_WRAP_CHECK_(n,t) (t*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) #define Renewc(v,n,t,c) \ - (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) + (v = (MEM_WRAP_CHECK_(n,t) (c*)MEM_LOG_REALLOC(n,t,v,saferealloc((Malloc_t)(v),(MEM_SIZE)((n)*sizeof(t)))))) #ifdef PERL_POISON #define Safefree(d) \ diff --git a/hints/t001.c b/hints/t001.c index 562d7597ffee..5edb855384ad 100644 --- a/hints/t001.c +++ b/hints/t001.c @@ -21,70 +21,70 @@ void test(double *result) { - float afloat; - double adouble; - int checksum = 0; - unsigned cuv = 0; - double cdouble = 0.0; - const int bits_in_uv = 8 * sizeof(cuv); + float afloat; + double adouble; + int checksum = 0; + unsigned cuv = 0; + double cdouble = 0.0; + const int bits_in_uv = 8 * sizeof(cuv); - checksum = 53; - cdouble = -1.0; + checksum = 53; + cdouble = -1.0; - if (checksum) { - if (checksum > bits_in_uv) { - double trouble; + if (checksum) { + if (checksum > bits_in_uv) { + double trouble; - adouble = (double) (1 << (checksum & 15)); + adouble = (double) (1 << (checksum & 15)); - while (checksum >= 16) { - checksum -= 16; - adouble *= 65536.0; - } + while (checksum >= 16) { + checksum -= 16; + adouble *= 65536.0; + } - /* At -O1, GCC 2.95.2 compiles the following loop - into: + /* At -O1, GCC 2.95.2 compiles the following loop + into: - L$0014 - fcmp,dbl,>= %fr4,%fr0 - ftest - b L$0014 - fadd,dbl %fr4,%fr12,%fr4 - fsub,dbl %fr4,%fr12,%fr4 + L$0014 + fcmp,dbl,>= %fr4,%fr0 + ftest + b L$0014 + fadd,dbl %fr4,%fr12,%fr4 + fsub,dbl %fr4,%fr12,%fr4 - This code depends on the floating-add and - floating-subtract retaining all of the - precision present in the operands. There is - no such guarantee when using floating-point, - as this test case demonstrates. + This code depends on the floating-add and + floating-subtract retaining all of the + precision present in the operands. There is + no such guarantee when using floating-point, + as this test case demonstrates. - The code is okay at -O0. */ + The code is okay at -O0. */ - while (cdouble < 0.0) - cdouble += adouble; + while (cdouble < 0.0) + cdouble += adouble; - cdouble = modf (cdouble / adouble, &trouble) * adouble; - } - } + cdouble = modf (cdouble / adouble, &trouble) * adouble; + } + } - *result = cdouble; + *result = cdouble; } int main (int argc, char ** argv) { double value; - test (&value); + test (&value); - if (argc == 2 && !strcmp(argv[1],"-v")) - printf ("value = %.18e\n", value); + if (argc == 2 && !strcmp(argv[1],"-v")) + printf ("value = %.18e\n", value); - if (value != 9.007199254740991e+15) { - printf ("t001 fails!\n"); - return -1; - } - else { - printf ("t001 works.\n"); - return 0; - } + if (value != 9.007199254740991e+15) { + printf ("t001 fails!\n"); + return -1; + } + else { + printf ("t001 works.\n"); + return 0; + } } diff --git a/hv.c b/hv.c index 8f7dbdcc3b2d..82657cb4e9cc 100644 --- a/hv.c +++ b/hv.c @@ -57,7 +57,7 @@ S_new_he(pTHX) void ** const root = &PL_body_roots[HE_SVSLOT]; if (!*root) - Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE); + Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE); he = (HE*) *root; assert(he); *root = HeNEXT(he); @@ -67,8 +67,8 @@ S_new_he(pTHX) #define new_HE() new_he() #define del_HE(p) \ STMT_START { \ - HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \ - PL_body_roots[HE_SVSLOT] = p; \ + HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \ + PL_body_roots[HE_SVSLOT] = p; \ } STMT_END @@ -93,7 +93,7 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) HEK_FLAGS(hek) = (unsigned char)flags_masked | HVhek_UNSHARED; if (flags & HVhek_FREEKEY) - Safefree(str); + Safefree(str); return hek; } @@ -105,10 +105,10 @@ Perl_free_tied_hv_pool(pTHX) { HE *he = PL_hv_fetch_ent_mh; while (he) { - HE * const ohe = he; - Safefree(HeKEY_hek(he)); - he = HeNEXT(he); - del_HE(ohe); + HE * const ohe = he; + Safefree(HeKEY_hek(he)); + he = HeNEXT(he); + del_HE(ohe); } PL_hv_fetch_ent_mh = NULL; } @@ -123,18 +123,18 @@ Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) PERL_UNUSED_ARG(param); if (!source) - return NULL; + return NULL; shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); if (shared) { - /* We already shared this hash key. */ - (void)share_hek_hek(shared); + /* We already shared this hash key. */ + (void)share_hek_hek(shared); } else { - shared - = share_hek_flags(HEK_KEY(source), HEK_LEN(source), - HEK_HASH(source), HEK_FLAGS(source)); - ptr_table_store(PL_ptr_table, source, shared); + shared + = share_hek_flags(HEK_KEY(source), HEK_LEN(source), + HEK_HASH(source), HEK_FLAGS(source)); + ptr_table_store(PL_ptr_table, source, shared); } return shared; } @@ -147,11 +147,11 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) PERL_ARGS_ASSERT_HE_DUP; if (!e) - return NULL; + return NULL; /* look for it in the table first */ ret = (HE*)ptr_table_fetch(PL_ptr_table, e); if (ret) - return ret; + return ret; /* create anew and remember what it is */ ret = new_HE(); @@ -159,31 +159,31 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) HeNEXT(ret) = he_dup(HeNEXT(e),shared, param); if (HeKLEN(e) == HEf_SVKEY) { - char *k; - Newx(k, HEK_BASESIZE + sizeof(const SV *), char); - HeKEY_hek(ret) = (HEK*)k; - HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param); + char *k; + Newx(k, HEK_BASESIZE + sizeof(const SV *), char); + HeKEY_hek(ret) = (HEK*)k; + HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param); } else if (shared) { - /* This is hek_dup inlined, which seems to be important for speed - reasons. */ - HEK * const source = HeKEY_hek(e); - HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); - - if (shared) { - /* We already shared this hash key. */ - (void)share_hek_hek(shared); - } - else { - shared - = share_hek_flags(HEK_KEY(source), HEK_LEN(source), - HEK_HASH(source), HEK_FLAGS(source)); - ptr_table_store(PL_ptr_table, source, shared); - } - HeKEY_hek(ret) = shared; + /* This is hek_dup inlined, which seems to be important for speed + reasons. */ + HEK * const source = HeKEY_hek(e); + HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); + + if (shared) { + /* We already shared this hash key. */ + (void)share_hek_hek(shared); + } + else { + shared + = share_hek_flags(HEK_KEY(source), HEK_LEN(source), + HEK_HASH(source), HEK_FLAGS(source)); + ptr_table_store(PL_ptr_table, source, shared); + } + HeKEY_hek(ret) = shared; } else - HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), + HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), HeKFLAGS(e)); HeVAL(ret) = sv_dup_inc(HeVAL(e), param); return ret; @@ -192,22 +192,22 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) static void S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, - const char *msg) + const char *msg) { SV * const sv = sv_newmortal(); PERL_ARGS_ASSERT_HV_NOTALLOWED; if (!(flags & HVhek_FREEKEY)) { - sv_setpvn(sv, key, klen); + sv_setpvn(sv, key, klen); } else { - /* Need to free saved eventually assign to mortal SV */ - /* XXX is this line an error ???: SV *sv = sv_newmortal(); */ - sv_usepvn(sv, (char *) key, klen); + /* Need to free saved eventually assign to mortal SV */ + /* XXX is this line an error ???: SV *sv = sv_newmortal(); */ + sv_usepvn(sv, (char *) key, klen); } if (flags & HVhek_UTF8) { - SvUTF8_on(sv); + SvUTF8_on(sv); } Perl_croak(aTHX_ msg, SVfARG(sv)); } @@ -321,7 +321,7 @@ information on how to use this function on tied hashes. /* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store() */ void * Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, - const int action, SV *val, const U32 hash) + const int action, SV *val, const U32 hash) { STRLEN klen; int flags; @@ -329,18 +329,18 @@ Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN; if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; + klen = -klen_i32; + flags = HVhek_UTF8; } else { - klen = klen_i32; - flags = 0; + klen = klen_i32; + flags = 0; } return hv_common(hv, NULL, key, klen, flags, action, val, hash); } void * Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, - int flags, int action, SV *val, U32 hash) + int flags, int action, SV *val, U32 hash) { XPVHV* xhv; HE *entry; @@ -353,276 +353,276 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HEK *keysv_hek = NULL; if (!hv) - return NULL; + return NULL; if (SvTYPE(hv) == (svtype)SVTYPEMASK) - return NULL; + return NULL; assert(SvTYPE(hv) == SVt_PVHV); if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) { - MAGIC* mg; - if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) { - struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; - if (uf->uf_set == NULL) { - SV* obj = mg->mg_obj; - - if (!keysv) { - keysv = newSVpvn_flags(key, klen, SVs_TEMP | - ((flags & HVhek_UTF8) - ? SVf_UTF8 : 0)); - } - - mg->mg_obj = keysv; /* pass key */ - uf->uf_index = action; /* pass action */ - magic_getuvar(MUTABLE_SV(hv), mg); - keysv = mg->mg_obj; /* may have changed */ - mg->mg_obj = obj; - - /* If the key may have changed, then we need to invalidate - any passed-in computed hash value. */ - hash = 0; - } - } + MAGIC* mg; + if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) { + struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; + if (uf->uf_set == NULL) { + SV* obj = mg->mg_obj; + + if (!keysv) { + keysv = newSVpvn_flags(key, klen, SVs_TEMP | + ((flags & HVhek_UTF8) + ? SVf_UTF8 : 0)); + } + + mg->mg_obj = keysv; /* pass key */ + uf->uf_index = action; /* pass action */ + magic_getuvar(MUTABLE_SV(hv), mg); + keysv = mg->mg_obj; /* may have changed */ + mg->mg_obj = obj; + + /* If the key may have changed, then we need to invalidate + any passed-in computed hash value. */ + hash = 0; + } + } } if (keysv) { - if (flags & HVhek_FREEKEY) - Safefree(key); - key = SvPV_const(keysv, klen); - is_utf8 = (SvUTF8(keysv) != 0); - if (SvIsCOW_shared_hash(keysv)) { - flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); - } else { - flags = 0; - } + if (flags & HVhek_FREEKEY) + Safefree(key); + key = SvPV_const(keysv, klen); + is_utf8 = (SvUTF8(keysv) != 0); + if (SvIsCOW_shared_hash(keysv)) { + flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); + } else { + flags = 0; + } } else { - is_utf8 = cBOOL(flags & HVhek_UTF8); + is_utf8 = cBOOL(flags & HVhek_UTF8); } if (action & HV_DELETE) { - return (void *) hv_delete_common(hv, keysv, key, klen, - flags | (is_utf8 ? HVhek_UTF8 : 0), - action, hash); + return (void *) hv_delete_common(hv, keysv, key, klen, + flags | (is_utf8 ? HVhek_UTF8 : 0), + action, hash); } xhv = (XPVHV*)SvANY(hv); if (SvMAGICAL(hv)) { - if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { - if (mg_find((const SV *)hv, PERL_MAGIC_tied) - || SvGMAGICAL((const SV *)hv)) - { - /* FIXME should be able to skimp on the HE/HEK here when - HV_FETCH_JUST_SV is true. */ - if (!keysv) { - keysv = newSVpvn_utf8(key, klen, is_utf8); - } else { - keysv = newSVsv(keysv); - } + if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { + if (mg_find((const SV *)hv, PERL_MAGIC_tied) + || SvGMAGICAL((const SV *)hv)) + { + /* FIXME should be able to skimp on the HE/HEK here when + HV_FETCH_JUST_SV is true. */ + if (!keysv) { + keysv = newSVpvn_utf8(key, klen, is_utf8); + } else { + keysv = newSVsv(keysv); + } sv = sv_newmortal(); mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY); - /* grab a fake HE/HEK pair from the pool or make a new one */ - entry = PL_hv_fetch_ent_mh; - if (entry) - PL_hv_fetch_ent_mh = HeNEXT(entry); - else { - char *k; - entry = new_HE(); - Newx(k, HEK_BASESIZE + sizeof(const SV *), char); - HeKEY_hek(entry) = (HEK*)k; - } - HeNEXT(entry) = NULL; - HeSVKEY_set(entry, keysv); - HeVAL(entry) = sv; - sv_upgrade(sv, SVt_PVLV); - LvTYPE(sv) = 'T'; - /* so we can free entry when freeing sv */ - LvTARG(sv) = MUTABLE_SV(entry); - - /* XXX remove at some point? */ - if (flags & HVhek_FREEKEY) - Safefree(key); - - if (return_svp) { - return entry ? (void *) &HeVAL(entry) : NULL; - } - return (void *) entry; - } + /* grab a fake HE/HEK pair from the pool or make a new one */ + entry = PL_hv_fetch_ent_mh; + if (entry) + PL_hv_fetch_ent_mh = HeNEXT(entry); + else { + char *k; + entry = new_HE(); + Newx(k, HEK_BASESIZE + sizeof(const SV *), char); + HeKEY_hek(entry) = (HEK*)k; + } + HeNEXT(entry) = NULL; + HeSVKEY_set(entry, keysv); + HeVAL(entry) = sv; + sv_upgrade(sv, SVt_PVLV); + LvTYPE(sv) = 'T'; + /* so we can free entry when freeing sv */ + LvTARG(sv) = MUTABLE_SV(entry); + + /* XXX remove at some point? */ + if (flags & HVhek_FREEKEY) + Safefree(key); + + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } + return (void *) entry; + } #ifdef ENV_IS_CASELESS - else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { - U32 i; - for (i = 0; i < klen; ++i) - if (isLOWER(key[i])) { - /* Would be nice if we had a routine to do the - copy and upercase in a single pass through. */ - const char * const nkey = strupr(savepvn(key,klen)); - /* Note that this fetch is for nkey (the uppercased - key) whereas the store is for key (the original) */ - void *result = hv_common(hv, NULL, nkey, klen, - HVhek_FREEKEY, /* free nkey */ - 0 /* non-LVAL fetch */ - | HV_DISABLE_UVAR_XKEY - | return_svp, - NULL /* no value */, - 0 /* compute hash */); - if (!result && (action & HV_FETCH_LVALUE)) { - /* This call will free key if necessary. - Do it this way to encourage compiler to tail - call optimise. */ - result = hv_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE - | HV_DISABLE_UVAR_XKEY - | return_svp, - newSV(0), hash); - } else { - if (flags & HVhek_FREEKEY) - Safefree(key); - } - return result; - } - } + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { + U32 i; + for (i = 0; i < klen; ++i) + if (isLOWER(key[i])) { + /* Would be nice if we had a routine to do the + copy and upercase in a single pass through. */ + const char * const nkey = strupr(savepvn(key,klen)); + /* Note that this fetch is for nkey (the uppercased + key) whereas the store is for key (the original) */ + void *result = hv_common(hv, NULL, nkey, klen, + HVhek_FREEKEY, /* free nkey */ + 0 /* non-LVAL fetch */ + | HV_DISABLE_UVAR_XKEY + | return_svp, + NULL /* no value */, + 0 /* compute hash */); + if (!result && (action & HV_FETCH_LVALUE)) { + /* This call will free key if necessary. + Do it this way to encourage compiler to tail + call optimise. */ + result = hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE + | HV_DISABLE_UVAR_XKEY + | return_svp, + newSV(0), hash); + } else { + if (flags & HVhek_FREEKEY) + Safefree(key); + } + return result; + } + } #endif - } /* ISFETCH */ - else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { - if (mg_find((const SV *)hv, PERL_MAGIC_tied) - || SvGMAGICAL((const SV *)hv)) { - /* I don't understand why hv_exists_ent has svret and sv, - whereas hv_exists only had one. */ - SV * const svret = sv_newmortal(); - sv = sv_newmortal(); - - if (keysv || is_utf8) { - if (!keysv) { - keysv = newSVpvn_utf8(key, klen, TRUE); - } else { - keysv = newSVsv(keysv); - } - mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY); - } else { - mg_copy(MUTABLE_SV(hv), sv, key, klen); - } - if (flags & HVhek_FREEKEY) - Safefree(key); - { + } /* ISFETCH */ + else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { + if (mg_find((const SV *)hv, PERL_MAGIC_tied) + || SvGMAGICAL((const SV *)hv)) { + /* I don't understand why hv_exists_ent has svret and sv, + whereas hv_exists only had one. */ + SV * const svret = sv_newmortal(); + sv = sv_newmortal(); + + if (keysv || is_utf8) { + if (!keysv) { + keysv = newSVpvn_utf8(key, klen, TRUE); + } else { + keysv = newSVsv(keysv); + } + mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY); + } else { + mg_copy(MUTABLE_SV(hv), sv, key, klen); + } + if (flags & HVhek_FREEKEY) + Safefree(key); + { MAGIC * const mg = mg_find(sv, PERL_MAGIC_tiedelem); if (mg) magic_existspack(svret, mg); - } - /* This cast somewhat evil, but I'm merely using NULL/ - not NULL to return the boolean exists. - And I know hv is not NULL. */ - return SvTRUE_NN(svret) ? (void *)hv : NULL; - } + } + /* This cast somewhat evil, but I'm merely using NULL/ + not NULL to return the boolean exists. + And I know hv is not NULL. */ + return SvTRUE_NN(svret) ? (void *)hv : NULL; + } #ifdef ENV_IS_CASELESS - else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { - /* XXX This code isn't UTF8 clean. */ - char * const keysave = (char * const)key; - /* Will need to free this, so set FREEKEY flag. */ - key = savepvn(key,klen); - key = (const char*)strupr((char*)key); - is_utf8 = FALSE; - hash = 0; - keysv = 0; - - if (flags & HVhek_FREEKEY) { - Safefree(keysave); - } - flags |= HVhek_FREEKEY; - } + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + char * const keysave = (char * const)key; + /* Will need to free this, so set FREEKEY flag. */ + key = savepvn(key,klen); + key = (const char*)strupr((char*)key); + is_utf8 = FALSE; + hash = 0; + keysv = 0; + + if (flags & HVhek_FREEKEY) { + Safefree(keysave); + } + flags |= HVhek_FREEKEY; + } #endif - } /* ISEXISTS */ - else if (action & HV_FETCH_ISSTORE) { - bool needs_copy; - bool needs_store; - hv_magic_check (hv, &needs_copy, &needs_store); - if (needs_copy) { - const bool save_taint = TAINT_get; - if (keysv || is_utf8) { - if (!keysv) { - keysv = newSVpvn_utf8(key, klen, TRUE); - } - if (TAINTING_get) - TAINT_set(SvTAINTED(keysv)); - keysv = sv_2mortal(newSVsv(keysv)); - mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY); - } else { - mg_copy(MUTABLE_SV(hv), val, key, klen); - } - - TAINT_IF(save_taint); + } /* ISEXISTS */ + else if (action & HV_FETCH_ISSTORE) { + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + if (needs_copy) { + const bool save_taint = TAINT_get; + if (keysv || is_utf8) { + if (!keysv) { + keysv = newSVpvn_utf8(key, klen, TRUE); + } + if (TAINTING_get) + TAINT_set(SvTAINTED(keysv)); + keysv = sv_2mortal(newSVsv(keysv)); + mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY); + } else { + mg_copy(MUTABLE_SV(hv), val, key, klen); + } + + TAINT_IF(save_taint); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(save_taint); #endif - if (!needs_store) { - if (flags & HVhek_FREEKEY) - Safefree(key); - return NULL; - } + if (!needs_store) { + if (flags & HVhek_FREEKEY) + Safefree(key); + return NULL; + } #ifdef ENV_IS_CASELESS - else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { - /* XXX This code isn't UTF8 clean. */ - const char *keysave = key; - /* Will need to free this, so set FREEKEY flag. */ - key = savepvn(key,klen); - key = (const char*)strupr((char*)key); - is_utf8 = FALSE; - hash = 0; - keysv = 0; - - if (flags & HVhek_FREEKEY) { - Safefree(keysave); - } - flags |= HVhek_FREEKEY; - } + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + const char *keysave = key; + /* Will need to free this, so set FREEKEY flag. */ + key = savepvn(key,klen); + key = (const char*)strupr((char*)key); + is_utf8 = FALSE; + hash = 0; + keysv = 0; + + if (flags & HVhek_FREEKEY) { + Safefree(keysave); + } + flags |= HVhek_FREEKEY; + } #endif - } - } /* ISSTORE */ + } + } /* ISSTORE */ } /* SvMAGICAL */ if (!HvARRAY(hv)) { - if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE)) + if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE)) #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ - || (SvRMAGICAL((const SV *)hv) - && mg_find((const SV *)hv, PERL_MAGIC_env)) + || (SvRMAGICAL((const SV *)hv) + && mg_find((const SV *)hv, PERL_MAGIC_env)) #endif - ) { - char *array; - Newxz(array, - PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), - char); - HvARRAY(hv) = (HE**)array; - } + ) { + char *array; + Newxz(array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), + char); + HvARRAY(hv) = (HE**)array; + } #ifdef DYNAMIC_ENV_FETCH - else if (action & HV_FETCH_ISEXISTS) { - /* for an %ENV exists, if we do an insert it's by a recursive - store call, so avoid creating HvARRAY(hv) right now. */ - } + else if (action & HV_FETCH_ISEXISTS) { + /* for an %ENV exists, if we do an insert it's by a recursive + store call, so avoid creating HvARRAY(hv) right now. */ + } #endif - else { - /* XXX remove at some point? */ + else { + /* XXX remove at some point? */ if (flags & HVhek_FREEKEY) Safefree(key); - return NULL; - } + return NULL; + } } if (is_utf8 && !(flags & HVhek_KEYCANONICAL)) { - char * const keysave = (char *)key; - key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); + char * const keysave = (char *)key; + key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) - flags |= HVhek_UTF8; - else - flags &= ~HVhek_UTF8; + flags |= HVhek_UTF8; + else + flags &= ~HVhek_UTF8; if (key != keysave) { - if (flags & HVhek_FREEKEY) - Safefree(keysave); + if (flags & HVhek_FREEKEY) + Safefree(keysave); flags |= HVhek_WASUTF8 | HVhek_FREEKEY; - /* If the caller calculated a hash, it was on the sequence of - octets that are the UTF-8 form. We've now changed the sequence - of octets stored to that of the equivalent byte representation, - so the hash we need is different. */ - hash = 0; - } + /* If the caller calculated a hash, it was on the sequence of + octets that are the UTF-8 form. We've now changed the sequence + of octets stored to that of the equivalent byte representation, + so the hash we need is different. */ + hash = 0; + } } if (keysv && (SvIsCOW_shared_hash(keysv))) { @@ -640,7 +640,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, else #endif { - entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; + entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; } if (!entry) @@ -674,146 +674,146 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } for (; entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) - continue; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (I32)klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) + continue; found: if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) { - if (HeKFLAGS(entry) != masked_flags) { - /* We match if HVhek_UTF8 bit in our flags and hash key's - match. But if entry was set previously with HVhek_WASUTF8 - and key now doesn't (or vice versa) then we should change - the key's flag, as this is assignment. */ - if (HvSHAREKEYS(hv)) { - /* Need to swap the key we have for a key with the flags we - need. As keys are shared we can't just write to the - flag, so we share the new one, unshare the old one. */ - HEK * const new_hek = share_hek_flags(key, klen, hash, - masked_flags); - unshare_hek (HeKEY_hek(entry)); - HeKEY_hek(entry) = new_hek; - } - else if (hv == PL_strtab) { - /* PL_strtab is usually the only hash without HvSHAREKEYS, - so putting this test here is cheap */ - if (flags & HVhek_FREEKEY) - Safefree(key); - Perl_croak(aTHX_ S_strtab_error, - action & HV_FETCH_LVALUE ? "fetch" : "store"); - } - else - HeKFLAGS(entry) = masked_flags; - if (masked_flags & HVhek_ENABLEHVKFLAGS) - HvHASKFLAGS_on(hv); - } - if (HeVAL(entry) == &PL_sv_placeholder) { - /* yes, can store into placeholder slot */ - if (action & HV_FETCH_LVALUE) { - if (SvMAGICAL(hv)) { - /* This preserves behaviour with the old hv_fetch - implementation which at this point would bail out - with a break; (at "if we find a placeholder, we - pretend we haven't found anything") - - That break mean that if a placeholder were found, it - caused a call into hv_store, which in turn would - check magic, and if there is no magic end up pretty - much back at this point (in hv_store's code). */ - break; - } - /* LVAL fetch which actually needs a store. */ - val = newSV(0); - HvPLACEHOLDERS(hv)--; - } else { - /* store */ - if (val != &PL_sv_placeholder) - HvPLACEHOLDERS(hv)--; - } - HeVAL(entry) = val; - } else if (action & HV_FETCH_ISSTORE) { - SvREFCNT_dec(HeVAL(entry)); - HeVAL(entry) = val; - } - } else if (HeVAL(entry) == &PL_sv_placeholder) { - /* if we find a placeholder, we pretend we haven't found - anything */ - break; - } - if (flags & HVhek_FREEKEY) - Safefree(key); - if (return_svp) { + if (HeKFLAGS(entry) != masked_flags) { + /* We match if HVhek_UTF8 bit in our flags and hash key's + match. But if entry was set previously with HVhek_WASUTF8 + and key now doesn't (or vice versa) then we should change + the key's flag, as this is assignment. */ + if (HvSHAREKEYS(hv)) { + /* Need to swap the key we have for a key with the flags we + need. As keys are shared we can't just write to the + flag, so we share the new one, unshare the old one. */ + HEK * const new_hek = share_hek_flags(key, klen, hash, + masked_flags); + unshare_hek (HeKEY_hek(entry)); + HeKEY_hek(entry) = new_hek; + } + else if (hv == PL_strtab) { + /* PL_strtab is usually the only hash without HvSHAREKEYS, + so putting this test here is cheap */ + if (flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, + action & HV_FETCH_LVALUE ? "fetch" : "store"); + } + else + HeKFLAGS(entry) = masked_flags; + if (masked_flags & HVhek_ENABLEHVKFLAGS) + HvHASKFLAGS_on(hv); + } + if (HeVAL(entry) == &PL_sv_placeholder) { + /* yes, can store into placeholder slot */ + if (action & HV_FETCH_LVALUE) { + if (SvMAGICAL(hv)) { + /* This preserves behaviour with the old hv_fetch + implementation which at this point would bail out + with a break; (at "if we find a placeholder, we + pretend we haven't found anything") + + That break mean that if a placeholder were found, it + caused a call into hv_store, which in turn would + check magic, and if there is no magic end up pretty + much back at this point (in hv_store's code). */ + break; + } + /* LVAL fetch which actually needs a store. */ + val = newSV(0); + HvPLACEHOLDERS(hv)--; + } else { + /* store */ + if (val != &PL_sv_placeholder) + HvPLACEHOLDERS(hv)--; + } + HeVAL(entry) = val; + } else if (action & HV_FETCH_ISSTORE) { + SvREFCNT_dec(HeVAL(entry)); + HeVAL(entry) = val; + } + } else if (HeVAL(entry) == &PL_sv_placeholder) { + /* if we find a placeholder, we pretend we haven't found + anything */ + break; + } + if (flags & HVhek_FREEKEY) + Safefree(key); + if (return_svp) { return (void *) &HeVAL(entry); - } - return entry; + } + return entry; } not_found: #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ if (!(action & HV_FETCH_ISSTORE) - && SvRMAGICAL((const SV *)hv) - && mg_find((const SV *)hv, PERL_MAGIC_env)) { - unsigned long len; - const char * const env = PerlEnv_ENVgetenv_len(key,&len); - if (env) { - sv = newSVpvn(env,len); - SvTAINTED_on(sv); - return hv_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, - sv, hash); - } + && SvRMAGICAL((const SV *)hv) + && mg_find((const SV *)hv, PERL_MAGIC_env)) { + unsigned long len; + const char * const env = PerlEnv_ENVgetenv_len(key,&len); + if (env) { + sv = newSVpvn(env,len); + SvTAINTED_on(sv); + return hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + sv, hash); + } } #endif if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) { - hv_notallowed(flags, key, klen, - "Attempt to access disallowed key '%" SVf "' in" - " a restricted hash"); + hv_notallowed(flags, key, klen, + "Attempt to access disallowed key '%" SVf "' in" + " a restricted hash"); } if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) { - /* Not doing some form of store, so return failure. */ - if (flags & HVhek_FREEKEY) - Safefree(key); - return NULL; + /* Not doing some form of store, so return failure. */ + if (flags & HVhek_FREEKEY) + Safefree(key); + return NULL; } if (action & HV_FETCH_LVALUE) { - val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0); - if (SvMAGICAL(hv)) { - /* At this point the old hv_fetch code would call to hv_store, - which in turn might do some tied magic. So we need to make that - magic check happen. */ - /* gonna assign to this, so it better be there */ - /* If a fetch-as-store fails on the fetch, then the action is to - recurse once into "hv_store". If we didn't do this, then that - recursive call would call the key conversion routine again. - However, as we replace the original key with the converted - key, this would result in a double conversion, which would show - up as a bug if the conversion routine is not idempotent. - Hence the use of HV_DISABLE_UVAR_XKEY. */ - return hv_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, - val, hash); - /* XXX Surely that could leak if the fetch-was-store fails? - Just like the hv_fetch. */ - } + val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0); + if (SvMAGICAL(hv)) { + /* At this point the old hv_fetch code would call to hv_store, + which in turn might do some tied magic. So we need to make that + magic check happen. */ + /* gonna assign to this, so it better be there */ + /* If a fetch-as-store fails on the fetch, then the action is to + recurse once into "hv_store". If we didn't do this, then that + recursive call would call the key conversion routine again. + However, as we replace the original key with the converted + key, this would result in a double conversion, which would show + up as a bug if the conversion routine is not idempotent. + Hence the use of HV_DISABLE_UVAR_XKEY. */ + return hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + val, hash); + /* XXX Surely that could leak if the fetch-was-store fails? + Just like the hv_fetch. */ + } } /* Welcome to hv_store... */ if (!HvARRAY(hv)) { - /* Not sure if we can get here. I think the only case of oentry being - NULL is for %ENV with dynamic env fetch. But that should disappear - with magic in the previous code. */ - char *array; - Newxz(array, - PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), - char); - HvARRAY(hv) = (HE**)array; + /* Not sure if we can get here. I think the only case of oentry being + NULL is for %ENV with dynamic env fetch. But that should disappear + with magic in the previous code. */ + char *array; + Newxz(array, + PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), + char); + HvARRAY(hv) = (HE**)array; } oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max]; @@ -822,17 +822,17 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* share_hek_flags will do the free for us. This might be considered bad API design. */ if (HvSHAREKEYS(hv)) - HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); + HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); else if (hv == PL_strtab) { - /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting - this test here is cheap */ - if (flags & HVhek_FREEKEY) - Safefree(key); - Perl_croak(aTHX_ S_strtab_error, - action & HV_FETCH_LVALUE ? "fetch" : "store"); + /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting + this test here is cheap */ + if (flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, + action & HV_FETCH_LVALUE ? "fetch" : "store"); } else /* gotta do the real thing */ - HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); + HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); HeVAL(entry) = val; #ifdef PERL_HASH_RANDOMIZE_KEYS @@ -879,9 +879,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, #endif if (val == &PL_sv_placeholder) - HvPLACEHOLDERS(hv)++; + HvPLACEHOLDERS(hv)++; if (masked_flags & HVhek_ENABLEHVKFLAGS) - HvHASKFLAGS_on(hv); + HvHASKFLAGS_on(hv); xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ if ( in_collision && DO_HSPLIT(xhv) ) { @@ -908,7 +908,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } if (return_svp) { - return entry ? (void *) &HeVAL(entry) : NULL; + return entry ? (void *) &HeVAL(entry) : NULL; } return (void *) entry; } @@ -923,14 +923,14 @@ S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store) *needs_copy = FALSE; *needs_store = TRUE; while (mg) { - if (isUPPER(mg->mg_type)) { - *needs_copy = TRUE; - if (mg->mg_type == PERL_MAGIC_tied) { - *needs_store = FALSE; - return; /* We've set all there is to set. */ - } - } - mg = mg->mg_moremagic; + if (isUPPER(mg->mg_type)) { + *needs_copy = TRUE; + if (mg->mg_type == PERL_MAGIC_tied) { + *needs_store = FALSE; + return; /* We've set all there is to set. */ + } + } + mg = mg->mg_moremagic; } } @@ -957,9 +957,9 @@ Perl_hv_scalar(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_SCALAR; if (SvRMAGICAL(hv)) { - MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied); - if (mg) - return magic_scalarpack(hv, mg); + MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied); + if (mg) + return magic_scalarpack(hv, mg); } sv = sv_newmortal(); @@ -1103,7 +1103,7 @@ value, or 0 to ask for it to be computed. STATIC SV * S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, - int k_flags, I32 d_flags, U32 hash) + int k_flags, I32 d_flags, U32 hash) { XPVHV* xhv; HE *entry; @@ -1118,65 +1118,65 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, HV *stash = NULL; if (SvRMAGICAL(hv)) { - bool needs_copy; - bool needs_store; - hv_magic_check (hv, &needs_copy, &needs_store); - - if (needs_copy) { - SV *sv; - entry = (HE *) hv_common(hv, keysv, key, klen, - k_flags & ~HVhek_FREEKEY, - HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, - NULL, hash); - sv = entry ? HeVAL(entry) : NULL; - if (sv) { - if (SvMAGICAL(sv)) { - mg_clear(sv); - } - if (!needs_store) { - if (mg_find(sv, PERL_MAGIC_tiedelem)) { - /* No longer an element */ - sv_unmagic(sv, PERL_MAGIC_tiedelem); - return sv; - } - return NULL; /* element cannot be deleted */ - } + bool needs_copy; + bool needs_store; + hv_magic_check (hv, &needs_copy, &needs_store); + + if (needs_copy) { + SV *sv; + entry = (HE *) hv_common(hv, keysv, key, klen, + k_flags & ~HVhek_FREEKEY, + HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, + NULL, hash); + sv = entry ? HeVAL(entry) : NULL; + if (sv) { + if (SvMAGICAL(sv)) { + mg_clear(sv); + } + if (!needs_store) { + if (mg_find(sv, PERL_MAGIC_tiedelem)) { + /* No longer an element */ + sv_unmagic(sv, PERL_MAGIC_tiedelem); + return sv; + } + return NULL; /* element cannot be deleted */ + } #ifdef ENV_IS_CASELESS - else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { - /* XXX This code isn't UTF8 clean. */ - keysv = newSVpvn_flags(key, klen, SVs_TEMP); - if (k_flags & HVhek_FREEKEY) { - Safefree(key); - } - key = strupr(SvPVX(keysv)); - is_utf8 = 0; - k_flags = 0; - hash = 0; - } + else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { + /* XXX This code isn't UTF8 clean. */ + keysv = newSVpvn_flags(key, klen, SVs_TEMP); + if (k_flags & HVhek_FREEKEY) { + Safefree(key); + } + key = strupr(SvPVX(keysv)); + is_utf8 = 0; + k_flags = 0; + hash = 0; + } #endif - } - } + } + } } xhv = (XPVHV*)SvANY(hv); if (!HvARRAY(hv)) - return NULL; + return NULL; if (is_utf8 && !(k_flags & HVhek_KEYCANONICAL)) { - const char * const keysave = key; - key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); + const char * const keysave = key; + key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); if (is_utf8) k_flags |= HVhek_UTF8; - else + else k_flags &= ~HVhek_UTF8; if (key != keysave) { - if (k_flags & HVhek_FREEKEY) { - /* This shouldn't happen if our caller does what we expect, - but strictly the API allows it. */ - Safefree(keysave); - } - k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; - } + if (k_flags & HVhek_FREEKEY) { + /* This shouldn't happen if our caller does what we expect, + but strictly the API allows it. */ + Safefree(keysave); + } + k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; + } HvHASKFLAGS_on(MUTABLE_SV(hv)); } @@ -1224,66 +1224,66 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } for (; entry; oentry = &HeNEXT(entry), entry = *oentry) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (I32)klen) - continue; - if (memNE(HeKEY(entry),key,klen)) /* is this it? */ - continue; - if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) - continue; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (I32)klen) + continue; + if (memNE(HeKEY(entry),key,klen)) /* is this it? */ + continue; + if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) + continue; found: - if (hv == PL_strtab) { - if (k_flags & HVhek_FREEKEY) - Safefree(key); - Perl_croak(aTHX_ S_strtab_error, "delete"); - } - - /* if placeholder is here, it's already been deleted.... */ - if (HeVAL(entry) == &PL_sv_placeholder) { - if (k_flags & HVhek_FREEKEY) - Safefree(key); - return NULL; - } - if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { - hv_notallowed(k_flags, key, klen, - "Attempt to delete readonly key '%" SVf "' from" - " a restricted hash"); - } + if (hv == PL_strtab) { + if (k_flags & HVhek_FREEKEY) + Safefree(key); + Perl_croak(aTHX_ S_strtab_error, "delete"); + } + + /* if placeholder is here, it's already been deleted.... */ + if (HeVAL(entry) == &PL_sv_placeholder) { + if (k_flags & HVhek_FREEKEY) + Safefree(key); + return NULL; + } + if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { + hv_notallowed(k_flags, key, klen, + "Attempt to delete readonly key '%" SVf "' from" + " a restricted hash"); + } if (k_flags & HVhek_FREEKEY) Safefree(key); - /* If this is a stash and the key ends with ::, then someone is - * deleting a package. - */ - if (HeVAL(entry) && HvENAME_get(hv)) { - gv = (GV *)HeVAL(entry); - if (keysv) key = SvPV(keysv, klen); - if (( - (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':') - || - (klen == 1 && key[0] == ':') - ) - && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6)) - && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv)) - && HvENAME_get(stash)) { - /* A previous version of this code checked that the - * GV was still in the symbol table by fetching the - * GV with its name. That is not necessary (and - * sometimes incorrect), as HvENAME cannot be set - * on hv if it is not in the symtab. */ - mro_changes = 2; - /* Hang on to it for a bit. */ - SvREFCNT_inc_simple_void_NN( - sv_2mortal((SV *)gv) - ); - } - else if (memEQs(key, klen, "ISA") && GvAV(gv)) { + /* If this is a stash and the key ends with ::, then someone is + * deleting a package. + */ + if (HeVAL(entry) && HvENAME_get(hv)) { + gv = (GV *)HeVAL(entry); + if (keysv) key = SvPV(keysv, klen); + if (( + (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':') + || + (klen == 1 && key[0] == ':') + ) + && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6)) + && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv)) + && HvENAME_get(stash)) { + /* A previous version of this code checked that the + * GV was still in the symbol table by fetching the + * GV with its name. That is not necessary (and + * sometimes incorrect), as HvENAME cannot be set + * on hv if it is not in the symtab. */ + mro_changes = 2; + /* Hang on to it for a bit. */ + SvREFCNT_inc_simple_void_NN( + sv_2mortal((SV *)gv) + ); + } + else if (memEQs(key, klen, "ISA") && GvAV(gv)) { AV *isa = GvAV(gv); MAGIC *mg = mg_find((SV*)isa, PERL_MAGIC_isa); - mro_changes = 1; + mro_changes = 1; if (mg) { if (mg->mg_obj == (SV*)gv) { /* This is the only stash this ISA was used for. @@ -1346,63 +1346,63 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } } - } - - sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry)); - HeVAL(entry) = &PL_sv_placeholder; - if (sv) { - /* deletion of method from stash */ - if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv) - && HvENAME_get(hv)) - mro_method_changed_in(hv); - } - - /* - * If a restricted hash, rather than really deleting the entry, put - * a placeholder there. This marks the key as being "approved", so - * we can still access via not-really-existing key without raising - * an error. - */ - if (SvREADONLY(hv)) - /* We'll be saving this slot, so the number of allocated keys - * doesn't go down, but the number placeholders goes up */ - HvPLACEHOLDERS(hv)++; - else { - *oentry = HeNEXT(entry); - if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */) - HvLAZYDEL_on(hv); - else { - if (SvOOK(hv) && HvLAZYDEL(hv) && - entry == HeNEXT(HvAUX(hv)->xhv_eiter)) - HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); - hv_free_ent(hv, entry); - } - xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */ - if (xhv->xhv_keys == 0) - HvHASKFLAGS_off(hv); - } - - if (d_flags & G_DISCARD) { - SvREFCNT_dec(sv); - sv = NULL; - } - - if (mro_changes == 1) mro_isa_changed_in(hv); - else if (mro_changes == 2) - mro_package_moved(NULL, stash, gv, 1); - - return sv; + } + + sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry)); + HeVAL(entry) = &PL_sv_placeholder; + if (sv) { + /* deletion of method from stash */ + if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv) + && HvENAME_get(hv)) + mro_method_changed_in(hv); + } + + /* + * If a restricted hash, rather than really deleting the entry, put + * a placeholder there. This marks the key as being "approved", so + * we can still access via not-really-existing key without raising + * an error. + */ + if (SvREADONLY(hv)) + /* We'll be saving this slot, so the number of allocated keys + * doesn't go down, but the number placeholders goes up */ + HvPLACEHOLDERS(hv)++; + else { + *oentry = HeNEXT(entry); + if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */) + HvLAZYDEL_on(hv); + else { + if (SvOOK(hv) && HvLAZYDEL(hv) && + entry == HeNEXT(HvAUX(hv)->xhv_eiter)) + HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); + hv_free_ent(hv, entry); + } + xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */ + if (xhv->xhv_keys == 0) + HvHASKFLAGS_off(hv); + } + + if (d_flags & G_DISCARD) { + SvREFCNT_dec(sv); + sv = NULL; + } + + if (mro_changes == 1) mro_isa_changed_in(hv); + else if (mro_changes == 2) + mro_package_moved(NULL, stash, gv, 1); + + return sv; } not_found: if (SvREADONLY(hv)) { - hv_notallowed(k_flags, key, klen, - "Attempt to delete disallowed key '%" SVf "' from" - " a restricted hash"); + hv_notallowed(k_flags, key, klen, + "Attempt to delete disallowed key '%" SVf "' from" + " a restricted hash"); } if (k_flags & HVhek_FREEKEY) - Safefree(key); + Safefree(key); return NULL; } @@ -1483,15 +1483,15 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) newsize--; aep = (HE**)a; do { - HE **oentry = aep + i; - HE *entry = aep[i]; + HE **oentry = aep + i; + HE *entry = aep[i]; - if (!entry) /* non-existent */ - continue; - do { + if (!entry) /* non-existent */ + continue; + do { U32 j = (HeHASH(entry) & newsize); - if (j != (U32)i) { - *oentry = HeNEXT(entry); + if (j != (U32)i) { + *oentry = HeNEXT(entry); #ifdef PERL_HASH_RANDOMIZE_KEYS /* if the target cell is empty or PL_HASH_RAND_BITS_ENABLED is false * insert to top, otherwise rotate the bucket rand 1 bit, @@ -1517,12 +1517,12 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) HeNEXT(entry) = aep[j]; aep[j] = entry; } - } - else { - oentry = &HeNEXT(entry); - } - entry = *oentry; - } while (entry); + } + else { + oentry = &HeNEXT(entry); + } + entry = *oentry; + } while (entry); } while (i++ < oldsize); } @@ -1540,7 +1540,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) wantsize = (I32) newmax; /* possible truncation here */ if (wantsize != newmax) - return; + return; wantsize= wantsize + (wantsize >> 1); /* wantsize *= 1.5 */ if (wantsize < newmax) /* overflow detection */ @@ -1592,76 +1592,76 @@ Perl_newHVhv(pTHX_ HV *ohv) STRLEN hv_max; if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv))) - return hv; + return hv; hv_max = HvMAX(ohv); if (!SvMAGICAL((const SV *)ohv)) { - /* It's an ordinary hash, so copy it fast. AMS 20010804 */ - STRLEN i; - const bool shared = !!HvSHAREKEYS(ohv); - HE **ents, ** const oents = (HE **)HvARRAY(ohv); - char *a; - Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char); - ents = (HE**)a; - - /* In each bucket... */ - for (i = 0; i <= hv_max; i++) { - HE *prev = NULL; - HE *oent = oents[i]; - - if (!oent) { - ents[i] = NULL; - continue; - } - - /* Copy the linked list of entries. */ - for (; oent; oent = HeNEXT(oent)) { - const U32 hash = HeHASH(oent); - const char * const key = HeKEY(oent); - const STRLEN len = HeKLEN(oent); - const int flags = HeKFLAGS(oent); - HE * const ent = new_HE(); - SV *const val = HeVAL(oent); - - HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val); - HeKEY_hek(ent) + /* It's an ordinary hash, so copy it fast. AMS 20010804 */ + STRLEN i; + const bool shared = !!HvSHAREKEYS(ohv); + HE **ents, ** const oents = (HE **)HvARRAY(ohv); + char *a; + Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char); + ents = (HE**)a; + + /* In each bucket... */ + for (i = 0; i <= hv_max; i++) { + HE *prev = NULL; + HE *oent = oents[i]; + + if (!oent) { + ents[i] = NULL; + continue; + } + + /* Copy the linked list of entries. */ + for (; oent; oent = HeNEXT(oent)) { + const U32 hash = HeHASH(oent); + const char * const key = HeKEY(oent); + const STRLEN len = HeKLEN(oent); + const int flags = HeKFLAGS(oent); + HE * const ent = new_HE(); + SV *const val = HeVAL(oent); + + HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val); + HeKEY_hek(ent) = shared ? share_hek_flags(key, len, hash, flags) : save_hek_flags(key, len, hash, flags); - if (prev) - HeNEXT(prev) = ent; - else - ents[i] = ent; - prev = ent; - HeNEXT(ent) = NULL; - } - } - - HvMAX(hv) = hv_max; - HvTOTALKEYS(hv) = HvTOTALKEYS(ohv); - HvARRAY(hv) = ents; + if (prev) + HeNEXT(prev) = ent; + else + ents[i] = ent; + prev = ent; + HeNEXT(ent) = NULL; + } + } + + HvMAX(hv) = hv_max; + HvTOTALKEYS(hv) = HvTOTALKEYS(ohv); + HvARRAY(hv) = ents; } /* not magical */ else { - /* Iterate over ohv, copying keys and values one at a time. */ - HE *entry; - const I32 riter = HvRITER_get(ohv); - HE * const eiter = HvEITER_get(ohv); + /* Iterate over ohv, copying keys and values one at a time. */ + HE *entry; + const I32 riter = HvRITER_get(ohv); + HE * const eiter = HvEITER_get(ohv); STRLEN hv_keys = HvTOTALKEYS(ohv); HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys); - hv_iterinit(ohv); - while ((entry = hv_iternext_flags(ohv, 0))) { - SV *val = hv_iterval(ohv,entry); - SV * const keysv = HeSVKEY(entry); - val = SvIMMORTAL(val) ? val : newSVsv(val); - if (keysv) - (void)hv_store_ent(hv, keysv, val, 0); - else - (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val, - HeHASH(entry), HeKFLAGS(entry)); - } - HvRITER_set(ohv, riter); - HvEITER_set(ohv, eiter); + hv_iterinit(ohv); + while ((entry = hv_iternext_flags(ohv, 0))) { + SV *val = hv_iterval(ohv,entry); + SV * const keysv = HeSVKEY(entry); + val = SvIMMORTAL(val) ? val : newSVsv(val); + if (keysv) + (void)hv_store_ent(hv, keysv, val, 0); + else + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val, + HeHASH(entry), HeKFLAGS(entry)); + } + HvRITER_set(ohv, riter); + HvEITER_set(ohv, eiter); } return hv; @@ -1685,37 +1685,37 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) HV * const hv = newHV(); if (ohv) { - STRLEN hv_max = HvMAX(ohv); + STRLEN hv_max = HvMAX(ohv); STRLEN hv_keys = HvTOTALKEYS(ohv); - HE *entry; - const I32 riter = HvRITER_get(ohv); - HE * const eiter = HvEITER_get(ohv); + HE *entry; + const I32 riter = HvRITER_get(ohv); + HE * const eiter = HvEITER_get(ohv); - ENTER; - SAVEFREESV(hv); + ENTER; + SAVEFREESV(hv); HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys); - hv_iterinit(ohv); - while ((entry = hv_iternext_flags(ohv, 0))) { - SV *const sv = newSVsv(hv_iterval(ohv,entry)); - SV *heksv = HeSVKEY(entry); - if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry)); - if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem, - (char *)heksv, HEf_SVKEY); - if (heksv == HeSVKEY(entry)) - (void)hv_store_ent(hv, heksv, sv, 0); - else { - (void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry), - HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry)); - SvREFCNT_dec_NN(heksv); - } - } - HvRITER_set(ohv, riter); - HvEITER_set(ohv, eiter); - - SvREFCNT_inc_simple_void_NN(hv); - LEAVE; + hv_iterinit(ohv); + while ((entry = hv_iternext_flags(ohv, 0))) { + SV *const sv = newSVsv(hv_iterval(ohv,entry)); + SV *heksv = HeSVKEY(entry); + if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry)); + if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem, + (char *)heksv, HEf_SVKEY); + if (heksv == HeSVKEY(entry)) + (void)hv_store_ent(hv, heksv, sv, 0); + else { + (void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry), + HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry)); + SvREFCNT_dec_NN(heksv); + } + } + HvRITER_set(ohv, riter); + HvEITER_set(ohv, eiter); + + SvREFCNT_inc_simple_void_NN(hv); + LEAVE; } hv_magic(hv, NULL, PERL_MAGIC_hints); return hv; @@ -1732,13 +1732,13 @@ S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry) val = HeVAL(entry); if (HeKLEN(entry) == HEf_SVKEY) { - SvREFCNT_dec(HeKEY_sv(entry)); - Safefree(HeKEY_hek(entry)); + SvREFCNT_dec(HeKEY_sv(entry)); + Safefree(HeKEY_hek(entry)); } else if (HvSHAREKEYS(hv)) - unshare_hek(HeKEY_hek(entry)); + unshare_hek(HeKEY_hek(entry)); else - Safefree(HeKEY_hek(entry)); + Safefree(HeKEY_hek(entry)); del_HE(entry); return val; } @@ -1752,7 +1752,7 @@ Perl_hv_free_ent(pTHX_ HV *hv, HE *entry) PERL_ARGS_ASSERT_HV_FREE_ENT; if (!entry) - return; + return; val = hv_free_ent_ret(hv, entry); SvREFCNT_dec(val); } @@ -1764,11 +1764,11 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry) PERL_ARGS_ASSERT_HV_DELAYFREE_ENT; if (!entry) - return; + return; /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */ sv_2mortal(SvREFCNT_inc(HeVAL(entry))); /* free between statements */ if (HeKLEN(entry) == HEf_SVKEY) { - sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry))); + sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry))); } hv_free_ent(hv, entry); } @@ -1792,7 +1792,7 @@ Perl_hv_clear(pTHX_ HV *hv) XPVHV* xhv; if (!hv) - return; + return; DEBUG_A(Perl_hv_assert(aTHX_ hv)); @@ -1803,41 +1803,41 @@ Perl_hv_clear(pTHX_ HV *hv) PL_tmps_stack[++PL_tmps_ix] = SvREFCNT_inc_simple_NN(hv); orig_ix = PL_tmps_ix; if (SvREADONLY(hv) && HvARRAY(hv) != NULL) { - /* restricted hash: convert all keys to placeholders */ - STRLEN i; - for (i = 0; i <= xhv->xhv_max; i++) { - HE *entry = (HvARRAY(hv))[i]; - for (; entry; entry = HeNEXT(entry)) { - /* not already placeholder */ - if (HeVAL(entry) != &PL_sv_placeholder) { - if (HeVAL(entry)) { - if (SvREADONLY(HeVAL(entry))) { - SV* const keysv = hv_iterkeysv(entry); - Perl_croak_nocontext( - "Attempt to delete readonly key '%" SVf "' from a restricted hash", - (void*)keysv); - } - SvREFCNT_dec_NN(HeVAL(entry)); - } - HeVAL(entry) = &PL_sv_placeholder; - HvPLACEHOLDERS(hv)++; - } - } - } + /* restricted hash: convert all keys to placeholders */ + STRLEN i; + for (i = 0; i <= xhv->xhv_max; i++) { + HE *entry = (HvARRAY(hv))[i]; + for (; entry; entry = HeNEXT(entry)) { + /* not already placeholder */ + if (HeVAL(entry) != &PL_sv_placeholder) { + if (HeVAL(entry)) { + if (SvREADONLY(HeVAL(entry))) { + SV* const keysv = hv_iterkeysv(entry); + Perl_croak_nocontext( + "Attempt to delete readonly key '%" SVf "' from a restricted hash", + (void*)keysv); + } + SvREFCNT_dec_NN(HeVAL(entry)); + } + HeVAL(entry) = &PL_sv_placeholder; + HvPLACEHOLDERS(hv)++; + } + } + } } else { - hv_free_entries(hv); - HvPLACEHOLDERS_set(hv, 0); + hv_free_entries(hv); + HvPLACEHOLDERS_set(hv, 0); - if (SvRMAGICAL(hv)) - mg_clear(MUTABLE_SV(hv)); + if (SvRMAGICAL(hv)) + mg_clear(MUTABLE_SV(hv)); - HvHASKFLAGS_off(hv); + HvHASKFLAGS_off(hv); } if (SvOOK(hv)) { if(HvENAME_get(hv)) mro_isa_changed_in(hv); - HvEITER_set(hv, NULL); + HvEITER_set(hv, NULL); } /* disarm hv's premature free guard */ if (LIKELY(PL_tmps_ix == orig_ix)) @@ -1870,7 +1870,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS; if (items) - clear_placeholders(hv, items); + clear_placeholders(hv, items); } static void @@ -1881,40 +1881,40 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items) PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS; if (items == 0) - return; + return; i = HvMAX(hv); do { - /* Loop down the linked list heads */ - HE **oentry = &(HvARRAY(hv))[i]; - HE *entry; - - while ((entry = *oentry)) { - if (HeVAL(entry) == &PL_sv_placeholder) { - *oentry = HeNEXT(entry); - if (entry == HvEITER_get(hv)) - HvLAZYDEL_on(hv); - else { - if (SvOOK(hv) && HvLAZYDEL(hv) && - entry == HeNEXT(HvAUX(hv)->xhv_eiter)) - HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); - hv_free_ent(hv, entry); - } - - if (--items == 0) { - /* Finished. */ - I32 placeholders = HvPLACEHOLDERS_get(hv); - HvTOTALKEYS(hv) -= (IV)placeholders; - /* HvUSEDKEYS expanded */ - if ((HvTOTALKEYS(hv) - placeholders) == 0) - HvHASKFLAGS_off(hv); - HvPLACEHOLDERS_set(hv, 0); - return; - } - } else { - oentry = &HeNEXT(entry); - } - } + /* Loop down the linked list heads */ + HE **oentry = &(HvARRAY(hv))[i]; + HE *entry; + + while ((entry = *oentry)) { + if (HeVAL(entry) == &PL_sv_placeholder) { + *oentry = HeNEXT(entry); + if (entry == HvEITER_get(hv)) + HvLAZYDEL_on(hv); + else { + if (SvOOK(hv) && HvLAZYDEL(hv) && + entry == HeNEXT(HvAUX(hv)->xhv_eiter)) + HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); + hv_free_ent(hv, entry); + } + + if (--items == 0) { + /* Finished. */ + I32 placeholders = HvPLACEHOLDERS_get(hv); + HvTOTALKEYS(hv) -= (IV)placeholders; + /* HvUSEDKEYS expanded */ + if ((HvTOTALKEYS(hv) - placeholders) == 0) + HvHASKFLAGS_off(hv); + HvPLACEHOLDERS_set(hv, 0); + return; + } + } else { + oentry = &HeNEXT(entry); + } + } } while (--i >= 0); /* You can't get here, hence assertion should always fail. */ assert (items == 0); @@ -1931,7 +1931,7 @@ S_hv_free_entries(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_FREE_ENTRIES; while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) { - SvREFCNT_dec(sv); + SvREFCNT_dec(sv); } } @@ -1958,7 +1958,7 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp) PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY; if (SvOOK(hv) && ((iter = HvAUX(hv)))) { - if ((entry = iter->xhv_eiter)) { + if ((entry = iter->xhv_eiter)) { /* the iterator may get resurrected after each * destructor call, so check each time */ if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ @@ -1977,31 +1977,31 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp) } if (!((XPVHV*)SvANY(hv))->xhv_keys) - return NULL; + return NULL; array = HvARRAY(hv); assert(array); while ( ! ((entry = array[*indexp])) ) { - if ((*indexp)++ >= HvMAX(hv)) - *indexp = 0; - assert(*indexp != orig_index); + if ((*indexp)++ >= HvMAX(hv)) + *indexp = 0; + assert(*indexp != orig_index); } array[*indexp] = HeNEXT(entry); ((XPVHV*) SvANY(hv))->xhv_keys--; if ( PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv) - && HeVAL(entry) && isGV(HeVAL(entry)) - && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry))) + && HeVAL(entry) && isGV(HeVAL(entry)) + && GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry))) ) { - STRLEN klen; - const char * const key = HePV(entry,klen); - if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':') - || (klen == 1 && key[0] == ':')) { - mro_package_moved( - NULL, GvHV(HeVAL(entry)), - (GV *)HeVAL(entry), 0 - ); - } + STRLEN klen; + const char * const key = HePV(entry,klen); + if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':') + || (klen == 1 && key[0] == ':')) { + mro_package_moved( + NULL, GvHV(HeVAL(entry)), + (GV *)HeVAL(entry), 0 + ); + } } return hv_free_ent_ret(hv, entry); } @@ -2029,7 +2029,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) SSize_t orig_ix = PL_tmps_ix; /* silence compiler warning about unitialized vars */ if (!hv) - return; + return; save = cBOOL(SvREFCNT(hv)); DEBUG_A(Perl_hv_assert(aTHX_ hv)); xhv = (XPVHV*)SvANY(hv); @@ -2048,9 +2048,9 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) if (PL_stashcache) { DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%" HEKf "'\n", HEKfARG(HvNAME_HEK(hv)))); - (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); + (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); } - hv_name_set(hv, NULL, 0, 0); + hv_name_set(hv, NULL, 0, 0); } if (save) { /* avoid hv being freed when calling destructors below */ @@ -2064,12 +2064,12 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) const char *name; if (HvENAME_get(hv)) { - if (PL_phase != PERL_PHASE_DESTRUCT) - mro_isa_changed_in(hv); + if (PL_phase != PERL_PHASE_DESTRUCT) + mro_isa_changed_in(hv); if (PL_stashcache) { DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%" HEKf "'\n", HEKfARG(HvENAME_HEK(hv)))); - (void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD); + (void)hv_deletehek(PL_stashcache, HvENAME_HEK(hv), G_DISCARD); } } @@ -2080,41 +2080,41 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) if (name && PL_stashcache) { DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%" HEKf "'\n", HEKfARG(HvNAME_HEK(hv)))); - (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); + (void)hv_deletehek(PL_stashcache, HvNAME_HEK(hv), G_DISCARD); } - hv_name_set(hv, NULL, 0, flags); + hv_name_set(hv, NULL, 0, flags); } if((meta = HvAUX(hv)->xhv_mro_meta)) { - if (meta->mro_linear_all) { - SvREFCNT_dec_NN(meta->mro_linear_all); - /* mro_linear_current is just acting as a shortcut pointer, - hence the else. */ - } - else - /* Only the current MRO is stored, so this owns the data. - */ - SvREFCNT_dec(meta->mro_linear_current); - SvREFCNT_dec(meta->mro_nextmethod); - SvREFCNT_dec(meta->isa); - SvREFCNT_dec(meta->super); - Safefree(meta); - HvAUX(hv)->xhv_mro_meta = NULL; + if (meta->mro_linear_all) { + SvREFCNT_dec_NN(meta->mro_linear_all); + /* mro_linear_current is just acting as a shortcut pointer, + hence the else. */ + } + else + /* Only the current MRO is stored, so this owns the data. + */ + SvREFCNT_dec(meta->mro_linear_current); + SvREFCNT_dec(meta->mro_nextmethod); + SvREFCNT_dec(meta->isa); + SvREFCNT_dec(meta->super); + Safefree(meta); + HvAUX(hv)->xhv_mro_meta = NULL; } if (!HvAUX(hv)->xhv_name_u.xhvnameu_name && ! HvAUX(hv)->xhv_backreferences) - SvFLAGS(hv) &= ~SVf_OOK; + SvFLAGS(hv) &= ~SVf_OOK; } if (!SvOOK(hv)) { - Safefree(HvARRAY(hv)); + Safefree(HvARRAY(hv)); xhv->xhv_max = PERL_HASH_DEFAULT_HvMAX; /* HvMAX(hv) = 7 (it's a normal hash) */ - HvARRAY(hv) = 0; + HvARRAY(hv) = 0; } /* if we're freeing the HV, the SvMAGIC field has been reused for * other purposes, and so there can't be any placeholder magic */ if (SvREFCNT(hv)) - HvPLACEHOLDERS_set(hv, 0); + HvPLACEHOLDERS_set(hv, 0); if (SvRMAGICAL(hv)) - mg_clear(MUTABLE_SV(hv)); + mg_clear(MUTABLE_SV(hv)); if (save) { /* disarm hv's premature free guard */ @@ -2162,13 +2162,13 @@ Perl_hv_fill(pTHX_ HV *const hv) * I would have thought counting up was better. * - Yves */ - HE *const *const last = ents + HvMAX(hv); - count = last + 1 - ents; + HE *const *const last = ents + HvMAX(hv); + count = last + 1 - ents; - do { - if (!*ents) - --count; - } while (++ents <= last); + do { + if (!*ents) + --count; + } while (++ents <= last); } return count; } @@ -2279,20 +2279,20 @@ Perl_hv_iterinit(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_ITERINIT; if (SvOOK(hv)) { - struct xpvhv_aux * iter = HvAUX(hv); - HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ - if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ - HvLAZYDEL_off(hv); - hv_free_ent(hv, entry); - } - iter = HvAUX(hv); /* may have been reallocated */ - iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ - iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ + struct xpvhv_aux * iter = HvAUX(hv); + HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ + if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ + HvLAZYDEL_off(hv); + hv_free_ent(hv, entry); + } + iter = HvAUX(hv); /* may have been reallocated */ + iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ + iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ #ifdef PERL_HASH_RANDOMIZE_KEYS iter->xhv_last_rand = iter->xhv_rand; #endif } else { - hv_auxinit(hv); + hv_auxinit(hv); } /* note this includes placeholders! */ @@ -2326,12 +2326,12 @@ Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) { PERL_ARGS_ASSERT_HV_RITER_SET; if (SvOOK(hv)) { - iter = HvAUX(hv); + iter = HvAUX(hv); } else { - if (riter == -1) - return; + if (riter == -1) + return; - iter = hv_auxinit(hv); + iter = hv_auxinit(hv); } iter->xhv_riter = riter; } @@ -2361,14 +2361,14 @@ Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { PERL_ARGS_ASSERT_HV_EITER_SET; if (SvOOK(hv)) { - iter = HvAUX(hv); + iter = HvAUX(hv); } else { - /* 0 is the default so don't go malloc()ing a new structure just to - hold 0. */ - if (!eiter) - return; + /* 0 is the default so don't go malloc()ing a new structure just to + hold 0. */ + if (!eiter) + return; - iter = hv_auxinit(hv); + iter = hv_auxinit(hv); } iter->xhv_eiter = eiter; } @@ -2383,64 +2383,64 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) PERL_ARGS_ASSERT_HV_NAME_SET; if (len > I32_MAX) - Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); + Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); if (SvOOK(hv)) { - iter = HvAUX(hv); - if (iter->xhv_name_u.xhvnameu_name) { - if(iter->xhv_name_count) { - if(flags & HV_NAME_SETALL) { - HEK ** const this_name = HvAUX(hv)->xhv_name_u.xhvnameu_names; - HEK **hekp = this_name + ( - iter->xhv_name_count < 0 - ? -iter->xhv_name_count - : iter->xhv_name_count - ); - while(hekp-- > this_name+1) - unshare_hek_or_pvn(*hekp, 0, 0, 0); - /* The first elem may be null. */ - if(*this_name) unshare_hek_or_pvn(*this_name, 0, 0, 0); - Safefree(this_name); + iter = HvAUX(hv); + if (iter->xhv_name_u.xhvnameu_name) { + if(iter->xhv_name_count) { + if(flags & HV_NAME_SETALL) { + HEK ** const this_name = HvAUX(hv)->xhv_name_u.xhvnameu_names; + HEK **hekp = this_name + ( + iter->xhv_name_count < 0 + ? -iter->xhv_name_count + : iter->xhv_name_count + ); + while(hekp-- > this_name+1) + unshare_hek_or_pvn(*hekp, 0, 0, 0); + /* The first elem may be null. */ + if(*this_name) unshare_hek_or_pvn(*this_name, 0, 0, 0); + Safefree(this_name); iter = HvAUX(hv); /* may been realloced */ - spot = &iter->xhv_name_u.xhvnameu_name; - iter->xhv_name_count = 0; - } - else { - if(iter->xhv_name_count > 0) { - /* shift some things over */ - Renew( - iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK * - ); - spot = iter->xhv_name_u.xhvnameu_names; - spot[iter->xhv_name_count] = spot[1]; - spot[1] = spot[0]; - iter->xhv_name_count = -(iter->xhv_name_count + 1); - } - else if(*(spot = iter->xhv_name_u.xhvnameu_names)) { - unshare_hek_or_pvn(*spot, 0, 0, 0); - } - } - } - else if (flags & HV_NAME_SETALL) { - unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0); + spot = &iter->xhv_name_u.xhvnameu_name; + iter->xhv_name_count = 0; + } + else { + if(iter->xhv_name_count > 0) { + /* shift some things over */ + Renew( + iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK * + ); + spot = iter->xhv_name_u.xhvnameu_names; + spot[iter->xhv_name_count] = spot[1]; + spot[1] = spot[0]; + iter->xhv_name_count = -(iter->xhv_name_count + 1); + } + else if(*(spot = iter->xhv_name_u.xhvnameu_names)) { + unshare_hek_or_pvn(*spot, 0, 0, 0); + } + } + } + else if (flags & HV_NAME_SETALL) { + unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0); iter = HvAUX(hv); /* may been realloced */ - spot = &iter->xhv_name_u.xhvnameu_name; - } - else { - HEK * const existing_name = iter->xhv_name_u.xhvnameu_name; - Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *); - iter->xhv_name_count = -2; - spot = iter->xhv_name_u.xhvnameu_names; - spot[1] = existing_name; - } - } - else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; } + spot = &iter->xhv_name_u.xhvnameu_name; + } + else { + HEK * const existing_name = iter->xhv_name_u.xhvnameu_name; + Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *); + iter->xhv_name_count = -2; + spot = iter->xhv_name_u.xhvnameu_names; + spot[1] = existing_name; + } + } + else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; } } else { - if (name == 0) - return; + if (name == 0) + return; - iter = hv_auxinit(hv); - spot = &iter->xhv_name_u.xhvnameu_name; + iter = hv_auxinit(hv); + spot = &iter->xhv_name_u.xhvnameu_name; } PERL_HASH(hash, name, len); *spot = name ? share_hek(name, flags & SVf_UTF8 ? -(I32)len : (I32)len, hash) : NULL; @@ -2457,11 +2457,11 @@ hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U3 if (flags & SVf_UTF8) return (bytes_cmp_utf8( (const U8*)HEK_KEY(hek), HEK_LEN(hek), - (const U8*)pv, pvlen) == 0); + (const U8*)pv, pvlen) == 0); else return (bytes_cmp_utf8( (const U8*)pv, pvlen, - (const U8*)HEK_KEY(hek), HEK_LEN(hek)) == 0); + (const U8*)HEK_KEY(hek), HEK_LEN(hek)) == 0); } else return HEK_LEN(hek) == pvlen && ((HEK_KEY(hek) == pv) @@ -2489,45 +2489,45 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags) PERL_ARGS_ASSERT_HV_ENAME_ADD; if (len > I32_MAX) - Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); + Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); PERL_HASH(hash, name, len); if (aux->xhv_name_count) { - I32 count = aux->xhv_name_count; - HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names + (count<0); - HEK **hekp = xhv_name + (count < 0 ? -count - 1 : count); - while (hekp-- > xhv_name) - { - assert(*hekp); - if ( + I32 count = aux->xhv_name_count; + HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names + (count<0); + HEK **hekp = xhv_name + (count < 0 ? -count - 1 : count); + while (hekp-- > xhv_name) + { + assert(*hekp); + if ( (HEK_UTF8(*hekp) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *hekp, name, (I32)len, flags) - : (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)) + : (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)) ) { - if (hekp == xhv_name && count < 0) - aux->xhv_name_count = -count; - return; - } - } - if (count < 0) aux->xhv_name_count--, count = -count; - else aux->xhv_name_count++; - Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *); - (aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); + if (hekp == xhv_name && count < 0) + aux->xhv_name_count = -count; + return; + } + } + if (count < 0) aux->xhv_name_count--, count = -count; + else aux->xhv_name_count++; + Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *); + (aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); } else { - HEK *existing_name = aux->xhv_name_u.xhvnameu_name; - if ( - existing_name && ( + HEK *existing_name = aux->xhv_name_u.xhvnameu_name; + if ( + existing_name && ( (HEK_UTF8(existing_name) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ existing_name, name, (I32)len, flags) - : (HEK_LEN(existing_name) == (I32)len && memEQ(HEK_KEY(existing_name), name, len)) - ) - ) return; - Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *); - aux->xhv_name_count = existing_name ? 2 : -2; - *aux->xhv_name_u.xhvnameu_names = existing_name; - (aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); + : (HEK_LEN(existing_name) == (I32)len && memEQ(HEK_KEY(existing_name), name, len)) + ) + ) return; + Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *); + aux->xhv_name_count = existing_name ? 2 : -2; + *aux->xhv_name_u.xhvnameu_names = existing_name; + (aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); } } @@ -2551,7 +2551,7 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) PERL_ARGS_ASSERT_HV_ENAME_DELETE; if (len > I32_MAX) - Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); + Perl_croak(aTHX_ "panic: hv name too long (%" UVuf ")", (UV) len); if (!SvOOK(hv)) return; @@ -2559,53 +2559,53 @@ Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) if (!aux->xhv_name_u.xhvnameu_name) return; if (aux->xhv_name_count) { - HEK ** const namep = aux->xhv_name_u.xhvnameu_names; - I32 const count = aux->xhv_name_count; - HEK **victim = namep + (count < 0 ? -count : count); - while (victim-- > namep + 1) - if ( + HEK ** const namep = aux->xhv_name_u.xhvnameu_names; + I32 const count = aux->xhv_name_count; + HEK **victim = namep + (count < 0 ? -count : count); + while (victim-- > namep + 1) + if ( (HEK_UTF8(*victim) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *victim, name, (I32)len, flags) - : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len)) - ) { - unshare_hek_or_pvn(*victim, 0, 0, 0); + : (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len)) + ) { + unshare_hek_or_pvn(*victim, 0, 0, 0); aux = HvAUX(hv); /* may been realloced */ - if (count < 0) ++aux->xhv_name_count; - else --aux->xhv_name_count; - if ( - (aux->xhv_name_count == 1 || aux->xhv_name_count == -1) - && !*namep - ) { /* if there are none left */ - Safefree(namep); - aux->xhv_name_u.xhvnameu_names = NULL; - aux->xhv_name_count = 0; - } - else { - /* Move the last one back to fill the empty slot. It - does not matter what order they are in. */ - *victim = *(namep + (count < 0 ? -count : count) - 1); - } - return; - } - if ( - count > 0 && ((HEK_UTF8(*namep) || (flags & SVf_UTF8)) + if (count < 0) ++aux->xhv_name_count; + else --aux->xhv_name_count; + if ( + (aux->xhv_name_count == 1 || aux->xhv_name_count == -1) + && !*namep + ) { /* if there are none left */ + Safefree(namep); + aux->xhv_name_u.xhvnameu_names = NULL; + aux->xhv_name_count = 0; + } + else { + /* Move the last one back to fill the empty slot. It + does not matter what order they are in. */ + *victim = *(namep + (count < 0 ? -count : count) - 1); + } + return; + } + if ( + count > 0 && ((HEK_UTF8(*namep) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags) - : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len)) + : (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len)) ) - ) { - aux->xhv_name_count = -count; - } + ) { + aux->xhv_name_count = -count; + } } else if( (HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8)) ? hek_eq_pvn_flags(aTHX_ aux->xhv_name_u.xhvnameu_name, name, (I32)len, flags) - : (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len && + : (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len && memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len)) ) { - HEK * const namehek = aux->xhv_name_u.xhvnameu_name; - Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *); - *aux->xhv_name_u.xhvnameu_names = namehek; - aux->xhv_name_count = -1; + HEK * const namehek = aux->xhv_name_u.xhvnameu_name; + Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *); + *aux->xhv_name_u.xhvnameu_names = namehek; + aux->xhv_name_count = -1; } } @@ -2626,15 +2626,15 @@ Perl_hv_kill_backrefs(pTHX_ HV *hv) { PERL_ARGS_ASSERT_HV_KILL_BACKREFS; if (!SvOOK(hv)) - return; + return; av = HvAUX(hv)->xhv_backreferences; if (av) { - HvAUX(hv)->xhv_backreferences = 0; - Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av); - if (SvTYPE(av) == SVt_PVAV) - SvREFCNT_dec_NN(av); + HvAUX(hv)->xhv_backreferences = 0; + Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av); + if (SvTYPE(av) == SVt_PVAV) + SvREFCNT_dec_NN(av); } } @@ -2684,21 +2684,21 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) xhv = (XPVHV*)SvANY(hv); if (!SvOOK(hv)) { - /* Too many things (well, pp_each at least) merrily assume that you can - call hv_iternext without calling hv_iterinit, so we'll have to deal - with it. */ - hv_iterinit(hv); + /* Too many things (well, pp_each at least) merrily assume that you can + call hv_iternext without calling hv_iterinit, so we'll have to deal + with it. */ + hv_iterinit(hv); } iter = HvAUX(hv); oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ if (SvMAGICAL(hv) && SvRMAGICAL(hv)) { - if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) { + if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) { SV * const key = sv_newmortal(); if (entry) { sv_setsv(key, HeSVKEY_force(entry)); SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ - HeSVKEY_set(entry, NULL); + HeSVKEY_set(entry, NULL); } else { char *k; @@ -2706,7 +2706,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* one HE per MAGICAL hash */ iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ - HvLAZYDEL_on(hv); /* make sure entry gets freed */ + HvLAZYDEL_on(hv); /* make sure entry gets freed */ Zero(entry, 1, HE); Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); hek = (HEK*)k; @@ -2724,21 +2724,21 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) del_HE(entry); iter = HvAUX(hv); /* may been realloced */ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ - HvLAZYDEL_off(hv); + HvLAZYDEL_off(hv); return NULL; } } #if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__) /* set up %ENV for iteration */ if (!entry && SvRMAGICAL((const SV *)hv) - && mg_find((const SV *)hv, PERL_MAGIC_env)) { - prime_env_iter(); + && mg_find((const SV *)hv, PERL_MAGIC_env)) { + prime_env_iter(); #ifdef VMS - /* The prime_env_iter() on VMS just loaded up new hash values - * so the iteration count needs to be reset back to the beginning - */ - hv_iterinit(hv); - iter = HvAUX(hv); - oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ + /* The prime_env_iter() on VMS just loaded up new hash values + * so the iteration count needs to be reset back to the beginning + */ + hv_iterinit(hv); + iter = HvAUX(hv); + oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ #endif } #endif @@ -2749,7 +2749,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* At start of hash, entry is NULL. */ if (entry) { - entry = HeNEXT(entry); + entry = HeNEXT(entry); if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { /* * Skip past any placeholders -- don't want to include them in @@ -2758,7 +2758,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) while (entry && HeVAL(entry) == &PL_sv_placeholder) { entry = HeNEXT(entry); } - } + } } #ifdef PERL_HASH_RANDOMIZE_KEYS @@ -2776,31 +2776,31 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) /* Skip the entire loop if the hash is empty. */ if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS) - ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) { - while (!entry) { - /* OK. Come to the end of the current list. Grab the next one. */ - - iter->xhv_riter++; /* HvRITER(hv)++ */ - if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { - /* There is no next one. End of the hash. */ - iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ + ? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) { + while (!entry) { + /* OK. Come to the end of the current list. Grab the next one. */ + + iter->xhv_riter++; /* HvRITER(hv)++ */ + if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { + /* There is no next one. End of the hash. */ + iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ #ifdef PERL_HASH_RANDOMIZE_KEYS iter->xhv_last_rand = iter->xhv_rand; /* reset xhv_last_rand so we can detect inserts during traversal */ #endif - break; - } + break; + } entry = (HvARRAY(hv))[ PERL_HASH_ITER_BUCKET(iter) & xhv->xhv_max ]; - if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { - /* If we have an entry, but it's a placeholder, don't count it. - Try the next. */ - while (entry && HeVAL(entry) == &PL_sv_placeholder) - entry = HeNEXT(entry); - } - /* Will loop again if this linked list starts NULL - (for HV_ITERNEXT_WANTPLACEHOLDERS) - or if we run through it and find only placeholders. */ - } + if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { + /* If we have an entry, but it's a placeholder, don't count it. + Try the next. */ + while (entry && HeVAL(entry) == &PL_sv_placeholder) + entry = HeNEXT(entry); + } + /* Will loop again if this linked list starts NULL + (for HV_ITERNEXT_WANTPLACEHOLDERS) + or if we run through it and find only placeholders. */ + } } else { iter->xhv_riter = -1; @@ -2810,8 +2810,8 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) } if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ - HvLAZYDEL_off(hv); - hv_free_ent(hv, oldentry); + HvLAZYDEL_off(hv); + hv_free_ent(hv, oldentry); } iter = HvAUX(hv); /* may been realloced */ @@ -2834,14 +2834,14 @@ Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen) PERL_ARGS_ASSERT_HV_ITERKEY; if (HeKLEN(entry) == HEf_SVKEY) { - STRLEN len; - char * const p = SvPV(HeKEY_sv(entry), len); - *retlen = len; - return p; + STRLEN len; + char * const p = SvPV(HeKEY_sv(entry), len); + *retlen = len; + return p; } else { - *retlen = HeKLEN(entry); - return HeKEY(entry); + *retlen = HeKLEN(entry); + return HeKEY(entry); } } @@ -2879,14 +2879,14 @@ Perl_hv_iterval(pTHX_ HV *hv, HE *entry) PERL_ARGS_ASSERT_HV_ITERVAL; if (SvRMAGICAL(hv)) { - if (mg_find((const SV *)hv, PERL_MAGIC_tied)) { - SV* const sv = sv_newmortal(); - if (HeKLEN(entry) == HEf_SVKEY) - mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY); - else - mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry)); - return sv; - } + if (mg_find((const SV *)hv, PERL_MAGIC_tied)) { + SV* const sv = sv_newmortal(); + if (HeKLEN(entry) == HEf_SVKEY) + mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY); + else + mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry)); + return sv; + } } return HeVAL(entry); } @@ -2908,7 +2908,7 @@ Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen) PERL_ARGS_ASSERT_HV_ITERNEXTSV; if (!he) - return NULL; + return NULL; *key = hv_iterkey(he, retlen); return hv_iterval(hv, he); } @@ -2957,19 +2957,19 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) struct shared_he *he = NULL; if (hek) { - /* Find the shared he which is just before us in memory. */ - he = (struct shared_he *)(((char *)hek) - - STRUCT_OFFSET(struct shared_he, - shared_he_hek)); + /* Find the shared he which is just before us in memory. */ + he = (struct shared_he *)(((char *)hek) + - STRUCT_OFFSET(struct shared_he, + shared_he_hek)); - /* Assert that the caller passed us a genuine (or at least consistent) - shared hek */ - assert (he->shared_he_he.hent_hek == hek); + /* Assert that the caller passed us a genuine (or at least consistent) + shared hek */ + assert (he->shared_he_he.hent_hek == hek); - if (he->shared_he_he.he_valu.hent_refcount - 1) { - --he->shared_he_he.he_valu.hent_refcount; - return; - } + if (he->shared_he_he.he_valu.hent_refcount - 1) { + --he->shared_he_he.he_valu.hent_refcount; + return; + } hash = HEK_HASH(hek); } else if (len < 0) { @@ -2986,14 +2986,14 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) /* what follows was the moral equivalent of: if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) { - if (--*Svp == NULL) - hv_delete(PL_strtab, str, len, G_DISCARD, hash); + if (--*Svp == NULL) + hv_delete(PL_strtab, str, len, G_DISCARD, hash); } */ xhv = (XPVHV*)SvANY(PL_strtab); /* assert(xhv_array != 0) */ oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)]; if (he) { - const HE *const he_he = &(he->shared_he_he); + const HE *const he_he = &(he->shared_he_he); for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) { if (entry == he_he) break; @@ -3022,13 +3022,13 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } if (!entry) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "Attempt to free nonexistent shared string '%s'%s" - pTHX__FORMAT, - hek ? HEK_KEY(hek) : str, - ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "Attempt to free nonexistent shared string '%s'%s" + pTHX__FORMAT, + hek ? HEK_KEY(hek) : str, + ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); if (k_flags & HVhek_FREEKEY) - Safefree(str); + Safefree(str); } /* get a (constant) string ptr from the global string table @@ -3083,73 +3083,73 @@ S_share_hek_flags(pTHX_ const char *str, STRLEN len, U32 hash, int flags) /* what follows is the moral equivalent of: if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE))) - hv_store(PL_strtab, str, len, NULL, hash); + hv_store(PL_strtab, str, len, NULL, hash); - Can't rehash the shared string table, so not sure if it's worth - counting the number of entries in the linked list + Can't rehash the shared string table, so not sure if it's worth + counting the number of entries in the linked list */ /* assert(xhv_array != 0) */ entry = (HvARRAY(PL_strtab))[hindex]; for (;entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) != hash) /* strings can't be equal */ - continue; - if (HeKLEN(entry) != (SSize_t) len) - continue; - if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ - continue; - if (HeKFLAGS(entry) != flags_masked) - continue; - break; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (SSize_t) len) + continue; + if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + if (HeKFLAGS(entry) != flags_masked) + continue; + break; } if (!entry) { - /* What used to be head of the list. - If this is NULL, then we're the first entry for this slot, which - means we need to increate fill. */ - struct shared_he *new_entry; - HEK *hek; - char *k; - HE **const head = &HvARRAY(PL_strtab)[hindex]; - HE *const next = *head; - - /* We don't actually store a HE from the arena and a regular HEK. - Instead we allocate one chunk of memory big enough for both, - and put the HEK straight after the HE. This way we can find the - HE directly from the HEK. - */ - - Newx(k, STRUCT_OFFSET(struct shared_he, - shared_he_hek.hek_key[0]) + len + 2, char); - new_entry = (struct shared_he *)k; - entry = &(new_entry->shared_he_he); - hek = &(new_entry->shared_he_hek); - - Copy(str, HEK_KEY(hek), len, char); - HEK_KEY(hek)[len] = 0; - HEK_LEN(hek) = len; - HEK_HASH(hek) = hash; - HEK_FLAGS(hek) = (unsigned char)flags_masked; - - /* Still "point" to the HEK, so that other code need not know what - we're up to. */ - HeKEY_hek(entry) = hek; - entry->he_valu.hent_refcount = 0; - HeNEXT(entry) = next; - *head = entry; - - xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ - if (!next) { /* initial entry? */ - } else if ( DO_HSPLIT(xhv) ) { + /* What used to be head of the list. + If this is NULL, then we're the first entry for this slot, which + means we need to increate fill. */ + struct shared_he *new_entry; + HEK *hek; + char *k; + HE **const head = &HvARRAY(PL_strtab)[hindex]; + HE *const next = *head; + + /* We don't actually store a HE from the arena and a regular HEK. + Instead we allocate one chunk of memory big enough for both, + and put the HEK straight after the HE. This way we can find the + HE directly from the HEK. + */ + + Newx(k, STRUCT_OFFSET(struct shared_he, + shared_he_hek.hek_key[0]) + len + 2, char); + new_entry = (struct shared_he *)k; + entry = &(new_entry->shared_he_he); + hek = &(new_entry->shared_he_hek); + + Copy(str, HEK_KEY(hek), len, char); + HEK_KEY(hek)[len] = 0; + HEK_LEN(hek) = len; + HEK_HASH(hek) = hash; + HEK_FLAGS(hek) = (unsigned char)flags_masked; + + /* Still "point" to the HEK, so that other code need not know what + we're up to. */ + HeKEY_hek(entry) = hek; + entry->he_valu.hent_refcount = 0; + HeNEXT(entry) = next; + *head = entry; + + xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ + if (!next) { /* initial entry? */ + } else if ( DO_HSPLIT(xhv) ) { const STRLEN oldsize = xhv->xhv_max + 1; hsplit(PL_strtab, oldsize, oldsize * 2); - } + } } ++entry->he_valu.hent_refcount; if (flags & HVhek_FREEKEY) - Safefree(str); + Safefree(str); return HeKEY_hek(entry); } @@ -3162,11 +3162,11 @@ Perl_hv_placeholders_p(pTHX_ HV *hv) PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P; if (!mg) { - mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0); + mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0); - if (!mg) { - Perl_die(aTHX_ "panic: hv_placeholders_p"); - } + if (!mg) { + Perl_die(aTHX_ "panic: hv_placeholders_p"); + } } return &(mg->mg_len); } @@ -3191,10 +3191,10 @@ Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET; if (mg) { - mg->mg_len = ph; + mg->mg_len = ph; } else if (ph) { - if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph)) - Perl_die(aTHX_ "panic: hv_placeholders_set"); + if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph)) + Perl_die(aTHX_ "panic: hv_placeholders_set"); } /* else we don't need to add magic to record 0 placeholders. */ } @@ -3208,34 +3208,34 @@ S_refcounted_he_value(pTHX_ const struct refcounted_he *he) switch(he->refcounted_he_data[0] & HVrhek_typemask) { case HVrhek_undef: - value = newSV(0); - break; + value = newSV(0); + break; case HVrhek_delete: - value = &PL_sv_placeholder; - break; + value = &PL_sv_placeholder; + break; case HVrhek_IV: - value = newSViv(he->refcounted_he_val.refcounted_he_u_iv); - break; + value = newSViv(he->refcounted_he_val.refcounted_he_u_iv); + break; case HVrhek_UV: - value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv); - break; + value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv); + break; case HVrhek_PV: case HVrhek_PV_UTF8: - /* Create a string SV that directly points to the bytes in our - structure. */ - value = newSV_type(SVt_PV); - SvPV_set(value, (char *) he->refcounted_he_data + 1); - SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len); - /* This stops anything trying to free it */ - SvLEN_set(value, 0); - SvPOK_on(value); - SvREADONLY_on(value); - if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) - SvUTF8_on(value); - break; + /* Create a string SV that directly points to the bytes in our + structure. */ + value = newSV_type(SVt_PV); + SvPV_set(value, (char *) he->refcounted_he_data + 1); + SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len); + /* This stops anything trying to free it */ + SvLEN_set(value, 0); + SvPOK_on(value); + SvREADONLY_on(value); + if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) + SvUTF8_on(value); + break; default: - Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %" UVxf, - (UV)he->refcounted_he_data[0]); + Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %" UVxf, + (UV)he->refcounted_he_data[0]); } return value; } @@ -3256,8 +3256,8 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags) U32 placeholders, max; if (flags) - Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %" UVxf, + (UV)flags); /* We could chase the chain once to get an idea of the number of keys, and call ksplit. But for now we'll make a potentially inefficient @@ -3265,77 +3265,77 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags) hv = newHV(); max = HvMAX(hv); if (!HvARRAY(hv)) { - char *array; - Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(max + 1), char); - HvARRAY(hv) = (HE**)array; + char *array; + Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(max + 1), char); + HvARRAY(hv) = (HE**)array; } placeholders = 0; while (chain) { #ifdef USE_ITHREADS - U32 hash = chain->refcounted_he_hash; + U32 hash = chain->refcounted_he_hash; #else - U32 hash = HEK_HASH(chain->refcounted_he_hek); + U32 hash = HEK_HASH(chain->refcounted_he_hek); #endif - HE **oentry = &((HvARRAY(hv))[hash & max]); - HE *entry = *oentry; - SV *value; - - for (; entry; entry = HeNEXT(entry)) { - if (HeHASH(entry) == hash) { - /* We might have a duplicate key here. If so, entry is older - than the key we've already put in the hash, so if they are - the same, skip adding entry. */ + HE **oentry = &((HvARRAY(hv))[hash & max]); + HE *entry = *oentry; + SV *value; + + for (; entry; entry = HeNEXT(entry)) { + if (HeHASH(entry) == hash) { + /* We might have a duplicate key here. If so, entry is older + than the key we've already put in the hash, so if they are + the same, skip adding entry. */ #ifdef USE_ITHREADS - const STRLEN klen = HeKLEN(entry); - const char *const key = HeKEY(entry); - if (klen == chain->refcounted_he_keylen - && (!!HeKUTF8(entry) - == !!(chain->refcounted_he_data[0] & HVhek_UTF8)) - && memEQ(key, REF_HE_KEY(chain), klen)) - goto next_please; + const STRLEN klen = HeKLEN(entry); + const char *const key = HeKEY(entry); + if (klen == chain->refcounted_he_keylen + && (!!HeKUTF8(entry) + == !!(chain->refcounted_he_data[0] & HVhek_UTF8)) + && memEQ(key, REF_HE_KEY(chain), klen)) + goto next_please; #else - if (HeKEY_hek(entry) == chain->refcounted_he_hek) - goto next_please; - if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek) - && HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek) - && memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek), - HeKLEN(entry))) - goto next_please; + if (HeKEY_hek(entry) == chain->refcounted_he_hek) + goto next_please; + if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek) + && HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek) + && memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek), + HeKLEN(entry))) + goto next_please; #endif - } - } - assert (!entry); - entry = new_HE(); + } + } + assert (!entry); + entry = new_HE(); #ifdef USE_ITHREADS - HeKEY_hek(entry) - = share_hek_flags(REF_HE_KEY(chain), - chain->refcounted_he_keylen, - chain->refcounted_he_hash, - (chain->refcounted_he_data[0] - & (HVhek_UTF8|HVhek_WASUTF8))); + HeKEY_hek(entry) + = share_hek_flags(REF_HE_KEY(chain), + chain->refcounted_he_keylen, + chain->refcounted_he_hash, + (chain->refcounted_he_data[0] + & (HVhek_UTF8|HVhek_WASUTF8))); #else - HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek); + HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek); #endif - value = refcounted_he_value(chain); - if (value == &PL_sv_placeholder) - placeholders++; - HeVAL(entry) = value; + value = refcounted_he_value(chain); + if (value == &PL_sv_placeholder) + placeholders++; + HeVAL(entry) = value; - /* Link it into the chain. */ - HeNEXT(entry) = *oentry; - *oentry = entry; + /* Link it into the chain. */ + HeNEXT(entry) = *oentry; + *oentry = entry; - HvTOTALKEYS(hv)++; + HvTOTALKEYS(hv)++; next_please: - chain = chain->refcounted_he_next; + chain = chain->refcounted_he_next; } if (placeholders) { - clear_placeholders(hv, placeholders); - HvTOTALKEYS(hv) -= placeholders; + clear_placeholders(hv, placeholders); + HvTOTALKEYS(hv) -= placeholders; } /* We could check in the loop to see if we encounter any keys with key @@ -3363,38 +3363,38 @@ if there is no value associated with the key. SV * Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain, - const char *keypv, STRLEN keylen, U32 hash, U32 flags) + const char *keypv, STRLEN keylen, U32 hash, U32 flags) { U8 utf8_flag; PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN; if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS)) - Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %" UVxf, + (UV)flags); if (!chain) - goto ret; + goto ret; if (flags & REFCOUNTED_HE_KEY_UTF8) { - /* For searching purposes, canonicalise to Latin-1 where possible. */ - const char *keyend = keypv + keylen, *p; - STRLEN nonascii_count = 0; - for (p = keypv; p != keyend; p++) { - if (! UTF8_IS_INVARIANT(*p)) { - if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { - goto canonicalised_key; + /* For searching purposes, canonicalise to Latin-1 where possible. */ + const char *keyend = keypv + keylen, *p; + STRLEN nonascii_count = 0; + for (p = keypv; p != keyend; p++) { + if (! UTF8_IS_INVARIANT(*p)) { + if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { + goto canonicalised_key; } - nonascii_count++; + nonascii_count++; p++; - } - } - if (nonascii_count) { - char *q; - const char *p = keypv, *keyend = keypv + keylen; - keylen -= nonascii_count; - Newx(q, keylen, char); - SAVEFREEPV(q); - keypv = q; - for (; p != keyend; p++, q++) { - U8 c = (U8)*p; + } + } + if (nonascii_count) { + char *q; + const char *p = keypv, *keyend = keypv + keylen; + keylen -= nonascii_count; + Newx(q, keylen, char); + SAVEFREEPV(q); + keypv = q; + for (; p != keyend; p++, q++) { + U8 c = (U8)*p; if (UTF8_IS_INVARIANT(c)) { *q = (char) c; } @@ -3402,35 +3402,35 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain, p++; *q = (char) EIGHT_BIT_UTF8_TO_NATIVE(c, *p); } - } - } - flags &= ~REFCOUNTED_HE_KEY_UTF8; - canonicalised_key: ; + } + } + flags &= ~REFCOUNTED_HE_KEY_UTF8; + canonicalised_key: ; } utf8_flag = (flags & REFCOUNTED_HE_KEY_UTF8) ? HVhek_UTF8 : 0; if (!hash) - PERL_HASH(hash, keypv, keylen); + PERL_HASH(hash, keypv, keylen); for (; chain; chain = chain->refcounted_he_next) { - if ( + if ( #ifdef USE_ITHREADS - hash == chain->refcounted_he_hash && - keylen == chain->refcounted_he_keylen && - memEQ(REF_HE_KEY(chain), keypv, keylen) && - utf8_flag == (chain->refcounted_he_data[0] & HVhek_UTF8) + hash == chain->refcounted_he_hash && + keylen == chain->refcounted_he_keylen && + memEQ(REF_HE_KEY(chain), keypv, keylen) && + utf8_flag == (chain->refcounted_he_data[0] & HVhek_UTF8) #else - hash == HEK_HASH(chain->refcounted_he_hek) && - keylen == (STRLEN)HEK_LEN(chain->refcounted_he_hek) && - memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) && - utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8) + hash == HEK_HASH(chain->refcounted_he_hek) && + keylen == (STRLEN)HEK_LEN(chain->refcounted_he_hek) && + memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) && + utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8) #endif - ) { - if (flags & REFCOUNTED_HE_EXISTS) - return (chain->refcounted_he_data[0] & HVrhek_typemask) - == HVrhek_delete - ? NULL : &PL_sv_yes; - return sv_2mortal(refcounted_he_value(chain)); - } + ) { + if (flags & REFCOUNTED_HE_EXISTS) + return (chain->refcounted_he_data[0] & HVrhek_typemask) + == HVrhek_delete + ? NULL : &PL_sv_yes; + return sv_2mortal(refcounted_he_value(chain)); + } } ret: return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder; @@ -3447,7 +3447,7 @@ instead of a string/length pair. SV * Perl_refcounted_he_fetch_pv(pTHX_ const struct refcounted_he *chain, - const char *key, U32 hash, U32 flags) + const char *key, U32 hash, U32 flags) { PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PV; return refcounted_he_fetch_pvn(chain, key, strlen(key), hash, flags); @@ -3464,19 +3464,19 @@ string/length pair. SV * Perl_refcounted_he_fetch_sv(pTHX_ const struct refcounted_he *chain, - SV *key, U32 hash, U32 flags) + SV *key, U32 hash, U32 flags) { const char *keypv; STRLEN keylen; PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_SV; if (flags & REFCOUNTED_HE_KEY_UTF8) - Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %" UVxf, + (UV)flags); keypv = SvPV_const(key, keylen); if (SvUTF8(key)) - flags |= REFCOUNTED_HE_KEY_UTF8; + flags |= REFCOUNTED_HE_KEY_UTF8; if (!hash && SvIsCOW_shared_hash(key)) - hash = SvSHARED_HASH(key); + hash = SvSHARED_HASH(key); return refcounted_he_fetch_pvn(chain, keypv, keylen, hash, flags); } @@ -3515,7 +3515,7 @@ C. struct refcounted_he * Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent, - const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags) + const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags) { STRLEN value_len = 0; const char *value_p = NULL; @@ -3527,49 +3527,49 @@ Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent, PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PVN; if (!value || value == &PL_sv_placeholder) { - value_type = HVrhek_delete; + value_type = HVrhek_delete; } else if (SvPOK(value)) { - value_type = HVrhek_PV; + value_type = HVrhek_PV; } else if (SvIOK(value)) { - value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV; + value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV; } else if (!SvOK(value)) { - value_type = HVrhek_undef; + value_type = HVrhek_undef; } else { - value_type = HVrhek_PV; + value_type = HVrhek_PV; } is_pv = value_type == HVrhek_PV; if (is_pv) { - /* Do it this way so that the SvUTF8() test is after the SvPV, in case - the value is overloaded, and doesn't yet have the UTF-8flag set. */ - value_p = SvPV_const(value, value_len); - if (SvUTF8(value)) - value_type = HVrhek_PV_UTF8; - key_offset = value_len + 2; + /* Do it this way so that the SvUTF8() test is after the SvPV, in case + the value is overloaded, and doesn't yet have the UTF-8flag set. */ + value_p = SvPV_const(value, value_len); + if (SvUTF8(value)) + value_type = HVrhek_PV_UTF8; + key_offset = value_len + 2; } hekflags = value_type; if (flags & REFCOUNTED_HE_KEY_UTF8) { - /* Canonicalise to Latin-1 where possible. */ - const char *keyend = keypv + keylen, *p; - STRLEN nonascii_count = 0; - for (p = keypv; p != keyend; p++) { - if (! UTF8_IS_INVARIANT(*p)) { - if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { - goto canonicalised_key; + /* Canonicalise to Latin-1 where possible. */ + const char *keyend = keypv + keylen, *p; + STRLEN nonascii_count = 0; + for (p = keypv; p != keyend; p++) { + if (! UTF8_IS_INVARIANT(*p)) { + if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { + goto canonicalised_key; } - nonascii_count++; + nonascii_count++; p++; - } - } - if (nonascii_count) { - char *q; - const char *p = keypv, *keyend = keypv + keylen; - keylen -= nonascii_count; - Newx(q, keylen, char); - SAVEFREEPV(q); - keypv = q; - for (; p != keyend; p++, q++) { - U8 c = (U8)*p; + } + } + if (nonascii_count) { + char *q; + const char *p = keypv, *keyend = keypv + keylen; + keylen -= nonascii_count; + Newx(q, keylen, char); + SAVEFREEPV(q); + keypv = q; + for (; p != keyend; p++, q++) { + U8 c = (U8)*p; if (UTF8_IS_INVARIANT(c)) { *q = (char) c; } @@ -3577,36 +3577,36 @@ Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent, p++; *q = (char) EIGHT_BIT_UTF8_TO_NATIVE(c, *p); } - } - } - flags &= ~REFCOUNTED_HE_KEY_UTF8; - canonicalised_key: ; + } + } + flags &= ~REFCOUNTED_HE_KEY_UTF8; + canonicalised_key: ; } if (flags & REFCOUNTED_HE_KEY_UTF8) - hekflags |= HVhek_UTF8; + hekflags |= HVhek_UTF8; if (!hash) - PERL_HASH(hash, keypv, keylen); + PERL_HASH(hash, keypv, keylen); #ifdef USE_ITHREADS he = (struct refcounted_he*) - PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 - + keylen - + key_offset); + PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 + + keylen + + key_offset); #else he = (struct refcounted_he*) - PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 - + key_offset); + PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 + + key_offset); #endif he->refcounted_he_next = parent; if (is_pv) { - Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char); - he->refcounted_he_val.refcounted_he_u_len = value_len; + Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char); + he->refcounted_he_val.refcounted_he_u_len = value_len; } else if (value_type == HVrhek_IV) { - he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value); + he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value); } else if (value_type == HVrhek_UV) { - he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value); + he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value); } #ifdef USE_ITHREADS @@ -3634,7 +3634,7 @@ of a string/length pair. struct refcounted_he * Perl_refcounted_he_new_pv(pTHX_ struct refcounted_he *parent, - const char *key, U32 hash, SV *value, U32 flags) + const char *key, U32 hash, SV *value, U32 flags) { PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PV; return refcounted_he_new_pvn(parent, key, strlen(key), hash, value, flags); @@ -3651,19 +3651,19 @@ string/length pair. struct refcounted_he * Perl_refcounted_he_new_sv(pTHX_ struct refcounted_he *parent, - SV *key, U32 hash, SV *value, U32 flags) + SV *key, U32 hash, SV *value, U32 flags) { const char *keypv; STRLEN keylen; PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_SV; if (flags & REFCOUNTED_HE_KEY_UTF8) - Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %" UVxf, + (UV)flags); keypv = SvPV_const(key, keylen); if (SvUTF8(key)) - flags |= REFCOUNTED_HE_KEY_UTF8; + flags |= REFCOUNTED_HE_KEY_UTF8; if (!hash && SvIsCOW_shared_hash(key)) - hash = SvSHARED_HASH(key); + hash = SvSHARED_HASH(key); return refcounted_he_new_pvn(parent, keypv, keylen, hash, value, flags); } @@ -3684,23 +3684,23 @@ Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) { PERL_UNUSED_CONTEXT; while (he) { - struct refcounted_he *copy; - U32 new_count; - - HINTS_REFCNT_LOCK; - new_count = --he->refcounted_he_refcnt; - HINTS_REFCNT_UNLOCK; - - if (new_count) { - return; - } + struct refcounted_he *copy; + U32 new_count; + + HINTS_REFCNT_LOCK; + new_count = --he->refcounted_he_refcnt; + HINTS_REFCNT_UNLOCK; + + if (new_count) { + return; + } #ifndef USE_ITHREADS - unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0); + unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0); #endif - copy = he; - he = he->refcounted_he_next; - PerlMemShared_free(copy); + copy = he; + he = he->refcounted_he_next; + PerlMemShared_free(copy); } } @@ -3719,9 +3719,9 @@ Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he) { PERL_UNUSED_CONTEXT; if (he) { - HINTS_REFCNT_LOCK; - he->refcounted_he_refcnt++; - HINTS_REFCNT_UNLOCK; + HINTS_REFCNT_LOCK; + he->refcounted_he_refcnt++; + HINTS_REFCNT_UNLOCK; } return he; } @@ -3752,29 +3752,29 @@ Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) { PERL_UNUSED_CONTEXT; if (!chain) - return NULL; + return NULL; #ifdef USE_ITHREADS if (chain->refcounted_he_keylen != 1) - return NULL; + return NULL; if (*REF_HE_KEY(chain) != ':') - return NULL; + return NULL; #else if ((STRLEN)HEK_LEN(chain->refcounted_he_hek) != 1) - return NULL; + return NULL; if (*HEK_KEY(chain->refcounted_he_hek) != ':') - return NULL; + return NULL; #endif /* Stop anyone trying to really mess us up by adding their own value for ':' into %^H */ if ((chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV - && (chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV_UTF8) - return NULL; + && (chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV_UTF8) + return NULL; if (len) - *len = chain->refcounted_he_val.refcounted_he_u_len; + *len = chain->refcounted_he_val.refcounted_he_u_len; if (flags) { - *flags = ((chain->refcounted_he_data[0] & HVrhek_typemask) - == HVrhek_PV_UTF8) ? SVf_UTF8 : 0; + *flags = ((chain->refcounted_he_data[0] & HVrhek_typemask) + == HVrhek_PV_UTF8) ? SVf_UTF8 : 0; } return chain->refcounted_he_data + 1; } @@ -3791,19 +3791,19 @@ for a UTF-8 label. Any other flag is ignored. void Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len, - U32 flags) + U32 flags) { SV *labelsv; PERL_ARGS_ASSERT_COP_STORE_LABEL; if (flags & ~(SVf_UTF8)) - Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf, + (UV)flags); labelsv = newSVpvn_flags(label, len, SVs_TEMP); if (flags & SVf_UTF8) - SvUTF8_on(labelsv); + SvUTF8_on(labelsv); cop->cop_hints_hash - = refcounted_he_new_pvs(cop->cop_hints_hash, ":", labelsv, 0); + = refcounted_he_new_pvs(cop->cop_hints_hash, ":", labelsv, 0); } /* @@ -3833,47 +3833,47 @@ Perl_hv_assert(pTHX_ HV *hv) (void)hv_iterinit(hv); while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) { - /* sanity check the values */ - if (HeVAL(entry) == &PL_sv_placeholder) - placeholders++; - else - real++; - /* sanity check the keys */ - if (HeSVKEY(entry)) { - NOOP; /* Don't know what to check on SV keys. */ - } else if (HeKUTF8(entry)) { - withflags++; - if (HeKWASUTF8(entry)) { - PerlIO_printf(Perl_debug_log, - "hash key has both WASUTF8 and UTF8: '%.*s'\n", - (int) HeKLEN(entry), HeKEY(entry)); - bad = 1; - } - } else if (HeKWASUTF8(entry)) - withflags++; + /* sanity check the values */ + if (HeVAL(entry) == &PL_sv_placeholder) + placeholders++; + else + real++; + /* sanity check the keys */ + if (HeSVKEY(entry)) { + NOOP; /* Don't know what to check on SV keys. */ + } else if (HeKUTF8(entry)) { + withflags++; + if (HeKWASUTF8(entry)) { + PerlIO_printf(Perl_debug_log, + "hash key has both WASUTF8 and UTF8: '%.*s'\n", + (int) HeKLEN(entry), HeKEY(entry)); + bad = 1; + } + } else if (HeKWASUTF8(entry)) + withflags++; } if (!SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) { - static const char bad_count[] = "Count %d %s(s), but hash reports %d\n"; - const int nhashkeys = HvUSEDKEYS(hv); - const int nhashplaceholders = HvPLACEHOLDERS_get(hv); - - if (nhashkeys != real) { - PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys ); - bad = 1; - } - if (nhashplaceholders != placeholders) { - PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders ); - bad = 1; - } + static const char bad_count[] = "Count %d %s(s), but hash reports %d\n"; + const int nhashkeys = HvUSEDKEYS(hv); + const int nhashplaceholders = HvPLACEHOLDERS_get(hv); + + if (nhashkeys != real) { + PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys ); + bad = 1; + } + if (nhashplaceholders != placeholders) { + PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders ); + bad = 1; + } } if (withflags && ! HvHASKFLAGS(hv)) { - PerlIO_printf(Perl_debug_log, - "Hash has HASKFLAGS off but I count %d key(s) with flags\n", - withflags); - bad = 1; + PerlIO_printf(Perl_debug_log, + "Hash has HASKFLAGS off but I count %d key(s) with flags\n", + withflags); + bad = 1; } if (bad) { - sv_dump(MUTABLE_SV(hv)); + sv_dump(MUTABLE_SV(hv)); } HvRITER_set(hv, riter); /* Restore hash iterator state */ HvEITER_set(hv, eiter); diff --git a/hv.h b/hv.h index 505c28e6f3af..6fbccdd39624 100644 --- a/hv.h +++ b/hv.h @@ -36,8 +36,8 @@ struct he { HE *hent_next; /* next entry in chain */ HEK *hent_hek; /* hash key */ union { - SV *hent_val; /* scalar value that was hashed */ - Size_t hent_refcount; /* references for this shared hash key */ + SV *hent_val; /* scalar value that was hashed */ + Size_t hent_refcount; /* references for this shared hash key */ } he_valu; }; @@ -304,16 +304,16 @@ See L. ) /* This macro may go away without notice. */ #define HvNAME_HEK(hv) \ - (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) + (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvNAME_HEK_NN(hv) : NULL) #define HvNAME_get(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_KEY(HvNAME_HEK_NN(hv)) : NULL) #define HvNAMELEN_get(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_LEN(HvNAME_HEK_NN(hv)) : 0) #define HvNAMEUTF8(hv) \ - ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ - ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) + ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvNAME_HEK_NN(hv)) \ + ? HEK_UTF8(HvNAME_HEK_NN(hv)) : 0) #define HvENAME_HEK_NN(hv) \ ( \ HvAUX(hv)->xhv_name_count > 0 ? HvAUX(hv)->xhv_name_u.xhvnameu_names[0] : \ @@ -322,16 +322,16 @@ See L. HvAUX(hv)->xhv_name_u.xhvnameu_name \ ) #define HvENAME_HEK(hv) \ - (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL) + (SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name ? HvENAME_HEK_NN(hv) : NULL) #define HvENAME_get(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) + ? HEK_KEY(HvENAME_HEK_NN(hv)) : NULL) #define HvENAMELEN_get(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) + ? HEK_LEN(HvENAME_HEK_NN(hv)) : 0) #define HvENAMEUTF8(hv) \ ((SvOOK(hv) && HvAUX(hv)->xhv_name_u.xhvnameu_name && HvAUX(hv)->xhv_name_count != -1) \ - ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) + ? HEK_UTF8(HvENAME_HEK_NN(hv)) : 0) /* the number of keys (including any placeholders) - NOT PART OF THE API */ #define XHvTOTALKEYS(xhv) ((xhv)->xhv_keys) @@ -383,24 +383,24 @@ See L. #define HeVAL(he) (he)->he_valu.hent_val #define HeHASH(he) HEK_HASH(HeKEY_hek(he)) #define HePV(he,lp) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvPV(HeKEY_sv(he),lp) : \ - ((lp = HeKLEN(he)), HeKEY(he))) + SvPV(HeKEY_sv(he),lp) : \ + ((lp = HeKLEN(he)), HeKEY(he))) #define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvUTF8(HeKEY_sv(he)) : \ - (U32)HeKUTF8(he)) + SvUTF8(HeKEY_sv(he)) : \ + (U32)HeKUTF8(he)) #define HeSVKEY(he) ((HeKEY(he) && \ - HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : NULL) + HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : NULL) #define HeSVKEY_force(he) (HeKEY(he) ? \ - ((HeKLEN(he) == HEf_SVKEY) ? \ - HeKEY_sv(he) : \ - newSVpvn_flags(HeKEY(he), \ + ((HeKLEN(he) == HEf_SVKEY) ? \ + HeKEY_sv(he) : \ + newSVpvn_flags(HeKEY(he), \ HeKLEN(he), \ SVs_TEMP | \ ( HeKUTF8(he) ? SVf_UTF8 : 0 ))) : \ - &PL_sv_undef) + &PL_sv_undef) #define HeSVKEY_set(he,sv) ((HeKLEN(he) = HEf_SVKEY), (HeKEY_sv(he) = sv)) #ifndef PERL_CORE @@ -420,8 +420,8 @@ See L. #define HVhek_PLACEHOLD 0x200 /* Internal flag to create placeholder. * (may change, but Storable is a core module) */ #define HVhek_KEYCANONICAL 0x400 /* Internal flag - key is in canonical form. - If the string is UTF-8, it cannot be - converted to bytes. */ + If the string is UTF-8, it cannot be + converted to bytes. */ #define HVhek_MASK 0xFF #define HVhek_ENABLEHVKFLAGS (HVhek_MASK & ~(HVhek_UNSHARED)) @@ -442,9 +442,9 @@ See L. #else # define MALLOC_OVERHEAD 16 # define PERL_HV_ARRAY_ALLOC_BYTES(size) \ - (((size) < 64) \ - ? (size) * sizeof(HE*) \ - : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) + (((size) < 64) \ + ? (size) * sizeof(HE*) \ + : (size) * sizeof(HE*) * 2 - MALLOC_OVERHEAD) #endif /* Flags for hv_iternext_flags. */ @@ -459,33 +459,33 @@ See L. #define share_hek_hek(hek) \ (++(((struct shared_he *)(((char *)hek) \ - - STRUCT_OFFSET(struct shared_he, \ - shared_he_hek))) \ - ->shared_he_he.he_valu.hent_refcount), \ + - STRUCT_OFFSET(struct shared_he, \ + shared_he_hek))) \ + ->shared_he_he.he_valu.hent_refcount), \ hek) #define hv_store_ent(hv, keysv, val, hash) \ ((HE *) hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISSTORE, \ - (val), (hash))) + (val), (hash))) #define hv_exists_ent(hv, keysv, hash) \ cBOOL(hv_common((hv), (keysv), NULL, 0, 0, HV_FETCH_ISEXISTS, 0, (hash))) #define hv_fetch_ent(hv, keysv, lval, hash) \ ((HE *) hv_common((hv), (keysv), NULL, 0, 0, \ - ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) + ((lval) ? HV_FETCH_LVALUE : 0), NULL, (hash))) #define hv_delete_ent(hv, key, flags, hash) \ (MUTABLE_SV(hv_common((hv), (key), NULL, 0, 0, (flags) | HV_DELETE, \ - NULL, (hash)))) + NULL, (hash)))) #define hv_store_flags(hv, key, klen, val, hash, flags) \ ((SV**) hv_common((hv), NULL, (key), (klen), (flags), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ - (hash))) + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), \ + (hash))) #define hv_store(hv, key, klen, val, hash) \ ((SV**) hv_common_key_len((hv), (key), (klen), \ - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ - (val), (hash))) + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \ + (val), (hash))) @@ -494,12 +494,12 @@ See L. #define hv_fetch(hv, key, klen, lval) \ ((SV**) hv_common_key_len((hv), (key), (klen), (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, NULL, 0)) + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, NULL, 0)) #define hv_delete(hv, key, klen, flags) \ (MUTABLE_SV(hv_common_key_len((hv), (key), (klen), \ - (flags) | HV_DELETE, NULL, 0))) + (flags) | HV_DELETE, NULL, 0))) /* Provide 's' suffix subs for constant strings (and avoid needing to count * chars). See STR_WITH_LEN in handy.h - because these are macros we cant use @@ -522,17 +522,17 @@ See L. #ifdef PERL_CORE # define hv_storehek(hv, hek, val) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) + HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) # define hv_fetchhek(hv, hek, lval) \ ((SV **) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (lval) \ - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ - : HV_FETCH_JUST_SV, \ - NULL, HEK_HASH(hek))) + (lval) \ + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, \ + NULL, HEK_HASH(hek))) # define hv_deletehek(hv, hek, flags) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ - (flags)|HV_DELETE, NULL, HEK_HASH(hek)) + (flags)|HV_DELETE, NULL, HEK_HASH(hek)) #endif /* This refcounted he structure is used for storing the hints used for lexical @@ -561,10 +561,10 @@ struct refcounted_he { HEK *refcounted_he_hek; /* hint key */ #endif union { - IV refcounted_he_u_iv; - UV refcounted_he_u_uv; - STRLEN refcounted_he_u_len; - void *refcounted_he_u_ptr; /* Might be useful in future */ + IV refcounted_he_u_iv; + UV refcounted_he_u_uv; + STRLEN refcounted_he_u_len; + void *refcounted_he_u_ptr; /* Might be useful in future */ } refcounted_he_val; U32 refcounted_he_refcnt; /* reference count */ /* First byte is flags. Then NUL-terminated value. Then for ithreads, @@ -610,9 +610,9 @@ instead of a string/length pair, and no precomputed hash. #ifdef USE_ITHREADS /* A big expression to find the key offset */ #define REF_HE_KEY(chain) \ - ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ - ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ - + 1 + chain->refcounted_he_data) + ((((chain->refcounted_he_data[0] & 0x60) == 0x40) \ + ? chain->refcounted_he_val.refcounted_he_u_len + 1 : 0) \ + + 1 + chain->refcounted_he_data) #endif # ifdef USE_ITHREADS diff --git a/inline.h b/inline.h index bed8afa51060..777f9f6743af 100644 --- a/inline.h +++ b/inline.h @@ -72,8 +72,8 @@ Perl_CvGV(pTHX_ CV *sv) PERL_ARGS_ASSERT_CVGV; return CvNAMED(sv) - ? Perl_cvgv_from_hek(aTHX_ sv) - : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv; + ? Perl_cvgv_from_hek(aTHX_ sv) + : ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_gv_u.xcv_gv; } PERL_STATIC_INLINE I32 * @@ -105,13 +105,13 @@ S_strip_spaces(pTHX_ const char * orig, STRLEN * const len) tmpsv = newSVpvn_flags(orig, *len, SVs_TEMP); tmps = SvPVX(tmpsv); while ((*len)--) { - if (!isSPACE(*orig)) - *tmps++ = *orig; - orig++; + if (!isSPACE(*orig)) + *tmps++ = *orig; + orig++; } *tmps = '\0'; *len = tmps - SvPVX(tmpsv); - return SvPVX(tmpsv); + return SvPVX(tmpsv); } #endif @@ -125,12 +125,12 @@ S_MgBYTEPOS(pTHX_ MAGIC *mg, SV *sv, const char *s, STRLEN len) assert(mg->mg_type == PERL_MAGIC_regex_global); assert(mg->mg_len != -1); if (mg->mg_flags & MGf_BYTES || !DO_UTF8(sv)) - return (STRLEN)mg->mg_len; + return (STRLEN)mg->mg_len; else { - const STRLEN pos = (STRLEN)mg->mg_len; - /* Without this check, we may read past the end of the buffer: */ - if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1; - return sv_or_pv_pos_u2b(sv, s, pos, NULL); + const STRLEN pos = (STRLEN)mg->mg_len; + /* Without this check, we may read past the end of the buffer: */ + if (pos > sv_or_pv_len_utf8(sv, s, len)) return len+1; + return sv_or_pv_pos_u2b(sv, s, pos, NULL); } } #endif @@ -147,27 +147,27 @@ S_PadnameIN_SCOPE(const PADNAME * const pn, const U32 seq) * This is complicated by the fact that PL_cop_seqmax * may have wrapped around at some point */ if (COP_SEQ_RANGE_LOW(pn) == PERL_PADSEQ_INTRO) - return FALSE; /* not yet introduced */ + return FALSE; /* not yet introduced */ if (COP_SEQ_RANGE_HIGH(pn) == PERL_PADSEQ_INTRO) { /* in compiling scope */ - if ( - (seq > COP_SEQ_RANGE_LOW(pn)) - ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1)) - : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1)) - ) - return TRUE; + if ( + (seq > COP_SEQ_RANGE_LOW(pn)) + ? (seq - COP_SEQ_RANGE_LOW(pn) < (U32_MAX >> 1)) + : (COP_SEQ_RANGE_LOW(pn) - seq > (U32_MAX >> 1)) + ) + return TRUE; } else if ( - (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn)) - ? - ( seq > COP_SEQ_RANGE_LOW(pn) - || seq <= COP_SEQ_RANGE_HIGH(pn)) + (COP_SEQ_RANGE_LOW(pn) > COP_SEQ_RANGE_HIGH(pn)) + ? + ( seq > COP_SEQ_RANGE_LOW(pn) + || seq <= COP_SEQ_RANGE_HIGH(pn)) - : ( seq > COP_SEQ_RANGE_LOW(pn) - && seq <= COP_SEQ_RANGE_HIGH(pn)) + : ( seq > COP_SEQ_RANGE_LOW(pn) + && seq <= COP_SEQ_RANGE_HIGH(pn)) ) - return TRUE; + return TRUE; return FALSE; } #endif @@ -178,9 +178,9 @@ PERL_STATIC_INLINE I32 Perl_TOPMARK(pTHX) { DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, - "MARK top %p %" IVdf "\n", - PL_markstack_ptr, - (IV)*PL_markstack_ptr))); + "MARK top %p %" IVdf "\n", + PL_markstack_ptr, + (IV)*PL_markstack_ptr))); return *PL_markstack_ptr; } @@ -188,9 +188,9 @@ PERL_STATIC_INLINE I32 Perl_POPMARK(pTHX) { DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, - "MARK pop %p %" IVdf "\n", - (PL_markstack_ptr-1), - (IV)*(PL_markstack_ptr-1)))); + "MARK pop %p %" IVdf "\n", + (PL_markstack_ptr-1), + (IV)*(PL_markstack_ptr-1)))); assert((PL_markstack_ptr > PL_markstack) || !"MARK underflow"); return *PL_markstack_ptr--; } @@ -272,7 +272,7 @@ PERL_STATIC_INLINE SV * Perl_SvREFCNT_inc(SV *sv) { if (LIKELY(sv != NULL)) - SvREFCNT(sv)++; + SvREFCNT(sv)++; return sv; } PERL_STATIC_INLINE SV * @@ -287,17 +287,17 @@ PERL_STATIC_INLINE void Perl_SvREFCNT_inc_void(SV *sv) { if (LIKELY(sv != NULL)) - SvREFCNT(sv)++; + SvREFCNT(sv)++; } PERL_STATIC_INLINE void Perl_SvREFCNT_dec(pTHX_ SV *sv) { if (LIKELY(sv != NULL)) { - U32 rc = SvREFCNT(sv); - if (LIKELY(rc > 1)) - SvREFCNT(sv) = rc - 1; - else - Perl_sv_free2(aTHX_ sv, rc); + U32 rc = SvREFCNT(sv); + if (LIKELY(rc > 1)) + SvREFCNT(sv) = rc - 1; + else + Perl_sv_free2(aTHX_ sv, rc); } } @@ -309,9 +309,9 @@ Perl_SvREFCNT_dec_NN(pTHX_ SV *sv) PERL_ARGS_ASSERT_SVREFCNT_DEC_NN; if (LIKELY(rc > 1)) - SvREFCNT(sv) = rc - 1; + SvREFCNT(sv) = rc - 1; else - Perl_sv_free2(aTHX_ sv, rc); + Perl_sv_free2(aTHX_ sv, rc); } PERL_STATIC_INLINE void @@ -328,7 +328,7 @@ Perl_SvAMAGIC_off(SV *sv) PERL_ARGS_ASSERT_SVAMAGIC_OFF; if (SvROK(sv) && SvOBJECT(SvRV(sv))) - HvAMAGIC_off(SvSTASH(SvRV(sv))); + HvAMAGIC_off(SvSTASH(SvRV(sv))); } PERL_STATIC_INLINE U32 @@ -349,9 +349,9 @@ S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp) { PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B; if (SvGAMAGIC(sv)) { - U8 *hopped = utf8_hop((U8 *)pv, pos); - if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped); - return (STRLEN)(hopped - (U8 *)pv); + U8 *hopped = utf8_hop((U8 *)pv, pos); + if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped); + return (STRLEN)(hopped - (U8 *)pv); } return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN); } @@ -405,7 +405,7 @@ Perl_valid_utf8_to_uvchr(const U8 *s, STRLEN *retlen) /* An invariant is trivially returned */ if (expectlen == 1) { - return uv; + return uv; } /* Remove the leading bits that indicate the number of bytes, leaving just @@ -567,7 +567,7 @@ Perl_is_utf8_invariant_string_loc(const U8* const s, STRLEN len, const U8 ** ep) /* Process per-byte */ while (x < send) { - if (! UTF8_IS_INVARIANT(*x)) { + if (! UTF8_IS_INVARIANT(*x)) { if (ep) { *ep = x; } @@ -742,7 +742,7 @@ S_variant_under_utf8_count(const U8* const s, const U8* const e) /* Process per-byte */ while (x < e) { - if (! UTF8_IS_INVARIANT(*x)) { + if (! UTF8_IS_INVARIANT(*x)) { count++; } @@ -1571,15 +1571,15 @@ Perl_utf8_hop(const U8 *s, SSize_t off) * In other words: in Perl UTF-8 is not just for Unicode. */ if (off >= 0) { - while (off--) - s += UTF8SKIP(s); + while (off--) + s += UTF8SKIP(s); } else { - while (off++) { - s--; - while (UTF8_IS_CONTINUATION(*s)) - s--; - } + while (off++) { + s--; + while (UTF8_IS_CONTINUATION(*s)) + s--; + } } GCC_DIAG_IGNORE(-Wcast-qual) return (U8 *)s; @@ -2063,10 +2063,10 @@ S_get_regex_charset_name(const U32 flags, STRLEN* const lenp) case REGEX_DEPENDS_CHARSET: return DEPENDS_PAT_MODS; case REGEX_LOCALE_CHARSET: return LOCALE_PAT_MODS; case REGEX_UNICODE_CHARSET: return UNICODE_PAT_MODS; - case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS; - case REGEX_ASCII_MORE_RESTRICTED_CHARSET: - *lenp = 2; - return ASCII_MORE_RESTRICT_PAT_MODS; + case REGEX_ASCII_RESTRICTED_CHARSET: return ASCII_RESTRICT_PAT_MODS; + case REGEX_ASCII_MORE_RESTRICTED_CHARSET: + *lenp = 2; + return ASCII_MORE_RESTRICT_PAT_MODS; } /* The NOT_REACHED; hides an assert() which has a rather complex * definition in perl.h. */ @@ -2500,9 +2500,9 @@ Perl_foldEQ(const char *s1, const char *s2, I32 len) assert(len >= 0); while (len--) { - if (*a != *b && *a != PL_fold[*b]) - return 0; - a++,b++; + if (*a != *b && *a != PL_fold[*b]) + return 0; + a++,b++; } return 1; } @@ -2523,10 +2523,10 @@ Perl_foldEQ_latin1(const char *s1, const char *s2, I32 len) assert(len >= 0); while (len--) { - if (*a != *b && *a != PL_fold_latin1[*b]) { - return 0; - } - a++, b++; + if (*a != *b && *a != PL_fold_latin1[*b]) { + return 0; + } + a++, b++; } return 1; } @@ -2552,9 +2552,9 @@ Perl_foldEQ_locale(const char *s1, const char *s2, I32 len) assert(len >= 0); while (len--) { - if (*a != *b && *a != PL_fold_locale[*b]) - return 0; - a++,b++; + if (*a != *b && *a != PL_fold_locale[*b]) + return 0; + a++,b++; } return 1; } diff --git a/intrpvar.h b/intrpvar.h index f16d6dd3bc0e..a9e13d718793 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -36,7 +36,7 @@ PERLVAR(I, stack_base, SV **) PERLVAR(I, stack_max, SV **) PERLVAR(I, savestack, ANY *) /* items that need to be restored when - LEAVEing scopes we've ENTERed */ + LEAVEing scopes we've ENTERed */ PERLVAR(I, savestack_ix, I32) PERLVAR(I, savestack_max, I32) @@ -50,7 +50,7 @@ PERLVARI(I, tmps_floor, SSize_t, -1) PERLVAR(I, tmps_max, SSize_t) /* first unalloced slot in tmps stack */ PERLVAR(I, markstack, I32 *) /* stack_sp locations we're - remembering */ + remembering */ PERLVAR(I, markstack_ptr, I32 *) PERLVAR(I, markstack_max, I32 *) @@ -163,7 +163,7 @@ PERLVAR(I, curcop, COP *) PERLVAR(I, curstack, AV *) /* THE STACK */ PERLVAR(I, curstackinfo, PERL_SI *) /* current stack + context */ PERLVAR(I, mainstack, AV *) /* the stack when nothing funny is - happening */ + happening */ /* memory management */ PERLVAR(I, sv_count, IV) /* how many SV* are currently allocated */ @@ -249,7 +249,7 @@ C macro. */ PERLVAR(I, na, STRLEN) /* for use in SvPV when length is - Not Applicable */ + Not Applicable */ /* stat stuff */ PERLVAR(I, statcache, Stat_t) /* _ */ @@ -318,7 +318,7 @@ PERLVAR(I, efloatbuf, char *) PERLVAR(I, efloatsize, STRLEN) PERLVARI(I, dumpindent, U16, 4) /* number of blanks per dump - indentation level */ + indentation level */ /* =for apidoc_section $embedding @@ -492,7 +492,7 @@ PERLVAR(I, e_script, SV *) PERLVAR(I, basetime, Time_t) /* $^T */ PERLVARI(I, maxsysfd, I32, MAXSYSFD) - /* top fd to pass to subprocesses */ + /* top fd to pass to subprocesses */ PERLVAR(I, statusvalue, I32) /* $? */ #ifdef VMS PERLVAR(I, statusvalue_vms, U32) @@ -612,12 +612,12 @@ PERLVARI(I, laststype, U16, OP_STAT) PERLVARI(I, laststatval, int, -1) PERLVAR(I, modcount, I32) /* how much op_lvalue()ification in - assignment? */ + assignment? */ /* interpreter atexit processing */ PERLVARI(I, exitlistlen, I32, 0) /* length of same */ PERLVARI(I, exitlist, PerlExitListEntry *, NULL) - /* list of exit functions */ + /* list of exit functions */ /* =for apidoc_section $HV @@ -650,7 +650,7 @@ PERLVAR(I, comppad_name_floor, PADOFFSET)/* start of vars in innermost block */ #ifdef HAVE_INTERP_INTERN PERLVAR(I, sys_intern, struct interp_intern) - /* platform internals */ + /* platform internals */ #endif /* more statics moved here */ @@ -713,7 +713,7 @@ PERLVAR(I, min_intro_pending, PADOFFSET)/* start of vars to introduce */ PERLVAR(I, max_intro_pending, PADOFFSET)/* end of vars to introduce */ PERLVAR(I, padix, PADOFFSET) /* lowest unused index - 1 - in current "register" pad */ + in current "register" pad */ PERLVAR(I, constpadix, PADOFFSET) /* lowest unused for constants */ PERLVAR(I, padix_floor, PADOFFSET) /* how low may inner block reset padix */ @@ -736,7 +736,7 @@ PERLVARI(I, strxfrm_is_behaved, bool, TRUE) /* Assume until proven otherwise that it works */ PERLVARI(I, strxfrm_max_cp, U8, 0) /* Highest collating cp in locale */ PERLVARI(I, collation_standard, bool, TRUE) - /* Assume simple collation */ + /* Assume simple collation */ #endif /* USE_LOCALE_COLLATE */ PERLVARI(I, langinfo_buf, char *, NULL) @@ -795,11 +795,11 @@ PERLVAR(I, srand_called, bool) #ifdef USE_LOCALE_NUMERIC PERLVARI(I, numeric_underlying, bool, TRUE) - /* Assume underlying locale numerics */ + /* Assume underlying locale numerics */ PERLVARI(I, numeric_underlying_is_standard, bool, TRUE) PERLVARI(I, numeric_standard, int, TRUE) - /* Assume C locale numerics */ + /* Assume C locale numerics */ PERLVAR(I, numeric_name, char *) /* Name of current numeric locale */ PERLVAR(I, numeric_radix_sv, SV *) /* The radix separator if not '.' */ @@ -838,12 +838,12 @@ PERLVAR(I, body_arenas, void *) /* pointer to list of body-arenas */ #if defined(USE_ITHREADS) PERLVAR(I, regex_pad, SV **) /* Shortcut into the array of - regex_padav */ + regex_padav */ PERLVAR(I, regex_padav, AV *) /* All regex objects, indexed via the - values in op_pmoffset of pmop. - Entry 0 is an SV whose PV is a - "packed" list of IVs listing - the now-free slots in the array */ + values in op_pmoffset of pmop. + Entry 0 is an SV whose PV is a + "packed" list of IVs listing + the now-free slots in the array */ PERLVAR(I, stashpad, HV **) /* for CopSTASH */ PERLVARI(I, stashpadmax, PADOFFSET, 64) PERLVARI(I, stashpadix, PADOFFSET, 0) @@ -864,7 +864,7 @@ PERLVARI(I, def_layerlist, PerlIO_list_t *, NULL) PERLVARI(I, checkav_save, AV *, NULL) /* save CHECK{}s when compiling */ PERLVARI(I, unitcheckav_save, AV *, NULL) - /* save UNITCHECK{}s when compiling */ + /* save UNITCHECK{}s when compiling */ PERLVARI(I, clocktick, long, 0) /* this many times() ticks in a second */ diff --git a/invlist_inline.h b/invlist_inline.h index f6ac81953355..0f24f3d50369 100644 --- a/invlist_inline.h +++ b/invlist_inline.h @@ -145,7 +145,7 @@ S_invlist_highest(SV* const invlist) PERL_ARGS_ASSERT_INVLIST_HIGHEST; if (len == 0) { - return 0; + return 0; } array = invlist_array(invlist); @@ -218,8 +218,8 @@ S_invlist_iternext(SV* invlist, UV* start, UV* end) PERL_ARGS_ASSERT_INVLIST_ITERNEXT; if (*pos >= len) { - *pos = (STRLEN) UV_MAX; /* Force iterinit() to be required next time */ - return FALSE; + *pos = (STRLEN) UV_MAX; /* Force iterinit() to be required next time */ + return FALSE; } array = invlist_array(invlist); @@ -227,10 +227,10 @@ S_invlist_iternext(SV* invlist, UV* start, UV* end) *start = array[(*pos)++]; if (*pos >= len) { - *end = UV_MAX; + *end = UV_MAX; } else { - *end = array[(*pos)++] - 1; + *end = array[(*pos)++] - 1; } return TRUE; diff --git a/iperlsys.h b/iperlsys.h index 28091141e69d..eaa0a9df227f 100644 --- a/iperlsys.h +++ b/iperlsys.h @@ -69,7 +69,7 @@ typedef FILE* (*LPStdin)(struct IPerlStdIO*); typedef FILE* (*LPStdout)(struct IPerlStdIO*); typedef FILE* (*LPStderr)(struct IPerlStdIO*); typedef FILE* (*LPOpen)(struct IPerlStdIO*, const char*, - const char*); + const char*); typedef int (*LPClose)(struct IPerlStdIO*, FILE*); typedef int (*LPEof)(struct IPerlStdIO*, FILE*); typedef int (*LPError)(struct IPerlStdIO*, FILE*); @@ -87,12 +87,12 @@ typedef int (*LPUngetc)(struct IPerlStdIO*, int,FILE*); typedef int (*LPFileno)(struct IPerlStdIO*, FILE*); typedef FILE* (*LPFdopen)(struct IPerlStdIO*, int, const char*); typedef FILE* (*LPReopen)(struct IPerlStdIO*, const char*, - const char*, FILE*); + const char*, FILE*); typedef SSize_t (*LPRead)(struct IPerlStdIO*, void*, Size_t, Size_t, FILE *); typedef SSize_t (*LPWrite)(struct IPerlStdIO*, const void*, Size_t, Size_t, FILE *); typedef void (*LPSetBuf)(struct IPerlStdIO*, FILE*, char*); typedef int (*LPSetVBuf)(struct IPerlStdIO*, FILE*, char*, int, - Size_t); + Size_t); typedef void (*LPSetCnt)(struct IPerlStdIO*, FILE*, int); #ifndef NETWARE @@ -103,16 +103,16 @@ typedef void (*LPSetPtr)(struct IPerlStdIO*, FILE*, STDCHAR*, int); typedef void (*LPSetlinebuf)(struct IPerlStdIO*, FILE*); typedef int (*LPPrintf)(struct IPerlStdIO*, FILE*, const char*, - ...); + ...); typedef int (*LPVprintf)(struct IPerlStdIO*, FILE*, const char*, - va_list); + va_list); typedef Off_t (*LPTell)(struct IPerlStdIO*, FILE*); typedef int (*LPSeek)(struct IPerlStdIO*, FILE*, Off_t, int); typedef void (*LPRewind)(struct IPerlStdIO*, FILE*); typedef FILE* (*LPTmpfile)(struct IPerlStdIO*); typedef int (*LPGetpos)(struct IPerlStdIO*, FILE*, Fpos_t*); typedef int (*LPSetpos)(struct IPerlStdIO*, FILE*, - const Fpos_t*); + const Fpos_t*); typedef void (*LPInit)(struct IPerlStdIO*); typedef void (*LPInitOSExtras)(struct IPerlStdIO*); typedef FILE* (*LPFdupopen)(struct IPerlStdIO*, FILE*); @@ -202,84 +202,84 @@ struct IPerlStdIOInfo /* Now take FILE * via function table */ #define PerlSIO_stdin \ - (*PL_StdIO->pStdin)(PL_StdIO) + (*PL_StdIO->pStdin)(PL_StdIO) #define PerlSIO_stdout \ - (*PL_StdIO->pStdout)(PL_StdIO) + (*PL_StdIO->pStdout)(PL_StdIO) #define PerlSIO_stderr \ - (*PL_StdIO->pStderr)(PL_StdIO) + (*PL_StdIO->pStderr)(PL_StdIO) #define PerlSIO_fopen(x,y) \ - (*PL_StdIO->pOpen)(PL_StdIO, (x),(y)) + (*PL_StdIO->pOpen)(PL_StdIO, (x),(y)) #define PerlSIO_fclose(f) \ - (*PL_StdIO->pClose)(PL_StdIO, (f)) + (*PL_StdIO->pClose)(PL_StdIO, (f)) #define PerlSIO_feof(f) \ - (*PL_StdIO->pEof)(PL_StdIO, (f)) + (*PL_StdIO->pEof)(PL_StdIO, (f)) #define PerlSIO_ferror(f) \ - (*PL_StdIO->pError)(PL_StdIO, (f)) + (*PL_StdIO->pError)(PL_StdIO, (f)) #define PerlSIO_clearerr(f) \ - (*PL_StdIO->pClearerr)(PL_StdIO, (f)) + (*PL_StdIO->pClearerr)(PL_StdIO, (f)) #define PerlSIO_fgetc(f) \ - (*PL_StdIO->pGetc)(PL_StdIO, (f)) + (*PL_StdIO->pGetc)(PL_StdIO, (f)) #define PerlSIO_get_base(f) \ - (*PL_StdIO->pGetBase)(PL_StdIO, (f)) + (*PL_StdIO->pGetBase)(PL_StdIO, (f)) #define PerlSIO_get_bufsiz(f) \ - (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f)) + (*PL_StdIO->pGetBufsiz)(PL_StdIO, (f)) #define PerlSIO_get_cnt(f) \ - (*PL_StdIO->pGetCnt)(PL_StdIO, (f)) + (*PL_StdIO->pGetCnt)(PL_StdIO, (f)) #define PerlSIO_get_ptr(f) \ - (*PL_StdIO->pGetPtr)(PL_StdIO, (f)) + (*PL_StdIO->pGetPtr)(PL_StdIO, (f)) #define PerlSIO_fputc(c,f) \ - (*PL_StdIO->pPutc)(PL_StdIO, (c),(f)) + (*PL_StdIO->pPutc)(PL_StdIO, (c),(f)) #define PerlSIO_fputs(s,f) \ - (*PL_StdIO->pPuts)(PL_StdIO, (s),(f)) + (*PL_StdIO->pPuts)(PL_StdIO, (s),(f)) #define PerlSIO_fflush(f) \ - (*PL_StdIO->pFlush)(PL_StdIO, (f)) + (*PL_StdIO->pFlush)(PL_StdIO, (f)) #define PerlSIO_fgets(s, n, f) \ - (*PL_StdIO->pGets)(PL_StdIO, s, n, (f)) + (*PL_StdIO->pGets)(PL_StdIO, s, n, (f)) #define PerlSIO_ungetc(c,f) \ - (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) + (*PL_StdIO->pUngetc)(PL_StdIO, (c),(f)) #define PerlSIO_fileno(f) \ - (*PL_StdIO->pFileno)(PL_StdIO, (f)) + (*PL_StdIO->pFileno)(PL_StdIO, (f)) #define PerlSIO_fdopen(f, s) \ - (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s)) + (*PL_StdIO->pFdopen)(PL_StdIO, (f),(s)) #define PerlSIO_freopen(p, m, f) \ - (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f)) + (*PL_StdIO->pReopen)(PL_StdIO, (p), (m), (f)) #define PerlSIO_fread(buf,sz,count,f) \ - (*PL_StdIO->pRead)(PL_StdIO, (buf), (sz), (count), (f)) + (*PL_StdIO->pRead)(PL_StdIO, (buf), (sz), (count), (f)) #define PerlSIO_fwrite(buf,sz,count,f) \ - (*PL_StdIO->pWrite)(PL_StdIO, (buf), (sz), (count), (f)) + (*PL_StdIO->pWrite)(PL_StdIO, (buf), (sz), (count), (f)) #define PerlSIO_setbuf(f,b) \ - (*PL_StdIO->pSetBuf)(PL_StdIO, (f), (b)) + (*PL_StdIO->pSetBuf)(PL_StdIO, (f), (b)) #define PerlSIO_setvbuf(f,b,t,s) \ - (*PL_StdIO->pSetVBuf)(PL_StdIO, (f),(b),(t),(s)) + (*PL_StdIO->pSetVBuf)(PL_StdIO, (f),(b),(t),(s)) #define PerlSIO_set_cnt(f,c) \ - (*PL_StdIO->pSetCnt)(PL_StdIO, (f), (c)) + (*PL_StdIO->pSetCnt)(PL_StdIO, (f), (c)) #define PerlSIO_set_ptr(f,p) \ - (*PL_StdIO->pSetPtr)(PL_StdIO, (f), (p)) + (*PL_StdIO->pSetPtr)(PL_StdIO, (f), (p)) #define PerlSIO_setlinebuf(f) \ - (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f)) + (*PL_StdIO->pSetlinebuf)(PL_StdIO, (f)) #define PerlSIO_printf Perl_fprintf_nocontext #define PerlSIO_stdoutf Perl_printf_nocontext #define PerlSIO_vprintf(f,fmt,a) \ - (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a) + (*PL_StdIO->pVprintf)(PL_StdIO, (f),(fmt),a) #define PerlSIO_ftell(f) \ - (*PL_StdIO->pTell)(PL_StdIO, (f)) + (*PL_StdIO->pTell)(PL_StdIO, (f)) #define PerlSIO_fseek(f,o,w) \ - (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w)) + (*PL_StdIO->pSeek)(PL_StdIO, (f),(o),(w)) #define PerlSIO_fgetpos(f,p) \ - (*PL_StdIO->pGetpos)(PL_StdIO, (f),(p)) + (*PL_StdIO->pGetpos)(PL_StdIO, (f),(p)) #define PerlSIO_fsetpos(f,p) \ - (*PL_StdIO->pSetpos)(PL_StdIO, (f),(p)) + (*PL_StdIO->pSetpos)(PL_StdIO, (f),(p)) #define PerlSIO_rewind(f) \ - (*PL_StdIO->pRewind)(PL_StdIO, (f)) + (*PL_StdIO->pRewind)(PL_StdIO, (f)) #define PerlSIO_tmpfile() \ - (*PL_StdIO->pTmpfile)(PL_StdIO) + (*PL_StdIO->pTmpfile)(PL_StdIO) #define PerlSIO_init() \ - (*PL_StdIO->pInit)(PL_StdIO) + (*PL_StdIO->pInit)(PL_StdIO) #undef init_os_extras #define init_os_extras() \ - (*PL_StdIO->pInitOSExtras)(PL_StdIO) + (*PL_StdIO->pInitOSExtras)(PL_StdIO) #define PerlSIO_fdupopen(f) \ - (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) + (*PL_StdIO->pFdupopen)(PL_StdIO, (f)) #else /* PERL_IMPLICIT_SYS */ @@ -408,28 +408,28 @@ struct IPerlDirInfo }; #define PerlDir_mkdir(name, mode) \ - (*PL_Dir->pMakedir)(PL_Dir, (name), (mode)) + (*PL_Dir->pMakedir)(PL_Dir, (name), (mode)) #define PerlDir_chdir(name) \ - (*PL_Dir->pChdir)(PL_Dir, (name)) + (*PL_Dir->pChdir)(PL_Dir, (name)) #define PerlDir_rmdir(name) \ - (*PL_Dir->pRmdir)(PL_Dir, (name)) + (*PL_Dir->pRmdir)(PL_Dir, (name)) #define PerlDir_close(dir) \ - (*PL_Dir->pClose)(PL_Dir, (dir)) + (*PL_Dir->pClose)(PL_Dir, (dir)) #define PerlDir_open(name) \ - (*PL_Dir->pOpen)(PL_Dir, (name)) + (*PL_Dir->pOpen)(PL_Dir, (name)) #define PerlDir_read(dir) \ - (*PL_Dir->pRead)(PL_Dir, (dir)) + (*PL_Dir->pRead)(PL_Dir, (dir)) #define PerlDir_rewind(dir) \ - (*PL_Dir->pRewind)(PL_Dir, (dir)) + (*PL_Dir->pRewind)(PL_Dir, (dir)) #define PerlDir_seek(dir, loc) \ - (*PL_Dir->pSeek)(PL_Dir, (dir), (loc)) + (*PL_Dir->pSeek)(PL_Dir, (dir), (loc)) #define PerlDir_tell(dir) \ - (*PL_Dir->pTell)(PL_Dir, (dir)) + (*PL_Dir->pTell)(PL_Dir, (dir)) #ifdef WIN32 #define PerlDir_mapA(dir) \ - (*PL_Dir->pMapPathA)(PL_Dir, (dir)) + (*PL_Dir->pMapPathA)(PL_Dir, (dir)) #define PerlDir_mapW(dir) \ - (*PL_Dir->pMapPathW)(PL_Dir, (dir)) + (*PL_Dir->pMapPathW)(PL_Dir, (dir)) #endif #else /* PERL_IMPLICIT_SYS */ @@ -466,7 +466,7 @@ struct IPerlEnvInfo; typedef char* (*LPEnvGetenv)(struct IPerlEnv*, const char*); typedef int (*LPEnvPutenv)(struct IPerlEnv*, const char*); typedef char* (*LPEnvGetenv_len)(struct IPerlEnv*, - const char *varname, unsigned long *len); + const char *varname, unsigned long *len); typedef int (*LPEnvUname)(struct IPerlEnv*, struct utsname *name); typedef void (*LPEnvClearenv)(struct IPerlEnv*); typedef void* (*LPEnvGetChildenv)(struct IPerlEnv*); @@ -476,16 +476,16 @@ typedef void (*LPEnvFreeChilddir)(struct IPerlEnv*, char* dir); #ifdef HAS_ENVGETENV typedef char* (*LPENVGetenv)(struct IPerlEnv*, const char *varname); typedef char* (*LPENVGetenv_len)(struct IPerlEnv*, - const char *varname, unsigned long *len); + const char *varname, unsigned long *len); #endif #ifdef WIN32 typedef unsigned long (*LPEnvOsID)(struct IPerlEnv*); typedef char* (*LPEnvLibPath)(struct IPerlEnv*, WIN32_NO_REGISTRY_M_(const char*) - STRLEN *const len); + STRLEN *const len); typedef char* (*LPEnvSiteLibPath)(struct IPerlEnv*, const char*, - STRLEN *const len); + STRLEN *const len); typedef char* (*LPEnvVendorLibPath)(struct IPerlEnv*, const char*, - STRLEN *const len); + STRLEN *const len); typedef void (*LPEnvGetChildIO)(struct IPerlEnv*, child_IO_table*); #endif @@ -520,45 +520,45 @@ struct IPerlEnvInfo }; #define PerlEnv_putenv(str) \ - (*PL_Env->pPutenv)(PL_Env,(str)) + (*PL_Env->pPutenv)(PL_Env,(str)) #define PerlEnv_getenv(str) \ - (*PL_Env->pGetenv)(PL_Env,(str)) + (*PL_Env->pGetenv)(PL_Env,(str)) #define PerlEnv_getenv_len(str,l) \ - (*PL_Env->pGetenv_len)(PL_Env,(str), (l)) + (*PL_Env->pGetenv_len)(PL_Env,(str), (l)) #define PerlEnv_clearenv() \ - (*PL_Env->pClearenv)(PL_Env) + (*PL_Env->pClearenv)(PL_Env) #define PerlEnv_get_childenv() \ - (*PL_Env->pGetChildenv)(PL_Env) + (*PL_Env->pGetChildenv)(PL_Env) #define PerlEnv_free_childenv(e) \ - (*PL_Env->pFreeChildenv)(PL_Env, (e)) + (*PL_Env->pFreeChildenv)(PL_Env, (e)) #define PerlEnv_get_childdir() \ - (*PL_Env->pGetChilddir)(PL_Env) + (*PL_Env->pGetChilddir)(PL_Env) #define PerlEnv_free_childdir(d) \ - (*PL_Env->pFreeChilddir)(PL_Env, (d)) + (*PL_Env->pFreeChilddir)(PL_Env, (d)) #ifdef HAS_ENVGETENV # define PerlEnv_ENVgetenv(str) \ - (*PL_Env->pENVGetenv)(PL_Env,(str)) + (*PL_Env->pENVGetenv)(PL_Env,(str)) # define PerlEnv_ENVgetenv_len(str,l) \ - (*PL_Env->pENVGetenv_len)(PL_Env,(str), (l)) + (*PL_Env->pENVGetenv_len)(PL_Env,(str), (l)) #else # define PerlEnv_ENVgetenv(str) \ - PerlEnv_getenv((str)) + PerlEnv_getenv((str)) # define PerlEnv_ENVgetenv_len(str,l) \ - PerlEnv_getenv_len((str),(l)) + PerlEnv_getenv_len((str),(l)) #endif #define PerlEnv_uname(name) \ - (*PL_Env->pEnvUname)(PL_Env,(name)) + (*PL_Env->pEnvUname)(PL_Env,(name)) #ifdef WIN32 #define PerlEnv_os_id() \ - (*PL_Env->pEnvOsID)(PL_Env) + (*PL_Env->pEnvOsID)(PL_Env) #define PerlEnv_lib_path(str, lenp) \ - (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp)) + (*PL_Env->pLibPath)(PL_Env,WIN32_NO_REGISTRY_M_(str)(lenp)) #define PerlEnv_sitelib_path(str, lenp) \ - (*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp)) + (*PL_Env->pSiteLibPath)(PL_Env,(str),(lenp)) #define PerlEnv_vendorlib_path(str, lenp) \ - (*PL_Env->pVendorLibPath)(PL_Env,(str),(lenp)) + (*PL_Env->pVendorLibPath)(PL_Env,(str),(lenp)) #define PerlEnv_get_child_IO(ptr) \ - (*PL_Env->pGetChildIO)(PL_Env, ptr) + (*PL_Env->pGetChildIO)(PL_Env, ptr) #endif #else /* below is ! PERL_IMPLICIT_SYS */ @@ -620,7 +620,7 @@ struct IPerlLIOInfo; typedef int (*LPLIOAccess)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOChmod)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOChown)(struct IPerlLIO*, const char*, uid_t, - gid_t); + gid_t); typedef int (*LPLIOChsize)(struct IPerlLIO*, int, Off_t); typedef int (*LPLIOClose)(struct IPerlLIO*, int); typedef int (*LPLIODup)(struct IPerlLIO*, int); @@ -628,34 +628,34 @@ typedef int (*LPLIODup2)(struct IPerlLIO*, int, int); typedef int (*LPLIOFlock)(struct IPerlLIO*, int, int); typedef int (*LPLIOFileStat)(struct IPerlLIO*, int, Stat_t*); typedef int (*LPLIOIOCtl)(struct IPerlLIO*, int, unsigned int, - char*); + char*); typedef int (*LPLIOIsatty)(struct IPerlLIO*, int); typedef int (*LPLIOLink)(struct IPerlLIO*, const char*, - const char *); + const char *); typedef Off_t (*LPLIOLseek)(struct IPerlLIO*, int, Off_t, int); typedef int (*LPLIOLstat)(struct IPerlLIO*, const char*, - Stat_t*); + Stat_t*); typedef char* (*LPLIOMktemp)(struct IPerlLIO*, char*); typedef int (*LPLIOOpen)(struct IPerlLIO*, const char*, int); typedef int (*LPLIOOpen3)(struct IPerlLIO*, const char*, int, int); typedef int (*LPLIORead)(struct IPerlLIO*, int, void*, unsigned int); typedef int (*LPLIORename)(struct IPerlLIO*, const char*, - const char*); + const char*); #ifdef NETWARE typedef int (*LPLIOSetmode)(struct IPerlLIO*, FILE*, int); #else typedef int (*LPLIOSetmode)(struct IPerlLIO*, int, int); #endif /* NETWARE */ typedef int (*LPLIONameStat)(struct IPerlLIO*, const char*, - Stat_t*); + Stat_t*); typedef char* (*LPLIOTmpnam)(struct IPerlLIO*, char*); typedef int (*LPLIOUmask)(struct IPerlLIO*, int); typedef int (*LPLIOUnlink)(struct IPerlLIO*, const char*); typedef int (*LPLIOUtime)(struct IPerlLIO*, const char*, struct utimbuf*); typedef int (*LPLIOWrite)(struct IPerlLIO*, int, const void*, - unsigned int); + unsigned int); typedef int (*LPLIOSymLink)(struct IPerlLIO*, const char*, - const char *); + const char *); typedef int (*LPLIOReadLink)(struct IPerlLIO*, const char*, char *, size_t); @@ -698,61 +698,61 @@ struct IPerlLIOInfo }; #define PerlLIO_access(file, mode) \ - (*PL_LIO->pAccess)(PL_LIO, (file), (mode)) + (*PL_LIO->pAccess)(PL_LIO, (file), (mode)) #define PerlLIO_chmod(file, mode) \ - (*PL_LIO->pChmod)(PL_LIO, (file), (mode)) + (*PL_LIO->pChmod)(PL_LIO, (file), (mode)) #define PerlLIO_chown(file, owner, group) \ - (*PL_LIO->pChown)(PL_LIO, (file), (owner), (group)) + (*PL_LIO->pChown)(PL_LIO, (file), (owner), (group)) #define PerlLIO_chsize(fd, size) \ - (*PL_LIO->pChsize)(PL_LIO, (fd), (size)) + (*PL_LIO->pChsize)(PL_LIO, (fd), (size)) #define PerlLIO_close(fd) \ - (*PL_LIO->pClose)(PL_LIO, (fd)) + (*PL_LIO->pClose)(PL_LIO, (fd)) #define PerlLIO_dup(fd) \ - (*PL_LIO->pDup)(PL_LIO, (fd)) + (*PL_LIO->pDup)(PL_LIO, (fd)) #define PerlLIO_dup2(fd1, fd2) \ - (*PL_LIO->pDup2)(PL_LIO, (fd1), (fd2)) + (*PL_LIO->pDup2)(PL_LIO, (fd1), (fd2)) #define PerlLIO_flock(fd, op) \ - (*PL_LIO->pFlock)(PL_LIO, (fd), (op)) + (*PL_LIO->pFlock)(PL_LIO, (fd), (op)) #define PerlLIO_fstat(fd, buf) \ - (*PL_LIO->pFileStat)(PL_LIO, (fd), (buf)) + (*PL_LIO->pFileStat)(PL_LIO, (fd), (buf)) #define PerlLIO_ioctl(fd, u, buf) \ - (*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf)) + (*PL_LIO->pIOCtl)(PL_LIO, (fd), (u), (buf)) #define PerlLIO_isatty(fd) \ - (*PL_LIO->pIsatty)(PL_LIO, (fd)) + (*PL_LIO->pIsatty)(PL_LIO, (fd)) #define PerlLIO_link(oldname, newname) \ - (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) + (*PL_LIO->pLink)(PL_LIO, (oldname), (newname)) #define PerlLIO_symlink(oldname, newname) \ (*PL_LIO->pSymLink)(PL_LIO, (oldname), (newname)) #define PerlLIO_readlink(path, buf, bufsiz) \ (*PL_LIO->pReadLink)(PL_LIO, (path), (buf), (bufsiz)) #define PerlLIO_lseek(fd, offset, mode) \ - (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) + (*PL_LIO->pLseek)(PL_LIO, (fd), (offset), (mode)) #define PerlLIO_lstat(name, buf) \ - (*PL_LIO->pLstat)(PL_LIO, (name), (buf)) + (*PL_LIO->pLstat)(PL_LIO, (name), (buf)) #define PerlLIO_mktemp(file) \ - (*PL_LIO->pMktemp)(PL_LIO, (file)) + (*PL_LIO->pMktemp)(PL_LIO, (file)) #define PerlLIO_open(file, flag) \ - (*PL_LIO->pOpen)(PL_LIO, (file), (flag)) + (*PL_LIO->pOpen)(PL_LIO, (file), (flag)) #define PerlLIO_open3(file, flag, perm) \ - (*PL_LIO->pOpen3)(PL_LIO, (file), (flag), (perm)) + (*PL_LIO->pOpen3)(PL_LIO, (file), (flag), (perm)) #define PerlLIO_read(fd, buf, count) \ - (*PL_LIO->pRead)(PL_LIO, (fd), (buf), (count)) + (*PL_LIO->pRead)(PL_LIO, (fd), (buf), (count)) #define PerlLIO_rename(oname, newname) \ - (*PL_LIO->pRename)(PL_LIO, (oname), (newname)) + (*PL_LIO->pRename)(PL_LIO, (oname), (newname)) #define PerlLIO_setmode(fd, mode) \ - (*PL_LIO->pSetmode)(PL_LIO, (fd), (mode)) + (*PL_LIO->pSetmode)(PL_LIO, (fd), (mode)) #define PerlLIO_stat(name, buf) \ - (*PL_LIO->pNameStat)(PL_LIO, (name), (buf)) + (*PL_LIO->pNameStat)(PL_LIO, (name), (buf)) #define PerlLIO_tmpnam(str) \ - (*PL_LIO->pTmpnam)(PL_LIO, (str)) + (*PL_LIO->pTmpnam)(PL_LIO, (str)) #define PerlLIO_umask(mode) \ - (*PL_LIO->pUmask)(PL_LIO, (mode)) + (*PL_LIO->pUmask)(PL_LIO, (mode)) #define PerlLIO_unlink(file) \ - (*PL_LIO->pUnlink)(PL_LIO, (file)) + (*PL_LIO->pUnlink)(PL_LIO, (file)) #define PerlLIO_utime(file, time) \ - (*PL_LIO->pUtime)(PL_LIO, (file), (time)) + (*PL_LIO->pUtime)(PL_LIO, (file), (time)) #define PerlLIO_write(fd, buf, count) \ - (*PL_LIO->pWrite)(PL_LIO, (fd), (buf), (count)) + (*PL_LIO->pWrite)(PL_LIO, (fd), (buf), (count)) #else /* PERL_IMPLICIT_SYS */ @@ -833,72 +833,72 @@ struct IPerlMemInfo /* Interpreter specific memory macros */ #define PerlMem_malloc(size) \ - (*PL_Mem->pMalloc)(PL_Mem, (size)) + (*PL_Mem->pMalloc)(PL_Mem, (size)) #define PerlMem_realloc(buf, size) \ - (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) + (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) #define PerlMem_free(buf) \ - (*PL_Mem->pFree)(PL_Mem, (buf)) + (*PL_Mem->pFree)(PL_Mem, (buf)) #define PerlMem_calloc(num, size) \ - (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) + (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) #define PerlMem_get_lock() \ - (*PL_Mem->pGetLock)(PL_Mem) + (*PL_Mem->pGetLock)(PL_Mem) #define PerlMem_free_lock() \ - (*PL_Mem->pFreeLock)(PL_Mem) + (*PL_Mem->pFreeLock)(PL_Mem) #define PerlMem_is_locked() \ - (*PL_Mem->pIsLocked)(PL_Mem) + (*PL_Mem->pIsLocked)(PL_Mem) /* Shared memory macros */ #ifdef NETWARE #define PerlMemShared_malloc(size) \ - (*PL_Mem->pMalloc)(PL_Mem, (size)) + (*PL_Mem->pMalloc)(PL_Mem, (size)) #define PerlMemShared_realloc(buf, size) \ - (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) + (*PL_Mem->pRealloc)(PL_Mem, (buf), (size)) #define PerlMemShared_free(buf) \ - (*PL_Mem->pFree)(PL_Mem, (buf)) + (*PL_Mem->pFree)(PL_Mem, (buf)) #define PerlMemShared_calloc(num, size) \ - (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) + (*PL_Mem->pCalloc)(PL_Mem, (num), (size)) #define PerlMemShared_get_lock() \ - (*PL_Mem->pGetLock)(PL_Mem) + (*PL_Mem->pGetLock)(PL_Mem) #define PerlMemShared_free_lock() \ - (*PL_Mem->pFreeLock)(PL_Mem) + (*PL_Mem->pFreeLock)(PL_Mem) #define PerlMemShared_is_locked() \ - (*PL_Mem->pIsLocked)(PL_Mem) + (*PL_Mem->pIsLocked)(PL_Mem) #else #define PerlMemShared_malloc(size) \ - (*PL_MemShared->pMalloc)(PL_MemShared, (size)) + (*PL_MemShared->pMalloc)(PL_MemShared, (size)) #define PerlMemShared_realloc(buf, size) \ - (*PL_MemShared->pRealloc)(PL_MemShared, (buf), (size)) + (*PL_MemShared->pRealloc)(PL_MemShared, (buf), (size)) #define PerlMemShared_free(buf) \ - (*PL_MemShared->pFree)(PL_MemShared, (buf)) + (*PL_MemShared->pFree)(PL_MemShared, (buf)) #define PerlMemShared_calloc(num, size) \ - (*PL_MemShared->pCalloc)(PL_MemShared, (num), (size)) + (*PL_MemShared->pCalloc)(PL_MemShared, (num), (size)) #define PerlMemShared_get_lock() \ - (*PL_MemShared->pGetLock)(PL_MemShared) + (*PL_MemShared->pGetLock)(PL_MemShared) #define PerlMemShared_free_lock() \ - (*PL_MemShared->pFreeLock)(PL_MemShared) + (*PL_MemShared->pFreeLock)(PL_MemShared) #define PerlMemShared_is_locked() \ - (*PL_MemShared->pIsLocked)(PL_MemShared) + (*PL_MemShared->pIsLocked)(PL_MemShared) #endif /* Parse tree memory macros */ #define PerlMemParse_malloc(size) \ - (*PL_MemParse->pMalloc)(PL_MemParse, (size)) + (*PL_MemParse->pMalloc)(PL_MemParse, (size)) #define PerlMemParse_realloc(buf, size) \ - (*PL_MemParse->pRealloc)(PL_MemParse, (buf), (size)) + (*PL_MemParse->pRealloc)(PL_MemParse, (buf), (size)) #define PerlMemParse_free(buf) \ - (*PL_MemParse->pFree)(PL_MemParse, (buf)) + (*PL_MemParse->pFree)(PL_MemParse, (buf)) #define PerlMemParse_calloc(num, size) \ - (*PL_MemParse->pCalloc)(PL_MemParse, (num), (size)) + (*PL_MemParse->pCalloc)(PL_MemParse, (num), (size)) #define PerlMemParse_get_lock() \ - (*PL_MemParse->pGetLock)(PL_MemParse) + (*PL_MemParse->pGetLock)(PL_MemParse) #define PerlMemParse_free_lock() \ - (*PL_MemParse->pFreeLock)(PL_MemParse) + (*PL_MemParse->pFreeLock)(PL_MemParse) #define PerlMemParse_is_locked() \ - (*PL_MemParse->pIsLocked)(PL_MemParse) + (*PL_MemParse->pIsLocked)(PL_MemParse) #else /* PERL_IMPLICIT_SYS */ @@ -948,18 +948,18 @@ struct IPerlProc; struct IPerlProcInfo; typedef void (*LPProcAbort)(struct IPerlProc*); typedef char* (*LPProcCrypt)(struct IPerlProc*, const char*, - const char*); + const char*); typedef void (*LPProcExit)(struct IPerlProc*, int) - __attribute__noreturn__; + __attribute__noreturn__; typedef void (*LPProc_Exit)(struct IPerlProc*, int) - __attribute__noreturn__; + __attribute__noreturn__; typedef int (*LPProcExecl)(struct IPerlProc*, const char*, - const char*, const char*, const char*, - const char*); + const char*, const char*, const char*, + const char*); typedef int (*LPProcExecv)(struct IPerlProc*, const char*, - const char*const*); + const char*const*); typedef int (*LPProcExecvp)(struct IPerlProc*, const char*, - const char*const*); + const char*const*); typedef Uid_t (*LPProcGetuid)(struct IPerlProc*); typedef Uid_t (*LPProcGeteuid)(struct IPerlProc*); typedef Gid_t (*LPProcGetgid)(struct IPerlProc*); @@ -969,9 +969,9 @@ typedef int (*LPProcKill)(struct IPerlProc*, int, int); typedef int (*LPProcKillpg)(struct IPerlProc*, int, int); typedef int (*LPProcPauseProc)(struct IPerlProc*); typedef PerlIO* (*LPProcPopen)(struct IPerlProc*, const char*, - const char*); + const char*); typedef PerlIO* (*LPProcPopenList)(struct IPerlProc*, const char*, - IV narg, SV **args); + IV narg, SV **args); typedef int (*LPProcPclose)(struct IPerlProc*, PerlIO*); typedef int (*LPProcPipe)(struct IPerlProc*, int*); typedef int (*LPProcSetuid)(struct IPerlProc*, uid_t); @@ -986,13 +986,13 @@ typedef int (*LPProcGetpid)(struct IPerlProc*); #ifdef WIN32 typedef void* (*LPProcDynaLoader)(struct IPerlProc*, const char*); typedef void (*LPProcGetOSError)(struct IPerlProc*, - SV* sv, DWORD dwErr); + SV* sv, DWORD dwErr); typedef int (*LPProcSpawnvp)(struct IPerlProc*, int, const char*, - const char*const*); + const char*const*); #endif typedef int (*LPProcLastHost)(struct IPerlProc*); typedef int (*LPProcGetTimeOfDay)(struct IPerlProc*, - struct timeval*, void*); + struct timeval*, void*); struct IPerlProc { @@ -1040,76 +1040,76 @@ struct IPerlProcInfo }; #define PerlProc_abort() \ - (*PL_Proc->pAbort)(PL_Proc) + (*PL_Proc->pAbort)(PL_Proc) #define PerlProc_crypt(c,s) \ - (*PL_Proc->pCrypt)(PL_Proc, (c), (s)) + (*PL_Proc->pCrypt)(PL_Proc, (c), (s)) #define PerlProc_exit(s) \ - (*PL_Proc->pExit)(PL_Proc, (s)) + (*PL_Proc->pExit)(PL_Proc, (s)) #define PerlProc__exit(s) \ - (*PL_Proc->p_Exit)(PL_Proc, (s)) + (*PL_Proc->p_Exit)(PL_Proc, (s)) #define PerlProc_execl(c, w, x, y, z) \ - (*PL_Proc->pExecl)(PL_Proc, (c), (w), (x), (y), (z)) + (*PL_Proc->pExecl)(PL_Proc, (c), (w), (x), (y), (z)) #define PerlProc_execv(c, a) \ - (*PL_Proc->pExecv)(PL_Proc, (c), (a)) + (*PL_Proc->pExecv)(PL_Proc, (c), (a)) #define PerlProc_execvp(c, a) \ - (*PL_Proc->pExecvp)(PL_Proc, (c), (a)) + (*PL_Proc->pExecvp)(PL_Proc, (c), (a)) #define PerlProc_getuid() \ - (*PL_Proc->pGetuid)(PL_Proc) + (*PL_Proc->pGetuid)(PL_Proc) #define PerlProc_geteuid() \ - (*PL_Proc->pGeteuid)(PL_Proc) + (*PL_Proc->pGeteuid)(PL_Proc) #define PerlProc_getgid() \ - (*PL_Proc->pGetgid)(PL_Proc) + (*PL_Proc->pGetgid)(PL_Proc) #define PerlProc_getegid() \ - (*PL_Proc->pGetegid)(PL_Proc) + (*PL_Proc->pGetegid)(PL_Proc) #define PerlProc_getlogin() \ - (*PL_Proc->pGetlogin)(PL_Proc) + (*PL_Proc->pGetlogin)(PL_Proc) #define PerlProc_kill(i, a) \ - (*PL_Proc->pKill)(PL_Proc, (i), (a)) + (*PL_Proc->pKill)(PL_Proc, (i), (a)) #define PerlProc_killpg(i, a) \ - (*PL_Proc->pKillpg)(PL_Proc, (i), (a)) + (*PL_Proc->pKillpg)(PL_Proc, (i), (a)) #define PerlProc_pause() \ - (*PL_Proc->pPauseProc)(PL_Proc) + (*PL_Proc->pPauseProc)(PL_Proc) #define PerlProc_popen(c, m) \ - (*PL_Proc->pPopen)(PL_Proc, (c), (m)) + (*PL_Proc->pPopen)(PL_Proc, (c), (m)) #define PerlProc_popen_list(m, n, a) \ - (*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a)) + (*PL_Proc->pPopenList)(PL_Proc, (m), (n), (a)) #define PerlProc_pclose(f) \ - (*PL_Proc->pPclose)(PL_Proc, (f)) + (*PL_Proc->pPclose)(PL_Proc, (f)) #define PerlProc_pipe(fd) \ - (*PL_Proc->pPipe)(PL_Proc, (fd)) + (*PL_Proc->pPipe)(PL_Proc, (fd)) #define PerlProc_setuid(u) \ - (*PL_Proc->pSetuid)(PL_Proc, (u)) + (*PL_Proc->pSetuid)(PL_Proc, (u)) #define PerlProc_setgid(g) \ - (*PL_Proc->pSetgid)(PL_Proc, (g)) + (*PL_Proc->pSetgid)(PL_Proc, (g)) #define PerlProc_sleep(t) \ - (*PL_Proc->pSleep)(PL_Proc, (t)) + (*PL_Proc->pSleep)(PL_Proc, (t)) #define PerlProc_times(t) \ - (*PL_Proc->pTimes)(PL_Proc, (t)) + (*PL_Proc->pTimes)(PL_Proc, (t)) #define PerlProc_wait(t) \ - (*PL_Proc->pWait)(PL_Proc, (t)) + (*PL_Proc->pWait)(PL_Proc, (t)) #define PerlProc_waitpid(p,s,f) \ - (*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f)) + (*PL_Proc->pWaitpid)(PL_Proc, (p), (s), (f)) #define PerlProc_signal(n, h) \ - (*PL_Proc->pSignal)(PL_Proc, (n), (h)) + (*PL_Proc->pSignal)(PL_Proc, (n), (h)) #define PerlProc_fork() \ - (*PL_Proc->pFork)(PL_Proc) + (*PL_Proc->pFork)(PL_Proc) #define PerlProc_getpid() \ - (*PL_Proc->pGetpid)(PL_Proc) + (*PL_Proc->pGetpid)(PL_Proc) #define PerlProc_setjmp(b, n) Sigsetjmp((b), (n)) #define PerlProc_longjmp(b, n) Siglongjmp((b), (n)) #ifdef WIN32 #define PerlProc_DynaLoad(f) \ - (*PL_Proc->pDynaLoader)(PL_Proc, (f)) + (*PL_Proc->pDynaLoader)(PL_Proc, (f)) #define PerlProc_GetOSError(s,e) \ - (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) + (*PL_Proc->pGetOSError)(PL_Proc, (s), (e)) #define PerlProc_spawnvp(m, c, a) \ - (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) + (*PL_Proc->pSpawnvp)(PL_Proc, (m), (c), (a)) #endif #define PerlProc_lasthost() \ - (*PL_Proc->pLastHost)(PL_Proc) + (*PL_Proc->pLastHost)(PL_Proc) #define PerlProc_gettimeofday(t,z) \ - (*PL_Proc->pGetTimeOfDay)(PL_Proc,(t),(z)) + (*PL_Proc->pGetTimeOfDay)(PL_Proc,(t),(z)) #else /* PERL_IMPLICIT_SYS */ @@ -1118,7 +1118,7 @@ struct IPerlProcInfo #define PerlProc_exit(s) exit((s)) #define PerlProc__exit(s) _exit((s)) #define PerlProc_execl(c,w,x,y,z) \ - execl((c), (w), (x), (y), (z)) + execl((c), (w), (x), (y), (z)) #define PerlProc_execv(c, a) execv((c), (a)) #define PerlProc_execvp(c, a) execvp((c), (a)) #define PerlProc_getuid() getuid() @@ -1148,11 +1148,11 @@ struct IPerlProcInfo #ifdef WIN32 #define PerlProc_DynaLoad(f) \ - win32_dynaload((f)) + win32_dynaload((f)) #define PerlProc_GetOSError(s,e) \ - win32_str_os_error((s), (e)) + win32_str_os_error((s), (e)) #define PerlProc_spawnvp(m, c, a) \ - win32_spawnvp((m), (c), (a)) + win32_spawnvp((m), (c), (a)) #undef PerlProc_signal #define PerlProc_signal(n, h) win32_signal((n), (h)) #endif @@ -1172,20 +1172,20 @@ typedef u_short (*LPHtons)(struct IPerlSock*, u_short); typedef u_long (*LPNtohl)(struct IPerlSock*, u_long); typedef u_short (*LPNtohs)(struct IPerlSock*, u_short); typedef SOCKET (*LPAccept)(struct IPerlSock*, SOCKET, - struct sockaddr*, int*); + struct sockaddr*, int*); typedef int (*LPBind)(struct IPerlSock*, SOCKET, - const struct sockaddr*, int); + const struct sockaddr*, int); typedef int (*LPConnect)(struct IPerlSock*, SOCKET, - const struct sockaddr*, int); + const struct sockaddr*, int); typedef void (*LPEndhostent)(struct IPerlSock*); typedef void (*LPEndnetent)(struct IPerlSock*); typedef void (*LPEndprotoent)(struct IPerlSock*); typedef void (*LPEndservent)(struct IPerlSock*); typedef int (*LPGethostname)(struct IPerlSock*, char*, int); typedef int (*LPGetpeername)(struct IPerlSock*, SOCKET, - struct sockaddr*, int*); + struct sockaddr*, int*); typedef struct hostent* (*LPGethostbyaddr)(struct IPerlSock*, const char*, - int, int); + int, int); typedef struct hostent* (*LPGethostbyname)(struct IPerlSock*, const char*); typedef struct hostent* (*LPGethostent)(struct IPerlSock*); typedef struct netent* (*LPGetnetbyaddr)(struct IPerlSock*, long, int); @@ -1195,36 +1195,36 @@ typedef struct protoent*(*LPGetprotobyname)(struct IPerlSock*, const char*); typedef struct protoent*(*LPGetprotobynumber)(struct IPerlSock*, int); typedef struct protoent*(*LPGetprotoent)(struct IPerlSock*); typedef struct servent* (*LPGetservbyname)(struct IPerlSock*, const char*, - const char*); + const char*); typedef struct servent* (*LPGetservbyport)(struct IPerlSock*, int, - const char*); + const char*); typedef struct servent* (*LPGetservent)(struct IPerlSock*); typedef int (*LPGetsockname)(struct IPerlSock*, SOCKET, - struct sockaddr*, int*); + struct sockaddr*, int*); typedef int (*LPGetsockopt)(struct IPerlSock*, SOCKET, int, int, - char*, int*); + char*, int*); typedef unsigned long (*LPInetAddr)(struct IPerlSock*, const char*); typedef char* (*LPInetNtoa)(struct IPerlSock*, struct in_addr); typedef int (*LPListen)(struct IPerlSock*, SOCKET, int); typedef int (*LPRecv)(struct IPerlSock*, SOCKET, char*, int, int); typedef int (*LPRecvfrom)(struct IPerlSock*, SOCKET, char*, int, - int, struct sockaddr*, int*); + int, struct sockaddr*, int*); typedef int (*LPSelect)(struct IPerlSock*, int, char*, char*, - char*, const struct timeval*); + char*, const struct timeval*); typedef int (*LPSend)(struct IPerlSock*, SOCKET, const char*, int, - int); + int); typedef int (*LPSendto)(struct IPerlSock*, SOCKET, const char*, - int, int, const struct sockaddr*, int); + int, int, const struct sockaddr*, int); typedef void (*LPSethostent)(struct IPerlSock*, int); typedef void (*LPSetnetent)(struct IPerlSock*, int); typedef void (*LPSetprotoent)(struct IPerlSock*, int); typedef void (*LPSetservent)(struct IPerlSock*, int); typedef int (*LPSetsockopt)(struct IPerlSock*, SOCKET, int, int, - const char*, int); + const char*, int); typedef int (*LPShutdown)(struct IPerlSock*, SOCKET, int); typedef SOCKET (*LPSocket)(struct IPerlSock*, int, int, int); typedef int (*LPSocketpair)(struct IPerlSock*, int, int, int, - int*); + int*); #ifdef WIN32 typedef int (*LPClosesocket)(struct IPerlSock*, SOCKET s); #endif @@ -1286,95 +1286,95 @@ struct IPerlSockInfo }; #define PerlSock_htonl(x) \ - (*PL_Sock->pHtonl)(PL_Sock, x) + (*PL_Sock->pHtonl)(PL_Sock, x) #define PerlSock_htons(x) \ - (*PL_Sock->pHtons)(PL_Sock, x) + (*PL_Sock->pHtons)(PL_Sock, x) #define PerlSock_ntohl(x) \ - (*PL_Sock->pNtohl)(PL_Sock, x) + (*PL_Sock->pNtohl)(PL_Sock, x) #define PerlSock_ntohs(x) \ - (*PL_Sock->pNtohs)(PL_Sock, x) + (*PL_Sock->pNtohs)(PL_Sock, x) #define PerlSock_accept(s, a, l) \ - (*PL_Sock->pAccept)(PL_Sock, s, a, l) + (*PL_Sock->pAccept)(PL_Sock, s, a, l) #define PerlSock_bind(s, n, l) \ - (*PL_Sock->pBind)(PL_Sock, s, n, l) + (*PL_Sock->pBind)(PL_Sock, s, n, l) #define PerlSock_connect(s, n, l) \ - (*PL_Sock->pConnect)(PL_Sock, s, n, l) + (*PL_Sock->pConnect)(PL_Sock, s, n, l) #define PerlSock_endhostent() \ - (*PL_Sock->pEndhostent)(PL_Sock) + (*PL_Sock->pEndhostent)(PL_Sock) #define PerlSock_endnetent() \ - (*PL_Sock->pEndnetent)(PL_Sock) + (*PL_Sock->pEndnetent)(PL_Sock) #define PerlSock_endprotoent() \ - (*PL_Sock->pEndprotoent)(PL_Sock) + (*PL_Sock->pEndprotoent)(PL_Sock) #define PerlSock_endservent() \ - (*PL_Sock->pEndservent)(PL_Sock) + (*PL_Sock->pEndservent)(PL_Sock) #define PerlSock_gethostbyaddr(a, l, t) \ - (*PL_Sock->pGethostbyaddr)(PL_Sock, a, l, t) + (*PL_Sock->pGethostbyaddr)(PL_Sock, a, l, t) #define PerlSock_gethostbyname(n) \ - (*PL_Sock->pGethostbyname)(PL_Sock, n) + (*PL_Sock->pGethostbyname)(PL_Sock, n) #define PerlSock_gethostent() \ - (*PL_Sock->pGethostent)(PL_Sock) + (*PL_Sock->pGethostent)(PL_Sock) #define PerlSock_gethostname(n, l) \ - (*PL_Sock->pGethostname)(PL_Sock, n, l) + (*PL_Sock->pGethostname)(PL_Sock, n, l) #define PerlSock_getnetbyaddr(n, t) \ - (*PL_Sock->pGetnetbyaddr)(PL_Sock, n, t) + (*PL_Sock->pGetnetbyaddr)(PL_Sock, n, t) #define PerlSock_getnetbyname(c) \ - (*PL_Sock->pGetnetbyname)(PL_Sock, c) + (*PL_Sock->pGetnetbyname)(PL_Sock, c) #define PerlSock_getnetent() \ - (*PL_Sock->pGetnetent)(PL_Sock) + (*PL_Sock->pGetnetent)(PL_Sock) #define PerlSock_getpeername(s, n, l) \ - (*PL_Sock->pGetpeername)(PL_Sock, s, n, l) + (*PL_Sock->pGetpeername)(PL_Sock, s, n, l) #define PerlSock_getprotobyname(n) \ - (*PL_Sock->pGetprotobyname)(PL_Sock, n) + (*PL_Sock->pGetprotobyname)(PL_Sock, n) #define PerlSock_getprotobynumber(n) \ - (*PL_Sock->pGetprotobynumber)(PL_Sock, n) + (*PL_Sock->pGetprotobynumber)(PL_Sock, n) #define PerlSock_getprotoent() \ - (*PL_Sock->pGetprotoent)(PL_Sock) + (*PL_Sock->pGetprotoent)(PL_Sock) #define PerlSock_getservbyname(n, p) \ - (*PL_Sock->pGetservbyname)(PL_Sock, n, p) + (*PL_Sock->pGetservbyname)(PL_Sock, n, p) #define PerlSock_getservbyport(port, p) \ - (*PL_Sock->pGetservbyport)(PL_Sock, port, p) + (*PL_Sock->pGetservbyport)(PL_Sock, port, p) #define PerlSock_getservent() \ - (*PL_Sock->pGetservent)(PL_Sock) + (*PL_Sock->pGetservent)(PL_Sock) #define PerlSock_getsockname(s, n, l) \ - (*PL_Sock->pGetsockname)(PL_Sock, s, n, l) + (*PL_Sock->pGetsockname)(PL_Sock, s, n, l) #define PerlSock_getsockopt(s,l,n,v,i) \ - (*PL_Sock->pGetsockopt)(PL_Sock, s, l, n, v, i) + (*PL_Sock->pGetsockopt)(PL_Sock, s, l, n, v, i) #define PerlSock_inet_addr(c) \ - (*PL_Sock->pInetAddr)(PL_Sock, c) + (*PL_Sock->pInetAddr)(PL_Sock, c) #define PerlSock_inet_ntoa(i) \ - (*PL_Sock->pInetNtoa)(PL_Sock, i) + (*PL_Sock->pInetNtoa)(PL_Sock, i) #define PerlSock_listen(s, b) \ - (*PL_Sock->pListen)(PL_Sock, s, b) + (*PL_Sock->pListen)(PL_Sock, s, b) #define PerlSock_recv(s, b, l, f) \ - (*PL_Sock->pRecv)(PL_Sock, s, b, l, f) + (*PL_Sock->pRecv)(PL_Sock, s, b, l, f) #define PerlSock_recvfrom(s,b,l,f,from,fromlen) \ - (*PL_Sock->pRecvfrom)(PL_Sock, s, b, l, f, from, fromlen) + (*PL_Sock->pRecvfrom)(PL_Sock, s, b, l, f, from, fromlen) #define PerlSock_select(n, r, w, e, t) \ - (*PL_Sock->pSelect)(PL_Sock, n, (char*)r, (char*)w, (char*)e, t) + (*PL_Sock->pSelect)(PL_Sock, n, (char*)r, (char*)w, (char*)e, t) #define PerlSock_send(s, b, l, f) \ - (*PL_Sock->pSend)(PL_Sock, s, b, l, f) + (*PL_Sock->pSend)(PL_Sock, s, b, l, f) #define PerlSock_sendto(s, b, l, f, t, tlen) \ - (*PL_Sock->pSendto)(PL_Sock, s, b, l, f, t, tlen) + (*PL_Sock->pSendto)(PL_Sock, s, b, l, f, t, tlen) #define PerlSock_sethostent(f) \ - (*PL_Sock->pSethostent)(PL_Sock, f) + (*PL_Sock->pSethostent)(PL_Sock, f) #define PerlSock_setnetent(f) \ - (*PL_Sock->pSetnetent)(PL_Sock, f) + (*PL_Sock->pSetnetent)(PL_Sock, f) #define PerlSock_setprotoent(f) \ - (*PL_Sock->pSetprotoent)(PL_Sock, f) + (*PL_Sock->pSetprotoent)(PL_Sock, f) #define PerlSock_setservent(f) \ - (*PL_Sock->pSetservent)(PL_Sock, f) + (*PL_Sock->pSetservent)(PL_Sock, f) #define PerlSock_setsockopt(s, l, n, v, len) \ - (*PL_Sock->pSetsockopt)(PL_Sock, s, l, n, v, len) + (*PL_Sock->pSetsockopt)(PL_Sock, s, l, n, v, len) #define PerlSock_shutdown(s, h) \ - (*PL_Sock->pShutdown)(PL_Sock, s, h) + (*PL_Sock->pShutdown)(PL_Sock, s, h) #define PerlSock_socket(a, t, p) \ - (*PL_Sock->pSocket)(PL_Sock, a, t, p) + (*PL_Sock->pSocket)(PL_Sock, a, t, p) #define PerlSock_socketpair(a, t, p, f) \ - (*PL_Sock->pSocketpair)(PL_Sock, a, t, p, f) + (*PL_Sock->pSocketpair)(PL_Sock, a, t, p, f) #ifdef WIN32 #define PerlSock_closesocket(s) \ - (*PL_Sock->pClosesocket)(PL_Sock, s) + (*PL_Sock->pClosesocket)(PL_Sock, s) #endif #else /* PERL_IMPLICIT_SYS */ @@ -1416,17 +1416,17 @@ struct IPerlSockInfo #define PerlSock_listen(s, b) listen(s, b) #define PerlSock_recv(s, b, l, f) recv(s, b, l, f) #define PerlSock_recvfrom(s, b, l, f, from, fromlen) \ - recvfrom(s, b, l, f, from, fromlen) + recvfrom(s, b, l, f, from, fromlen) #define PerlSock_select(n, r, w, e, t) select(n, r, w, e, t) #define PerlSock_send(s, b, l, f) send(s, b, l, f) #define PerlSock_sendto(s, b, l, f, t, tlen) \ - sendto(s, b, l, f, t, tlen) + sendto(s, b, l, f, t, tlen) #define PerlSock_sethostent(f) sethostent(f) #define PerlSock_setnetent(f) setnetent(f) #define PerlSock_setprotoent(f) setprotoent(f) #define PerlSock_setservent(f) setservent(f) #define PerlSock_setsockopt(s, l, n, v, len) \ - setsockopt(s, l, n, v, len) + setsockopt(s, l, n, v, len) #define PerlSock_shutdown(s, h) shutdown(s, h) #define PerlSock_socket(a, t, p) socket(a, t, p) #define PerlSock_socketpair(a, t, p, f) socketpair(a, t, p, f) diff --git a/locale.c b/locale.c index ed3cb66767d0..c8ee1b718d78 100644 --- a/locale.c +++ b/locale.c @@ -142,21 +142,21 @@ S_stdize_locale(pTHX_ char *locs) PERL_ARGS_ASSERT_STDIZE_LOCALE; if (s) { - const char * const t = strchr(s, '.'); - okay = FALSE; - if (t) { - const char * const u = strchr(t, '\n'); - if (u && (u[1] == 0)) { - const STRLEN len = u - s; - Move(s + 1, locs, len, char); - locs[len] = 0; - okay = TRUE; - } - } + const char * const t = strchr(s, '.'); + okay = FALSE; + if (t) { + const char * const u = strchr(t, '\n'); + if (u && (u[1] == 0)) { + const STRLEN len = u - s; + Move(s + 1, locs, len, char); + locs[len] = 0; + okay = TRUE; + } + } } if (!okay) - Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs); + Perl_croak(aTHX_ "Can't fix broken locale name \"%s\"", locs); return locs; } @@ -1440,12 +1440,12 @@ S_new_numeric(pTHX_ const char *newnum) char *save_newnum; if (! newnum) { - Safefree(PL_numeric_name); - PL_numeric_name = NULL; - PL_numeric_standard = TRUE; - PL_numeric_underlying = TRUE; - PL_numeric_underlying_is_standard = TRUE; - return; + Safefree(PL_numeric_name); + PL_numeric_name = NULL; + PL_numeric_standard = TRUE; + PL_numeric_underlying = TRUE; + PL_numeric_underlying_is_standard = TRUE; + return; } save_newnum = stdize_locale(savepv(newnum)); @@ -1468,11 +1468,11 @@ S_new_numeric(pTHX_ const char *newnum) /* Save the new name if it isn't the same as the previous one, if any */ if (! PL_numeric_name || strNE(PL_numeric_name, save_newnum)) { - Safefree(PL_numeric_name); - PL_numeric_name = save_newnum; + Safefree(PL_numeric_name); + PL_numeric_name = save_newnum; } else { - Safefree(save_newnum); + Safefree(save_newnum); } PL_numeric_underlying_is_standard = PL_numeric_standard; @@ -1925,27 +1925,27 @@ S_new_collate(pTHX_ const char *newcoll) * an unlikely bug */ if (! newcoll) { - if (PL_collation_name) { - ++PL_collation_ix; - Safefree(PL_collation_name); - PL_collation_name = NULL; - } - PL_collation_standard = TRUE; + if (PL_collation_name) { + ++PL_collation_ix; + Safefree(PL_collation_name); + PL_collation_name = NULL; + } + PL_collation_standard = TRUE; is_standard_collation: - PL_collxfrm_base = 0; - PL_collxfrm_mult = 2; + PL_collxfrm_base = 0; + PL_collxfrm_mult = 2; PL_in_utf8_COLLATE_locale = FALSE; PL_strxfrm_NUL_replacement = '\0'; PL_strxfrm_max_cp = 0; - return; + return; } /* If this is not the same locale as currently, set the new one up */ if (! PL_collation_name || strNE(PL_collation_name, newcoll)) { - ++PL_collation_ix; - Safefree(PL_collation_name); - PL_collation_name = stdize_locale(savepv(newcoll)); - PL_collation_standard = isNAME_C_OR_POSIX(newcoll); + ++PL_collation_ix; + Safefree(PL_collation_name); + PL_collation_name = stdize_locale(savepv(newcoll)); + PL_collation_standard = isNAME_C_OR_POSIX(newcoll); if (PL_collation_standard) { goto is_standard_collation; } @@ -1995,7 +1995,7 @@ S_new_collate(pTHX_ const char *newcoll) * get it right the first time to avoid wasted expensive string * transformations. */ - { + { /* We use the string below to find how long the tranformation of it * is. Almost all locales are supersets of ASCII, or at least the * ASCII letters. We use all of them, half upper half lower, @@ -2111,7 +2111,7 @@ S_new_collate(pTHX_ const char *newcoll) } # endif - } + } } #endif /* USE_LOCALE_COLLATE */ @@ -3367,8 +3367,8 @@ Perl_init_i18nl10n(pTHX_ int printwarn) DEBUG_INITIALIZATION_set(cBOOL(PerlEnv_getenv("PERL_DEBUG_LOCALE_INIT"))); # define DEBUG_LOCALE_INIT(category, locale, result) \ - STMT_START { \ - if (debug_initialization) { \ + STMT_START { \ + if (debug_initialization) { \ PerlIO_printf(Perl_debug_log, \ "%s:%d: %s\n", \ __FILE__, __LINE__, \ @@ -3376,7 +3376,7 @@ Perl_init_i18nl10n(pTHX_ int printwarn) locale, \ result)); \ } \ - } STMT_END + } STMT_END /* Make sure the parallel arrays are properly set up */ # ifdef USE_LOCALE_NUMERIC @@ -3921,10 +3921,10 @@ Perl_init_i18nl10n(pTHX_ int printwarn) This is an alternative to using the -C command line switch (the -C if present will override this). */ { - const char *p = PerlEnv_getenv("PERL_UNICODE"); - PL_unicode = p ? parse_unicode_opts(&p) : 0; - if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG) - PL_utf8cache = -1; + const char *p = PerlEnv_getenv("PERL_UNICODE"); + PL_unicode = p ? parse_unicode_opts(&p) : 0; + if (PL_unicode & PERL_UNICODE_UTF8CACHEASSERT_FLAG) + PL_utf8cache = -1; } # endif @@ -4287,7 +4287,7 @@ Perl__mem_collxfrm(pTHX_ const char *input_string, if (UNLIKELY(! xbuf)) { DEBUG_L(PerlIO_printf(Perl_debug_log, "_mem_collxfrm: Couldn't malloc %zu bytes\n", xAlloc)); - goto bad; + goto bad; } /* Store the collation id */ diff --git a/malloc.c b/malloc.c index 01e84bfc19c4..f24fa248261a 100644 --- a/malloc.c +++ b/malloc.c @@ -149,13 +149,13 @@ # Do not allow configuration of runtime options via $ENV{PERL_MALLOC_OPT} NO_PERL_MALLOC_ENV undef - [The variable consists of ;-separated parts of the form CODE=VALUE - with 1-character codes F, M, f, A, P, G, d, a, c for runtime - configuration of FIRST_SBRK, MIN_SBRK, MIN_SBRK_FRAC1000, - SBRK_ALLOW_FAILURES, SBRK_FAILURE_PRICE, sbrk_goodness, - filldead, fillalive, fillcheck. The last 3 are for DEBUGGING - build, and allow switching the tests for free()ed memory read, - uninit memory reads, and free()ed memory write.] + [The variable consists of ;-separated parts of the form CODE=VALUE + with 1-character codes F, M, f, A, P, G, d, a, c for runtime + configuration of FIRST_SBRK, MIN_SBRK, MIN_SBRK_FRAC1000, + SBRK_ALLOW_FAILURES, SBRK_FAILURE_PRICE, sbrk_goodness, + filldead, fillalive, fillcheck. The last 3 are for DEBUGGING + build, and allow switching the tests for free()ed memory read, + uninit memory reads, and free()ed memory write.] This implementation assumes that calling PerlIO_printf() does not result in any memory allocation calls (used during a panic). @@ -281,14 +281,14 @@ # undef DEBUG_m # define DEBUG_m(a) \ STMT_START { \ - if (PERL_MAYBE_ALIVE && PERL_GET_THX) { \ - dTHX; \ - if (DEBUG_m_TEST) { \ - PL_debug &= ~DEBUG_m_FLAG; \ - a; \ - PL_debug |= DEBUG_m_FLAG; \ - } \ - } \ + if (PERL_MAYBE_ALIVE && PERL_GET_THX) { \ + dTHX; \ + if (DEBUG_m_TEST) { \ + PL_debug &= ~DEBUG_m_FLAG; \ + a; \ + PL_debug |= DEBUG_m_FLAG; \ + } \ + } \ } STMT_END #endif @@ -389,27 +389,27 @@ * plus the range checking words, and the header word MINUS ONE. */ union overhead { - union overhead *ov_next; /* when free */ + union overhead *ov_next; /* when free */ #if MEM_ALIGNBYTES > 4 - double strut; /* alignment problems */ + double strut; /* alignment problems */ # if MEM_ALIGNBYTES > 8 - char sstrut[MEM_ALIGNBYTES]; /* for the sizing */ + char sstrut[MEM_ALIGNBYTES]; /* for the sizing */ # endif #endif - struct { + struct { /* * Keep the ovu_index and ovu_magic in this order, having a char * field first gives alignment indigestion in some systems, such as * MachTen. */ - u_char ovu_index; /* bucket # */ - u_char ovu_magic; /* magic number */ + u_char ovu_index; /* bucket # */ + u_char ovu_magic; /* magic number */ #ifdef RCHECK - /* Subtract one to fit into u_short for an extra bucket */ - u_short ovu_size; /* block size (requested + overhead - 1) */ - u_int ovu_rmagic; /* range magic number */ + /* Subtract one to fit into u_short for an extra bucket */ + u_short ovu_size; /* block size (requested + overhead - 1) */ + u_int ovu_rmagic; /* range magic number */ #endif - } ovu; + } ovu; #define ov_magic ovu.ovu_magic #define ov_index ovu.ovu_index #define ov_size ovu.ovu_size @@ -466,10 +466,10 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = }; # define BUCKET_SIZE_NO_SURPLUS(i) ((i) % 2 ? buck_size[i] : (1 << ((i) >> BUCKET_POW2_SHIFT))) # define BUCKET_SIZE_REAL(i) ((i) <= MAX_BUCKET_BY_TABLE \ - ? ((size_t)buck_size[i]) \ - : ((((size_t)1) << ((i) >> BUCKET_POW2_SHIFT)) \ - - MEM_OVERHEAD(i) \ - + POW2_OPTIMIZE_SURPLUS(i))) + ? ((size_t)buck_size[i]) \ + : ((((size_t)1) << ((i) >> BUCKET_POW2_SHIFT)) \ + - MEM_OVERHEAD(i) \ + + POW2_OPTIMIZE_SURPLUS(i))) #else # define BUCKET_SIZE_NO_SURPLUS(i) (((size_t)1) << ((i) >> BUCKET_POW2_SHIFT)) # define BUCKET_SIZE(i) (BUCKET_SIZE_NO_SURPLUS(i) + POW2_OPTIMIZE_SURPLUS(i)) @@ -602,9 +602,9 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = # define OV_INDEXp(block) (INT2PTR(u_char*,TWOK_MASKED(block))) # define OV_INDEX(block) (*OV_INDEXp(block)) # define OV_MAGIC(block,bucket) (*(OV_INDEXp(block) + \ - (TWOK_SHIFT(block)>> \ - (bucket>>BUCKET_POW2_SHIFT)) + \ - (bucket >= MIN_NEEDS_SHIFT ? 1 : 0))) + (TWOK_SHIFT(block)>> \ + (bucket>>BUCKET_POW2_SHIFT)) + \ + (bucket >= MIN_NEEDS_SHIFT ? 1 : 0))) /* A bucket can have a shift smaller than it size, we need to shift its magic number so it will not overwrite index: */ # ifdef BUCKETS_ROOT2 @@ -618,8 +618,8 @@ static const u_short buck_size[MAX_BUCKET_BY_TABLE + 1] = #ifdef IGNORE_SMALL_BAD_FREE #define FIRST_BUCKET_WITH_CHECK (6 * BUCKETS_PER_POW2) /* 64 */ # define N_BLKS(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \ - ? nBIT_MASK(LOG_OF_MIN_ARENA)/BUCKET_SIZE_NO_SURPLUS(bucket) \ - : n_blks[bucket] ) + ? nBIT_MASK(LOG_OF_MIN_ARENA)/BUCKET_SIZE_NO_SURPLUS(bucket) \ + : n_blks[bucket] ) #else # define N_BLKS(bucket) n_blks[bucket] #endif @@ -640,9 +640,9 @@ static const u_short n_blks[LOG_OF_MIN_ARENA * BUCKETS_PER_POW2] = /* Shift of the first bucket with the given ordinal inside 2K chunk. */ #ifdef IGNORE_SMALL_BAD_FREE # define BLK_SHIFT(bucket) ( (bucket) < FIRST_BUCKET_WITH_CHECK \ - ? ((1<>LOG_OF_MIN_ARENA) + 1)<= BIG_SIZE - && (!emergency_buffer_last_req || - (size < (MEM_SIZE)emergency_buffer_last_req))) { - /* Give the possibility to recover, but avoid an infinite cycle. */ - MALLOC_UNLOCK; - emergency_buffer_last_req = size; - emergency_sbrk_croak("Out of memory during \"large\" request for %" UVuf + && (!emergency_buffer_last_req || + (size < (MEM_SIZE)emergency_buffer_last_req))) { + /* Give the possibility to recover, but avoid an infinite cycle. */ + MALLOC_UNLOCK; + emergency_buffer_last_req = size; + emergency_sbrk_croak("Out of memory during \"large\" request for %" UVuf " bytes, total sbrk() is %" UVuf " bytes", (UV)size, (UV)(goodsbrk + sbrk_slack)); } if ((MEM_SIZE)emergency_buffer_size >= rsize) { - char *old = emergency_buffer; - - emergency_buffer_size -= rsize; - emergency_buffer += rsize; - return old; + char *old = emergency_buffer; + + emergency_buffer_size -= rsize; + emergency_buffer += rsize; + return old; } else { - /* First offense, give a possibility to recover by dieing. */ - /* No malloc involved here: */ - IV Size; - char *pv = GET_EMERGENCY_BUFFER(&Size); - int have = 0; - - if (emergency_buffer_size) { - add_to_chain(emergency_buffer, emergency_buffer_size, 0); - emergency_buffer_size = 0; - emergency_buffer = NULL; - have = 1; - } - - if (!pv) - pv = PERL_GET_EMERGENCY_BUFFER(&Size); - if (!pv) { - if (have) - goto do_croak; - return (char *)-1; /* Now die die die... */ - } - - /* Check alignment: */ - if (PTR2UV(pv) & (NEEDED_ALIGNMENT - 1)) { - dTHX; - - PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n"); - return (char *)-1; /* die die die */ - } - - emergency_buffer = pv; - emergency_buffer_size = Size; + /* First offense, give a possibility to recover by dieing. */ + /* No malloc involved here: */ + IV Size; + char *pv = GET_EMERGENCY_BUFFER(&Size); + int have = 0; + + if (emergency_buffer_size) { + add_to_chain(emergency_buffer, emergency_buffer_size, 0); + emergency_buffer_size = 0; + emergency_buffer = NULL; + have = 1; + } + + if (!pv) + pv = PERL_GET_EMERGENCY_BUFFER(&Size); + if (!pv) { + if (have) + goto do_croak; + return (char *)-1; /* Now die die die... */ + } + + /* Check alignment: */ + if (PTR2UV(pv) & (NEEDED_ALIGNMENT - 1)) { + dTHX; + + PerlIO_puts(PerlIO_stderr(),"Bad alignment of $^M!\n"); + return (char *)-1; /* die die die */ + } + + emergency_buffer = pv; + emergency_buffer_size = Size; } do_croak: MALLOC_UNLOCK; @@ -1066,32 +1066,32 @@ botch(const char *diag, const char *s, const char *file, int line) { dTHX; if (!(PERL_MAYBE_ALIVE && PERL_GET_THX)) - goto do_write; + goto do_write; else { - if (PerlIO_printf(PerlIO_stderr(), - "assertion botched (%s?): %s %s:%d\n", - diag, s, file, line) != 0) { - do_write: /* Can be initializing interpreter */ - MYMALLOC_WRITE2STDERR("assertion botched ("); - MYMALLOC_WRITE2STDERR(diag); - MYMALLOC_WRITE2STDERR("?): "); - MYMALLOC_WRITE2STDERR(s); - MYMALLOC_WRITE2STDERR(" ("); - MYMALLOC_WRITE2STDERR(file); - MYMALLOC_WRITE2STDERR(":"); - { - char linebuf[10]; - char *s = linebuf + sizeof(linebuf) - 1; - int n = line; - *s = 0; - do { - *--s = '0' + (n % 10); - } while (n /= 10); - MYMALLOC_WRITE2STDERR(s); - } - MYMALLOC_WRITE2STDERR(")\n"); - } - PerlProc_abort(); + if (PerlIO_printf(PerlIO_stderr(), + "assertion botched (%s?): %s %s:%d\n", + diag, s, file, line) != 0) { + do_write: /* Can be initializing interpreter */ + MYMALLOC_WRITE2STDERR("assertion botched ("); + MYMALLOC_WRITE2STDERR(diag); + MYMALLOC_WRITE2STDERR("?): "); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" ("); + MYMALLOC_WRITE2STDERR(file); + MYMALLOC_WRITE2STDERR(":"); + { + char linebuf[10]; + char *s = linebuf + sizeof(linebuf) - 1; + int n = line; + *s = 0; + do { + *--s = '0' + (n % 10); + } while (n /= 10); + MYMALLOC_WRITE2STDERR(s); + } + MYMALLOC_WRITE2STDERR(")\n"); + } + PerlProc_abort(); } } #else @@ -1108,19 +1108,19 @@ fill_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) const long lfill = *(long*)fill; if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */ - int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); - unsigned const char *f = fill + sizeof(long) - shift; - unsigned char *e1 = s + shift; + int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); + unsigned const char *f = fill + sizeof(long) - shift; + unsigned char *e1 = s + shift; - while (s < e1) - *s++ = *f++; + while (s < e1) + *s++ = *f++; } lp = (long*)s; while ((unsigned char*)(lp + 1) <= e) - *lp++ = lfill; + *lp++ = lfill; s = (unsigned char*)lp; while (s < e) - *s++ = *fill++; + *s++ = *fill++; } /* Just malloc()ed */ static const unsigned char fill_feedadad[] = @@ -1131,9 +1131,9 @@ static const unsigned char fill_deadbeef[] = {0xDE, 0xAD, 0xBE, 0xEF, 0xDE, 0xAD, 0xBE, 0xEF, 0xDE, 0xAD, 0xBE, 0xEF, 0xDE, 0xAD, 0xBE, 0xEF}; # define FILL_DEADBEEF(s, n) \ - (void)(FILL_DEAD? (fill_pat_4bytes((s), (n), fill_deadbeef), 0) : 0) + (void)(FILL_DEAD? (fill_pat_4bytes((s), (n), fill_deadbeef), 0) : 0) # define FILL_FEEDADAD(s, n) \ - (void)(FILL_ALIVE? (fill_pat_4bytes((s), (n), fill_feedadad), 0) : 0) + (void)(FILL_ALIVE? (fill_pat_4bytes((s), (n), fill_feedadad), 0) : 0) #else # define FILL_DEADBEEF(s, n) ((void)0) # define FILL_FEEDADAD(s, n) ((void)0) @@ -1149,27 +1149,27 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) const long lfill = *(long*)fill; if (PTR2UV(s) & (sizeof(long)-1)) { /* Align the pattern */ - int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); - unsigned const char *f = fill + sizeof(long) - shift; - unsigned char *e1 = s + shift; + int shift = sizeof(long) - (PTR2UV(s) & (sizeof(long)-1)); + unsigned const char *f = fill + sizeof(long) - shift; + unsigned char *e1 = s + shift; - while (s < e1) - if (*s++ != *f++) - return 1; + while (s < e1) + if (*s++ != *f++) + return 1; } lp = (long*)s; while ((unsigned char*)(lp + 1) <= e) - if (*lp++ != lfill) - return 1; + if (*lp++ != lfill) + return 1; s = (unsigned char*)lp; while (s < e) - if (*s++ != *fill++) - return 1; + if (*s++ != *fill++) + return 1; return 0; } # define FILLCHECK_DEADBEEF(s, n) \ - ASSERT(!FILL_CHECK || !cmp_pat_4bytes(s, n, fill_deadbeef), \ - "free()ed/realloc()ed-away memory was overwritten") + ASSERT(!FILL_CHECK || !cmp_pat_4bytes(s, n, fill_deadbeef), \ + "free()ed/realloc()ed-away memory was overwritten") #else # define FILLCHECK_DEADBEEF(s, n) ((void)0) #endif @@ -1177,49 +1177,49 @@ cmp_pat_4bytes(unsigned char *s, size_t nbytes, const unsigned char *fill) STATIC int S_adjust_size_and_find_bucket(size_t *nbytes_p) { - MEM_SIZE shiftr; - int bucket; - size_t nbytes; + MEM_SIZE shiftr; + int bucket; + size_t nbytes; - PERL_ARGS_ASSERT_ADJUST_SIZE_AND_FIND_BUCKET; + PERL_ARGS_ASSERT_ADJUST_SIZE_AND_FIND_BUCKET; - nbytes = *nbytes_p; + nbytes = *nbytes_p; - /* - * Convert amount of memory requested into - * closest block size stored in hash buckets - * which satisfies request. Account for - * space used per block for accounting. - */ + /* + * Convert amount of memory requested into + * closest block size stored in hash buckets + * which satisfies request. Account for + * space used per block for accounting. + */ #ifdef PACK_MALLOC # ifdef SMALL_BUCKET_VIA_TABLE - if (nbytes == 0) - bucket = MIN_BUCKET; - else if (nbytes <= SIZE_TABLE_MAX) { - bucket = bucket_of[(nbytes - 1) >> BUCKET_TABLE_SHIFT]; - } else + if (nbytes == 0) + bucket = MIN_BUCKET; + else if (nbytes <= SIZE_TABLE_MAX) { + bucket = bucket_of[(nbytes - 1) >> BUCKET_TABLE_SHIFT]; + } else # else - if (nbytes == 0) - nbytes = 1; - if (nbytes <= MAX_POW2_ALGO) goto do_shifts; - else + if (nbytes == 0) + nbytes = 1; + if (nbytes <= MAX_POW2_ALGO) goto do_shifts; + else # endif #endif - { - POW2_OPTIMIZE_ADJUST(nbytes); - nbytes += M_OVERHEAD; - nbytes = (nbytes + 3) &~ 3; + { + POW2_OPTIMIZE_ADJUST(nbytes); + nbytes += M_OVERHEAD; + nbytes = (nbytes + 3) &~ 3; #if defined(PACK_MALLOC) && !defined(SMALL_BUCKET_VIA_TABLE) - do_shifts: + do_shifts: #endif - shiftr = (nbytes - 1) >> START_SHIFT; - bucket = START_SHIFTS_BUCKET; - /* apart from this loop, this is O(1) */ - while (shiftr >>= 1) - bucket += BUCKETS_PER_POW2; - } - *nbytes_p = nbytes; - return bucket; + shiftr = (nbytes - 1) >> START_SHIFT; + bucket = START_SHIFTS_BUCKET; + /* apart from this loop, this is O(1) */ + while (shiftr >>= 1) + bucket += BUCKETS_PER_POW2; + } + *nbytes_p = nbytes; + return bucket; } /* @@ -1234,10 +1234,10 @@ These have the same interfaces as the C lib ones, so are considered documented Malloc_t Perl_malloc(size_t nbytes) { - union overhead *p; - int bucket; + union overhead *p; + int bucket; #if defined(DEBUGGING) || defined(RCHECK) - MEM_SIZE size = nbytes; + MEM_SIZE size = nbytes; #endif /* A structure that has more than PTRDIFF_MAX bytes is unfortunately @@ -1253,119 +1253,119 @@ Perl_malloc(size_t nbytes) return NULL; } - BARK_64K_LIMIT("Allocation",nbytes,nbytes); + BARK_64K_LIMIT("Allocation",nbytes,nbytes); #ifdef DEBUGGING - if ((long)nbytes < 0) - croak("%s", "panic: malloc"); + if ((long)nbytes < 0) + croak("%s", "panic: malloc"); #endif - bucket = adjust_size_and_find_bucket(&nbytes); - MALLOC_LOCK; - /* - * If nothing in hash bucket right now, - * request more memory from the system. - */ - if (nextf[bucket] == NULL) - morecore(bucket); - if ((p = nextf[bucket]) == NULL) { - MALLOC_UNLOCK; - { - dTHX; - if (!PL_nomemok) { + bucket = adjust_size_and_find_bucket(&nbytes); + MALLOC_LOCK; + /* + * If nothing in hash bucket right now, + * request more memory from the system. + */ + if (nextf[bucket] == NULL) + morecore(bucket); + if ((p = nextf[bucket]) == NULL) { + MALLOC_UNLOCK; + { + dTHX; + if (!PL_nomemok) { #if defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) - MYMALLOC_WRITE2STDERR("Out of memory!\n"); + MYMALLOC_WRITE2STDERR("Out of memory!\n"); #else - char buff[80]; - char *eb = buff + sizeof(buff) - 1; - char *s = eb; - size_t n = nbytes; + char buff[80]; + char *eb = buff + sizeof(buff) - 1; + char *s = eb; + size_t n = nbytes; - MYMALLOC_WRITE2STDERR("Out of memory during request for "); + MYMALLOC_WRITE2STDERR("Out of memory during request for "); #if defined(DEBUGGING) || defined(RCHECK) - n = size; + n = size; #endif - *s = 0; - do { - *--s = '0' + (n % 10); - } while (n /= 10); - MYMALLOC_WRITE2STDERR(s); - MYMALLOC_WRITE2STDERR(" bytes, total sbrk() is "); - s = eb; - n = goodsbrk + sbrk_slack; - do { - *--s = '0' + (n % 10); - } while (n /= 10); - MYMALLOC_WRITE2STDERR(s); - MYMALLOC_WRITE2STDERR(" bytes!\n"); + *s = 0; + do { + *--s = '0' + (n % 10); + } while (n /= 10); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" bytes, total sbrk() is "); + s = eb; + n = goodsbrk + sbrk_slack; + do { + *--s = '0' + (n % 10); + } while (n /= 10); + MYMALLOC_WRITE2STDERR(s); + MYMALLOC_WRITE2STDERR(" bytes!\n"); #endif /* defined(PLAIN_MALLOC) && defined(NO_FANCY_MALLOC) */ - my_exit(1); - } - } - return (NULL); - } + my_exit(1); + } + } + return (NULL); + } - /* remove from linked list */ + /* remove from linked list */ #ifdef DEBUGGING - if ( (PTR2UV(p) & (MEM_ALIGNBYTES - 1)) - /* Can't get this low */ - || (p && PTR2UV(p) < (1<ov_next) & (MEM_ALIGNBYTES - 1)) - || (p->ov_next && PTR2UV(p->ov_next) < (1<ov_next), PTR2UV(p)); - } + if ( (PTR2UV(p) & (MEM_ALIGNBYTES - 1)) + /* Can't get this low */ + || (p && PTR2UV(p) < (1<ov_next) & (MEM_ALIGNBYTES - 1)) + || (p->ov_next && PTR2UV(p->ov_next) < (1<ov_next), PTR2UV(p)); + } #endif - nextf[bucket] = p->ov_next; + nextf[bucket] = p->ov_next; - MALLOC_UNLOCK; + MALLOC_UNLOCK; - DEBUG_m(PerlIO_printf(Perl_debug_log, - "%p: (%05lu) malloc %ld bytes\n", - (Malloc_t)(p + CHUNK_SHIFT), + DEBUG_m(PerlIO_printf(Perl_debug_log, + "%p: (%05lu) malloc %ld bytes\n", + (Malloc_t)(p + CHUNK_SHIFT), (unsigned long)(PL_an++), - (long)size)); + (long)size)); - FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT), - BUCKET_SIZE_REAL(bucket) + RMAGIC_SZ); + FILLCHECK_DEADBEEF((unsigned char*)(p + CHUNK_SHIFT), + BUCKET_SIZE_REAL(bucket) + RMAGIC_SZ); #ifdef IGNORE_SMALL_BAD_FREE - if (bucket >= FIRST_BUCKET_WITH_CHECK) + if (bucket >= FIRST_BUCKET_WITH_CHECK) #endif - OV_MAGIC(p, bucket) = MAGIC; + OV_MAGIC(p, bucket) = MAGIC; #ifndef PACK_MALLOC - OV_INDEX(p) = bucket; + OV_INDEX(p) = bucket; #endif #ifdef RCHECK - /* - * Record allocated size of block and - * bound space with magic numbers. - */ - p->ov_rmagic = RMAGIC; - if (bucket <= MAX_SHORT_BUCKET) { - int i; - - nbytes = size + M_OVERHEAD; - p->ov_size = nbytes - 1; - if ((i = nbytes & (RMAGIC_SZ-1))) { - i = RMAGIC_SZ - i; - while (i--) /* nbytes - RMAGIC_SZ is end of alloced area */ - ((caddr_t)p + nbytes - RMAGIC_SZ)[i] = RMAGIC_C; - } - /* Same at RMAGIC_SZ-aligned RMAGIC */ - nbytes = (nbytes + RMAGIC_SZ - 1) & ~(RMAGIC_SZ - 1); - ((u_int *)((caddr_t)p + nbytes))[-1] = RMAGIC; - } - FILL_FEEDADAD((unsigned char *)(p + CHUNK_SHIFT), size); + /* + * Record allocated size of block and + * bound space with magic numbers. + */ + p->ov_rmagic = RMAGIC; + if (bucket <= MAX_SHORT_BUCKET) { + int i; + + nbytes = size + M_OVERHEAD; + p->ov_size = nbytes - 1; + if ((i = nbytes & (RMAGIC_SZ-1))) { + i = RMAGIC_SZ - i; + while (i--) /* nbytes - RMAGIC_SZ is end of alloced area */ + ((caddr_t)p + nbytes - RMAGIC_SZ)[i] = RMAGIC_C; + } + /* Same at RMAGIC_SZ-aligned RMAGIC */ + nbytes = (nbytes + RMAGIC_SZ - 1) & ~(RMAGIC_SZ - 1); + ((u_int *)((caddr_t)p + nbytes))[-1] = RMAGIC; + } + FILL_FEEDADAD((unsigned char *)(p + CHUNK_SHIFT), size); #endif - return ((Malloc_t)(p + CHUNK_SHIFT)); + return ((Malloc_t)(p + CHUNK_SHIFT)); } static char *last_sbrk_top; @@ -1393,33 +1393,33 @@ get_from_chain(MEM_SIZE size) long min_remain = LONG_MAX; while (elt) { - if (elt->size >= size) { - long remains = elt->size - size; - if (remains >= 0 && remains < min_remain) { - oldgoodp = oldp; - min_remain = remains; - } - if (remains == 0) { - break; - } - } - oldp = &( elt->next ); - elt = elt->next; + if (elt->size >= size) { + long remains = elt->size - size; + if (remains >= 0 && remains < min_remain) { + oldgoodp = oldp; + min_remain = remains; + } + if (remains == 0) { + break; + } + } + oldp = &( elt->next ); + elt = elt->next; } if (!oldgoodp) return NULL; if (min_remain) { - void *ret = *oldgoodp; - struct chunk_chain_s *next = (*oldgoodp)->next; - - *oldgoodp = (struct chunk_chain_s *)((char*)ret + size); - (*oldgoodp)->size = min_remain; - (*oldgoodp)->next = next; - return ret; + void *ret = *oldgoodp; + struct chunk_chain_s *next = (*oldgoodp)->next; + + *oldgoodp = (struct chunk_chain_s *)((char*)ret + size); + (*oldgoodp)->size = min_remain; + (*oldgoodp)->next = next; + return ret; } else { - void *ret = *oldgoodp; - *oldgoodp = (*oldgoodp)->next; - n_chunks--; - return ret; + void *ret = *oldgoodp; + *oldgoodp = (*oldgoodp)->next; + n_chunks--; + return ret; } } @@ -1442,26 +1442,26 @@ get_from_bigger_buckets(int bucket, MEM_SIZE size) int price = 1; static int bucketprice[NBUCKETS]; while (bucket <= max_bucket) { - /* We postpone stealing from bigger buckets until we want it - often enough. */ - if (nextf[bucket] && bucketprice[bucket]++ >= price) { - /* Steal it! */ - void *ret = (void*)(nextf[bucket] - 1 + CHUNK_SHIFT); - bucketprice[bucket] = 0; - if (((char*)nextf[bucket]) - M_OVERHEAD == last_op) { - last_op = NULL; /* Disable optimization */ - } - nextf[bucket] = nextf[bucket]->ov_next; + /* We postpone stealing from bigger buckets until we want it + often enough. */ + if (nextf[bucket] && bucketprice[bucket]++ >= price) { + /* Steal it! */ + void *ret = (void*)(nextf[bucket] - 1 + CHUNK_SHIFT); + bucketprice[bucket] = 0; + if (((char*)nextf[bucket]) - M_OVERHEAD == last_op) { + last_op = NULL; /* Disable optimization */ + } + nextf[bucket] = nextf[bucket]->ov_next; #ifdef DEBUGGING_MSTATS - nmalloc[bucket]--; - start_slack -= M_OVERHEAD; + nmalloc[bucket]--; + start_slack -= M_OVERHEAD; #endif - add_to_chain(ret, (BUCKET_SIZE_NO_SURPLUS(bucket) + - POW2_OPTIMIZE_SURPLUS(bucket)), - size); - return ret; - } - bucket++; + add_to_chain(ret, (BUCKET_SIZE_NO_SURPLUS(bucket) + + POW2_OPTIMIZE_SURPLUS(bucket)), + size); + return ret; + } + bucket++; } return NULL; } @@ -1477,134 +1477,134 @@ getpages(MEM_SIZE needed, int *nblksp, int bucket) MEM_SIZE slack = 0; if (sbrk_goodness > 0) { - if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) - require = FIRST_SBRK; - else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK; + if (!last_sbrk_top && require < (MEM_SIZE)FIRST_SBRK) + require = FIRST_SBRK; + else if (require < (MEM_SIZE)MIN_SBRK) require = MIN_SBRK; - if (require < (Size_t)(goodsbrk * MIN_SBRK_FRAC1000 / 1000)) - require = goodsbrk * MIN_SBRK_FRAC1000 / 1000; - require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK; + if (require < (Size_t)(goodsbrk * MIN_SBRK_FRAC1000 / 1000)) + require = goodsbrk * MIN_SBRK_FRAC1000 / 1000; + require = ((require - 1 + MIN_SBRK) / MIN_SBRK) * MIN_SBRK; } else { - require = needed; - last_sbrk_top = 0; - sbrked_remains = 0; + require = needed; + last_sbrk_top = 0; + sbrked_remains = 0; } DEBUG_m(PerlIO_printf(Perl_debug_log, - "sbrk(%ld) for %ld-byte-long arena\n", - (long)require, (long) needed)); + "sbrk(%ld) for %ld-byte-long arena\n", + (long)require, (long) needed)); cp = (char *)sbrk(require); #ifdef DEBUGGING_MSTATS sbrks++; #endif if (cp == last_sbrk_top) { - /* Common case, anything is fine. */ - sbrk_goodness++; - ovp = (union overhead *) (cp - sbrked_remains); - last_op = cp - sbrked_remains; - sbrked_remains = require - (needed - sbrked_remains); + /* Common case, anything is fine. */ + sbrk_goodness++; + ovp = (union overhead *) (cp - sbrked_remains); + last_op = cp - sbrked_remains; + sbrked_remains = require - (needed - sbrked_remains); } else if (cp == (char *)-1) { /* no more room! */ - ovp = (union overhead *)emergency_sbrk(needed); - if (ovp == (union overhead *)-1) - return 0; - if (((char*)ovp) > last_op) { /* Cannot happen with current emergency_sbrk() */ - last_op = 0; - } - return ovp; + ovp = (union overhead *)emergency_sbrk(needed); + if (ovp == (union overhead *)-1) + return 0; + if (((char*)ovp) > last_op) { /* Cannot happen with current emergency_sbrk() */ + last_op = 0; + } + return ovp; } else { /* Non-continuous or first sbrk(). */ - long add = sbrked_remains; - char *newcp; - - if (sbrked_remains) { /* Put rest into chain, we - cannot use it right now. */ - add_to_chain((void*)(last_sbrk_top - sbrked_remains), - sbrked_remains, 0); - } - - /* Second, check alignment. */ - slack = 0; - - /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may - improve performance of memory access. */ - if (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */ - slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)); - add += slack; - } - - if (add) { - DEBUG_m(PerlIO_printf(Perl_debug_log, - "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignment,\t%ld were assumed to come from the tail of the previous sbrk\n", - (long)add, (long) slack, - (long) sbrked_remains)); - newcp = (char *)sbrk(add); + long add = sbrked_remains; + char *newcp; + + if (sbrked_remains) { /* Put rest into chain, we + cannot use it right now. */ + add_to_chain((void*)(last_sbrk_top - sbrked_remains), + sbrked_remains, 0); + } + + /* Second, check alignment. */ + slack = 0; + + /* WANTED_ALIGNMENT may be more than NEEDED_ALIGNMENT, but this may + improve performance of memory access. */ + if (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)) { /* Not aligned. */ + slack = WANTED_ALIGNMENT - (PTR2UV(cp) & (WANTED_ALIGNMENT - 1)); + add += slack; + } + + if (add) { + DEBUG_m(PerlIO_printf(Perl_debug_log, + "sbrk(%ld) to fix non-continuous/off-page sbrk:\n\t%ld for alignment,\t%ld were assumed to come from the tail of the previous sbrk\n", + (long)add, (long) slack, + (long) sbrked_remains)); + newcp = (char *)sbrk(add); #if defined(DEBUGGING_MSTATS) - sbrks++; - sbrk_slack += add; + sbrks++; + sbrk_slack += add; #endif - if (newcp != cp + require) { - /* Too bad: even rounding sbrk() is not continuous.*/ - DEBUG_m(PerlIO_printf(Perl_debug_log, - "failed to fix bad sbrk()\n")); + if (newcp != cp + require) { + /* Too bad: even rounding sbrk() is not continuous.*/ + DEBUG_m(PerlIO_printf(Perl_debug_log, + "failed to fix bad sbrk()\n")); #ifdef PACK_MALLOC - if (slack) { - MALLOC_UNLOCK; - fatalcroak("panic: Off-page sbrk\n"); - } + if (slack) { + MALLOC_UNLOCK; + fatalcroak("panic: Off-page sbrk\n"); + } #endif - if (sbrked_remains) { - /* Try again. */ + if (sbrked_remains) { + /* Try again. */ #if defined(DEBUGGING_MSTATS) - sbrk_slack += require; + sbrk_slack += require; #endif - require = needed; - DEBUG_m(PerlIO_printf(Perl_debug_log, - "straight sbrk(%ld)\n", - (long)require)); - cp = (char *)sbrk(require); + require = needed; + DEBUG_m(PerlIO_printf(Perl_debug_log, + "straight sbrk(%ld)\n", + (long)require)); + cp = (char *)sbrk(require); #ifdef DEBUGGING_MSTATS - sbrks++; + sbrks++; #endif - if (cp == (char *)-1) - return 0; - } - sbrk_goodness = -1; /* Disable optimization! - Continue with not-aligned... */ - } else { - cp += slack; - require += sbrked_remains; - } - } - - if (last_sbrk_top) { - sbrk_goodness -= SBRK_FAILURE_PRICE; - } - - ovp = (union overhead *) cp; - /* - * Round up to minimum allocation size boundary - * and deduct from block count to reflect. - */ + if (cp == (char *)-1) + return 0; + } + sbrk_goodness = -1; /* Disable optimization! + Continue with not-aligned... */ + } else { + cp += slack; + require += sbrked_remains; + } + } + + if (last_sbrk_top) { + sbrk_goodness -= SBRK_FAILURE_PRICE; + } + + ovp = (union overhead *) cp; + /* + * Round up to minimum allocation size boundary + * and deduct from block count to reflect. + */ # if NEEDED_ALIGNMENT > MEM_ALIGNBYTES - if (PTR2UV(ovp) & (NEEDED_ALIGNMENT - 1)) - fatalcroak("Misalignment of sbrk()\n"); - else + if (PTR2UV(ovp) & (NEEDED_ALIGNMENT - 1)) + fatalcroak("Misalignment of sbrk()\n"); + else # endif - if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) { - DEBUG_m(PerlIO_printf(Perl_debug_log, - "fixing sbrk(): %d bytes off machine alignment\n", - (int)(PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)))); - ovp = INT2PTR(union overhead *,(PTR2UV(ovp) + MEM_ALIGNBYTES) & - (MEM_ALIGNBYTES - 1)); - (*nblksp)--; + if (PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)) { + DEBUG_m(PerlIO_printf(Perl_debug_log, + "fixing sbrk(): %d bytes off machine alignment\n", + (int)(PTR2UV(ovp) & (MEM_ALIGNBYTES - 1)))); + ovp = INT2PTR(union overhead *,(PTR2UV(ovp) + MEM_ALIGNBYTES) & + (MEM_ALIGNBYTES - 1)); + (*nblksp)--; # if defined(DEBUGGING_MSTATS) - /* This is only approx. if TWO_POT_OPTIMIZE: */ - sbrk_slack += (1 << (bucket >> BUCKET_POW2_SHIFT)); + /* This is only approx. if TWO_POT_OPTIMIZE: */ + sbrk_slack += (1 << (bucket >> BUCKET_POW2_SHIFT)); # endif - } - ; /* Finish "else" */ - sbrked_remains = require - needed; - last_op = cp; + } + ; /* Finish "else" */ + sbrked_remains = require - needed; + last_op = cp; } #if !defined(PLAIN_MALLOC) && !defined(NO_FANCY_MALLOC) emergency_buffer_last_req = 0; @@ -1620,40 +1620,40 @@ static int getpages_adjacent(MEM_SIZE require) { if (require <= sbrked_remains) { - sbrked_remains -= require; + sbrked_remains -= require; } else { - char *cp; + char *cp; - require -= sbrked_remains; - /* We do not try to optimize sbrks here, we go for place. */ - cp = (char*) sbrk(require); + require -= sbrked_remains; + /* We do not try to optimize sbrks here, we go for place. */ + cp = (char*) sbrk(require); #ifdef DEBUGGING_MSTATS - sbrks++; - goodsbrk += require; + sbrks++; + goodsbrk += require; #endif - if (cp == last_sbrk_top) { - sbrked_remains = 0; - last_sbrk_top = cp + require; - } else { - if (cp == (char*)-1) { /* Out of memory */ + if (cp == last_sbrk_top) { + sbrked_remains = 0; + last_sbrk_top = cp + require; + } else { + if (cp == (char*)-1) { /* Out of memory */ #ifdef DEBUGGING_MSTATS - goodsbrk -= require; + goodsbrk -= require; #endif - return 0; - } - /* Report the failure: */ - if (sbrked_remains) - add_to_chain((void*)(last_sbrk_top - sbrked_remains), - sbrked_remains, 0); - add_to_chain((void*)cp, require, 0); - sbrk_goodness -= SBRK_FAILURE_PRICE; - sbrked_remains = 0; - last_sbrk_top = 0; - last_op = 0; - return 0; - } + return 0; + } + /* Report the failure: */ + if (sbrked_remains) + add_to_chain((void*)(last_sbrk_top - sbrked_remains), + sbrked_remains, 0); + add_to_chain((void*)cp, require, 0); + sbrk_goodness -= SBRK_FAILURE_PRICE; + sbrked_remains = 0; + last_sbrk_top = 0; + last_op = 0; + return 0; + } } - + return 1; } @@ -1663,227 +1663,227 @@ getpages_adjacent(MEM_SIZE require) static void morecore(int bucket) { - union overhead *ovp; - int rnu; /* 2^rnu bytes will be requested */ - int nblks; /* become nblks blocks of the desired size */ - MEM_SIZE siz, needed; - static int were_called = 0; - - if (nextf[bucket]) - return; + union overhead *ovp; + int rnu; /* 2^rnu bytes will be requested */ + int nblks; /* become nblks blocks of the desired size */ + MEM_SIZE siz, needed; + static int were_called = 0; + + if (nextf[bucket]) + return; #ifndef NO_PERL_MALLOC_ENV - if (!were_called) { - /* It's our first time. Initialize ourselves */ - were_called = 1; /* Avoid a loop */ - if (!MallocCfg[MallocCfg_skip_cfg_env]) { - char *s = getenv("PERL_MALLOC_OPT"), *t = s; + if (!were_called) { + /* It's our first time. Initialize ourselves */ + were_called = 1; /* Avoid a loop */ + if (!MallocCfg[MallocCfg_skip_cfg_env]) { + char *s = getenv("PERL_MALLOC_OPT"), *t = s; const char *off; - const char *opts = PERL_MALLOC_OPT_CHARS; - int changed = 0; - - while ( t && t[0] && t[1] == '=' - && ((off = strchr(opts, *t))) ) { - IV val = 0; - - t += 2; - while (isDIGIT(*t)) - val = 10*val + *t++ - '0'; - if (!*t || *t == ';') { - if (MallocCfg[off - opts] != val) - changed = 1; - MallocCfg[off - opts] = val; - if (*t) - t++; - } - } - if (t && *t) { - dTHX; - MYMALLOC_WRITE2STDERR("Unrecognized part of PERL_MALLOC_OPT: \""); - MYMALLOC_WRITE2STDERR(t); - MYMALLOC_WRITE2STDERR("\"\n"); - } - if (changed) - MallocCfg[MallocCfg_cfg_env_read] = 1; - } - } + const char *opts = PERL_MALLOC_OPT_CHARS; + int changed = 0; + + while ( t && t[0] && t[1] == '=' + && ((off = strchr(opts, *t))) ) { + IV val = 0; + + t += 2; + while (isDIGIT(*t)) + val = 10*val + *t++ - '0'; + if (!*t || *t == ';') { + if (MallocCfg[off - opts] != val) + changed = 1; + MallocCfg[off - opts] = val; + if (*t) + t++; + } + } + if (t && *t) { + dTHX; + MYMALLOC_WRITE2STDERR("Unrecognized part of PERL_MALLOC_OPT: \""); + MYMALLOC_WRITE2STDERR(t); + MYMALLOC_WRITE2STDERR("\"\n"); + } + if (changed) + MallocCfg[MallocCfg_cfg_env_read] = 1; + } + } #endif - if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) { - MALLOC_UNLOCK; - croak("%s", "Out of memory during ridiculously large request"); - } - if (bucket > max_bucket) - max_bucket = bucket; - - rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT)) - ? LOG_OF_MIN_ARENA - : (bucket >> BUCKET_POW2_SHIFT) ); - /* This may be overwritten later: */ - nblks = 1 << (rnu - (bucket >> BUCKET_POW2_SHIFT)); /* how many blocks to get */ - needed = ((MEM_SIZE)1 << rnu) + POW2_OPTIMIZE_SURPLUS(bucket); - if (nextf[rnu << BUCKET_POW2_SHIFT]) { /* 2048b bucket. */ - ovp = nextf[rnu << BUCKET_POW2_SHIFT] - 1 + CHUNK_SHIFT; - nextf[rnu << BUCKET_POW2_SHIFT] - = nextf[rnu << BUCKET_POW2_SHIFT]->ov_next; + if (bucket == sizeof(MEM_SIZE)*8*BUCKETS_PER_POW2) { + MALLOC_UNLOCK; + croak("%s", "Out of memory during ridiculously large request"); + } + if (bucket > max_bucket) + max_bucket = bucket; + + rnu = ( (bucket <= (LOG_OF_MIN_ARENA << BUCKET_POW2_SHIFT)) + ? LOG_OF_MIN_ARENA + : (bucket >> BUCKET_POW2_SHIFT) ); + /* This may be overwritten later: */ + nblks = 1 << (rnu - (bucket >> BUCKET_POW2_SHIFT)); /* how many blocks to get */ + needed = ((MEM_SIZE)1 << rnu) + POW2_OPTIMIZE_SURPLUS(bucket); + if (nextf[rnu << BUCKET_POW2_SHIFT]) { /* 2048b bucket. */ + ovp = nextf[rnu << BUCKET_POW2_SHIFT] - 1 + CHUNK_SHIFT; + nextf[rnu << BUCKET_POW2_SHIFT] + = nextf[rnu << BUCKET_POW2_SHIFT]->ov_next; #ifdef DEBUGGING_MSTATS - nmalloc[rnu << BUCKET_POW2_SHIFT]--; - start_slack -= M_OVERHEAD; + nmalloc[rnu << BUCKET_POW2_SHIFT]--; + start_slack -= M_OVERHEAD; #endif - DEBUG_m(PerlIO_printf(Perl_debug_log, - "stealing %ld bytes from %ld arena\n", - (long) needed, (long) rnu << BUCKET_POW2_SHIFT)); - } else if (chunk_chain - && (ovp = (union overhead*) get_from_chain(needed))) { - DEBUG_m(PerlIO_printf(Perl_debug_log, - "stealing %ld bytes from chain\n", - (long) needed)); - } else if ( (ovp = (union overhead*) - get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1, - needed)) ) { - DEBUG_m(PerlIO_printf(Perl_debug_log, - "stealing %ld bytes from bigger buckets\n", - (long) needed)); - } else if (needed <= sbrked_remains) { - ovp = (union overhead *)(last_sbrk_top - sbrked_remains); - sbrked_remains -= needed; - last_op = (char*)ovp; - } else - ovp = getpages(needed, &nblks, bucket); - - if (!ovp) - return; - FILL_DEADBEEF((unsigned char*)ovp, needed); - - /* - * Add new memory allocated to that on - * free list for this hash bucket. - */ - siz = BUCKET_SIZE_NO_SURPLUS(bucket); /* No surplus if nblks > 1 */ + DEBUG_m(PerlIO_printf(Perl_debug_log, + "stealing %ld bytes from %ld arena\n", + (long) needed, (long) rnu << BUCKET_POW2_SHIFT)); + } else if (chunk_chain + && (ovp = (union overhead*) get_from_chain(needed))) { + DEBUG_m(PerlIO_printf(Perl_debug_log, + "stealing %ld bytes from chain\n", + (long) needed)); + } else if ( (ovp = (union overhead*) + get_from_bigger_buckets((rnu << BUCKET_POW2_SHIFT) + 1, + needed)) ) { + DEBUG_m(PerlIO_printf(Perl_debug_log, + "stealing %ld bytes from bigger buckets\n", + (long) needed)); + } else if (needed <= sbrked_remains) { + ovp = (union overhead *)(last_sbrk_top - sbrked_remains); + sbrked_remains -= needed; + last_op = (char*)ovp; + } else + ovp = getpages(needed, &nblks, bucket); + + if (!ovp) + return; + FILL_DEADBEEF((unsigned char*)ovp, needed); + + /* + * Add new memory allocated to that on + * free list for this hash bucket. + */ + siz = BUCKET_SIZE_NO_SURPLUS(bucket); /* No surplus if nblks > 1 */ #ifdef PACK_MALLOC - *(u_char*)ovp = bucket; /* Fill index. */ - if (bucket <= MAX_PACKED) { - ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket)); - nblks = N_BLKS(bucket); + *(u_char*)ovp = bucket; /* Fill index. */ + if (bucket <= MAX_PACKED) { + ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket)); + nblks = N_BLKS(bucket); # ifdef DEBUGGING_MSTATS - start_slack += BLK_SHIFT(bucket); + start_slack += BLK_SHIFT(bucket); # endif - } else if (bucket < LOG_OF_MIN_ARENA * BUCKETS_PER_POW2) { - ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket)); - siz -= sizeof(union overhead); - } else ovp++; /* One chunk per block. */ + } else if (bucket < LOG_OF_MIN_ARENA * BUCKETS_PER_POW2) { + ovp = (union overhead *) ((char*)ovp + BLK_SHIFT(bucket)); + siz -= sizeof(union overhead); + } else ovp++; /* One chunk per block. */ #endif /* PACK_MALLOC */ - nextf[bucket] = ovp; + nextf[bucket] = ovp; #ifdef DEBUGGING_MSTATS - nmalloc[bucket] += nblks; - if (bucket > MAX_PACKED) { - start_slack += M_OVERHEAD * nblks; - } + nmalloc[bucket] += nblks; + if (bucket > MAX_PACKED) { + start_slack += M_OVERHEAD * nblks; + } #endif - while (--nblks > 0) { - ovp->ov_next = (union overhead *)((caddr_t)ovp + siz); - ovp = (union overhead *)((caddr_t)ovp + siz); - } - /* Not all sbrks return zeroed memory.*/ - ovp->ov_next = (union overhead *)NULL; + while (--nblks > 0) { + ovp->ov_next = (union overhead *)((caddr_t)ovp + siz); + ovp = (union overhead *)((caddr_t)ovp + siz); + } + /* Not all sbrks return zeroed memory.*/ + ovp->ov_next = (union overhead *)NULL; #ifdef PACK_MALLOC - if (bucket == 7*BUCKETS_PER_POW2) { /* Special case, explanation is above. */ - union overhead *n_op = nextf[7*BUCKETS_PER_POW2]->ov_next; - nextf[7*BUCKETS_PER_POW2] = - (union overhead *)((caddr_t)nextf[7*BUCKETS_PER_POW2] - - sizeof(union overhead)); - nextf[7*BUCKETS_PER_POW2]->ov_next = n_op; - } + if (bucket == 7*BUCKETS_PER_POW2) { /* Special case, explanation is above. */ + union overhead *n_op = nextf[7*BUCKETS_PER_POW2]->ov_next; + nextf[7*BUCKETS_PER_POW2] = + (union overhead *)((caddr_t)nextf[7*BUCKETS_PER_POW2] + - sizeof(union overhead)); + nextf[7*BUCKETS_PER_POW2]->ov_next = n_op; + } #endif /* !PACK_MALLOC */ } Free_t Perl_mfree(Malloc_t where) { - MEM_SIZE size; - union overhead *ovp; - char *cp = (char*)where; + MEM_SIZE size; + union overhead *ovp; + char *cp = (char*)where; #ifdef PACK_MALLOC - u_char bucket; + u_char bucket; #endif - DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%" UVxf ": (%05lu) free\n", - PTR2UV(cp), (unsigned long)(PL_an++))); + DEBUG_m(PerlIO_printf(Perl_debug_log, + "0x%" UVxf ": (%05lu) free\n", + PTR2UV(cp), (unsigned long)(PL_an++))); - if (cp == NULL) - return; + if (cp == NULL) + return; #ifdef DEBUGGING - if (PTR2UV(cp) & (MEM_ALIGNBYTES - 1)) - croak("%s", "wrong alignment in free()"); + if (PTR2UV(cp) & (MEM_ALIGNBYTES - 1)) + croak("%s", "wrong alignment in free()"); #endif - ovp = (union overhead *)((caddr_t)cp - - sizeof (union overhead) * CHUNK_SHIFT); + ovp = (union overhead *)((caddr_t)cp + - sizeof (union overhead) * CHUNK_SHIFT); #ifdef PACK_MALLOC - bucket = OV_INDEX(ovp); + bucket = OV_INDEX(ovp); #endif #ifdef IGNORE_SMALL_BAD_FREE - if ((bucket >= FIRST_BUCKET_WITH_CHECK) - && (OV_MAGIC(ovp, bucket) != MAGIC)) + if ((bucket >= FIRST_BUCKET_WITH_CHECK) + && (OV_MAGIC(ovp, bucket) != MAGIC)) #else - if (OV_MAGIC(ovp, bucket) != MAGIC) + if (OV_MAGIC(ovp, bucket) != MAGIC) #endif - { - static int bad_free_warn = -1; - if (bad_free_warn == -1) { - dTHX; - char *pbf = PerlEnv_getenv("PERL_BADFREE"); - bad_free_warn = (pbf) ? strNE("0", pbf) : 1; - } - if (!bad_free_warn) - return; + { + static int bad_free_warn = -1; + if (bad_free_warn == -1) { + dTHX; + char *pbf = PerlEnv_getenv("PERL_BADFREE"); + bad_free_warn = (pbf) ? strNE("0", pbf) : 1; + } + if (!bad_free_warn) + return; #ifdef RCHECK - { - dTHX; - if (!PERL_IS_ALIVE || !PL_curcop) - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)", - ovp->ov_rmagic == RMAGIC - 1 ? - "Duplicate" : "Bad"); - } + { + dTHX; + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s free() ignored (RMAGIC, PERL_CORE)", + ovp->ov_rmagic == RMAGIC - 1 ? + "Duplicate" : "Bad"); + } #else - { - dTHX; - if (!PERL_IS_ALIVE || !PL_curcop) - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)"); - } + { + dTHX; + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", "Bad free() ignored (PERL_CORE)"); + } #endif - return; /* sanity */ - } + return; /* sanity */ + } #ifdef RCHECK - ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite"); - if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { - int i; - MEM_SIZE nbytes = ovp->ov_size + 1; - - if ((i = nbytes & (RMAGIC_SZ-1))) { - i = RMAGIC_SZ - i; - while (i--) { /* nbytes - RMAGIC_SZ is end of alloced area */ - ASSERT(((caddr_t)ovp + nbytes - RMAGIC_SZ)[i] == RMAGIC_C, - "chunk's tail overwrite"); - } - } - /* Same at RMAGIC_SZ-aligned RMAGIC */ - nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1); - ASSERT(((u_int *)((caddr_t)ovp + nbytes))[-1] == RMAGIC, - "chunk's tail overwrite"); - FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes), - BUCKET_SIZE(OV_INDEX(ovp)) - nbytes); - } - FILL_DEADBEEF((unsigned char*)(ovp+CHUNK_SHIFT), - BUCKET_SIZE_REAL(OV_INDEX(ovp)) + RMAGIC_SZ); - ovp->ov_rmagic = RMAGIC - 1; + ASSERT(ovp->ov_rmagic == RMAGIC, "chunk's head overwrite"); + if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { + int i; + MEM_SIZE nbytes = ovp->ov_size + 1; + + if ((i = nbytes & (RMAGIC_SZ-1))) { + i = RMAGIC_SZ - i; + while (i--) { /* nbytes - RMAGIC_SZ is end of alloced area */ + ASSERT(((caddr_t)ovp + nbytes - RMAGIC_SZ)[i] == RMAGIC_C, + "chunk's tail overwrite"); + } + } + /* Same at RMAGIC_SZ-aligned RMAGIC */ + nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1); + ASSERT(((u_int *)((caddr_t)ovp + nbytes))[-1] == RMAGIC, + "chunk's tail overwrite"); + FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nbytes), + BUCKET_SIZE(OV_INDEX(ovp)) - nbytes); + } + FILL_DEADBEEF((unsigned char*)(ovp+CHUNK_SHIFT), + BUCKET_SIZE_REAL(OV_INDEX(ovp)) + RMAGIC_SZ); + ovp->ov_rmagic = RMAGIC - 1; #endif - ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite"); - size = OV_INDEX(ovp); + ASSERT(OV_INDEX(ovp) < NBUCKETS, "chunk's head overwrite"); + size = OV_INDEX(ovp); - MALLOC_LOCK; - ovp->ov_next = nextf[size]; - nextf[size] = ovp; - MALLOC_UNLOCK; + MALLOC_LOCK; + ovp->ov_next = nextf[size]; + nextf[size] = ovp; + MALLOC_UNLOCK; } /* There is no need to do any locking in realloc (with an exception of @@ -1894,193 +1894,193 @@ Perl_mfree(Malloc_t where) Malloc_t Perl_realloc(void *mp, size_t nbytes) { - MEM_SIZE onb; - union overhead *ovp; - char *res; - int prev_bucket; - int bucket; - int incr; /* 1 if does not fit, -1 if "easily" fits in a - smaller bucket, otherwise 0. */ - char *cp = (char*)mp; + MEM_SIZE onb; + union overhead *ovp; + char *res; + int prev_bucket; + int bucket; + int incr; /* 1 if does not fit, -1 if "easily" fits in a + smaller bucket, otherwise 0. */ + char *cp = (char*)mp; #ifdef DEBUGGING - MEM_SIZE size = nbytes; + MEM_SIZE size = nbytes; - if ((long)nbytes < 0) - croak("%s", "panic: realloc"); + if ((long)nbytes < 0) + croak("%s", "panic: realloc"); #endif - BARK_64K_LIMIT("Reallocation",nbytes,size); - if (!cp) - return Perl_malloc(nbytes); + BARK_64K_LIMIT("Reallocation",nbytes,size); + if (!cp) + return Perl_malloc(nbytes); - ovp = (union overhead *)((caddr_t)cp - - sizeof (union overhead) * CHUNK_SHIFT); - bucket = OV_INDEX(ovp); + ovp = (union overhead *)((caddr_t)cp + - sizeof (union overhead) * CHUNK_SHIFT); + bucket = OV_INDEX(ovp); #ifdef IGNORE_SMALL_BAD_FREE - if ((bucket >= FIRST_BUCKET_WITH_CHECK) - && (OV_MAGIC(ovp, bucket) != MAGIC)) + if ((bucket >= FIRST_BUCKET_WITH_CHECK) + && (OV_MAGIC(ovp, bucket) != MAGIC)) #else - if (OV_MAGIC(ovp, bucket) != MAGIC) + if (OV_MAGIC(ovp, bucket) != MAGIC) #endif - { - static int bad_free_warn = -1; - if (bad_free_warn == -1) { - dTHX; - char *pbf = PerlEnv_getenv("PERL_BADFREE"); - bad_free_warn = (pbf) ? strNE("0", pbf) : 1; - } - if (!bad_free_warn) - return NULL; + { + static int bad_free_warn = -1; + if (bad_free_warn == -1) { + dTHX; + char *pbf = PerlEnv_getenv("PERL_BADFREE"); + bad_free_warn = (pbf) ? strNE("0", pbf) : 1; + } + if (!bad_free_warn) + return NULL; #ifdef RCHECK - { - dTHX; - if (!PERL_IS_ALIVE || !PL_curcop) - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored", - (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), - ovp->ov_rmagic == RMAGIC - 1 - ? "of freed memory " : ""); - } + { + dTHX; + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%srealloc() %signored", + (ovp->ov_rmagic == RMAGIC - 1 ? "" : "Bad "), + ovp->ov_rmagic == RMAGIC - 1 + ? "of freed memory " : ""); + } #else - { - dTHX; - if (!PERL_IS_ALIVE || !PL_curcop) - Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", - "Bad realloc() ignored"); - } + { + dTHX; + if (!PERL_IS_ALIVE || !PL_curcop) + Perl_ck_warner_d(aTHX_ packWARN(WARN_MALLOC), "%s", + "Bad realloc() ignored"); + } #endif - return NULL; /* sanity */ - } - - onb = BUCKET_SIZE_REAL(bucket); - /* - * avoid the copy if same size block. - * We are not aggressive with boundary cases. Note that it might - * (for a small number of cases) give false negative if - * both new size and old one are in the bucket for - * FIRST_BIG_POW2, but the new one is near the lower end. - * - * We do not try to go to 1.5 times smaller bucket so far. - */ - if (nbytes > onb) incr = 1; - else { + return NULL; /* sanity */ + } + + onb = BUCKET_SIZE_REAL(bucket); + /* + * avoid the copy if same size block. + * We are not aggressive with boundary cases. Note that it might + * (for a small number of cases) give false negative if + * both new size and old one are in the bucket for + * FIRST_BIG_POW2, but the new one is near the lower end. + * + * We do not try to go to 1.5 times smaller bucket so far. + */ + if (nbytes > onb) incr = 1; + else { #ifdef DO_NOT_TRY_HARDER_WHEN_SHRINKING - if ( /* This is a little bit pessimal if PACK_MALLOC: */ - nbytes > ( (onb >> 1) - M_OVERHEAD ) + if ( /* This is a little bit pessimal if PACK_MALLOC: */ + nbytes > ( (onb >> 1) - M_OVERHEAD ) # ifdef TWO_POT_OPTIMIZE - || (bucket == FIRST_BIG_POW2 && nbytes >= LAST_SMALL_BOUND ) + || (bucket == FIRST_BIG_POW2 && nbytes >= LAST_SMALL_BOUND ) # endif - ) + ) #else /* !DO_NOT_TRY_HARDER_WHEN_SHRINKING */ - prev_bucket = ( (bucket > MAX_PACKED + 1) - ? bucket - BUCKETS_PER_POW2 - : bucket - 1); - if (nbytes > BUCKET_SIZE_REAL(prev_bucket)) + prev_bucket = ( (bucket > MAX_PACKED + 1) + ? bucket - BUCKETS_PER_POW2 + : bucket - 1); + if (nbytes > BUCKET_SIZE_REAL(prev_bucket)) #endif /* !DO_NOT_TRY_HARDER_WHEN_SHRINKING */ - incr = 0; - else incr = -1; - } + incr = 0; + else incr = -1; + } #ifdef STRESS_REALLOC - goto hard_way; + goto hard_way; #endif - if (incr == 0) { - inplace_label: + if (incr == 0) { + inplace_label: #ifdef RCHECK - /* - * Record new allocated size of block and - * bound space with magic numbers. - */ - if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { - int i, nb = ovp->ov_size + 1; - - if ((i = nb & (RMAGIC_SZ-1))) { - i = RMAGIC_SZ - i; - while (i--) { /* nb - RMAGIC_SZ is end of alloced area */ - ASSERT(((caddr_t)ovp + nb - RMAGIC_SZ)[i] == RMAGIC_C, "chunk's tail overwrite"); - } - } - /* Same at RMAGIC_SZ-aligned RMAGIC */ - nb = (nb + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1); - ASSERT(((u_int *)((caddr_t)ovp + nb))[-1] == RMAGIC, - "chunk's tail overwrite"); - FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nb), - BUCKET_SIZE(OV_INDEX(ovp)) - nb); - if (nbytes > ovp->ov_size + 1 - M_OVERHEAD) - FILL_FEEDADAD((unsigned char*)cp + ovp->ov_size + 1 - M_OVERHEAD, - nbytes - (ovp->ov_size + 1 - M_OVERHEAD)); - else - FILL_DEADBEEF((unsigned char*)cp + nbytes, - nb - M_OVERHEAD + RMAGIC_SZ - nbytes); - /* - * Convert amount of memory requested into - * closest block size stored in hash buckets - * which satisfies request. Account for - * space used per block for accounting. - */ - nbytes += M_OVERHEAD; - ovp->ov_size = nbytes - 1; - if ((i = nbytes & (RMAGIC_SZ-1))) { - i = RMAGIC_SZ - i; - while (i--) /* nbytes - RMAGIC_SZ is end of alloced area */ - ((caddr_t)ovp + nbytes - RMAGIC_SZ)[i] - = RMAGIC_C; - } - /* Same at RMAGIC_SZ-aligned RMAGIC */ - nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ - 1); - ((u_int *)((caddr_t)ovp + nbytes))[-1] = RMAGIC; - } + /* + * Record new allocated size of block and + * bound space with magic numbers. + */ + if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { + int i, nb = ovp->ov_size + 1; + + if ((i = nb & (RMAGIC_SZ-1))) { + i = RMAGIC_SZ - i; + while (i--) { /* nb - RMAGIC_SZ is end of alloced area */ + ASSERT(((caddr_t)ovp + nb - RMAGIC_SZ)[i] == RMAGIC_C, "chunk's tail overwrite"); + } + } + /* Same at RMAGIC_SZ-aligned RMAGIC */ + nb = (nb + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ-1); + ASSERT(((u_int *)((caddr_t)ovp + nb))[-1] == RMAGIC, + "chunk's tail overwrite"); + FILLCHECK_DEADBEEF((unsigned char*)((caddr_t)ovp + nb), + BUCKET_SIZE(OV_INDEX(ovp)) - nb); + if (nbytes > ovp->ov_size + 1 - M_OVERHEAD) + FILL_FEEDADAD((unsigned char*)cp + ovp->ov_size + 1 - M_OVERHEAD, + nbytes - (ovp->ov_size + 1 - M_OVERHEAD)); + else + FILL_DEADBEEF((unsigned char*)cp + nbytes, + nb - M_OVERHEAD + RMAGIC_SZ - nbytes); + /* + * Convert amount of memory requested into + * closest block size stored in hash buckets + * which satisfies request. Account for + * space used per block for accounting. + */ + nbytes += M_OVERHEAD; + ovp->ov_size = nbytes - 1; + if ((i = nbytes & (RMAGIC_SZ-1))) { + i = RMAGIC_SZ - i; + while (i--) /* nbytes - RMAGIC_SZ is end of alloced area */ + ((caddr_t)ovp + nbytes - RMAGIC_SZ)[i] + = RMAGIC_C; + } + /* Same at RMAGIC_SZ-aligned RMAGIC */ + nbytes = (nbytes + (RMAGIC_SZ-1)) & ~(RMAGIC_SZ - 1); + ((u_int *)((caddr_t)ovp + nbytes))[-1] = RMAGIC; + } #endif - res = cp; - DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%" UVxf ": (%05lu) realloc %ld bytes inplace\n", - PTR2UV(res),(unsigned long)(PL_an++), - (long)size)); - } else if (incr == 1 && (cp - M_OVERHEAD == last_op) - && (onb > (1 << LOG_OF_MIN_ARENA))) { - MEM_SIZE require, newarena = nbytes, pow; - int shiftr; - - POW2_OPTIMIZE_ADJUST(newarena); - newarena = newarena + M_OVERHEAD; - /* newarena = (newarena + 3) &~ 3; */ - shiftr = (newarena - 1) >> LOG_OF_MIN_ARENA; - pow = LOG_OF_MIN_ARENA + 1; - /* apart from this loop, this is O(1) */ - while (shiftr >>= 1) - pow++; - newarena = (1 << pow) + POW2_OPTIMIZE_SURPLUS(pow * BUCKETS_PER_POW2); - require = newarena - onb - M_OVERHEAD; - - MALLOC_LOCK; - if (cp - M_OVERHEAD == last_op /* We *still* are the last chunk */ - && getpages_adjacent(require)) { + res = cp; + DEBUG_m(PerlIO_printf(Perl_debug_log, + "0x%" UVxf ": (%05lu) realloc %ld bytes inplace\n", + PTR2UV(res),(unsigned long)(PL_an++), + (long)size)); + } else if (incr == 1 && (cp - M_OVERHEAD == last_op) + && (onb > (1 << LOG_OF_MIN_ARENA))) { + MEM_SIZE require, newarena = nbytes, pow; + int shiftr; + + POW2_OPTIMIZE_ADJUST(newarena); + newarena = newarena + M_OVERHEAD; + /* newarena = (newarena + 3) &~ 3; */ + shiftr = (newarena - 1) >> LOG_OF_MIN_ARENA; + pow = LOG_OF_MIN_ARENA + 1; + /* apart from this loop, this is O(1) */ + while (shiftr >>= 1) + pow++; + newarena = (1 << pow) + POW2_OPTIMIZE_SURPLUS(pow * BUCKETS_PER_POW2); + require = newarena - onb - M_OVERHEAD; + + MALLOC_LOCK; + if (cp - M_OVERHEAD == last_op /* We *still* are the last chunk */ + && getpages_adjacent(require)) { #ifdef DEBUGGING_MSTATS - nmalloc[bucket]--; - nmalloc[pow * BUCKETS_PER_POW2]++; + nmalloc[bucket]--; + nmalloc[pow * BUCKETS_PER_POW2]++; #endif - if (pow * BUCKETS_PER_POW2 > (MEM_SIZE)max_bucket) - max_bucket = pow * BUCKETS_PER_POW2; - *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */ - MALLOC_UNLOCK; - goto inplace_label; - } else { - MALLOC_UNLOCK; - goto hard_way; - } - } else { - hard_way: - DEBUG_m(PerlIO_printf(Perl_debug_log, - "0x%" UVxf ": (%05lu) realloc %ld bytes the hard way\n", - PTR2UV(cp),(unsigned long)(PL_an++), - (long)size)); - if ((res = (char*)Perl_malloc(nbytes)) == NULL) - return (NULL); - if (cp != res) /* common optimization */ - Copy(cp, res, (MEM_SIZE)(nbytes (MEM_SIZE)max_bucket) + max_bucket = pow * BUCKETS_PER_POW2; + *(cp - M_OVERHEAD) = pow * BUCKETS_PER_POW2; /* Fill index. */ + MALLOC_UNLOCK; + goto inplace_label; + } else { + MALLOC_UNLOCK; + goto hard_way; + } + } else { + hard_way: + DEBUG_m(PerlIO_printf(Perl_debug_log, + "0x%" UVxf ": (%05lu) realloc %ld bytes the hard way\n", + PTR2UV(cp),(unsigned long)(PL_an++), + (long)size)); + if ((res = (char*)Perl_malloc(nbytes)) == NULL) + return (NULL); + if (cp != res) /* common optimization */ + Copy(cp, res, (MEM_SIZE)(nbytesov_size = size + M_OVERHEAD - 1; - *((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RMAGIC_SZ)) = RMAGIC; + const MEM_SIZE size = BUCKET_SIZE_REAL(bucket); + ovp->ov_size = size + M_OVERHEAD - 1; + *((u_int *)((caddr_t)ovp + size + M_OVERHEAD - RMAGIC_SZ)) = RMAGIC; } #endif return BUCKET_SIZE_REAL(bucket); @@ -2170,56 +2170,56 @@ int Perl_get_mstats(pTHX_ perl_mstats_t *buf, int buflen, int level) { #ifdef DEBUGGING_MSTATS - int i, j; - union overhead *p; - struct chunk_chain_s* nextchain; - - PERL_ARGS_ASSERT_GET_MSTATS; - - buf->topbucket = buf->topbucket_ev = buf->topbucket_odd - = buf->totfree = buf->total = buf->total_chain = 0; - - buf->minbucket = MIN_BUCKET; - MALLOC_LOCK; - for (i = MIN_BUCKET ; i < NBUCKETS; i++) { - for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) - ; - if (i < buflen) { - buf->nfree[i] = j; - buf->ntotal[i] = nmalloc[i]; - } - buf->totfree += j * BUCKET_SIZE_REAL(i); - buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i); - if (nmalloc[i]) { - i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i); - buf->topbucket = i; - } - } - nextchain = chunk_chain; - while (nextchain) { - buf->total_chain += nextchain->size; - nextchain = nextchain->next; - } - buf->total_sbrk = goodsbrk + sbrk_slack; - buf->sbrks = sbrks; - buf->sbrk_good = sbrk_goodness; - buf->sbrk_slack = sbrk_slack; - buf->start_slack = start_slack; - buf->sbrked_remains = sbrked_remains; - MALLOC_UNLOCK; - buf->nbuckets = NBUCKETS; - if (level) { - for (i = MIN_BUCKET ; i < NBUCKETS; i++) { - if (i >= buflen) - break; - buf->bucket_mem_size[i] = BUCKET_SIZE_NO_SURPLUS(i); - buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i); - } - } + int i, j; + union overhead *p; + struct chunk_chain_s* nextchain; + + PERL_ARGS_ASSERT_GET_MSTATS; + + buf->topbucket = buf->topbucket_ev = buf->topbucket_odd + = buf->totfree = buf->total = buf->total_chain = 0; + + buf->minbucket = MIN_BUCKET; + MALLOC_LOCK; + for (i = MIN_BUCKET ; i < NBUCKETS; i++) { + for (j = 0, p = nextf[i]; p; p = p->ov_next, j++) + ; + if (i < buflen) { + buf->nfree[i] = j; + buf->ntotal[i] = nmalloc[i]; + } + buf->totfree += j * BUCKET_SIZE_REAL(i); + buf->total += nmalloc[i] * BUCKET_SIZE_REAL(i); + if (nmalloc[i]) { + i % 2 ? (buf->topbucket_odd = i) : (buf->topbucket_ev = i); + buf->topbucket = i; + } + } + nextchain = chunk_chain; + while (nextchain) { + buf->total_chain += nextchain->size; + nextchain = nextchain->next; + } + buf->total_sbrk = goodsbrk + sbrk_slack; + buf->sbrks = sbrks; + buf->sbrk_good = sbrk_goodness; + buf->sbrk_slack = sbrk_slack; + buf->start_slack = start_slack; + buf->sbrked_remains = sbrked_remains; + MALLOC_UNLOCK; + buf->nbuckets = NBUCKETS; + if (level) { + for (i = MIN_BUCKET ; i < NBUCKETS; i++) { + if (i >= buflen) + break; + buf->bucket_mem_size[i] = BUCKET_SIZE_NO_SURPLUS(i); + buf->bucket_available_size[i] = BUCKET_SIZE_REAL(i); + } + } #else /* defined DEBUGGING_MSTATS */ - PerlIO_printf(Perl_error_log, "perl not compiled with DEBUGGING_MSTATS\n"); + PerlIO_printf(Perl_error_log, "perl not compiled with DEBUGGING_MSTATS\n"); #endif /* defined DEBUGGING_MSTATS */ - return 0; /* XXX unused */ + return 0; /* XXX unused */ } /* * mstats - print out statistics about malloc @@ -2232,72 +2232,72 @@ void Perl_dump_mstats(pTHX_ const char *s) { #ifdef DEBUGGING_MSTATS - int i; - perl_mstats_t buffer; - UV nf[NBUCKETS]; - UV nt[NBUCKETS]; + int i; + perl_mstats_t buffer; + UV nf[NBUCKETS]; + UV nt[NBUCKETS]; - PERL_ARGS_ASSERT_DUMP_MSTATS; + PERL_ARGS_ASSERT_DUMP_MSTATS; - buffer.nfree = nf; - buffer.ntotal = nt; - get_mstats(&buffer, NBUCKETS, 0); + buffer.nfree = nf; + buffer.ntotal = nt; + get_mstats(&buffer, NBUCKETS, 0); - if (s) - PerlIO_printf(Perl_error_log, - "Memory allocation statistics %s (buckets %" IVdf + if (s) + PerlIO_printf(Perl_error_log, + "Memory allocation statistics %s (buckets %" IVdf "(%" IVdf ")..%" IVdf "(%" IVdf ")\n", - s, - (IV)BUCKET_SIZE_REAL(MIN_BUCKET), - (IV)BUCKET_SIZE_NO_SURPLUS(MIN_BUCKET), - (IV)BUCKET_SIZE_REAL(buffer.topbucket), - (IV)BUCKET_SIZE_NO_SURPLUS(buffer.topbucket)); + s, + (IV)BUCKET_SIZE_REAL(MIN_BUCKET), + (IV)BUCKET_SIZE_NO_SURPLUS(MIN_BUCKET), + (IV)BUCKET_SIZE_REAL(buffer.topbucket), + (IV)BUCKET_SIZE_NO_SURPLUS(buffer.topbucket)); PerlIO_printf(Perl_error_log, "%8" IVdf " free:", buffer.totfree); - for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, - ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5" UVuf - : ((i < 12*BUCKETS_PER_POW2) ? " %3" UVuf + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, + ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) + ? " %5" UVuf + : ((i < 12*BUCKETS_PER_POW2) ? " %3" UVuf : " %" UVuf)), - buffer.nfree[i]); - } + buffer.nfree[i]); + } #ifdef BUCKETS_ROOT2 - PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, - ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5"UVuf - : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)), - buffer.nfree[i]); - } + PerlIO_printf(Perl_error_log, "\n\t "); + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, + ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) + ? " %5"UVuf + : ((i < 12*BUCKETS_PER_POW2) ? " %3"UVuf : " %"UVuf)), + buffer.nfree[i]); + } #endif PerlIO_printf(Perl_error_log, "\n%8" IVdf " used:", buffer.total - buffer.totfree); - for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, - ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5" IVdf - : ((i < 12*BUCKETS_PER_POW2) ? " %3" IVdf : " %" IVdf)), - buffer.ntotal[i] - buffer.nfree[i]); - } + for (i = MIN_EVEN_REPORT; i <= buffer.topbucket; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, + ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) + ? " %5" IVdf + : ((i < 12*BUCKETS_PER_POW2) ? " %3" IVdf : " %" IVdf)), + buffer.ntotal[i] - buffer.nfree[i]); + } #ifdef BUCKETS_ROOT2 - PerlIO_printf(Perl_error_log, "\n\t "); - for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { - PerlIO_printf(Perl_error_log, - ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) - ? " %5"IVdf - : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), - buffer.ntotal[i] - buffer.nfree[i]); - } + PerlIO_printf(Perl_error_log, "\n\t "); + for (i = MIN_BUCKET + 1; i <= buffer.topbucket_odd; i += BUCKETS_PER_POW2) { + PerlIO_printf(Perl_error_log, + ((i < 8*BUCKETS_PER_POW2 || i == 10*BUCKETS_PER_POW2) + ? " %5"IVdf + : ((i < 12*BUCKETS_PER_POW2) ? " %3"IVdf : " %"IVdf)), + buffer.ntotal[i] - buffer.nfree[i]); + } #endif - PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %" IVdf "/%" IVdf ":%" + PerlIO_printf(Perl_error_log, "\nTotal sbrk(): %" IVdf "/%" IVdf ":%" IVdf ". Odd ends: pad+heads+chain+tail: %" IVdf "+%" IVdf "+%" IVdf "+%" IVdf ".\n", - buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, - buffer.sbrk_slack, buffer.start_slack, - buffer.total_chain, buffer.sbrked_remains); + buffer.total_sbrk, buffer.sbrks, buffer.sbrk_good, + buffer.sbrk_slack, buffer.start_slack, + buffer.total_chain, buffer.sbrked_remains); #else /* DEBUGGING_MSTATS */ - PerlIO_printf(Perl_error_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",s); + PerlIO_printf(Perl_error_log, "%s: perl not compiled with DEBUGGING_MSTATS\n",s); #endif /* DEBUGGING_MSTATS */ } @@ -2341,15 +2341,15 @@ Perl_sbrk(int size) size = (size + 0x7ff) & ~0x7ff; #endif if (size <= Perl_sbrk_oldsize) { - got = Perl_sbrk_oldchunk; - Perl_sbrk_oldchunk += size; - Perl_sbrk_oldsize -= size; + got = Perl_sbrk_oldchunk; + Perl_sbrk_oldchunk += size; + Perl_sbrk_oldsize -= size; } else { if (size >= PERLSBRK_32_K) { - small = 0; + small = 0; } else { - size = PERLSBRK_64_K; - small = 1; + size = PERLSBRK_64_K; + small = 1; } # if NEEDED_ALIGNMENT > SYSTEM_ALLOC_ALIGNMENT size += NEEDED_ALIGNMENT - SYSTEM_ALLOC_ALIGNMENT; @@ -2359,9 +2359,9 @@ Perl_sbrk(int size) got = (got + NEEDED_ALIGNMENT - 1) & ~(NEEDED_ALIGNMENT - 1); # endif if (small) { - /* Chunk is small, register the rest for future allocs. */ - Perl_sbrk_oldchunk = got + reqsize; - Perl_sbrk_oldsize = size - reqsize; + /* Chunk is small, register the rest for future allocs. */ + Perl_sbrk_oldchunk = got + reqsize; + Perl_sbrk_oldsize = size - reqsize; } } diff --git a/mathoms.c b/mathoms.c index fb21563363db..1144e1519e41 100644 --- a/mathoms.c +++ b/mathoms.c @@ -306,9 +306,9 @@ Perl_sv_iv(pTHX_ SV *sv) PERL_ARGS_ASSERT_SV_IV; if (SvIOK(sv)) { - if (SvIsUV(sv)) - return (IV)SvUVX(sv); - return SvIVX(sv); + if (SvIsUV(sv)) + return (IV)SvUVX(sv); + return SvIVX(sv); } return sv_2iv(sv); } @@ -328,9 +328,9 @@ Perl_sv_uv(pTHX_ SV *sv) PERL_ARGS_ASSERT_SV_UV; if (SvIOK(sv)) { - if (SvIsUV(sv)) - return SvUVX(sv); - return (UV)SvIVX(sv); + if (SvIsUV(sv)) + return SvUVX(sv); + return (UV)SvIVX(sv); } return sv_2uv(sv); } @@ -350,7 +350,7 @@ Perl_sv_nv(pTHX_ SV *sv) PERL_ARGS_ASSERT_SV_NV; if (SvNOK(sv)) - return SvNVX(sv); + return SvNVX(sv); return sv_2nv(sv); } @@ -373,8 +373,8 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) PERL_ARGS_ASSERT_SV_PVN; if (SvPOK(sv)) { - *lp = SvCUR(sv); - return SvPVX(sv); + *lp = SvCUR(sv); + return SvPVX(sv); } return sv_2pv(sv, lp); } @@ -386,8 +386,8 @@ Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp) PERL_ARGS_ASSERT_SV_PVN_NOMG; if (SvPOK(sv)) { - *lp = SvCUR(sv); - return SvPVX(sv); + *lp = SvCUR(sv); + return SvPVX(sv); } return sv_2pv_flags(sv, lp, 0); } @@ -624,12 +624,12 @@ Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how) bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, - int rawmode, int rawperm, PerlIO *supplied_fp) + int rawmode, int rawperm, PerlIO *supplied_fp) { PERL_ARGS_ASSERT_DO_OPEN; return do_openn(gv, name, len, as_raw, rawmode, rawperm, - supplied_fp, (SV **) NULL, 0); + supplied_fp, (SV **) NULL, 0); } bool @@ -760,14 +760,14 @@ Perl_save_list(pTHX_ SV **sarg, I32 maxsarg) PERL_ARGS_ASSERT_SAVE_LIST; for (i = 1; i <= maxsarg; i++) { - SV *sv; - SvGETMAGIC(sarg[i]); - sv = newSV(0); - sv_setsv_nomg(sv,sarg[i]); - SSCHECK(3); - SSPUSHPTR(sarg[i]); /* remember the pointer */ - SSPUSHPTR(sv); /* remember the value */ - SSPUSHUV(SAVEt_ITEM); + SV *sv; + SvGETMAGIC(sarg[i]); + sv = newSV(0); + sv_setsv_nomg(sv,sarg[i]); + SSCHECK(3); + SSPUSHPTR(sarg[i]); /* remember the pointer */ + SSPUSHPTR(sv); /* remember the value */ + SSPUSHUV(SAVEt_ITEM); } } @@ -817,8 +817,8 @@ C instead. SSize_t Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, - const char *strbeg, const char *strend, char **new_s, I32 ocnt, - U32 flags) + const char *strbeg, const char *strend, char **new_s, I32 ocnt, + U32 flags) { PERL_ARGS_ASSERT_UNPACK_STR; @@ -870,7 +870,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash) PERL_ARGS_ASSERT_HV_FETCH_ENT; return (HE *)hv_common(hv, keysv, NULL, 0, 0, - (lval ? HV_FETCH_LVALUE : 0), NULL, hash); + (lval ? HV_FETCH_LVALUE : 0), NULL, hash); } SV * @@ -879,15 +879,15 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) PERL_ARGS_ASSERT_HV_DELETE_ENT; return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL, - hash)); + hash)); } SV** Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash, - int flags) + int flags) { return (SV**) hv_common(hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); } SV** @@ -897,14 +897,14 @@ Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) int flags; if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; + klen = -klen_i32; + flags = HVhek_UTF8; } else { - klen = klen_i32; - flags = 0; + klen = klen_i32; + flags = 0; } return (SV **) hv_common(hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); } bool @@ -916,11 +916,11 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) PERL_ARGS_ASSERT_HV_EXISTS; if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; + klen = -klen_i32; + flags = HVhek_UTF8; } else { - klen = klen_i32; - flags = 0; + klen = klen_i32; + flags = 0; } return cBOOL(hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)); } @@ -934,15 +934,15 @@ Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) PERL_ARGS_ASSERT_HV_FETCH; if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; + klen = -klen_i32; + flags = HVhek_UTF8; } else { - klen = klen_i32; - flags = 0; + klen = klen_i32; + flags = 0; } return (SV **) hv_common(hv, NULL, key, klen, flags, - lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) - : HV_FETCH_JUST_SV, NULL, 0); + lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) + : HV_FETCH_JUST_SV, NULL, 0); } SV * @@ -954,14 +954,14 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags) PERL_ARGS_ASSERT_HV_DELETE; if (klen_i32 < 0) { - klen = -klen_i32; - k_flags = HVhek_UTF8; + klen = -klen_i32; + k_flags = HVhek_UTF8; } else { - klen = klen_i32; - k_flags = 0; + klen = klen_i32; + k_flags = 0; } return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE, - NULL, 0)); + NULL, 0)); } AV * diff --git a/mg.c b/mg.c index fcbefff8fa37..4461b6d4594e 100644 --- a/mg.c +++ b/mg.c @@ -103,8 +103,8 @@ S_save_magic_flags(pTHX_ I32 mgs_ix, SV *sv, U32 flags) if (SvREFCNT(sv) > 0) { /* guard against sv getting freed midway through the mg clearing, * by holding a private reference for the duration. */ - SvREFCNT_inc_simple_void_NN(sv); - bumped = TRUE; + SvREFCNT_inc_simple_void_NN(sv); + bumped = TRUE; } SAVEDESTRUCTOR_X(S_restore_magic, INT2PTR(void*, (IV)mgs_ix)); @@ -137,19 +137,19 @@ Perl_mg_magical(SV *sv) SvMAGICAL_off(sv); if ((mg = SvMAGIC(sv))) { - do { - const MGVTBL* const vtbl = mg->mg_virtual; - if (vtbl) { - if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) - SvGMAGICAL_on(sv); - if (vtbl->svt_set) - SvSMAGICAL_on(sv); - if (vtbl->svt_clear) - SvRMAGICAL_on(sv); - } - } while ((mg = mg->mg_moremagic)); - if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG))) - SvRMAGICAL_on(sv); + do { + const MGVTBL* const vtbl = mg->mg_virtual; + if (vtbl) { + if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP)) + SvGMAGICAL_on(sv); + if (vtbl->svt_set) + SvSMAGICAL_on(sv); + if (vtbl->svt_clear) + SvRMAGICAL_on(sv); + } + } while ((mg = mg->mg_moremagic)); + if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG))) + SvRMAGICAL_on(sv); } } @@ -181,13 +181,13 @@ Perl_mg_get(pTHX_ SV *sv) newmg = cur = head = mg = SvMAGIC(sv); while (mg) { - const MGVTBL * const vtbl = mg->mg_virtual; - MAGIC * const nextmg = mg->mg_moremagic; /* it may delete itself */ + const MGVTBL * const vtbl = mg->mg_virtual; + MAGIC * const nextmg = mg->mg_moremagic; /* it may delete itself */ - if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { + if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) { - /* taint's mg get is so dumb it doesn't need flag saving */ - if (mg->mg_type != PERL_MAGIC_taint) { + /* taint's mg get is so dumb it doesn't need flag saving */ + if (mg->mg_type != PERL_MAGIC_taint) { taint_only = FALSE; if (!saved) { save_magic(mgs_ix, sv); @@ -195,23 +195,23 @@ Perl_mg_get(pTHX_ SV *sv) } } - vtbl->svt_get(aTHX_ sv, mg); - - /* guard against magic having been deleted - eg FETCH calling - * untie */ - if (!SvMAGIC(sv)) { - /* recalculate flags */ - (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); - break; - } - - /* recalculate flags if this entry was deleted. */ - if (mg->mg_flags & MGf_GSKIP) - (SSPTR(mgs_ix, MGS *))->mgs_flags &= - ~(SVs_GMG|SVs_SMG|SVs_RMG); - } - else if (vtbl == &PL_vtbl_utf8) { - /* get-magic can reallocate the PV, unless there's only taint + vtbl->svt_get(aTHX_ sv, mg); + + /* guard against magic having been deleted - eg FETCH calling + * untie */ + if (!SvMAGIC(sv)) { + /* recalculate flags */ + (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); + break; + } + + /* recalculate flags if this entry was deleted. */ + if (mg->mg_flags & MGf_GSKIP) + (SSPTR(mgs_ix, MGS *))->mgs_flags &= + ~(SVs_GMG|SVs_SMG|SVs_RMG); + } + else if (vtbl == &PL_vtbl_utf8) { + /* get-magic can reallocate the PV, unless there's only taint * magic */ if (taint_only) { MAGIC *mg2; @@ -228,32 +228,32 @@ Perl_mg_get(pTHX_ SV *sv) } if (!taint_only) magic_setutf8(sv, mg); - } - - mg = nextmg; - - if (have_new) { - /* Have we finished with the new entries we saw? Start again - where we left off (unless there are more new entries). */ - if (mg == head) { - have_new = 0; - mg = cur; - head = newmg; - } - } - - /* Were any new entries added? */ - if (!have_new && (newmg = SvMAGIC(sv)) != head) { - have_new = 1; - cur = mg; - mg = newmg; - /* recalculate flags */ - (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); - } + } + + mg = nextmg; + + if (have_new) { + /* Have we finished with the new entries we saw? Start again + where we left off (unless there are more new entries). */ + if (mg == head) { + have_new = 0; + mg = cur; + head = newmg; + } + } + + /* Were any new entries added? */ + if (!have_new && (newmg = SvMAGIC(sv)) != head) { + have_new = 1; + cur = mg; + mg = newmg; + /* recalculate flags */ + (SSPTR(mgs_ix, MGS *))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); + } } if (saved) - restore_magic(INT2PTR(void *, (IV)mgs_ix)); + restore_magic(INT2PTR(void *, (IV)mgs_ix)); return 0; } @@ -281,16 +281,16 @@ Perl_mg_set(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = nextmg) { const MGVTBL* vtbl = mg->mg_virtual; - nextmg = mg->mg_moremagic; /* it may delete itself */ - if (mg->mg_flags & MGf_GSKIP) { - mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ - (SSPTR(mgs_ix, MGS*))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); - } - if (PL_localizing == 2 - && PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) - continue; - if (vtbl && vtbl->svt_set) - vtbl->svt_set(aTHX_ sv, mg); + nextmg = mg->mg_moremagic; /* it may delete itself */ + if (mg->mg_flags & MGf_GSKIP) { + mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */ + (SSPTR(mgs_ix, MGS*))->mgs_flags &= ~(SVs_GMG|SVs_SMG|SVs_RMG); + } + if (PL_localizing == 2 + && PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) + continue; + if (vtbl && vtbl->svt_set) + vtbl->svt_set(aTHX_ sv, mg); } restore_magic(INT2PTR(void*, (IV)mgs_ix)); @@ -319,14 +319,14 @@ Perl_mg_length(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL * const vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_len) { + if (vtbl && vtbl->svt_len) { const I32 mgs_ix = SSNEW(sizeof(MGS)); - save_magic(mgs_ix, sv); - /* omit MGf_GSKIP -- not changed here */ - len = vtbl->svt_len(aTHX_ sv, mg); - restore_magic(INT2PTR(void*, (IV)mgs_ix)); - return len; - } + save_magic(mgs_ix, sv); + /* omit MGf_GSKIP -- not changed here */ + len = vtbl->svt_len(aTHX_ sv, mg); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); + return len; + } } (void)SvPV_const(sv, len); @@ -342,24 +342,24 @@ Perl_mg_size(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; - if (vtbl && vtbl->svt_len) { + if (vtbl && vtbl->svt_len) { const I32 mgs_ix = SSNEW(sizeof(MGS)); I32 len; - save_magic(mgs_ix, sv); - /* omit MGf_GSKIP -- not changed here */ - len = vtbl->svt_len(aTHX_ sv, mg); - restore_magic(INT2PTR(void*, (IV)mgs_ix)); - return len; - } + save_magic(mgs_ix, sv); + /* omit MGf_GSKIP -- not changed here */ + len = vtbl->svt_len(aTHX_ sv, mg); + restore_magic(INT2PTR(void*, (IV)mgs_ix)); + return len; + } } switch(SvTYPE(sv)) { - case SVt_PVAV: - return AvFILLp((const AV *) sv); /* Fallback to non-tied array */ - case SVt_PVHV: - /* FIXME */ - default: - Perl_croak(aTHX_ "Size magic not implemented"); + case SVt_PVAV: + return AvFILLp((const AV *) sv); /* Fallback to non-tied array */ + case SVt_PVHV: + /* FIXME */ + default: + Perl_croak(aTHX_ "Size magic not implemented"); } NOT_REACHED; /* NOTREACHED */ @@ -386,12 +386,12 @@ Perl_mg_clear(pTHX_ SV *sv) for (mg = SvMAGIC(sv); mg; mg = nextmg) { const MGVTBL* const vtbl = mg->mg_virtual; - /* omit GSKIP -- never set here */ + /* omit GSKIP -- never set here */ - nextmg = mg->mg_moremagic; /* it may delete itself */ + nextmg = mg->mg_moremagic; /* it may delete itself */ - if (vtbl && vtbl->svt_clear) - vtbl->svt_clear(aTHX_ sv, mg); + if (vtbl && vtbl->svt_clear) + vtbl->svt_clear(aTHX_ sv, mg); } restore_magic(INT2PTR(void*, (IV)mgs_ix)); @@ -404,13 +404,13 @@ S_mg_findext_flags(const SV *sv, int type, const MGVTBL *vtbl, U32 flags) assert(flags <= 1); if (sv) { - MAGIC *mg; + MAGIC *mg; - for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { - if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) { - return mg; - } - } + for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { + if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) { + return mg; + } + } } return NULL; @@ -478,20 +478,20 @@ Perl_mg_copy(pTHX_ SV *sv, SV *nsv, const char *key, I32 klen) for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { const MGVTBL* const vtbl = mg->mg_virtual; - if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){ - count += vtbl->svt_copy(aTHX_ sv, mg, nsv, key, klen); - } - else { - const char type = mg->mg_type; - if (isUPPER(type) && type != PERL_MAGIC_uvar) { - sv_magic(nsv, - (type == PERL_MAGIC_tied) - ? SvTIED_obj(sv, mg) + if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){ + count += vtbl->svt_copy(aTHX_ sv, mg, nsv, key, klen); + } + else { + const char type = mg->mg_type; + if (isUPPER(type) && type != PERL_MAGIC_uvar) { + sv_magic(nsv, + (type == PERL_MAGIC_tied) + ? SvTIED_obj(sv, mg) : mg->mg_obj, - toLOWER(type), key, klen); - count++; - } - } + toLOWER(type), key, klen); + count++; + } + } } return count; } @@ -519,30 +519,30 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv, bool setmagic) PERL_ARGS_ASSERT_MG_LOCALIZE; if (nsv == DEFSV) - return; + return; for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) { - const MGVTBL* const vtbl = mg->mg_virtual; - if (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) - continue; - - if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local) - (void)vtbl->svt_local(aTHX_ nsv, mg); - else - sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl, - mg->mg_ptr, mg->mg_len); + const MGVTBL* const vtbl = mg->mg_virtual; + if (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type)) + continue; + + if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local) + (void)vtbl->svt_local(aTHX_ nsv, mg); + else + sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl, + mg->mg_ptr, mg->mg_len); - /* container types should remain read-only across localization */ - SvFLAGS(nsv) |= SvREADONLY(sv); + /* container types should remain read-only across localization */ + SvFLAGS(nsv) |= SvREADONLY(sv); } if (SvTYPE(nsv) >= SVt_PVMG && SvMAGIC(nsv)) { - SvFLAGS(nsv) |= SvMAGICAL(sv); - if (setmagic) { - PL_localizing = 1; - SvSETMAGIC(nsv); - PL_localizing = 0; - } + SvFLAGS(nsv) |= SvMAGICAL(sv); + if (setmagic) { + PL_localizing = 1; + SvSETMAGIC(nsv); + PL_localizing = 0; + } } } @@ -552,7 +552,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg) { const MGVTBL* const vtbl = mg->mg_virtual; if (vtbl && vtbl->svt_free) - vtbl->svt_free(aTHX_ sv, mg); + vtbl->svt_free(aTHX_ sv, mg); if (mg->mg_len > 0) Safefree(mg->mg_ptr); @@ -560,7 +560,7 @@ S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg) SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr)); if (mg->mg_flags & MGf_REFCOUNTED) - SvREFCNT_dec(mg->mg_obj); + SvREFCNT_dec(mg->mg_obj); Safefree(mg); } @@ -581,9 +581,9 @@ Perl_mg_free(pTHX_ SV *sv) PERL_ARGS_ASSERT_MG_FREE; for (mg = SvMAGIC(sv); mg; mg = moremagic) { - moremagic = mg->mg_moremagic; - mg_free_struct(sv, mg); - SvMAGIC_set(sv, moremagic); + moremagic = mg->mg_moremagic; + mg_free_struct(sv, mg); + SvMAGIC_set(sv, moremagic); } SvMAGIC_set(sv, NULL); SvMAGICAL_off(sv); @@ -604,21 +604,21 @@ Perl_mg_free_type(pTHX_ SV *sv, int how) MAGIC *mg, *prevmg, *moremg; PERL_ARGS_ASSERT_MG_FREE_TYPE; for (prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) { - moremg = mg->mg_moremagic; - if (mg->mg_type == how) { + moremg = mg->mg_moremagic; + if (mg->mg_type == how) { MAGIC *newhead; - /* temporarily move to the head of the magic chain, in case - custom free code relies on this historical aspect of mg_free */ - if (prevmg) { - prevmg->mg_moremagic = moremg; - mg->mg_moremagic = SvMAGIC(sv); - SvMAGIC_set(sv, mg); - } - newhead = mg->mg_moremagic; - mg_free_struct(sv, mg); - SvMAGIC_set(sv, newhead); - mg = prevmg; - } + /* temporarily move to the head of the magic chain, in case + custom free code relies on this historical aspect of mg_free */ + if (prevmg) { + prevmg->mg_moremagic = moremg; + mg->mg_moremagic = SvMAGIC(sv); + SvMAGIC_set(sv, mg); + } + newhead = mg->mg_moremagic; + mg_free_struct(sv, mg); + SvMAGIC_set(sv, newhead); + mg = prevmg; + } } mg_magical(sv); } @@ -640,21 +640,21 @@ Perl_mg_freeext(pTHX_ SV *sv, int how, const MGVTBL *vtbl) MAGIC *mg, *prevmg, *moremg; PERL_ARGS_ASSERT_MG_FREEEXT; for (prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) { - MAGIC *newhead; - moremg = mg->mg_moremagic; - if (mg->mg_type == how && (vtbl == NULL || mg->mg_virtual == vtbl)) { - /* temporarily move to the head of the magic chain, in case - custom free code relies on this historical aspect of mg_free */ - if (prevmg) { - prevmg->mg_moremagic = moremg; - mg->mg_moremagic = SvMAGIC(sv); - SvMAGIC_set(sv, mg); - } - newhead = mg->mg_moremagic; - mg_free_struct(sv, mg); - SvMAGIC_set(sv, newhead); - mg = prevmg; - } + MAGIC *newhead; + moremg = mg->mg_moremagic; + if (mg->mg_type == how && (vtbl == NULL || mg->mg_virtual == vtbl)) { + /* temporarily move to the head of the magic chain, in case + custom free code relies on this historical aspect of mg_free */ + if (prevmg) { + prevmg->mg_moremagic = moremg; + mg->mg_moremagic = SvMAGIC(sv); + SvMAGIC_set(sv, mg); + } + newhead = mg->mg_moremagic; + mg_free_struct(sv, mg); + SvMAGIC_set(sv, newhead); + mg = prevmg; + } } mg_magical(sv); } @@ -670,19 +670,19 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) if (PL_curpm) { REGEXP * const rx = PM_GETRE(PL_curpm); - if (rx) { + if (rx) { const SSize_t n = (SSize_t)mg->mg_obj; if (n == '+') { /* @+ */ - /* return the number possible */ - return RX_NPARENS(rx); + /* return the number possible */ + return RX_NPARENS(rx); } else { /* @- @^CAPTURE @{^CAPTURE} */ - I32 paren = RX_LASTPAREN(rx); + I32 paren = RX_LASTPAREN(rx); - /* return the last filled */ - while ( paren >= 0 - && (RX_OFFS(rx)[paren].start == -1 - || RX_OFFS(rx)[paren].end == -1) ) - paren--; + /* return the last filled */ + while ( paren >= 0 + && (RX_OFFS(rx)[paren].start == -1 + || RX_OFFS(rx)[paren].end == -1) ) + paren--; if (n == '-') { /* @- */ return (U32)paren; @@ -691,7 +691,7 @@ Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg) return paren >= 0 ? (U32)(paren-1) : (U32)-1; } } - } + } } return (U32)-1; @@ -706,42 +706,42 @@ Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg) if (PL_curpm) { REGEXP * const rx = PM_GETRE(PL_curpm); - if (rx) { + if (rx) { const SSize_t n = (SSize_t)mg->mg_obj; /* @{^CAPTURE} does not contain $&, so we need to increment by 1 */ const I32 paren = mg->mg_len + (n == '\003' ? 1 : 0); - SSize_t s; - SSize_t t; - if (paren < 0) - return 0; - if (paren <= (I32)RX_NPARENS(rx) && - (s = RX_OFFS(rx)[paren].start) != -1 && - (t = RX_OFFS(rx)[paren].end) != -1) - { - SSize_t i; + SSize_t s; + SSize_t t; + if (paren < 0) + return 0; + if (paren <= (I32)RX_NPARENS(rx) && + (s = RX_OFFS(rx)[paren].start) != -1 && + (t = RX_OFFS(rx)[paren].end) != -1) + { + SSize_t i; if (n == '+') /* @+ */ - i = t; + i = t; else if (n == '-') /* @- */ - i = s; + i = s; else { /* @^CAPTURE @{^CAPTURE} */ CALLREG_NUMBUF_FETCH(rx,paren,sv); return 0; } - if (RX_MATCH_UTF8(rx)) { - const char * const b = RX_SUBBEG(rx); - if (b) - i = RX_SUBCOFFSET(rx) + + if (RX_MATCH_UTF8(rx)) { + const char * const b = RX_SUBBEG(rx); + if (b) + i = RX_SUBCOFFSET(rx) + utf8_length((U8*)b, (U8*)(b-RX_SUBOFFSET(rx)+i)); - } + } - sv_setuv(sv, i); - return 0; - } - } + sv_setuv(sv, i); + return 0; + } + } } sv_set_undef(sv); return 0; @@ -764,10 +764,10 @@ Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg) if (SvPOK(sv)) { \ STRLEN len = SvCUR(sv); \ char * const p = SvPVX(sv); \ - while (len > 0 && isSPACE(p[len-1])) \ - --len; \ - SvCUR_set(sv, len); \ - p[len] = '\0'; \ + while (len > 0 && isSPACE(p[len-1])) \ + --len; \ + SvCUR_set(sv, len); \ + p[len] = '\0'; \ } \ } STMT_END @@ -777,21 +777,21 @@ Perl_emulate_cop_io(pTHX_ const COP *const c, SV *const sv) PERL_ARGS_ASSERT_EMULATE_COP_IO; if (!(CopHINTS_get(c) & (HINT_LEXICAL_IO_IN|HINT_LEXICAL_IO_OUT))) - sv_set_undef(sv); + sv_set_undef(sv); else { SvPVCLEAR(sv); - SvUTF8_off(sv); - if ((CopHINTS_get(c) & HINT_LEXICAL_IO_IN)) { - SV *const value = cop_hints_fetch_pvs(c, "open<", 0); - assert(value); - sv_catsv(sv, value); - } - sv_catpvs(sv, "\0"); - if ((CopHINTS_get(c) & HINT_LEXICAL_IO_OUT)) { - SV *const value = cop_hints_fetch_pvs(c, "open>", 0); - assert(value); - sv_catsv(sv, value); - } + SvUTF8_off(sv); + if ((CopHINTS_get(c) & HINT_LEXICAL_IO_IN)) { + SV *const value = cop_hints_fetch_pvs(c, "open<", 0); + assert(value); + sv_catsv(sv, value); + } + sv_catpvs(sv, "\0"); + if ((CopHINTS_get(c) & HINT_LEXICAL_IO_OUT)) { + SV *const value = cop_hints_fetch_pvs(c, "open>", 0); + assert(value); + sv_catsv(sv, value); + } } } @@ -806,7 +806,7 @@ S_fixup_errno_string(pTHX_ SV* sv) assert(SvOK(sv)); if(strEQ(SvPVX(sv), "")) { - sv_catpv(sv, UNKNOWN_ERRNO_MSG); + sv_catpv(sv, UNKNOWN_ERRNO_MSG); } else { @@ -877,13 +877,13 @@ Perl_sv_string_from_errnum(pTHX_ int errnum, SV *tgtsv) { char const *errstr; if(!tgtsv) - tgtsv = sv_newmortal(); + tgtsv = sv_newmortal(); errstr = my_strerror(errnum); if(errstr) { - sv_setpv(tgtsv, errstr); - fixup_errno_string(tgtsv); + sv_setpv(tgtsv, errstr); + fixup_errno_string(tgtsv); } else { - SvPVCLEAR(tgtsv); + SvPVCLEAR(tgtsv); } return tgtsv; } @@ -918,26 +918,26 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) nextchar = *remaining; switch (*mg->mg_ptr) { case '\001': /* ^A */ - if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget); - else + if (SvOK(PL_bodytarget)) sv_copypv(sv, PL_bodytarget); + else sv_set_undef(sv); - if (SvTAINTED(PL_bodytarget)) - SvTAINTED_on(sv); - break; + if (SvTAINTED(PL_bodytarget)) + SvTAINTED_on(sv); + break; case '\003': /* ^C, ^CHILD_ERROR_NATIVE */ - if (nextchar == '\0') { - sv_setiv(sv, (IV)PL_minus_c); - } - else if (strEQ(remaining, "HILD_ERROR_NATIVE")) { - sv_setiv(sv, (IV)STATUS_NATIVE); + if (nextchar == '\0') { + sv_setiv(sv, (IV)PL_minus_c); + } + else if (strEQ(remaining, "HILD_ERROR_NATIVE")) { + sv_setiv(sv, (IV)STATUS_NATIVE); } - break; + break; case '\004': /* ^D */ - sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK)); - break; + sv_setiv(sv, (IV)(PL_debug & DEBUG_MASK)); + break; case '\005': /* ^E */ - if (nextchar != '\0') { + if (nextchar != '\0') { if (strEQ(remaining, "NCODING")) sv_set_undef(sv); break; @@ -987,13 +987,13 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) # endif SvRTRIM(sv); SvNOK_on(sv); /* what a wonderful hack! */ - break; + break; #endif /* End of platforms with special handling for $^E; others just fall through to $! */ /* FALLTHROUGH */ case '!': - { + { dSAVE_ERRNO; #ifdef VMS sv_setnv(sv, (NV)((errno == EVMSERR) ? vaxc$errno : errno)); @@ -1017,219 +1017,219 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) SvPOK_off(sv); } RESTORE_ERRNO; - } + } - SvRTRIM(sv); - SvNOK_on(sv); /* what a wonderful hack! */ - break; + SvRTRIM(sv); + SvNOK_on(sv); /* what a wonderful hack! */ + break; case '\006': /* ^F */ if (nextchar == '\0') { sv_setiv(sv, (IV)PL_maxsysfd); } - break; + break; case '\007': /* ^GLOBAL_PHASE */ - if (strEQ(remaining, "LOBAL_PHASE")) { - sv_setpvn(sv, PL_phase_names[PL_phase], - strlen(PL_phase_names[PL_phase])); - } - break; + if (strEQ(remaining, "LOBAL_PHASE")) { + sv_setpvn(sv, PL_phase_names[PL_phase], + strlen(PL_phase_names[PL_phase])); + } + break; case '\010': /* ^H */ - sv_setuv(sv, PL_hints); - break; + sv_setuv(sv, PL_hints); + break; case '\011': /* ^I */ /* NOT \t in EBCDIC */ - sv_setpv(sv, PL_inplace); /* Will undefine sv if PL_inplace is NULL */ - break; + sv_setpv(sv, PL_inplace); /* Will undefine sv if PL_inplace is NULL */ + break; case '\014': /* ^LAST_FH */ - if (strEQ(remaining, "AST_FH")) { - if (PL_last_in_gv && (SV*)PL_last_in_gv != &PL_sv_undef) { - assert(isGV_with_GP(PL_last_in_gv)); - SV_CHECK_THINKFIRST_COW_DROP(sv); - prepare_SV_for_RV(sv); - SvOK_off(sv); - SvRV_set(sv, SvREFCNT_inc_simple_NN(PL_last_in_gv)); - SvROK_on(sv); - sv_rvweaken(sv); - } - else + if (strEQ(remaining, "AST_FH")) { + if (PL_last_in_gv && (SV*)PL_last_in_gv != &PL_sv_undef) { + assert(isGV_with_GP(PL_last_in_gv)); + SV_CHECK_THINKFIRST_COW_DROP(sv); + prepare_SV_for_RV(sv); + SvOK_off(sv); + SvRV_set(sv, SvREFCNT_inc_simple_NN(PL_last_in_gv)); + SvROK_on(sv); + sv_rvweaken(sv); + } + else sv_set_undef(sv); - } - break; + } + break; case '\017': /* ^O & ^OPEN */ - if (nextchar == '\0') { - sv_setpv(sv, PL_osname); - SvTAINTED_off(sv); - } - else if (strEQ(remaining, "PEN")) { - Perl_emulate_cop_io(aTHX_ &PL_compiling, sv); - } - break; + if (nextchar == '\0') { + sv_setpv(sv, PL_osname); + SvTAINTED_off(sv); + } + else if (strEQ(remaining, "PEN")) { + Perl_emulate_cop_io(aTHX_ &PL_compiling, sv); + } + break; case '\020': sv_setiv(sv, (IV)PL_perldb); - break; + break; case '\023': /* ^S */ - if (nextchar == '\0') { - if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING) - SvOK_off(sv); - else if (PL_in_eval) - sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE)); - else - sv_setiv(sv, 0); - } - else if (strEQ(remaining, "AFE_LOCALES")) { + if (nextchar == '\0') { + if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING) + SvOK_off(sv); + else if (PL_in_eval) + sv_setiv(sv, PL_in_eval & ~(EVAL_INREQUIRE)); + else + sv_setiv(sv, 0); + } + else if (strEQ(remaining, "AFE_LOCALES")) { #if ! defined(USE_ITHREADS) || defined(USE_THREAD_SAFE_LOCALE) - sv_setuv(sv, (UV) 1); + sv_setuv(sv, (UV) 1); #else - sv_setuv(sv, (UV) 0); + sv_setuv(sv, (UV) 0); #endif } - break; + break; case '\024': /* ^T */ - if (nextchar == '\0') { + if (nextchar == '\0') { #ifdef BIG_TIME sv_setnv(sv, PL_basetime); #else sv_setiv(sv, (IV)PL_basetime); #endif } - else if (strEQ(remaining, "AINT")) + else if (strEQ(remaining, "AINT")) sv_setiv(sv, TAINTING_get - ? (TAINT_WARN_get || PL_unsafe ? -1 : 1) - : 0); + ? (TAINT_WARN_get || PL_unsafe ? -1 : 1) + : 0); break; case '\025': /* $^UNICODE, $^UTF8LOCALE, $^UTF8CACHE */ - if (strEQ(remaining, "NICODE")) - sv_setuv(sv, (UV) PL_unicode); - else if (strEQ(remaining, "TF8LOCALE")) - sv_setuv(sv, (UV) PL_utf8locale); - else if (strEQ(remaining, "TF8CACHE")) - sv_setiv(sv, (IV) PL_utf8cache); + if (strEQ(remaining, "NICODE")) + sv_setuv(sv, (UV) PL_unicode); + else if (strEQ(remaining, "TF8LOCALE")) + sv_setuv(sv, (UV) PL_utf8locale); + else if (strEQ(remaining, "TF8CACHE")) + sv_setiv(sv, (IV) PL_utf8cache); break; case '\027': /* ^W & $^WARNING_BITS */ - if (nextchar == '\0') - sv_setiv(sv, (IV)cBOOL(PL_dowarn & G_WARN_ON)); - else if (strEQ(remaining, "ARNING_BITS")) { - if (PL_compiling.cop_warnings == pWARN_NONE) { - sv_setpvn(sv, WARN_NONEstring, WARNsize) ; - } - else if (PL_compiling.cop_warnings == pWARN_STD) { + if (nextchar == '\0') + sv_setiv(sv, (IV)cBOOL(PL_dowarn & G_WARN_ON)); + else if (strEQ(remaining, "ARNING_BITS")) { + if (PL_compiling.cop_warnings == pWARN_NONE) { + sv_setpvn(sv, WARN_NONEstring, WARNsize) ; + } + else if (PL_compiling.cop_warnings == pWARN_STD) { goto set_undef; - } + } else if (PL_compiling.cop_warnings == pWARN_ALL) { - sv_setpvn(sv, WARN_ALLstring, WARNsize); - } + sv_setpvn(sv, WARN_ALLstring, WARNsize); + } else { - sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1), - *PL_compiling.cop_warnings); - } - } - break; + sv_setpvn(sv, (char *) (PL_compiling.cop_warnings + 1), + *PL_compiling.cop_warnings); + } + } + break; case '+': - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { - paren = RX_LASTPAREN(rx); - if (paren) + if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { + paren = RX_LASTPAREN(rx); + if (paren) goto do_numbuf_fetch; - } + } goto set_undef; case '\016': /* ^N */ - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { - paren = RX_LASTCLOSEPAREN(rx); - if (paren) + if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { + paren = RX_LASTCLOSEPAREN(rx); + if (paren) goto do_numbuf_fetch; - } + } goto set_undef; case '.': - if (GvIO(PL_last_in_gv)) { - sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv))); - } - break; + if (GvIO(PL_last_in_gv)) { + sv_setiv(sv, (IV)IoLINES(GvIOp(PL_last_in_gv))); + } + break; case '?': - { - sv_setiv(sv, (IV)STATUS_CURRENT); + { + sv_setiv(sv, (IV)STATUS_CURRENT); #ifdef COMPLEX_STATUS - SvUPGRADE(sv, SVt_PVLV); - LvTARGOFF(sv) = PL_statusvalue; - LvTARGLEN(sv) = PL_statusvalue_vms; + SvUPGRADE(sv, SVt_PVLV); + LvTARGOFF(sv) = PL_statusvalue; + LvTARGLEN(sv) = PL_statusvalue_vms; #endif - } - break; + } + break; case '^': - if (GvIOp(PL_defoutgv)) - s = IoTOP_NAME(GvIOp(PL_defoutgv)); - if (s) - sv_setpv(sv,s); - else { - sv_setpv(sv,GvENAME(PL_defoutgv)); - sv_catpvs(sv,"_TOP"); - } - break; + if (GvIOp(PL_defoutgv)) + s = IoTOP_NAME(GvIOp(PL_defoutgv)); + if (s) + sv_setpv(sv,s); + else { + sv_setpv(sv,GvENAME(PL_defoutgv)); + sv_catpvs(sv,"_TOP"); + } + break; case '~': - if (GvIOp(PL_defoutgv)) - s = IoFMT_NAME(GvIOp(PL_defoutgv)); - if (!s) - s = GvENAME(PL_defoutgv); - sv_setpv(sv,s); - break; + if (GvIOp(PL_defoutgv)) + s = IoFMT_NAME(GvIOp(PL_defoutgv)); + if (!s) + s = GvENAME(PL_defoutgv); + sv_setpv(sv,s); + break; case '=': - if (GvIO(PL_defoutgv)) - sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv))); - break; + if (GvIO(PL_defoutgv)) + sv_setiv(sv, (IV)IoPAGE_LEN(GvIOp(PL_defoutgv))); + break; case '-': - if (GvIO(PL_defoutgv)) - sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv))); - break; + if (GvIO(PL_defoutgv)) + sv_setiv(sv, (IV)IoLINES_LEFT(GvIOp(PL_defoutgv))); + break; case '%': - if (GvIO(PL_defoutgv)) - sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv))); - break; + if (GvIO(PL_defoutgv)) + sv_setiv(sv, (IV)IoPAGE(GvIOp(PL_defoutgv))); + break; case ':': case '/': - break; + break; case '[': - sv_setiv(sv, 0); - break; + sv_setiv(sv, 0); + break; case '|': - if (GvIO(PL_defoutgv)) - sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 ); - break; + if (GvIO(PL_defoutgv)) + sv_setiv(sv, (IV)(IoFLAGS(GvIOp(PL_defoutgv)) & IOf_FLUSH) != 0 ); + break; case '\\': - if (PL_ors_sv) - sv_copypv(sv, PL_ors_sv); - else + if (PL_ors_sv) + sv_copypv(sv, PL_ors_sv); + else goto set_undef; - break; + break; case '$': /* $$ */ - { - IV const pid = (IV)PerlProc_getpid(); - if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid) { - /* never set manually, or at least not since last fork */ - sv_setiv(sv, pid); - /* never unsafe, even if reading in a tainted expression */ - SvTAINTED_off(sv); - } - /* else a value has been assigned manually, so do nothing */ - } - break; + { + IV const pid = (IV)PerlProc_getpid(); + if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid) { + /* never set manually, or at least not since last fork */ + sv_setiv(sv, pid); + /* never unsafe, even if reading in a tainted expression */ + SvTAINTED_off(sv); + } + /* else a value has been assigned manually, so do nothing */ + } + break; case '<': sv_setuid(sv, PerlProc_getuid()); - break; + break; case '>': sv_setuid(sv, PerlProc_geteuid()); - break; + break; case '(': sv_setgid(sv, PerlProc_getgid()); - goto add_groups; + goto add_groups; case ')': sv_setgid(sv, PerlProc_getegid()); add_groups: #ifdef HAS_GETGROUPS - { - Groups_t *gary = NULL; + { + Groups_t *gary = NULL; I32 num_groups = getgroups(0, gary); if (num_groups > 0) { I32 i; @@ -1239,12 +1239,12 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg) Perl_sv_catpvf(aTHX_ sv, " %" IVdf, (IV)gary[i]); Safefree(gary); } - } - (void)SvIOK_on(sv); /* what a wonderful hack! */ + } + (void)SvIOK_on(sv); /* what a wonderful hack! */ #endif - break; + break; case '0': - break; + break; } return 0; @@ -1261,7 +1261,7 @@ Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETUVAR; if (uf && uf->uf_val) - (*uf->uf_val)(aTHX_ uf->uf_index, sv); + (*uf->uf_val)(aTHX_ uf->uf_index, sv); return 0; } @@ -1293,76 +1293,76 @@ Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg) /* We just undefd an environment var. Is a replacement */ /* waiting in the wings? */ if (!len) { - SV ** const valp = hv_fetch(GvHVn(PL_envgv), key, klen, FALSE); - if (valp) - s = SvOK(*valp) ? SvPV_const(*valp, len) : ""; + SV ** const valp = hv_fetch(GvHVn(PL_envgv), key, klen, FALSE); + if (valp) + s = SvOK(*valp) ? SvPV_const(*valp, len) : ""; } #endif #if !defined(OS2) && !defined(WIN32) && !defined(MSDOS) - /* And you'll never guess what the dog had */ - /* in its mouth... */ + /* And you'll never guess what the dog had */ + /* in its mouth... */ if (TAINTING_get) { - MgTAINTEDDIR_off(mg); + MgTAINTEDDIR_off(mg); #ifdef VMS - if (s && memEQs(key, klen, "DCL$PATH")) { - char pathbuf[256], eltbuf[256], *cp, *elt; - int i = 0, j = 0; - - my_strlcpy(eltbuf, s, sizeof(eltbuf)); - elt = eltbuf; - do { /* DCL$PATH may be a search list */ - while (1) { /* as may dev portion of any element */ - if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) { - if ( *(cp+1) == '.' || *(cp+1) == '-' || - cando_by_name(S_IWUSR,0,elt) ) { - MgTAINTEDDIR_on(mg); - return 0; - } - } - if ((cp = strchr(elt, ':')) != NULL) - *cp = '\0'; - if (my_trnlnm(elt, eltbuf, j++)) - elt = eltbuf; - else - break; - } - j = 0; - } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf)); - } + if (s && memEQs(key, klen, "DCL$PATH")) { + char pathbuf[256], eltbuf[256], *cp, *elt; + int i = 0, j = 0; + + my_strlcpy(eltbuf, s, sizeof(eltbuf)); + elt = eltbuf; + do { /* DCL$PATH may be a search list */ + while (1) { /* as may dev portion of any element */ + if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) { + if ( *(cp+1) == '.' || *(cp+1) == '-' || + cando_by_name(S_IWUSR,0,elt) ) { + MgTAINTEDDIR_on(mg); + return 0; + } + } + if ((cp = strchr(elt, ':')) != NULL) + *cp = '\0'; + if (my_trnlnm(elt, eltbuf, j++)) + elt = eltbuf; + else + break; + } + j = 0; + } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf)); + } #endif /* VMS */ - if (s && memEQs(key, klen, "PATH")) { - const char * const strend = s + len; + if (s && memEQs(key, klen, "PATH")) { + const char * const strend = s + len; /* set MGf_TAINTEDDIR if any component of the new path is * relative or world-writeable */ - while (s < strend) { - char tmpbuf[256]; - Stat_t st; - I32 i; + while (s < strend) { + char tmpbuf[256]; + Stat_t st; + I32 i; #ifdef __VMS /* Hmm. How do we get $Config{path_sep} from C? */ - const char path_sep = PL_perllib_sep; + const char path_sep = PL_perllib_sep; #else - const char path_sep = ':'; + const char path_sep = ':'; #endif - s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, - s, strend, path_sep, &i); - s++; - if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */ + s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, + s, strend, path_sep, &i); + s++; + if (i >= (I32)sizeof tmpbuf /* too long -- assume the worst */ #ifdef __VMS - /* no colon thus no device name -- assume relative path */ - || (PL_perllib_sep != ':' && !strchr(tmpbuf, ':')) - /* Using Unix separator, e.g. under bash, so act line Unix */ - || (PL_perllib_sep == ':' && *tmpbuf != '/') + /* no colon thus no device name -- assume relative path */ + || (PL_perllib_sep != ':' && !strchr(tmpbuf, ':')) + /* Using Unix separator, e.g. under bash, so act line Unix */ + || (PL_perllib_sep == ':' && *tmpbuf != '/') #else - || *tmpbuf != '/' /* no starting slash -- assume relative path */ + || *tmpbuf != '/' /* no starting slash -- assume relative path */ #endif - || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { - MgTAINTEDDIR_on(mg); - return 0; - } - } - } + || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) { + MgTAINTEDDIR_on(mg); + return 0; + } + } + } } #endif /* neither OS2 nor WIN32 nor MSDOS */ @@ -1387,14 +1387,14 @@ Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg) Perl_die(aTHX_ "Can't make list assignment to %%ENV on this system"); #else if (PL_localizing) { - HE* entry; - my_clearenv(); - hv_iterinit(MUTABLE_HV(sv)); - while ((entry = hv_iternext(MUTABLE_HV(sv)))) { - I32 keylen; - my_setenv(hv_iterkey(entry, &keylen), - SvPV_nolen_const(hv_iterval(MUTABLE_HV(sv), entry))); - } + HE* entry; + my_clearenv(); + hv_iterinit(MUTABLE_HV(sv)); + while ((entry = hv_iternext(MUTABLE_HV(sv)))) { + I32 keylen; + my_setenv(hv_iterkey(entry, &keylen), + SvPV_nolen_const(hv_iterval(MUTABLE_HV(sv), entry))); + } } #endif return 0; @@ -1438,26 +1438,26 @@ Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg) } if (i > 0) { - if(PL_psig_ptr[i]) - sv_setsv(sv,PL_psig_ptr[i]); - else { - Sighandler_t sigstate = rsignal_state(i); + if(PL_psig_ptr[i]) + sv_setsv(sv,PL_psig_ptr[i]); + else { + Sighandler_t sigstate = rsignal_state(i); #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS - if (PL_sig_handlers_initted && PL_sig_ignoring[i]) - sigstate = SIG_IGN; + if (PL_sig_handlers_initted && PL_sig_ignoring[i]) + sigstate = SIG_IGN; #endif #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS - if (PL_sig_handlers_initted && PL_sig_defaulting[i]) - sigstate = SIG_DFL; + if (PL_sig_handlers_initted && PL_sig_defaulting[i]) + sigstate = SIG_DFL; #endif - /* cache state so we don't fetch it again */ - if(sigstate == (Sighandler_t) SIG_IGN) - sv_setpvs(sv,"IGNORE"); - else + /* cache state so we don't fetch it again */ + if(sigstate == (Sighandler_t) SIG_IGN) + sv_setpvs(sv,"IGNORE"); + else sv_set_undef(sv); - PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); - SvTEMP_off(sv); - } + PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); + SvTEMP_off(sv); + } } return 0; } @@ -1531,17 +1531,17 @@ Perl_csighandler3(int sig, Siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSE #endif if ( #ifdef SIGILL - sig == SIGILL || + sig == SIGILL || #endif #ifdef SIGBUS - sig == SIGBUS || + sig == SIGBUS || #endif #ifdef SIGSEGV - sig == SIGSEGV || + sig == SIGSEGV || #endif - (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)) - /* Call the perl level handler now-- - * with risk we may be in malloc() or being destructed etc. */ + (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)) + /* Call the perl level handler now-- + * with risk we may be in malloc() or being destructed etc. */ { if (PL_sighandlerp == Perl_sighandler) /* default handler, so can call perly_sighandler() directly @@ -1557,18 +1557,18 @@ Perl_csighandler3(int sig, Siginfo_t *sip PERL_UNUSED_DECL, void *uap PERL_UNUSE #endif } else { - if (!PL_psig_pend) return; - /* Set a flag to say this signal is pending, that is awaiting delivery after - * the current Perl opcode completes */ - PL_psig_pend[sig]++; + if (!PL_psig_pend) return; + /* Set a flag to say this signal is pending, that is awaiting delivery after + * the current Perl opcode completes */ + PL_psig_pend[sig]++; #ifndef SIG_PENDING_DIE_COUNT # define SIG_PENDING_DIE_COUNT 120 #endif - /* Add one to say _a_ signal is pending */ - if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) - Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded", - (unsigned long)SIG_PENDING_DIE_COUNT); + /* Add one to say _a_ signal is pending */ + if (++PL_sig_pending >= SIG_PENDING_DIE_COUNT) + Perl_croak(aTHX_ "Maximal count of pending signals (%lu) exceeded", + (unsigned long)SIG_PENDING_DIE_COUNT); } } @@ -1608,31 +1608,31 @@ Perl_despatch_signals(pTHX) int sig; PL_sig_pending = 0; for (sig = 1; sig < SIG_SIZE; sig++) { - if (PL_psig_pend[sig]) { - dSAVE_ERRNO; + if (PL_psig_pend[sig]) { + dSAVE_ERRNO; #ifdef HAS_SIGPROCMASK - /* From sigaction(2) (FreeBSD man page): - * | Signal routines normally execute with the signal that - * | caused their invocation blocked, but other signals may - * | yet occur. - * Emulation of this behavior (from within Perl) is enabled - * using sigprocmask - */ - int was_blocked; - sigset_t newset, oldset; - - sigemptyset(&newset); - sigaddset(&newset, sig); - sigprocmask(SIG_BLOCK, &newset, &oldset); - was_blocked = sigismember(&oldset, sig); - if (!was_blocked) { - SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t)); - ENTER; - SAVEFREESV(save_sv); - SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv)); - } -#endif - PL_psig_pend[sig] = 0; + /* From sigaction(2) (FreeBSD man page): + * | Signal routines normally execute with the signal that + * | caused their invocation blocked, but other signals may + * | yet occur. + * Emulation of this behavior (from within Perl) is enabled + * using sigprocmask + */ + int was_blocked; + sigset_t newset, oldset; + + sigemptyset(&newset); + sigaddset(&newset, sig); + sigprocmask(SIG_BLOCK, &newset, &oldset); + was_blocked = sigismember(&oldset, sig); + if (!was_blocked) { + SV* save_sv = newSVpvn((char *)(&newset), sizeof(sigset_t)); + ENTER; + SAVEFREESV(save_sv); + SAVEDESTRUCTOR_X(unblock_sigmask, SvPV_nolen(save_sv)); + } +#endif + PL_psig_pend[sig] = 0; if (PL_sighandlerp == Perl_sighandler) /* default handler, so can call perly_sighandler() directly * rather than via Perl_sighandler, passing the extra @@ -1647,11 +1647,11 @@ Perl_despatch_signals(pTHX) #endif #ifdef HAS_SIGPROCMASK - if (!was_blocked) - LEAVE; + if (!was_blocked) + LEAVE; #endif - RESTORE_ERRNO; - } + RESTORE_ERRNO; + } } } @@ -1677,134 +1677,134 @@ Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg) if (*s == '_') { if (memEQs(s, len, "__DIE__")) - svp = &PL_diehook; - else if (memEQs(s, len, "__WARN__") - && (sv ? 1 : PL_warnhook != PERL_WARNHOOK_FATAL)) { - /* Merge the existing behaviours, which are as follows: - magic_setsig, we always set svp to &PL_warnhook - (hence we always change the warnings handler) - For magic_clearsig, we don't change the warnings handler if it's - set to the &PL_warnhook. */ - svp = &PL_warnhook; + svp = &PL_diehook; + else if (memEQs(s, len, "__WARN__") + && (sv ? 1 : PL_warnhook != PERL_WARNHOOK_FATAL)) { + /* Merge the existing behaviours, which are as follows: + magic_setsig, we always set svp to &PL_warnhook + (hence we always change the warnings handler) + For magic_clearsig, we don't change the warnings handler if it's + set to the &PL_warnhook. */ + svp = &PL_warnhook; } else if (sv) { SV *tmp = sv_newmortal(); Perl_croak(aTHX_ "No such hook: %s", pv_pretty(tmp, s, len, 0, NULL, NULL, 0)); } - i = 0; - if (svp && *svp) { - if (*svp != PERL_WARNHOOK_FATAL) - to_dec = *svp; - *svp = NULL; - } + i = 0; + if (svp && *svp) { + if (*svp != PERL_WARNHOOK_FATAL) + to_dec = *svp; + *svp = NULL; + } } else { - i = (I16)mg->mg_private; - if (!i) { - i = whichsig_pvn(s, len); /* ...no, a brick */ - mg->mg_private = (U16)i; - } - if (i <= 0) { - if (sv) { + i = (I16)mg->mg_private; + if (!i) { + i = whichsig_pvn(s, len); /* ...no, a brick */ + mg->mg_private = (U16)i; + } + if (i <= 0) { + if (sv) { SV *tmp = sv_newmortal(); - Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", + Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), "No such signal: SIG%s", pv_pretty(tmp, s, len, 0, NULL, NULL, 0)); } - return 0; - } + return 0; + } #ifdef HAS_SIGPROCMASK - /* Avoid having the signal arrive at a bad time, if possible. */ - sigemptyset(&set); - sigaddset(&set,i); - sigprocmask(SIG_BLOCK, &set, &save); - ENTER; - save_sv = newSVpvn((char *)(&save), sizeof(sigset_t)); - SAVEFREESV(save_sv); - SAVEDESTRUCTOR_X(restore_sigmask, save_sv); -#endif - PERL_ASYNC_CHECK(); + /* Avoid having the signal arrive at a bad time, if possible. */ + sigemptyset(&set); + sigaddset(&set,i); + sigprocmask(SIG_BLOCK, &set, &save); + ENTER; + save_sv = newSVpvn((char *)(&save), sizeof(sigset_t)); + SAVEFREESV(save_sv); + SAVEDESTRUCTOR_X(restore_sigmask, save_sv); +#endif + PERL_ASYNC_CHECK(); #if defined(FAKE_PERSISTENT_SIGNAL_HANDLERS) || defined(FAKE_DEFAULT_SIGNAL_HANDLERS) - if (!PL_sig_handlers_initted) Perl_csighandler_init(); + if (!PL_sig_handlers_initted) Perl_csighandler_init(); #endif #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS - PL_sig_ignoring[i] = 0; + PL_sig_ignoring[i] = 0; #endif #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS - PL_sig_defaulting[i] = 0; -#endif - to_dec = PL_psig_ptr[i]; - if (sv) { - PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); - SvTEMP_off(sv); /* Make sure it doesn't go away on us */ - - /* Signals don't change name during the program's execution, so once - they're cached in the appropriate slot of PL_psig_name, they can - stay there. - - Ideally we'd find some way of making SVs at (C) compile time, or - at least, doing most of the work. */ - if (!PL_psig_name[i]) { - const char* name = PL_sig_name[i]; - PL_psig_name[i] = newSVpvn(name, strlen(name)); - SvREADONLY_on(PL_psig_name[i]); - } - } else { - SvREFCNT_dec(PL_psig_name[i]); - PL_psig_name[i] = NULL; - PL_psig_ptr[i] = NULL; - } + PL_sig_defaulting[i] = 0; +#endif + to_dec = PL_psig_ptr[i]; + if (sv) { + PL_psig_ptr[i] = SvREFCNT_inc_simple_NN(sv); + SvTEMP_off(sv); /* Make sure it doesn't go away on us */ + + /* Signals don't change name during the program's execution, so once + they're cached in the appropriate slot of PL_psig_name, they can + stay there. + + Ideally we'd find some way of making SVs at (C) compile time, or + at least, doing most of the work. */ + if (!PL_psig_name[i]) { + const char* name = PL_sig_name[i]; + PL_psig_name[i] = newSVpvn(name, strlen(name)); + SvREADONLY_on(PL_psig_name[i]); + } + } else { + SvREFCNT_dec(PL_psig_name[i]); + PL_psig_name[i] = NULL; + PL_psig_ptr[i] = NULL; + } } if (sv && (isGV_with_GP(sv) || SvROK(sv))) { - if (i) { - (void)rsignal(i, PL_csighandlerp); - } - else - *svp = SvREFCNT_inc_simple_NN(sv); + if (i) { + (void)rsignal(i, PL_csighandlerp); + } + else + *svp = SvREFCNT_inc_simple_NN(sv); } else { - if (sv && SvOK(sv)) { - s = SvPV_force(sv, len); - } else { - sv = NULL; - } - if (sv && memEQs(s, len,"IGNORE")) { - if (i) { + if (sv && SvOK(sv)) { + s = SvPV_force(sv, len); + } else { + sv = NULL; + } + if (sv && memEQs(s, len,"IGNORE")) { + if (i) { #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS - PL_sig_ignoring[i] = 1; - (void)rsignal(i, PL_csighandlerp); + PL_sig_ignoring[i] = 1; + (void)rsignal(i, PL_csighandlerp); #else - (void)rsignal(i, (Sighandler_t) SIG_IGN); + (void)rsignal(i, (Sighandler_t) SIG_IGN); #endif - } - } - else if (!sv || memEQs(s, len,"DEFAULT") || !len) { - if (i) { + } + } + else if (!sv || memEQs(s, len,"DEFAULT") || !len) { + if (i) { #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS - PL_sig_defaulting[i] = 1; - (void)rsignal(i, PL_csighandlerp); + PL_sig_defaulting[i] = 1; + (void)rsignal(i, PL_csighandlerp); #else - (void)rsignal(i, (Sighandler_t) SIG_DFL); -#endif - } - } - else { - /* - * We should warn if HINT_STRICT_REFS, but without - * access to a known hint bit in a known OP, we can't - * tell whether HINT_STRICT_REFS is in force or not. - */ - if (!memchr(s, ':', len) && !memchr(s, '\'', len)) - Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"), - SV_GMAGIC); - if (i) - (void)rsignal(i, PL_csighandlerp); - else - *svp = SvREFCNT_inc_simple_NN(sv); - } + (void)rsignal(i, (Sighandler_t) SIG_DFL); +#endif + } + } + else { + /* + * We should warn if HINT_STRICT_REFS, but without + * access to a known hint bit in a known OP, we can't + * tell whether HINT_STRICT_REFS is in force or not. + */ + if (!memchr(s, ':', len) && !memchr(s, '\'', len)) + Perl_sv_insert_flags(aTHX_ sv, 0, 0, STR_WITH_LEN("main::"), + SV_GMAGIC); + if (i) + (void)rsignal(i, PL_csighandlerp); + else + *svp = SvREFCNT_inc_simple_NN(sv); + } } #ifdef HAS_SIGPROCMASK if(i) - LEAVE; + LEAVE; #endif SvREFCNT_dec(to_dec); return 0; @@ -1819,7 +1819,7 @@ Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg) /* Skip _isaelem because _isa will handle it shortly */ if (PL_delaymagic & DM_ARRAY_ISA && mg->mg_type == PERL_MAGIC_isaelem) - return 0; + return 0; return magic_clearisa(NULL, mg); } @@ -1835,23 +1835,23 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) if(PL_phase == PERL_PHASE_DESTRUCT) return 0; if (sv) - av_clear(MUTABLE_AV(sv)); + av_clear(MUTABLE_AV(sv)); if (SvTYPE(mg->mg_obj) != SVt_PVGV && SvSMAGICAL(mg->mg_obj)) - /* This occurs with setisa_elem magic, which calls this - same function. */ - mg = mg_find(mg->mg_obj, PERL_MAGIC_isa); + /* This occurs with setisa_elem magic, which calls this + same function. */ + mg = mg_find(mg->mg_obj, PERL_MAGIC_isa); assert(mg); if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */ - SV **svp = AvARRAY((AV *)mg->mg_obj); - I32 items = AvFILLp((AV *)mg->mg_obj) + 1; - while (items--) { - stash = GvSTASH((GV *)*svp++); - if (stash && HvENAME(stash)) mro_isa_changed_in(stash); - } + SV **svp = AvARRAY((AV *)mg->mg_obj); + I32 items = AvFILLp((AV *)mg->mg_obj) + 1; + while (items--) { + stash = GvSTASH((GV *)*svp++); + if (stash && HvENAME(stash)) mro_isa_changed_in(stash); + } - return 0; + return 0; } stash = GvSTASH( @@ -1861,7 +1861,7 @@ Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg) /* The stash may have been detached from the symbol table, so check its name before doing anything. */ if (stash && HvENAME_get(stash)) - mro_isa_changed_in(stash); + mro_isa_changed_in(stash); return 0; } @@ -1878,10 +1878,10 @@ Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg) if (hv) { (void) hv_iterinit(hv); if (! SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) - i = HvUSEDKEYS(hv); + i = HvUSEDKEYS(hv); else { - while (hv_iternext(hv)) - i++; + while (hv_iternext(hv)) + i++; } } @@ -1895,7 +1895,7 @@ Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETNKEYS; PERL_UNUSED_ARG(mg); if (LvTARG(sv)) { - hv_ksplit(MUTABLE_HV(LvTARG(sv)), SvIV(sv)); + hv_ksplit(MUTABLE_HV(LvTARG(sv)), SvIV(sv)); } return 0; } @@ -1929,7 +1929,7 @@ Returns the SV (if any) returned by the method, or C on failure. SV* Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, - U32 argc, ...) + U32 argc, ...) { dSP; SV* ret = NULL; @@ -1939,11 +1939,11 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, ENTER; if (flags & G_WRITING_TO_STDERR) { - SAVETMPS; + SAVETMPS; - save_re_context(); - SAVESPTR(PL_stderrgv); - PL_stderrgv = NULL; + save_re_context(); + SAVESPTR(PL_stderrgv); + PL_stderrgv = NULL; } PUSHSTACKi(PERLSI_MAGIC); @@ -1954,31 +1954,31 @@ Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, EXTEND(SP, (I32)argc+1); PUSHs(SvTIED_obj(sv, mg)); if (flags & G_UNDEF_FILL) { - while (argc--) { - PUSHs(&PL_sv_undef); - } + while (argc--) { + PUSHs(&PL_sv_undef); + } } else if (argc > 0) { - va_list args; - va_start(args, argc); + va_list args; + va_start(args, argc); - do { - SV *const this_sv = va_arg(args, SV *); - PUSHs(this_sv); - } while (--argc); + do { + SV *const this_sv = va_arg(args, SV *); + PUSHs(this_sv); + } while (--argc); - va_end(args); + va_end(args); } PUTBACK; if (flags & G_DISCARD) { - call_sv(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED); + call_sv(meth, G_SCALAR|G_DISCARD|G_METHOD_NAMED); } else { - if (call_sv(meth, G_SCALAR|G_METHOD_NAMED)) - ret = *PL_stack_sp--; + if (call_sv(meth, G_SCALAR|G_METHOD_NAMED)) + ret = *PL_stack_sp--; } POPSTACK; if (flags & G_WRITING_TO_STDERR) - FREETMPS; + FREETMPS; LEAVE; return ret; } @@ -1994,18 +1994,18 @@ S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags, PERL_ARGS_ASSERT_MAGIC_METHCALL1; if (mg->mg_ptr) { - if (mg->mg_len >= 0) { - arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); - } - else if (mg->mg_len == HEf_SVKEY) - arg1 = MUTABLE_SV(mg->mg_ptr); + if (mg->mg_len >= 0) { + arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); + } + else if (mg->mg_len == HEf_SVKEY) + arg1 = MUTABLE_SV(mg->mg_ptr); } else if (mg->mg_type == PERL_MAGIC_tiedelem) { - arg1 = newSViv((IV)(mg->mg_len)); - sv_2mortal(arg1); + arg1 = newSViv((IV)(mg->mg_len)); + sv_2mortal(arg1); } if (!arg1) { - return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val); + return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val); } return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val); } @@ -2019,7 +2019,7 @@ S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth) ret = magic_methcall1(sv, mg, meth, 0, 1, NULL); if (ret) - sv_setsv(sv, ret); + sv_setsv(sv, ret); return 0; } @@ -2029,7 +2029,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETPACK; if (mg->mg_type == PERL_MAGIC_tiedelem) - mg->mg_flags |= MGf_GSKIP; + mg->mg_flags |= MGf_GSKIP; magic_methpack(sv,mg,SV_CONST(FETCH)); return 0; } @@ -2053,13 +2053,13 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg) * re-enabling magic on sv). */ if (TAINTING_get && (tmg = mg_find(sv, PERL_MAGIC_taint)) - && (tmg->mg_len & 1)) + && (tmg->mg_len & 1)) { - val = sv_mortalcopy(sv); - SvTAINTED_on(val); + val = sv_mortalcopy(sv); + SvTAINTED_on(val); } else - val = sv; + val = sv; magic_methcall1(sv, mg, SV_CONST(STORE), G_DISCARD, 2, val); return 0; @@ -2085,9 +2085,9 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg) retsv = magic_methcall1(sv, mg, SV_CONST(FETCHSIZE), 0, 1, NULL); if (retsv) { - retval = SvIV(retsv)-1; - if (retval < -1) - Perl_croak(aTHX_ "FETCHSIZE returned a negative value"); + retval = SvIV(retsv)-1; + if (retval < -1) + Perl_croak(aTHX_ "FETCHSIZE returned a negative value"); } return (U32) retval; } @@ -2109,9 +2109,9 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) PERL_ARGS_ASSERT_MAGIC_NEXTPACK; ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(NEXTKEY), 0, 1, key) - : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0); + : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0); if (ret) - sv_setsv(key,ret); + sv_setsv(key,ret); return 0; } @@ -2147,7 +2147,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) /* there is a SCALAR method that we can call */ retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0); if (!retval) - retval = &PL_sv_undef; + retval = &PL_sv_undef; return retval; } @@ -2167,23 +2167,23 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) /* Use sv_2iv instead of SvIV() as the former generates smaller code, and setting/clearing debugger breakpoints is not a hot path. */ svp = av_fetch(MUTABLE_AV(mg->mg_obj), - sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); + sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); if (svp && SvIOKp(*svp)) { - OP * const o = INT2PTR(OP*,SvIVX(*svp)); - if (o) { + OP * const o = INT2PTR(OP*,SvIVX(*svp)); + if (o) { #ifdef PERL_DEBUG_READONLY_OPS - Slab_to_rw(OpSLAB(o)); + Slab_to_rw(OpSLAB(o)); #endif - /* set or clear breakpoint in the relevant control op */ - if (SvTRUE(sv)) - o->op_flags |= OPf_SPECIAL; - else - o->op_flags &= ~OPf_SPECIAL; + /* set or clear breakpoint in the relevant control op */ + if (SvTRUE(sv)) + o->op_flags |= OPf_SPECIAL; + else + o->op_flags &= ~OPf_SPECIAL; #ifdef PERL_DEBUG_READONLY_OPS - Slab_to_ro(OpSLAB(o)); + Slab_to_ro(OpSLAB(o)); #endif - } + } } return 0; } @@ -2196,7 +2196,7 @@ Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_GETARYLEN; if (obj) { - sv_setiv(sv, AvFILL(obj)); + sv_setiv(sv, AvFILL(obj)); } else { sv_set_undef(sv); } @@ -2211,10 +2211,10 @@ Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETARYLEN; if (obj) { - av_fill(obj, SvIV(sv)); + av_fill(obj, SvIV(sv)); } else { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Attempt to set length of freed array"); + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "Attempt to set length of freed array"); } return 0; } @@ -2228,10 +2228,10 @@ Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg) /* Reset the iterator when the array is cleared */ if (sizeof(IV) == sizeof(SSize_t)) { - *((IV *) &(mg->mg_len)) = 0; + *((IV *) &(mg->mg_len)) = 0; } else { - if (mg->mg_ptr) - *((IV *) mg->mg_ptr) = 0; + if (mg->mg_ptr) + *((IV *) mg->mg_ptr) = 0; } return 0; @@ -2245,17 +2245,17 @@ Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg) /* during global destruction, mg_obj may already have been freed */ if (PL_in_clean_all) - return 0; + return 0; mg = mg_find (mg->mg_obj, PERL_MAGIC_arylen); if (mg) { - /* arylen scalar holds a pointer back to the array, but doesn't own a - reference. Hence the we (the array) are about to go away with it - still pointing at us. Clear its pointer, else it would be pointing - at free memory. See the comment in sv_magic about reference loops, - and why it can't own a reference to us. */ - mg->mg_obj = 0; + /* arylen scalar holds a pointer back to the array, but doesn't own a + reference. Hence the we (the array) are about to go away with it + still pointing at us. Clear its pointer, else it would be pointing + at free memory. See the comment in sv_magic about reference loops, + and why it can't own a reference to us. */ + mg->mg_obj = 0; } return 0; } @@ -2270,11 +2270,11 @@ Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg) PERL_UNUSED_ARG(mg); if (found && found->mg_len != -1) { - STRLEN i = found->mg_len; - if (found->mg_flags & MGf_BYTES && DO_UTF8(lsv)) - i = sv_pos_b2u_flags(lsv, i, SV_GMAGIC|SV_CONST_RETURN); - sv_setuv(sv, i); - return 0; + STRLEN i = found->mg_len; + if (found->mg_flags & MGf_BYTES && DO_UTF8(lsv)) + i = sv_pos_b2u_flags(lsv, i, SV_GMAGIC|SV_CONST_RETURN); + sv_setuv(sv, i); + return 0; } sv_set_undef(sv); return 0; @@ -2294,13 +2294,13 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) found = mg_find_mglob(lsv); if (!found) { - if (!SvOK(sv)) - return 0; - found = sv_magicext_mglob(lsv); + if (!SvOK(sv)) + return 0; + found = sv_magicext_mglob(lsv); } else if (!SvOK(sv)) { - found->mg_len = -1; - return 0; + found->mg_len = -1; + return 0; } s = SvPV_const(lsv, len); @@ -2308,17 +2308,17 @@ Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg) if (DO_UTF8(lsv)) { const STRLEN ulen = sv_or_pv_len_utf8(lsv, s, len); - if (ulen) - len = ulen; + if (ulen) + len = ulen; } if (pos < 0) { - pos += len; - if (pos < 0) - pos = 0; + pos += len; + if (pos < 0) + pos = 0; } else if (pos > (SSize_t)len) - pos = len; + pos = len; found->mg_len = pos; found->mg_flags &= ~(MGf_MINMATCH|MGf_BYTES); @@ -2341,17 +2341,17 @@ Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg) PERL_UNUSED_ARG(mg); if (!translate_substr_offsets( - SvUTF8(lsv) ? sv_or_pv_len_utf8(lsv, tmps, len) : len, - negoff ? -(IV)offs : (IV)offs, !negoff, - negrem ? -(IV)rem : (IV)rem, !negrem, &offs, &rem + SvUTF8(lsv) ? sv_or_pv_len_utf8(lsv, tmps, len) : len, + negoff ? -(IV)offs : (IV)offs, !negoff, + negrem ? -(IV)rem : (IV)rem, !negrem, &offs, &rem )) { - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); + Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), "substr outside of string"); sv_set_undef(sv); - return 0; + return 0; } if (SvUTF8(lsv)) - offs = sv_or_pv_pos_u2b(lsv, tmps, offs, &rem); + offs = sv_or_pv_pos_u2b(lsv, tmps, offs, &rem); sv_setpvn(sv, tmps + offs, rem); if (SvUTF8(lsv)) SvUTF8_on(sv); @@ -2374,36 +2374,36 @@ Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg) SvGETMAGIC(lsv); if (SvROK(lsv)) - Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), - "Attempt to use reference as lvalue in substr" - ); + Perl_ck_warner(aTHX_ packWARN(WARN_SUBSTR), + "Attempt to use reference as lvalue in substr" + ); SvPV_force_nomg(lsv,lsv_len); if (SvUTF8(lsv)) lsv_len = sv_len_utf8_nomg(lsv); if (!translate_substr_offsets( - lsv_len, - negoff ? -(IV)lvoff : (IV)lvoff, !negoff, - neglen ? -(IV)lvlen : (IV)lvlen, !neglen, &lvoff, &lvlen + lsv_len, + negoff ? -(IV)lvoff : (IV)lvoff, !negoff, + neglen ? -(IV)lvlen : (IV)lvlen, !neglen, &lvoff, &lvlen )) - Perl_croak(aTHX_ "substr outside of string"); + Perl_croak(aTHX_ "substr outside of string"); oldtarglen = lvlen; if (DO_UTF8(sv)) { - sv_utf8_upgrade_nomg(lsv); - lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN); - sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0); - newtarglen = sv_or_pv_len_utf8(sv, tmps, len); - SvUTF8_on(lsv); + sv_utf8_upgrade_nomg(lsv); + lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN); + sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0); + newtarglen = sv_or_pv_len_utf8(sv, tmps, len); + SvUTF8_on(lsv); } else if (SvUTF8(lsv)) { - const char *utf8; - lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN); - newtarglen = len; - utf8 = (char*)bytes_to_utf8((U8*)tmps, &len); - sv_insert_flags(lsv, lvoff, lvlen, utf8, len, 0); - Safefree(utf8); + const char *utf8; + lvoff = sv_pos_u2b_flags(lsv, lvoff, &lvlen, SV_CONST_RETURN); + newtarglen = len; + utf8 = (char*)bytes_to_utf8((U8*)tmps, &len); + sv_insert_flags(lsv, lvoff, lvlen, utf8, len, 0); + Safefree(utf8); } else { - sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0); - newtarglen = len; + sv_insert_flags(lsv, lvoff, lvlen, tmps, len, 0); + newtarglen = len; } if (!neglen) LvTARGLEN(sv) = newtarglen; if (negoff) LvTARGOFF(sv) += newtarglen - oldtarglen; @@ -2432,9 +2432,9 @@ Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg) /* update taint status */ if (TAINT_get) - mg->mg_len |= 1; + mg->mg_len |= 1; else - mg->mg_len &= ~1; + mg->mg_len &= ~1; return 0; } @@ -2471,37 +2471,37 @@ Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg) if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem); assert(mg); if (LvTARGLEN(sv)) { - if (mg->mg_obj) { - SV * const ahv = LvTARG(sv); - HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, FALSE, 0); + if (mg->mg_obj) { + SV * const ahv = LvTARG(sv); + HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, FALSE, 0); if (he) targ = HeVAL(he); - } - else if (LvSTARGOFF(sv) >= 0) { - AV *const av = MUTABLE_AV(LvTARG(sv)); - if (LvSTARGOFF(sv) <= AvFILL(av)) - { - if (SvRMAGICAL(av)) { - SV * const * const svp = av_fetch(av, LvSTARGOFF(sv), 0); - targ = svp ? *svp : NULL; - } - else - targ = AvARRAY(av)[LvSTARGOFF(sv)]; - } - } - if (targ && (targ != &PL_sv_undef)) { - /* somebody else defined it for us */ - SvREFCNT_dec(LvTARG(sv)); - LvTARG(sv) = SvREFCNT_inc_simple_NN(targ); - LvTARGLEN(sv) = 0; - SvREFCNT_dec(mg->mg_obj); - mg->mg_obj = NULL; - mg->mg_flags &= ~MGf_REFCOUNTED; - } - return targ; + } + else if (LvSTARGOFF(sv) >= 0) { + AV *const av = MUTABLE_AV(LvTARG(sv)); + if (LvSTARGOFF(sv) <= AvFILL(av)) + { + if (SvRMAGICAL(av)) { + SV * const * const svp = av_fetch(av, LvSTARGOFF(sv), 0); + targ = svp ? *svp : NULL; + } + else + targ = AvARRAY(av)[LvSTARGOFF(sv)]; + } + } + if (targ && (targ != &PL_sv_undef)) { + /* somebody else defined it for us */ + SvREFCNT_dec(LvTARG(sv)); + LvTARG(sv) = SvREFCNT_inc_simple_NN(targ); + LvTARGLEN(sv) = 0; + SvREFCNT_dec(mg->mg_obj); + mg->mg_obj = NULL; + mg->mg_flags &= ~MGf_REFCOUNTED; + } + return targ; } else - return LvTARG(sv); + return LvTARG(sv); } int @@ -2519,10 +2519,10 @@ Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETDEFELEM; PERL_UNUSED_ARG(mg); if (LvTARGLEN(sv)) - vivify_defelem(sv); + vivify_defelem(sv); if (LvTARG(sv)) { - sv_setsv(LvTARG(sv), sv); - SvSETMAGIC(LvTARG(sv)); + sv_setsv(LvTARG(sv), sv); + SvSETMAGIC(LvTARG(sv)); } return 0; } @@ -2536,26 +2536,26 @@ Perl_vivify_defelem(pTHX_ SV *sv) PERL_ARGS_ASSERT_VIVIFY_DEFELEM; if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem))) - return; + return; if (mg->mg_obj) { - SV * const ahv = LvTARG(sv); - HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, TRUE, 0); + SV * const ahv = LvTARG(sv); + HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, TRUE, 0); if (he) value = HeVAL(he); - if (!value || value == &PL_sv_undef) - Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj)); + if (!value || value == &PL_sv_undef) + Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj)); } else if (LvSTARGOFF(sv) < 0) - Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); + Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); else { - AV *const av = MUTABLE_AV(LvTARG(sv)); - if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av)) - LvTARG(sv) = NULL; /* array can't be extended */ - else { - SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE); - if (!svp || !(value = *svp)) - Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); - } + AV *const av = MUTABLE_AV(LvTARG(sv)); + if ((I32)LvTARGLEN(sv) < 0 && LvSTARGOFF(sv) > AvFILL(av)) + LvTARG(sv) = NULL; /* array can't be extended */ + else { + SV* const * const svp = av_fetch(av, LvSTARGOFF(sv), TRUE); + if (!svp || !(value = *svp)) + Perl_croak(aTHX_ PL_no_aelem, LvSTARGOFF(sv)); + } } SvREFCNT_inc_simple_void(value); SvREFCNT_dec(LvTARG(sv)); @@ -2618,7 +2618,7 @@ Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SETUVAR; if (uf && uf->uf_set) - (*uf->uf_set)(aTHX_ uf->uf_index, sv); + (*uf->uf_set)(aTHX_ uf->uf_index, sv); return 0; } @@ -2648,9 +2648,9 @@ Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg) PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(sv); if (mg->mg_ptr) { - Safefree(mg->mg_ptr); - mg->mg_ptr = NULL; - mg->mg_len = -1; + Safefree(mg->mg_ptr); + mg->mg_ptr = NULL; + mg->mg_len = -1; } return 0; } @@ -2711,52 +2711,52 @@ Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg) if (!SvROK(sv)) Perl_croak(aTHX_ "Assigned value is not a reference"); switch (mg->mg_private & OPpLVREF_TYPE) { case OPpLVREF_SV: - if (SvTYPE(SvRV(sv)) > SVt_PVLV) - bad = " SCALAR"; - break; + if (SvTYPE(SvRV(sv)) > SVt_PVLV) + bad = " SCALAR"; + break; case OPpLVREF_AV: - if (SvTYPE(SvRV(sv)) != SVt_PVAV) - bad = "n ARRAY"; - break; + if (SvTYPE(SvRV(sv)) != SVt_PVAV) + bad = "n ARRAY"; + break; case OPpLVREF_HV: - if (SvTYPE(SvRV(sv)) != SVt_PVHV) - bad = " HASH"; - break; + if (SvTYPE(SvRV(sv)) != SVt_PVHV) + bad = " HASH"; + break; case OPpLVREF_CV: - if (SvTYPE(SvRV(sv)) != SVt_PVCV) - bad = " CODE"; + if (SvTYPE(SvRV(sv)) != SVt_PVCV) + bad = " CODE"; } if (bad) - /* diag_listed_as: Assigned value is not %s reference */ - Perl_croak(aTHX_ "Assigned value is not a%s reference", bad); + /* diag_listed_as: Assigned value is not %s reference */ + Perl_croak(aTHX_ "Assigned value is not a%s reference", bad); switch (mg->mg_obj ? SvTYPE(mg->mg_obj) : 0) { case 0: { - SV * const old = PAD_SV(mg->mg_len); - PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv))); - SvREFCNT_dec(old); - break; + SV * const old = PAD_SV(mg->mg_len); + PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv))); + SvREFCNT_dec(old); + break; } case SVt_PVGV: - gv_setref(mg->mg_obj, sv); - SvSETMAGIC(mg->mg_obj); - break; + gv_setref(mg->mg_obj, sv); + SvSETMAGIC(mg->mg_obj); + break; case SVt_PVAV: - av_store((AV *)mg->mg_obj, SvIV((SV *)mg->mg_ptr), - SvREFCNT_inc_simple_NN(SvRV(sv))); - break; + av_store((AV *)mg->mg_obj, SvIV((SV *)mg->mg_ptr), + SvREFCNT_inc_simple_NN(SvRV(sv))); + break; case SVt_PVHV: - (void)hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr, + (void)hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr, SvREFCNT_inc_simple_NN(SvRV(sv)), 0); } if (mg->mg_flags & MGf_PERSIST) - NOOP; /* This sv is in use as an iterator var and will be reused, - so we must leave the magic. */ + NOOP; /* This sv is in use as an iterator var and will be reused, + so we must leave the magic. */ else - /* This sv could be returned by the assignment op, so clear the - magic, as lvrefs are an implementation detail that must not be - leaked to the user. */ - sv_unmagic(sv, PERL_MAGIC_lvref); + /* This sv could be returned by the assignment op, so clear the + magic, as lvrefs are an implementation detail that must not be + leaked to the user. */ + sv_unmagic(sv, PERL_MAGIC_lvref); return 0; } @@ -2850,10 +2850,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (!mg->mg_ptr) { paren = mg->mg_len; - if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { + if (PL_curpm && (rx = PM_GETRE(PL_curpm))) { setparen_got_rx: CALLREG_NUMBUF_STORE((REGEXP * const)rx,paren,sv); - } else { + } else { /* Croak with a READONLY error when a numbered match var is * set without a previous pattern match. Unless it's C */ @@ -2867,28 +2867,28 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) switch (*mg->mg_ptr) { case '\001': /* ^A */ - if (SvOK(sv)) sv_copypv(PL_bodytarget, sv); - else SvOK_off(PL_bodytarget); - FmLINES(PL_bodytarget) = 0; - if (SvPOK(PL_bodytarget)) { - char *s = SvPVX(PL_bodytarget); + if (SvOK(sv)) sv_copypv(PL_bodytarget, sv); + else SvOK_off(PL_bodytarget); + FmLINES(PL_bodytarget) = 0; + if (SvPOK(PL_bodytarget)) { + char *s = SvPVX(PL_bodytarget); char *e = SvEND(PL_bodytarget); - while ( ((s = (char *) memchr(s, '\n', e - s))) ) { - FmLINES(PL_bodytarget)++; - s++; - } - } - /* mg_set() has temporarily made sv non-magical */ - if (TAINTING_get) { - if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1) - SvTAINTED_on(PL_bodytarget); - else - SvTAINTED_off(PL_bodytarget); - } - break; + while ( ((s = (char *) memchr(s, '\n', e - s))) ) { + FmLINES(PL_bodytarget)++; + s++; + } + } + /* mg_set() has temporarily made sv non-magical */ + if (TAINTING_get) { + if ((tmg = mg_find(sv,PERL_MAGIC_taint)) && tmg->mg_len & 1) + SvTAINTED_on(PL_bodytarget); + else + SvTAINTED_off(PL_bodytarget); + } + break; case '\003': /* ^C */ - PL_minus_c = cBOOL(SvIV(sv)); - break; + PL_minus_c = cBOOL(SvIV(sv)); + break; case '\004': /* ^D */ #ifdef DEBUGGING @@ -2899,30 +2899,30 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) dump_all_perl(!DEBUG_B_TEST); } #else - PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG; + PL_debug = (SvIV(sv)) | DEBUG_TOP_FLAG; #endif - break; + break; case '\005': /* ^E */ - if (*(mg->mg_ptr+1) == '\0') { + if (*(mg->mg_ptr+1) == '\0') { #ifdef VMS - set_vaxc_errno(SvIV(sv)); + set_vaxc_errno(SvIV(sv)); #elif defined(WIN32) - SetLastError( SvIV(sv) ); + SetLastError( SvIV(sv) ); #elif defined(OS2) - os2_setsyserrno(SvIV(sv)); + os2_setsyserrno(SvIV(sv)); #else - /* will anyone ever use this? */ - SETERRNO(SvIV(sv), 4); + /* will anyone ever use this? */ + SETERRNO(SvIV(sv), 4); #endif - } - else if (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv)) + } + else if (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv)) Perl_croak(aTHX_ "${^ENCODING} is no longer supported"); - break; + break; case '\006': /* ^F */ if (mg->mg_ptr[1] == '\0') { PL_maxsysfd = SvIV(sv); } - break; + break; case '\010': /* ^H */ { U32 save_hints = PL_hints; @@ -2933,48 +2933,48 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) notify_parser_that_changed_to_utf8(); } } - break; + break; case '\011': /* ^I */ /* NOT \t in EBCDIC */ - Safefree(PL_inplace); - PL_inplace = SvOK(sv) ? savesvpv(sv) : NULL; - break; + Safefree(PL_inplace); + PL_inplace = SvOK(sv) ? savesvpv(sv) : NULL; + break; case '\016': /* ^N */ - if (PL_curpm && (rx = PM_GETRE(PL_curpm)) - && (paren = RX_LASTCLOSEPAREN(rx))) goto setparen_got_rx; - goto croakparen; + if (PL_curpm && (rx = PM_GETRE(PL_curpm)) + && (paren = RX_LASTCLOSEPAREN(rx))) goto setparen_got_rx; + goto croakparen; case '\017': /* ^O */ - if (*(mg->mg_ptr+1) == '\0') { - Safefree(PL_osname); - PL_osname = NULL; - if (SvOK(sv)) { - TAINT_PROPER("assigning to $^O"); - PL_osname = savesvpv(sv); - } - } - else if (strEQ(mg->mg_ptr, "\017PEN")) { - STRLEN len; - const char *const start = SvPV(sv, len); - const char *out = (const char*)memchr(start, '\0', len); - SV *tmp; - - - PL_compiling.cop_hints |= HINT_LEXICAL_IO_IN | HINT_LEXICAL_IO_OUT; - PL_hints |= HINT_LEXICAL_IO_IN | HINT_LEXICAL_IO_OUT; - - /* Opening for input is more common than opening for output, so - ensure that hints for input are sooner on linked list. */ - tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1, - SvUTF8(sv)) - : newSVpvs_flags("", SvUTF8(sv)); - (void)hv_stores(GvHV(PL_hintgv), "open>", tmp); - mg_set(tmp); - - tmp = newSVpvn_flags(start, out ? (STRLEN)(out - start) : len, - SvUTF8(sv)); - (void)hv_stores(GvHV(PL_hintgv), "open<", tmp); - mg_set(tmp); - } - break; + if (*(mg->mg_ptr+1) == '\0') { + Safefree(PL_osname); + PL_osname = NULL; + if (SvOK(sv)) { + TAINT_PROPER("assigning to $^O"); + PL_osname = savesvpv(sv); + } + } + else if (strEQ(mg->mg_ptr, "\017PEN")) { + STRLEN len; + const char *const start = SvPV(sv, len); + const char *out = (const char*)memchr(start, '\0', len); + SV *tmp; + + + PL_compiling.cop_hints |= HINT_LEXICAL_IO_IN | HINT_LEXICAL_IO_OUT; + PL_hints |= HINT_LEXICAL_IO_IN | HINT_LEXICAL_IO_OUT; + + /* Opening for input is more common than opening for output, so + ensure that hints for input are sooner on linked list. */ + tmp = out ? newSVpvn_flags(out + 1, start + len - out - 1, + SvUTF8(sv)) + : newSVpvs_flags("", SvUTF8(sv)); + (void)hv_stores(GvHV(PL_hintgv), "open>", tmp); + mg_set(tmp); + + tmp = newSVpvn_flags(start, out ? (STRLEN)(out - start) : len, + SvUTF8(sv)); + (void)hv_stores(GvHV(PL_hintgv), "open<", tmp); + mg_set(tmp); + } + break; case '\020': /* ^P */ PL_perldb = SvIV(sv); if (PL_perldb && !PL_DBsingle) @@ -2982,106 +2982,106 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) break; case '\024': /* ^T */ #ifdef BIG_TIME - PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)); + PL_basetime = (Time_t)(SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv)); #else - PL_basetime = (Time_t)SvIV(sv); + PL_basetime = (Time_t)SvIV(sv); #endif - break; + break; case '\025': /* ^UTF8CACHE */ - if (strEQ(mg->mg_ptr+1, "TF8CACHE")) { - PL_utf8cache = (signed char) sv_2iv(sv); - } - break; + if (strEQ(mg->mg_ptr+1, "TF8CACHE")) { + PL_utf8cache = (signed char) sv_2iv(sv); + } + break; case '\027': /* ^W & $^WARNING_BITS */ - if (*(mg->mg_ptr+1) == '\0') { - if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { - i = SvIV(sv); - PL_dowarn = (PL_dowarn & ~G_WARN_ON) - | (i ? G_WARN_ON : G_WARN_OFF) ; - } - } - else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) { - if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { - if (!SvPOK(sv)) { + if (*(mg->mg_ptr+1) == '\0') { + if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { + i = SvIV(sv); + PL_dowarn = (PL_dowarn & ~G_WARN_ON) + | (i ? G_WARN_ON : G_WARN_OFF) ; + } + } + else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) { + if ( ! (PL_dowarn & G_WARN_ALL_MASK)) { + if (!SvPOK(sv)) { free_and_set_cop_warnings(&PL_compiling, pWARN_STD); - break; - } - { - STRLEN len, i; - int not_none = 0, not_all = 0; - const U8 * const ptr = (const U8 *)SvPV_const(sv, len) ; - for (i = 0 ; i < len ; ++i) { - not_none |= ptr[i]; - not_all |= ptr[i] ^ 0x55; - } - if (!not_none) { + break; + } + { + STRLEN len, i; + int not_none = 0, not_all = 0; + const U8 * const ptr = (const U8 *)SvPV_const(sv, len) ; + for (i = 0 ; i < len ; ++i) { + not_none |= ptr[i]; + not_all |= ptr[i] ^ 0x55; + } + if (!not_none) { free_and_set_cop_warnings(&PL_compiling, pWARN_NONE); - } else if (len >= WARNsize && !not_all) { + } else if (len >= WARNsize && !not_all) { free_and_set_cop_warnings(&PL_compiling, pWARN_ALL); - PL_dowarn |= G_WARN_ONCE ; - } + PL_dowarn |= G_WARN_ONCE ; + } else { - STRLEN len; - const char *const p = SvPV_const(sv, len); + STRLEN len; + const char *const p = SvPV_const(sv, len); - PL_compiling.cop_warnings - = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings, - p, len); + PL_compiling.cop_warnings + = Perl_new_warnings_bitfield(aTHX_ PL_compiling.cop_warnings, + p, len); - if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE)) - PL_dowarn |= G_WARN_ONCE ; - } + if (isWARN_on(PL_compiling.cop_warnings, WARN_ONCE)) + PL_dowarn |= G_WARN_ONCE ; + } - } - } - } - break; + } + } + } + break; case '.': - if (PL_localizing) { - if (PL_localizing == 1) - SAVESPTR(PL_last_in_gv); - } - else if (SvOK(sv) && GvIO(PL_last_in_gv)) - IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv); - break; + if (PL_localizing) { + if (PL_localizing == 1) + SAVESPTR(PL_last_in_gv); + } + else if (SvOK(sv) && GvIO(PL_last_in_gv)) + IoLINES(GvIOp(PL_last_in_gv)) = SvIV(sv); + break; case '^': - Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); - IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); - IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); - break; + Safefree(IoTOP_NAME(GvIOp(PL_defoutgv))); + IoTOP_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); + IoTOP_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + break; case '~': - Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); - IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); - IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); - break; + Safefree(IoFMT_NAME(GvIOp(PL_defoutgv))); + IoFMT_NAME(GvIOp(PL_defoutgv)) = savesvpv(sv); + IoFMT_GV(GvIOp(PL_defoutgv)) = gv_fetchsv(sv, GV_ADD, SVt_PVIO); + break; case '=': - IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv)); - break; + IoPAGE_LEN(GvIOp(PL_defoutgv)) = (SvIV(sv)); + break; case '-': - IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv)); - if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L) - IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L; - break; + IoLINES_LEFT(GvIOp(PL_defoutgv)) = (SvIV(sv)); + if (IoLINES_LEFT(GvIOp(PL_defoutgv)) < 0L) + IoLINES_LEFT(GvIOp(PL_defoutgv)) = 0L; + break; case '%': - IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv)); - break; + IoPAGE(GvIOp(PL_defoutgv)) = (SvIV(sv)); + break; case '|': - { - IO * const io = GvIO(PL_defoutgv); - if(!io) - break; - if ((SvIV(sv)) == 0) - IoFLAGS(io) &= ~IOf_FLUSH; - else { - if (!(IoFLAGS(io) & IOf_FLUSH)) { - PerlIO *ofp = IoOFP(io); - if (ofp) - (void)PerlIO_flush(ofp); - IoFLAGS(io) |= IOf_FLUSH; - } - } - } - break; + { + IO * const io = GvIO(PL_defoutgv); + if(!io) + break; + if ((SvIV(sv)) == 0) + IoFLAGS(io) &= ~IOf_FLUSH; + else { + if (!(IoFLAGS(io) & IOf_FLUSH)) { + PerlIO *ofp = IoOFP(io); + if (ofp) + (void)PerlIO_flush(ofp); + IoFLAGS(io) |= IOf_FLUSH; + } + } + } + break; case '/': { if (SvROK(sv)) { @@ -3111,36 +3111,36 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) SvREFCNT_dec(PL_rs); PL_rs = newSVsv(sv); } - break; + break; case '\\': - SvREFCNT_dec(PL_ors_sv); - if (SvOK(sv)) { - PL_ors_sv = newSVsv(sv); - } - else { - PL_ors_sv = NULL; - } - break; + SvREFCNT_dec(PL_ors_sv); + if (SvOK(sv)) { + PL_ors_sv = newSVsv(sv); + } + else { + PL_ors_sv = NULL; + } + break; case '[': - if (SvIV(sv) != 0) - Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible"); - break; + if (SvIV(sv) != 0) + Perl_croak(aTHX_ "Assigning non-zero to $[ is no longer possible"); + break; case '?': #ifdef COMPLEX_STATUS - if (PL_localizing == 2) { - SvUPGRADE(sv, SVt_PVLV); - PL_statusvalue = LvTARGOFF(sv); - PL_statusvalue_vms = LvTARGLEN(sv); - } - else + if (PL_localizing == 2) { + SvUPGRADE(sv, SVt_PVLV); + PL_statusvalue = LvTARGOFF(sv); + PL_statusvalue_vms = LvTARGLEN(sv); + } + else #endif #ifdef VMSISH_STATUS - if (VMSISH_STATUS) - STATUS_NATIVE_CHILD_SET((U32)SvIV(sv)); - else + if (VMSISH_STATUS) + STATUS_NATIVE_CHILD_SET((U32)SvIV(sv)); + else #endif - STATUS_UNIX_EXIT_SET(SvIV(sv)); - break; + STATUS_UNIX_EXIT_SET(SvIV(sv)); + break; case '!': { #ifdef VMS @@ -3149,93 +3149,93 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) # define PERL_VMS_BANG 0 #endif #if defined(WIN32) - SETERRNO(win32_get_errno(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0), - (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG); + SETERRNO(win32_get_errno(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0), + (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG); #else - SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0, - (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG); + SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0, + (SvIV(sv) == EVMSERR) ? 4 : PERL_VMS_BANG); #endif - } - break; + } + break; case '<': - { + { /* XXX $< currently silently ignores failures */ - const Uid_t new_uid = SvUID(sv); - PL_delaymagic_uid = new_uid; - if (PL_delaymagic) { - PL_delaymagic |= DM_RUID; - break; /* don't do magic till later */ - } + const Uid_t new_uid = SvUID(sv); + PL_delaymagic_uid = new_uid; + if (PL_delaymagic) { + PL_delaymagic |= DM_RUID; + break; /* don't do magic till later */ + } #ifdef HAS_SETRUID - PERL_UNUSED_RESULT(setruid(new_uid)); + PERL_UNUSED_RESULT(setruid(new_uid)); #elif defined(HAS_SETREUID) PERL_UNUSED_RESULT(setreuid(new_uid, (Uid_t)-1)); #elif defined(HAS_SETRESUID) PERL_UNUSED_RESULT(setresuid(new_uid, (Uid_t)-1, (Uid_t)-1)); #else - if (new_uid == PerlProc_geteuid()) { /* special case $< = $> */ + if (new_uid == PerlProc_geteuid()) { /* special case $< = $> */ # ifdef PERL_DARWIN - /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */ - if (new_uid != 0 && PerlProc_getuid() == 0) + /* workaround for Darwin's setuid peculiarity, cf [perl #24122] */ + if (new_uid != 0 && PerlProc_getuid() == 0) PERL_UNUSED_RESULT(PerlProc_setuid(0)); # endif PERL_UNUSED_RESULT(PerlProc_setuid(new_uid)); - } else { - Perl_croak(aTHX_ "setruid() not implemented"); - } + } else { + Perl_croak(aTHX_ "setruid() not implemented"); + } #endif - break; - } + break; + } case '>': - { + { /* XXX $> currently silently ignores failures */ - const Uid_t new_euid = SvUID(sv); - PL_delaymagic_euid = new_euid; - if (PL_delaymagic) { - PL_delaymagic |= DM_EUID; - break; /* don't do magic till later */ - } + const Uid_t new_euid = SvUID(sv); + PL_delaymagic_euid = new_euid; + if (PL_delaymagic) { + PL_delaymagic |= DM_EUID; + break; /* don't do magic till later */ + } #ifdef HAS_SETEUID - PERL_UNUSED_RESULT(seteuid(new_euid)); + PERL_UNUSED_RESULT(seteuid(new_euid)); #elif defined(HAS_SETREUID) - PERL_UNUSED_RESULT(setreuid((Uid_t)-1, new_euid)); + PERL_UNUSED_RESULT(setreuid((Uid_t)-1, new_euid)); #elif defined(HAS_SETRESUID) - PERL_UNUSED_RESULT(setresuid((Uid_t)-1, new_euid, (Uid_t)-1)); + PERL_UNUSED_RESULT(setresuid((Uid_t)-1, new_euid, (Uid_t)-1)); #else - if (new_euid == PerlProc_getuid()) /* special case $> = $< */ - PERL_UNUSED_RESULT(PerlProc_setuid(new_euid)); - else { - Perl_croak(aTHX_ "seteuid() not implemented"); - } -#endif - break; - } + if (new_euid == PerlProc_getuid()) /* special case $> = $< */ + PERL_UNUSED_RESULT(PerlProc_setuid(new_euid)); + else { + Perl_croak(aTHX_ "seteuid() not implemented"); + } +#endif + break; + } case '(': - { + { /* XXX $( currently silently ignores failures */ - const Gid_t new_gid = SvGID(sv); - PL_delaymagic_gid = new_gid; - if (PL_delaymagic) { - PL_delaymagic |= DM_RGID; - break; /* don't do magic till later */ - } + const Gid_t new_gid = SvGID(sv); + PL_delaymagic_gid = new_gid; + if (PL_delaymagic) { + PL_delaymagic |= DM_RGID; + break; /* don't do magic till later */ + } #ifdef HAS_SETRGID - PERL_UNUSED_RESULT(setrgid(new_gid)); + PERL_UNUSED_RESULT(setrgid(new_gid)); #elif defined(HAS_SETREGID) - PERL_UNUSED_RESULT(setregid(new_gid, (Gid_t)-1)); + PERL_UNUSED_RESULT(setregid(new_gid, (Gid_t)-1)); #elif defined(HAS_SETRESGID) PERL_UNUSED_RESULT(setresgid(new_gid, (Gid_t)-1, (Gid_t) -1)); #else - if (new_gid == PerlProc_getegid()) /* special case $( = $) */ - PERL_UNUSED_RESULT(PerlProc_setgid(new_gid)); - else { - Perl_croak(aTHX_ "setrgid() not implemented"); - } -#endif - break; - } + if (new_gid == PerlProc_getegid()) /* special case $( = $) */ + PERL_UNUSED_RESULT(PerlProc_setgid(new_gid)); + else { + Perl_croak(aTHX_ "setrgid() not implemented"); + } +#endif + break; + } case ')': - { + { /* (hv) best guess: maybe we'll need configure probes to do a better job, * but you can override it if you need to. */ @@ -3243,10 +3243,10 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) #define INVALID_GID ((Gid_t)-1) #endif /* XXX $) currently silently ignores failures */ - Gid_t new_egid; + Gid_t new_egid; #ifdef HAS_SETGROUPS - { - const char *p = SvPV_const(sv, len); + { + const char *p = SvPV_const(sv, len); Groups_t *gary = NULL; const char* p_end = p + len; const char* endptr = p_end; @@ -3290,50 +3290,50 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) } if (i) PERL_UNUSED_RESULT(setgroups(i, gary)); - Safefree(gary); - } + Safefree(gary); + } #else /* HAS_SETGROUPS */ new_egid = SvGID(sv); #endif /* HAS_SETGROUPS */ - PL_delaymagic_egid = new_egid; - if (PL_delaymagic) { - PL_delaymagic |= DM_EGID; - break; /* don't do magic till later */ - } + PL_delaymagic_egid = new_egid; + if (PL_delaymagic) { + PL_delaymagic |= DM_EGID; + break; /* don't do magic till later */ + } #ifdef HAS_SETEGID - PERL_UNUSED_RESULT(setegid(new_egid)); + PERL_UNUSED_RESULT(setegid(new_egid)); #elif defined(HAS_SETREGID) - PERL_UNUSED_RESULT(setregid((Gid_t)-1, new_egid)); + PERL_UNUSED_RESULT(setregid((Gid_t)-1, new_egid)); #elif defined(HAS_SETRESGID) - PERL_UNUSED_RESULT(setresgid((Gid_t)-1, new_egid, (Gid_t)-1)); + PERL_UNUSED_RESULT(setresgid((Gid_t)-1, new_egid, (Gid_t)-1)); #else - if (new_egid == PerlProc_getgid()) /* special case $) = $( */ - PERL_UNUSED_RESULT(PerlProc_setgid(new_egid)); - else { - Perl_croak(aTHX_ "setegid() not implemented"); - } -#endif - break; - } + if (new_egid == PerlProc_getgid()) /* special case $) = $( */ + PERL_UNUSED_RESULT(PerlProc_setgid(new_egid)); + else { + Perl_croak(aTHX_ "setegid() not implemented"); + } +#endif + break; + } case ':': - PL_chopset = SvPV_force(sv,len); - break; + PL_chopset = SvPV_force(sv,len); + break; case '$': /* $$ */ - /* Store the pid in mg->mg_obj so we can tell when a fork has - occurred. mg->mg_obj points to *$ by default, so clear it. */ - if (isGV(mg->mg_obj)) { - if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */ - SvREFCNT_dec(mg->mg_obj); - mg->mg_flags |= MGf_REFCOUNTED; - mg->mg_obj = newSViv((IV)PerlProc_getpid()); - } - else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid()); - break; + /* Store the pid in mg->mg_obj so we can tell when a fork has + occurred. mg->mg_obj points to *$ by default, so clear it. */ + if (isGV(mg->mg_obj)) { + if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */ + SvREFCNT_dec(mg->mg_obj); + mg->mg_flags |= MGf_REFCOUNTED; + mg->mg_obj = newSViv((IV)PerlProc_getpid()); + } + else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid()); + break; case '0': - LOCK_DOLLARZERO_MUTEX; + LOCK_DOLLARZERO_MUTEX; S_set_dollarzero(aTHX_ sv); - UNLOCK_DOLLARZERO_MUTEX; - break; + UNLOCK_DOLLARZERO_MUTEX; + break; } return 0; } @@ -3389,15 +3389,15 @@ Perl_whichsig_pvn(pTHX_ const char *sig, STRLEN len) PERL_UNUSED_CONTEXT; for (sigv = (char* const*)PL_sig_name; *sigv; sigv++) - if (strlen(*sigv) == len && memEQ(sig,*sigv, len)) - return PL_sig_num[sigv - (char* const*)PL_sig_name]; + if (strlen(*sigv) == len && memEQ(sig,*sigv, len)) + return PL_sig_num[sigv - (char* const*)PL_sig_name]; #ifdef SIGCLD if (memEQs(sig, len, "CHLD")) - return SIGCLD; + return SIGCLD; #endif #ifdef SIGCHLD if (memEQs(sig, len, "CLD")) - return SIGCHLD; + return SIGCHLD; #endif return -1; } @@ -3477,54 +3477,54 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, if (!PL_psig_ptr[sig]) { - PerlIO_printf(Perl_error_log, "Signal SIG%s received, but no signal handler set.\n", - PL_sig_name[sig]); - exit(sig); - } + PerlIO_printf(Perl_error_log, "Signal SIG%s received, but no signal handler set.\n", + PL_sig_name[sig]); + exit(sig); + } if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) { - /* Max number of items pushed there is 3*n or 4. We cannot fix - infinity, so we fix 4 (in fact 5): */ - if (PL_savestack_ix + 15 <= PL_savestack_max) { - flags |= 1; - PL_savestack_ix += 5; /* Protect save in progress. */ - SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL); - } + /* Max number of items pushed there is 3*n or 4. We cannot fix + infinity, so we fix 4 (in fact 5): */ + if (PL_savestack_ix + 15 <= PL_savestack_max) { + flags |= 1; + PL_savestack_ix += 5; /* Protect save in progress. */ + SAVEDESTRUCTOR_X(S_unwind_handler_stack, NULL); + } } /* sv_2cv is too complicated, try a simpler variant first: */ if (!SvROK(PL_psig_ptr[sig]) || !(cv = MUTABLE_CV(SvRV(PL_psig_ptr[sig]))) - || SvTYPE(cv) != SVt_PVCV) { - HV *st; - cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD); + || SvTYPE(cv) != SVt_PVCV) { + HV *st; + cv = sv_2cv(PL_psig_ptr[sig], &st, &gv, GV_ADD); } if (!cv || !CvROOT(cv)) { - const HEK * const hek = gv - ? GvENAME_HEK(gv) - : cv && CvNAMED(cv) - ? CvNAME_HEK(cv) - : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL; - if (hek) - Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), - "SIG%s handler \"%" HEKf "\" not defined.\n", - PL_sig_name[sig], HEKfARG(hek)); - /* diag_listed_as: SIG%s handler "%s" not defined */ - else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), - "SIG%s handler \"__ANON__\" not defined.\n", - PL_sig_name[sig]); - goto cleanup; + const HEK * const hek = gv + ? GvENAME_HEK(gv) + : cv && CvNAMED(cv) + ? CvNAME_HEK(cv) + : cv && CvGV(cv) ? GvENAME_HEK(CvGV(cv)) : NULL; + if (hek) + Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), + "SIG%s handler \"%" HEKf "\" not defined.\n", + PL_sig_name[sig], HEKfARG(hek)); + /* diag_listed_as: SIG%s handler "%s" not defined */ + else Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL), + "SIG%s handler \"__ANON__\" not defined.\n", + PL_sig_name[sig]); + goto cleanup; } sv = PL_psig_name[sig] - ? SvREFCNT_inc_NN(PL_psig_name[sig]) - : newSVpv(PL_sig_name[sig],0); + ? SvREFCNT_inc_NN(PL_psig_name[sig]) + : newSVpv(PL_sig_name[sig],0); flags |= 8; SAVEFREESV(sv); if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG) { - /* make sure our assumption about the size of the SAVEs are correct: - * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */ - assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0) == PL_savestack_ix); + /* make sure our assumption about the size of the SAVEs are correct: + * 3 for SAVEDESTRUCTOR_X, 2 for SAVEFREESV */ + assert(old_ss_ix + 2 + ((flags & 1) ? 3+5 : 0) == PL_savestack_ix); } PUSHSTACKi(PERLSI_SIGNAL); @@ -3533,9 +3533,9 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, #if defined(HAS_SIGACTION) && defined(SA_SIGINFO) { - struct sigaction oact; + struct sigaction oact; - if (sip && sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) { + if (sip && sigaction(sig, 0, &oact) == 0 && oact.sa_flags & SA_SIGINFO) { HV *sih = newHV(); SV *rv = newRV_noinc(MUTABLE_SV(sih)); /* The siginfo fields signo, code, errno, pid, uid, @@ -3568,7 +3568,7 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, PUSHs(rv); mPUSHp((char *)sip, sizeof(*sip)); - } + } } #endif @@ -3580,9 +3580,9 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, POPSTACK; { - SV * const errsv = ERRSV; - if (SvTRUE_NN(errsv)) { - SvREFCNT_dec(errsv_save); + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) { + SvREFCNT_dec(errsv_save); #ifndef PERL_MICRO /* Handler "died", for example to get out of a restart-able read(). @@ -3590,41 +3590,41 @@ Perl_perly_sighandler(int sig, Siginfo_t *sip PERL_UNUSED_DECL, * blocked by the system when we entered. */ # ifdef HAS_SIGPROCMASK - if (!safe) { + if (!safe) { /* safe signals called via dispatch_signals() set up a * savestack destructor, unblock_sigmask(), to * automatically unblock the handler at the end. If * instead we get here directly, we have to do it * ourselves */ - sigset_t set; - sigemptyset(&set); - sigaddset(&set,sig); - sigprocmask(SIG_UNBLOCK, &set, NULL); - } + sigset_t set; + sigemptyset(&set); + sigaddset(&set,sig); + sigprocmask(SIG_UNBLOCK, &set, NULL); + } # else - /* Not clear if this will work */ + /* Not clear if this will work */ /* XXX not clear if this should be protected by 'if (safe)' * too */ - (void)rsignal(sig, SIG_IGN); - (void)rsignal(sig, PL_csighandlerp); + (void)rsignal(sig, SIG_IGN); + (void)rsignal(sig, PL_csighandlerp); # endif #endif /* !PERL_MICRO */ - die_sv(errsv); - } - else { - sv_setsv(errsv, errsv_save); - SvREFCNT_dec(errsv_save); - } + die_sv(errsv); + } + else { + sv_setsv(errsv, errsv_save); + SvREFCNT_dec(errsv_save); + } } cleanup: /* pop any of SAVEFREESV, SAVEDESTRUCTOR_X and "save in progress" */ PL_savestack_ix = old_ss_ix; if (flags & 8) - SvREFCNT_dec_NN(sv); + SvREFCNT_dec_NN(sv); PL_op = myop; /* Apparently not needed... */ PL_Sv = tSv; /* Restore global temporaries. */ @@ -3644,11 +3644,11 @@ S_restore_magic(pTHX_ const void *p) return; if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { - SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */ - if (mgs->mgs_flags) - SvFLAGS(sv) |= mgs->mgs_flags; - else - mg_magical(sv); + SvTEMP_off(sv); /* if it's still magical, this value isn't temporary */ + if (mgs->mgs_flags) + SvFLAGS(sv) |= mgs->mgs_flags; + else + mg_magical(sv); } bumped = mgs->mgs_bumped; @@ -3663,25 +3663,25 @@ S_restore_magic(pTHX_ const void *p) */ if (PL_savestack_ix == mgs->mgs_ss_ix) { - UV popval = SSPOPUV; + UV popval = SSPOPUV; assert(popval == SAVEt_DESTRUCTOR_X); PL_savestack_ix -= 2; - popval = SSPOPUV; + popval = SSPOPUV; assert((popval & SAVE_MASK) == SAVEt_ALLOC); PL_savestack_ix -= popval >> SAVE_TIGHT_SHIFT; } if (bumped) { - if (SvREFCNT(sv) == 1) { - /* We hold the last reference to this SV, which implies that the - SV was deleted as a side effect of the routines we called. - So artificially keep it alive a bit longer. - We avoid turning on the TEMP flag, which can cause the SV's - buffer to get stolen (and maybe other stuff). */ - sv_2mortal(sv); - SvTEMP_off(sv); - } - else - SvREFCNT_dec_NN(sv); /* undo the inc in S_save_magic() */ + if (SvREFCNT(sv) == 1) { + /* We hold the last reference to this SV, which implies that the + SV was deleted as a side effect of the routines we called. + So artificially keep it alive a bit longer. + We avoid turning on the TEMP flag, which can cause the SV's + buffer to get stolen (and maybe other stuff). */ + sv_2mortal(sv); + SvTEMP_off(sv); + } + else + SvREFCNT_dec_NN(sv); /* undo the inc in S_save_magic() */ } } @@ -3713,7 +3713,7 @@ int Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg) { SV *key = (mg->mg_len == HEf_SVKEY) ? MUTABLE_SV(mg->mg_ptr) - : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); + : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP); PERL_ARGS_ASSERT_MAGIC_SETHINT; @@ -3727,7 +3727,7 @@ Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg) forgetting to do it, and consequent subtle errors. */ PL_hints |= HINT_LOCALIZE_HH; CopHINTHASH_set(&PL_compiling, - cophh_store_sv(CopHINTHASH_get(&PL_compiling), key, 0, sv, 0)); + cophh_store_sv(CopHINTHASH_get(&PL_compiling), key, 0, sv, 0)); magic_sethint_feature(key, NULL, 0, sv, 0); return 0; } @@ -3748,11 +3748,11 @@ Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg) PL_hints |= HINT_LOCALIZE_HH; CopHINTHASH_set(&PL_compiling, - mg->mg_len == HEf_SVKEY - ? cophh_delete_sv(CopHINTHASH_get(&PL_compiling), - MUTABLE_SV(mg->mg_ptr), 0, 0) - : cophh_delete_pvn(CopHINTHASH_get(&PL_compiling), - mg->mg_ptr, mg->mg_len, 0, 0)); + mg->mg_len == HEf_SVKEY + ? cophh_delete_sv(CopHINTHASH_get(&PL_compiling), + MUTABLE_SV(mg->mg_ptr), 0, 0) + : cophh_delete_pvn(CopHINTHASH_get(&PL_compiling), + mg->mg_ptr, mg->mg_len, 0, 0)); if (mg->mg_len == HEf_SVKEY) magic_sethint_feature(MUTABLE_SV(mg->mg_ptr), NULL, 0, NULL, FALSE); else @@ -3781,7 +3781,7 @@ Perl_magic_clearhints(pTHX_ SV *sv, MAGIC *mg) int Perl_magic_copycallchecker(pTHX_ SV *sv, MAGIC *mg, SV *nsv, - const char *name, I32 namlen) + const char *name, I32 namlen) { MAGIC *nmg; diff --git a/mg.h b/mg.h index 5e3bcc0a6651..53f1a47032f2 100644 --- a/mg.h +++ b/mg.h @@ -15,7 +15,7 @@ struct mgvtbl { int (*svt_clear) (pTHX_ SV *sv, MAGIC* mg); int (*svt_free) (pTHX_ SV *sv, MAGIC* mg); int (*svt_copy) (pTHX_ SV *sv, MAGIC* mg, - SV *nsv, const char *name, I32 namlen); + SV *nsv, const char *name, I32 namlen); int (*svt_dup) (pTHX_ MAGIC *mg, CLONE_PARAMS *param); int (*svt_local)(pTHX_ SV *nsv, MAGIC *mg); }; @@ -47,14 +47,14 @@ struct magic { #define MgTAINTEDDIR_off(mg) (mg->mg_flags &= ~MGf_TAINTEDDIR) #define MgPV(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV(MUTABLE_SV((mg)->mg_ptr),lp) : \ - (mg)->mg_ptr) + SvPV(MUTABLE_SV((mg)->mg_ptr),lp) : \ + (mg)->mg_ptr) #define MgPV_const(mg,lp) ((((int)(lp = (mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV_const(MUTABLE_SV((mg)->mg_ptr),lp) : \ - (const char*)(mg)->mg_ptr) + SvPV_const(MUTABLE_SV((mg)->mg_ptr),lp) : \ + (const char*)(mg)->mg_ptr) #define MgPV_nolen_const(mg) (((((int)(mg)->mg_len)) == HEf_SVKEY) ? \ - SvPV_nolen_const(MUTABLE_SV((mg)->mg_ptr)) : \ - (const char*)(mg)->mg_ptr) + SvPV_nolen_const(MUTABLE_SV((mg)->mg_ptr)) : \ + (const char*)(mg)->mg_ptr) #define SvTIED_mg(sv,how) (SvRMAGICAL(sv) ? mg_find((sv),(how)) : NULL) #define SvTIED_obj(sv,mg) \ @@ -66,11 +66,11 @@ struct magic { # define MgBYTEPOS_set(mg,sv,pv,off) ( \ assert_((mg)->mg_type == PERL_MAGIC_regex_global) \ SvPOK(sv) && (!SvGMAGICAL(sv) || sv_only_taint_gmagic(sv)) \ - ? (mg)->mg_len = (off), (mg)->mg_flags |= MGf_BYTES \ - : ((mg)->mg_len = DO_UTF8(sv) \ - ? (SSize_t)utf8_length((U8 *)(pv), (U8 *)(pv)+(off)) \ - : (SSize_t)(off), \ - (mg)->mg_flags &= ~MGf_BYTES)) + ? (mg)->mg_len = (off), (mg)->mg_flags |= MGf_BYTES \ + : ((mg)->mg_len = DO_UTF8(sv) \ + ? (SSize_t)utf8_length((U8 *)(pv), (U8 *)(pv)+(off)) \ + : (SSize_t)(off), \ + (mg)->mg_flags &= ~MGf_BYTES)) #endif #define whichsig(pv) whichsig_pv(pv) diff --git a/mro_core.c b/mro_core.c index 378c738c7a5e..25642d826f66 100644 --- a/mro_core.c +++ b/mro_core.c @@ -35,68 +35,68 @@ static const struct mro_alg dfs_alg = SV * Perl_mro_get_private_data(pTHX_ struct mro_meta *const smeta, - const struct mro_alg *const which) + const struct mro_alg *const which) { SV **data; PERL_ARGS_ASSERT_MRO_GET_PRIVATE_DATA; data = (SV **)Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL, - which->name, which->length, which->kflags, - HV_FETCH_JUST_SV, NULL, which->hash); + which->name, which->length, which->kflags, + HV_FETCH_JUST_SV, NULL, which->hash); if (!data) - return NULL; + return NULL; /* If we've been asked to look up the private data for the current MRO, then cache it. */ if (smeta->mro_which == which) - smeta->mro_linear_current = *data; + smeta->mro_linear_current = *data; return *data; } SV * Perl_mro_set_private_data(pTHX_ struct mro_meta *const smeta, - const struct mro_alg *const which, SV *const data) + const struct mro_alg *const which, SV *const data) { PERL_ARGS_ASSERT_MRO_SET_PRIVATE_DATA; if (!smeta->mro_linear_all) { - if (smeta->mro_which == which) { - /* If all we need to store is the current MRO's data, then don't use - memory on a hash with 1 element - store it direct, and signal - this by leaving the would-be-hash NULL. */ - smeta->mro_linear_current = data; - return data; - } else { - HV *const hv = newHV(); - /* Start with 2 buckets. It's unlikely we'll need more. */ - HvMAX(hv) = 1; - smeta->mro_linear_all = hv; - - if (smeta->mro_linear_current) { - /* If we were storing something directly, put it in the hash - before we lose it. */ - Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which, - smeta->mro_linear_current); - } - } + if (smeta->mro_which == which) { + /* If all we need to store is the current MRO's data, then don't use + memory on a hash with 1 element - store it direct, and signal + this by leaving the would-be-hash NULL. */ + smeta->mro_linear_current = data; + return data; + } else { + HV *const hv = newHV(); + /* Start with 2 buckets. It's unlikely we'll need more. */ + HvMAX(hv) = 1; + smeta->mro_linear_all = hv; + + if (smeta->mro_linear_current) { + /* If we were storing something directly, put it in the hash + before we lose it. */ + Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which, + smeta->mro_linear_current); + } + } } /* We get here if we're storing more than one linearisation for this stash, or the linearisation we are storing is not that if its current MRO. */ if (smeta->mro_which == which) { - /* If we've been asked to store the private data for the current MRO, - then cache it. */ - smeta->mro_linear_current = data; + /* If we've been asked to store the private data for the current MRO, + then cache it. */ + smeta->mro_linear_current = data; } if (!Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL, - which->name, which->length, which->kflags, - HV_FETCH_ISSTORE, data, which->hash)) { - Perl_croak(aTHX_ "panic: hv_store() failed in set_mro_private_data() " - "for '%.*s' %d", (int) which->length, which->name, - which->kflags); + which->name, which->length, which->kflags, + HV_FETCH_ISSTORE, data, which->hash)) { + Perl_croak(aTHX_ "panic: hv_store() failed in set_mro_private_data() " + "for '%.*s' %d", (int) which->length, which->name, + which->kflags); } return data; @@ -109,9 +109,9 @@ Perl_mro_get_from_name(pTHX_ SV *name) { PERL_ARGS_ASSERT_MRO_GET_FROM_NAME; data = (SV **)Perl_hv_common(aTHX_ PL_registered_mros, name, NULL, 0, 0, - HV_FETCH_JUST_SV, NULL, 0); + HV_FETCH_JUST_SV, NULL, 0); if (!data) - return NULL; + return NULL; assert(SvTYPE(*data) == SVt_IV); assert(SvIOK(*data)); return INT2PTR(const struct mro_alg *, SvUVX(*data)); @@ -133,11 +133,11 @@ Perl_mro_register(pTHX_ const struct mro_alg *mro) { if (!Perl_hv_common(aTHX_ PL_registered_mros, NULL, - mro->name, mro->length, mro->kflags, - HV_FETCH_ISSTORE, wrapper, mro->hash)) { - SvREFCNT_dec_NN(wrapper); - Perl_croak(aTHX_ "panic: hv_store() failed in mro_register() " - "for '%.*s' %d", (int) mro->length, mro->name, mro->kflags); + mro->name, mro->length, mro->kflags, + HV_FETCH_ISSTORE, wrapper, mro->hash)) { + SvREFCNT_dec_NN(wrapper); + Perl_croak(aTHX_ "panic: hv_store() failed in mro_register() " + "for '%.*s' %d", (int) mro->length, mro->name, mro->kflags); } } @@ -173,23 +173,23 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) Copy(smeta, newmeta, 1, struct mro_meta); if (newmeta->mro_linear_all) { - newmeta->mro_linear_all - = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_linear_all, param)); - /* This is just acting as a shortcut pointer, and will be automatically - updated on the first get. */ - newmeta->mro_linear_current = NULL; + newmeta->mro_linear_all + = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_linear_all, param)); + /* This is just acting as a shortcut pointer, and will be automatically + updated on the first get. */ + newmeta->mro_linear_current = NULL; } else if (newmeta->mro_linear_current) { - /* Only the current MRO is stored, so this owns the data. */ - newmeta->mro_linear_current - = sv_dup_inc((const SV *)newmeta->mro_linear_current, param); + /* Only the current MRO is stored, so this owns the data. */ + newmeta->mro_linear_current + = sv_dup_inc((const SV *)newmeta->mro_linear_current, param); } if (newmeta->mro_nextmethod) - newmeta->mro_nextmethod - = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_nextmethod, param)); + newmeta->mro_nextmethod + = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->mro_nextmethod, param)); if (newmeta->isa) - newmeta->isa - = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->isa, param)); + newmeta->isa + = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->isa, param)); newmeta->super = NULL; @@ -243,8 +243,8 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) if (level > 100) Perl_croak(aTHX_ - "Recursive inheritance detected in package '%" HEKf "'", - HEKfARG(stashhek)); + "Recursive inheritance detected in package '%" HEKf "'", + HEKfARG(stashhek)); meta = HvMROMETA(stash); @@ -280,85 +280,85 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) while (items--) { SV* const sv = *svp ? *svp : &PL_sv_undef; HV* const basestash = gv_stashsv(sv, 0); - SV *const *subrv_p; - I32 subrv_items; - svp++; + SV *const *subrv_p; + I32 subrv_items; + svp++; if (!basestash) { /* if no stash exists for this @ISA member, simply add it to the MRO and move on */ - subrv_p = &sv; - subrv_items = 1; + subrv_p = &sv; + subrv_items = 1; } else { /* otherwise, recurse into ourselves for the MRO of this @ISA member, and append their MRO to ours. - The recursive call could throw an exception, which - has memory management implications here, hence the use of - the mortal. */ - const AV *const subrv - = mro_get_linear_isa_dfs(basestash, level + 1); - - subrv_p = AvARRAY(subrv); - subrv_items = AvFILLp(subrv) + 1; - } - if (stored) { - while(subrv_items--) { - SV *const subsv = *subrv_p++; - /* LVALUE fetch will create a new undefined SV if necessary - */ - HE *const he = hv_fetch_ent(stored, subsv, 1, 0); - assert(he); - if(HeVAL(he) != &PL_sv_undef) { - /* It was newly created. Steal it for our new SV, and - replace it in the hash with the "real" thing. */ - SV *const val = HeVAL(he); - HEK *const key = HeKEY_hek(he); - - HeVAL(he) = &PL_sv_undef; - sv_sethek(val, key); - av_push(retval, val); - } - } + The recursive call could throw an exception, which + has memory management implications here, hence the use of + the mortal. */ + const AV *const subrv + = mro_get_linear_isa_dfs(basestash, level + 1); + + subrv_p = AvARRAY(subrv); + subrv_items = AvFILLp(subrv) + 1; + } + if (stored) { + while(subrv_items--) { + SV *const subsv = *subrv_p++; + /* LVALUE fetch will create a new undefined SV if necessary + */ + HE *const he = hv_fetch_ent(stored, subsv, 1, 0); + assert(he); + if(HeVAL(he) != &PL_sv_undef) { + /* It was newly created. Steal it for our new SV, and + replace it in the hash with the "real" thing. */ + SV *const val = HeVAL(he); + HEK *const key = HeKEY_hek(he); + + HeVAL(he) = &PL_sv_undef; + sv_sethek(val, key); + av_push(retval, val); + } + } } else { - /* We are the first (or only) parent. We can short cut the - complexity above, because our @ISA is simply us prepended - to our parent's @ISA, and our ->isa cache is simply our - parent's, with our name added. */ - /* newSVsv() is slow. This code is only faster if we can avoid - it by ensuring that SVs in the arrays are shared hash key - scalar SVs, because we can "copy" them very efficiently. - Although to be fair, we can't *ensure* this, as a reference - to the internal array is returned by mro::get_linear_isa(), - so we'll have to be defensive just in case someone faffed - with it. */ - if (basestash) { - SV **svp; - stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa))); - av_extend(retval, subrv_items); - AvFILLp(retval) = subrv_items; - svp = AvARRAY(retval); - while(subrv_items--) { - SV *const val = *subrv_p++; - *++svp = SvIsCOW_shared_hash(val) - ? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val))) - : newSVsv(val); - } - } else { - /* They have no stash. So create ourselves an ->isa cache - as if we'd copied it from what theirs should be. */ - stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); - (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); - av_push(retval, - newSVhek(HeKEY_hek(hv_store_ent(stored, sv, - &PL_sv_undef, 0)))); - } - } + /* We are the first (or only) parent. We can short cut the + complexity above, because our @ISA is simply us prepended + to our parent's @ISA, and our ->isa cache is simply our + parent's, with our name added. */ + /* newSVsv() is slow. This code is only faster if we can avoid + it by ensuring that SVs in the arrays are shared hash key + scalar SVs, because we can "copy" them very efficiently. + Although to be fair, we can't *ensure* this, as a reference + to the internal array is returned by mro::get_linear_isa(), + so we'll have to be defensive just in case someone faffed + with it. */ + if (basestash) { + SV **svp; + stored = MUTABLE_HV(sv_2mortal((SV*)newHVhv(HvMROMETA(basestash)->isa))); + av_extend(retval, subrv_items); + AvFILLp(retval) = subrv_items; + svp = AvARRAY(retval); + while(subrv_items--) { + SV *const val = *subrv_p++; + *++svp = SvIsCOW_shared_hash(val) + ? newSVhek(SvSHARED_HEK_FROM_PV(SvPVX(val))) + : newSVsv(val); + } + } else { + /* They have no stash. So create ourselves an ->isa cache + as if we'd copied it from what theirs should be. */ + stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); + (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); + av_push(retval, + newSVhek(HeKEY_hek(hv_store_ent(stored, sv, + &PL_sv_undef, 0)))); + } + } } } else { - /* We have no parents. */ - stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); - (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); + /* We have no parents. */ + stored = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV()))); + (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); } (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0); @@ -380,7 +380,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) SvREADONLY_on(retval); return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &dfs_alg, - MUTABLE_SV(retval))); + MUTABLE_SV(retval))); } /* @@ -415,49 +415,49 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) isa = meta->mro_which->resolve(aTHX_ stash, 0); if (meta->mro_which != &dfs_alg) { /* skip for dfs, for speed */ - SV * const namesv = - (HvENAME(stash)||HvNAME(stash)) - ? newSVhek(HvENAME_HEK(stash) - ? HvENAME_HEK(stash) - : HvNAME_HEK(stash)) - : NULL; - - if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv))) - { - AV * const old = isa; - SV **svp; - SV **ovp = AvARRAY(old); - SV * const * const oend = ovp + AvFILLp(old) + 1; - isa = (AV *)sv_2mortal((SV *)newAV()); - av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1); - *AvARRAY(isa) = namesv; - svp = AvARRAY(isa)+1; - while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++); - } - else SvREFCNT_dec(namesv); + SV * const namesv = + (HvENAME(stash)||HvNAME(stash)) + ? newSVhek(HvENAME_HEK(stash) + ? HvENAME_HEK(stash) + : HvNAME_HEK(stash)) + : NULL; + + if(namesv && (AvFILLp(isa) == -1 || !sv_eq(*AvARRAY(isa), namesv))) + { + AV * const old = isa; + SV **svp; + SV **ovp = AvARRAY(old); + SV * const * const oend = ovp + AvFILLp(old) + 1; + isa = (AV *)sv_2mortal((SV *)newAV()); + av_extend(isa, AvFILLp(isa) = AvFILLp(old)+1); + *AvARRAY(isa) = namesv; + svp = AvARRAY(isa)+1; + while (ovp < oend) *svp++ = SvREFCNT_inc(*ovp++); + } + else SvREFCNT_dec(namesv); } if (!meta->isa) { - HV *const isa_hash = newHV(); - /* Linearisation didn't build it for us, so do it here. */ - SV *const *svp = AvARRAY(isa); - SV *const *const svp_end = svp + AvFILLp(isa) + 1; - const HEK *canon_name = HvENAME_HEK(stash); - if (!canon_name) canon_name = HvNAME_HEK(stash); - - while (svp < svp_end) { - (void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0); - } - - (void) hv_common(isa_hash, NULL, HEK_KEY(canon_name), - HEK_LEN(canon_name), HEK_FLAGS(canon_name), - HV_FETCH_ISSTORE, &PL_sv_undef, - HEK_HASH(canon_name)); - (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef); - - SvREADONLY_on(isa_hash); - - meta->isa = isa_hash; + HV *const isa_hash = newHV(); + /* Linearisation didn't build it for us, so do it here. */ + SV *const *svp = AvARRAY(isa); + SV *const *const svp_end = svp + AvFILLp(isa) + 1; + const HEK *canon_name = HvENAME_HEK(stash); + if (!canon_name) canon_name = HvNAME_HEK(stash); + + while (svp < svp_end) { + (void) hv_store_ent(isa_hash, *svp++, &PL_sv_undef, 0); + } + + (void) hv_common(isa_hash, NULL, HEK_KEY(canon_name), + HEK_LEN(canon_name), HEK_FLAGS(canon_name), + HV_FETCH_ISSTORE, &PL_sv_undef, + HEK_HASH(canon_name)); + (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef); + + SvREADONLY_on(isa_hash); + + meta->isa = isa_hash; } return isa; @@ -476,14 +476,14 @@ by the C magic, should not need to invoke directly. /* Macro to avoid repeating the code five times. */ #define CLEAR_LINEAR(mEta) \ if (mEta->mro_linear_all) { \ - SvREFCNT_dec(MUTABLE_SV(mEta->mro_linear_all)); \ - mEta->mro_linear_all = NULL; \ - /* This is just acting as a shortcut pointer. */ \ - mEta->mro_linear_current = NULL; \ + SvREFCNT_dec(MUTABLE_SV(mEta->mro_linear_all)); \ + mEta->mro_linear_all = NULL; \ + /* This is just acting as a shortcut pointer. */ \ + mEta->mro_linear_current = NULL; \ } else if (mEta->mro_linear_current) { \ - /* Only the current MRO is stored, so this owns the data. */ \ - SvREFCNT_dec(mEta->mro_linear_current); \ - mEta->mro_linear_current = NULL; \ + /* Only the current MRO is stored, so this owns the data. */ \ + SvREFCNT_dec(mEta->mro_linear_current); \ + mEta->mro_linear_current = NULL; \ } void @@ -512,9 +512,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) meta = HvMROMETA(stash); CLEAR_LINEAR(meta); if (meta->isa) { - /* Steal it for our own purposes. */ - isa = (HV *)sv_2mortal((SV *)meta->isa); - meta->isa = NULL; + /* Steal it for our own purposes. */ + isa = (HV *)sv_2mortal((SV *)meta->isa); + meta->isa = NULL; } /* Inc the package generation, since our @ISA changed */ @@ -533,7 +533,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) } else { /* Wipe the local method cache otherwise */ meta->cache_gen++; - is_universal = FALSE; + is_universal = FALSE; } /* wipe next::method cache too */ @@ -573,19 +573,19 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) if(!revstash) continue; revmeta = HvMROMETA(revstash); - CLEAR_LINEAR(revmeta); + CLEAR_LINEAR(revmeta); if(!is_universal) revmeta->cache_gen++; if(revmeta->mro_nextmethod) hv_clear(revmeta->mro_nextmethod); - if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; - - (void) - hv_store( - isa_hashes, (const char*)&revstash, sizeof(HV *), - revmeta->isa ? (SV *)revmeta->isa : &PL_sv_undef, 0 - ); - revmeta->isa = NULL; + if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL; + + (void) + hv_store( + isa_hashes, (const char*)&revstash, sizeof(HV *), + revmeta->isa ? (SV *)revmeta->isa : &PL_sv_undef, 0 + ); + revmeta->isa = NULL; } /* Second pass: Update PL_isarev. We can just use isa_hashes to @@ -661,20 +661,20 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0); - /* That fetch should not fail. But if it had to create a new SV for - us, then will need to upgrade it to an HV (which sv_upgrade() can - now do for us. */ + /* That fetch should not fail. But if it had to create a new SV for + us, then will need to upgrade it to an HV (which sv_upgrade() can + now do for us. */ mroisarev = MUTABLE_HV(HeVAL(he)); - SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV); + SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV); - /* This hash only ever contains PL_sv_yes. Storing it over itself is - almost as cheap as calling hv_exists, so on aggregate we expect to - save time by not making two calls to the common HV code for the - case where it doesn't exist. */ + /* This hash only ever contains PL_sv_yes. Storing it over itself is + almost as cheap as calling hv_exists, so on aggregate we expect to + save time by not making two calls to the common HV code for the + case where it doesn't exist. */ - (void)hv_storehek(mroisarev, stashhek, &PL_sv_yes); + (void)hv_storehek(mroisarev, stashhek, &PL_sv_yes); } /* Delete our name from our former parents' isarevs. */ @@ -771,12 +771,12 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, * If flags & 1, the caller has asked us to skip the check. */ if(!(flags & 1)) { - SV **svp; - if( - !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) || - !(svp = hv_fetchhek(GvSTASH(gv), GvNAME_HEK(gv), 0)) || - *svp != (SV *)gv - ) return; + SV **svp; + if( + !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) || + !(svp = hv_fetchhek(GvSTASH(gv), GvNAME_HEK(gv), 0)) || + *svp != (SV *)gv + ) return; } assert(SvOOK(GvSTASH(gv))); assert(GvNAMELEN(gv)); @@ -784,56 +784,56 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, assert(GvNAMELEN(gv) == 1 || GvNAME(gv)[GvNAMELEN(gv) - 2] == ':'); name_count = HvAUX(GvSTASH(gv))->xhv_name_count; if (!name_count) { - name_count = 1; - namep = &HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_name; + name_count = 1; + namep = &HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_name; } else { - namep = HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_names; - if (name_count < 0) ++namep, name_count = -name_count - 1; + namep = HvAUX(GvSTASH(gv))->xhv_name_u.xhvnameu_names; + if (name_count < 0) ++namep, name_count = -name_count - 1; } if (name_count == 1) { - if (memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")) { - namesv = GvNAMELEN(gv) == 1 - ? newSVpvs_flags(":", SVs_TEMP) - : newSVpvs_flags("", SVs_TEMP); - } - else { - namesv = sv_2mortal(newSVhek(*namep)); - if (GvNAMELEN(gv) == 1) sv_catpvs(namesv, ":"); - else sv_catpvs(namesv, "::"); - } - if (GvNAMELEN(gv) != 1) { - sv_catpvn_flags( - namesv, GvNAME(gv), GvNAMELEN(gv) - 2, - /* skip trailing :: */ - GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES - ); + if (memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")) { + namesv = GvNAMELEN(gv) == 1 + ? newSVpvs_flags(":", SVs_TEMP) + : newSVpvs_flags("", SVs_TEMP); + } + else { + namesv = sv_2mortal(newSVhek(*namep)); + if (GvNAMELEN(gv) == 1) sv_catpvs(namesv, ":"); + else sv_catpvs(namesv, "::"); + } + if (GvNAMELEN(gv) != 1) { + sv_catpvn_flags( + namesv, GvNAME(gv), GvNAMELEN(gv) - 2, + /* skip trailing :: */ + GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES + ); } } else { - SV *aname; - namesv = sv_2mortal((SV *)newAV()); - while (name_count--) { - if(memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")){ - aname = GvNAMELEN(gv) == 1 - ? newSVpvs(":") - : newSVpvs(""); - namep++; - } - else { - aname = newSVhek(*namep++); - if (GvNAMELEN(gv) == 1) sv_catpvs(aname, ":"); - else sv_catpvs(aname, "::"); - } - if (GvNAMELEN(gv) != 1) { - sv_catpvn_flags( - aname, GvNAME(gv), GvNAMELEN(gv) - 2, - /* skip trailing :: */ - GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES - ); + SV *aname; + namesv = sv_2mortal((SV *)newAV()); + while (name_count--) { + if(memEQs(HEK_KEY(*namep), HEK_LEN(*namep), "main")){ + aname = GvNAMELEN(gv) == 1 + ? newSVpvs(":") + : newSVpvs(""); + namep++; } - av_push((AV *)namesv, aname); - } + else { + aname = newSVhek(*namep++); + if (GvNAMELEN(gv) == 1) sv_catpvs(aname, ":"); + else sv_catpvs(aname, "::"); + } + if (GvNAMELEN(gv) != 1) { + sv_catpvn_flags( + aname, GvNAME(gv), GvNAMELEN(gv) - 2, + /* skip trailing :: */ + GvNAMEUTF8(gv) ? SV_CATUTF8 : SV_CATBYTES + ); + } + av_push((AV *)namesv, aname); + } } /* Get a list of all the affected classes. */ @@ -859,25 +859,25 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, mro_isa_changed_in on each. */ hv_iterinit(stashes); while((iter = hv_iternext(stashes))) { - HV * const this_stash = *(HV **)HEK_KEY(HeKEY_hek(iter)); - if(HvENAME(this_stash)) { - /* We have to restore the original meta->isa (that - mro_gather_and_rename set aside for us) this way, in case - one class in this list is a superclass of a another class - that we have already encountered. In such a case, meta->isa - will have been overwritten without old entries being deleted - from PL_isarev. */ - struct mro_meta * const meta = HvMROMETA(this_stash); - if(meta->isa != (HV *)HeVAL(iter)){ - SvREFCNT_dec(meta->isa); - meta->isa - = HeVAL(iter) == &PL_sv_yes - ? NULL - : (HV *)HeVAL(iter); - HeVAL(iter) = NULL; /* We donated our reference count. */ - } - mro_isa_changed_in(this_stash); - } + HV * const this_stash = *(HV **)HEK_KEY(HeKEY_hek(iter)); + if(HvENAME(this_stash)) { + /* We have to restore the original meta->isa (that + mro_gather_and_rename set aside for us) this way, in case + one class in this list is a superclass of a another class + that we have already encountered. In such a case, meta->isa + will have been overwritten without old entries being deleted + from PL_isarev. */ + struct mro_meta * const meta = HvMROMETA(this_stash); + if(meta->isa != (HV *)HeVAL(iter)){ + SvREFCNT_dec(meta->isa); + meta->isa + = HeVAL(iter) == &PL_sv_yes + ? NULL + : (HV *)HeVAL(iter); + HeVAL(iter) = NULL; /* We donated our reference count. */ + } + mro_isa_changed_in(this_stash); + } } } @@ -915,196 +915,196 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, */ if(oldstash) { - /* Add to the big list. */ - struct mro_meta * meta; - HE * const entry - = (HE *) - hv_common( - seen_stashes, NULL, (const char *)&oldstash, sizeof(HV *), 0, - HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0 - ); - if(HeVAL(entry) == &PL_sv_undef || HeVAL(entry) == &PL_sv_yes) { - oldstash = NULL; - goto check_stash; - } - HeVAL(entry) - = HeVAL(entry) == &PL_sv_no ? &PL_sv_yes : &PL_sv_undef; - meta = HvMROMETA(oldstash); - (void) - hv_store( - stashes, (const char *)&oldstash, sizeof(HV *), - meta->isa - ? SvREFCNT_inc_simple_NN((SV *)meta->isa) - : &PL_sv_yes, - 0 - ); - CLEAR_LINEAR(meta); - - /* Update the effective name. */ - if(HvENAME_get(oldstash)) { - const HEK * const enamehek = HvENAME_HEK(oldstash); - if(SvTYPE(namesv) == SVt_PVAV) { - items = AvFILLp((AV *)namesv) + 1; - svp = AvARRAY((AV *)namesv); - } - else { - items = 1; - svp = &namesv; - } - while (items--) { + /* Add to the big list. */ + struct mro_meta * meta; + HE * const entry + = (HE *) + hv_common( + seen_stashes, NULL, (const char *)&oldstash, sizeof(HV *), 0, + HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0 + ); + if(HeVAL(entry) == &PL_sv_undef || HeVAL(entry) == &PL_sv_yes) { + oldstash = NULL; + goto check_stash; + } + HeVAL(entry) + = HeVAL(entry) == &PL_sv_no ? &PL_sv_yes : &PL_sv_undef; + meta = HvMROMETA(oldstash); + (void) + hv_store( + stashes, (const char *)&oldstash, sizeof(HV *), + meta->isa + ? SvREFCNT_inc_simple_NN((SV *)meta->isa) + : &PL_sv_yes, + 0 + ); + CLEAR_LINEAR(meta); + + /* Update the effective name. */ + if(HvENAME_get(oldstash)) { + const HEK * const enamehek = HvENAME_HEK(oldstash); + if(SvTYPE(namesv) == SVt_PVAV) { + items = AvFILLp((AV *)namesv) + 1; + svp = AvARRAY((AV *)namesv); + } + else { + items = 1; + svp = &namesv; + } + while (items--) { const U32 name_utf8 = SvUTF8(*svp); - STRLEN len; - const char *name = SvPVx_const(*svp, len); - if(PL_stashcache) { + STRLEN len; + const char *name = SvPVx_const(*svp, len); + if(PL_stashcache) { DEBUG_o(Perl_deb(aTHX_ "mro_gather_and_rename clearing PL_stashcache for '%" SVf "'\n", SVfARG(*svp))); - (void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD); + (void)hv_delete(PL_stashcache, name, name_utf8 ? -(I32)len : (I32)len, G_DISCARD); } ++svp; - hv_ename_delete(oldstash, name, len, name_utf8); - - if (!fetched_isarev) { - /* If the name deletion caused a name change, then we - * are not going to call mro_isa_changed_in with this - * name (and not at all if it has become anonymous) so - * we need to delete old isarev entries here, both - * those in the superclasses and this class's own list - * of subclasses. We simply delete the latter from - * PL_isarev, since we still need it. hv_delete morti- - * fies it for us, so sv_2mortal is not necessary. */ - if(HvENAME_HEK(oldstash) != enamehek) { - if(meta->isa && HvARRAY(meta->isa)) - mro_clean_isarev(meta->isa, name, len, 0, 0, - name_utf8 ? HVhek_UTF8 : 0); - isarev = (HV *)hv_delete(PL_isarev, name, + hv_ename_delete(oldstash, name, len, name_utf8); + + if (!fetched_isarev) { + /* If the name deletion caused a name change, then we + * are not going to call mro_isa_changed_in with this + * name (and not at all if it has become anonymous) so + * we need to delete old isarev entries here, both + * those in the superclasses and this class's own list + * of subclasses. We simply delete the latter from + * PL_isarev, since we still need it. hv_delete morti- + * fies it for us, so sv_2mortal is not necessary. */ + if(HvENAME_HEK(oldstash) != enamehek) { + if(meta->isa && HvARRAY(meta->isa)) + mro_clean_isarev(meta->isa, name, len, 0, 0, + name_utf8 ? HVhek_UTF8 : 0); + isarev = (HV *)hv_delete(PL_isarev, name, name_utf8 ? -(I32)len : (I32)len, 0); - fetched_isarev=TRUE; - } - } - } - } + fetched_isarev=TRUE; + } + } + } + } } check_stash: if(stash) { - if(SvTYPE(namesv) == SVt_PVAV) { - items = AvFILLp((AV *)namesv) + 1; - svp = AvARRAY((AV *)namesv); - } - else { - items = 1; - svp = &namesv; - } - while (items--) { + if(SvTYPE(namesv) == SVt_PVAV) { + items = AvFILLp((AV *)namesv) + 1; + svp = AvARRAY((AV *)namesv); + } + else { + items = 1; + svp = &namesv; + } + while (items--) { const U32 name_utf8 = SvUTF8(*svp); - STRLEN len; - const char *name = SvPVx_const(*svp++, len); - hv_ename_add(stash, name, len, name_utf8); - } + STRLEN len; + const char *name = SvPVx_const(*svp++, len); + hv_ename_add(stash, name, len, name_utf8); + } /* Add it to the big list if it needs - * mro_isa_changed_in called on it. That happens if it was - * detached from the symbol table (so it had no HvENAME) before - * being assigned to the spot named by the 'name' variable, because - * its cached isa linearisation is now stale (the effective name - * having changed), and subclasses will then use that cache when - * mro_package_moved calls mro_isa_changed_in. (See - * [perl #77358].) - * - * If it did have a name, then its previous name is still - * used in isa caches, and there is no need for - * mro_package_moved to call mro_isa_changed_in. - */ - - entry - = (HE *) - hv_common( - seen_stashes, NULL, (const char *)&stash, sizeof(HV *), 0, - HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0 - ); - if(HeVAL(entry) == &PL_sv_yes || HeVAL(entry) == &PL_sv_no) - stash = NULL; - else { - HeVAL(entry) - = HeVAL(entry) == &PL_sv_undef ? &PL_sv_yes : &PL_sv_no; - if(!stash_had_name) - { - struct mro_meta * const meta = HvMROMETA(stash); - (void) - hv_store( - stashes, (const char *)&stash, sizeof(HV *), - meta->isa - ? SvREFCNT_inc_simple_NN((SV *)meta->isa) - : &PL_sv_yes, - 0 - ); - CLEAR_LINEAR(meta); - } - } + * mro_isa_changed_in called on it. That happens if it was + * detached from the symbol table (so it had no HvENAME) before + * being assigned to the spot named by the 'name' variable, because + * its cached isa linearisation is now stale (the effective name + * having changed), and subclasses will then use that cache when + * mro_package_moved calls mro_isa_changed_in. (See + * [perl #77358].) + * + * If it did have a name, then its previous name is still + * used in isa caches, and there is no need for + * mro_package_moved to call mro_isa_changed_in. + */ + + entry + = (HE *) + hv_common( + seen_stashes, NULL, (const char *)&stash, sizeof(HV *), 0, + HV_FETCH_LVALUE|HV_FETCH_EMPTY_HE, NULL, 0 + ); + if(HeVAL(entry) == &PL_sv_yes || HeVAL(entry) == &PL_sv_no) + stash = NULL; + else { + HeVAL(entry) + = HeVAL(entry) == &PL_sv_undef ? &PL_sv_yes : &PL_sv_no; + if(!stash_had_name) + { + struct mro_meta * const meta = HvMROMETA(stash); + (void) + hv_store( + stashes, (const char *)&stash, sizeof(HV *), + meta->isa + ? SvREFCNT_inc_simple_NN((SV *)meta->isa) + : &PL_sv_yes, + 0 + ); + CLEAR_LINEAR(meta); + } + } } if(!stash && !oldstash) - /* Both stashes have been encountered already. */ - return; + /* Both stashes have been encountered already. */ + return; /* Add all the subclasses to the big list. */ if(!fetched_isarev) { - /* If oldstash is not null, then we can use its HvENAME to look up - the isarev hash, since all its subclasses will be listed there. - It will always have an HvENAME. It the HvENAME was removed - above, then fetch_isarev will be true, and this code will not be - reached. - - If oldstash is null, then this is an empty spot with no stash in - it, so subclasses could be listed in isarev hashes belonging to - any of the names, so we have to check all of them. - */ - assert(!oldstash || HvENAME(oldstash)); - if (oldstash) { - /* Extra variable to avoid a compiler warning */ - const HEK * const hvename = HvENAME_HEK(oldstash); - fetched_isarev = TRUE; - svp = hv_fetchhek(PL_isarev, hvename, 0); - if (svp) isarev = MUTABLE_HV(*svp); - } - else if(SvTYPE(namesv) == SVt_PVAV) { - items = AvFILLp((AV *)namesv) + 1; - svp = AvARRAY((AV *)namesv); - } - else { - items = 1; - svp = &namesv; - } + /* If oldstash is not null, then we can use its HvENAME to look up + the isarev hash, since all its subclasses will be listed there. + It will always have an HvENAME. It the HvENAME was removed + above, then fetch_isarev will be true, and this code will not be + reached. + + If oldstash is null, then this is an empty spot with no stash in + it, so subclasses could be listed in isarev hashes belonging to + any of the names, so we have to check all of them. + */ + assert(!oldstash || HvENAME(oldstash)); + if (oldstash) { + /* Extra variable to avoid a compiler warning */ + const HEK * const hvename = HvENAME_HEK(oldstash); + fetched_isarev = TRUE; + svp = hv_fetchhek(PL_isarev, hvename, 0); + if (svp) isarev = MUTABLE_HV(*svp); + } + else if(SvTYPE(namesv) == SVt_PVAV) { + items = AvFILLp((AV *)namesv) + 1; + svp = AvARRAY((AV *)namesv); + } + else { + items = 1; + svp = &namesv; + } } if( isarev || !fetched_isarev ) { while (fetched_isarev || items--) { - HE *iter; - - if (!fetched_isarev) { - HE * const he = hv_fetch_ent(PL_isarev, *svp++, 0, 0); - if (!he || !(isarev = MUTABLE_HV(HeVAL(he)))) continue; - } - - hv_iterinit(isarev); - while((iter = hv_iternext(isarev))) { - HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0); - struct mro_meta * meta; - - if(!revstash) continue; - meta = HvMROMETA(revstash); - (void) - hv_store( - stashes, (const char *)&revstash, sizeof(HV *), - meta->isa - ? SvREFCNT_inc_simple_NN((SV *)meta->isa) - : &PL_sv_yes, - 0 - ); - CLEAR_LINEAR(meta); + HE *iter; + + if (!fetched_isarev) { + HE * const he = hv_fetch_ent(PL_isarev, *svp++, 0, 0); + if (!he || !(isarev = MUTABLE_HV(HeVAL(he)))) continue; } - if (fetched_isarev) break; + hv_iterinit(isarev); + while((iter = hv_iternext(isarev))) { + HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0); + struct mro_meta * meta; + + if(!revstash) continue; + meta = HvMROMETA(revstash); + (void) + hv_store( + stashes, (const char *)&revstash, sizeof(HV *), + meta->isa + ? SvREFCNT_inc_simple_NN((SV *)meta->isa) + : &PL_sv_yes, + 0 + ); + CLEAR_LINEAR(meta); + } + + if (fetched_isarev) break; } } @@ -1113,169 +1113,169 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, /* Skip the entire loop if the hash is empty. */ if(oldstash && HvUSEDKEYS(oldstash)) { - xhv = (XPVHV*)SvANY(oldstash); - seen = (HV *) sv_2mortal((SV *)newHV()); - - /* Iterate through entries in the oldstash, adding them to the - list, meanwhile doing the equivalent of $seen{$key} = 1. - */ - - while (++riter <= (I32)xhv->xhv_max) { - entry = (HvARRAY(oldstash))[riter]; - - /* Iterate through the entries in this list */ - for(; entry; entry = HeNEXT(entry)) { - const char* key; - I32 len; - - /* If this entry is not a glob, ignore it. - Try the next. */ - if (!isGV(HeVAL(entry))) continue; - - key = hv_iterkey(entry, &len); - if ((len > 1 && key[len-2] == ':' && key[len-1] == ':') - || (len == 1 && key[0] == ':')) { - HV * const oldsubstash = GvHV(HeVAL(entry)); - SV ** const stashentry - = stash ? hv_fetch(stash, key, HeUTF8(entry) ? -(I32)len : (I32)len, 0) : NULL; - HV *substash = NULL; - - /* Avoid main::main::main::... */ - if(oldsubstash == oldstash) continue; - - if( - ( - stashentry && *stashentry && isGV(*stashentry) - && (substash = GvHV(*stashentry)) - ) - || (oldsubstash && HvENAME_get(oldsubstash)) - ) - { - /* Add :: and the key (minus the trailing ::) - to each name. */ - SV *subname; - if(SvTYPE(namesv) == SVt_PVAV) { - SV *aname; - items = AvFILLp((AV *)namesv) + 1; - svp = AvARRAY((AV *)namesv); - subname = sv_2mortal((SV *)newAV()); - while (items--) { - aname = newSVsv(*svp++); - if (len == 1) - sv_catpvs(aname, ":"); - else { - sv_catpvs(aname, "::"); - sv_catpvn_flags( - aname, key, len-2, - HeUTF8(entry) - ? SV_CATUTF8 : SV_CATBYTES - ); - } - av_push((AV *)subname, aname); - } - } - else { - subname = sv_2mortal(newSVsv(namesv)); - if (len == 1) sv_catpvs(subname, ":"); - else { - sv_catpvs(subname, "::"); - sv_catpvn_flags( - subname, key, len-2, - HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES - ); - } - } - mro_gather_and_rename( - stashes, seen_stashes, - substash, oldsubstash, subname - ); - } - - (void)hv_store(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len, &PL_sv_yes, 0); - } - } - } + xhv = (XPVHV*)SvANY(oldstash); + seen = (HV *) sv_2mortal((SV *)newHV()); + + /* Iterate through entries in the oldstash, adding them to the + list, meanwhile doing the equivalent of $seen{$key} = 1. + */ + + while (++riter <= (I32)xhv->xhv_max) { + entry = (HvARRAY(oldstash))[riter]; + + /* Iterate through the entries in this list */ + for(; entry; entry = HeNEXT(entry)) { + const char* key; + I32 len; + + /* If this entry is not a glob, ignore it. + Try the next. */ + if (!isGV(HeVAL(entry))) continue; + + key = hv_iterkey(entry, &len); + if ((len > 1 && key[len-2] == ':' && key[len-1] == ':') + || (len == 1 && key[0] == ':')) { + HV * const oldsubstash = GvHV(HeVAL(entry)); + SV ** const stashentry + = stash ? hv_fetch(stash, key, HeUTF8(entry) ? -(I32)len : (I32)len, 0) : NULL; + HV *substash = NULL; + + /* Avoid main::main::main::... */ + if(oldsubstash == oldstash) continue; + + if( + ( + stashentry && *stashentry && isGV(*stashentry) + && (substash = GvHV(*stashentry)) + ) + || (oldsubstash && HvENAME_get(oldsubstash)) + ) + { + /* Add :: and the key (minus the trailing ::) + to each name. */ + SV *subname; + if(SvTYPE(namesv) == SVt_PVAV) { + SV *aname; + items = AvFILLp((AV *)namesv) + 1; + svp = AvARRAY((AV *)namesv); + subname = sv_2mortal((SV *)newAV()); + while (items--) { + aname = newSVsv(*svp++); + if (len == 1) + sv_catpvs(aname, ":"); + else { + sv_catpvs(aname, "::"); + sv_catpvn_flags( + aname, key, len-2, + HeUTF8(entry) + ? SV_CATUTF8 : SV_CATBYTES + ); + } + av_push((AV *)subname, aname); + } + } + else { + subname = sv_2mortal(newSVsv(namesv)); + if (len == 1) sv_catpvs(subname, ":"); + else { + sv_catpvs(subname, "::"); + sv_catpvn_flags( + subname, key, len-2, + HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES + ); + } + } + mro_gather_and_rename( + stashes, seen_stashes, + substash, oldsubstash, subname + ); + } + + (void)hv_store(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len, &PL_sv_yes, 0); + } + } + } } /* Skip the entire loop if the hash is empty. */ if (stash && HvUSEDKEYS(stash)) { - xhv = (XPVHV*)SvANY(stash); - riter = -1; - - /* Iterate through the new stash, skipping $seen{$key} items, - calling mro_gather_and_rename(stashes,seen,entry,NULL, ...). */ - while (++riter <= (I32)xhv->xhv_max) { - entry = (HvARRAY(stash))[riter]; - - /* Iterate through the entries in this list */ - for(; entry; entry = HeNEXT(entry)) { - const char* key; - I32 len; - - /* If this entry is not a glob, ignore it. - Try the next. */ - if (!isGV(HeVAL(entry))) continue; - - key = hv_iterkey(entry, &len); - if ((len > 1 && key[len-2] == ':' && key[len-1] == ':') - || (len == 1 && key[0] == ':')) { - HV *substash; - - /* If this entry was seen when we iterated through the - oldstash, skip it. */ - if(seen && hv_exists(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len)) continue; - - /* We get here only if this stash has no corresponding - entry in the stash being replaced. */ - - substash = GvHV(HeVAL(entry)); - if(substash) { - SV *subname; - - /* Avoid checking main::main::main::... */ - if(substash == stash) continue; - - /* Add :: and the key (minus the trailing ::) - to each name. */ - if(SvTYPE(namesv) == SVt_PVAV) { - SV *aname; - items = AvFILLp((AV *)namesv) + 1; - svp = AvARRAY((AV *)namesv); - subname = sv_2mortal((SV *)newAV()); - while (items--) { - aname = newSVsv(*svp++); - if (len == 1) - sv_catpvs(aname, ":"); - else { - sv_catpvs(aname, "::"); - sv_catpvn_flags( - aname, key, len-2, - HeUTF8(entry) - ? SV_CATUTF8 : SV_CATBYTES - ); - } - av_push((AV *)subname, aname); - } - } - else { - subname = sv_2mortal(newSVsv(namesv)); - if (len == 1) sv_catpvs(subname, ":"); - else { - sv_catpvs(subname, "::"); - sv_catpvn_flags( - subname, key, len-2, - HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES - ); - } - } - mro_gather_and_rename( - stashes, seen_stashes, - substash, NULL, subname - ); - } - } - } - } + xhv = (XPVHV*)SvANY(stash); + riter = -1; + + /* Iterate through the new stash, skipping $seen{$key} items, + calling mro_gather_and_rename(stashes,seen,entry,NULL, ...). */ + while (++riter <= (I32)xhv->xhv_max) { + entry = (HvARRAY(stash))[riter]; + + /* Iterate through the entries in this list */ + for(; entry; entry = HeNEXT(entry)) { + const char* key; + I32 len; + + /* If this entry is not a glob, ignore it. + Try the next. */ + if (!isGV(HeVAL(entry))) continue; + + key = hv_iterkey(entry, &len); + if ((len > 1 && key[len-2] == ':' && key[len-1] == ':') + || (len == 1 && key[0] == ':')) { + HV *substash; + + /* If this entry was seen when we iterated through the + oldstash, skip it. */ + if(seen && hv_exists(seen, key, HeUTF8(entry) ? -(I32)len : (I32)len)) continue; + + /* We get here only if this stash has no corresponding + entry in the stash being replaced. */ + + substash = GvHV(HeVAL(entry)); + if(substash) { + SV *subname; + + /* Avoid checking main::main::main::... */ + if(substash == stash) continue; + + /* Add :: and the key (minus the trailing ::) + to each name. */ + if(SvTYPE(namesv) == SVt_PVAV) { + SV *aname; + items = AvFILLp((AV *)namesv) + 1; + svp = AvARRAY((AV *)namesv); + subname = sv_2mortal((SV *)newAV()); + while (items--) { + aname = newSVsv(*svp++); + if (len == 1) + sv_catpvs(aname, ":"); + else { + sv_catpvs(aname, "::"); + sv_catpvn_flags( + aname, key, len-2, + HeUTF8(entry) + ? SV_CATUTF8 : SV_CATBYTES + ); + } + av_push((AV *)subname, aname); + } + } + else { + subname = sv_2mortal(newSVsv(namesv)); + if (len == 1) sv_catpvs(subname, ":"); + else { + sv_catpvs(subname, "::"); + sv_catpvn_flags( + subname, key, len-2, + HeUTF8(entry) ? SV_CATUTF8 : SV_CATBYTES + ); + } + } + mro_gather_and_rename( + stashes, seen_stashes, + substash, NULL, subname + ); + } + } + } + } } } @@ -1340,7 +1340,7 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* else, invalidate the method caches of all child classes, but not itself */ if(isarev) { - HE* iter; + HE* iter; hv_iterinit(isarev); while((iter = hv_iternext(isarev))) { @@ -1374,15 +1374,15 @@ Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name) Perl_croak(aTHX_ "Invalid mro name: '%" SVf "'", name); if(meta->mro_which != which) { - if (meta->mro_linear_current && !meta->mro_linear_all) { - /* If we were storing something directly, put it in the hash before - we lose it. */ - Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, - MUTABLE_SV(meta->mro_linear_current)); - } - meta->mro_which = which; - /* Scrub our cached pointer to the private data. */ - meta->mro_linear_current = NULL; + if (meta->mro_linear_current && !meta->mro_linear_all) { + /* If we were storing something directly, put it in the hash before + we lose it. */ + Perl_mro_set_private_data(aTHX_ meta, meta->mro_which, + MUTABLE_SV(meta->mro_linear_current)); + } + meta->mro_which = which; + /* Scrub our cached pointer to the private data. */ + meta->mro_linear_current = NULL; /* Only affects local method cache, not even child classes */ meta->cache_gen++; @@ -1412,7 +1412,7 @@ XS(XS_mro_method_changed_in) HV* class_stash; if(items != 1) - croak_xs_usage(cv, "classname"); + croak_xs_usage(cv, "classname"); classname = ST(0); diff --git a/numeric.c b/numeric.c index 349048cdcbe8..72130dd9f521 100644 --- a/numeric.c +++ b/numeric.c @@ -1367,9 +1367,9 @@ S_mulexp10(NV value, I32 exponent) I32 bit; if (exponent == 0) - return value; + return value; if (value == 0) - return (NV)0; + return (NV)0; /* On OpenVMS VAX we by default use the D_FLOAT double format, * and that format does not have *easy* capabilities [1] for @@ -1393,24 +1393,24 @@ S_mulexp10(NV value, I32 exponent) #if ((defined(VMS) && !defined(_IEEE_FP)) || defined(_UNICOS) || defined(DOUBLE_IS_VAX_FLOAT)) && defined(NV_MAX_10_EXP) STMT_START { - const NV exp_v = log10(value); - if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP) - return NV_MAX; - if (exponent < 0) { - if (-(exponent + exp_v) >= NV_MAX_10_EXP) - return 0.0; - while (-exponent >= NV_MAX_10_EXP) { - /* combination does not overflow, but 10^(-exponent) does */ - value /= 10; - ++exponent; - } - } + const NV exp_v = log10(value); + if (exponent >= NV_MAX_10_EXP || exponent + exp_v >= NV_MAX_10_EXP) + return NV_MAX; + if (exponent < 0) { + if (-(exponent + exp_v) >= NV_MAX_10_EXP) + return 0.0; + while (-exponent >= NV_MAX_10_EXP) { + /* combination does not overflow, but 10^(-exponent) does */ + value /= 10; + ++exponent; + } + } } STMT_END; #endif if (exponent < 0) { - negative = 1; - exponent = -exponent; + negative = 1; + exponent = -exponent; #ifdef NV_MAX_10_EXP /* for something like 1234 x 10^-309, the action of calculating * the intermediate value 10^309 then returning 1234 / (10^309) @@ -1433,9 +1433,9 @@ S_mulexp10(NV value, I32 exponent) # define FP_OVERFLOWS_TO_ZERO #endif for (bit = 1; exponent; bit <<= 1) { - if (exponent & bit) { - exponent ^= bit; - result *= power; + if (exponent & bit) { + exponent ^= bit; + result *= power; #ifdef FP_OVERFLOWS_TO_ZERO if (result == 0) # ifdef NV_INF @@ -1444,12 +1444,12 @@ S_mulexp10(NV value, I32 exponent) return value < 0 ? -FLT_MAX : FLT_MAX; # endif #endif - /* Floating point exceptions are supposed to be turned off, - * but if we're obviously done, don't risk another iteration. - */ - if (exponent == 0) break; - } - power *= power; + /* Floating point exceptions are supposed to be turned off, + * but if we're obviously done, don't risk another iteration. + */ + if (exponent == 0) break; + } + power *= power; } return negative ? value / result : value * result; } @@ -1646,15 +1646,15 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) /* leading whitespace */ while (s < send && isSPACE(*s)) - ++s; + ++s; /* sign */ switch (*s) { - case '-': - negative = 1; - /* FALLTHROUGH */ - case '+': - ++s; + case '-': + negative = 1; + /* FALLTHROUGH */ + case '+': + ++s; } #endif @@ -1744,102 +1744,102 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) * large, we add the total to NV and start again */ while (s < send) { - if (isDIGIT(*s)) { - seen_digit = 1; - old_digit = digit; - digit = *s++ - '0'; - if (seen_dp) - exp_adjust[1]++; - - /* don't start counting until we see the first significant - * digit, eg the 5 in 0.00005... */ - if (!sig_digits && digit == 0) - continue; - - if (++sig_digits > MAX_SIG_DIGITS) { - /* limits of precision reached */ - if (digit > 5) { - ++accumulator[seen_dp]; - } else if (digit == 5) { - if (old_digit % 2) { /* round to even - Allen */ - ++accumulator[seen_dp]; - } - } - if (seen_dp) { - exp_adjust[1]--; - } else { - exp_adjust[0]++; - } - /* skip remaining digits */ - while (s < send && isDIGIT(*s)) { - ++s; - if (! seen_dp) { - exp_adjust[0]++; - } - } - /* warn of loss of precision? */ - } - else { - if (accumulator[seen_dp] > MAX_ACCUMULATE) { - /* add accumulator to result and start again */ - result[seen_dp] = S_mulexp10(result[seen_dp], - exp_acc[seen_dp]) - + (NV)accumulator[seen_dp]; - accumulator[seen_dp] = 0; - exp_acc[seen_dp] = 0; - } - accumulator[seen_dp] = accumulator[seen_dp] * 10 + digit; - ++exp_acc[seen_dp]; - } - } - else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) { - seen_dp = 1; - if (sig_digits > MAX_SIG_DIGITS) { - while (s < send && isDIGIT(*s)) { - ++s; - } - break; - } - } - else { - break; - } + if (isDIGIT(*s)) { + seen_digit = 1; + old_digit = digit; + digit = *s++ - '0'; + if (seen_dp) + exp_adjust[1]++; + + /* don't start counting until we see the first significant + * digit, eg the 5 in 0.00005... */ + if (!sig_digits && digit == 0) + continue; + + if (++sig_digits > MAX_SIG_DIGITS) { + /* limits of precision reached */ + if (digit > 5) { + ++accumulator[seen_dp]; + } else if (digit == 5) { + if (old_digit % 2) { /* round to even - Allen */ + ++accumulator[seen_dp]; + } + } + if (seen_dp) { + exp_adjust[1]--; + } else { + exp_adjust[0]++; + } + /* skip remaining digits */ + while (s < send && isDIGIT(*s)) { + ++s; + if (! seen_dp) { + exp_adjust[0]++; + } + } + /* warn of loss of precision? */ + } + else { + if (accumulator[seen_dp] > MAX_ACCUMULATE) { + /* add accumulator to result and start again */ + result[seen_dp] = S_mulexp10(result[seen_dp], + exp_acc[seen_dp]) + + (NV)accumulator[seen_dp]; + accumulator[seen_dp] = 0; + exp_acc[seen_dp] = 0; + } + accumulator[seen_dp] = accumulator[seen_dp] * 10 + digit; + ++exp_acc[seen_dp]; + } + } + else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) { + seen_dp = 1; + if (sig_digits > MAX_SIG_DIGITS) { + while (s < send && isDIGIT(*s)) { + ++s; + } + break; + } + } + else { + break; + } } result[0] = S_mulexp10(result[0], exp_acc[0]) + (NV)accumulator[0]; if (seen_dp) { - result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1]; + result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1]; } if (s < send && seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) { - bool expnegative = 0; - - ++s; - switch (*s) { - case '-': - expnegative = 1; - /* FALLTHROUGH */ - case '+': - ++s; - } - while (s < send && isDIGIT(*s)) - exponent = exponent * 10 + (*s++ - '0'); - if (expnegative) - exponent = -exponent; + bool expnegative = 0; + + ++s; + switch (*s) { + case '-': + expnegative = 1; + /* FALLTHROUGH */ + case '+': + ++s; + } + while (s < send && isDIGIT(*s)) + exponent = exponent * 10 + (*s++ - '0'); + if (expnegative) + exponent = -exponent; } /* now apply the exponent */ if (seen_dp) { - result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]) - + S_mulexp10(result[1],exponent-exp_adjust[1]); + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]) + + S_mulexp10(result[1],exponent-exp_adjust[1]); } else { - result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]); + result[2] = S_mulexp10(result[0],exponent+exp_adjust[0]); } /* now apply the sign */ if (negative) - result[2] = -result[2]; + result[2] = -result[2]; *value = result[2]; return (char *)s; #else /* USE_PERL_ATOF */ diff --git a/op.h b/op.h index 975071756240..189299ec6497 100644 --- a/op.h +++ b/op.h @@ -65,7 +65,7 @@ typedef PERL_BITFIELD16 Optype; /* for efficiency, requires OPf_WANT_VOID == G_VOID etc */ #define OP_GIMME(op,dfl) \ - (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl) + (((op)->op_flags & OPf_WANT) ? ((op)->op_flags & OPf_WANT) : dfl) #define OP_GIMME_REVERSE(flags) ((flags) & G_WANT) @@ -95,9 +95,9 @@ Deprecated. Use C instead. #define OPf_WANT_LIST 3 /* Want list of any length */ #define OPf_KIDS 4 /* There is a firstborn child. */ #define OPf_PARENS 8 /* This operator was parenthesized. */ - /* (Or block needs explicit scope entry.) */ + /* (Or block needs explicit scope entry.) */ #define OPf_REF 16 /* Certified reference. */ - /* (Return container, not containee). */ + /* (Return container, not containee). */ #define OPf_MOD 32 /* Will modify (lvalue). */ #define OPf_STACKED 64 /* Some arg is arriving on the stack. */ @@ -106,43 +106,43 @@ Deprecated. Use C instead. */ #define OPf_SPECIAL 128 /* Do something weird for this op: */ - /* On local LVAL, don't init local value. */ - /* On OP_SORT, subroutine is inlined. */ - /* On OP_NOT, inversion was implicit. */ - /* On OP_LEAVE, don't restore curpm, e.g. + /* On local LVAL, don't init local value. */ + /* On OP_SORT, subroutine is inlined. */ + /* On OP_NOT, inversion was implicit. */ + /* On OP_LEAVE, don't restore curpm, e.g. * /(...)/ while ...>; */ - /* On truncate, we truncate filehandle */ - /* On control verbs, we saw no label */ - /* On flipflop, we saw ... instead of .. */ - /* On UNOPs, saw bare parens, e.g. eof(). */ - /* On OP_CHDIR, handle (or bare parens) */ - /* On OP_NULL, saw a "do". */ - /* On OP_EXISTS, treat av as av, not avhv. */ - /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ - /* On regcomp, "use re 'eval'" was in scope */ - /* On RV2[ACGHS]V, don't create GV--in - defined()*/ - /* On OP_DBSTATE, indicates breakpoint - * (runtime property) */ - /* On OP_REQUIRE, was seen as CORE::require */ - /* On OP_(ENTER|LEAVE)WHEN, there's - no condition */ - /* On OP_SMARTMATCH, an implicit smartmatch */ - /* On OP_ANONHASH and OP_ANONLIST, create a - reference to the new anon hash or array */ - /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE, + /* On truncate, we truncate filehandle */ + /* On control verbs, we saw no label */ + /* On flipflop, we saw ... instead of .. */ + /* On UNOPs, saw bare parens, e.g. eof(). */ + /* On OP_CHDIR, handle (or bare parens) */ + /* On OP_NULL, saw a "do". */ + /* On OP_EXISTS, treat av as av, not avhv. */ + /* On OP_(ENTER|LEAVE)EVAL, don't clear $@ */ + /* On regcomp, "use re 'eval'" was in scope */ + /* On RV2[ACGHS]V, don't create GV--in + defined()*/ + /* On OP_DBSTATE, indicates breakpoint + * (runtime property) */ + /* On OP_REQUIRE, was seen as CORE::require */ + /* On OP_(ENTER|LEAVE)WHEN, there's + no condition */ + /* On OP_SMARTMATCH, an implicit smartmatch */ + /* On OP_ANONHASH and OP_ANONLIST, create a + reference to the new anon hash or array */ + /* On OP_HELEM, OP_MULTIDEREF and OP_HSLICE, localization will be followed by assignment, so do not wipe the target if it is special (e.g. a glob or a magic SV) */ - /* On OP_MATCH, OP_SUBST & OP_TRANS, the - operand of a logical or conditional - that was optimised away, so it should - not be bound via =~ */ - /* On OP_CONST, from a constant CV */ - /* On OP_GLOB, two meanings: - - Before ck_glob, called as CORE::glob - - After ck_glob, use Perl glob function - */ + /* On OP_MATCH, OP_SUBST & OP_TRANS, the + operand of a logical or conditional + that was optimised away, so it should + not be bound via =~ */ + /* On OP_CONST, from a constant CV */ + /* On OP_GLOB, two meanings: + - Before ck_glob, called as CORE::glob + - After ck_glob, use Perl glob function + */ /* On OP_PADRANGE, push @_ */ /* On OP_DUMP, has no label */ /* On OP_UNSTACK, in a C-style for loop */ @@ -158,11 +158,11 @@ Deprecated. Use C instead. #if !defined(PERL_CORE) && !defined(PERL_EXT) # define GIMME \ - (PL_op->op_flags & OPf_WANT \ - ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \ - ? G_ARRAY \ - : G_SCALAR) \ - : dowantarray()) + (PL_op->op_flags & OPf_WANT \ + ? ((PL_op->op_flags & OPf_WANT) == OPf_WANT_LIST \ + ? G_ARRAY \ + : G_SCALAR) \ + : dowantarray()) #endif @@ -259,16 +259,16 @@ struct pmop { #endif U32 op_pmflags; union { - OP * op_pmreplroot; /* For OP_SUBST */ - PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */ - GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */ + OP * op_pmreplroot; /* For OP_SUBST */ + PADOFFSET op_pmtargetoff; /* For OP_SPLIT lex ary or thr GV */ + GV * op_pmtargetgv; /* For OP_SPLIT non-threaded GV */ } op_pmreplrootu; union { - OP * op_pmreplstart; /* Only used in OP_SUBST */ + OP * op_pmreplstart; /* Only used in OP_SUBST */ #ifdef USE_ITHREADS - PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */ + PADOFFSET op_pmstashoff; /* Only used in OP_MATCH, with PMf_ONCE set */ #else - HV * op_pmstash; + HV * op_pmstash; #endif } op_pmstashstartu; OP * op_code_list; /* list of (?{}) code blocks */ @@ -276,7 +276,7 @@ struct pmop { #ifdef USE_ITHREADS #define PM_GETRE(o) (SvTYPE(PL_regex_pad[(o)->op_pmoffset]) == SVt_REGEXP \ - ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL) + ? (REGEXP*)(PL_regex_pad[(o)->op_pmoffset]) : NULL) /* The assignment is just to enforce type safety (or at least get a warning). */ /* With first class regexps not via a reference one needs to assign @@ -288,7 +288,7 @@ struct pmop { #define PM_SETRE(o,r) STMT_START { \ REGEXP *const _pm_setre = (r); \ assert(_pm_setre); \ - PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \ + PL_regex_pad[(o)->op_pmoffset] = MUTABLE_SV(_pm_setre); \ } STMT_END #else #define PM_GETRE(o) ((o)->op_pmregexp) @@ -390,16 +390,16 @@ struct pmop { ? PL_stashpad[(o)->op_pmstashstartu.op_pmstashoff] \ : NULL) # define PmopSTASH_set(o,hv) \ - (assert_((o)->op_pmflags & PMf_ONCE) \ - (o)->op_pmstashstartu.op_pmstashoff = \ - (hv) ? alloccopstash(hv) : 0) + (assert_((o)->op_pmflags & PMf_ONCE) \ + (o)->op_pmstashstartu.op_pmstashoff = \ + (hv) ? alloccopstash(hv) : 0) #else # define PmopSTASH(o) \ (((o)->op_pmflags & PMf_ONCE) ? (o)->op_pmstashstartu.op_pmstash : NULL) # if defined (DEBUGGING) && defined(PERL_USE_GCC_BRACE_GROUPS) # define PmopSTASH_set(o,hv) ({ \ - assert((o)->op_pmflags & PMf_ONCE); \ - ((o)->op_pmstashstartu.op_pmstash = (hv)); \ + assert((o)->op_pmflags & PMf_ONCE); \ + ((o)->op_pmstashstartu.op_pmstash = (hv)); \ }) # else # define PmopSTASH_set(o,hv) ((o)->op_pmstashstartu.op_pmstash = (hv)) @@ -506,12 +506,12 @@ typedef enum { # ifndef PERL_CORE # define IS_PADGV(v) (v && isGV(v)) # define IS_PADCONST(v) \ - (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v)))) + (v && (SvREADONLY(v) || (SvIsCOW(v) && !SvLEN(v)))) # endif # define cSVOPx_sv(v) (cSVOPx(v)->op_sv \ - ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) + ? cSVOPx(v)->op_sv : PAD_SVl((v)->op_targ)) # define cSVOPx_svp(v) (cSVOPx(v)->op_sv \ - ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) + ? &cSVOPx(v)->op_sv : &PAD_SVl((v)->op_targ)) # define cMETHOPx_rclass(v) PAD_SVl(cMETHOPx(v)->op_rclass_targ) #else # define cGVOPx_gv(o) ((GV*)cSVOPx(o)->op_sv) @@ -621,9 +621,9 @@ typedef enum { #define PERL_LOADMOD_DENY 0x1 /* no Module */ #define PERL_LOADMOD_NOIMPORT 0x2 /* use Module () */ #define PERL_LOADMOD_IMPORT_OPS 0x4 /* import arguments - are passed as a sin- - gle op tree, not a - list of SVs */ + are passed as a sin- + gle op tree, not a + list of SVs */ #if defined(PERL_IN_PERLY_C) || defined(PERL_IN_OP_C) || defined(PERL_IN_TOKE_C) #define ref(o, type) doref(o, type, TRUE) @@ -668,9 +668,9 @@ least an C. #endif #define NewOp(m,var,c,type) \ - (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type))) + (var = (type *) Perl_Slab_Alloc(aTHX_ c*sizeof(type))) #define NewOpSz(m,var,size) \ - (var = (OP *) Perl_Slab_Alloc(aTHX_ size)) + (var = (OP *) Perl_Slab_Alloc(aTHX_ size)) #define FreeOp(p) Perl_Slab_Free(aTHX_ p) /* @@ -719,7 +719,7 @@ struct opslab { # define OPSLOT_HEADER STRUCT_OFFSET(OPSLOT, opslot_op) # define OpSLOT(o) (assert_(o->op_slabbed) \ - (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) + (OPSLOT *)(((char *)o)-OPSLOT_HEADER)) /* the slab that owns this op */ # define OpMySLAB(o) \ @@ -732,14 +732,14 @@ struct opslab { ((OPSLOT*)(((I32 **)&(slab)->opslab_slots)+(offset))) # define OpslabREFCNT_dec(slab) \ - (((slab)->opslab_refcnt == 1) \ - ? opslab_free_nopad(slab) \ - : (void)--(slab)->opslab_refcnt) + (((slab)->opslab_refcnt == 1) \ + ? opslab_free_nopad(slab) \ + : (void)--(slab)->opslab_refcnt) /* Variant that does not null out the pads */ # define OpslabREFCNT_dec_padok(slab) \ - (((slab)->opslab_refcnt == 1) \ - ? opslab_free(slab) \ - : (void)--(slab)->opslab_refcnt) + (((slab)->opslab_refcnt == 1) \ + ? opslab_free(slab) \ + : (void)--(slab)->opslab_refcnt) #endif struct block_hooks { @@ -797,39 +797,39 @@ preprocessing token; the type of C depends on C. #define BhkENABLE(hk, which) \ STMT_START { \ - BhkFLAGS(hk) |= BHKf_ ## which; \ - assert(BhkENTRY(hk, which)); \ + BhkFLAGS(hk) |= BHKf_ ## which; \ + assert(BhkENTRY(hk, which)); \ } STMT_END #define BhkDISABLE(hk, which) \ STMT_START { \ - BhkFLAGS(hk) &= ~(BHKf_ ## which); \ + BhkFLAGS(hk) &= ~(BHKf_ ## which); \ } STMT_END #define BhkENTRY_set(hk, which, ptr) \ STMT_START { \ - (hk)->which = ptr; \ - BhkENABLE(hk, which); \ + (hk)->which = ptr; \ + BhkENABLE(hk, which); \ } STMT_END #define CALL_BLOCK_HOOKS(which, arg) \ STMT_START { \ - if (PL_blockhooks) { \ - SSize_t i; \ - for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \ - SV *sv = AvARRAY(PL_blockhooks)[i]; \ - BHK *hk; \ - \ - assert(SvIOK(sv)); \ - if (SvUOK(sv)) \ - hk = INT2PTR(BHK *, SvUVX(sv)); \ - else \ - hk = INT2PTR(BHK *, SvIVX(sv)); \ - \ - if (BhkENTRY(hk, which)) \ - BhkENTRY(hk, which)(aTHX_ arg); \ - } \ - } \ + if (PL_blockhooks) { \ + SSize_t i; \ + for (i = av_top_index(PL_blockhooks); i >= 0; i--) { \ + SV *sv = AvARRAY(PL_blockhooks)[i]; \ + BHK *hk; \ + \ + assert(SvIOK(sv)); \ + if (SvUOK(sv)) \ + hk = INT2PTR(BHK *, SvUVX(sv)); \ + else \ + hk = INT2PTR(BHK *, SvIVX(sv)); \ + \ + if (BhkENTRY(hk, which)) \ + BhkENTRY(hk, which)(aTHX_ arg); \ + } \ + } \ } STMT_END /* flags for rv2cv_op_cv */ @@ -924,8 +924,8 @@ typedef enum { #define XopENTRY_set(xop, which, to) \ STMT_START { \ - (xop)->which = (to); \ - (xop)->xop_flags |= XOPf_ ## which; \ + (xop)->which = (to); \ + (xop)->xop_flags |= XOPf_ ## which; \ } STMT_END #define XopENTRY(xop, which) \ @@ -937,8 +937,8 @@ typedef enum { #define XopDISABLE(xop, which) ((xop)->xop_flags &= ~XOPf_ ## which) #define XopENABLE(xop, which) \ STMT_START { \ - (xop)->xop_flags |= XOPf_ ## which; \ - assert(XopENTRY(xop, which)); \ + (xop)->xop_flags |= XOPf_ ## which; \ + assert(XopENTRY(xop, which)); \ } STMT_END #define Perl_custom_op_xop(x) \ @@ -1009,13 +1009,13 @@ C is non-null. For a higher-level interface, see C>. #define OP_NAME(o) ((o)->op_type == OP_CUSTOM \ ? XopENTRYCUSTOM(o, xop_name) \ - : PL_op_name[(o)->op_type]) + : PL_op_name[(o)->op_type]) #define OP_DESC(o) ((o)->op_type == OP_CUSTOM \ ? XopENTRYCUSTOM(o, xop_desc) \ - : PL_op_desc[(o)->op_type]) + : PL_op_desc[(o)->op_type]) #define OP_CLASS(o) ((o)->op_type == OP_CUSTOM \ - ? XopENTRYCUSTOM(o, xop_class) \ - : (PL_opargs[(o)->op_type] & OA_CLASS_MASK)) + ? XopENTRYCUSTOM(o, xop_class) \ + : (PL_opargs[(o)->op_type] & OA_CLASS_MASK)) #define OP_TYPE_IS(o, type) ((o) && (o)->op_type == (type)) #define OP_TYPE_IS_NN(o, type) ((o)->op_type == (type)) diff --git a/os2/dl_os2.c b/os2/dl_os2.c index f15c465f621d..ccf2e1a84cbb 100644 --- a/os2/dl_os2.c +++ b/os2/dl_os2.c @@ -31,11 +31,11 @@ unsigned long _DLL_InitTerm(unsigned long modHandle, unsigned long flag) case 0: /* INIT */ /* Save handle */ dllHandle = modHandle; - handle_found = 1; + handle_found = 1; return TRUE; case 1: /* TERM */ - handle_found = 0; + handle_found = 0; dllHandle = (unsigned long)NULLHANDLE; return TRUE; } @@ -50,25 +50,25 @@ find_myself(void) { static APIRET APIENTRY (*pDosQueryModFromEIP) (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf, - ULONG * Offset, ULONG Address); + ULONG * Offset, ULONG Address); HMODULE doscalls_h, mod; static int failed; ULONG obj, offset, rc; char buf[260]; if (failed) - return 0; + return 0; failed = 1; doscalls_h = (HMODULE)dlopen("DOSCALLS",0); if (!doscalls_h) - return 0; + return 0; /* {&doscalls_handle, NULL, 360}, */ /* DosQueryModFromEIP */ rc = DosQueryProcAddr(doscalls_h, 360, 0, (PFN*)&pDosQueryModFromEIP); if (rc) - return 0; + return 0; rc = pDosQueryModFromEIP(&mod, &obj, sizeof(buf), buf, &offset, (ULONG)dlopen); if (rc) - return 0; + return 0; failed = 0; handle_found = 1; dllHandle = mod; @@ -78,66 +78,66 @@ find_myself(void) void * dlopen(const char *path, int mode) { - HMODULE handle; - char tmp[260]; - const char *beg, *dot; - ULONG rc; - unsigned fpflag = _control87(0,0); - - fail[0] = 0; - if (!path) { /* Our own handle. */ - if (handle_found || find_myself()) { - char dllname[260]; - - if (handle_loaded) - return (void*)dllHandle; - rc = DosQueryModuleName(dllHandle, sizeof(dllname), dllname); - if (rc) { - strcpy(fail, "can't find my DLL name by the handle"); - retcode = rc; - return 0; - } - rc = DosLoadModule(fail, sizeof fail, dllname, &handle); - if (rc) { - strcpy(fail, "can't load my own DLL"); - retcode = rc; - return 0; - } - handle_loaded = 1; - goto ret; - } - retcode = ERROR_MOD_NOT_FOUND; + HMODULE handle; + char tmp[260]; + const char *beg, *dot; + ULONG rc; + unsigned fpflag = _control87(0,0); + + fail[0] = 0; + if (!path) { /* Our own handle. */ + if (handle_found || find_myself()) { + char dllname[260]; + + if (handle_loaded) + return (void*)dllHandle; + rc = DosQueryModuleName(dllHandle, sizeof(dllname), dllname); + if (rc) { + strcpy(fail, "can't find my DLL name by the handle"); + retcode = rc; + return 0; + } + rc = DosLoadModule(fail, sizeof fail, dllname, &handle); + if (rc) { + strcpy(fail, "can't load my own DLL"); + retcode = rc; + return 0; + } + handle_loaded = 1; + goto ret; + } + retcode = ERROR_MOD_NOT_FOUND; strcpy(fail, "can't load from myself: compiled without -DDLOPEN_INITTERM"); - return 0; - } - if ((rc = DosLoadModule(fail, sizeof fail, (char*)path, &handle)) == 0) - goto ret; - - retcode = rc; - - if (strlen(path) >= sizeof(tmp)) - return NULL; - - /* Not found. Check for non-FAT name and try truncated name. */ - /* Don't know if this helps though... */ - for (beg = dot = path + strlen(path); - beg > path && !memCHRs(":/\\", *(beg-1)); - beg--) - if (*beg == '.') - dot = beg; - if (dot - beg > 8) { - int n = beg+8-path; - - memmove(tmp, path, n); - memmove(tmp+n, dot, strlen(dot)+1); - if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0) - goto ret; - } - handle = 0; + return 0; + } + if ((rc = DosLoadModule(fail, sizeof fail, (char*)path, &handle)) == 0) + goto ret; + + retcode = rc; + + if (strlen(path) >= sizeof(tmp)) + return NULL; + + /* Not found. Check for non-FAT name and try truncated name. */ + /* Don't know if this helps though... */ + for (beg = dot = path + strlen(path); + beg > path && !memCHRs(":/\\", *(beg-1)); + beg--) + if (*beg == '.') + dot = beg; + if (dot - beg > 8) { + int n = beg+8-path; + + memmove(tmp, path, n); + memmove(tmp+n, dot, strlen(dot)+1); + if (DosLoadModule(fail, sizeof fail, tmp, &handle) == 0) + goto ret; + } + handle = 0; ret: - _control87(fpflag, MCW_EM); /* Some modules reset FP flags on load */ - return (void *)handle; + _control87(fpflag, MCW_EM); /* Some modules reset FP flags on load */ + return (void *)handle; } #define ERROR_WRONG_PROCTYPE 0xffffffff @@ -145,51 +145,51 @@ dlopen(const char *path, int mode) void * dlsym(void *handle, const char *symbol) { - ULONG rc, type; - PFN addr; - - fail[0] = 0; - rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); - if (rc == 0) { - rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); - if (rc == 0 && type == PT_32BIT) - return (void *)addr; - rc = ERROR_WRONG_PROCTYPE; - } - retcode = rc; - return NULL; + ULONG rc, type; + PFN addr; + + fail[0] = 0; + rc = DosQueryProcAddr((HMODULE)handle, 0, symbol, &addr); + if (rc == 0) { + rc = DosQueryProcType((HMODULE)handle, 0, symbol, &type); + if (rc == 0 && type == PT_32BIT) + return (void *)addr; + rc = ERROR_WRONG_PROCTYPE; + } + retcode = rc; + return NULL; } char * dlerror(void) { - static char buf[700]; - ULONG len; - char *err; - - if (retcode == 0) - return NULL; - if (retcode == ERROR_WRONG_PROCTYPE) - err = "Wrong procedure type"; - else - err = os2error(retcode); - len = strlen(err); - if (len > sizeof(buf) - 1) - len = sizeof(buf) - 1; - strncpy(buf, err, len+1); - if (fail[0] && len + strlen(fail) < sizeof(buf) - 100) - sprintf(buf + len, ", possible problematic module: '%s'", fail); - retcode = 0; - return buf; + static char buf[700]; + ULONG len; + char *err; + + if (retcode == 0) + return NULL; + if (retcode == ERROR_WRONG_PROCTYPE) + err = "Wrong procedure type"; + else + err = os2error(retcode); + len = strlen(err); + if (len > sizeof(buf) - 1) + len = sizeof(buf) - 1; + strncpy(buf, err, len+1); + if (fail[0] && len + strlen(fail) < sizeof(buf) - 100) + sprintf(buf + len, ", possible problematic module: '%s'", fail); + retcode = 0; + return buf; } int dlclose(void *handle) { - ULONG rc; + ULONG rc; - if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0; + if ((rc = DosFreeModule((HMODULE)handle)) == 0) return 0; - retcode = rc; - return 2; + retcode = rc; + return 2; } diff --git a/os2/os2.c b/os2/os2.c index 3e2bd1b31bb1..ebe58b058b6d 100644 --- a/os2/os2.c +++ b/os2/os2.c @@ -246,7 +246,7 @@ pthreads_state_string(enum pthreads_state state) { if (state < 0 || state >= sizeof(pthreads_states)/sizeof(*pthreads_states)) { snprintf(pthreads_state_buf, sizeof(pthreads_state_buf), - "unknown thread state %d", (int)state); + "unknown thread state %d", (int)state); return pthreads_state_buf; } return pthreads_states[state]; @@ -269,53 +269,53 @@ pthread_join(perl_os_thread tid, void **status) { MUTEX_LOCK(&start_thread_mutex); if (tid < 1 || tid >= thread_join_count) { - MUTEX_UNLOCK(&start_thread_mutex); - if (tid != pthread_not_existant) - Perl_croak_nocontext("panic: join with a thread with strange ordinal %d", (int)tid); - Perl_warn_nocontext("panic: join with a thread which could not start"); - *status = 0; - return 0; + MUTEX_UNLOCK(&start_thread_mutex); + if (tid != pthread_not_existant) + Perl_croak_nocontext("panic: join with a thread with strange ordinal %d", (int)tid); + Perl_warn_nocontext("panic: join with a thread which could not start"); + *status = 0; + return 0; } switch (thread_join_data[tid].state) { case pthreads_st_exited: - thread_join_data[tid].state = pthreads_st_exited_waited; - *status = thread_join_data[tid].status; - MUTEX_UNLOCK(&start_thread_mutex); - COND_SIGNAL(&thread_join_data[tid].cond); - break; + thread_join_data[tid].state = pthreads_st_exited_waited; + *status = thread_join_data[tid].status; + MUTEX_UNLOCK(&start_thread_mutex); + COND_SIGNAL(&thread_join_data[tid].cond); + break; case pthreads_st_waited: - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("join with a thread with a waiter"); - break; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("join with a thread with a waiter"); + break; case pthreads_st_norun: { - int state = (int)thread_join_data[tid].status; - - thread_join_data[tid].state = pthreads_st_none; - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: join with a thread which could not run" - " due to attempt of tid reuse (state='%s')", - pthreads_state_string(state)); - break; + int state = (int)thread_join_data[tid].status; + + thread_join_data[tid].state = pthreads_st_none; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("panic: join with a thread which could not run" + " due to attempt of tid reuse (state='%s')", + pthreads_state_string(state)); + break; } case pthreads_st_run: { - perl_cond cond; - - thread_join_data[tid].state = pthreads_st_waited; - thread_join_data[tid].status = (void *)status; - COND_INIT(&thread_join_data[tid].cond); - cond = thread_join_data[tid].cond; - COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex); - COND_DESTROY(&cond); - MUTEX_UNLOCK(&start_thread_mutex); - break; + perl_cond cond; + + thread_join_data[tid].state = pthreads_st_waited; + thread_join_data[tid].status = (void *)status; + COND_INIT(&thread_join_data[tid].cond); + cond = thread_join_data[tid].cond; + COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex); + COND_DESTROY(&cond); + MUTEX_UNLOCK(&start_thread_mutex); + break; } default: - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: join with thread in unknown thread state: '%s'", - pthreads_state_string(thread_join_data[tid].state)); - break; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("panic: join with thread in unknown thread state: '%s'", + pthreads_state_string(thread_join_data[tid].state)); + break; } return 0; } @@ -327,9 +327,9 @@ typedef struct { } pthr_startit; /* The lock is used: - a) Since we temporarily usurp the caller interp, so malloc() may - use it to decide on debugging the call; - b) Since *args is on the caller's stack. + a) Since we temporarily usurp the caller interp, so malloc() may + use it to decide on debugging the call; + b) Since *args is on the caller's stack. */ void pthread_startit(void *arg1) @@ -341,40 +341,40 @@ pthread_startit(void *arg1) int state; if (tid <= 1) { - /* Can't croak, the setjmp() is not in scope... */ - char buf[80]; - - snprintf(buf, sizeof(buf), - "panic: thread with strange ordinal %d created\n\r", tid); - write(2,buf,strlen(buf)); - MUTEX_UNLOCK(&start_thread_mutex); - return; + /* Can't croak, the setjmp() is not in scope... */ + char buf[80]; + + snprintf(buf, sizeof(buf), + "panic: thread with strange ordinal %d created\n\r", tid); + write(2,buf,strlen(buf)); + MUTEX_UNLOCK(&start_thread_mutex); + return; } /* Until args.sub resets it, makes debugging Perl_malloc() work: */ PERL_SET_CONTEXT(0); if (tid >= thread_join_count) { - int oc = thread_join_count; - - thread_join_count = tid + 5 + tid/5; - if (thread_join_data) { - Renew(thread_join_data, thread_join_count, thread_join_t); - Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t); - } else { - Newxz(thread_join_data, thread_join_count, thread_join_t); - } + int oc = thread_join_count; + + thread_join_count = tid + 5 + tid/5; + if (thread_join_data) { + Renew(thread_join_data, thread_join_count, thread_join_t); + Zero(thread_join_data + oc, thread_join_count - oc, thread_join_t); + } else { + Newxz(thread_join_data, thread_join_count, thread_join_t); + } } if (thread_join_data[tid].state != pthreads_st_none) { - /* Can't croak, the setjmp() is not in scope... */ - char buf[80]; - - snprintf(buf, sizeof(buf), - "panic: attempt to reuse thread id %d (state='%s')\n\r", - tid, pthreads_state_string(thread_join_data[tid].state)); - write(2,buf,strlen(buf)); - thread_join_data[tid].status = (void*)thread_join_data[tid].state; - thread_join_data[tid].state = pthreads_st_norun; - MUTEX_UNLOCK(&start_thread_mutex); - return; + /* Can't croak, the setjmp() is not in scope... */ + char buf[80]; + + snprintf(buf, sizeof(buf), + "panic: attempt to reuse thread id %d (state='%s')\n\r", + tid, pthreads_state_string(thread_join_data[tid].state)); + write(2,buf,strlen(buf)); + thread_join_data[tid].status = (void*)thread_join_data[tid].state; + thread_join_data[tid].state = pthreads_st_norun; + MUTEX_UNLOCK(&start_thread_mutex); + return; } thread_join_data[tid].state = pthreads_st_run; /* Now that we copied/updated the guys, we may release the caller... */ @@ -383,35 +383,35 @@ pthread_startit(void *arg1) MUTEX_LOCK(&start_thread_mutex); switch (thread_join_data[tid].state) { case pthreads_st_waited: - COND_SIGNAL(&thread_join_data[tid].cond); - thread_join_data[tid].state = pthreads_st_none; - *((void**)thread_join_data[tid].status) = rc; - break; + COND_SIGNAL(&thread_join_data[tid].cond); + thread_join_data[tid].state = pthreads_st_none; + *((void**)thread_join_data[tid].status) = rc; + break; case pthreads_st_detached: - thread_join_data[tid].state = pthreads_st_none; - break; + thread_join_data[tid].state = pthreads_st_none; + break; case pthreads_st_run: - /* Somebody can wait on us; cannot exit, since OS can reuse the tid - and our waiter will get somebody else's status. */ - thread_join_data[tid].state = pthreads_st_exited; - thread_join_data[tid].status = rc; - COND_INIT(&thread_join_data[tid].cond); - COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex); - COND_DESTROY(&thread_join_data[tid].cond); - thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */ - break; + /* Somebody can wait on us; cannot exit, since OS can reuse the tid + and our waiter will get somebody else's status. */ + thread_join_data[tid].state = pthreads_st_exited; + thread_join_data[tid].status = rc; + COND_INIT(&thread_join_data[tid].cond); + COND_WAIT(&thread_join_data[tid].cond, &start_thread_mutex); + COND_DESTROY(&thread_join_data[tid].cond); + thread_join_data[tid].state = pthreads_st_none; /* Ready to reuse */ + break; default: - state = thread_join_data[tid].state; - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: unexpected thread state on exit: '%s'", - pthreads_state_string(state)); + state = thread_join_data[tid].state; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("panic: unexpected thread state on exit: '%s'", + pthreads_state_string(state)); } MUTEX_UNLOCK(&start_thread_mutex); } int pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, - void *(*start_routine)(void*), void *arg) + void *(*start_routine)(void*), void *arg) { dTHX; pthr_startit args; @@ -424,11 +424,11 @@ pthread_create(perl_os_thread *tidp, const pthread_attr_t *attr, /* Test suite creates 31 extra threads; on machine without shared-memory-hogs this stack sizeis OK with 31: */ *tidp = _beginthread(pthread_startit, /*stack*/ NULL, - /*stacksize*/ 4*1024*1024, (void*)&args); + /*stacksize*/ 4*1024*1024, (void*)&args); if (*tidp == -1) { - *tidp = pthread_not_existant; - MUTEX_UNLOCK(&start_thread_mutex); - return EINVAL; + *tidp = pthread_not_existant; + MUTEX_UNLOCK(&start_thread_mutex); + return EINVAL; } MUTEX_LOCK(&start_thread_mutex); /* Wait for init to proceed */ MUTEX_UNLOCK(&start_thread_mutex); @@ -440,45 +440,45 @@ pthread_detach(perl_os_thread tid) { MUTEX_LOCK(&start_thread_mutex); if (tid < 1 || tid >= thread_join_count) { - MUTEX_UNLOCK(&start_thread_mutex); - if (tid != pthread_not_existant) - Perl_croak_nocontext("panic: detach of a thread with strange ordinal %d", (int)tid); - Perl_warn_nocontext("detach of a thread which could not start"); - return 0; + MUTEX_UNLOCK(&start_thread_mutex); + if (tid != pthread_not_existant) + Perl_croak_nocontext("panic: detach of a thread with strange ordinal %d", (int)tid); + Perl_warn_nocontext("detach of a thread which could not start"); + return 0; } switch (thread_join_data[tid].state) { case pthreads_st_waited: - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("detach on a thread with a waiter"); - break; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("detach on a thread with a waiter"); + break; case pthreads_st_run: - thread_join_data[tid].state = pthreads_st_detached; - MUTEX_UNLOCK(&start_thread_mutex); - break; + thread_join_data[tid].state = pthreads_st_detached; + MUTEX_UNLOCK(&start_thread_mutex); + break; case pthreads_st_exited: - MUTEX_UNLOCK(&start_thread_mutex); - COND_SIGNAL(&thread_join_data[tid].cond); - break; + MUTEX_UNLOCK(&start_thread_mutex); + COND_SIGNAL(&thread_join_data[tid].cond); + break; case pthreads_st_detached: - MUTEX_UNLOCK(&start_thread_mutex); - Perl_warn_nocontext("detach on an already detached thread"); - break; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_warn_nocontext("detach on an already detached thread"); + break; case pthreads_st_norun: { - int state = (int)thread_join_data[tid].status; - - thread_join_data[tid].state = pthreads_st_none; - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: detaching thread which could not run" - " due to attempt of tid reuse (state='%s')", - pthreads_state_string(state)); - break; + int state = (int)thread_join_data[tid].status; + + thread_join_data[tid].state = pthreads_st_none; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("panic: detaching thread which could not run" + " due to attempt of tid reuse (state='%s')", + pthreads_state_string(state)); + break; } default: - MUTEX_UNLOCK(&start_thread_mutex); - Perl_croak_nocontext("panic: detach of a thread with unknown thread state: '%s'", - pthreads_state_string(thread_join_data[tid].state)); - break; + MUTEX_UNLOCK(&start_thread_mutex); + Perl_croak_nocontext("panic: detach of a thread with unknown thread state: '%s'", + pthreads_state_string(thread_join_data[tid].state)); + break; } return 0; } @@ -490,13 +490,13 @@ os2_cond_wait(perl_cond *c, perl_mutex *m) int rc; STRLEN n_a; if ((rc = DosResetEventSem(*c,&n_a)) && (rc != ERROR_ALREADY_RESET)) - Perl_rc = CheckOSError(rc), croak_with_os2error("panic: COND_WAIT-reset"); + Perl_rc = CheckOSError(rc), croak_with_os2error("panic: COND_WAIT-reset"); if (m) MUTEX_UNLOCK(m); if (CheckOSError(DosWaitEventSem(*c,SEM_INDEFINITE_WAIT)) - && (rc != ERROR_INTERRUPT)) - croak_with_os2error("panic: COND_WAIT"); + && (rc != ERROR_INTERRUPT)) + croak_with_os2error("panic: COND_WAIT"); if (rc == ERROR_INTERRUPT) - errno = EINTR; + errno = EINTR; if (m) MUTEX_LOCK(m); return 0; } @@ -533,8 +533,8 @@ static const struct { {&pmwin_handle, NULL, 912}, /* WinDispatchMsg */ {&pmwin_handle, NULL, 753}, /* WinGetLastError */ {&pmwin_handle, NULL, 705}, /* WinCancelShutdown */ - /* These are needed in extensions. - How to protect PMSHAPI: it comes through EMX functions? */ + /* These are needed in extensions. + How to protect PMSHAPI: it comes through EMX functions? */ {&rexx_handle, "RexxStart", 0}, {&rexx_handle, "RexxVariablePool", 0}, {&rexxapi_handle, "RexxRegisterFunctionExe", 0}, @@ -549,7 +549,7 @@ static const struct { {&pmshapi_handle, "PRF32WRITEPROFILEDATA", 0}, /* At least some of these do not work by name, since they need - WIN32 instead of WIN... */ + WIN32 instead of WIN... */ #if 0 These were generated with nm I:\emx\lib\os2.a | fgrep -f API-list | grep = > API-list-entries @@ -646,8 +646,8 @@ loadModule(const char *modname, int fail) HMODULE h = (HMODULE)dlopen(modname, 0); if (!h && fail) - Perl_croak_nocontext("Error loading module '%s': %s", - modname, dlerror()); + Perl_croak_nocontext("Error loading module '%s': %s", + modname, dlerror()); return h; } @@ -662,7 +662,7 @@ my_type() if (!(_emx_env & 0x200)) return 1; /* not OS/2. */ if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) - return -1; + return -1; return (pib->pib_ultype); } @@ -675,9 +675,9 @@ my_type_set(int type) PIB *pib; if (!(_emx_env & 0x200)) - Perl_croak_nocontext("Can't set type on DOS"); /* not OS/2. */ + Perl_croak_nocontext("Can't set type on DOS"); /* not OS/2. */ if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) - croak_with_os2error("Error getting info blocks"); + croak_with_os2error("Error getting info blocks"); pib->pib_ultype = type; } @@ -685,54 +685,54 @@ PFN loadByOrdinal(enum entries_ordinals ord, int fail) { if (sizeof(loadOrdinals)/sizeof(loadOrdinals[0]) != ORD_NENTRIES) - Perl_croak_nocontext( - "Wrong size of loadOrdinals array: expected %d, actual %d", - sizeof(loadOrdinals)/sizeof(loadOrdinals[0]), ORD_NENTRIES); + Perl_croak_nocontext( + "Wrong size of loadOrdinals array: expected %d, actual %d", + sizeof(loadOrdinals)/sizeof(loadOrdinals[0]), ORD_NENTRIES); if (ExtFCN[ord] == NULL) { - PFN fcn = (PFN)-1; - APIRET rc; - - if (!loadOrdinals[ord].dll->handle) { - if (loadOrdinals[ord].dll->requires_pm && my_type() < 2) { /* FS */ - char *s = PerlEnv_getenv("PERL_ASIF_PM"); - - if (!s || !atoi(s)) { - /* The module will not function well without PM. - The usual way to detect PM is the existence of the mutex - \SEM32\PMDRAG.SEM. */ - HMTX hMtx = 0; - - if (CheckOSError(DosOpenMutexSem("\\SEM32\\PMDRAG.SEM", - &hMtx))) - Perl_croak_nocontext("Looks like we have no PM; will not load DLL %s without $ENV{PERL_ASIF_PM}", - loadOrdinals[ord].dll->modname); - DosCloseMutexSem(hMtx); - } - } - MUTEX_LOCK(&perlos2_state_mutex); - loadOrdinals[ord].dll->handle - = loadModule(loadOrdinals[ord].dll->modname, fail); - MUTEX_UNLOCK(&perlos2_state_mutex); - } - if (!loadOrdinals[ord].dll->handle) - return 0; /* Possible with FAIL==0 only */ - if (CheckOSError(DosQueryProcAddr(loadOrdinals[ord].dll->handle, - loadOrdinals[ord].entrypoint, - loadOrdinals[ord].entryname,&fcn))) { - char buf[20], *s = (char*)loadOrdinals[ord].entryname; - - if (!fail) - return 0; - if (!s) - sprintf(s = buf, "%d", loadOrdinals[ord].entrypoint); - Perl_croak_nocontext( - "This version of OS/2 does not support %s.%s", - loadOrdinals[ord].dll->modname, s); - } - ExtFCN[ord] = fcn; + PFN fcn = (PFN)-1; + APIRET rc; + + if (!loadOrdinals[ord].dll->handle) { + if (loadOrdinals[ord].dll->requires_pm && my_type() < 2) { /* FS */ + char *s = PerlEnv_getenv("PERL_ASIF_PM"); + + if (!s || !atoi(s)) { + /* The module will not function well without PM. + The usual way to detect PM is the existence of the mutex + \SEM32\PMDRAG.SEM. */ + HMTX hMtx = 0; + + if (CheckOSError(DosOpenMutexSem("\\SEM32\\PMDRAG.SEM", + &hMtx))) + Perl_croak_nocontext("Looks like we have no PM; will not load DLL %s without $ENV{PERL_ASIF_PM}", + loadOrdinals[ord].dll->modname); + DosCloseMutexSem(hMtx); + } + } + MUTEX_LOCK(&perlos2_state_mutex); + loadOrdinals[ord].dll->handle + = loadModule(loadOrdinals[ord].dll->modname, fail); + MUTEX_UNLOCK(&perlos2_state_mutex); + } + if (!loadOrdinals[ord].dll->handle) + return 0; /* Possible with FAIL==0 only */ + if (CheckOSError(DosQueryProcAddr(loadOrdinals[ord].dll->handle, + loadOrdinals[ord].entrypoint, + loadOrdinals[ord].entryname,&fcn))) { + char buf[20], *s = (char*)loadOrdinals[ord].entryname; + + if (!fail) + return 0; + if (!s) + sprintf(s = buf, "%d", loadOrdinals[ord].entrypoint); + Perl_croak_nocontext( + "This version of OS/2 does not support %s.%s", + loadOrdinals[ord].dll->modname, s); + } + ExtFCN[ord] = fcn; } if ((long)ExtFCN[ord] == -1) - Perl_croak_nocontext("panic queryaddr"); + Perl_croak_nocontext("panic queryaddr"); return ExtFCN[ord]; } @@ -742,7 +742,7 @@ init_PMWIN_entries(void) int i; for (i = ORD_WinInitialize; i <= ORD_WinCancelShutdown; i++) - ((PFN*)&PMWIN_entries)[i - ORD_WinInitialize] = loadByOrdinal(i, 1); + ((PFN*)&PMWIN_entries)[i - ORD_WinInitialize] = loadByOrdinal(i, 1); } /*****************************************************/ @@ -765,7 +765,7 @@ DeclVoidFuncByORD(endservent, ORD_ENDSERVENT, (void), ()) /* priorities */ static const signed char priors[] = {0, 1, 3, 2}; /* Last two interchanged, - self inverse. */ + self inverse. */ #define QSS_INI_BUFFER 1024 ULONG (*pDosVerifyPidTid) (PID pid, TID tid); @@ -778,28 +778,28 @@ get_sysinfo(ULONG pid, ULONG flags) PQTOPLEVEL psi; if (pid) { - if (!pidtid_lookup) { - pidtid_lookup = 1; - *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0); - } - if (pDosVerifyPidTid) { /* Warp3 or later */ - /* Up to some fixpak QuerySysState() kills the system if a non-existent - pid is used. */ - if (CheckOSError(pDosVerifyPidTid(pid, 1))) - return 0; + if (!pidtid_lookup) { + pidtid_lookup = 1; + *(PFN*)&pDosVerifyPidTid = loadByOrdinal(ORD_DosVerifyPidTid, 0); + } + if (pDosVerifyPidTid) { /* Warp3 or later */ + /* Up to some fixpak QuerySysState() kills the system if a non-existent + pid is used. */ + if (CheckOSError(pDosVerifyPidTid(pid, 1))) + return 0; } } Newx(pbuffer, buf_len, char); /* QSS_PROCESS | QSS_MODULE | QSS_SEMAPHORES | QSS_SHARED */ rc = QuerySysState(flags, pid, pbuffer, buf_len); while (rc == ERROR_BUFFER_OVERFLOW) { - Renew(pbuffer, buf_len *= 2, char); - rc = QuerySysState(flags, pid, pbuffer, buf_len); + Renew(pbuffer, buf_len *= 2, char); + rc = QuerySysState(flags, pid, pbuffer, buf_len); } if (rc) { - FillOSError(rc); - Safefree(pbuffer); - return 0; + FillOSError(rc); + Safefree(pbuffer); + return 0; } psi = (PQTOPLEVEL)pbuffer; if (psi && pid && psi->procdata && pid != psi->procdata->pid) { @@ -836,28 +836,28 @@ setpriority(int which, int pid, int val) if (priors[(32 - val) >> 5] + 1 == (prio >> 8)) { /* Do not change class. */ return CheckOSError(DosSetPriority((pid < 0) - ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - 0, - (32 - val) % 32 - (prio & 0xFF), - abs(pid))) + ? PRTYS_PROCESSTREE : PRTYS_PROCESS, + 0, + (32 - val) % 32 - (prio & 0xFF), + abs(pid))) ? -1 : 0; } else /* if ((32 - val) % 32 == (prio & 0xFF)) */ { /* Documentation claims one can change both class and basevalue, * but I find it wrong. */ /* Change class, but since delta == 0 denotes absolute 0, correct. */ if (CheckOSError(DosSetPriority((pid < 0) - ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - priors[(32 - val) >> 5] + 1, - 0, - abs(pid)))) - return -1; + ? PRTYS_PROCESSTREE : PRTYS_PROCESS, + priors[(32 - val) >> 5] + 1, + 0, + abs(pid)))) + return -1; if ( ((32 - val) % 32) == 0 ) return 0; return CheckOSError(DosSetPriority((pid < 0) - ? PRTYS_PROCESSTREE : PRTYS_PROCESS, - 0, - (32 - val) % 32, - abs(pid))) - ? -1 : 0; + ? PRTYS_PROCESSTREE : PRTYS_PROCESS, + 0, + (32 - val) % 32, + abs(pid))) + ? -1 : 0; } } @@ -891,7 +891,7 @@ spawn_sighandler(int sig) */ if (spawn_killed) - sig = SIGKILL; /* Try harder. */ + sig = SIGKILL; /* Try harder. */ kill(spawn_pid, sig); spawn_killed = 1; } @@ -899,40 +899,40 @@ spawn_sighandler(int sig) static int result(pTHX_ int flag, int pid) { - int r, status; - Signal_t (*ihand)(); /* place to save signal during system() */ - Signal_t (*qhand)(); /* place to save signal during system() */ + int r, status; + Signal_t (*ihand)(); /* place to save signal during system() */ + Signal_t (*qhand)(); /* place to save signal during system() */ #ifndef __EMX__ - RESULTCODES res; - int rpid; + RESULTCODES res; + int rpid; #endif - if (pid < 0 || flag != 0) - return pid; + if (pid < 0 || flag != 0) + return pid; #ifdef __EMX__ - spawn_pid = pid; - spawn_killed = 0; - ihand = rsignal(SIGINT, &spawn_sighandler); - qhand = rsignal(SIGQUIT, &spawn_sighandler); - do { - r = wait4pid(pid, &status, 0); - } while (r == -1 && errno == EINTR); - rsignal(SIGINT, ihand); - rsignal(SIGQUIT, qhand); - - PL_statusvalue = (U16)status; - if (r < 0) - return -1; - return status & 0xFFFF; + spawn_pid = pid; + spawn_killed = 0; + ihand = rsignal(SIGINT, &spawn_sighandler); + qhand = rsignal(SIGQUIT, &spawn_sighandler); + do { + r = wait4pid(pid, &status, 0); + } while (r == -1 && errno == EINTR); + rsignal(SIGINT, ihand); + rsignal(SIGQUIT, qhand); + + PL_statusvalue = (U16)status; + if (r < 0) + return -1; + return status & 0xFFFF; #else - ihand = rsignal(SIGINT, SIG_IGN); - r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid); - rsignal(SIGINT, ihand); - PL_statusvalue = res.codeResult << 8 | res.codeTerminate; - if (r) - return -1; - return PL_statusvalue; + ihand = rsignal(SIGINT, SIG_IGN); + r = DosWaitChild(DCWA_PROCESS, DCWW_WAIT, &res, &rpid, pid); + rsignal(SIGINT, ihand); + PL_statusvalue = res.codeResult << 8 | res.codeTerminate; + if (r) + return -1; + return PL_statusvalue; #endif } @@ -952,19 +952,19 @@ file_type(char *path) ULONG apptype; if (!(_emx_env & 0x200)) - Perl_croak_nocontext("file_type not implemented on DOS"); /* not OS/2. */ + Perl_croak_nocontext("file_type not implemented on DOS"); /* not OS/2. */ if (CheckOSError(DosQueryAppType(path, &apptype))) { - switch (rc) { - case ERROR_FILE_NOT_FOUND: - case ERROR_PATH_NOT_FOUND: - return -1; - case ERROR_ACCESS_DENIED: /* Directory with this name found? */ - return -3; - default: /* Found, but not an - executable, or some other - read error. */ - return -2; - } + switch (rc) { + case ERROR_FILE_NOT_FOUND: + case ERROR_PATH_NOT_FOUND: + return -1; + case ERROR_ACCESS_DENIED: /* Directory with this name found? */ + return -3; + default: /* Found, but not an + executable, or some other + read error. */ + return -2; + } } return apptype; } @@ -972,374 +972,374 @@ file_type(char *path) /* Spawn/exec a program, revert to shell if needed. */ extern ULONG _emx_exception ( EXCEPTIONREPORTRECORD *, - EXCEPTIONREGISTRATIONRECORD *, + EXCEPTIONREGISTRATIONRECORD *, CONTEXTRECORD *, void *); int do_spawn_ve(pTHX_ SV *really, const char **argv, U32 flag, U32 execf, char *inicmd, U32 addflag) { - int trueflag = flag; - int rc, pass = 1; - char *real_name = NULL; /* Shut down the warning */ - char const * args[4]; - static const char * const fargs[4] - = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; - const char * const *argsp = fargs; - int nargs = 4; - int force_shell; - int new_stderr = -1, nostderr = 0; - int fl_stderr = 0; - STRLEN n_a; - char *buf; - PerlIO *file; - - if (flag == P_WAIT) - flag = P_NOWAIT; - if (really) { - real_name = SvPV(really, n_a); - real_name = savepv(real_name); - SAVEFREEPV(real_name); - if (!*real_name) - really = NULL; - } + int trueflag = flag; + int rc, pass = 1; + char *real_name = NULL; /* Shut down the warning */ + char const * args[4]; + static const char * const fargs[4] + = { "/bin/sh", "-c", "\"$@\"", "spawn-via-shell", }; + const char * const *argsp = fargs; + int nargs = 4; + int force_shell; + int new_stderr = -1, nostderr = 0; + int fl_stderr = 0; + STRLEN n_a; + char *buf; + PerlIO *file; + + if (flag == P_WAIT) + flag = P_NOWAIT; + if (really) { + real_name = SvPV(really, n_a); + real_name = savepv(real_name); + SAVEFREEPV(real_name); + if (!*real_name) + really = NULL; + } retry: - if (strEQ(argv[0],"/bin/sh")) - argv[0] = PL_sh_path; - - /* We should check PERL_SH* and PERLLIB_* as well? */ - if (!really || pass >= 2) - real_name = argv[0]; - if (real_name[0] != '/' && real_name[0] != '\\' - && !(real_name[0] && real_name[1] == ':' - && (real_name[2] == '/' || real_name[2] != '\\')) - ) /* will spawnvp use PATH? */ - TAINT_ENV(); /* testing IFS here is overkill, probably */ + if (strEQ(argv[0],"/bin/sh")) + argv[0] = PL_sh_path; + + /* We should check PERL_SH* and PERLLIB_* as well? */ + if (!really || pass >= 2) + real_name = argv[0]; + if (real_name[0] != '/' && real_name[0] != '\\' + && !(real_name[0] && real_name[1] == ':' + && (real_name[2] == '/' || real_name[2] != '\\')) + ) /* will spawnvp use PATH? */ + TAINT_ENV(); /* testing IFS here is overkill, probably */ reread: - force_shell = 0; - if (_emx_env & 0x200) { /* OS/2. */ - int type = file_type(real_name); - type_again: - if (type == -1) { /* Not found */ - errno = ENOENT; - rc = -1; - goto do_script; - } - else if (type == -2) { /* Not an EXE */ - errno = ENOEXEC; - rc = -1; - goto do_script; - } - else if (type == -3) { /* Is a directory? */ - /* Special-case this */ - char tbuf[512]; - int l = strlen(real_name); - - if (l + 5 <= sizeof tbuf) { - strcpy(tbuf, real_name); - strcpy(tbuf + l, ".exe"); - type = file_type(tbuf); - if (type >= -3) - goto type_again; - } - - errno = ENOEXEC; - rc = -1; - goto do_script; - } - switch (type & 7) { - /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */ - case FAPPTYP_WINDOWAPI: - { /* Apparently, kids are started basing on startup type, not the morphed type */ - if (os2_mytype != 3) { /* not PM */ - if (flag == P_NOWAIT) - flag = P_PM; - else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting PM process with flag=%d, mytype=%d", - flag, os2_mytype); - } - } - break; - case FAPPTYP_NOTWINDOWCOMPAT: - { - if (os2_mytype != 0) { /* not full screen */ - if (flag == P_NOWAIT) - flag = P_SESSION; - else if ((flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting Full Screen process with flag=%d, mytype=%d", - flag, os2_mytype); - } - } - break; - case FAPPTYP_NOTSPEC: - /* Let the shell handle this... */ - force_shell = 1; - buf = ""; /* Pacify a warning */ - file = 0; /* Pacify a warning */ - goto doshell_args; - break; - } - } - - if (addflag) { - addflag = 0; - new_stderr = dup(2); /* Preserve stderr */ - if (new_stderr == -1) { - if (errno == EBADF) - nostderr = 1; - else { - rc = -1; - goto finish; - } - } else - fl_stderr = fcntl(2, F_GETFD); - rc = dup2(1,2); - if (rc == -1) - goto finish; - fcntl(new_stderr, F_SETFD, FD_CLOEXEC); - } + force_shell = 0; + if (_emx_env & 0x200) { /* OS/2. */ + int type = file_type(real_name); + type_again: + if (type == -1) { /* Not found */ + errno = ENOENT; + rc = -1; + goto do_script; + } + else if (type == -2) { /* Not an EXE */ + errno = ENOEXEC; + rc = -1; + goto do_script; + } + else if (type == -3) { /* Is a directory? */ + /* Special-case this */ + char tbuf[512]; + int l = strlen(real_name); + + if (l + 5 <= sizeof tbuf) { + strcpy(tbuf, real_name); + strcpy(tbuf + l, ".exe"); + type = file_type(tbuf); + if (type >= -3) + goto type_again; + } + + errno = ENOEXEC; + rc = -1; + goto do_script; + } + switch (type & 7) { + /* Ignore WINDOWCOMPAT and FAPI, start them the same type we are. */ + case FAPPTYP_WINDOWAPI: + { /* Apparently, kids are started basing on startup type, not the morphed type */ + if (os2_mytype != 3) { /* not PM */ + if (flag == P_NOWAIT) + flag = P_PM; + else if ((flag & 7) != P_PM && (flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting PM process with flag=%d, mytype=%d", + flag, os2_mytype); + } + } + break; + case FAPPTYP_NOTWINDOWCOMPAT: + { + if (os2_mytype != 0) { /* not full screen */ + if (flag == P_NOWAIT) + flag = P_SESSION; + else if ((flag & 7) != P_SESSION && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Starting Full Screen process with flag=%d, mytype=%d", + flag, os2_mytype); + } + } + break; + case FAPPTYP_NOTSPEC: + /* Let the shell handle this... */ + force_shell = 1; + buf = ""; /* Pacify a warning */ + file = 0; /* Pacify a warning */ + goto doshell_args; + break; + } + } + + if (addflag) { + addflag = 0; + new_stderr = dup(2); /* Preserve stderr */ + if (new_stderr == -1) { + if (errno == EBADF) + nostderr = 1; + else { + rc = -1; + goto finish; + } + } else + fl_stderr = fcntl(2, F_GETFD); + rc = dup2(1,2); + if (rc == -1) + goto finish; + fcntl(new_stderr, F_SETFD, FD_CLOEXEC); + } #if 0 - rc = result(aTHX_ trueflag, spawnvp(flag,real_name,argv)); + rc = result(aTHX_ trueflag, spawnvp(flag,real_name,argv)); #else - if (execf == EXECF_TRUEEXEC) - rc = execvp(real_name,argv); - else if (execf == EXECF_EXEC) - rc = spawnvp(trueflag | P_OVERLAY,real_name,argv); - else if (execf == EXECF_SPAWN_NOWAIT) - rc = spawnvp(flag,real_name,argv); + if (execf == EXECF_TRUEEXEC) + rc = execvp(real_name,argv); + else if (execf == EXECF_EXEC) + rc = spawnvp(trueflag | P_OVERLAY,real_name,argv); + else if (execf == EXECF_SPAWN_NOWAIT) + rc = spawnvp(flag,real_name,argv); else if (execf == EXECF_SYNC) - rc = spawnvp(trueflag,real_name,argv); + rc = spawnvp(trueflag,real_name,argv); else /* EXECF_SPAWN, EXECF_SPAWN_BYFLAG */ - rc = result(aTHX_ trueflag, - spawnvp(flag,real_name,argv)); + rc = result(aTHX_ trueflag, + spawnvp(flag,real_name,argv)); #endif - if (rc < 0 && pass == 1) { - do_script: - if (real_name == argv[0]) { - int err = errno; - - if (err == ENOENT || err == ENOEXEC) { - /* No such file, or is a script. */ - /* Try adding script extensions to the file name, and - search on PATH. */ - char *scr = find_script(argv[0], TRUE, NULL, 0); - - if (scr) { - char *s = 0, *s1; - SV *scrsv = sv_2mortal(newSVpv(scr, 0)); - SV *bufsv = sv_newmortal(); + if (rc < 0 && pass == 1) { + do_script: + if (real_name == argv[0]) { + int err = errno; + + if (err == ENOENT || err == ENOEXEC) { + /* No such file, or is a script. */ + /* Try adding script extensions to the file name, and + search on PATH. */ + char *scr = find_script(argv[0], TRUE, NULL, 0); + + if (scr) { + char *s = 0, *s1; + SV *scrsv = sv_2mortal(newSVpv(scr, 0)); + SV *bufsv = sv_newmortal(); Safefree(scr); - scr = SvPV(scrsv, n_a); /* free()ed later */ + scr = SvPV(scrsv, n_a); /* free()ed later */ - file = PerlIO_open(scr, "r"); - argv[0] = scr; - if (!file) - goto panic_file; + file = PerlIO_open(scr, "r"); + argv[0] = scr; + if (!file) + goto panic_file; - buf = sv_gets(bufsv, file, 0 /* No append */); - if (!buf) - buf = ""; /* XXX Needed? */ - if (!buf[0]) { /* Empty... */ + buf = sv_gets(bufsv, file, 0 /* No append */); + if (!buf) + buf = ""; /* XXX Needed? */ + if (!buf[0]) { /* Empty... */ struct stat statbuf; - PerlIO_close(file); - /* Special case: maybe from -Zexe build, so - there is an executable around (contrary to - documentation, DosQueryAppType sometimes (?) - does not append ".exe", so we could have - reached this place). */ - sv_catpvs(scrsv, ".exe"); - argv[0] = scr = SvPV(scrsv, n_a); /* Reload */ + PerlIO_close(file); + /* Special case: maybe from -Zexe build, so + there is an executable around (contrary to + documentation, DosQueryAppType sometimes (?) + does not append ".exe", so we could have + reached this place). */ + sv_catpvs(scrsv, ".exe"); + argv[0] = scr = SvPV(scrsv, n_a); /* Reload */ if (PerlLIO_stat(scr,&statbuf) >= 0 && !S_ISDIR(statbuf.st_mode)) { /* Found */ - real_name = scr; - pass++; - goto reread; - } else { /* Restore */ - SvCUR_set(scrsv, SvCUR(scrsv) - 4); - *SvEND(scrsv) = 0; - } - } - if (PerlIO_close(file) != 0) { /* Failure */ - panic_file: - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Error reading \"%s\": %s", - scr, Strerror(errno)); - buf = ""; /* Not #! */ - goto doshell_args; - } - if (buf[0] == '#') { - if (buf[1] == '!') - s = buf + 2; - } else if (buf[0] == 'e') { - if (strBEGINs(buf, "extproc") - && isSPACE(buf[7])) - s = buf + 8; - } else if (buf[0] == 'E') { - if (strBEGINs(buf, "EXTPROC") - && isSPACE(buf[7])) - s = buf + 8; - } - if (!s) { - buf = ""; /* Not #! */ - goto doshell_args; - } - - s1 = s; - nargs = 0; - argsp = args; - while (1) { - /* Do better than pdksh: allow a few args, - strip trailing whitespace. */ - while (isSPACE(*s)) - s++; - if (*s == 0) - break; - if (nargs == 4) { - nargs = -1; - break; - } - args[nargs++] = s; - while (*s && !isSPACE(*s)) - s++; - if (*s == 0) - break; - *s++ = 0; - } - if (nargs == -1) { - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Too many args on %.*s line of \"%s\"", - s1 - buf, buf, scr); - nargs = 4; - argsp = fargs; - } - /* Can jump from far, buf/file invalid if force_shell: */ - doshell_args: - { - char **a = argv; - const char *exec_args[2]; - - if (force_shell - || (!buf[0] && file)) { /* File without magic */ - /* In fact we tried all what pdksh would - try. There is no point in calling - pdksh, we may just emulate its logic. */ - char *shell = PerlEnv_getenv("EXECSHELL"); - char *shell_opt = NULL; - if (!shell) { - char *s; - - shell_opt = "/c"; - shell = PerlEnv_getenv("OS2_SHELL"); - if (inicmd) { /* No spaces at start! */ - s = inicmd; - while (*s && !isSPACE(*s)) { - if (*s++ == '/') { - inicmd = NULL; /* Cannot use */ - break; - } - } - } - if (!inicmd) { - s = argv[0]; - while (*s) { - /* Dosish shells will choke on slashes - in paths, fortunately, this is - important for zeroth arg only. */ - if (*s == '/') - *s = '\\'; - s++; - } - } - } - /* If EXECSHELL is set, we do not set */ - - if (!shell) - shell = ((_emx_env & 0x200) - ? "c:/os2/cmd.exe" - : "c:/command.com"); - nargs = shell_opt ? 2 : 1; /* shell file args */ - exec_args[0] = shell; - exec_args[1] = shell_opt; - argsp = exec_args; - if (nargs == 2 && inicmd) { - /* Use the original cmd line */ - /* XXXX This is good only until we refuse - quoted arguments... */ - argv[0] = inicmd; - argv[1] = NULL; - } - } else if (!buf[0] && inicmd) { /* No file */ - /* Start with the original cmdline. */ - /* XXXX This is good only until we refuse - quoted arguments... */ - - argv[0] = inicmd; - argv[1] = NULL; - nargs = 2; /* shell -c */ - } - - while (a[1]) /* Get to the end */ - a++; - a++; /* Copy finil NULL too */ - while (a >= argv) { - *(a + nargs) = *a; /* argv was preallocated to be - long enough. */ - a--; - } - while (--nargs >= 0) /* XXXX Discard const... */ - argv[nargs] = (char*)argsp[nargs]; - /* Enable pathless exec if #! (as pdksh). */ - pass = (buf[0] == '#' ? 2 : 3); - goto retry; - } - } - /* Not found: restore errno */ - errno = err; - } - } else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */ - if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - real_name, argv[0]); - goto warned; - } else if (errno == ENOENT) { /* Cannot transfer `real_name' via shell. */ - if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - real_name, argv[0]); - goto warned; - } - } else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */ - char *no_dir = strrchr(argv[0], '/'); - - /* Do as pdksh port does: if not found with /, try without - path. */ - if (no_dir) { - argv[0] = no_dir + 1; - pass++; - goto retry; - } - } - if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", - ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) - ? "spawn" : "exec"), - real_name, Strerror(errno)); + real_name = scr; + pass++; + goto reread; + } else { /* Restore */ + SvCUR_set(scrsv, SvCUR(scrsv) - 4); + *SvEND(scrsv) = 0; + } + } + if (PerlIO_close(file) != 0) { /* Failure */ + panic_file: + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Error reading \"%s\": %s", + scr, Strerror(errno)); + buf = ""; /* Not #! */ + goto doshell_args; + } + if (buf[0] == '#') { + if (buf[1] == '!') + s = buf + 2; + } else if (buf[0] == 'e') { + if (strBEGINs(buf, "extproc") + && isSPACE(buf[7])) + s = buf + 8; + } else if (buf[0] == 'E') { + if (strBEGINs(buf, "EXTPROC") + && isSPACE(buf[7])) + s = buf + 8; + } + if (!s) { + buf = ""; /* Not #! */ + goto doshell_args; + } + + s1 = s; + nargs = 0; + argsp = args; + while (1) { + /* Do better than pdksh: allow a few args, + strip trailing whitespace. */ + while (isSPACE(*s)) + s++; + if (*s == 0) + break; + if (nargs == 4) { + nargs = -1; + break; + } + args[nargs++] = s; + while (*s && !isSPACE(*s)) + s++; + if (*s == 0) + break; + *s++ = 0; + } + if (nargs == -1) { + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Too many args on %.*s line of \"%s\"", + s1 - buf, buf, scr); + nargs = 4; + argsp = fargs; + } + /* Can jump from far, buf/file invalid if force_shell: */ + doshell_args: + { + char **a = argv; + const char *exec_args[2]; + + if (force_shell + || (!buf[0] && file)) { /* File without magic */ + /* In fact we tried all what pdksh would + try. There is no point in calling + pdksh, we may just emulate its logic. */ + char *shell = PerlEnv_getenv("EXECSHELL"); + char *shell_opt = NULL; + if (!shell) { + char *s; + + shell_opt = "/c"; + shell = PerlEnv_getenv("OS2_SHELL"); + if (inicmd) { /* No spaces at start! */ + s = inicmd; + while (*s && !isSPACE(*s)) { + if (*s++ == '/') { + inicmd = NULL; /* Cannot use */ + break; + } + } + } + if (!inicmd) { + s = argv[0]; + while (*s) { + /* Dosish shells will choke on slashes + in paths, fortunately, this is + important for zeroth arg only. */ + if (*s == '/') + *s = '\\'; + s++; + } + } + } + /* If EXECSHELL is set, we do not set */ + + if (!shell) + shell = ((_emx_env & 0x200) + ? "c:/os2/cmd.exe" + : "c:/command.com"); + nargs = shell_opt ? 2 : 1; /* shell file args */ + exec_args[0] = shell; + exec_args[1] = shell_opt; + argsp = exec_args; + if (nargs == 2 && inicmd) { + /* Use the original cmd line */ + /* XXXX This is good only until we refuse + quoted arguments... */ + argv[0] = inicmd; + argv[1] = NULL; + } + } else if (!buf[0] && inicmd) { /* No file */ + /* Start with the original cmdline. */ + /* XXXX This is good only until we refuse + quoted arguments... */ + + argv[0] = inicmd; + argv[1] = NULL; + nargs = 2; /* shell -c */ + } + + while (a[1]) /* Get to the end */ + a++; + a++; /* Copy finil NULL too */ + while (a >= argv) { + *(a + nargs) = *a; /* argv was preallocated to be + long enough. */ + a--; + } + while (--nargs >= 0) /* XXXX Discard const... */ + argv[nargs] = (char*)argsp[nargs]; + /* Enable pathless exec if #! (as pdksh). */ + pass = (buf[0] == '#' ? 2 : 3); + goto retry; + } + } + /* Not found: restore errno */ + errno = err; + } + } else if (errno == ENOEXEC) { /* Cannot transfer `real_name' via shell. */ + if (rc < 0 && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s script `%s' with ARGV[0] being `%s'", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + real_name, argv[0]); + goto warned; + } else if (errno == ENOENT) { /* Cannot transfer `real_name' via shell. */ + if (rc < 0 && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s `%s' with ARGV[0] being `%s' (looking for executables only, not found)", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + real_name, argv[0]); + goto warned; + } + } else if (rc < 0 && pass == 2 && errno == ENOENT) { /* File not found */ + char *no_dir = strrchr(argv[0], '/'); + + /* Do as pdksh port does: if not found with /, try without + path. */ + if (no_dir) { + argv[0] = no_dir + 1; + pass++; + goto retry; + } + } + if (rc < 0 && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s\n", + ((execf != EXECF_EXEC && execf != EXECF_TRUEEXEC) + ? "spawn" : "exec"), + real_name, Strerror(errno)); warned: - if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) - && ((trueflag & 0xFF) == P_WAIT)) - rc = -1; + if (rc < 0 && (execf != EXECF_SPAWN_NOWAIT) + && ((trueflag & 0xFF) == P_WAIT)) + rc = -1; finish: if (new_stderr != -1) { /* How can we use error codes? */ - dup2(new_stderr, 2); - close(new_stderr); - fcntl(2, F_SETFD, fl_stderr); + dup2(new_stderr, 2); + close(new_stderr); + fcntl(2, F_SETFD, fl_stderr); } else if (nostderr) close(2); return rc; @@ -1357,13 +1357,13 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) ENTER; #ifdef TRYSHELL if ((shell = PerlEnv_getenv("EMXSHELL")) != NULL) - copt = "-c"; + copt = "-c"; else if ((shell = PerlEnv_getenv("SHELL")) != NULL) - copt = "-c"; + copt = "-c"; else if ((shell = PerlEnv_getenv("COMSPEC")) != NULL) - copt = "/C"; + copt = "/C"; else - shell = "cmd.exe"; + shell = "cmd.exe"; #else /* Consensus on perl5-porters is that it is _very_ important to have a shell which will not change between computers with the @@ -1374,81 +1374,81 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) #endif while (*cmd && isSPACE(*cmd)) - cmd++; + cmd++; if (strBEGINs(cmd,"/bin/sh") && isSPACE(cmd[7])) { - STRLEN l = strlen(PL_sh_path); - - Newx(news, strlen(cmd) - 7 + l + 1, char); - strcpy(news, PL_sh_path); - strcpy(news + l, cmd + 7); - cmd = news; + STRLEN l = strlen(PL_sh_path); + + Newx(news, strlen(cmd) - 7 + l + 1, char); + strcpy(news, PL_sh_path); + strcpy(news + l, cmd + 7); + cmd = news; } /* save an extra exec if possible */ /* see if there are shell metacharacters in it */ if (*cmd == '.' && isSPACE(cmd[1])) - goto doshell; + goto doshell; if (strBEGINs(cmd,"exec") && isSPACE(cmd[4])) - goto doshell; + goto doshell; for (s = cmd; *s && isALPHA(*s); s++) ; /* catch VAR=val gizmo */ if (*s == '=') - goto doshell; + goto doshell; for (s = cmd; *s; s++) { - if (*s != ' ' && !isALPHA(*s) && memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) { - if (*s == '\n' && s[1] == '\0') { - *s = '\0'; - break; - } else if (*s == '\\' && !seenspace) { - continue; /* Allow backslashes in names */ - } else if (*s == '>' && s >= cmd + 3 - && s[-1] == '2' && s[1] == '&' && s[2] == '1' - && isSPACE(s[-2]) ) { - char *t = s + 3; - - while (*t && isSPACE(*t)) - t++; - if (!*t) { - s[-2] = '\0'; - mergestderr = 1; - break; /* Allow 2>&1 as the last thing */ - } - } - /* We do not convert this to do_spawn_ve since shell - should be smart enough to start itself gloriously. */ - doshell: - if (execf == EXECF_TRUEEXEC) + if (*s != ' ' && !isALPHA(*s) && memCHRs("$&*(){}[]'\";\\|?<>~`\n",*s)) { + if (*s == '\n' && s[1] == '\0') { + *s = '\0'; + break; + } else if (*s == '\\' && !seenspace) { + continue; /* Allow backslashes in names */ + } else if (*s == '>' && s >= cmd + 3 + && s[-1] == '2' && s[1] == '&' && s[2] == '1' + && isSPACE(s[-2]) ) { + char *t = s + 3; + + while (*t && isSPACE(*t)) + t++; + if (!*t) { + s[-2] = '\0'; + mergestderr = 1; + break; /* Allow 2>&1 as the last thing */ + } + } + /* We do not convert this to do_spawn_ve since shell + should be smart enough to start itself gloriously. */ + doshell: + if (execf == EXECF_TRUEEXEC) rc = execl(shell,shell,copt,cmd,(char*)0); - else if (execf == EXECF_EXEC) + else if (execf == EXECF_EXEC) rc = spawnl(P_OVERLAY,shell,shell,copt,cmd,(char*)0); - else if (execf == EXECF_SPAWN_NOWAIT) + else if (execf == EXECF_SPAWN_NOWAIT) rc = spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0); - else if (execf == EXECF_SPAWN_BYFLAG) + else if (execf == EXECF_SPAWN_BYFLAG) rc = spawnl(flag,shell,shell,copt,cmd,(char*)0); - else { - /* In the ak code internal P_NOWAIT is P_WAIT ??? */ - if (execf == EXECF_SYNC) - rc = spawnl(P_WAIT,shell,shell,copt,cmd,(char*)0); - else - rc = result(aTHX_ P_WAIT, - spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); - if (rc < 0 && ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", - (execf == EXECF_SPAWN ? "spawn" : "exec"), - shell, Strerror(errno)); - if (rc < 0) - rc = -1; - } - if (news) - Safefree(news); - goto leave; - } else if (*s == ' ' || *s == '\t') { - seenspace = 1; - } + else { + /* In the ak code internal P_NOWAIT is P_WAIT ??? */ + if (execf == EXECF_SYNC) + rc = spawnl(P_WAIT,shell,shell,copt,cmd,(char*)0); + else + rc = result(aTHX_ P_WAIT, + spawnl(P_NOWAIT,shell,shell,copt,cmd,(char*)0)); + if (rc < 0 && ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", + (execf == EXECF_SPAWN ? "spawn" : "exec"), + shell, Strerror(errno)); + if (rc < 0) + rc = -1; + } + if (news) + Safefree(news); + goto leave; + } else if (*s == ' ' || *s == '\t') { + seenspace = 1; + } } /* cmd="a" may lead to "sh", "-c", "\"$@\"", "a", "a.cmd", NULL */ @@ -1458,20 +1458,20 @@ do_spawn3(pTHX_ char *cmd, int execf, int flag) SAVEFREEPV(cmd); a = argv; for (s = cmd; *s;) { - while (*s && isSPACE(*s)) s++; - if (*s) - *(a++) = s; - while (*s && !isSPACE(*s)) s++; - if (*s) - *s++ = '\0'; + while (*s && isSPACE(*s)) s++; + if (*s) + *(a++) = s; + while (*s && !isSPACE(*s)) s++; + if (*s) + *s++ = '\0'; } *a = NULL; if (argv[0]) - rc = do_spawn_ve(aTHX_ NULL, argv, flag, execf, cmd, mergestderr); + rc = do_spawn_ve(aTHX_ NULL, argv, flag, execf, cmd, mergestderr); else - rc = -1; + rc = -1; if (news) - Safefree(news); + Safefree(news); leave: LEAVE; return rc; @@ -1494,37 +1494,37 @@ os2_aspawn_4(pTHX_ SV *really, SV **args, I32 cnt, int execing) ENTER; if (cnt) { - Newx(argv, cnt + 3, char*); /* 3 extra to expand #! */ - SAVEFREEPV(argv); - a = argv; - - if (cnt > 1 && SvNIOKp(*argp) && !SvPOKp(*argp)) { - flag = SvIVx(*argp); - flag_set = 1; - } else - --argp; - - while (++argp < last) { - if (*argp) { - char *arg = SvPVx(*argp, n_a); - arg = savepv(arg); - SAVEFREEPV(arg); - *a++ = arg; - } else - *a++ = ""; - } - *a = NULL; - - if ( flag_set && (a == argv + 1) - && !really && execing == ASPAWN_WAIT ) { /* One arg? */ - rc = do_spawn3(aTHX_ a[-1], EXECF_SPAWN_BYFLAG, flag); - } else { - const int execf[3] = {EXECF_SPAWN, EXECF_EXEC, EXECF_SPAWN_NOWAIT}; - - rc = do_spawn_ve(aTHX_ really, argv, flag, execf[execing], NULL, 0); - } + Newx(argv, cnt + 3, char*); /* 3 extra to expand #! */ + SAVEFREEPV(argv); + a = argv; + + if (cnt > 1 && SvNIOKp(*argp) && !SvPOKp(*argp)) { + flag = SvIVx(*argp); + flag_set = 1; + } else + --argp; + + while (++argp < last) { + if (*argp) { + char *arg = SvPVx(*argp, n_a); + arg = savepv(arg); + SAVEFREEPV(arg); + *a++ = arg; + } else + *a++ = ""; + } + *a = NULL; + + if ( flag_set && (a == argv + 1) + && !really && execing == ASPAWN_WAIT ) { /* One arg? */ + rc = do_spawn3(aTHX_ a[-1], EXECF_SPAWN_BYFLAG, flag); + } else { + const int execf[3] = {EXECF_SPAWN, EXECF_EXEC, EXECF_SPAWN_NOWAIT}; + + rc = do_spawn_ve(aTHX_ really, argv, flag, execf[execing], NULL, 0); + } } else - rc = -1; + rc = -1; LEAVE; return rc; } @@ -1582,63 +1582,63 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args) this = (*mode == 'w'); that = !this; if (TAINTING_get) { - taint_env(); - taint_proper("Insecure %s%s", "EXEC"); + taint_env(); + taint_proper("Insecure %s%s", "EXEC"); } if (pipe(p) < 0) - return NULL; + return NULL; /* Now we need to spawn the child. */ if (p[this] == (*mode == 'r')) { /* if fh 0/1 was initially closed. */ - int new = dup(p[this]); + int new = dup(p[this]); - if (new == -1) - goto closepipes; - close(p[this]); - p[this] = new; + if (new == -1) + goto closepipes; + close(p[this]); + p[this] = new; } newfd = dup(*mode == 'r'); /* Preserve std* */ if (newfd == -1) { - /* This cannot happen due to fh being bad after pipe(), since - pipe() should have created fh 0 and 1 even if they were - initially closed. But we closed p[this] before. */ - if (errno != EBADF) { - closepipes: - close(p[0]); - close(p[1]); - return NULL; - } + /* This cannot happen due to fh being bad after pipe(), since + pipe() should have created fh 0 and 1 even if they were + initially closed. But we closed p[this] before. */ + if (errno != EBADF) { + closepipes: + close(p[0]); + close(p[1]); + return NULL; + } } else - fh_fl = fcntl(*mode == 'r', F_GETFD); + fh_fl = fcntl(*mode == 'r', F_GETFD); if (p[that] != (*mode == 'r')) { /* if fh 0/1 was initially closed. */ - dup2(p[that], *mode == 'r'); - close(p[that]); + dup2(p[that], *mode == 'r'); + close(p[that]); } /* Where is `this' and newfd now? */ fcntl(p[this], F_SETFD, FD_CLOEXEC); if (newfd != -1) - fcntl(newfd, F_SETFD, FD_CLOEXEC); + fcntl(newfd, F_SETFD, FD_CLOEXEC); if (cnt) { /* Args: "Real cmd", before first arg, the last, execing */ - pid = os2_aspawn_4(aTHX_ NULL, args, cnt, ASPAWN_NOWAIT); + pid = os2_aspawn_4(aTHX_ NULL, args, cnt, ASPAWN_NOWAIT); } else - pid = do_spawn_nowait(aTHX_ cmd); + pid = do_spawn_nowait(aTHX_ cmd); if (newfd == -1) - close(*mode == 'r'); /* It was closed initially */ + close(*mode == 'r'); /* It was closed initially */ else if (newfd != (*mode == 'r')) { /* Probably this check is not needed */ - dup2(newfd, *mode == 'r'); /* Return std* back. */ - close(newfd); - fcntl(*mode == 'r', F_SETFD, fh_fl); + dup2(newfd, *mode == 'r'); /* Return std* back. */ + close(newfd); + fcntl(*mode == 'r', F_SETFD, fh_fl); } else - fcntl(*mode == 'r', F_SETFD, fh_fl); + fcntl(*mode == 'r', F_SETFD, fh_fl); if (p[that] == (*mode == 'r')) - close(p[that]); + close(p[that]); if (pid == -1) { - close(p[this]); - return NULL; + close(p[this]); + return NULL; } if (p[that] < p[this]) { /* Make fh as small as possible */ - dup2(p[this], p[that]); - close(p[this]); - p[this] = p[that]; + dup2(p[this], p[that]); + close(p[this]); + p[this] = p[that]; } sv = *av_fetch(PL_fdpid,p[this],TRUE); (void)SvUPGRADE(sv,SVt_IV); @@ -1652,7 +1652,7 @@ my_syspopen4(pTHX_ char *cmd, char *mode, I32 cnt, SV** args) SV *sv; if (cnt) - Perl_croak(aTHX_ "List form of piped open not implemented"); + Perl_croak(aTHX_ "List form of piped open not implemented"); # ifdef TRYSHELL res = popen(cmd, mode); @@ -1726,16 +1726,16 @@ static void massage_os2_attr(struct stat *st) { if ( ((st->st_mode & S_IFMT) != S_IFREG - && (st->st_mode & S_IFMT) != S_IFDIR) + && (st->st_mode & S_IFMT) != S_IFDIR) || !(st->st_attr & (FILE_ARCHIVED | FILE_HIDDEN | FILE_SYSTEM))) - return; + return; if ( st->st_attr & FILE_ARCHIVED ) - st->st_mode |= (os2_stat_archived | os2_stat_force); + st->st_mode |= (os2_stat_archived | os2_stat_force); if ( st->st_attr & FILE_HIDDEN ) - st->st_mode |= (os2_stat_hidden | os2_stat_force); + st->st_mode |= (os2_stat_hidden | os2_stat_force); if ( st->st_attr & FILE_SYSTEM ) - st->st_mode |= (os2_stat_system | os2_stat_force); + st->st_mode |= (os2_stat_system | os2_stat_force); } /* First attempt used DosQueryFSAttach which crashed the system when @@ -1748,15 +1748,15 @@ os2_stat(const char *name, struct stat *st) if ( ( l < 8 || l > 9) || strnicmp(name, "/dev/", 5) != 0 || ( stricmp(name + 5, "con") != 0 - && stricmp(name + 5, "tty") != 0 - && stricmp(name + 5, "nul") != 0 - && stricmp(name + 5, "null") != 0) ) { - int s = stat(name, st); - - if (s) - return s; - massage_os2_attr(st); - return 0; + && stricmp(name + 5, "tty") != 0 + && stricmp(name + 5, "nul") != 0 + && stricmp(name + 5, "null") != 0) ) { + int s = stat(name, st); + + if (s) + return s; + massage_os2_attr(st); + return 0; } memset(st, 0, sizeof *st); @@ -1774,7 +1774,7 @@ os2_fstat(int handle, struct stat *st) int s = fstat(handle, st); if (s) - return s; + return s; massage_os2_attr(st); return 0; } @@ -1786,15 +1786,15 @@ os2_chmod (const char *name, int pmode) /* Modelled after EMX src/lib/io/chmod.c int attr, rc; if (!(pmode & os2_stat_force)) - return chmod(name, pmode); + return chmod(name, pmode); attr = __chmod (name, 0, 0); /* Get attributes */ if (attr < 0) - return -1; + return -1; if (pmode & S_IWRITE) - attr &= ~FILE_READONLY; + attr &= ~FILE_READONLY; else - attr |= FILE_READONLY; + attr |= FILE_READONLY; /* New logic */ attr &= ~(FILE_ARCHIVED | FILE_HIDDEN | FILE_SYSTEM); @@ -1822,9 +1822,9 @@ sys_alloc(int size) { APIRET rc = DosAllocMem(&got, size, PAG_COMMIT | PAG_WRITE); if (rc == ERROR_NOT_ENOUGH_MEMORY) { - return (void *) -1; + return (void *) -1; } else if ( rc ) - Perl_croak_nocontext("Got an error from DosAllocMem: %li", (long)rc); + Perl_croak_nocontext("Got an error from DosAllocMem: %li", (long)rc); return got; } @@ -1846,10 +1846,10 @@ settmppath() len = strlen(p); tpath = (char *)malloc(len + strlen(TMPPATH1) + 2); if (tpath) { - strcpy(tpath, p); - tpath[len] = '/'; - strcpy(tpath + len + 1, TMPPATH1); - tmppath = tpath; + strcpy(tpath, p); + tpath[len] = '/'; + strcpy(tpath + len + 1, TMPPATH1); + tmppath = tpath; } } @@ -1859,23 +1859,23 @@ XS(XS_File__Copy_syscopy) { dXSARGS; if (items < 2 || items > 3) - Perl_croak_nocontext("Usage: File::Copy::syscopy(src,dst,flag=0)"); + Perl_croak_nocontext("Usage: File::Copy::syscopy(src,dst,flag=0)"); { - STRLEN n_a; - char * src = (char *)SvPV(ST(0),n_a); - char * dst = (char *)SvPV(ST(1),n_a); - U32 flag; - int RETVAL, rc; - dXSTARG; - - if (items < 3) - flag = 0; - else { - flag = (unsigned long)SvIV(ST(2)); - } - - RETVAL = !CheckOSError(DosCopy(src, dst, flag)); - XSprePUSH; PUSHi((IV)RETVAL); + STRLEN n_a; + char * src = (char *)SvPV(ST(0),n_a); + char * dst = (char *)SvPV(ST(1),n_a); + U32 flag; + int RETVAL, rc; + dXSTARG; + + if (items < 3) + flag = 0; + else { + flag = (unsigned long)SvIV(ST(2)); + } + + RETVAL = !CheckOSError(DosCopy(src, dst, flag)); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -1883,21 +1883,21 @@ XS(XS_File__Copy_syscopy) /* APIRET APIENTRY DosReplaceModule (PCSZ pszOld, PCSZ pszNew, PCSZ pszBackup); */ DeclOSFuncByORD(ULONG,replaceModule,ORD_DosReplaceModule, - (char *old, char *new, char *backup), (old, new, backup)) + (char *old, char *new, char *backup), (old, new, backup)) XS(XS_OS2_replaceModule); /* prototype to pass -Wmissing-prototypes */ XS(XS_OS2_replaceModule) { dXSARGS; if (items < 1 || items > 3) - Perl_croak(aTHX_ "Usage: OS2::replaceModule(target [, source [, backup]])"); + Perl_croak(aTHX_ "Usage: OS2::replaceModule(target [, source [, backup]])"); { - char * target = (char *)SvPV_nolen(ST(0)); - char * source = (items < 2) ? NULL : (char *)SvPV_nolen(ST(1)); - char * backup = (items < 3) ? NULL : (char *)SvPV_nolen(ST(2)); + char * target = (char *)SvPV_nolen(ST(0)); + char * source = (items < 2) ? NULL : (char *)SvPV_nolen(ST(1)); + char * backup = (items < 3) ? NULL : (char *)SvPV_nolen(ST(2)); - if (!replaceModule(target, source, backup)) - croak_with_os2error("replaceModule() error"); + if (!replaceModule(target, source, backup)) + croak_with_os2error("replaceModule() error"); } XSRETURN_YES; } @@ -1906,8 +1906,8 @@ XS(XS_OS2_replaceModule) ULONG ulParm2, ULONG ulParm3); */ DeclOSFuncByORD(ULONG,perfSysCall,ORD_DosPerfSysCall, - (ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3), - (ulCommand, ulParm1, ulParm2, ulParm3)) + (ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3), + (ulCommand, ulParm1, ulParm2, ulParm3)) #ifndef CMD_KI_RDCNT # define CMD_KI_RDCNT 0x63 @@ -1925,10 +1925,10 @@ typedef unsigned long long myCPUUTIL[4]; /* time/idle/busy/intr */ NO_OUTPUT ULONG perfSysCall(ULONG ulCommand, ULONG ulParm1, ULONG ulParm2, ULONG ulParm3) PREINIT: - ULONG rc; + ULONG rc; POSTCALL: - if (!RETVAL) - croak_with_os2error("perfSysCall() error"); + if (!RETVAL) + croak_with_os2error("perfSysCall() error"); */ static int @@ -1937,7 +1937,7 @@ numprocessors(void) ULONG res; if (DosQuerySysInfo(QSV_NUMPROCESSORS, QSV_NUMPROCESSORS, (PVOID)&res, sizeof(res))) - return 1; /* Old system? */ + return 1; /* Old system? */ return res; } @@ -1946,64 +1946,64 @@ XS(XS_OS2_perfSysCall) { dXSARGS; if (items < 0 || items > 4) - Perl_croak(aTHX_ "Usage: OS2::perfSysCall(ulCommand = CMD_KI_RDCNT, ulParm1= 0, ulParm2= 0, ulParm3= 0)"); + Perl_croak(aTHX_ "Usage: OS2::perfSysCall(ulCommand = CMD_KI_RDCNT, ulParm1= 0, ulParm2= 0, ulParm3= 0)"); SP -= items; { - dXSTARG; - ULONG RETVAL, ulCommand, ulParm1, ulParm2, ulParm3, res; - myCPUUTIL u[64]; - int total = 0, tot2 = 0; - - if (items < 1) - ulCommand = CMD_KI_RDCNT; - else { - ulCommand = (ULONG)SvUV(ST(0)); - } - - if (items < 2) { - total = (ulCommand == CMD_KI_RDCNT ? numprocessors() : 0); - ulParm1 = (total ? (ULONG)u : 0); - - if (total > C_ARRAY_LENGTH(u)) - croak("Unexpected number of processors: %d", total); - } else { - ulParm1 = (ULONG)SvUV(ST(1)); - } - - if (items < 3) { - tot2 = (ulCommand == CMD_KI_GETQTY); - ulParm2 = (tot2 ? (ULONG)&res : 0); - } else { - ulParm2 = (ULONG)SvUV(ST(2)); - } - - if (items < 4) - ulParm3 = 0; - else { - ulParm3 = (ULONG)SvUV(ST(3)); - } - - RETVAL = perfSysCall(ulCommand, ulParm1, ulParm2, ulParm3); - if (!RETVAL) - croak_with_os2error("perfSysCall() error"); - XSprePUSH; - if (total) { - int i,j; - - if (GIMME_V != G_ARRAY) { - PUSHn(u[0][0]); /* Total ticks on the first processor */ - XSRETURN(1); - } - EXTEND(SP, 4*total); - for (i=0; i < total; i++) - for (j=0; j < 4; j++) - PUSHs(sv_2mortal(newSVnv(u[i][j]))); - XSRETURN(4*total); - } - if (tot2) { - PUSHu(res); - XSRETURN(1); - } + dXSTARG; + ULONG RETVAL, ulCommand, ulParm1, ulParm2, ulParm3, res; + myCPUUTIL u[64]; + int total = 0, tot2 = 0; + + if (items < 1) + ulCommand = CMD_KI_RDCNT; + else { + ulCommand = (ULONG)SvUV(ST(0)); + } + + if (items < 2) { + total = (ulCommand == CMD_KI_RDCNT ? numprocessors() : 0); + ulParm1 = (total ? (ULONG)u : 0); + + if (total > C_ARRAY_LENGTH(u)) + croak("Unexpected number of processors: %d", total); + } else { + ulParm1 = (ULONG)SvUV(ST(1)); + } + + if (items < 3) { + tot2 = (ulCommand == CMD_KI_GETQTY); + ulParm2 = (tot2 ? (ULONG)&res : 0); + } else { + ulParm2 = (ULONG)SvUV(ST(2)); + } + + if (items < 4) + ulParm3 = 0; + else { + ulParm3 = (ULONG)SvUV(ST(3)); + } + + RETVAL = perfSysCall(ulCommand, ulParm1, ulParm2, ulParm3); + if (!RETVAL) + croak_with_os2error("perfSysCall() error"); + XSprePUSH; + if (total) { + int i,j; + + if (GIMME_V != G_ARRAY) { + PUSHn(u[0][0]); /* Total ticks on the first processor */ + XSRETURN(1); + } + EXTEND(SP, 4*total); + for (i=0; i < total; i++) + for (j=0; j < 4; j++) + PUSHs(sv_2mortal(newSVnv(u[i][j]))); + XSRETURN(4*total); + } + if (tot2) { + PUSHu(res); + XSRETURN(1); + } } XSRETURN_EMPTY; } @@ -2034,15 +2034,15 @@ mod2fname(pTHX_ SV *sv) len = strlen(s); if (len < 6) pos = len; while (*s) { - sum = 33 * sum + *(s++); /* Checksumming first chars to - * get the capitalization into c.s. */ + sum = 33 * sum + *(s++); /* Checksumming first chars to + * get the capitalization into c.s. */ } while (avlen > 0) { - s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); - while (*s) { - sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */ - } - avlen --; + s = SvPV(*av_fetch((AV*)sv, avlen, FALSE), n_a); + while (*s) { + sum = 33 * sum + *(s++); /* 7 is primitive mod 13. */ + } + avlen --; } /* We always load modules as *specific* DLLs, and with the full name. When loading a specific DLL by its full name, one cannot get a @@ -2066,15 +2066,15 @@ XS(XS_DynaLoader_mod2fname) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: DynaLoader::mod2fname(sv)"); + Perl_croak_nocontext("Usage: DynaLoader::mod2fname(sv)"); { - SV * sv = ST(0); - char * RETVAL; - dXSTARG; + SV * sv = ST(0); + char * RETVAL; + dXSTARG; - RETVAL = mod2fname(aTHX_ sv); - sv_setpv(TARG, RETVAL); - XSprePUSH; PUSHTARG; + RETVAL = mod2fname(aTHX_ sv); + sv_setpv(TARG, RETVAL); + XSprePUSH; PUSHTARG; } XSRETURN(1); } @@ -2082,75 +2082,75 @@ XS(XS_DynaLoader_mod2fname) char * os2error(int rc) { - dTHX; - ULONG len; - char *s; - int number = SvTRUE(get_sv("OS2::nsyserror", GV_ADD)); + dTHX; + ULONG len; + char *s; + int number = SvTRUE(get_sv("OS2::nsyserror", GV_ADD)); if (!(_emx_env & 0x200)) return ""; /* Nop if not OS/2. */ - if (rc == 0) - return ""; - if (number) { - sprintf(os2error_buf, "SYS%04d=%#x: ", rc, rc); - s = os2error_buf + strlen(os2error_buf); - } else - s = os2error_buf; - if (DosGetMessage(NULL, 0, s, sizeof(os2error_buf) - 1 - (s-os2error_buf), - rc, "OSO001.MSG", &len)) { - char *name = ""; - - if (!number) { - sprintf(os2error_buf, "SYS%04d=%#x: ", rc, rc); - s = os2error_buf + strlen(os2error_buf); - } - switch (rc) { - case PMERR_INVALID_HWND: - name = "PMERR_INVALID_HWND"; - break; - case PMERR_INVALID_HMQ: - name = "PMERR_INVALID_HMQ"; - break; - case PMERR_CALL_FROM_WRONG_THREAD: - name = "PMERR_CALL_FROM_WRONG_THREAD"; - break; - case PMERR_NO_MSG_QUEUE: - name = "PMERR_NO_MSG_QUEUE"; - break; - case PMERR_NOT_IN_A_PM_SESSION: - name = "PMERR_NOT_IN_A_PM_SESSION"; - break; - case PMERR_INVALID_ATOM: - name = "PMERR_INVALID_ATOM"; - break; - case PMERR_INVALID_HATOMTBL: - name = "PMERR_INVALID_HATOMTMB"; - break; - case PMERR_INVALID_INTEGER_ATOM: - name = "PMERR_INVALID_INTEGER_ATOM"; - break; - case PMERR_INVALID_ATOM_NAME: - name = "PMERR_INVALID_ATOM_NAME"; - break; - case PMERR_ATOM_NAME_NOT_FOUND: - name = "PMERR_ATOM_NAME_NOT_FOUND"; - break; - } - sprintf(s, "%s%s[No description found in OSO001.MSG]", - name, (*name ? "=" : "")); - } else { - s[len] = '\0'; - if (len && s[len - 1] == '\n') - s[--len] = 0; - if (len && s[len - 1] == '\r') - s[--len] = 0; - if (len && s[len - 1] == '.') - s[--len] = 0; - if (len >= 10 && number && strnEQ(s, os2error_buf, 7) - && s[7] == ':' && s[8] == ' ') - /* Some messages start with SYSdddd:, some not */ - Move(s + 9, s, (len -= 9) + 1, char); - } - return os2error_buf; + if (rc == 0) + return ""; + if (number) { + sprintf(os2error_buf, "SYS%04d=%#x: ", rc, rc); + s = os2error_buf + strlen(os2error_buf); + } else + s = os2error_buf; + if (DosGetMessage(NULL, 0, s, sizeof(os2error_buf) - 1 - (s-os2error_buf), + rc, "OSO001.MSG", &len)) { + char *name = ""; + + if (!number) { + sprintf(os2error_buf, "SYS%04d=%#x: ", rc, rc); + s = os2error_buf + strlen(os2error_buf); + } + switch (rc) { + case PMERR_INVALID_HWND: + name = "PMERR_INVALID_HWND"; + break; + case PMERR_INVALID_HMQ: + name = "PMERR_INVALID_HMQ"; + break; + case PMERR_CALL_FROM_WRONG_THREAD: + name = "PMERR_CALL_FROM_WRONG_THREAD"; + break; + case PMERR_NO_MSG_QUEUE: + name = "PMERR_NO_MSG_QUEUE"; + break; + case PMERR_NOT_IN_A_PM_SESSION: + name = "PMERR_NOT_IN_A_PM_SESSION"; + break; + case PMERR_INVALID_ATOM: + name = "PMERR_INVALID_ATOM"; + break; + case PMERR_INVALID_HATOMTBL: + name = "PMERR_INVALID_HATOMTMB"; + break; + case PMERR_INVALID_INTEGER_ATOM: + name = "PMERR_INVALID_INTEGER_ATOM"; + break; + case PMERR_INVALID_ATOM_NAME: + name = "PMERR_INVALID_ATOM_NAME"; + break; + case PMERR_ATOM_NAME_NOT_FOUND: + name = "PMERR_ATOM_NAME_NOT_FOUND"; + break; + } + sprintf(s, "%s%s[No description found in OSO001.MSG]", + name, (*name ? "=" : "")); + } else { + s[len] = '\0'; + if (len && s[len - 1] == '\n') + s[--len] = 0; + if (len && s[len - 1] == '\r') + s[--len] = 0; + if (len && s[len - 1] == '.') + s[--len] = 0; + if (len >= 10 && number && strnEQ(s, os2error_buf, 7) + && s[7] == ':' && s[8] == ' ') + /* Some messages start with SYSdddd:, some not */ + Move(s + 9, s, (len -= 9) + 1, char); + } + return os2error_buf; } void @@ -2196,12 +2196,12 @@ execname2buffer(char *buf, STRLEN l, char *oname) p = buf; while (*p) { if (*p == '\\') - *p = '/'; + *p = '/'; if (*p == '/') { - if (ok && *oname != '/' && *oname != '\\') - ok = 0; + if (ok && *oname != '/' && *oname != '\\') + ok = 0; } else if (ok && tolower(*oname) != tolower(*p)) - ok = 0; + ok = 0; p++; oname++; } @@ -2234,32 +2234,32 @@ Perl_OS2_handler_install(void *handler, enum Perlos2_handler how) switch (how) { case Perlos2_handler_mangle: - perllib_mangle_installed = (char *(*)(char *s, unsigned int l))handler; - return 1; + perllib_mangle_installed = (char *(*)(char *s, unsigned int l))handler; + return 1; case Perlos2_handler_perl_sh: - s = (char *)handler; - s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perl_sh"); - perl_sh_installed = savepv(s); - return 1; + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perl_sh"); + perl_sh_installed = savepv(s); + return 1; case Perlos2_handler_perllib_from: - s = (char *)handler; - s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_from"); - oldl = strlen(s); - oldp = savepv(s); - return 1; + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_from"); + oldl = strlen(s); + oldp = savepv(s); + return 1; case Perlos2_handler_perllib_to: - s = (char *)handler; - s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_to"); - newl = strlen(s); - newp = savepv(s); - strcpy(mangle_ret, newp); - s = mangle_ret - 1; - while (*++s) - if (*s == '\\') - *s = '/'; - return 1; + s = (char *)handler; + s = dir_subst(s, strlen(s), b, sizeof b, 0, "handler_perllib_to"); + newl = strlen(s); + newp = savepv(s); + strcpy(mangle_ret, newp); + s = mangle_ret - 1; + while (*++s) + if (*s == '\\') + *s = '/'; + return 1; default: - return 0; + return 0; } } @@ -2271,115 +2271,115 @@ dir_subst(char *s, unsigned int l, char *b, unsigned int bl, enum dir_subst_e fl STRLEN froml = 0, tol = 0, rest = 0; /* froml: likewise */ if (l >= 2 && s[0] == '~') { - switch (s[1]) { - case 'i': case 'I': - from = "installprefix"; break; - case 'd': case 'D': - from = "dll"; break; - case 'e': case 'E': - from = "exe"; break; - default: - from = NULL; - froml = l + 1; /* Will not match */ - break; - } - if (from) - froml = strlen(from) + 1; - if (l >= froml && strnicmp(s + 2, from + 1, froml - 2) == 0) { - int strip = 1; - - switch (s[1]) { - case 'i': case 'I': - strip = 0; - tol = strlen(INSTALL_PREFIX); - if (tol >= bl) { - if (flags & dir_subst_fatal) - Perl_croak_nocontext("INSTALL_PREFIX too long: `%s'", INSTALL_PREFIX); - else - return NULL; - } - memcpy(b, INSTALL_PREFIX, tol + 1); - to = b; - e = b + tol; - break; - case 'd': case 'D': - if (flags & dir_subst_fatal) { - dTHX; - - to = dllname2buffer(aTHX_ b, bl); - } else { /* No Perl present yet */ - HMODULE self = find_myself(); - APIRET rc = DosQueryModuleName(self, bl, b); - - if (rc) - return 0; - to = b - 1; - while (*++to) - if (*to == '\\') - *to = '/'; - to = b; - } - break; - case 'e': case 'E': - if (flags & dir_subst_fatal) { - dTHX; - - to = execname2buffer(b, bl, PL_origargv[0]); - } else - to = execname2buffer(b, bl, NULL); - break; - } - if (!to) - return NULL; - if (strip) { - e = strrchr(to, '/'); - if (!e && (flags & dir_subst_fatal)) - Perl_croak_nocontext("%s: Can't parse EXE/DLL name: '%s'", msg, to); - else if (!e) - return NULL; - *e = 0; - } - s += froml; l -= froml; - if (!l) - return to; - if (!tol) - tol = strlen(to); - - while (l >= 3 && (s[0] == '/' || s[0] == '\\') - && s[1] == '.' && s[2] == '.' - && (l == 3 || s[3] == '/' || s[3] == '\\' || s[3] == ';')) { - e = strrchr(b, '/'); - if (!e && (flags & dir_subst_fatal)) - Perl_croak_nocontext("%s: Error stripping dirs from EXE/DLL/INSTALLDIR name", msg); - else if (!e) - return NULL; - *e = 0; - l -= 3; s += 3; - } - if (l && s[0] != '/' && s[0] != '\\' && s[0] != ';') - *e++ = '/'; - } + switch (s[1]) { + case 'i': case 'I': + from = "installprefix"; break; + case 'd': case 'D': + from = "dll"; break; + case 'e': case 'E': + from = "exe"; break; + default: + from = NULL; + froml = l + 1; /* Will not match */ + break; + } + if (from) + froml = strlen(from) + 1; + if (l >= froml && strnicmp(s + 2, from + 1, froml - 2) == 0) { + int strip = 1; + + switch (s[1]) { + case 'i': case 'I': + strip = 0; + tol = strlen(INSTALL_PREFIX); + if (tol >= bl) { + if (flags & dir_subst_fatal) + Perl_croak_nocontext("INSTALL_PREFIX too long: `%s'", INSTALL_PREFIX); + else + return NULL; + } + memcpy(b, INSTALL_PREFIX, tol + 1); + to = b; + e = b + tol; + break; + case 'd': case 'D': + if (flags & dir_subst_fatal) { + dTHX; + + to = dllname2buffer(aTHX_ b, bl); + } else { /* No Perl present yet */ + HMODULE self = find_myself(); + APIRET rc = DosQueryModuleName(self, bl, b); + + if (rc) + return 0; + to = b - 1; + while (*++to) + if (*to == '\\') + *to = '/'; + to = b; + } + break; + case 'e': case 'E': + if (flags & dir_subst_fatal) { + dTHX; + + to = execname2buffer(b, bl, PL_origargv[0]); + } else + to = execname2buffer(b, bl, NULL); + break; + } + if (!to) + return NULL; + if (strip) { + e = strrchr(to, '/'); + if (!e && (flags & dir_subst_fatal)) + Perl_croak_nocontext("%s: Can't parse EXE/DLL name: '%s'", msg, to); + else if (!e) + return NULL; + *e = 0; + } + s += froml; l -= froml; + if (!l) + return to; + if (!tol) + tol = strlen(to); + + while (l >= 3 && (s[0] == '/' || s[0] == '\\') + && s[1] == '.' && s[2] == '.' + && (l == 3 || s[3] == '/' || s[3] == '\\' || s[3] == ';')) { + e = strrchr(b, '/'); + if (!e && (flags & dir_subst_fatal)) + Perl_croak_nocontext("%s: Error stripping dirs from EXE/DLL/INSTALLDIR name", msg); + else if (!e) + return NULL; + *e = 0; + l -= 3; s += 3; + } + if (l && s[0] != '/' && s[0] != '\\' && s[0] != ';') + *e++ = '/'; + } } /* Else: copy as is */ if (l && (flags & dir_subst_pathlike)) { - STRLEN i = 0; - - while ( i < l - 2 && s[i] != ';') /* May have ~char after `;' */ - i++; - if (i < l - 2) { /* Found */ - rest = l - i - 1; - l = i + 1; - } + STRLEN i = 0; + + while ( i < l - 2 && s[i] != ';') /* May have ~char after `;' */ + i++; + if (i < l - 2) { /* Found */ + rest = l - i - 1; + l = i + 1; + } } if (e + l >= b + bl) { - if (flags & dir_subst_fatal) - Perl_croak_nocontext("%s: name `%s%s' too long", msg, b, s); - else - return NULL; + if (flags & dir_subst_fatal) + Perl_croak_nocontext("%s: name `%s%s' too long", msg, b, s); + else + return NULL; } memcpy(e, s, l); if (rest) { - e = dir_subst(s + l, rest, e + l, bl - (e + l - b), flags, msg); - return e ? b : e; + e = dir_subst(s + l, rest, e + l, bl - (e + l - b), flags, msg); + return e ? b : e; } e[l] = 0; return b; @@ -2389,15 +2389,15 @@ char * perllib_mangle_with(char *s, unsigned int l, char *from, unsigned int froml, char *to, unsigned int tol) { if (!to) - return s; + return s; if (l == 0) - l = strlen(s); + l = strlen(s); if (l < froml || strnicmp(from, s, froml) != 0) - return s; + return s; if (l + tol - froml > STATIC_FILE_LENGTH || tol > STATIC_FILE_LENGTH) - Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); + Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); if (to && to != mangle_ret) - memcpy(mangle_ret, to, tol); + memcpy(mangle_ret, to, tol); strcpy(mangle_ret + tol, s + froml); return mangle_ret; } @@ -2408,44 +2408,44 @@ perllib_mangle(char *s, unsigned int l) char *name; if (perllib_mangle_installed && (name = perllib_mangle_installed(s,l))) - return name; + return name; if (!newp && !notfound) { - newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) - STRINGIFY(PERL_VERSION) STRINGIFY(PERL_SUBVERSION) - "_PREFIX"); - if (!newp) - newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) - STRINGIFY(PERL_VERSION) "_PREFIX"); - if (!newp) - newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) "_PREFIX"); - if (!newp) - newp = PerlEnv_getenv(name = "PERLLIB_PREFIX"); - if (newp) { - char *s, b[300]; - - oldp = newp; - while (*newp && !isSPACE(*newp) && *newp != ';') - newp++; /* Skip old name. */ - oldl = newp - oldp; - s = dir_subst(oldp, oldl, b, sizeof b, dir_subst_fatal, name); - oldp = savepv(s); - oldl = strlen(s); - while (*newp && (isSPACE(*newp) || *newp == ';')) - newp++; /* Skip whitespace. */ - Perl_OS2_handler_install((void *)newp, Perlos2_handler_perllib_to); - if (newl == 0 || oldl == 0) - Perl_croak_nocontext("Malformed %s", name); - } else - notfound = 1; + newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) + STRINGIFY(PERL_VERSION) STRINGIFY(PERL_SUBVERSION) + "_PREFIX"); + if (!newp) + newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) + STRINGIFY(PERL_VERSION) "_PREFIX"); + if (!newp) + newp = PerlEnv_getenv(name = "PERLLIB_" STRINGIFY(PERL_REVISION) "_PREFIX"); + if (!newp) + newp = PerlEnv_getenv(name = "PERLLIB_PREFIX"); + if (newp) { + char *s, b[300]; + + oldp = newp; + while (*newp && !isSPACE(*newp) && *newp != ';') + newp++; /* Skip old name. */ + oldl = newp - oldp; + s = dir_subst(oldp, oldl, b, sizeof b, dir_subst_fatal, name); + oldp = savepv(s); + oldl = strlen(s); + while (*newp && (isSPACE(*newp) || *newp == ';')) + newp++; /* Skip whitespace. */ + Perl_OS2_handler_install((void *)newp, Perlos2_handler_perllib_to); + if (newl == 0 || oldl == 0) + Perl_croak_nocontext("Malformed %s", name); + } else + notfound = 1; } if (!newp) - return s; + return s; if (l == 0) - l = strlen(s); + l = strlen(s); if (l < oldl || strnicmp(oldp, s, oldl) != 0) - return s; + return s; if (l + newl - oldl > STATIC_FILE_LENGTH || newl > STATIC_FILE_LENGTH) - Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); + Perl_croak_nocontext("Malformed PERLLIB_PREFIX"); strcpy(mangle_ret + newl, s + oldl); return mangle_ret; } @@ -2465,15 +2465,15 @@ Create_HMQ(int serve, char *message) /* Assumes morphing */ /* 64 messages if before OS/2 3.0, ignored otherwise */ Perl_hmq = (*PMWIN_entries.CreateMsgQueue)(perl_hab_GET(), 64); if (!Perl_hmq) { - dTHX; + dTHX; - SAVEINT(rmq_cnt); /* Allow catch()ing. */ - if (rmq_cnt++) - _exit(188); /* Panic can try to create a window. */ - CroakWinError(1, message ? message : "Cannot create a message queue"); + SAVEINT(rmq_cnt); /* Allow catch()ing. */ + if (rmq_cnt++) + _exit(188); /* Panic can try to create a window. */ + CroakWinError(1, message ? message : "Cannot create a message queue"); } if (serve != -1) - (*PMWIN_entries.CancelShutdown)(Perl_hmq, !serve); + (*PMWIN_entries.CancelShutdown)(Perl_hmq, !serve); /* We may have loaded some modules */ _control87(fpflag, MCW_EM); /* Some modules reset FP flags on (un)load */ } @@ -2491,28 +2491,28 @@ Perl_Register_MQ(int serve) Perl_hmq_refcnt = 0; /* Be extra safe */ DosGetInfoBlocks(&tib, &pib); if (!Perl_morph_refcnt) { - Perl_os2_initial_mode = pib->pib_ultype; - /* Try morphing into a PM application. */ - if (pib->pib_ultype != 3) /* 2 is VIO */ - pib->pib_ultype = 3; /* 3 is PM */ + Perl_os2_initial_mode = pib->pib_ultype; + /* Try morphing into a PM application. */ + if (pib->pib_ultype != 3) /* 2 is VIO */ + pib->pib_ultype = 3; /* 3 is PM */ } Create_HMQ(-1, /* We do CancelShutdown ourselves */ - "Cannot create a message queue, or morph to a PM application"); + "Cannot create a message queue, or morph to a PM application"); if ((serve & REGISTERMQ_IMEDIATE_UNMORPH)) { - if (!Perl_morph_refcnt && Perl_os2_initial_mode != 3) - pib->pib_ultype = Perl_os2_initial_mode; + if (!Perl_morph_refcnt && Perl_os2_initial_mode != 3) + pib->pib_ultype = Perl_os2_initial_mode; } } if (serve & REGISTERMQ_WILL_SERVE) { - if ( Perl_hmq_servers <= 0 /* Safe to inform us on shutdown, */ - && Perl_hmq_refcnt > 0 ) /* this was switched off before... */ - (*PMWIN_entries.CancelShutdown)(Perl_hmq, 0); - Perl_hmq_servers++; + if ( Perl_hmq_servers <= 0 /* Safe to inform us on shutdown, */ + && Perl_hmq_refcnt > 0 ) /* this was switched off before... */ + (*PMWIN_entries.CancelShutdown)(Perl_hmq, 0); + Perl_hmq_servers++; } else if (!Perl_hmq_servers) /* Do not inform us on shutdown */ - (*PMWIN_entries.CancelShutdown)(Perl_hmq, 1); + (*PMWIN_entries.CancelShutdown)(Perl_hmq, 1); Perl_hmq_refcnt++; if (!(serve & REGISTERMQ_IMEDIATE_UNMORPH)) - Perl_morph_refcnt++; + Perl_morph_refcnt++; return Perl_hmq; } @@ -2523,14 +2523,14 @@ Perl_Serve_Messages(int force) QMSG msg; if (Perl_hmq_servers > 0 && !force) - return 0; + return 0; if (Perl_hmq_refcnt <= 0) - Perl_croak_nocontext("No message queue"); + Perl_croak_nocontext("No message queue"); while ((*PMWIN_entries.PeekMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0, PM_REMOVE)) { - cnt++; - if (msg.msg == WM_QUIT) - Perl_croak_nocontext("QUITing..."); - (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); + cnt++; + if (msg.msg == WM_QUIT) + Perl_croak_nocontext("QUITing..."); + (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); } return cnt; } @@ -2541,17 +2541,17 @@ Perl_Process_Messages(int force, I32 *cntp) QMSG msg; if (Perl_hmq_servers > 0 && !force) - return 0; + return 0; if (Perl_hmq_refcnt <= 0) - Perl_croak_nocontext("No message queue"); + Perl_croak_nocontext("No message queue"); while ((*PMWIN_entries.GetMsg)(Perl_hab, &msg, NULLHANDLE, 0, 0)) { - if (cntp) - (*cntp)++; - (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); - if (msg.msg == WM_DESTROY) - return -1; - if (msg.msg == WM_CREATE) - return +1; + if (cntp) + (*cntp)++; + (*PMWIN_entries.DispatchMsg)(Perl_hab, &msg); + if (msg.msg == WM_DESTROY) + return -1; + if (msg.msg == WM_CREATE) + return +1; } Perl_croak_nocontext("QUITing..."); } @@ -2560,34 +2560,34 @@ void Perl_Deregister_MQ(int serve) { if (serve & REGISTERMQ_WILL_SERVE) - Perl_hmq_servers--; + Perl_hmq_servers--; if (--Perl_hmq_refcnt <= 0) { - unsigned fpflag = _control87(0,0); + unsigned fpflag = _control87(0,0); - init_PMWIN_entries(); /* To be extra safe */ - (*PMWIN_entries.DestroyMsgQueue)(Perl_hmq); - Perl_hmq = 0; - /* We may have (un)loaded some modules */ - _control87(fpflag, MCW_EM); /* Some modules reset FP flags on (un)load */ + init_PMWIN_entries(); /* To be extra safe */ + (*PMWIN_entries.DestroyMsgQueue)(Perl_hmq); + Perl_hmq = 0; + /* We may have (un)loaded some modules */ + _control87(fpflag, MCW_EM); /* Some modules reset FP flags on (un)load */ } else if ((serve & REGISTERMQ_WILL_SERVE) && Perl_hmq_servers <= 0) - (*PMWIN_entries.CancelShutdown)(Perl_hmq, 1); /* Last server exited */ + (*PMWIN_entries.CancelShutdown)(Perl_hmq, 1); /* Last server exited */ if (!(serve & REGISTERMQ_IMEDIATE_UNMORPH) && (--Perl_morph_refcnt <= 0)) { - /* Try morphing back from a PM application. */ - PPIB pib; - PTIB tib; - - DosGetInfoBlocks(&tib, &pib); - if (pib->pib_ultype == 3) /* 3 is PM */ - pib->pib_ultype = Perl_os2_initial_mode; - else - Perl_warn_nocontext("Unexpected program mode %d when morphing back from PM", - pib->pib_ultype); + /* Try morphing back from a PM application. */ + PPIB pib; + PTIB tib; + + DosGetInfoBlocks(&tib, &pib); + if (pib->pib_ultype == 3) /* 3 is PM */ + pib->pib_ultype = Perl_os2_initial_mode; + else + Perl_warn_nocontext("Unexpected program mode %d when morphing back from PM", + pib->pib_ultype); } } #define sys_is_absolute(path) ( isALPHA((path)[0]) && (path)[1] == ':' \ - && ((path)[2] == '/' || (path)[2] == '\\')) + && ((path)[2] == '/' || (path)[2] == '\\')) #define sys_is_rooted _fnisabs #define sys_is_relative _fnisrel #define current_drive _getdrive @@ -2600,21 +2600,21 @@ XS(XS_OS2_Error) { dXSARGS; if (items != 2) - Perl_croak_nocontext("Usage: OS2::Error(harderr, exception)"); + Perl_croak_nocontext("Usage: OS2::Error(harderr, exception)"); { - int arg1 = SvIV(ST(0)); - int arg2 = SvIV(ST(1)); - int a = ((arg1 ? FERR_ENABLEHARDERR : FERR_DISABLEHARDERR) - | (arg2 ? FERR_ENABLEEXCEPTION : FERR_DISABLEEXCEPTION)); - int RETVAL = ((arg1 ? 1 : 0) | (arg2 ? 2 : 0)); - unsigned long rc; - - if (CheckOSError(DosError(a))) - Perl_croak_nocontext("DosError(%d) failed: %s", a, os2error(Perl_rc)); - ST(0) = sv_newmortal(); - if (DOS_harderr_state >= 0) - sv_setiv(ST(0), DOS_harderr_state); - DOS_harderr_state = RETVAL; + int arg1 = SvIV(ST(0)); + int arg2 = SvIV(ST(1)); + int a = ((arg1 ? FERR_ENABLEHARDERR : FERR_DISABLEHARDERR) + | (arg2 ? FERR_ENABLEEXCEPTION : FERR_DISABLEEXCEPTION)); + int RETVAL = ((arg1 ? 1 : 0) | (arg2 ? 2 : 0)); + unsigned long rc; + + if (CheckOSError(DosError(a))) + Perl_croak_nocontext("DosError(%d) failed: %s", a, os2error(Perl_rc)); + ST(0) = sv_newmortal(); + if (DOS_harderr_state >= 0) + sv_setiv(ST(0), DOS_harderr_state); + DOS_harderr_state = RETVAL; } XSRETURN(1); } @@ -2623,29 +2623,29 @@ XS(XS_OS2_Errors2Drive) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: OS2::Errors2Drive(drive)"); + Perl_croak_nocontext("Usage: OS2::Errors2Drive(drive)"); { - STRLEN n_a; - SV *sv = ST(0); - int suppress = SvOK(sv); - char *s = suppress ? SvPV(sv, n_a) : NULL; - char drive = (s ? *s : 0); - unsigned long rc; - - if (suppress && !isALPHA(drive)) - Perl_croak_nocontext("Non-char argument '%c' to OS2::Errors2Drive()", drive); - if (CheckOSError(DosSuppressPopUps((suppress - ? SPU_ENABLESUPPRESSION - : SPU_DISABLESUPPRESSION), - drive))) - Perl_croak_nocontext("DosSuppressPopUps(%c) failed: %s", drive, - os2error(Perl_rc)); - ST(0) = sv_newmortal(); - if (DOS_suppression_state > 0) - sv_setpvn(ST(0), &DOS_suppression_state, 1); - else if (DOS_suppression_state == 0) + STRLEN n_a; + SV *sv = ST(0); + int suppress = SvOK(sv); + char *s = suppress ? SvPV(sv, n_a) : NULL; + char drive = (s ? *s : 0); + unsigned long rc; + + if (suppress && !isALPHA(drive)) + Perl_croak_nocontext("Non-char argument '%c' to OS2::Errors2Drive()", drive); + if (CheckOSError(DosSuppressPopUps((suppress + ? SPU_ENABLESUPPRESSION + : SPU_DISABLESUPPRESSION), + drive))) + Perl_croak_nocontext("DosSuppressPopUps(%c) failed: %s", drive, + os2error(Perl_rc)); + ST(0) = sv_newmortal(); + if (DOS_suppression_state > 0) + sv_setpvn(ST(0), &DOS_suppression_state, 1); + else if (DOS_suppression_state == 0) SvPVCLEAR(ST(0)); - DOS_suppression_state = drive; + DOS_suppression_state = drive; } XSRETURN(1); } @@ -2668,49 +2668,49 @@ async_mssleep(ULONG ms, int switch_priority) { return !_sleep2(ms); os2cp_croak(DosCreateEventSem(NULL, /* Unnamed */ - &hevEvent1, /* Handle of semaphore returned */ - DC_SEM_SHARED, /* Shared needed for DosAsyncTimer */ - FALSE), /* Semaphore is in RESET state */ - "DosCreateEventSem"); + &hevEvent1, /* Handle of semaphore returned */ + DC_SEM_SHARED, /* Shared needed for DosAsyncTimer */ + FALSE), /* Semaphore is in RESET state */ + "DosCreateEventSem"); if (ms >= switch_priority) switch_priority = 0; if (switch_priority) { if (CheckOSError(DosGetInfoBlocks(&tib, &pib))) - switch_priority = 0; + switch_priority = 0; else { - /* In Warp3, to switch scheduling to 8ms step, one needs to do - DosAsyncTimer() in time-critical thread. On laters versions, - more and more cases of wait-for-something are covered. - - It turns out that on Warp3fp42 it is the priority at the time - of DosAsyncTimer() which matters. Let's hope that this works - with later versions too... XXXX - */ - priority = (tib->tib_ptib2->tib2_ulpri); - if ((priority & 0xFF00) == 0x0300) /* already time-critical */ - switch_priority = 0; - /* Make us time-critical. Just modifying TIB is not enough... */ - /* tib->tib_ptib2->tib2_ulpri = 0x0300;*/ - /* We do not want to run at high priority if a signal causes us - to longjmp() out of this section... */ - if (DosEnterMustComplete(&nesting)) - switch_priority = 0; - else - DosSetPriority(PRTYS_THREAD, PRTYC_TIMECRITICAL, 0, 0); + /* In Warp3, to switch scheduling to 8ms step, one needs to do + DosAsyncTimer() in time-critical thread. On laters versions, + more and more cases of wait-for-something are covered. + + It turns out that on Warp3fp42 it is the priority at the time + of DosAsyncTimer() which matters. Let's hope that this works + with later versions too... XXXX + */ + priority = (tib->tib_ptib2->tib2_ulpri); + if ((priority & 0xFF00) == 0x0300) /* already time-critical */ + switch_priority = 0; + /* Make us time-critical. Just modifying TIB is not enough... */ + /* tib->tib_ptib2->tib2_ulpri = 0x0300;*/ + /* We do not want to run at high priority if a signal causes us + to longjmp() out of this section... */ + if (DosEnterMustComplete(&nesting)) + switch_priority = 0; + else + DosSetPriority(PRTYS_THREAD, PRTYC_TIMECRITICAL, 0, 0); } } if ((badrc = DosAsyncTimer(ms, - (HSEM) hevEvent1, /* Semaphore to post */ - &htimerEvent1))) /* Timer handler (returned) */ + (HSEM) hevEvent1, /* Semaphore to post */ + &htimerEvent1))) /* Timer handler (returned) */ e = "DosAsyncTimer"; if (switch_priority && tib->tib_ptib2->tib2_ulpri == 0x0300) { - /* Nobody switched priority while we slept... Ignore errors... */ - /* tib->tib_ptib2->tib2_ulpri = priority; */ /* Get back... */ - if (!(rc = DosSetPriority(PRTYS_THREAD, (priority>>8) & 0xFF, 0, 0))) - rc = DosSetPriority(PRTYS_THREAD, 0, priority & 0xFF, 0); + /* Nobody switched priority while we slept... Ignore errors... */ + /* tib->tib_ptib2->tib2_ulpri = priority; */ /* Get back... */ + if (!(rc = DosSetPriority(PRTYS_THREAD, (priority>>8) & 0xFF, 0, 0))) + rc = DosSetPriority(PRTYS_THREAD, 0, priority & 0xFF, 0); } if (switch_priority) rc = DosExitMustComplete(&nesting); /* Ignore errors */ @@ -2742,7 +2742,7 @@ XS(XS_OS2_ms_sleep) /* for testing only... */ ULONG ms, lim; if (items > 2 || items < 1) - Perl_croak_nocontext("Usage: OS2::ms_sleep(wait_ms [, high_priority_limit])"); + Perl_croak_nocontext("Usage: OS2::ms_sleep(wait_ms [, high_priority_limit])"); ms = SvUV(ST(0)); lim = items > 1 ? SvUV(ST(1)) : ms + 1; async_mssleep(ms, lim); @@ -2760,22 +2760,22 @@ XS(XS_OS2_Timer) ULONG rc; if (items != 0) - Perl_croak_nocontext("Usage: OS2::Timer()"); + Perl_croak_nocontext("Usage: OS2::Timer()"); if (!freq) { - *(PFN*)&pDosTmrQueryFreq = loadByOrdinal(ORD_DosTmrQueryFreq, 0); - *(PFN*)&pDosTmrQueryTime = loadByOrdinal(ORD_DosTmrQueryTime, 0); - MUTEX_LOCK(&perlos2_state_mutex); - if (!freq) - if (CheckOSError(pDosTmrQueryFreq(&freq))) - croak_with_os2error("DosTmrQueryFreq"); - MUTEX_UNLOCK(&perlos2_state_mutex); + *(PFN*)&pDosTmrQueryFreq = loadByOrdinal(ORD_DosTmrQueryFreq, 0); + *(PFN*)&pDosTmrQueryTime = loadByOrdinal(ORD_DosTmrQueryTime, 0); + MUTEX_LOCK(&perlos2_state_mutex); + if (!freq) + if (CheckOSError(pDosTmrQueryFreq(&freq))) + croak_with_os2error("DosTmrQueryFreq"); + MUTEX_UNLOCK(&perlos2_state_mutex); } if (CheckOSError(pDosTmrQueryTime(&count))) - croak_with_os2error("DosTmrQueryTime"); + croak_with_os2error("DosTmrQueryTime"); { - dXSTARG; + dXSTARG; - XSprePUSH; PUSHn(((NV)count)/freq); + XSprePUSH; PUSHn(((NV)count)/freq); } XSRETURN(1); } @@ -2785,11 +2785,11 @@ XS(XS_OS2_msCounter) dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: OS2::msCounter()"); + Perl_croak_nocontext("Usage: OS2::msCounter()"); { - dXSTARG; + dXSTARG; - XSprePUSH; PUSHu(msCounter()); + XSprePUSH; PUSHu(msCounter()); } XSRETURN(1); } @@ -2800,13 +2800,13 @@ XS(XS_OS2__InfoTable) int is_local = 0; if (items > 1) - Perl_croak_nocontext("Usage: OS2::_infoTable([isLocal])"); + Perl_croak_nocontext("Usage: OS2::_infoTable([isLocal])"); if (items == 1) - is_local = (int)SvIV(ST(0)); + is_local = (int)SvIV(ST(0)); { - dXSTARG; + dXSTARG; - XSprePUSH; PUSHu(InfoTable(is_local)); + XSprePUSH; PUSHu(InfoTable(is_local)); } XSRETURN(1); } @@ -2871,76 +2871,76 @@ XS(XS_OS2_DevCap) { dXSARGS; if (items > 2) - Perl_croak_nocontext("Usage: OS2::DevCap()"); + Perl_croak_nocontext("Usage: OS2::DevCap()"); { - /* Device Capabilities Data Buffer (10 extra w.r.t. Warp 4.5) */ - LONG si[CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1]; - int i = 0, j = 0, how = DevCap_dc; - HDC hScreenDC; - DEVOPENSTRUC doStruc= {0L, (PSZ)"DISPLAY", NULL, 0L, 0L, 0L, 0L, 0L, 0L}; - ULONG rc1 = NO_ERROR; - HWND hwnd; - static volatile int devcap_loaded; - - if (!devcap_loaded) { - *(PFN*)&pWinOpenWindowDC = loadByOrdinal(ORD_WinOpenWindowDC, 0); - *(PFN*)&pDevOpenDC = loadByOrdinal(ORD_DevOpenDC, 0); - *(PFN*)&pDevCloseDC = loadByOrdinal(ORD_DevCloseDC, 0); - *(PFN*)&pDevQueryCaps = loadByOrdinal(ORD_DevQueryCaps, 0); - devcap_loaded = 1; - } - - if (items >= 2) - how = SvIV(ST(1)); - if (!items) { /* Get device contents from PM */ - hScreenDC = pDevOpenDC(perl_hab_GET(), OD_MEMORY, (PSZ)"*", 0, - (PDEVOPENDATA)&doStruc, NULLHANDLE); - if (CheckWinError(hScreenDC)) - croak_with_os2error("DevOpenDC() failed"); - } else if (how == DevCap_dc) - hScreenDC = (HDC)SvIV(ST(0)); - else { /* DevCap_hwnd */ - if (!Perl_hmq) - Perl_croak(aTHX_ "Getting a window's device context without a message queue would lock PM"); - hwnd = (HWND)SvIV(ST(0)); - hScreenDC = pWinOpenWindowDC(hwnd); /* No need to DevCloseDC() */ - if (CheckWinError(hScreenDC)) - croak_with_os2error("WinOpenWindowDC() failed"); - } - if (CheckWinError(pDevQueryCaps(hScreenDC, - CAPS_FAMILY, /* W3 documented caps */ - CAPS_DEVICE_POLYSET_POINTS - - CAPS_FAMILY + 1, - si))) - rc1 = Perl_rc; - else { - EXTEND(SP,2*(CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1)); - while (i < CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1) { - ST(j) = sv_newmortal(); - sv_setpv(ST(j++), dc_fields[i]); - ST(j) = sv_newmortal(); - sv_setiv(ST(j++), si[i]); - i++; - } - i = CAPS_DEVICE_POLYSET_POINTS + 1; - while (i < CAPS_DEVICE_POLYSET_POINTS + 11) { /* Just in case... */ - LONG l; - - if (CheckWinError(pDevQueryCaps(hScreenDC, i, 1, &l))) - break; - EXTEND(SP, j + 2); - ST(j) = sv_newmortal(); - sv_setiv(ST(j++), i); - ST(j) = sv_newmortal(); - sv_setiv(ST(j++), l); - i++; - } - } - if (!items && CheckWinError(pDevCloseDC(hScreenDC))) - Perl_warn_nocontext("DevCloseDC() failed: %s", os2error(Perl_rc)); - if (rc1) - Perl_rc = rc1, croak_with_os2error("DevQueryCaps() failed"); - XSRETURN(j); + /* Device Capabilities Data Buffer (10 extra w.r.t. Warp 4.5) */ + LONG si[CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1]; + int i = 0, j = 0, how = DevCap_dc; + HDC hScreenDC; + DEVOPENSTRUC doStruc= {0L, (PSZ)"DISPLAY", NULL, 0L, 0L, 0L, 0L, 0L, 0L}; + ULONG rc1 = NO_ERROR; + HWND hwnd; + static volatile int devcap_loaded; + + if (!devcap_loaded) { + *(PFN*)&pWinOpenWindowDC = loadByOrdinal(ORD_WinOpenWindowDC, 0); + *(PFN*)&pDevOpenDC = loadByOrdinal(ORD_DevOpenDC, 0); + *(PFN*)&pDevCloseDC = loadByOrdinal(ORD_DevCloseDC, 0); + *(PFN*)&pDevQueryCaps = loadByOrdinal(ORD_DevQueryCaps, 0); + devcap_loaded = 1; + } + + if (items >= 2) + how = SvIV(ST(1)); + if (!items) { /* Get device contents from PM */ + hScreenDC = pDevOpenDC(perl_hab_GET(), OD_MEMORY, (PSZ)"*", 0, + (PDEVOPENDATA)&doStruc, NULLHANDLE); + if (CheckWinError(hScreenDC)) + croak_with_os2error("DevOpenDC() failed"); + } else if (how == DevCap_dc) + hScreenDC = (HDC)SvIV(ST(0)); + else { /* DevCap_hwnd */ + if (!Perl_hmq) + Perl_croak(aTHX_ "Getting a window's device context without a message queue would lock PM"); + hwnd = (HWND)SvIV(ST(0)); + hScreenDC = pWinOpenWindowDC(hwnd); /* No need to DevCloseDC() */ + if (CheckWinError(hScreenDC)) + croak_with_os2error("WinOpenWindowDC() failed"); + } + if (CheckWinError(pDevQueryCaps(hScreenDC, + CAPS_FAMILY, /* W3 documented caps */ + CAPS_DEVICE_POLYSET_POINTS + - CAPS_FAMILY + 1, + si))) + rc1 = Perl_rc; + else { + EXTEND(SP,2*(CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1)); + while (i < CAPS_DEVICE_POLYSET_POINTS - CAPS_FAMILY + 1) { + ST(j) = sv_newmortal(); + sv_setpv(ST(j++), dc_fields[i]); + ST(j) = sv_newmortal(); + sv_setiv(ST(j++), si[i]); + i++; + } + i = CAPS_DEVICE_POLYSET_POINTS + 1; + while (i < CAPS_DEVICE_POLYSET_POINTS + 11) { /* Just in case... */ + LONG l; + + if (CheckWinError(pDevQueryCaps(hScreenDC, i, 1, &l))) + break; + EXTEND(SP, j + 2); + ST(j) = sv_newmortal(); + sv_setiv(ST(j++), i); + ST(j) = sv_newmortal(); + sv_setiv(ST(j++), l); + i++; + } + } + if (!items && CheckWinError(pDevCloseDC(hScreenDC))) + Perl_warn_nocontext("DevCloseDC() failed: %s", os2error(Perl_rc)); + if (rc1) + Perl_rc = rc1, croak_with_os2error("DevQueryCaps() failed"); + XSRETURN(j); } } @@ -3057,64 +3057,64 @@ const char * const sv_keys[] = { "106", "107", /* "CSYSVALUES",*/ - /* In recent DDK the limit is 108 */ + /* In recent DDK the limit is 108 */ }; XS(XS_OS2_SysValues) { dXSARGS; if (items > 2) - Perl_croak_nocontext("Usage: OS2::SysValues(which = -1, hwndDesktop = HWND_DESKTOP)"); + Perl_croak_nocontext("Usage: OS2::SysValues(which = -1, hwndDesktop = HWND_DESKTOP)"); { - int i = 0, j = 0, which = -1; - HWND hwnd = HWND_DESKTOP; - static volatile int sv_loaded; - LONG RETVAL; - - if (!sv_loaded) { - *(PFN*)&pWinQuerySysValue = loadByOrdinal(ORD_WinQuerySysValue, 0); - sv_loaded = 1; - } - - if (items == 2) - hwnd = (HWND)SvIV(ST(1)); - if (items >= 1) - which = (int)SvIV(ST(0)); - if (which == -1) { - EXTEND(SP,2*C_ARRAY_LENGTH(sv_keys)); - while (i < C_ARRAY_LENGTH(sv_keys)) { - ResetWinError(); - RETVAL = pWinQuerySysValue(hwnd, i); - if ( !RETVAL - && !(sv_keys[i][0] >= '0' && sv_keys[i][0] <= '9' - && i <= SV_PRINTSCREEN) ) { - FillWinError; - if (Perl_rc) { - if (i > SV_PRINTSCREEN) - break; /* May be not present on older systems */ - croak_with_os2error("SysValues():"); - } - - } - ST(j) = sv_newmortal(); - sv_setpv(ST(j++), sv_keys[i]); - ST(j) = sv_newmortal(); - sv_setiv(ST(j++), RETVAL); - i++; - } - XSRETURN(2 * i); - } else { - dXSTARG; - - ResetWinError(); - RETVAL = pWinQuerySysValue(hwnd, which); - if (!RETVAL) { - FillWinError; - if (Perl_rc) - croak_with_os2error("SysValues():"); - } - XSprePUSH; PUSHi((IV)RETVAL); - } + int i = 0, j = 0, which = -1; + HWND hwnd = HWND_DESKTOP; + static volatile int sv_loaded; + LONG RETVAL; + + if (!sv_loaded) { + *(PFN*)&pWinQuerySysValue = loadByOrdinal(ORD_WinQuerySysValue, 0); + sv_loaded = 1; + } + + if (items == 2) + hwnd = (HWND)SvIV(ST(1)); + if (items >= 1) + which = (int)SvIV(ST(0)); + if (which == -1) { + EXTEND(SP,2*C_ARRAY_LENGTH(sv_keys)); + while (i < C_ARRAY_LENGTH(sv_keys)) { + ResetWinError(); + RETVAL = pWinQuerySysValue(hwnd, i); + if ( !RETVAL + && !(sv_keys[i][0] >= '0' && sv_keys[i][0] <= '9' + && i <= SV_PRINTSCREEN) ) { + FillWinError; + if (Perl_rc) { + if (i > SV_PRINTSCREEN) + break; /* May be not present on older systems */ + croak_with_os2error("SysValues():"); + } + + } + ST(j) = sv_newmortal(); + sv_setpv(ST(j++), sv_keys[i]); + ST(j) = sv_newmortal(); + sv_setiv(ST(j++), RETVAL); + i++; + } + XSRETURN(2 * i); + } else { + dXSTARG; + + ResetWinError(); + RETVAL = pWinQuerySysValue(hwnd, which); + if (!RETVAL) { + FillWinError; + if (Perl_rc) + croak_with_os2error("SysValues():"); + } + XSprePUSH; PUSHi((IV)RETVAL); + } } } @@ -3122,22 +3122,22 @@ XS(XS_OS2_SysValues_set) { dXSARGS; if (items < 2 || items > 3) - Perl_croak_nocontext("Usage: OS2::SysValues_set(which, val, hwndDesktop = HWND_DESKTOP)"); + Perl_croak_nocontext("Usage: OS2::SysValues_set(which, val, hwndDesktop = HWND_DESKTOP)"); { - int which = (int)SvIV(ST(0)); - LONG val = (LONG)SvIV(ST(1)); - HWND hwnd = HWND_DESKTOP; - static volatile int svs_loaded; - - if (!svs_loaded) { - *(PFN*)&pWinSetSysValue = loadByOrdinal(ORD_WinSetSysValue, 0); - svs_loaded = 1; - } - - if (items == 3) - hwnd = (HWND)SvIV(ST(2)); - if (CheckWinError(pWinSetSysValue(hwnd, which, val))) - croak_with_os2error("SysValues_set()"); + int which = (int)SvIV(ST(0)); + LONG val = (LONG)SvIV(ST(1)); + HWND hwnd = HWND_DESKTOP; + static volatile int svs_loaded; + + if (!svs_loaded) { + *(PFN*)&pWinSetSysValue = loadByOrdinal(ORD_WinSetSysValue, 0); + svs_loaded = 1; + } + + if (items == 3) + hwnd = (HWND)SvIV(ST(2)); + if (CheckWinError(pWinSetSysValue(hwnd, which, val))) + croak_with_os2error("SysValues_set()"); } XSRETURN_YES; } @@ -3182,40 +3182,40 @@ XS(XS_OS2_SysInfo) { dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: OS2::SysInfo()"); + Perl_croak_nocontext("Usage: OS2::SysInfo()"); { - /* System Information Data Buffer (10 extra w.r.t. Warp 4.5) */ - ULONG si[C_ARRAY_LENGTH(si_fields) + 10]; - APIRET rc = NO_ERROR; /* Return code */ - int i = 0, j = 0, last = QSV_MAX_WARP3; - - if (CheckOSError(DosQuerySysInfo(1L, /* Request documented system */ - last, /* info for Warp 3 */ - (PVOID)si, - sizeof(si)))) - croak_with_os2error("DosQuerySysInfo() failed"); - while (++last <= C_ARRAY_LENGTH(si)) { - if (CheckOSError(DosQuerySysInfo(last, last, /* One entry only */ - (PVOID)(si+last-1), - sizeof(*si)))) { - if (Perl_rc != ERROR_INVALID_PARAMETER) - croak_with_os2error("DosQuerySysInfo() failed"); - break; - } - } - last--; /* Count of successfully processed offsets */ - EXTEND(SP,2*last); - while (i < last) { - ST(j) = sv_newmortal(); - if (i < C_ARRAY_LENGTH(si_fields)) - sv_setpv(ST(j++), si_fields[i]); - else - sv_setiv(ST(j++), i + 1); - ST(j) = sv_newmortal(); - sv_setuv(ST(j++), si[i]); - i++; - } - XSRETURN(2 * last); + /* System Information Data Buffer (10 extra w.r.t. Warp 4.5) */ + ULONG si[C_ARRAY_LENGTH(si_fields) + 10]; + APIRET rc = NO_ERROR; /* Return code */ + int i = 0, j = 0, last = QSV_MAX_WARP3; + + if (CheckOSError(DosQuerySysInfo(1L, /* Request documented system */ + last, /* info for Warp 3 */ + (PVOID)si, + sizeof(si)))) + croak_with_os2error("DosQuerySysInfo() failed"); + while (++last <= C_ARRAY_LENGTH(si)) { + if (CheckOSError(DosQuerySysInfo(last, last, /* One entry only */ + (PVOID)(si+last-1), + sizeof(*si)))) { + if (Perl_rc != ERROR_INVALID_PARAMETER) + croak_with_os2error("DosQuerySysInfo() failed"); + break; + } + } + last--; /* Count of successfully processed offsets */ + EXTEND(SP,2*last); + while (i < last) { + ST(j) = sv_newmortal(); + if (i < C_ARRAY_LENGTH(si_fields)) + sv_setpv(ST(j++), si_fields[i]); + else + sv_setiv(ST(j++), i + 1); + ST(j) = sv_newmortal(); + sv_setuv(ST(j++), si[i]); + i++; + } + XSRETURN(2 * last); } } @@ -3225,27 +3225,27 @@ XS(XS_OS2_SysInfoFor) int count = (items == 2 ? (int)SvIV(ST(1)) : 1); if (items < 1 || items > 2) - Perl_croak_nocontext("Usage: OS2::SysInfoFor(id[,count])"); + Perl_croak_nocontext("Usage: OS2::SysInfoFor(id[,count])"); { - /* System Information Data Buffer (10 extra w.r.t. Warp 4.5) */ - ULONG si[C_ARRAY_LENGTH(si_fields) + 10]; - APIRET rc = NO_ERROR; /* Return code */ - int i = 0; - int start = (int)SvIV(ST(0)); - - if (count > C_ARRAY_LENGTH(si) || count <= 0) - Perl_croak(aTHX_ "unexpected count %d for OS2::SysInfoFor()", count); - if (CheckOSError(DosQuerySysInfo(start, - start + count - 1, - (PVOID)si, - sizeof(si)))) - croak_with_os2error("DosQuerySysInfo() failed"); - EXTEND(SP,count); - while (i < count) { - ST(i) = sv_newmortal(); - sv_setiv(ST(i), si[i]); - i++; - } + /* System Information Data Buffer (10 extra w.r.t. Warp 4.5) */ + ULONG si[C_ARRAY_LENGTH(si_fields) + 10]; + APIRET rc = NO_ERROR; /* Return code */ + int i = 0; + int start = (int)SvIV(ST(0)); + + if (count > C_ARRAY_LENGTH(si) || count <= 0) + Perl_croak(aTHX_ "unexpected count %d for OS2::SysInfoFor()", count); + if (CheckOSError(DosQuerySysInfo(start, + start + count - 1, + (PVOID)si, + sizeof(si)))) + croak_with_os2error("DosQuerySysInfo() failed"); + EXTEND(SP,count); + while (i < count) { + ST(i) = sv_newmortal(); + sv_setiv(ST(i), si[i]); + i++; + } } XSRETURN(count); } @@ -3254,19 +3254,19 @@ XS(XS_OS2_BootDrive) { dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: OS2::BootDrive()"); + Perl_croak_nocontext("Usage: OS2::BootDrive()"); { - ULONG si[1] = {0}; /* System Information Data Buffer */ - APIRET rc = NO_ERROR; /* Return code */ - char c; - dXSTARG; - - if (CheckOSError(DosQuerySysInfo(QSV_BOOT_DRIVE, QSV_BOOT_DRIVE, - (PVOID)si, sizeof(si)))) - croak_with_os2error("DosQuerySysInfo() failed"); - c = 'a' - 1 + si[0]; - sv_setpvn(TARG, &c, 1); - XSprePUSH; PUSHTARG; + ULONG si[1] = {0}; /* System Information Data Buffer */ + APIRET rc = NO_ERROR; /* Return code */ + char c; + dXSTARG; + + if (CheckOSError(DosQuerySysInfo(QSV_BOOT_DRIVE, QSV_BOOT_DRIVE, + (PVOID)si, sizeof(si)))) + croak_with_os2error("DosQuerySysInfo() failed"); + c = 'a' - 1 + si[0]; + sv_setpvn(TARG, &c, 1); + XSprePUSH; PUSHTARG; } XSRETURN(1); } @@ -3275,14 +3275,14 @@ XS(XS_OS2_Beep) { dXSARGS; if (items > 2) /* Defaults as for WinAlarm(ERROR) */ - Perl_croak_nocontext("Usage: OS2::Beep(freq = 440, ms = 100)"); + Perl_croak_nocontext("Usage: OS2::Beep(freq = 440, ms = 100)"); { - ULONG freq = (items > 0 ? (ULONG)SvUV(ST(0)) : 440); - ULONG ms = (items > 1 ? (ULONG)SvUV(ST(1)) : 100); - ULONG rc; + ULONG freq = (items > 0 ? (ULONG)SvUV(ST(0)) : 440); + ULONG ms = (items > 1 ? (ULONG)SvUV(ST(1)) : 100); + ULONG rc; - if (CheckOSError(DosBeep(freq, ms))) - croak_with_os2error("SysValues_set()"); + if (CheckOSError(DosBeep(freq, ms))) + croak_with_os2error("SysValues_set()"); } XSRETURN_YES; } @@ -3293,13 +3293,13 @@ XS(XS_OS2_MorphPM) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: OS2::MorphPM(serve)"); + Perl_croak_nocontext("Usage: OS2::MorphPM(serve)"); { - bool serve = SvOK(ST(0)); - unsigned long pmq = perl_hmq_GET(serve); - dXSTARG; + bool serve = SvOK(ST(0)); + unsigned long pmq = perl_hmq_GET(serve); + dXSTARG; - XSprePUSH; PUSHi((IV)pmq); + XSprePUSH; PUSHi((IV)pmq); } XSRETURN(1); } @@ -3308,11 +3308,11 @@ XS(XS_OS2_UnMorphPM) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: OS2::UnMorphPM(serve)"); + Perl_croak_nocontext("Usage: OS2::UnMorphPM(serve)"); { - bool serve = SvOK(ST(0)); + bool serve = SvOK(ST(0)); - perl_hmq_UNSET(serve); + perl_hmq_UNSET(serve); } XSRETURN(0); } @@ -3321,13 +3321,13 @@ XS(XS_OS2_Serve_Messages) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: OS2::Serve_Messages(force)"); + Perl_croak_nocontext("Usage: OS2::Serve_Messages(force)"); { - bool force = SvOK(ST(0)); - unsigned long cnt = Perl_Serve_Messages(force); - dXSTARG; + bool force = SvOK(ST(0)); + unsigned long cnt = Perl_Serve_Messages(force); + dXSTARG; - XSprePUSH; PUSHi((IV)cnt); + XSprePUSH; PUSHi((IV)cnt); } XSRETURN(1); } @@ -3336,26 +3336,26 @@ XS(XS_OS2_Process_Messages) { dXSARGS; if (items < 1 || items > 2) - Perl_croak_nocontext("Usage: OS2::Process_Messages(force [, cnt])"); + Perl_croak_nocontext("Usage: OS2::Process_Messages(force [, cnt])"); { - bool force = SvOK(ST(0)); - unsigned long cnt; - dXSTARG; - - if (items == 2) { - I32 cntr; - SV *sv = ST(1); - - (void)SvIV(sv); /* Force SvIVX */ - if (!SvIOK(sv)) - Perl_croak_nocontext("Can't upgrade count to IV"); - cntr = SvIVX(sv); - cnt = Perl_Process_Messages(force, &cntr); - SvIVX(sv) = cntr; - } else { - cnt = Perl_Process_Messages(force, NULL); + bool force = SvOK(ST(0)); + unsigned long cnt; + dXSTARG; + + if (items == 2) { + I32 cntr; + SV *sv = ST(1); + + (void)SvIV(sv); /* Force SvIVX */ + if (!SvIOK(sv)) + Perl_croak_nocontext("Can't upgrade count to IV"); + cntr = SvIVX(sv); + cnt = Perl_Process_Messages(force, &cntr); + SvIVX(sv) = cntr; + } else { + cnt = Perl_Process_Messages(force, NULL); } - XSprePUSH; PUSHi((IV)cnt); + XSprePUSH; PUSHi((IV)cnt); } XSRETURN(1); } @@ -3364,14 +3364,14 @@ XS(XS_Cwd_current_drive) { dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: Cwd::current_drive()"); + Perl_croak_nocontext("Usage: Cwd::current_drive()"); { - char RETVAL; - dXSTARG; + char RETVAL; + dXSTARG; - RETVAL = current_drive(); - sv_setpvn(TARG, (char *)&RETVAL, 1); - XSprePUSH; PUSHTARG; + RETVAL = current_drive(); + sv_setpvn(TARG, (char *)&RETVAL, 1); + XSprePUSH; PUSHTARG; } XSRETURN(1); } @@ -3380,15 +3380,15 @@ XS(XS_Cwd_sys_chdir) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: Cwd::sys_chdir(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_chdir(path)"); { - STRLEN n_a; - char * path = (char *)SvPV(ST(0),n_a); - bool RETVAL; + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); + bool RETVAL; - RETVAL = sys_chdir(path); - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + RETVAL = sys_chdir(path); + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3397,15 +3397,15 @@ XS(XS_Cwd_change_drive) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: Cwd::change_drive(d)"); + Perl_croak_nocontext("Usage: Cwd::change_drive(d)"); { - STRLEN n_a; - char d = (char)*SvPV(ST(0),n_a); - bool RETVAL; + STRLEN n_a; + char d = (char)*SvPV(ST(0),n_a); + bool RETVAL; - RETVAL = change_drive(d); - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + RETVAL = change_drive(d); + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3414,15 +3414,15 @@ XS(XS_Cwd_sys_is_absolute) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: Cwd::sys_is_absolute(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_absolute(path)"); { - STRLEN n_a; - char * path = (char *)SvPV(ST(0),n_a); - bool RETVAL; + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); + bool RETVAL; - RETVAL = sys_is_absolute(path); - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + RETVAL = sys_is_absolute(path); + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3431,15 +3431,15 @@ XS(XS_Cwd_sys_is_rooted) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: Cwd::sys_is_rooted(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_rooted(path)"); { - STRLEN n_a; - char * path = (char *)SvPV(ST(0),n_a); - bool RETVAL; + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); + bool RETVAL; - RETVAL = sys_is_rooted(path); - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + RETVAL = sys_is_rooted(path); + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3448,15 +3448,15 @@ XS(XS_Cwd_sys_is_relative) { dXSARGS; if (items != 1) - Perl_croak_nocontext("Usage: Cwd::sys_is_relative(path)"); + Perl_croak_nocontext("Usage: Cwd::sys_is_relative(path)"); { - STRLEN n_a; - char * path = (char *)SvPV(ST(0),n_a); - bool RETVAL; + STRLEN n_a; + char * path = (char *)SvPV(ST(0),n_a); + bool RETVAL; - RETVAL = sys_is_relative(path); - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + RETVAL = sys_is_relative(path); + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3465,16 +3465,16 @@ XS(XS_Cwd_sys_cwd) { dXSARGS; if (items != 0) - Perl_croak_nocontext("Usage: Cwd::sys_cwd()"); + Perl_croak_nocontext("Usage: Cwd::sys_cwd()"); { - char p[MAXPATHLEN]; - char * RETVAL; - - /* Can't use TARG, since tainting behaves differently */ - RETVAL = _getcwd2(p, MAXPATHLEN); - ST(0) = sv_newmortal(); - sv_setpv(ST(0), RETVAL); - SvTAINTED_on(ST(0)); + char p[MAXPATHLEN]; + char * RETVAL; + + /* Can't use TARG, since tainting behaves differently */ + RETVAL = _getcwd2(p, MAXPATHLEN); + ST(0) = sv_newmortal(); + sv_setpv(ST(0), RETVAL); + SvTAINTED_on(ST(0)); } XSRETURN(1); } @@ -3483,131 +3483,131 @@ XS(XS_Cwd_sys_abspath) { dXSARGS; if (items > 2) - Perl_croak_nocontext("Usage: Cwd::sys_abspath(path = '.', dir = NULL)"); + Perl_croak_nocontext("Usage: Cwd::sys_abspath(path = '.', dir = NULL)"); { - STRLEN n_a; - char * path = items ? (char *)SvPV(ST(0),n_a) : "."; - char * dir, *s, *t, *e; - char p[MAXPATHLEN]; - char * RETVAL; - int l; - SV *sv; - - if (items < 2) - dir = NULL; - else { - dir = (char *)SvPV(ST(1),n_a); - } - if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) { - path += 2; - } - if (dir == NULL) { - if (_abspath(p, path, MAXPATHLEN) == 0) { - RETVAL = p; - } else { - RETVAL = NULL; - } - } else { - /* Absolute with drive: */ - if ( sys_is_absolute(path) ) { - if (_abspath(p, path, MAXPATHLEN) == 0) { - RETVAL = p; - } else { - RETVAL = NULL; - } - } else if (path[0] == '/' || path[0] == '\\') { - /* Rooted, but maybe on different drive. */ - if (isALPHA(dir[0]) && dir[1] == ':' ) { - char p1[MAXPATHLEN]; - - /* Need to prepend the drive. */ - p1[0] = dir[0]; - p1[1] = dir[1]; - Copy(path, p1 + 2, strlen(path) + 1, char); - RETVAL = p; - if (_abspath(p, p1, MAXPATHLEN) == 0) { - RETVAL = p; - } else { - RETVAL = NULL; - } - } else if (_abspath(p, path, MAXPATHLEN) == 0) { - RETVAL = p; - } else { - RETVAL = NULL; - } - } else { - /* Either path is relative, or starts with a drive letter. */ - /* If the path starts with a drive letter, then dir is - relevant only if - a/b) it is absolute/x:relative on the same drive. - c) path is on current drive, and dir is rooted - In all the cases it is safe to drop the drive part - of the path. */ - if ( !sys_is_relative(path) ) { - if ( ( ( sys_is_absolute(dir) - || (isALPHA(dir[0]) && dir[1] == ':' - && strnicmp(dir, path,1) == 0)) - && strnicmp(dir, path,1) == 0) - || ( !(isALPHA(dir[0]) && dir[1] == ':') - && toupper(path[0]) == current_drive())) { - path += 2; - } else if (_abspath(p, path, MAXPATHLEN) == 0) { - RETVAL = p; goto done; - } else { - RETVAL = NULL; goto done; - } - } - { - /* Need to prepend the absolute path of dir. */ - char p1[MAXPATHLEN]; - - if (_abspath(p1, dir, MAXPATHLEN) == 0) { - int l = strlen(p1); - - if (p1[ l - 1 ] != '/') { - p1[ l ] = '/'; - l++; - } - Copy(path, p1 + l, strlen(path) + 1, char); - if (_abspath(p, p1, MAXPATHLEN) == 0) { - RETVAL = p; - } else { - RETVAL = NULL; - } - } else { - RETVAL = NULL; - } - } - done: - } - } - if (!RETVAL) - XSRETURN_EMPTY; - /* Backslashes are already converted to slashes. */ - /* Remove trailing slashes */ - l = strlen(RETVAL); - while (l > 0 && RETVAL[l-1] == '/') - l--; - ST(0) = sv_newmortal(); - sv_setpvn( sv = (SV*)ST(0), RETVAL, l); - /* Remove duplicate slashes, skipping the first three, which - may be parts of a server-based path */ - s = t = 3 + SvPV_force(sv, n_a); - e = SvEND(sv); - /* Do not worry about multibyte chars here, this would contradict the - eventual UTFization, and currently most other places break too... */ - while (s < e) { - if (s[0] == t[-1] && s[0] == '/') - s++; /* Skip duplicate / */ - else - *t++ = *s++; - } - if (t < e) { - *t = 0; - SvCUR_set(sv, t - SvPVX(sv)); - } - if (!items) - SvTAINTED_on(ST(0)); + STRLEN n_a; + char * path = items ? (char *)SvPV(ST(0),n_a) : "."; + char * dir, *s, *t, *e; + char p[MAXPATHLEN]; + char * RETVAL; + int l; + SV *sv; + + if (items < 2) + dir = NULL; + else { + dir = (char *)SvPV(ST(1),n_a); + } + if (path[0] == '.' && (path[1] == '/' || path[1] == '\\')) { + path += 2; + } + if (dir == NULL) { + if (_abspath(p, path, MAXPATHLEN) == 0) { + RETVAL = p; + } else { + RETVAL = NULL; + } + } else { + /* Absolute with drive: */ + if ( sys_is_absolute(path) ) { + if (_abspath(p, path, MAXPATHLEN) == 0) { + RETVAL = p; + } else { + RETVAL = NULL; + } + } else if (path[0] == '/' || path[0] == '\\') { + /* Rooted, but maybe on different drive. */ + if (isALPHA(dir[0]) && dir[1] == ':' ) { + char p1[MAXPATHLEN]; + + /* Need to prepend the drive. */ + p1[0] = dir[0]; + p1[1] = dir[1]; + Copy(path, p1 + 2, strlen(path) + 1, char); + RETVAL = p; + if (_abspath(p, p1, MAXPATHLEN) == 0) { + RETVAL = p; + } else { + RETVAL = NULL; + } + } else if (_abspath(p, path, MAXPATHLEN) == 0) { + RETVAL = p; + } else { + RETVAL = NULL; + } + } else { + /* Either path is relative, or starts with a drive letter. */ + /* If the path starts with a drive letter, then dir is + relevant only if + a/b) it is absolute/x:relative on the same drive. + c) path is on current drive, and dir is rooted + In all the cases it is safe to drop the drive part + of the path. */ + if ( !sys_is_relative(path) ) { + if ( ( ( sys_is_absolute(dir) + || (isALPHA(dir[0]) && dir[1] == ':' + && strnicmp(dir, path,1) == 0)) + && strnicmp(dir, path,1) == 0) + || ( !(isALPHA(dir[0]) && dir[1] == ':') + && toupper(path[0]) == current_drive())) { + path += 2; + } else if (_abspath(p, path, MAXPATHLEN) == 0) { + RETVAL = p; goto done; + } else { + RETVAL = NULL; goto done; + } + } + { + /* Need to prepend the absolute path of dir. */ + char p1[MAXPATHLEN]; + + if (_abspath(p1, dir, MAXPATHLEN) == 0) { + int l = strlen(p1); + + if (p1[ l - 1 ] != '/') { + p1[ l ] = '/'; + l++; + } + Copy(path, p1 + l, strlen(path) + 1, char); + if (_abspath(p, p1, MAXPATHLEN) == 0) { + RETVAL = p; + } else { + RETVAL = NULL; + } + } else { + RETVAL = NULL; + } + } + done: + } + } + if (!RETVAL) + XSRETURN_EMPTY; + /* Backslashes are already converted to slashes. */ + /* Remove trailing slashes */ + l = strlen(RETVAL); + while (l > 0 && RETVAL[l-1] == '/') + l--; + ST(0) = sv_newmortal(); + sv_setpvn( sv = (SV*)ST(0), RETVAL, l); + /* Remove duplicate slashes, skipping the first three, which + may be parts of a server-based path */ + s = t = 3 + SvPV_force(sv, n_a); + e = SvEND(sv); + /* Do not worry about multibyte chars here, this would contradict the + eventual UTFization, and currently most other places break too... */ + while (s < e) { + if (s[0] == t[-1] && s[0] == '/') + s++; /* Skip duplicate / */ + else + *t++ = *s++; + } + if (t < e) { + *t = 0; + SvCUR_set(sv, t - SvPVX(sv)); + } + if (!items) + SvTAINTED_on(ST(0)); } XSRETURN(1); } @@ -3625,13 +3625,13 @@ ExtLIBPATH(ULONG ord, PSZ path, IV type, int fatal) PFN f = loadByOrdinal(ord, fatal); /* if fatal: load or die! */ if (!f) /* Impossible with fatal */ - return Perl_rc; + return Perl_rc; if (type > 0) - what = END_LIBPATH; + what = END_LIBPATH; else if (type == 0) - what = BEGIN_LIBPATH; + what = BEGIN_LIBPATH; else - what = LIBPATHSTRICT; + what = LIBPATHSTRICT; return (*(PELP)f)(path, what); } @@ -3656,31 +3656,31 @@ XS(XS_Cwd_extLibpath) { dXSARGS; if (items < 0 || items > 1) - Perl_croak_nocontext("Usage: OS2::extLibpath(type = 0)"); + Perl_croak_nocontext("Usage: OS2::extLibpath(type = 0)"); { - IV type; - char to[1024]; - U32 rc; - char * RETVAL; - dXSTARG; - STRLEN l; - - if (items < 1) - type = 0; - else { - type = SvIV(ST(0)); - } - - to[0] = 1; to[1] = 0; /* Sometimes no error reported */ - RETVAL = extLibpath(to, type, 1); /* Make errors fatal */ - if (RETVAL && RETVAL[0] == 1 && RETVAL[1] == 0) - Perl_croak_nocontext("panic OS2::extLibpath parameter"); - l = strlen(to); - if (l >= sizeof(to)) - early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", - to, "'\r\n"); /* Will not return */ - sv_setpv(TARG, RETVAL); - XSprePUSH; PUSHTARG; + IV type; + char to[1024]; + U32 rc; + char * RETVAL; + dXSTARG; + STRLEN l; + + if (items < 1) + type = 0; + else { + type = SvIV(ST(0)); + } + + to[0] = 1; to[1] = 0; /* Sometimes no error reported */ + RETVAL = extLibpath(to, type, 1); /* Make errors fatal */ + if (RETVAL && RETVAL[0] == 1 && RETVAL[1] == 0) + Perl_croak_nocontext("panic OS2::extLibpath parameter"); + l = strlen(to); + if (l >= sizeof(to)) + early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", + to, "'\r\n"); /* Will not return */ + sv_setpv(TARG, RETVAL); + XSprePUSH; PUSHTARG; } XSRETURN(1); } @@ -3689,23 +3689,23 @@ XS(XS_Cwd_extLibpath_set) { dXSARGS; if (items < 1 || items > 2) - Perl_croak_nocontext("Usage: OS2::extLibpath_set(s, type = 0)"); + Perl_croak_nocontext("Usage: OS2::extLibpath_set(s, type = 0)"); { - STRLEN n_a; - char * s = (char *)SvPV(ST(0),n_a); - IV type; - U32 rc; - bool RETVAL; - - if (items < 2) - type = 0; - else { - type = SvIV(ST(1)); - } - - RETVAL = extLibpath_set(s, type, 1); /* Make errors fatal */ - ST(0) = boolSV(RETVAL); - if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); + STRLEN n_a; + char * s = (char *)SvPV(ST(0),n_a); + IV type; + U32 rc; + bool RETVAL; + + if (items < 2) + type = 0; + else { + type = SvIV(ST(1)); + } + + RETVAL = extLibpath_set(s, type, 1); /* Make errors fatal */ + ST(0) = boolSV(RETVAL); + if (SvREFCNT(ST(0))) sv_2mortal(ST(0)); } XSRETURN(1); } @@ -3718,53 +3718,53 @@ fill_extLibpath(int type, char *pre, char *post, int replace, char *msg) ULONG rc; if (!pre && !post) - return 0; + return 0; if (pre) { - pre = dir_subst(pre, strlen(pre), buf1, sizeof buf1, dir_subst_pathlike, msg); - if (!pre) - return ERROR_INVALID_PARAMETER; - l = strlen(pre); - if (l >= sizeof(buf)/2) - return ERROR_BUFFER_OVERFLOW; - s = pre - 1; - while (*++s) - if (*s == '/') - *s = '\\'; /* Be extra cautious */ - memcpy(to, pre, l); - if (!l || to[l-1] != ';') - to[l++] = ';'; - to += l; + pre = dir_subst(pre, strlen(pre), buf1, sizeof buf1, dir_subst_pathlike, msg); + if (!pre) + return ERROR_INVALID_PARAMETER; + l = strlen(pre); + if (l >= sizeof(buf)/2) + return ERROR_BUFFER_OVERFLOW; + s = pre - 1; + while (*++s) + if (*s == '/') + *s = '\\'; /* Be extra cautious */ + memcpy(to, pre, l); + if (!l || to[l-1] != ';') + to[l++] = ';'; + to += l; } if (!replace) { to[0] = 1; to[1] = 0; /* Sometimes no error reported */ rc = ExtLIBPATH(ORD_DosQueryExtLibpath, to, type, 0); /* Do not croak */ if (rc) - return rc; + return rc; if (to[0] == 1 && to[1] == 0) - return ERROR_INVALID_PARAMETER; + return ERROR_INVALID_PARAMETER; to += strlen(to); if (buf + sizeof(buf) - 1 <= to) /* Buffer overflow */ - early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", - buf, "'\r\n"); /* Will not return */ + early_error("Buffer overflow while getting BEGIN/ENDLIBPATH: `", + buf, "'\r\n"); /* Will not return */ if (to > buf && to[-1] != ';') - *to++ = ';'; + *to++ = ';'; } if (post) { - post = dir_subst(post, strlen(post), buf1, sizeof buf1, dir_subst_pathlike, msg); - if (!post) - return ERROR_INVALID_PARAMETER; - l = strlen(post); - if (l + to - buf >= sizeof(buf) - 1) - return ERROR_BUFFER_OVERFLOW; - s = post - 1; - while (*++s) - if (*s == '/') - *s = '\\'; /* Be extra cautious */ - memcpy(to, post, l); - if (!l || to[l-1] != ';') - to[l++] = ';'; - to += l; + post = dir_subst(post, strlen(post), buf1, sizeof buf1, dir_subst_pathlike, msg); + if (!post) + return ERROR_INVALID_PARAMETER; + l = strlen(post); + if (l + to - buf >= sizeof(buf) - 1) + return ERROR_BUFFER_OVERFLOW; + s = post - 1; + while (*++s) + if (*s == '/') + *s = '\\'; /* Be extra cautious */ + memcpy(to, post, l); + if (!l || to[l-1] != ';') + to[l++] = ';'; + to += l; } *to = 0; rc = ExtLIBPATH(ORD_DosSetExtLibpath, buf, type, 0); /* Do not croak */ @@ -3774,13 +3774,13 @@ fill_extLibpath(int type, char *pre, char *post, int replace, char *msg) /* Input: Address, BufLen APIRET APIENTRY DosQueryModFromEIP (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf, - ULONG * Offset, ULONG Address); + ULONG * Offset, ULONG Address); */ DeclOSFuncByORD(APIRET, _DosQueryModFromEIP,ORD_DosQueryModFromEIP, - (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf, - ULONG * Offset, ULONG Address), - (hmod, obj, BufLen, Buf, Offset, Address)) + (HMODULE * hmod, ULONG * obj, ULONG BufLen, PCHAR Buf, + ULONG * Offset, ULONG Address), + (hmod, obj, BufLen, Buf, Offset, Address)) static SV* module_name_at(void *pp, enum module_name_how how) @@ -3792,22 +3792,22 @@ module_name_at(void *pp, enum module_name_how how) ULONG obj, offset, rc, addr = (ULONG)pp; if (how & mod_name_HMODULE) { - if ((how & ~mod_name_HMODULE) == mod_name_shortname) - Perl_croak(aTHX_ "Can't get short module name from a handle"); - mod = (HMODULE)pp; - how &= ~mod_name_HMODULE; + if ((how & ~mod_name_HMODULE) == mod_name_shortname) + Perl_croak(aTHX_ "Can't get short module name from a handle"); + mod = (HMODULE)pp; + how &= ~mod_name_HMODULE; } else if (!_DosQueryModFromEIP(&mod, &obj, sizeof(buf), buf, &offset, addr)) - return &PL_sv_undef; + return &PL_sv_undef; if (how == mod_name_handle) - return newSVuv(mod); + return newSVuv(mod); /* Full name... */ if ( how != mod_name_shortname - && CheckOSError(DosQueryModuleName(mod, sizeof(buf), buf)) ) - return &PL_sv_undef; + && CheckOSError(DosQueryModuleName(mod, sizeof(buf), buf)) ) + return &PL_sv_undef; while (*p) { - if (*p == '\\') - *p = '/'; - p++; + if (*p == '\\') + *p = '/'; + p++; } return newSVpv(buf, 0); } @@ -3816,13 +3816,13 @@ static SV* module_name_of_cv(SV *cv, enum module_name_how how) { if (!cv || !SvROK(cv) || SvTYPE(SvRV(cv)) != SVt_PVCV || !CvXSUB(SvRV(cv))) { - dTHX; + dTHX; - if (how & mod_name_C_function) - return module_name_at((void*)SvIV(cv), how & ~mod_name_C_function); - else if (how & mod_name_HMODULE) - return module_name_at((void*)SvIV(cv), how); - Perl_croak(aTHX_ "Not an XSUB reference"); + if (how & mod_name_C_function) + return module_name_at((void*)SvIV(cv), how & ~mod_name_C_function); + else if (how & mod_name_HMODULE) + return module_name_at((void*)SvIV(cv), how); + Perl_croak(aTHX_ "Not an XSUB reference"); } return module_name_at(CvXSUB(SvRV(cv)), how); } @@ -3831,52 +3831,52 @@ XS(XS_OS2_DLLname) { dXSARGS; if (items > 2) - Perl_croak(aTHX_ "Usage: OS2::DLLname( [ how, [\\&xsub] ] )"); + Perl_croak(aTHX_ "Usage: OS2::DLLname( [ how, [\\&xsub] ] )"); { - SV * RETVAL; - int how; - - if (items < 1) - how = mod_name_full; - else { - how = (int)SvIV(ST(0)); - } - if (items < 2) - RETVAL = module_name(how); - else - RETVAL = module_name_of_cv(ST(1), how); - ST(0) = RETVAL; - sv_2mortal(ST(0)); + SV * RETVAL; + int how; + + if (items < 1) + how = mod_name_full; + else { + how = (int)SvIV(ST(0)); + } + if (items < 2) + RETVAL = module_name(how); + else + RETVAL = module_name_of_cv(ST(1), how); + ST(0) = RETVAL; + sv_2mortal(ST(0)); } XSRETURN(1); } DeclOSFuncByORD(INT, _Dos32QueryHeaderInfo, ORD_Dos32QueryHeaderInfo, - (ULONG r1, ULONG r2, PVOID buf, ULONG szbuf, ULONG fnum), - (r1, r2, buf, szbuf, fnum)) + (ULONG r1, ULONG r2, PVOID buf, ULONG szbuf, ULONG fnum), + (r1, r2, buf, szbuf, fnum)) XS(XS_OS2__headerInfo) { dXSARGS; if (items > 4 || items < 2) - Perl_croak(aTHX_ "Usage: OS2::_headerInfo(req,size[,handle,[offset]])"); + Perl_croak(aTHX_ "Usage: OS2::_headerInfo(req,size[,handle,[offset]])"); { - ULONG req = (ULONG)SvIV(ST(0)); - STRLEN size = (STRLEN)SvIV(ST(1)), n_a; - ULONG handle = (items >= 3 ? (ULONG)SvIV(ST(2)) : 0); - ULONG offset = (items >= 4 ? (ULONG)SvIV(ST(3)) : 0); - - if (size <= 0) - Perl_croak(aTHX_ "OS2::_headerInfo(): unexpected size: %d", (int)size); - ST(0) = newSVpvs(""); - SvGROW(ST(0), size + 1); - sv_2mortal(ST(0)); - - if (!_Dos32QueryHeaderInfo(handle, offset, SvPV(ST(0), n_a), size, req)) - Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", - req, size, handle, offset, os2error(Perl_rc)); - SvCUR_set(ST(0), size); - *SvEND(ST(0)) = 0; + ULONG req = (ULONG)SvIV(ST(0)); + STRLEN size = (STRLEN)SvIV(ST(1)), n_a; + ULONG handle = (items >= 3 ? (ULONG)SvIV(ST(2)) : 0); + ULONG offset = (items >= 4 ? (ULONG)SvIV(ST(3)) : 0); + + if (size <= 0) + Perl_croak(aTHX_ "OS2::_headerInfo(): unexpected size: %d", (int)size); + ST(0) = newSVpvs(""); + SvGROW(ST(0), size + 1); + sv_2mortal(ST(0)); + + if (!_Dos32QueryHeaderInfo(handle, offset, SvPV(ST(0), n_a), size, req)) + Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", + req, size, handle, offset, os2error(Perl_rc)); + SvCUR_set(ST(0), size); + *SvEND(ST(0)) = 0; } XSRETURN(1); } @@ -3888,29 +3888,29 @@ XS(XS_OS2_libPath) { dXSARGS; if (items != 0) - Perl_croak(aTHX_ "Usage: OS2::libPath()"); + Perl_croak(aTHX_ "Usage: OS2::libPath()"); { - ULONG size; - STRLEN n_a; - - if (!_Dos32QueryHeaderInfo(0, 0, &size, sizeof(size), - DQHI_QUERYLIBPATHSIZE)) - Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", - DQHI_QUERYLIBPATHSIZE, sizeof(size), 0, 0, - os2error(Perl_rc)); - ST(0) = newSVpvs(""); - SvGROW(ST(0), size + 1); - sv_2mortal(ST(0)); - - /* We should be careful: apparently, this entry point does not - pay attention to the size argument, so may overwrite - unrelated data! */ - if (!_Dos32QueryHeaderInfo(0, 0, SvPV(ST(0), n_a), size, - DQHI_QUERYLIBPATH)) - Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", - DQHI_QUERYLIBPATH, size, 0, 0, os2error(Perl_rc)); - SvCUR_set(ST(0), size); - *SvEND(ST(0)) = 0; + ULONG size; + STRLEN n_a; + + if (!_Dos32QueryHeaderInfo(0, 0, &size, sizeof(size), + DQHI_QUERYLIBPATHSIZE)) + Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", + DQHI_QUERYLIBPATHSIZE, sizeof(size), 0, 0, + os2error(Perl_rc)); + ST(0) = newSVpvs(""); + SvGROW(ST(0), size + 1); + sv_2mortal(ST(0)); + + /* We should be careful: apparently, this entry point does not + pay attention to the size argument, so may overwrite + unrelated data! */ + if (!_Dos32QueryHeaderInfo(0, 0, SvPV(ST(0), n_a), size, + DQHI_QUERYLIBPATH)) + Perl_croak(aTHX_ "OS2::_headerInfo(%ld,%ld,%ld,%ld) error: %s", + DQHI_QUERYLIBPATH, size, 0, 0, os2error(Perl_rc)); + SvCUR_set(ST(0), size); + *SvEND(ST(0)) = 0; } XSRETURN(1); } @@ -3922,15 +3922,15 @@ XS(XS_OS2__control87) { dXSARGS; if (items != 2) - Perl_croak(aTHX_ "Usage: OS2::_control87(new,mask)"); + Perl_croak(aTHX_ "Usage: OS2::_control87(new,mask)"); { - unsigned new = (unsigned)SvIV(ST(0)); - unsigned mask = (unsigned)SvIV(ST(1)); - unsigned RETVAL; - dXSTARG; + unsigned new = (unsigned)SvIV(ST(0)); + unsigned mask = (unsigned)SvIV(ST(1)); + unsigned RETVAL; + dXSTARG; - RETVAL = _control87(new, mask); - XSprePUSH; PUSHi((IV)RETVAL); + RETVAL = _control87(new, mask); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -3941,30 +3941,30 @@ XS(XS_OS2_mytype) int which = 0; if (items < 0 || items > 1) - Perl_croak(aTHX_ "Usage: OS2::mytype([which])"); + Perl_croak(aTHX_ "Usage: OS2::mytype([which])"); if (items == 1) - which = (int)SvIV(ST(0)); + which = (int)SvIV(ST(0)); { - unsigned RETVAL; - dXSTARG; - - switch (which) { - case 0: - RETVAL = os2_mytype; /* Reset after fork */ - break; - case 1: - RETVAL = os2_mytype_ini; /* Before any fork */ - break; - case 2: - RETVAL = Perl_os2_initial_mode; /* Before first morphing */ - break; - case 3: - RETVAL = my_type(); /* Morphed type */ - break; - default: - Perl_croak(aTHX_ "OS2::mytype(which): unknown which=%d", which); - } - XSprePUSH; PUSHi((IV)RETVAL); + unsigned RETVAL; + dXSTARG; + + switch (which) { + case 0: + RETVAL = os2_mytype; /* Reset after fork */ + break; + case 1: + RETVAL = os2_mytype_ini; /* Before any fork */ + break; + case 2: + RETVAL = Perl_os2_initial_mode; /* Before first morphing */ + break; + case 3: + RETVAL = my_type(); /* Morphed type */ + break; + default: + Perl_croak(aTHX_ "OS2::mytype(which): unknown which=%d", which); + } + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -3976,9 +3976,9 @@ XS(XS_OS2_mytype_set) int type; if (items == 1) - type = (int)SvIV(ST(0)); + type = (int)SvIV(ST(0)); else - Perl_croak(aTHX_ "Usage: OS2::mytype_set(type)"); + Perl_croak(aTHX_ "Usage: OS2::mytype_set(type)"); my_type_set(type); XSRETURN_YES; } @@ -3988,13 +3988,13 @@ XS(XS_OS2_get_control87) { dXSARGS; if (items != 0) - Perl_croak(aTHX_ "Usage: OS2::get_control87()"); + Perl_croak(aTHX_ "Usage: OS2::get_control87()"); { - unsigned RETVAL; - dXSTARG; + unsigned RETVAL; + dXSTARG; - RETVAL = get_control87(); - XSprePUSH; PUSHi((IV)RETVAL); + RETVAL = get_control87(); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -4004,27 +4004,27 @@ XS(XS_OS2_set_control87) { dXSARGS; if (items < 0 || items > 2) - Perl_croak(aTHX_ "Usage: OS2::set_control87(new=MCW_EM, mask=MCW_EM)"); + Perl_croak(aTHX_ "Usage: OS2::set_control87(new=MCW_EM, mask=MCW_EM)"); { - unsigned new; - unsigned mask; - unsigned RETVAL; - dXSTARG; - - if (items < 1) - new = MCW_EM; - else { - new = (unsigned)SvIV(ST(0)); - } - - if (items < 2) - mask = MCW_EM; - else { - mask = (unsigned)SvIV(ST(1)); - } - - RETVAL = set_control87(new, mask); - XSprePUSH; PUSHi((IV)RETVAL); + unsigned new; + unsigned mask; + unsigned RETVAL; + dXSTARG; + + if (items < 1) + new = MCW_EM; + else { + new = (unsigned)SvIV(ST(0)); + } + + if (items < 2) + mask = MCW_EM; + else { + mask = (unsigned)SvIV(ST(1)); + } + + RETVAL = set_control87(new, mask); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -4033,20 +4033,20 @@ XS(XS_OS2_incrMaxFHandles) /* DosSetRelMaxFH */ { dXSARGS; if (items < 0 || items > 1) - Perl_croak(aTHX_ "Usage: OS2::incrMaxFHandles(delta = 0)"); + Perl_croak(aTHX_ "Usage: OS2::incrMaxFHandles(delta = 0)"); { - LONG delta; - ULONG RETVAL, rc; - dXSTARG; - - if (items < 1) - delta = 0; - else - delta = (LONG)SvIV(ST(0)); - - if (CheckOSError(DosSetRelMaxFH(&delta, &RETVAL))) - croak_with_os2error("OS2::incrMaxFHandles(): DosSetRelMaxFH() error"); - XSprePUSH; PUSHu((UV)RETVAL); + LONG delta; + ULONG RETVAL, rc; + dXSTARG; + + if (items < 1) + delta = 0; + else + delta = (LONG)SvIV(ST(0)); + + if (CheckOSError(DosSetRelMaxFH(&delta, &RETVAL))) + croak_with_os2error("OS2::incrMaxFHandles(): DosSetRelMaxFH() error"); + XSprePUSH; PUSHu((UV)RETVAL); } XSRETURN(1); } @@ -4061,24 +4061,24 @@ connectNPipe(ULONG hpipe, int wait, ULONG restore, ULONG oflags) ULONG ret = ERROR_INTERRUPT, rc, flags; if (restore && wait) - os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()"); + os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()"); /* DosSetNPHState fails if more bits than NP_NOWAIT|NP_READMODE_MESSAGE */ oflags &= (NP_NOWAIT | NP_READMODE_MESSAGE); flags = (oflags & ~NP_NOWAIT) | (wait > 0 ? NP_WAIT : NP_NOWAIT); /* We know (o)flags unless wait == 0 && restore */ if (wait && (flags != oflags)) - os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()"); + os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()"); while (ret == ERROR_INTERRUPT) - ret = DosConnectNPipe(hpipe); + ret = DosConnectNPipe(hpipe); (void)CheckOSError(ret); if (restore && wait && (flags != oflags)) - os2cp_croak(DosSetNPHState(hpipe, oflags), "DosSetNPHState() back"); + os2cp_croak(DosSetNPHState(hpipe, oflags), "DosSetNPHState() back"); /* We know flags unless wait == 0 && restore */ if ( ((wait || restore) ? (flags & NP_NOWAIT) : 1) - && (ret == ERROR_PIPE_NOT_CONNECTED) ) - return 0; /* normal return value */ + && (ret == ERROR_PIPE_NOT_CONNECTED) ) + return 0; /* normal return value */ if (ret == NO_ERROR) - return 1; + return 1; croak_with_os2error("DosConnectNPipe()"); } @@ -4086,196 +4086,196 @@ connectNPipe(ULONG hpipe, int wait, ULONG restore, ULONG oflags) NO_OUTPUT ULONG DosCreateNPipe(PCSZ pszName, OUTLIST HPIPE hpipe, ULONG ulOpenMode, int connect = 1, int count = 1, ULONG ulInbufLength = 8192, ULONG ulOutbufLength = ulInbufLength, ULONG ulPipeMode = count | NP_NOWAIT | NP_TYPE_BYTE | NP_READMODE_BYTE, ULONG ulTimeout = 0) PREINIT: - ULONG rc; + ULONG rc; C_ARGS: - pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout + pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout POSTCALL: - if (CheckOSError(RETVAL)) - croak_with_os2error("OS2::mkpipe() error"); + if (CheckOSError(RETVAL)) + croak_with_os2error("OS2::mkpipe() error"); */ XS(XS_OS2_pipe); /* prototype to pass -Wmissing-prototypes */ XS(XS_OS2_pipe) { dXSARGS; if (items < 2 || items > 8) - Perl_croak(aTHX_ "Usage: OS2::pipe(pszName, ulOpenMode, connect= 1, count= 1, ulInbufLength= 8192, ulOutbufLength= ulInbufLength, ulPipeMode= count | NP_NOWAIT | NP_TYPE_BYTE | NP_READMODE_BYTE, ulTimeout= 0)"); + Perl_croak(aTHX_ "Usage: OS2::pipe(pszName, ulOpenMode, connect= 1, count= 1, ulInbufLength= 8192, ulOutbufLength= ulInbufLength, ulPipeMode= count | NP_NOWAIT | NP_TYPE_BYTE | NP_READMODE_BYTE, ulTimeout= 0)"); { - ULONG RETVAL; - PCSZ pszName = ( SvOK(ST(0)) ? (PCSZ)SvPV_nolen(ST(0)) : NULL ); - HPIPE hpipe; - SV *OpenMode = ST(1); - ULONG ulOpenMode; - int connect = 0, count, message_r = 0, message = 0, b = 0; - ULONG ulInbufLength, ulOutbufLength, ulPipeMode, ulTimeout, rc; - STRLEN len; - char *s, buf[10], *s1, *perltype = NULL; - PerlIO *perlio; - double timeout; - - if (!pszName || !*pszName) - Perl_croak(aTHX_ "OS2::pipe(): empty pipe name"); - s = SvPV(OpenMode, len); - if (memEQs(s, len, "wait")) { /* DosWaitNPipe() */ - ULONG ms = 0xFFFFFFFF, ret = ERROR_INTERRUPT; /* Indefinite */ - - if (items == 3) { - timeout = (double)SvNV(ST(2)); - ms = timeout * 1000; - if (timeout < 0) - ms = 0xFFFFFFFF; /* Indefinite */ - else if (timeout && !ms) - ms = 1; - } else if (items > 3) - Perl_croak(aTHX_ "OS2::pipe(): too many arguments for wait-for-connect: %ld", (long)items); - - while (ret == ERROR_INTERRUPT) - ret = DosWaitNPipe(pszName, ms); /* XXXX Update ms? */ - os2cp_croak(ret, "DosWaitNPipe()"); - XSRETURN_YES; - } - if (memEQs(s, len, "call")) { /* DosCallNPipe() */ - ULONG ms = 0xFFFFFFFF, got; /* Indefinite */ - STRLEN l; - char *s; - char buf[8192]; - STRLEN ll = sizeof(buf); - char *b = buf; - - if (items < 3 || items > 5) - Perl_croak(aTHX_ "usage: OS2::pipe(pszName, 'call', write [, timeout= 0xFFFFFFFF, buffsize = 8192])"); - s = SvPV(ST(2), l); - if (items >= 4) { - timeout = (double)SvNV(ST(3)); - ms = timeout * 1000; - if (timeout < 0) - ms = 0xFFFFFFFF; /* Indefinite */ - else if (timeout && !ms) - ms = 1; - } - if (items >= 5) { - STRLEN lll = SvUV(ST(4)); - SV *sv = NEWSV(914, lll); - - sv_2mortal(sv); - ll = lll; - b = SvPVX(sv); - } - - os2cp_croak(DosCallNPipe(pszName, s, l, b, ll, &got, ms), - "DosCallNPipe()"); - XSRETURN_PVN(b, got); - } - s1 = buf; - if (len && len <= 3 && !(*s >= '0' && *s <= '9')) { - int r, w, R, W; - - r = strchr(s, 'r') != 0; - w = strchr(s, 'w') != 0; - R = strchr(s, 'R') != 0; - W = strchr(s, 'W') != 0; - b = strchr(s, 'b') != 0; - if (r + w + R + W + b != len || (r && R) || (w && W)) - Perl_croak(aTHX_ "OS2::pipe(): unknown OpenMode argument: `%s'", s); - if ((r || R) && (w || W)) - ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_DUPLEX; - else if (r || R) - ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_INBOUND; - else - ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_OUTBOUND; - if (R) - message = message_r = 1; - if (W) - message = 1; - else if (w && R) - Perl_croak(aTHX_ "OS2::pipe(): can't have message read mode for non-message pipes"); - } else - ulOpenMode = (ULONG)SvUV(OpenMode); /* ST(1) */ - - if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX - || (ulOpenMode & 0x3) == NP_ACCESS_INBOUND ) - *s1++ = 'r'; - if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX ) - *s1++ = '+'; - if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND ) - *s1++ = 'w'; - if (b) - *s1++ = 'b'; - *s1 = 0; - if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX ) - perltype = "+<&"; - else if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND ) - perltype = ">&"; - else - perltype = "<&"; - - if (items < 3) - connect = -1; /* no wait */ - else if (SvTRUE(ST(2))) { - s = SvPV(ST(2), len); - if (memEQs(s, len, "nowait")) - connect = -1; /* no wait */ - else if (memEQs(s, len, "wait")) - connect = 1; /* wait */ - else - Perl_croak(aTHX_ "OS2::pipe(): unknown connect argument: `%s'", s); - } - - if (items < 4) - count = 1; - else - count = (int)SvIV(ST(3)); - - if (items < 5) - ulInbufLength = 8192; - else - ulInbufLength = (ULONG)SvUV(ST(4)); - - if (items < 6) - ulOutbufLength = ulInbufLength; - else - ulOutbufLength = (ULONG)SvUV(ST(5)); - - if (count < -1 || count == 0 || count >= 255) - Perl_croak(aTHX_ "OS2::pipe(): count should be -1 or between 1 and 254: %ld", (long)count); - if (count < 0 ) - count = 255; /* Unlimited */ - - ulPipeMode = count; - if (items < 7) - ulPipeMode |= (NP_WAIT - | (message ? NP_TYPE_MESSAGE : NP_TYPE_BYTE) - | (message_r ? NP_READMODE_MESSAGE : NP_READMODE_BYTE)); - else - ulPipeMode |= (ULONG)SvUV(ST(6)); - - if (items < 8) - timeout = 0; - else - timeout = (double)SvNV(ST(7)); - ulTimeout = timeout * 1000; - if (timeout < 0) - ulTimeout = 0xFFFFFFFF; /* Indefinite */ - else if (timeout && !ulTimeout) - ulTimeout = 1; - - RETVAL = DosCreateNPipe(pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout); - if (CheckOSError(RETVAL)) - croak_with_os2error("OS2::pipe(): DosCreateNPipe() error"); - - if (connect) - connectNPipe(hpipe, connect, 1, 0); /* XXXX wait, retval */ - hpipe = __imphandle(hpipe); - - perlio = PerlIO_fdopen(hpipe, buf); - ST(0) = sv_newmortal(); - { - GV *gv = (GV *)sv_newmortal(); - gv_init_pvn(gv, gv_stashpvs("OS2::pipe",1),"__ANONIO__",10,0); - if ( do_open6(gv, perltype, strlen(perltype), perlio, NULL, 0) ) - sv_setsv(ST(0), sv_bless(newRV((SV*)gv), gv_stashpv("IO::Handle",1))); - else - ST(0) = &PL_sv_undef; - } + ULONG RETVAL; + PCSZ pszName = ( SvOK(ST(0)) ? (PCSZ)SvPV_nolen(ST(0)) : NULL ); + HPIPE hpipe; + SV *OpenMode = ST(1); + ULONG ulOpenMode; + int connect = 0, count, message_r = 0, message = 0, b = 0; + ULONG ulInbufLength, ulOutbufLength, ulPipeMode, ulTimeout, rc; + STRLEN len; + char *s, buf[10], *s1, *perltype = NULL; + PerlIO *perlio; + double timeout; + + if (!pszName || !*pszName) + Perl_croak(aTHX_ "OS2::pipe(): empty pipe name"); + s = SvPV(OpenMode, len); + if (memEQs(s, len, "wait")) { /* DosWaitNPipe() */ + ULONG ms = 0xFFFFFFFF, ret = ERROR_INTERRUPT; /* Indefinite */ + + if (items == 3) { + timeout = (double)SvNV(ST(2)); + ms = timeout * 1000; + if (timeout < 0) + ms = 0xFFFFFFFF; /* Indefinite */ + else if (timeout && !ms) + ms = 1; + } else if (items > 3) + Perl_croak(aTHX_ "OS2::pipe(): too many arguments for wait-for-connect: %ld", (long)items); + + while (ret == ERROR_INTERRUPT) + ret = DosWaitNPipe(pszName, ms); /* XXXX Update ms? */ + os2cp_croak(ret, "DosWaitNPipe()"); + XSRETURN_YES; + } + if (memEQs(s, len, "call")) { /* DosCallNPipe() */ + ULONG ms = 0xFFFFFFFF, got; /* Indefinite */ + STRLEN l; + char *s; + char buf[8192]; + STRLEN ll = sizeof(buf); + char *b = buf; + + if (items < 3 || items > 5) + Perl_croak(aTHX_ "usage: OS2::pipe(pszName, 'call', write [, timeout= 0xFFFFFFFF, buffsize = 8192])"); + s = SvPV(ST(2), l); + if (items >= 4) { + timeout = (double)SvNV(ST(3)); + ms = timeout * 1000; + if (timeout < 0) + ms = 0xFFFFFFFF; /* Indefinite */ + else if (timeout && !ms) + ms = 1; + } + if (items >= 5) { + STRLEN lll = SvUV(ST(4)); + SV *sv = NEWSV(914, lll); + + sv_2mortal(sv); + ll = lll; + b = SvPVX(sv); + } + + os2cp_croak(DosCallNPipe(pszName, s, l, b, ll, &got, ms), + "DosCallNPipe()"); + XSRETURN_PVN(b, got); + } + s1 = buf; + if (len && len <= 3 && !(*s >= '0' && *s <= '9')) { + int r, w, R, W; + + r = strchr(s, 'r') != 0; + w = strchr(s, 'w') != 0; + R = strchr(s, 'R') != 0; + W = strchr(s, 'W') != 0; + b = strchr(s, 'b') != 0; + if (r + w + R + W + b != len || (r && R) || (w && W)) + Perl_croak(aTHX_ "OS2::pipe(): unknown OpenMode argument: `%s'", s); + if ((r || R) && (w || W)) + ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_DUPLEX; + else if (r || R) + ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_INBOUND; + else + ulOpenMode = NP_INHERIT | NP_NOWRITEBEHIND | NP_ACCESS_OUTBOUND; + if (R) + message = message_r = 1; + if (W) + message = 1; + else if (w && R) + Perl_croak(aTHX_ "OS2::pipe(): can't have message read mode for non-message pipes"); + } else + ulOpenMode = (ULONG)SvUV(OpenMode); /* ST(1) */ + + if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX + || (ulOpenMode & 0x3) == NP_ACCESS_INBOUND ) + *s1++ = 'r'; + if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX ) + *s1++ = '+'; + if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND ) + *s1++ = 'w'; + if (b) + *s1++ = 'b'; + *s1 = 0; + if ( (ulOpenMode & 0x3) == NP_ACCESS_DUPLEX ) + perltype = "+<&"; + else if ( (ulOpenMode & 0x3) == NP_ACCESS_OUTBOUND ) + perltype = ">&"; + else + perltype = "<&"; + + if (items < 3) + connect = -1; /* no wait */ + else if (SvTRUE(ST(2))) { + s = SvPV(ST(2), len); + if (memEQs(s, len, "nowait")) + connect = -1; /* no wait */ + else if (memEQs(s, len, "wait")) + connect = 1; /* wait */ + else + Perl_croak(aTHX_ "OS2::pipe(): unknown connect argument: `%s'", s); + } + + if (items < 4) + count = 1; + else + count = (int)SvIV(ST(3)); + + if (items < 5) + ulInbufLength = 8192; + else + ulInbufLength = (ULONG)SvUV(ST(4)); + + if (items < 6) + ulOutbufLength = ulInbufLength; + else + ulOutbufLength = (ULONG)SvUV(ST(5)); + + if (count < -1 || count == 0 || count >= 255) + Perl_croak(aTHX_ "OS2::pipe(): count should be -1 or between 1 and 254: %ld", (long)count); + if (count < 0 ) + count = 255; /* Unlimited */ + + ulPipeMode = count; + if (items < 7) + ulPipeMode |= (NP_WAIT + | (message ? NP_TYPE_MESSAGE : NP_TYPE_BYTE) + | (message_r ? NP_READMODE_MESSAGE : NP_READMODE_BYTE)); + else + ulPipeMode |= (ULONG)SvUV(ST(6)); + + if (items < 8) + timeout = 0; + else + timeout = (double)SvNV(ST(7)); + ulTimeout = timeout * 1000; + if (timeout < 0) + ulTimeout = 0xFFFFFFFF; /* Indefinite */ + else if (timeout && !ulTimeout) + ulTimeout = 1; + + RETVAL = DosCreateNPipe(pszName, &hpipe, ulOpenMode, ulPipeMode, ulInbufLength, ulOutbufLength, ulTimeout); + if (CheckOSError(RETVAL)) + croak_with_os2error("OS2::pipe(): DosCreateNPipe() error"); + + if (connect) + connectNPipe(hpipe, connect, 1, 0); /* XXXX wait, retval */ + hpipe = __imphandle(hpipe); + + perlio = PerlIO_fdopen(hpipe, buf); + ST(0) = sv_newmortal(); + { + GV *gv = (GV *)sv_newmortal(); + gv_init_pvn(gv, gv_stashpvs("OS2::pipe",1),"__ANONIO__",10,0); + if ( do_open6(gv, perltype, strlen(perltype), perlio, NULL, 0) ) + sv_setsv(ST(0), sv_bless(newRV((SV*)gv), gv_stashpv("IO::Handle",1))); + else + ST(0) = &PL_sv_undef; + } } XSRETURN(1); } @@ -4285,155 +4285,155 @@ XS(XS_OS2_pipeCntl) { dXSARGS; if (items < 2 || items > 3) - Perl_croak(aTHX_ "Usage: OS2::pipeCntl(pipe, op [, wait])"); + Perl_croak(aTHX_ "Usage: OS2::pipeCntl(pipe, op [, wait])"); { - ULONG rc; - PerlIO *perlio = IoIFP(sv_2io(ST(0))); - IV fn = PerlIO_fileno(perlio); - HPIPE hpipe = (HPIPE)fn; - STRLEN len; - char *s = SvPV(ST(1), len); - int wait = 0, disconnect = 0, connect = 0, message = -1, query = 0; - int peek = 0, state = 0, info = 0; - - if (fn < 0) - Perl_croak(aTHX_ "OS2::pipeCntl(): not a pipe"); - if (items == 3) - wait = (SvTRUE(ST(2)) ? 1 : -1); - - switch (len) { - case 4: - if (strEQ(s, "byte")) - message = 0; - else if (strEQ(s, "peek")) - peek = 1; - else if (strEQ(s, "info")) - info = 1; - else - goto unknown; - break; - case 5: - if (strEQ(s, "reset")) - disconnect = connect = 1; - else if (strEQ(s, "state")) - query = 1; - else - goto unknown; - break; - case 7: - if (strEQ(s, "connect")) - connect = 1; - else if (strEQ(s, "message")) - message = 1; - else - goto unknown; - break; - case 9: - if (!strEQ(s, "readstate")) - goto unknown; - state = 1; - break; - case 10: - if (!strEQ(s, "disconnect")) - goto unknown; - disconnect = 1; - break; - default: - unknown: - Perl_croak(aTHX_ "OS2::pipeCntl(): unknown argument: `%s'", s); - break; - } - - if (items == 3 && !connect) - Perl_croak(aTHX_ "OS2::pipeCntl(): no wait argument for `%s'", s); - - XSprePUSH; /* Do not need arguments any more */ - if (disconnect) { - os2cp_croak(DosDisConnectNPipe(hpipe), "OS2::pipeCntl(): DosDisConnectNPipe()"); - PerlIO_clearerr(perlio); - } - if (connect) { - if (!connectNPipe(hpipe, wait , 1, 0)) - XSRETURN_IV(-1); - } - if (query) { - ULONG flags; - - os2cp_croak(DosQueryNPHState(hpipe, &flags), "DosQueryNPHState()"); - XSRETURN_UV(flags); - } - if (peek || state || info) { - ULONG BytesRead, PipeState; - AVAILDATA BytesAvail; - - os2cp_croak( DosPeekNPipe(hpipe, NULL, 0, &BytesRead, &BytesAvail, - &PipeState), "DosPeekNPipe() for state"); - if (state) { - EXTEND(SP, 3); - mPUSHu(PipeState); - /* Bytes (available/in-message) */ - mPUSHi(BytesAvail.cbpipe); - mPUSHi(BytesAvail.cbmessage); - XSRETURN(3); - } else if (info) { - /* L S S C C C/Z* - ID of the (remote) computer - buffers (out/in) - instances (max/actual) - */ - struct pipe_info_t { - ULONG id; /* char id[4]; */ - PIPEINFO pInfo; - char buf[512]; - } b; - int size; - - os2cp_croak( DosQueryNPipeInfo(hpipe, 1, &b.pInfo, sizeof(b) - STRUCT_OFFSET(struct pipe_info_t, pInfo)), - "DosQueryNPipeInfo(1)"); - os2cp_croak( DosQueryNPipeInfo(hpipe, 2, &b.id, sizeof(b.id)), - "DosQueryNPipeInfo(2)"); - size = b.pInfo.cbName; - /* Trailing 0 is included in cbName - undocumented; so - one should always extract with Z* */ - if (size) /* name length 254 or less */ - size--; - else - size = strlen(b.pInfo.szName); - EXTEND(SP, 6); - mPUSHp(b.pInfo.szName, size); - mPUSHu(b.id); - mPUSHi(b.pInfo.cbOut); - mPUSHi(b.pInfo.cbIn); - mPUSHi(b.pInfo.cbMaxInst); - mPUSHi(b.pInfo.cbCurInst); - XSRETURN(6); - } else if (BytesAvail.cbpipe == 0) { - XSRETURN_NO; - } else { - SV *tmp = NEWSV(914, BytesAvail.cbpipe); - char *s = SvPVX(tmp); - - sv_2mortal(tmp); - os2cp_croak( DosPeekNPipe(hpipe, s, BytesAvail.cbpipe, &BytesRead, - &BytesAvail, &PipeState), "DosPeekNPipe()"); - SvCUR_set(tmp, BytesRead); - *SvEND(tmp) = 0; - SvPOK_on(tmp); - XSprePUSH; PUSHs(tmp); - XSRETURN(1); - } - } - if (message > -1) { - ULONG oflags, flags; - - os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()"); - /* DosSetNPHState fails if more bits than NP_NOWAIT|NP_READMODE_MESSAGE */ - oflags &= (NP_NOWAIT | NP_READMODE_MESSAGE); - flags = (oflags & NP_NOWAIT) - | (message ? NP_READMODE_MESSAGE : NP_READMODE_BYTE); - if (flags != oflags) - os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()"); - } + ULONG rc; + PerlIO *perlio = IoIFP(sv_2io(ST(0))); + IV fn = PerlIO_fileno(perlio); + HPIPE hpipe = (HPIPE)fn; + STRLEN len; + char *s = SvPV(ST(1), len); + int wait = 0, disconnect = 0, connect = 0, message = -1, query = 0; + int peek = 0, state = 0, info = 0; + + if (fn < 0) + Perl_croak(aTHX_ "OS2::pipeCntl(): not a pipe"); + if (items == 3) + wait = (SvTRUE(ST(2)) ? 1 : -1); + + switch (len) { + case 4: + if (strEQ(s, "byte")) + message = 0; + else if (strEQ(s, "peek")) + peek = 1; + else if (strEQ(s, "info")) + info = 1; + else + goto unknown; + break; + case 5: + if (strEQ(s, "reset")) + disconnect = connect = 1; + else if (strEQ(s, "state")) + query = 1; + else + goto unknown; + break; + case 7: + if (strEQ(s, "connect")) + connect = 1; + else if (strEQ(s, "message")) + message = 1; + else + goto unknown; + break; + case 9: + if (!strEQ(s, "readstate")) + goto unknown; + state = 1; + break; + case 10: + if (!strEQ(s, "disconnect")) + goto unknown; + disconnect = 1; + break; + default: + unknown: + Perl_croak(aTHX_ "OS2::pipeCntl(): unknown argument: `%s'", s); + break; + } + + if (items == 3 && !connect) + Perl_croak(aTHX_ "OS2::pipeCntl(): no wait argument for `%s'", s); + + XSprePUSH; /* Do not need arguments any more */ + if (disconnect) { + os2cp_croak(DosDisConnectNPipe(hpipe), "OS2::pipeCntl(): DosDisConnectNPipe()"); + PerlIO_clearerr(perlio); + } + if (connect) { + if (!connectNPipe(hpipe, wait , 1, 0)) + XSRETURN_IV(-1); + } + if (query) { + ULONG flags; + + os2cp_croak(DosQueryNPHState(hpipe, &flags), "DosQueryNPHState()"); + XSRETURN_UV(flags); + } + if (peek || state || info) { + ULONG BytesRead, PipeState; + AVAILDATA BytesAvail; + + os2cp_croak( DosPeekNPipe(hpipe, NULL, 0, &BytesRead, &BytesAvail, + &PipeState), "DosPeekNPipe() for state"); + if (state) { + EXTEND(SP, 3); + mPUSHu(PipeState); + /* Bytes (available/in-message) */ + mPUSHi(BytesAvail.cbpipe); + mPUSHi(BytesAvail.cbmessage); + XSRETURN(3); + } else if (info) { + /* L S S C C C/Z* + ID of the (remote) computer + buffers (out/in) + instances (max/actual) + */ + struct pipe_info_t { + ULONG id; /* char id[4]; */ + PIPEINFO pInfo; + char buf[512]; + } b; + int size; + + os2cp_croak( DosQueryNPipeInfo(hpipe, 1, &b.pInfo, sizeof(b) - STRUCT_OFFSET(struct pipe_info_t, pInfo)), + "DosQueryNPipeInfo(1)"); + os2cp_croak( DosQueryNPipeInfo(hpipe, 2, &b.id, sizeof(b.id)), + "DosQueryNPipeInfo(2)"); + size = b.pInfo.cbName; + /* Trailing 0 is included in cbName - undocumented; so + one should always extract with Z* */ + if (size) /* name length 254 or less */ + size--; + else + size = strlen(b.pInfo.szName); + EXTEND(SP, 6); + mPUSHp(b.pInfo.szName, size); + mPUSHu(b.id); + mPUSHi(b.pInfo.cbOut); + mPUSHi(b.pInfo.cbIn); + mPUSHi(b.pInfo.cbMaxInst); + mPUSHi(b.pInfo.cbCurInst); + XSRETURN(6); + } else if (BytesAvail.cbpipe == 0) { + XSRETURN_NO; + } else { + SV *tmp = NEWSV(914, BytesAvail.cbpipe); + char *s = SvPVX(tmp); + + sv_2mortal(tmp); + os2cp_croak( DosPeekNPipe(hpipe, s, BytesAvail.cbpipe, &BytesRead, + &BytesAvail, &PipeState), "DosPeekNPipe()"); + SvCUR_set(tmp, BytesRead); + *SvEND(tmp) = 0; + SvPOK_on(tmp); + XSprePUSH; PUSHs(tmp); + XSRETURN(1); + } + } + if (message > -1) { + ULONG oflags, flags; + + os2cp_croak(DosQueryNPHState(hpipe, &oflags), "DosQueryNPHState()"); + /* DosSetNPHState fails if more bits than NP_NOWAIT|NP_READMODE_MESSAGE */ + oflags &= (NP_NOWAIT | NP_READMODE_MESSAGE); + flags = (oflags & NP_NOWAIT) + | (message ? NP_READMODE_MESSAGE : NP_READMODE_BYTE); + if (flags != oflags) + os2cp_croak(DosSetNPHState(hpipe, flags), "DosSetNPHState()"); + } } XSRETURN_YES; } @@ -4442,65 +4442,65 @@ XS(XS_OS2_pipeCntl) NO_OUTPUT ULONG DosOpen(PCSZ pszFileName, OUTLIST HFILE hFile, OUTLIST ULONG ulAction, ULONG ulOpenFlags, ULONG ulOpenMode = OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW, ULONG ulAttribute = FILE_NORMAL, ULONG ulFileSize = 0, PEAOP2 pEABuf = NULL); PREINIT: - ULONG rc; + ULONG rc; C_ARGS: - pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf + pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf POSTCALL: - if (CheckOSError(RETVAL)) - croak_with_os2error("OS2::open() error"); + if (CheckOSError(RETVAL)) + croak_with_os2error("OS2::open() error"); */ XS(XS_OS2_open); /* prototype to pass -Wmissing-prototypes */ XS(XS_OS2_open) { dXSARGS; if (items < 2 || items > 6) - Perl_croak(aTHX_ "Usage: OS2::open(pszFileName, ulOpenMode, ulOpenFlags= OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW, ulAttribute= FILE_NORMAL, ulFileSize= 0, pEABuf= NULL)"); + Perl_croak(aTHX_ "Usage: OS2::open(pszFileName, ulOpenMode, ulOpenFlags= OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW, ulAttribute= FILE_NORMAL, ulFileSize= 0, pEABuf= NULL)"); { #line 39 "pipe.xs" - ULONG rc; + ULONG rc; #line 113 "pipe.c" - ULONG RETVAL; - PCSZ pszFileName = ( SvOK(ST(0)) ? (PCSZ)SvPV_nolen(ST(0)) : NULL ); - HFILE hFile; - ULONG ulAction; - ULONG ulOpenMode = (ULONG)SvUV(ST(1)); - ULONG ulOpenFlags; - ULONG ulAttribute; - ULONG ulFileSize; - PEAOP2 pEABuf; - - if (items < 3) - ulOpenFlags = OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW; - else { - ulOpenFlags = (ULONG)SvUV(ST(2)); - } - - if (items < 4) - ulAttribute = FILE_NORMAL; - else { - ulAttribute = (ULONG)SvUV(ST(3)); - } - - if (items < 5) - ulFileSize = 0; - else { - ulFileSize = (ULONG)SvUV(ST(4)); - } - - if (items < 6) - pEABuf = NULL; - else { - pEABuf = (PEAOP2)SvUV(ST(5)); - } - - RETVAL = DosOpen(pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf); - if (CheckOSError(RETVAL)) - croak_with_os2error("OS2::open() error"); - XSprePUSH; EXTEND(SP,2); - PUSHs(sv_newmortal()); - sv_setuv(ST(0), (UV)hFile); - PUSHs(sv_newmortal()); - sv_setuv(ST(1), (UV)ulAction); + ULONG RETVAL; + PCSZ pszFileName = ( SvOK(ST(0)) ? (PCSZ)SvPV_nolen(ST(0)) : NULL ); + HFILE hFile; + ULONG ulAction; + ULONG ulOpenMode = (ULONG)SvUV(ST(1)); + ULONG ulOpenFlags; + ULONG ulAttribute; + ULONG ulFileSize; + PEAOP2 pEABuf; + + if (items < 3) + ulOpenFlags = OPEN_ACTION_OPEN_IF_EXISTS | OPEN_ACTION_FAIL_IF_NEW; + else { + ulOpenFlags = (ULONG)SvUV(ST(2)); + } + + if (items < 4) + ulAttribute = FILE_NORMAL; + else { + ulAttribute = (ULONG)SvUV(ST(3)); + } + + if (items < 5) + ulFileSize = 0; + else { + ulFileSize = (ULONG)SvUV(ST(4)); + } + + if (items < 6) + pEABuf = NULL; + else { + pEABuf = (PEAOP2)SvUV(ST(5)); + } + + RETVAL = DosOpen(pszFileName, &hFile, &ulAction, ulFileSize, ulAttribute, ulOpenFlags, ulOpenMode, pEABuf); + if (CheckOSError(RETVAL)) + croak_with_os2error("OS2::open() error"); + XSprePUSH; EXTEND(SP,2); + PUSHs(sv_newmortal()); + sv_setuv(ST(0), (UV)hFile); + PUSHs(sv_newmortal()); + sv_setuv(ST(1), (UV)ulAction); } XSRETURN(2); } @@ -4510,15 +4510,15 @@ Xs_OS2_init(pTHX) { char *file = __FILE__; { - GV *gv; + GV *gv; - if (_emx_env & 0x200) { /* OS/2 */ + if (_emx_env & 0x200) { /* OS/2 */ newXS("File::Copy::syscopy", XS_File__Copy_syscopy, file); newXS("Cwd::extLibpath", XS_Cwd_extLibpath, file); newXS("Cwd::extLibpath_set", XS_Cwd_extLibpath_set, file); newXS("OS2::extLibpath", XS_Cwd_extLibpath, file); newXS("OS2::extLibpath_set", XS_Cwd_extLibpath_set, file); - } + } newXS("OS2::Error", XS_OS2_Error, file); newXS("OS2::Errors2Drive", XS_OS2_Errors2Drive, file); newXS("OS2::SysInfo", XS_OS2_SysInfo, file); @@ -4559,33 +4559,33 @@ Xs_OS2_init(pTHX) newXSproto("OS2::pipe", XS_OS2_pipe, file, "$$;$$$$$$"); newXSproto("OS2::pipeCntl", XS_OS2_pipeCntl, file, "$$;$"); newXSproto("OS2::open", XS_OS2_open, file, "$$;$$$$"); - gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV); - GvMULTI_on(gv); + gv = gv_fetchpv("OS2::is_aout", TRUE, SVt_PV); + GvMULTI_on(gv); #ifdef PERL_IS_AOUT - sv_setiv(GvSV(gv), 1); + sv_setiv(GvSV(gv), 1); #endif - gv = gv_fetchpv("OS2::is_static", TRUE, SVt_PV); - GvMULTI_on(gv); + gv = gv_fetchpv("OS2::is_static", TRUE, SVt_PV); + GvMULTI_on(gv); #ifdef PERL_IS_AOUT - sv_setiv(GvSV(gv), 1); + sv_setiv(GvSV(gv), 1); #endif - gv = gv_fetchpv("OS2::can_fork", TRUE, SVt_PV); - GvMULTI_on(gv); - sv_setiv(GvSV(gv), exe_is_aout()); - gv = gv_fetchpv("OS2::emx_rev", TRUE, SVt_PV); - GvMULTI_on(gv); - sv_setiv(GvSV(gv), _emx_rev); - sv_setpv(GvSV(gv), _emx_vprt); - SvIOK_on(GvSV(gv)); - gv = gv_fetchpv("OS2::emx_env", TRUE, SVt_PV); - GvMULTI_on(gv); - sv_setiv(GvSV(gv), _emx_env); - gv = gv_fetchpv("OS2::os_ver", TRUE, SVt_PV); - GvMULTI_on(gv); - sv_setnv(GvSV(gv), _osmajor + 0.001 * _osminor); - gv = gv_fetchpv("OS2::nsyserror", TRUE, SVt_PV); - GvMULTI_on(gv); - sv_setiv(GvSV(gv), 1); /* DEFAULT: Show number on syserror */ + gv = gv_fetchpv("OS2::can_fork", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), exe_is_aout()); + gv = gv_fetchpv("OS2::emx_rev", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), _emx_rev); + sv_setpv(GvSV(gv), _emx_vprt); + SvIOK_on(GvSV(gv)); + gv = gv_fetchpv("OS2::emx_env", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), _emx_env); + gv = gv_fetchpv("OS2::os_ver", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setnv(GvSV(gv), _osmajor + 0.001 * _osminor); + gv = gv_fetchpv("OS2::nsyserror", TRUE, SVt_PV); + GvMULTI_on(gv); + sv_setiv(GvSV(gv), 1); /* DEFAULT: Show number on syserror */ } return 0; } @@ -4604,13 +4604,13 @@ my_emx_init(void *layout) { /* Can't just call emx_init(), since it moves the stack pointer */ /* It also busts a lot of registers, so be extra careful */ __asm__( "pushf\n" - "pusha\n" - "movl %%esp, %1\n" - "push %0\n" - "call __emx_init\n" - "movl %1, %%esp\n" - "popa\n" - "popf\n" : : "r" (layout), "m" (old_esp) ); + "pusha\n" + "movl %%esp, %1\n" + "push %0\n" + "call __emx_init\n" + "movl %1, %%esp\n" + "popa\n" + "popf\n" : : "r" (layout), "m" (old_esp) ); } struct layout_table_t { @@ -4639,11 +4639,11 @@ my_os_version() { /* Can't just call __os_version(), since it does not follow C calling convention: it busts a lot of registers, so be extra careful */ __asm__( "pushf\n" - "pusha\n" - "call ___os_version\n" - "movl %%eax, %0\n" - "popa\n" - "popf\n" : "=m" (osv_res) ); + "pusha\n" + "call ___os_version\n" + "movl %%eax, %0\n" + "popa\n" + "popf\n" : "=m" (osv_res) ); return osv_res; } @@ -4661,9 +4661,9 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) char buf[512]; static struct layout_table_t layout_table; struct { - char buf[48*1024]; /* _emx_init() requires 32K, cmd.exe has 64K only */ - double alignment1; - EXCEPTIONREGISTRATIONRECORD xreg; + char buf[48*1024]; /* _emx_init() requires 32K, cmd.exe has 64K only */ + double alignment1; + EXCEPTIONREGISTRATIONRECORD xreg; } *newstack; char *s; @@ -4677,23 +4677,23 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) oldstackend = tib->tib_pstacklimit; if ( (char*)&s < (char*)oldstack + 4*1024 - || (char *)oldstackend < (char*)oldstack + 52*1024 ) - early_error("It is a lunacy to try to run EMX Perl ", - "with less than 64K of stack;\r\n", - " at least with non-EMX starter...\r\n"); + || (char *)oldstackend < (char*)oldstack + 52*1024 ) + early_error("It is a lunacy to try to run EMX Perl ", + "with less than 64K of stack;\r\n", + " at least with non-EMX starter...\r\n"); /* Minimize the damage to the stack via reducing the size of argv. */ if (flags & FORCE_EMX_INIT_CONTRACT_ARGV) { - pib->pib_pchcmd = "\0\0"; /* Need 3 concatenated strings */ - pib->pib_pchcmd = "\0"; /* Ended by an extra \0. */ + pib->pib_pchcmd = "\0\0"; /* Need 3 concatenated strings */ + pib->pib_pchcmd = "\0"; /* Ended by an extra \0. */ } newstack = alloca(sizeof(*newstack)); /* Emulate the stack probe */ s = ((char*)newstack) + sizeof(*newstack); while (s > (char*)newstack) { - s[-1] = 0; - s -= 4096; + s[-1] = 0; + s -= 4096; } /* Reassigning stack is documented to work */ @@ -4707,38 +4707,38 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) Check whether it is inside the new stack. */ buf[0] = 0; if (tib->tib_pexchain >= tib->tib_pstacklimit - || tib->tib_pexchain < tib->tib_pstack) { - error = 1; - sprintf(buf, - "panic: ExceptionHandler misplaced: not %#lx <= %#lx < %#lx\n", - (unsigned long)tib->tib_pstack, - (unsigned long)tib->tib_pexchain, - (unsigned long)tib->tib_pstacklimit); - goto finish; + || tib->tib_pexchain < tib->tib_pstack) { + error = 1; + sprintf(buf, + "panic: ExceptionHandler misplaced: not %#lx <= %#lx < %#lx\n", + (unsigned long)tib->tib_pstack, + (unsigned long)tib->tib_pexchain, + (unsigned long)tib->tib_pstacklimit); + goto finish; } if (tib->tib_pexchain != &(newstack->xreg)) { - sprintf(buf, "ExceptionHandler misplaced: %#lx != %#lx\n", - (unsigned long)tib->tib_pexchain, - (unsigned long)&(newstack->xreg)); + sprintf(buf, "ExceptionHandler misplaced: %#lx != %#lx\n", + (unsigned long)tib->tib_pexchain, + (unsigned long)&(newstack->xreg)); } rc = DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)tib->tib_pexchain); if (rc) - sprintf(buf + strlen(buf), - "warning: DosUnsetExceptionHandler rc=%#lx=%lu\n", rc, rc); + sprintf(buf + strlen(buf), + "warning: DosUnsetExceptionHandler rc=%#lx=%lu\n", rc, rc); if (preg) { - /* ExceptionRecords should be on stack, in a correct order. Sigh... */ - preg->prev_structure = 0; - preg->ExceptionHandler = _emx_exception; - rc = DosSetExceptionHandler(preg); - if (rc) { - sprintf(buf + strlen(buf), - "warning: DosSetExceptionHandler rc=%#lx=%lu\n", rc, rc); - DosWrite(2, buf, strlen(buf), &out); - emx_exception_init = 1; /* Do it around spawn*() calls */ - } + /* ExceptionRecords should be on stack, in a correct order. Sigh... */ + preg->prev_structure = 0; + preg->ExceptionHandler = _emx_exception; + rc = DosSetExceptionHandler(preg); + if (rc) { + sprintf(buf + strlen(buf), + "warning: DosSetExceptionHandler rc=%#lx=%lu\n", rc, rc); + DosWrite(2, buf, strlen(buf), &out); + emx_exception_init = 1; /* Do it around spawn*() calls */ + } } else - emx_exception_init = 1; /* Do it around spawn*() calls */ + emx_exception_init = 1; /* Do it around spawn*() calls */ finish: /* Restore the damage */ @@ -4748,16 +4748,16 @@ force_init_emx_runtime(EXCEPTIONREGISTRATIONRECORD *preg, ULONG flags) tib->tib_pstack = oldstack; emx_runtime_init = 1; if (buf[0]) - DosWrite(2, buf, strlen(buf), &out); + DosWrite(2, buf, strlen(buf), &out); if (error) - exit(56); + exit(56); } static void jmp_out_of_atexit(void) { if (longjmp_at_exit) - longjmp(at_exit_buf, 1); + longjmp(at_exit_buf, 1); } extern void _CRT_term(void); @@ -4766,34 +4766,34 @@ void Perl_OS2_term(void **p, int exitstatus, int flags) { if (!emx_runtime_secondary) - return; + return; /* The principal executable is not running the same CRTL, so there is nobody to shutdown *this* CRTL except us... */ if (flags & FORCE_EMX_DEINIT_EXIT) { - if (p && !emx_exception_init) - DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)p); - /* Do not run the executable's CRTL's termination routines */ - exit(exitstatus); /* Run at-exit, flush buffers, etc */ + if (p && !emx_exception_init) + DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)p); + /* Do not run the executable's CRTL's termination routines */ + exit(exitstatus); /* Run at-exit, flush buffers, etc */ } /* Run at-exit list, and jump out at the end */ if ((flags & FORCE_EMX_DEINIT_RUN_ATEXIT) && !setjmp(at_exit_buf)) { - longjmp_at_exit = 1; - exit(exitstatus); /* The first pass through "if" */ + longjmp_at_exit = 1; + exit(exitstatus); /* The first pass through "if" */ } /* Get here if we managed to jump out of exit(), or did not run atexit. */ longjmp_at_exit = 0; /* Maybe exit() is called again? */ #if 0 /* _atexit_n is not exported */ if (flags & FORCE_EMX_DEINIT_RUN_ATEXIT) - _atexit_n = 0; /* Remove the atexit() handlers */ + _atexit_n = 0; /* Remove the atexit() handlers */ #endif /* Will segfault on program termination if we leave this dangling... */ if (p && !emx_exception_init) - DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)p); + DosUnsetExceptionHandler((EXCEPTIONREGISTRATIONRECORD *)p); /* Typically there is no need to do this, done from _DLL_InitTerm() */ if (flags & FORCE_EMX_DEINIT_CRT_TERM) - _CRT_term(); /* Flush buffers, etc. */ + _CRT_term(); /* Flush buffers, etc. */ /* Now it is a good time to call exit() in the caller's CRTL... */ } @@ -4809,11 +4809,11 @@ check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg) static int emx_init_done = 0; /* If _environ is not set, this code sits in a DLL which - uses a CRT DLL which not compatible with the executable's - CRT library. Some parts of the DLL are not initialized. + uses a CRT DLL which not compatible with the executable's + CRT library. Some parts of the DLL are not initialized. */ if (_environ != NULL) - return; /* Properly initialized */ + return; /* Properly initialized */ /* It is not DOS, so we may use OS/2 API now */ /* Some data we manipulate is static; protect ourselves from @@ -4822,92 +4822,92 @@ check_emx_runtime(char **env, EXCEPTIONREGISTRATIONRECORD *preg) rc1 = DosEnterCritSec(); if (!hmtx_emx_init) - rc = DosCreateMutexSem(NULL, &hmtx_emx_init, 0, TRUE); /*Create owned*/ + rc = DosCreateMutexSem(NULL, &hmtx_emx_init, 0, TRUE); /*Create owned*/ else - maybe_inited = 1; + maybe_inited = 1; if (rc != NO_ERROR) - hmtx_emx_init = NULLHANDLE; + hmtx_emx_init = NULLHANDLE; if (rc1 == NO_ERROR) - DosExitCritSec(); + DosExitCritSec(); DosExitMustComplete(&count); while (maybe_inited) { /* Other thread did or is doing the same now */ - if (emx_init_done) - return; - rc = DosRequestMutexSem(hmtx_emx_init, - (ULONG) SEM_INDEFINITE_WAIT); /* Timeout (none) */ - if (rc == ERROR_INTERRUPT) - continue; - if (rc != NO_ERROR) { - char buf[80]; - ULONG out; - - sprintf(buf, - "panic: EMX backdoor init: DosRequestMutexSem error: %lu=%#lx\n", rc, rc); - DosWrite(2, buf, strlen(buf), &out); - return; - } - DosReleaseMutexSem(hmtx_emx_init); - return; + if (emx_init_done) + return; + rc = DosRequestMutexSem(hmtx_emx_init, + (ULONG) SEM_INDEFINITE_WAIT); /* Timeout (none) */ + if (rc == ERROR_INTERRUPT) + continue; + if (rc != NO_ERROR) { + char buf[80]; + ULONG out; + + sprintf(buf, + "panic: EMX backdoor init: DosRequestMutexSem error: %lu=%#lx\n", rc, rc); + DosWrite(2, buf, strlen(buf), &out); + return; + } + DosReleaseMutexSem(hmtx_emx_init); + return; } /* If the executable does not use EMX.DLL, EMX.DLL is not completely - initialized either. Uninitialized EMX.DLL returns 0 in the low - nibble of __os_version(). */ + initialized either. Uninitialized EMX.DLL returns 0 in the low + nibble of __os_version(). */ v_emx = my_os_version(); /* _osmajor and _osminor are normally set in _DLL_InitTerm of CRT DLL - (=>_CRT_init=>_entry2) via a call to __os_version(), then - reset when the EXE initialization code calls _text=>_init=>_entry2. - The first time they are wrongly set to 0; the second time the - EXE initialization code had already called emx_init=>initialize1 - which correctly set version_major, version_minor used by - __os_version(). */ + (=>_CRT_init=>_entry2) via a call to __os_version(), then + reset when the EXE initialization code calls _text=>_init=>_entry2. + The first time they are wrongly set to 0; the second time the + EXE initialization code had already called emx_init=>initialize1 + which correctly set version_major, version_minor used by + __os_version(). */ v_crt = (_osmajor | _osminor); if ((_emx_env & 0x200) && !(v_emx & 0xFFFF)) { /* OS/2, EMX uninit. */ - force_init_emx_runtime( preg, - FORCE_EMX_INIT_CONTRACT_ARGV - | FORCE_EMX_INIT_INSTALL_ATEXIT ); - emx_wasnt_initialized = 1; - /* Update CRTL data basing on now-valid EMX runtime data */ - if (!v_crt) { /* The only wrong data are the versions. */ - v_emx = my_os_version(); /* *Now* it works */ - *(unsigned char *)&_osmajor = v_emx & 0xFF; /* Cast out const */ - *(unsigned char *)&_osminor = (v_emx>>8) & 0xFF; - } + force_init_emx_runtime( preg, + FORCE_EMX_INIT_CONTRACT_ARGV + | FORCE_EMX_INIT_INSTALL_ATEXIT ); + emx_wasnt_initialized = 1; + /* Update CRTL data basing on now-valid EMX runtime data */ + if (!v_crt) { /* The only wrong data are the versions. */ + v_emx = my_os_version(); /* *Now* it works */ + *(unsigned char *)&_osmajor = v_emx & 0xFF; /* Cast out const */ + *(unsigned char *)&_osminor = (v_emx>>8) & 0xFF; + } } emx_runtime_secondary = 1; /* if (flags & FORCE_EMX_INIT_INSTALL_ATEXIT) */ atexit(jmp_out_of_atexit); /* Allow run of atexit() w/o exit() */ if (env == NULL) { /* Fetch from the process info block */ - int c = 0; - PPIB pib; - PTIB tib; - char *e, **ep; - - DosGetInfoBlocks(&tib, &pib); - e = pib->pib_pchenv; - while (*e) { /* Get count */ - c++; - e = e + strlen(e) + 1; - } - Newx(env, c + 1, char*); - ep = env; - e = pib->pib_pchenv; - while (c--) { - *ep++ = e; - e = e + strlen(e) + 1; - } - *ep = NULL; + int c = 0; + PPIB pib; + PTIB tib; + char *e, **ep; + + DosGetInfoBlocks(&tib, &pib); + e = pib->pib_pchenv; + while (*e) { /* Get count */ + c++; + e = e + strlen(e) + 1; + } + Newx(env, c + 1, char*); + ep = env; + e = pib->pib_pchenv; + while (c--) { + *ep++ = e; + e = e + strlen(e) + 1; + } + *ep = NULL; } _environ = _org_environ = env; emx_init_done = 1; if (hmtx_emx_init) - DosReleaseMutexSem(hmtx_emx_init); + DosReleaseMutexSem(hmtx_emx_init); } #define ENTRY_POINT 0x10000 @@ -4917,16 +4917,16 @@ exe_is_aout(void) { struct layout_table_t *layout; if (emx_wasnt_initialized) - return 0; + return 0; /* Now we know that the principal executable is an EMX application - unless somebody did already play with delayed initialization... */ /* With EMX applications to determine whether it is AOUT one needs to examine the start of the executable to find "layout" */ if ( *(unsigned char*)ENTRY_POINT != 0x68 /* PUSH n */ - || *(unsigned char*)(ENTRY_POINT+5) != 0xe8 /* CALL */ - || *(unsigned char*)(ENTRY_POINT+10) != 0xeb /* JMP */ - || *(unsigned char*)(ENTRY_POINT+12) != 0xe8) /* CALL */ - return 0; /* ! EMX executable */ + || *(unsigned char*)(ENTRY_POINT+5) != 0xe8 /* CALL */ + || *(unsigned char*)(ENTRY_POINT+10) != 0xeb /* JMP */ + || *(unsigned char*)(ENTRY_POINT+12) != 0xe8) /* CALL */ + return 0; /* ! EMX executable */ /* Fix alignment */ Copy((char*)(ENTRY_POINT+1), &layout, 1, struct layout_table_t*); return !(layout->flags & 2); @@ -4952,25 +4952,25 @@ Perl_OS2_init3(char **env, void **preg, int flags) settmppath(); OS2_Perl_data.xs_init = &Xs_OS2_init; if (perl_sh_installed) { - int l = strlen(perl_sh_installed); + int l = strlen(perl_sh_installed); - Newx(PL_sh_path, l + 1, char); - memcpy(PL_sh_path, perl_sh_installed, l + 1); + Newx(PL_sh_path, l + 1, char); + memcpy(PL_sh_path, perl_sh_installed, l + 1); } else if ( (shell = PerlEnv_getenv("PERL_SH_DRIVE")) ) { - Newx(PL_sh_path, strlen(SH_PATH) + 1, char); - strcpy(PL_sh_path, SH_PATH); - PL_sh_path[0] = shell[0]; + Newx(PL_sh_path, strlen(SH_PATH) + 1, char); + strcpy(PL_sh_path, SH_PATH); + PL_sh_path[0] = shell[0]; } else if ( (shell = PerlEnv_getenv("PERL_SH_DIR")) ) { - int l = strlen(shell), i; - - while (l && (shell[l-1] == '/' || shell[l-1] == '\\')) - l--; - Newx(PL_sh_path, l + 8, char); - strncpy(PL_sh_path, shell, l); - strcpy(PL_sh_path + l, "/sh.exe"); - for (i = 0; i < l; i++) { - if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/'; - } + int l = strlen(shell), i; + + while (l && (shell[l-1] == '/' || shell[l-1] == '\\')) + l--; + Newx(PL_sh_path, l + 8, char); + strncpy(PL_sh_path, shell, l); + strcpy(PL_sh_path + l, "/sh.exe"); + for (i = 0; i < l; i++) { + if (PL_sh_path[i] == '\\') PL_sh_path[i] = '/'; + } } MUTEX_INIT(&start_thread_mutex); MUTEX_INIT(&perlos2_state_mutex); @@ -4984,19 +4984,19 @@ Perl_OS2_init3(char **env, void **preg, int flags) else rc = fill_extLibpath(0, PerlEnv_getenv("PERL_PRE_BEGINLIBPATH"), PerlEnv_getenv("PERL_POST_BEGINLIBPATH"), 0, "PERL_(PRE/POST)_BEGINLIBPATH"); if (!rc) { - s = PerlEnv_getenv("PERL_ENDLIBPATH"); - if (s) - rc = fill_extLibpath(1, s, NULL, 1, "PERL_ENDLIBPATH"); - else - rc = fill_extLibpath(1, PerlEnv_getenv("PERL_PRE_ENDLIBPATH"), PerlEnv_getenv("PERL_POST_ENDLIBPATH"), 0, "PERL_(PRE/POST)_ENDLIBPATH"); + s = PerlEnv_getenv("PERL_ENDLIBPATH"); + if (s) + rc = fill_extLibpath(1, s, NULL, 1, "PERL_ENDLIBPATH"); + else + rc = fill_extLibpath(1, PerlEnv_getenv("PERL_PRE_ENDLIBPATH"), PerlEnv_getenv("PERL_POST_ENDLIBPATH"), 0, "PERL_(PRE/POST)_ENDLIBPATH"); } if (rc) { - char buf[1024]; + char buf[1024]; - snprintf(buf, sizeof buf, "Error setting BEGIN/ENDLIBPATH: %s\n", - os2error(rc)); - DosWrite(2, buf, strlen(buf), &rc); - exit(2); + snprintf(buf, sizeof buf, "Error setting BEGIN/ENDLIBPATH: %s\n", + os2error(rc)); + DosWrite(2, buf, strlen(buf), &rc); + exit(2); } _emxload_env("PERL_EMXLOAD_SECS"); @@ -5011,10 +5011,10 @@ fd_ok(int fd) if (!(_emx_env & 0x200)) return 1; /* not OS/2. */ if (fd >= max_fh) { /* Renew */ - LONG delta = 0; + LONG delta = 0; - if (DosSetRelMaxFH(&delta, &max_fh)) /* Assume it OK??? */ - return 1; + if (DosSetRelMaxFH(&delta, &max_fh)) /* Assume it OK??? */ + return 1; } return fd < max_fh; } @@ -5024,7 +5024,7 @@ int dup2(int from, int to) { if (fd_ok(from < to ? to : from)) - return _dup2(from, to); + return _dup2(from, to); errno = EBADF; return -1; } @@ -5033,7 +5033,7 @@ int dup(int from) { if (fd_ok(from)) - return _dup(from); + return _dup(from); errno = EBADF; return -1; } @@ -5050,9 +5050,9 @@ my_tmpnam (char *str) ENV_LOCK; tpath = tempnam(p, "pltmp"); if (str && tpath) { - strcpy(str, tpath); + strcpy(str, tpath); ENV_UNLOCK; - return str; + return str; } ENV_UNLOCK; return tpath; @@ -5065,10 +5065,10 @@ my_tmpfile () stat(".", &s); if (s.st_mode & S_IWOTH) { - return tmpfile(); + return tmpfile(); } return fopen(my_tmpnam(NULL), "w+b"); /* Race condition, but - grants TMP. */ + grants TMP. */ } #undef rmdir @@ -5085,17 +5085,17 @@ my_rmdir (__const__ char *s) int rc; if (s[l-1] == '/' || s[l-1] == '\\') { /* EMX mkdir fails... */ - if (l >= sizeof b) - Newx(buf, l + 1, char); - strcpy(buf,s); - while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\')) - l--; - buf[l] = 0; - s = buf; + if (l >= sizeof b) + Newx(buf, l + 1, char); + strcpy(buf,s); + while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\')) + l--; + buf[l] = 0; + s = buf; } rc = rmdir(s); if (b != buf) - Safefree(buf); + Safefree(buf); return rc; } @@ -5110,17 +5110,17 @@ my_mkdir (__const__ char *s, long perm) int rc; if (s[l-1] == '/' || s[l-1] == '\\') { /* EMX mkdir fails... */ - if (l >= sizeof b) - Newx(buf, l + 1, char); - strcpy(buf,s); - while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\')) - l--; - buf[l] = 0; - s = buf; + if (l >= sizeof b) + Newx(buf, l + 1, char); + strcpy(buf,s); + while (l > 1 && (s[l-1] == '/' || s[l-1] == '\\')) + l--; + buf[l] = 0; + s = buf; } rc = mkdir(s, perm); if (b != buf) - Safefree(buf); + Safefree(buf); return rc; } @@ -5141,9 +5141,9 @@ my_flock(int handle, int o) if (use_my_flock == -1) { char *s = PerlEnv_getenv("USE_PERL_FLOCK"); if (s) - use_my_flock = atoi(s); + use_my_flock = atoi(s); else - use_my_flock = 1; + use_my_flock = 1; } MUTEX_UNLOCK(&perlos2_state_mutex); } @@ -5247,9 +5247,9 @@ use_my_pwent(void) if (_my_pwent == -1) { char *s = PerlEnv_getenv("USE_PERL_PWENT"); if (s) - _my_pwent = atoi(s); + _my_pwent = atoi(s); else - _my_pwent = 1; + _my_pwent = 1; } return _my_pwent; } @@ -5318,11 +5318,11 @@ passw_wrap(struct passwd *p) char *s; if (!p || (p->pw_passwd && *p->pw_passwd)) /* Not a dangerous password */ - return p; + return p; pw = *p; s = PerlEnv_getenv("PW_PASSWD"); if (!s) - s = (char*)pw_p; /* Make match impossible */ + s = (char*)pw_p; /* Make match impossible */ pw.pw_passwd = s; @@ -5385,51 +5385,51 @@ int fork_with_resources() #endif { /* Reload loaded-on-demand DLLs */ - struct dll_handle_t *dlls = dll_handles; - - while (dlls->modname) { - char dllname[260], fail[260]; - ULONG rc; - - if (!dlls->handle) { /* Was not loaded */ - dlls++; - continue; - } - /* It was loaded in the parent. We need to reload it. */ - - rc = DosQueryModuleName(dlls->handle, sizeof(dllname), dllname); - if (rc) { - Perl_warn_nocontext("Can't find DLL name for the module `%s' by the handle %d, rc=%lu=%#lx", - dlls->modname, (int)dlls->handle, rc, rc); - dlls++; - continue; - } - rc = DosLoadModule(fail, sizeof fail, dllname, &dlls->handle); - if (rc) - Perl_warn_nocontext("Can't load DLL `%s', possible problematic module `%s'", - dllname, fail); - dlls++; - } + struct dll_handle_t *dlls = dll_handles; + + while (dlls->modname) { + char dllname[260], fail[260]; + ULONG rc; + + if (!dlls->handle) { /* Was not loaded */ + dlls++; + continue; + } + /* It was loaded in the parent. We need to reload it. */ + + rc = DosQueryModuleName(dlls->handle, sizeof(dllname), dllname); + if (rc) { + Perl_warn_nocontext("Can't find DLL name for the module `%s' by the handle %d, rc=%lu=%#lx", + dlls->modname, (int)dlls->handle, rc, rc); + dlls++; + continue; + } + rc = DosLoadModule(fail, sizeof fail, dllname, &dlls->handle); + if (rc) + Perl_warn_nocontext("Can't load DLL `%s', possible problematic module `%s'", + dllname, fail); + dlls++; + } } { /* Support message queue etc. */ - os2_mytype = my_type(); - /* Apparently, subprocesses (in particular, fork()) do not - inherit the morphed state, so os2_mytype is the same as - os2_mytype_ini. */ - - if (Perl_os2_initial_mode != -1 - && Perl_os2_initial_mode != os2_mytype) { - /* XXXX ??? */ - } + os2_mytype = my_type(); + /* Apparently, subprocesses (in particular, fork()) do not + inherit the morphed state, so os2_mytype is the same as + os2_mytype_ini. */ + + if (Perl_os2_initial_mode != -1 + && Perl_os2_initial_mode != os2_mytype) { + /* XXXX ??? */ + } } if (Perl_HAB_set) - (void)_obtain_Perl_HAB; + (void)_obtain_Perl_HAB; if (Perl_hmq_refcnt) { - if (my_type() != 3) - my_type_set(3); - Create_HMQ(Perl_hmq_servers != 0, - "Cannot create a message queue on fork"); + if (my_type() != 3) + my_type_set(3); + Create_HMQ(Perl_hmq_servers != 0, + "Cannot create a message queue on fork"); } /* We may have loaded some modules */ @@ -5454,7 +5454,7 @@ myDosGetInfoSeg(PGINFOSEG *pGlobal, PLINFOSEG *pLocal) _THUNK_FLAT (&lSel); _THUNK_CALL (Dos16GetInfoSeg))); if (rc) - return rc; + return rc; *pGlobal = MAKEPGINFOSEG(gSel); *pLocal = MAKEPLINFOSEG(lSel); return rc; diff --git a/os2/os2ish.h b/os2/os2ish.h index e209fb560500..1acc2765c215 100644 --- a/os2/os2ish.h +++ b/os2/os2ish.h @@ -117,68 +117,68 @@ extern int rc; #define MUTEX_INIT(m) \ STMT_START { \ - int rc; \ - if ((rc = _rmutex_create(m,0))) \ - Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \ + int rc; \ + if ((rc = _rmutex_create(m,0))) \ + Perl_croak_nocontext("panic: MUTEX_INIT: rc=%i", rc); \ } STMT_END #define MUTEX_LOCK(m) \ STMT_START { \ - int rc; \ - if ((rc = _rmutex_request(m,_FMR_IGNINT))) \ - Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \ + int rc; \ + if ((rc = _rmutex_request(m,_FMR_IGNINT))) \ + Perl_croak_nocontext("panic: MUTEX_LOCK: rc=%i", rc); \ } STMT_END #define MUTEX_UNLOCK(m) \ STMT_START { \ - int rc; \ - if ((rc = _rmutex_release(m))) \ - Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \ + int rc; \ + if ((rc = _rmutex_release(m))) \ + Perl_croak_nocontext("panic: MUTEX_UNLOCK: rc=%i", rc); \ } STMT_END #define MUTEX_DESTROY(m) \ STMT_START { \ - int rc; \ - if ((rc = _rmutex_close(m))) \ - Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \ + int rc; \ + if ((rc = _rmutex_close(m))) \ + Perl_croak_nocontext("panic: MUTEX_DESTROY: rc=%i", rc); \ } STMT_END #define COND_INIT(c) \ STMT_START { \ - int rc; \ - if ((rc = DosCreateEventSem(NULL,c,0,0))) \ - Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \ + int rc; \ + if ((rc = DosCreateEventSem(NULL,c,0,0))) \ + Perl_croak_nocontext("panic: COND_INIT: rc=%i", rc); \ } STMT_END #define COND_SIGNAL(c) \ STMT_START { \ - int rc; \ - if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ - Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \ + int rc; \ + if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ + Perl_croak_nocontext("panic: COND_SIGNAL, rc=%ld", rc); \ } STMT_END #define COND_BROADCAST(c) \ STMT_START { \ - int rc; \ - if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ - Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \ + int rc; \ + if ((rc = DosPostEventSem(*(c))) && rc != OS2_ERROR_ALREADY_POSTED)\ + Perl_croak_nocontext("panic: COND_BROADCAST, rc=%i", rc); \ } STMT_END /* #define COND_WAIT(c, m) \ STMT_START { \ - if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \ - Perl_croak_nocontext("panic: COND_WAIT"); \ + if (WaitForSingleObject(*(c),INFINITE) == WAIT_FAILED) \ + Perl_croak_nocontext("panic: COND_WAIT"); \ } STMT_END */ #define COND_WAIT(c, m) os2_cond_wait(c,m) #define COND_WAIT_win32(c, m) \ STMT_START { \ - int rc; \ - if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \ - Perl_croak_nocontext("panic: COND_WAIT"); \ - else \ - MUTEX_LOCK(m); \ + int rc; \ + if ((rc = SignalObjectAndWait(*(m),*(c),INFINITE,FALSE))) \ + Perl_croak_nocontext("panic: COND_WAIT"); \ + else \ + MUTEX_LOCK(m); \ } STMT_END #define COND_DESTROY(c) \ STMT_START { \ - int rc; \ - if ((rc = DosCloseEventSem(*(c)))) \ - Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \ + int rc; \ + if ((rc = DosCloseEventSem(*(c)))) \ + Perl_croak_nocontext("panic: COND_DESTROY, rc=%i", rc); \ } STMT_END /*#define THR ((struct thread *) TlsGetValue(PL_thr_key)) */ @@ -191,10 +191,10 @@ extern int rc; # define pthread_getspecific(k) (*(k)) # define pthread_setspecific(k,v) (*(k)=(v),0) # define pthread_key_create(keyp,flag) \ - ( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \ - ? Perl_croak_nocontext("LocalMemory"),1 \ - : 0 \ - ) + ( DosAllocThreadLocalMemory(1,(unsigned long**)keyp) \ + ? Perl_croak_nocontext("LocalMemory"),1 \ + : 0 \ + ) #endif /* USE_SLOW_THREAD_SPECIFIC */ #define pthread_key_delete(keyp) #define pthread_self() _gettid() @@ -204,7 +204,7 @@ extern int rc; int pthread_join(pthread_t tid, void **status); int pthread_detach(pthread_t tid); int pthread_create(pthread_t *tid, const pthread_attr_t *attr, - void *(*start_routine)(void*), void *arg); + void *(*start_routine)(void*), void *arg); #endif /* PTHREAD_INCLUDED */ #define THREADS_ELSEWHERE @@ -410,10 +410,10 @@ void *emx_realloc (void *, size_t); /* This guy is needed for quick stdstd */ #if defined(USE_STDIO_PTR) && defined(STDIO_PTR_LVALUE) && defined(STDIO_CNT_LVALUE) - /* Perl uses ungetc only with successful return */ + /* Perl uses ungetc only with successful return */ # define ungetc(c,fp) \ - (FILE_ptr(fp) > FILE_base(fp) && c == (int)*(FILE_ptr(fp) - 1) \ - ? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp)) + (FILE_ptr(fp) > FILE_base(fp) && c == (int)*(FILE_ptr(fp) - 1) \ + ? (--FILE_ptr(fp), ++FILE_cnt(fp), (int)c) : ungetc(c,fp)) #endif #define PERLIO_IS_BINMODE_FD(fd) _PERLIO_IS_BINMODE_FD(fd) @@ -500,8 +500,8 @@ extern OS2_Perl_data_t OS2_Perl_data; #define set_Perl_HAB_f (OS2_Perl_flags |= Perl_HAB_set_f) #define set_Perl_HAB(h) (set_Perl_HAB_f, Perl_hab = h) #define _obtain_Perl_HAB (init_PMWIN_entries(), \ - Perl_hab = (*PMWIN_entries.Initialize)(0), \ - set_Perl_HAB_f, Perl_hab) + Perl_hab = (*PMWIN_entries.Initialize)(0), \ + set_Perl_HAB_f, Perl_hab) #define perl_hab_GET() (Perl_HAB_set ? Perl_hab : _obtain_Perl_HAB) #define Acquire_hab() perl_hab_GET() #define Perl_hmq ((HMQ)OS2_Perl_data.phmq) @@ -524,11 +524,11 @@ struct PMWIN_entries_t { unsigned long (*CreateMsgQueue)(unsigned long hab, long cmsg); int (*DestroyMsgQueue)(unsigned long hmq); int (*PeekMsg)(unsigned long hab, struct _QMSG *pqmsg, - unsigned long hwndFilter, unsigned long msgFilterFirst, - unsigned long msgFilterLast, unsigned long fl); + unsigned long hwndFilter, unsigned long msgFilterFirst, + unsigned long msgFilterLast, unsigned long fl); int (*GetMsg)(unsigned long hab, struct _QMSG *pqmsg, - unsigned long hwndFilter, unsigned long msgFilterFirst, - unsigned long msgFilterLast); + unsigned long hwndFilter, unsigned long msgFilterFirst, + unsigned long msgFilterLast); void * (*DispatchMsg)(unsigned long hab, struct _QMSG *pqmsg); unsigned long (*GetLastError)(unsigned long hab); unsigned long (*CancelShutdown)(unsigned long hmq, unsigned long fCancelAlways); @@ -543,7 +543,7 @@ void init_PMWIN_entries(void); #if _EMX_CRT_REV_ >= 60 # define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2_set, \ - _setsyserrno(rc)) + _setsyserrno(rc)) #else # define os2_setsyserrno(rc) (Perl_rc = rc, errno = errno_isOS2) #endif @@ -562,11 +562,11 @@ void init_PMWIN_entries(void); ((expr) ? : (CroakWinError(die,name1 name2), 0)) #define FillOSError(rc) (os2_setsyserrno(rc), \ - Perl_severity = SEVERITY_ERROR) + Perl_severity = SEVERITY_ERROR) #define WinError_2_Perl_rc \ ( init_PMWIN_entries(), \ - Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()) ) + Perl_rc=(*PMWIN_entries.GetLastError)(perl_hab_GET()) ) /* Calling WinGetLastError() resets the error code of the current thread. Since for some Win* API return value 0 is normal, one needs to call @@ -576,9 +576,9 @@ void init_PMWIN_entries(void); /* At this moment init_PMWIN_entries() should be a nop (WinInitialize should be called already, right?), so we do not risk stepping over our own error */ #define FillWinError ( WinError_2_Perl_rc, \ - Perl_severity = ERRORIDSEV(Perl_rc), \ - Perl_rc = ERRORIDERROR(Perl_rc), \ - os2_setsyserrno(Perl_rc)) + Perl_severity = ERRORIDSEV(Perl_rc), \ + Perl_rc = ERRORIDERROR(Perl_rc), \ + os2_setsyserrno(Perl_rc)) #define STATIC_FILE_LENGTH 127 @@ -726,38 +726,38 @@ enum entries_ordinals { /* This flavor caches the procedure pointer (named as p__Win#name) locally */ #define DeclWinFuncByORD_CACHE(ret,name,o,at,args) \ - DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,1) + DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,1) /* This flavor may reset the last error before the call (if ret=0 may be OK) */ #define DeclWinFuncByORD_CACHE_resetError(ret,name,o,at,args) \ - DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,1) + DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,1) /* Two flavors below do the same as above, but do not auto-croak */ /* This flavor caches the procedure pointer (named as p__Win#name) locally */ #define DeclWinFuncByORD_CACHE_survive(ret,name,o,at,args) \ - DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,0) + DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,0,0) /* This flavor may reset the last error before the call (if ret=0 may be OK) */ #define DeclWinFuncByORD_CACHE_resetError_survive(ret,name,o,at,args) \ - DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,0) + DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,1,0) #define DeclWinFuncByORD_CACHE_r(ret,name,o,at,args,r,die) \ static ret (*CAT2(p__Win,name)) at; \ static ret name at { \ - if (!CAT2(p__Win,name)) \ - AssignFuncPByORD(CAT2(p__Win,name), o); \ - if (r) ResetWinError(); \ - return SaveCroakWinError(CAT2(p__Win,name) args, die, "[Win]", STRINGIFY(name)); } + if (!CAT2(p__Win,name)) \ + AssignFuncPByORD(CAT2(p__Win,name), o); \ + if (r) ResetWinError(); \ + return SaveCroakWinError(CAT2(p__Win,name) args, die, "[Win]", STRINGIFY(name)); } /* These flavors additionally assume ORD is name with prepended ORD_Win */ #define DeclWinFunc_CACHE(ret,name,at,args) \ - DeclWinFuncByORD_CACHE(ret,name,CAT2(ORD_Win,name),at,args) + DeclWinFuncByORD_CACHE(ret,name,CAT2(ORD_Win,name),at,args) #define DeclWinFunc_CACHE_resetError(ret,name,at,args) \ - DeclWinFuncByORD_CACHE_resetError(ret,name,CAT2(ORD_Win,name),at,args) + DeclWinFuncByORD_CACHE_resetError(ret,name,CAT2(ORD_Win,name),at,args) #define DeclWinFunc_CACHE_survive(ret,name,at,args) \ - DeclWinFuncByORD_CACHE_survive(ret,name,CAT2(ORD_Win,name),at,args) + DeclWinFuncByORD_CACHE_survive(ret,name,CAT2(ORD_Win,name),at,args) #define DeclWinFunc_CACHE_resetError_survive(ret,name,at,args) \ - DeclWinFuncByORD_CACHE_resetError_survive(ret,name,CAT2(ORD_Win,name),at,args) + DeclWinFuncByORD_CACHE_resetError_survive(ret,name,CAT2(ORD_Win,name),at,args) void ResetWinError(void); void CroakWinError(int die, char *name); @@ -815,12 +815,12 @@ void croak_with_os2error(char *s) __attribute__((noreturn)); /* propagates rc */ #define os2win_croak(rc,msg) \ - SaveCroakWinError((expr), 1 /* die */, /* no prefix */, (msg)) + SaveCroakWinError((expr), 1 /* die */, /* no prefix */, (msg)) /* propagates rc; use with functions which may return 0 on success */ #define os2win_croak_0OK(rc,msg) \ - SaveCroakWinError((ResetWinError, (expr)), \ - 1 /* die */, /* no prefix */, (msg)) + SaveCroakWinError((ResetWinError, (expr)), \ + 1 /* die */, /* no prefix */, (msg)) #ifdef PERL_CORE int os2_do_spawn(pTHX_ char *cmd); @@ -840,7 +840,7 @@ int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp); # define LOG_DEBUG 7 /* debug-level messages */ # define LOG_PRIMASK 0x007 /* mask to extract priority part (internal) */ - /* extract priority */ + /* extract priority */ # define LOG_PRI(p) ((p) & LOG_PRIMASK) # define LOG_MAKEPRI(fac, pri) (((fac) << 3) | (pri)) @@ -855,7 +855,7 @@ int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp); # define LOG_NEWS (7<<3) /* network news subsystem */ # define LOG_UUCP (8<<3) /* UUCP subsystem */ # define LOG_CRON (15<<3) /* clock daemon */ - /* other codes through 15 reserved for system use */ + /* other codes through 15 reserved for system use */ # define LOG_LOCAL0 (16<<3) /* reserved for local use */ # define LOG_LOCAL1 (17<<3) /* reserved for local use */ # define LOG_LOCAL2 (18<<3) /* reserved for local use */ @@ -867,7 +867,7 @@ int os2_do_aspawn(pTHX_ SV *really, SV **vmark, SV **vsp); # define LOG_NFACILITIES 24 /* current number of facilities */ # define LOG_FACMASK 0x03f8 /* mask to extract facility part */ - /* facility of pri */ + /* facility of pri */ # define LOG_FAC(p) (((p) & LOG_FACMASK) >> 3) /* @@ -1080,7 +1080,7 @@ unsigned long LIS_pPIB; /* Pointer to PIB */ /* ************************************************************ */ #define Dos32QuerySysState DosQuerySysState #define QuerySysState(flags, pid, buf, bufsz) \ - Dos32QuerySysState(flags, 0, pid, 0, buf, bufsz) + Dos32QuerySysState(flags, 0, pid, 0, buf, bufsz) #define QSS_PROCESS 1 #define QSS_MODULE 4 @@ -1091,156 +1091,156 @@ unsigned long LIS_pPIB; /* Pointer to PIB */ #ifdef _OS2_H APIRET APIENTRY Dos32QuerySysState(ULONG func,ULONG arg1,ULONG pid, - ULONG _res_,PVOID buf,ULONG bufsz); + ULONG _res_,PVOID buf,ULONG bufsz); typedef struct { - ULONG threadcnt; - ULONG proccnt; - ULONG modulecnt; + ULONG threadcnt; + ULONG proccnt; + ULONG modulecnt; } QGLOBAL, *PQGLOBAL; typedef struct { - ULONG rectype; - USHORT threadid; - USHORT slotid; - ULONG sleepid; - ULONG priority; - ULONG systime; - ULONG usertime; - UCHAR state; - UCHAR _reserved1_; /* padding to ULONG */ - USHORT _reserved2_; /* padding to ULONG */ + ULONG rectype; + USHORT threadid; + USHORT slotid; + ULONG sleepid; + ULONG priority; + ULONG systime; + ULONG usertime; + UCHAR state; + UCHAR _reserved1_; /* padding to ULONG */ + USHORT _reserved2_; /* padding to ULONG */ } QTHREAD, *PQTHREAD; typedef struct { - USHORT sfn; - USHORT refcnt; - USHORT flags1; - USHORT flags2; - USHORT accmode1; - USHORT accmode2; - ULONG filesize; - USHORT volhnd; - USHORT attrib; - USHORT _reserved_; + USHORT sfn; + USHORT refcnt; + USHORT flags1; + USHORT flags2; + USHORT accmode1; + USHORT accmode2; + ULONG filesize; + USHORT volhnd; + USHORT attrib; + USHORT _reserved_; } QFDS, *PQFDS; typedef struct qfile { - ULONG rectype; - struct qfile *next; - ULONG opencnt; - PQFDS filedata; - char name[1]; + ULONG rectype; + struct qfile *next; + ULONG opencnt; + PQFDS filedata; + char name[1]; } QFILE, *PQFILE; typedef struct { - ULONG rectype; - PQTHREAD threads; - USHORT pid; - USHORT ppid; - ULONG type; - ULONG state; - ULONG sessid; - USHORT hndmod; - USHORT threadcnt; - ULONG privsem32cnt; - ULONG _reserved2_; - USHORT sem16cnt; - USHORT dllcnt; - USHORT shrmemcnt; - USHORT fdscnt; - PUSHORT sem16s; - PUSHORT dlls; - PUSHORT shrmems; - PUSHORT fds; + ULONG rectype; + PQTHREAD threads; + USHORT pid; + USHORT ppid; + ULONG type; + ULONG state; + ULONG sessid; + USHORT hndmod; + USHORT threadcnt; + ULONG privsem32cnt; + ULONG _reserved2_; + USHORT sem16cnt; + USHORT dllcnt; + USHORT shrmemcnt; + USHORT fdscnt; + PUSHORT sem16s; + PUSHORT dlls; + PUSHORT shrmems; + PUSHORT fds; } QPROCESS, *PQPROCESS; typedef struct sema { - struct sema *next; - USHORT refcnt; - UCHAR sysflags; - UCHAR sysproccnt; - ULONG _reserved1_; - USHORT index; - CHAR name[1]; + struct sema *next; + USHORT refcnt; + UCHAR sysflags; + UCHAR sysproccnt; + ULONG _reserved1_; + USHORT index; + CHAR name[1]; } QSEMA, *PQSEMA; typedef struct { - ULONG rectype; - ULONG _reserved1_; - USHORT _reserved2_; - USHORT syssemidx; - ULONG index; - QSEMA sema; + ULONG rectype; + ULONG _reserved1_; + USHORT _reserved2_; + USHORT syssemidx; + ULONG index; + QSEMA sema; } QSEMSTRUC, *PQSEMSTRUC; typedef struct { - USHORT pid; - USHORT opencnt; + USHORT pid; + USHORT opencnt; } QSEMOWNER32, *PQSEMOWNER32; typedef struct { - PQSEMOWNER32 own; - PCHAR name; - PVOID semrecs; /* array of associated sema's */ - USHORT flags; - USHORT semreccnt; - USHORT waitcnt; - USHORT _reserved_; /* padding to ULONG */ + PQSEMOWNER32 own; + PCHAR name; + PVOID semrecs; /* array of associated sema's */ + USHORT flags; + USHORT semreccnt; + USHORT waitcnt; + USHORT _reserved_; /* padding to ULONG */ } QSEMSMUX32, *PQSEMSMUX32; typedef struct { - PQSEMOWNER32 own; - PCHAR name; - PQSEMSMUX32 mux; - USHORT flags; - USHORT postcnt; + PQSEMOWNER32 own; + PCHAR name; + PQSEMSMUX32 mux; + USHORT flags; + USHORT postcnt; } QSEMEV32, *PQSEMEV32; typedef struct { - PQSEMOWNER32 own; - PCHAR name; - PQSEMSMUX32 mux; - USHORT flags; - USHORT refcnt; - USHORT thrdnum; - USHORT _reserved_; /* padding to ULONG */ + PQSEMOWNER32 own; + PCHAR name; + PQSEMSMUX32 mux; + USHORT flags; + USHORT refcnt; + USHORT thrdnum; + USHORT _reserved_; /* padding to ULONG */ } QSEMMUX32, *PQSEMMUX32; typedef struct semstr32 { - struct semstr *next; - QSEMEV32 evsem; - QSEMMUX32 muxsem; - QSEMSMUX32 smuxsem; + struct semstr *next; + QSEMEV32 evsem; + QSEMMUX32 muxsem; + QSEMSMUX32 smuxsem; } QSEMSTRUC32, *PQSEMSTRUC32; typedef struct shrmem { - struct shrmem *next; - USHORT hndshr; - USHORT selshr; - USHORT refcnt; - CHAR name[1]; + struct shrmem *next; + USHORT hndshr; + USHORT selshr; + USHORT refcnt; + CHAR name[1]; } QSHRMEM, *PQSHRMEM; typedef struct module { - struct module *next; - USHORT hndmod; - USHORT type; - ULONG refcnt; - ULONG segcnt; - PVOID _reserved_; - PCHAR name; - USHORT modref[1]; + struct module *next; + USHORT hndmod; + USHORT type; + ULONG refcnt; + ULONG segcnt; + PVOID _reserved_; + PCHAR name; + USHORT modref[1]; } QMODULE, *PQMODULE; typedef struct { - PQGLOBAL gbldata; - PQPROCESS procdata; - PQSEMSTRUC semadata; - PQSEMSTRUC32 sem32data; - PQSHRMEM shrmemdata; - PQMODULE moddata; - PVOID _reserved2_; - PQFILE filedata; + PQGLOBAL gbldata; + PQPROCESS procdata; + PQSEMSTRUC semadata; + PQSEMSTRUC32 sem32data; + PQSHRMEM shrmemdata; + PQMODULE moddata; + PVOID _reserved2_; + PQFILE filedata; } QTOPLEVEL, *PQTOPLEVEL; /* ************************************************************ */ diff --git a/os2/perlrexx.c b/os2/perlrexx.c index 18d655137d85..8d3237e887da 100644 --- a/os2/perlrexx.c +++ b/os2/perlrexx.c @@ -64,17 +64,17 @@ init_perl(int doparse) char *argv[3] = {"perl_in_REXX", "-e", ""}; if (!perlos2_is_inited) { - perlos2_is_inited = 1; - init_perlos2(); + perlos2_is_inited = 1; + init_perlos2(); } if (my_perl) - return 1; + return 1; if (!PL_do_undump) { - my_perl = perl_alloc(); - if (!my_perl) - return 0; - perl_construct(my_perl); - PL_perl_destruct_level = 1; + my_perl = perl_alloc(); + if (!my_perl) + return 0; + perl_construct(my_perl); + PL_perl_destruct_level = 1; } if (!doparse) return 1; @@ -86,19 +86,19 @@ static char last_error[4096]; static int seterr(char *format, ...) { - va_list va; - char *s = last_error; - - va_start(va, format); - if (s[0]) { - s += strlen(s); - if (s[-1] != '\n') { - snprintf(s, sizeof(last_error) - (s - last_error), "\n"); - s += strlen(s); - } - } - vsnprintf(s, sizeof(last_error) - (s - last_error), format, va); - return 1; + va_list va; + char *s = last_error; + + va_start(va, format); + if (s[0]) { + s += strlen(s); + if (s[-1] != '\n') { + snprintf(s, sizeof(last_error) - (s - last_error), "\n"); + s += strlen(s); + } + } + vsnprintf(s, sizeof(last_error) - (s - last_error), format, va); + return 1; } /* The REXX-callable entrypoints ... */ @@ -112,30 +112,30 @@ ULONG PERL (PCSZ name, LONG rargc, const RXSTRING *rargv, ULONG ret; if (rargc != 1) - return seterr("one argument expected, got %ld", rargc); + return seterr("one argument expected, got %ld", rargc); if (rargv[0].strlength >= sizeof(buf)) - return seterr("length of the argument %ld exceeds the maximum %ld", - rargv[0].strlength, (long)sizeof(buf) - 1); + return seterr("length of the argument %ld exceeds the maximum %ld", + rargv[0].strlength, (long)sizeof(buf) - 1); if (!init_perl(0)) - return 1; + return 1; memcpy(buf, rargv[0].strptr, rargv[0].strlength); buf[rargv[0].strlength] = 0; if (!perl_parse(my_perl, xs_init, 3, argv, (char **)NULL)) - perl_run(my_perl); + perl_run(my_perl); exitstatus = perl_destruct(my_perl); perl_free(my_perl); my_perl = 0; if (exitstatus) - ret = 1; + ret = 1; else { - ret = 0; - sprintf(retstr->strptr, "%s", "ok"); - retstr->strlength = strlen (retstr->strptr); + ret = 0; + sprintf(retstr->strptr, "%s", "ok"); + retstr->strlength = strlen (retstr->strptr); } PERL_SYS_TERM1(0); return ret; @@ -145,7 +145,7 @@ ULONG PERLEXIT (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTRING retstr) { if (rargc != 0) - return seterr("no arguments expected, got %ld", rargc); + return seterr("no arguments expected, got %ld", rargc); PERL_SYS_TERM1(0); return 0; } @@ -154,9 +154,9 @@ ULONG PERLTERM (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTRING retstr) { if (rargc != 0) - return seterr("no arguments expected, got %ld", rargc); + return seterr("no arguments expected, got %ld", rargc); if (!my_perl) - return seterr("no perl interpreter present"); + return seterr("no perl interpreter present"); perl_destruct(my_perl); perl_free(my_perl); my_perl = 0; @@ -171,9 +171,9 @@ ULONG PERLINIT (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTRING retstr) { if (rargc != 0) - return seterr("no argument expected, got %ld", rargc); + return seterr("no argument expected, got %ld", rargc); if (!init_perl(1)) - return 1; + return 1; sprintf(retstr->strptr, "%s", "ok"); retstr->strlength = strlen (retstr->strptr); @@ -186,13 +186,13 @@ PERLLASTERROR (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRX int len = strlen(last_error); if (len <= 256 /* Default buffer is 256-char long */ - || !DosAllocMem((PPVOID)&retstr->strptr, len, - PAG_READ|PAG_WRITE|PAG_COMMIT)) { - memcpy(retstr->strptr, last_error, len); - retstr->strlength = len; + || !DosAllocMem((PPVOID)&retstr->strptr, len, + PAG_READ|PAG_WRITE|PAG_COMMIT)) { + memcpy(retstr->strptr, last_error, len); + retstr->strlength = len; } else { - strcpy(retstr->strptr, "[Not enough memory to copy the errortext]"); - retstr->strlength = strlen(retstr->strptr); + strcpy(retstr->strptr, "[Not enough memory to copy the errortext]"); + retstr->strlength = strlen(retstr->strptr); } return 0; } @@ -206,10 +206,10 @@ PERLEVAL (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTRIN last_error[0] = 0; if (rargc != 1) - return seterr("one argument expected, got %ld", rargc); + return seterr("one argument expected, got %ld", rargc); if (!init_perl(1)) - return seterr("error initializing perl"); + return seterr("error initializing perl"); { dSP; @@ -227,17 +227,17 @@ PERLEVAL (PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTRIN ret = 0; if (SvTRUE(ERRSV)) - ret = seterr(SvPV(ERRSV, n_a)); + ret = seterr(SvPV(ERRSV, n_a)); if (!SvOK(res)) - ret = seterr("undefined value returned by Perl-in-REXX"); + ret = seterr("undefined value returned by Perl-in-REXX"); str = SvPV(res, len); if (len <= 256 /* Default buffer is 256-char long */ - || !DosAllocMem((PPVOID)&retstr->strptr, len, - PAG_READ|PAG_WRITE|PAG_COMMIT)) { - memcpy(retstr->strptr, str, len); - retstr->strlength = len; + || !DosAllocMem((PPVOID)&retstr->strptr, len, + PAG_READ|PAG_WRITE|PAG_COMMIT)) { + memcpy(retstr->strptr, str, len); + retstr->strlength = len; } else - ret = seterr("Not enough memory for the return string of Perl-in-REXX"); + ret = seterr("Not enough memory for the return string of Perl-in-REXX"); FREETMPS; LEAVE; @@ -255,7 +255,7 @@ PERLEVALSUBCOMMAND( ULONG rc = PERLEVAL(NULL, 1, command, NULL, retstr); if (rc) - *flags = RXSUBCOM_ERROR; /* raise error condition */ + *flags = RXSUBCOM_ERROR; /* raise error condition */ return 0; /* finished */ } @@ -284,7 +284,7 @@ PERLEXPORTALL(PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXS int i = -1; while (++i < ArrLength(funcs) - 1) - RexxRegisterFunctionExe(funcs[i].name, funcs[i].f); + RexxRegisterFunctionExe(funcs[i].name, funcs[i].f); RexxRegisterSubcomExe("EVALPERL", (PFN)&PERLEVALSUBCOMMAND, NULL); retstr->strlength = 0; return 0; @@ -296,7 +296,7 @@ PERLDROPALL(PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PRXSTR int i = -1; while (++i < ArrLength(funcs)) - RexxDeregisterFunction(funcs[i].name); + RexxDeregisterFunction(funcs[i].name); RexxDeregisterSubcom("EVALPERL", NULL /* Not a DLL version */); retstr->strlength = 0; return 0; @@ -308,7 +308,7 @@ PERLDROPALLEXIT(PCSZ name, LONG rargc, const RXSTRING *rargv, PCSZ queuename, PR int i = -1; while (++i < ArrLength(funcs)) - RexxDeregisterFunction(funcs[i].name); + RexxDeregisterFunction(funcs[i].name); RexxDeregisterSubcom("EVALPERL", NULL /* Not a DLL version */); PERL_SYS_TERM1(0); retstr->strlength = 0; diff --git a/pad.c b/pad.c index 2af0e1958e9f..543264fc7057 100644 --- a/pad.c +++ b/pad.c @@ -201,19 +201,19 @@ Perl_pad_new(pTHX_ int flags) /* save existing state, ... */ if (flags & padnew_SAVE) { - SAVECOMPPAD(); - if (! (flags & padnew_CLONE)) { - SAVESPTR(PL_comppad_name); + SAVECOMPPAD(); + if (! (flags & padnew_CLONE)) { + SAVESPTR(PL_comppad_name); save_strlen((STRLEN *)&PL_padix); save_strlen((STRLEN *)&PL_constpadix); - save_strlen((STRLEN *)&PL_comppad_name_fill); - save_strlen((STRLEN *)&PL_min_intro_pending); - save_strlen((STRLEN *)&PL_max_intro_pending); - SAVEBOOL(PL_cv_has_eval); - if (flags & padnew_SAVESUB) { - SAVEBOOL(PL_pad_reset_pending); - } - } + save_strlen((STRLEN *)&PL_comppad_name_fill); + save_strlen((STRLEN *)&PL_min_intro_pending); + save_strlen((STRLEN *)&PL_max_intro_pending); + SAVEBOOL(PL_cv_has_eval); + if (flags & padnew_SAVESUB) { + SAVEBOOL(PL_pad_reset_pending); + } + } } /* ... create new pad ... */ @@ -223,16 +223,16 @@ Perl_pad_new(pTHX_ int flags) if (flags & padnew_CLONE) { AV * const a0 = newAV(); /* will be @_ */ - av_store(pad, 0, MUTABLE_SV(a0)); - AvREIFY_only(a0); + av_store(pad, 0, MUTABLE_SV(a0)); + AvREIFY_only(a0); - PadnamelistREFCNT(padname = PL_comppad_name)++; + PadnamelistREFCNT(padname = PL_comppad_name)++; } else { - padlist->xpadl_id = PL_padlist_generation++; - av_store(pad, 0, NULL); - padname = newPADNAMELIST(0); - padnamelist_store(padname, 0, &PL_padname_undef); + padlist->xpadl_id = PL_padlist_generation++; + av_store(pad, 0, NULL); + padname = newPADNAMELIST(0); + padnamelist_store(padname, 0, &PL_padname_undef); } /* Most subroutines never recurse, hence only need 2 entries in the padlist @@ -251,20 +251,20 @@ Perl_pad_new(pTHX_ int flags) PL_curpad = AvARRAY(pad); if (! (flags & padnew_CLONE)) { - PL_comppad_name = padname; - PL_comppad_name_fill = 0; - PL_min_intro_pending = 0; - PL_padix = 0; - PL_constpadix = 0; - PL_cv_has_eval = 0; + PL_comppad_name = padname; + PL_comppad_name_fill = 0; + PL_min_intro_pending = 0; + PL_padix = 0; + PL_constpadix = 0; + PL_cv_has_eval = 0; } DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] new: compcv=0x%" UVxf - " name=0x%" UVxf " flags=0x%" UVxf "\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv), - PTR2UV(padname), (UV)flags - ) + "Pad 0x%" UVxf "[0x%" UVxf "] new: compcv=0x%" UVxf + " name=0x%" UVxf " flags=0x%" UVxf "\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv), + PTR2UV(padname), (UV)flags + ) ); return (PADLIST*)padlist; @@ -302,15 +302,15 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) PERL_ARGS_ASSERT_CV_UNDEF_FLAGS; DEBUG_X(PerlIO_printf(Perl_debug_log, - "CV undef: cv=0x%" UVxf " comppad=0x%" UVxf "\n", - PTR2UV(cv), PTR2UV(PL_comppad)) + "CV undef: cv=0x%" UVxf " comppad=0x%" UVxf "\n", + PTR2UV(cv), PTR2UV(PL_comppad)) ); if (CvFILE(&cvbody)) { - char * file = CvFILE(&cvbody); - CvFILE(&cvbody) = NULL; - if(CvDYNFILE(&cvbody)) - Safefree(file); + char * file = CvFILE(&cvbody); + CvFILE(&cvbody) = NULL; + if(CvDYNFILE(&cvbody)) + Safefree(file); } /* CvSLABBED_off(&cvbody); *//* turned off below */ @@ -332,7 +332,7 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) CvSTART(&cvbody) = NULL; LEAVE; } - else if (CvSLABBED(&cvbody)) { + else if (CvSLABBED(&cvbody)) { if( CvSTART(&cvbody)) { ENTER; PAD_SAVE_SETNULLPAD(); @@ -351,128 +351,128 @@ Perl_cv_undef_flags(pTHX_ CV *cv, U32 flags) } } else { /* dont bother checking if CvXSUB(cv) is true, less branching */ - CvXSUB(&cvbody) = NULL; + CvXSUB(&cvbody) = NULL; } SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */ sv_unmagic((SV *)cv, PERL_MAGIC_checkcall); if (!(flags & CV_UNDEF_KEEP_NAME)) { - if (CvNAMED(&cvbody)) { - CvNAME_HEK_set(&cvbody, NULL); - CvNAMED_off(&cvbody); - } - else CvGV_set(cv, NULL); + if (CvNAMED(&cvbody)) { + CvNAME_HEK_set(&cvbody, NULL); + CvNAMED_off(&cvbody); + } + else CvGV_set(cv, NULL); } /* This statement and the subsequence if block was pad_undef(). */ pad_peg("pad_undef"); if (!CvISXSUB(&cvbody) && CvPADLIST(&cvbody)) { - PADOFFSET ix; - const PADLIST *padlist = CvPADLIST(&cvbody); - - /* Free the padlist associated with a CV. - If parts of it happen to be current, we null the relevant PL_*pad* - global vars so that we don't have any dangling references left. - We also repoint the CvOUTSIDE of any about-to-be-orphaned inner - subs to the outer of this cv. */ - - DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad undef: cv=0x%" UVxf " padlist=0x%" UVxf " comppad=0x%" UVxf "\n", - PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad)) - ); - - /* detach any '&' anon children in the pad; if afterwards they - * are still live, fix up their CvOUTSIDEs to point to our outside, - * bypassing us. */ - - if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */ - CV * const outercv = CvOUTSIDE(&cvbody); - const U32 seq = CvOUTSIDE_SEQ(&cvbody); - PADNAMELIST * const comppad_name = PadlistNAMES(padlist); - PADNAME ** const namepad = PadnamelistARRAY(comppad_name); - PAD * const comppad = PadlistARRAY(padlist)[1]; - SV ** const curpad = AvARRAY(comppad); - for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) { - PADNAME * const name = namepad[ix]; - if (name && PadnamePV(name) && *PadnamePV(name) == '&') - { - CV * const innercv = MUTABLE_CV(curpad[ix]); - U32 inner_rc; - assert(innercv); - assert(SvTYPE(innercv) != SVt_PVFM); - inner_rc = SvREFCNT(innercv); - assert(inner_rc); - - if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */ - curpad[ix] = NULL; - SvREFCNT_dec_NN(innercv); - inner_rc--; - } - - /* in use, not just a prototype */ - if (inner_rc && SvTYPE(innercv) == SVt_PVCV - && (CvOUTSIDE(innercv) == cv)) - { - assert(CvWEAKOUTSIDE(innercv)); - /* don't relink to grandfather if he's being freed */ - if (outercv && SvREFCNT(outercv)) { - CvWEAKOUTSIDE_off(innercv); - CvOUTSIDE(innercv) = outercv; - CvOUTSIDE_SEQ(innercv) = seq; - SvREFCNT_inc_simple_void_NN(outercv); - } - else { - CvOUTSIDE(innercv) = NULL; - } - } - } - } - } - - ix = PadlistMAX(padlist); - while (ix > 0) { - PAD * const sv = PadlistARRAY(padlist)[ix--]; - if (sv) { - if (sv == PL_comppad) { - PL_comppad = NULL; - PL_curpad = NULL; - } - SvREFCNT_dec_NN(sv); - } - } - { - PADNAMELIST * const names = PadlistNAMES(padlist); - if (names == PL_comppad_name && PadnamelistREFCNT(names) == 1) - PL_comppad_name = NULL; - PadnamelistREFCNT_dec(names); - } - if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist)); - Safefree(padlist); - CvPADLIST_set(&cvbody, NULL); + PADOFFSET ix; + const PADLIST *padlist = CvPADLIST(&cvbody); + + /* Free the padlist associated with a CV. + If parts of it happen to be current, we null the relevant PL_*pad* + global vars so that we don't have any dangling references left. + We also repoint the CvOUTSIDE of any about-to-be-orphaned inner + subs to the outer of this cv. */ + + DEBUG_X(PerlIO_printf(Perl_debug_log, + "Pad undef: cv=0x%" UVxf " padlist=0x%" UVxf " comppad=0x%" UVxf "\n", + PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad)) + ); + + /* detach any '&' anon children in the pad; if afterwards they + * are still live, fix up their CvOUTSIDEs to point to our outside, + * bypassing us. */ + + if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */ + CV * const outercv = CvOUTSIDE(&cvbody); + const U32 seq = CvOUTSIDE_SEQ(&cvbody); + PADNAMELIST * const comppad_name = PadlistNAMES(padlist); + PADNAME ** const namepad = PadnamelistARRAY(comppad_name); + PAD * const comppad = PadlistARRAY(padlist)[1]; + SV ** const curpad = AvARRAY(comppad); + for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) { + PADNAME * const name = namepad[ix]; + if (name && PadnamePV(name) && *PadnamePV(name) == '&') + { + CV * const innercv = MUTABLE_CV(curpad[ix]); + U32 inner_rc; + assert(innercv); + assert(SvTYPE(innercv) != SVt_PVFM); + inner_rc = SvREFCNT(innercv); + assert(inner_rc); + + if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */ + curpad[ix] = NULL; + SvREFCNT_dec_NN(innercv); + inner_rc--; + } + + /* in use, not just a prototype */ + if (inner_rc && SvTYPE(innercv) == SVt_PVCV + && (CvOUTSIDE(innercv) == cv)) + { + assert(CvWEAKOUTSIDE(innercv)); + /* don't relink to grandfather if he's being freed */ + if (outercv && SvREFCNT(outercv)) { + CvWEAKOUTSIDE_off(innercv); + CvOUTSIDE(innercv) = outercv; + CvOUTSIDE_SEQ(innercv) = seq; + SvREFCNT_inc_simple_void_NN(outercv); + } + else { + CvOUTSIDE(innercv) = NULL; + } + } + } + } + } + + ix = PadlistMAX(padlist); + while (ix > 0) { + PAD * const sv = PadlistARRAY(padlist)[ix--]; + if (sv) { + if (sv == PL_comppad) { + PL_comppad = NULL; + PL_curpad = NULL; + } + SvREFCNT_dec_NN(sv); + } + } + { + PADNAMELIST * const names = PadlistNAMES(padlist); + if (names == PL_comppad_name && PadnamelistREFCNT(names) == 1) + PL_comppad_name = NULL; + PadnamelistREFCNT_dec(names); + } + if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist)); + Safefree(padlist); + CvPADLIST_set(&cvbody, NULL); } else if (CvISXSUB(&cvbody)) - CvHSCXT(&cvbody) = NULL; + CvHSCXT(&cvbody) = NULL; /* else is (!CvISXSUB(&cvbody) && !CvPADLIST(&cvbody)) {do nothing;} */ /* remove CvOUTSIDE unless this is an undef rather than a free */ if (!SvREFCNT(cv)) { - CV * outside = CvOUTSIDE(&cvbody); - if(outside) { - CvOUTSIDE(&cvbody) = NULL; - if (!CvWEAKOUTSIDE(&cvbody)) - SvREFCNT_dec_NN(outside); - } + CV * outside = CvOUTSIDE(&cvbody); + if(outside) { + CvOUTSIDE(&cvbody) = NULL; + if (!CvWEAKOUTSIDE(&cvbody)) + SvREFCNT_dec_NN(outside); + } } if (CvCONST(&cvbody)) { - SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(&cvbody).any_ptr)); - /* CvCONST_off(cv); *//* turned off below */ + SvREFCNT_dec(MUTABLE_SV(CvXSUBANY(&cvbody).any_ptr)); + /* CvCONST_off(cv); *//* turned off below */ } /* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the * ref status of CvOUTSIDE and CvGV, and ANON, NAMED and * LEXICAL, which are used to determine the sub's name. */ CvFLAGS(&cvbody) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON|CVf_LEXICAL - |CVf_NAMED); + |CVf_NAMED); } /* @@ -508,11 +508,11 @@ Perl_cv_forget_slab(pTHX_ CV *cv) if (slab) { #ifdef PERL_DEBUG_READONLY_OPS - const size_t refcnt = slab->opslab_refcnt; + const size_t refcnt = slab->opslab_refcnt; #endif - OpslabREFCNT_dec(slab); + OpslabREFCNT_dec(slab); #ifdef PERL_DEBUG_READONLY_OPS - if (refcnt > 1) Slab_to_ro(slab); + if (refcnt > 1) Slab_to_ro(slab); #endif } } @@ -534,7 +534,7 @@ is done. Returns the offset of the allocated pad slot. static PADOFFSET S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash, - HV *ourstash) + HV *ourstash) { const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); @@ -543,22 +543,22 @@ S_pad_alloc_name(pTHX_ PADNAME *name, U32 flags, HV *typestash, ASSERT_CURPAD_ACTIVE("pad_alloc_name"); if (typestash) { - SvPAD_TYPED_on(name); - PadnameTYPE(name) = - MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))); + SvPAD_TYPED_on(name); + PadnameTYPE(name) = + MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))); } if (ourstash) { - SvPAD_OUR_on(name); - SvOURSTASH_set(name, ourstash); - SvREFCNT_inc_simple_void_NN(ourstash); + SvPAD_OUR_on(name); + SvOURSTASH_set(name, ourstash); + SvREFCNT_inc_simple_void_NN(ourstash); } else if (flags & padadd_STATE) { - SvPAD_STATE_on(name); + SvPAD_STATE_on(name); } padnamelist_store(PL_comppad_name, offset, name); if (PadnameLEN(name) > 1) - PadnamelistMAXNAMED(PL_comppad_name) = offset; + PadnamelistMAXNAMED(PL_comppad_name) = offset; return offset; } @@ -585,7 +585,7 @@ flags can be OR'ed together: PADOFFSET Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, - U32 flags, HV *typestash, HV *ourstash) + U32 flags, HV *typestash, HV *ourstash) { PADOFFSET offset; PADNAME *name; @@ -593,18 +593,18 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN; if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK)) - Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf, + (UV)flags); name = newPADNAMEpvn(namepv, namelen); if ((flags & padadd_NO_DUP_CHECK) == 0) { - ENTER; - SAVEFREEPADNAME(name); /* in case of fatal warnings */ - /* check for duplicate declaration */ - pad_check_dup(name, flags & padadd_OUR, ourstash); - PadnameREFCNT(name)++; - LEAVE; + ENTER; + SAVEFREEPADNAME(name); /* in case of fatal warnings */ + /* check for duplicate declaration */ + pad_check_dup(name, flags & padadd_OUR, ourstash); + PadnameREFCNT(name)++; + LEAVE; } offset = pad_alloc_name(name, flags, typestash, ourstash); @@ -614,22 +614,22 @@ Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen, COP_SEQ_RANGE_HIGH_set(name, 0); if (!PL_min_intro_pending) - PL_min_intro_pending = offset; + PL_min_intro_pending = offset; PL_max_intro_pending = offset; /* if it's not a simple scalar, replace with an AV or HV */ assert(SvTYPE(PL_curpad[offset]) == SVt_NULL); assert(SvREFCNT(PL_curpad[offset]) == 1); if (namelen != 0 && *namepv == '@') - sv_upgrade(PL_curpad[offset], SVt_PVAV); + sv_upgrade(PL_curpad[offset], SVt_PVAV); else if (namelen != 0 && *namepv == '%') - sv_upgrade(PL_curpad[offset], SVt_PVHV); + sv_upgrade(PL_curpad[offset], SVt_PVHV); else if (namelen != 0 && *namepv == '&') - sv_upgrade(PL_curpad[offset], SVt_PVCV); + sv_upgrade(PL_curpad[offset], SVt_PVCV); assert(SvPADMY(PL_curpad[offset])); DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad addname: %ld \"%s\" new lex=0x%" UVxf "\n", - (long)offset, PadnamePV(name), - PTR2UV(PL_curpad[offset]))); + "Pad addname: %ld \"%s\" new lex=0x%" UVxf "\n", + (long)offset, PadnamePV(name), + PTR2UV(PL_curpad[offset]))); return offset; } @@ -645,7 +645,7 @@ instead of a string/length pair. PADOFFSET Perl_pad_add_name_pv(pTHX_ const char *name, - const U32 flags, HV *typestash, HV *ourstash) + const U32 flags, HV *typestash, HV *ourstash) { PERL_ARGS_ASSERT_PAD_ADD_NAME_PV; return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash); @@ -706,63 +706,63 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype) ASSERT_CURPAD_ACTIVE("pad_alloc"); if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p", - AvARRAY(PL_comppad), PL_curpad); + Perl_croak(aTHX_ "panic: pad_alloc, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (PL_pad_reset_pending) - pad_reset(); + pad_reset(); if (tmptype == SVs_PADMY) { /* Not & because this ‘flag’ is 0. */ - /* For a my, simply push a null SV onto the end of PL_comppad. */ - sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE); - retval = (PADOFFSET)AvFILLp(PL_comppad); + /* For a my, simply push a null SV onto the end of PL_comppad. */ + sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE); + retval = (PADOFFSET)AvFILLp(PL_comppad); } else { - /* For a tmp, scan the pad from PL_padix upwards - * for a slot which has no name and no active value. - * For a constant, likewise, but use PL_constpadix. - */ - PADNAME * const * const names = PadnamelistARRAY(PL_comppad_name); - const SSize_t names_fill = PadnamelistMAX(PL_comppad_name); - const bool konst = cBOOL(tmptype & SVf_READONLY); - retval = konst ? PL_constpadix : PL_padix; - for (;;) { - /* - * Entries that close over unavailable variables - * in outer subs contain values not marked PADMY. - * Thus we must skip, not just pad values that are - * marked as current pad values, but also those with names. - * If pad_reset is enabled, ‘current’ means different - * things depending on whether we are allocating a con- - * stant or a target. For a target, things marked PADTMP - * can be reused; not so for constants. - */ - PADNAME *pn; - if (++retval <= names_fill && - (pn = names[retval]) && PadnamePV(pn)) - continue; - sv = *av_fetch(PL_comppad, retval, TRUE); - if (!(SvFLAGS(sv) & + /* For a tmp, scan the pad from PL_padix upwards + * for a slot which has no name and no active value. + * For a constant, likewise, but use PL_constpadix. + */ + PADNAME * const * const names = PadnamelistARRAY(PL_comppad_name); + const SSize_t names_fill = PadnamelistMAX(PL_comppad_name); + const bool konst = cBOOL(tmptype & SVf_READONLY); + retval = konst ? PL_constpadix : PL_padix; + for (;;) { + /* + * Entries that close over unavailable variables + * in outer subs contain values not marked PADMY. + * Thus we must skip, not just pad values that are + * marked as current pad values, but also those with names. + * If pad_reset is enabled, ‘current’ means different + * things depending on whether we are allocating a con- + * stant or a target. For a target, things marked PADTMP + * can be reused; not so for constants. + */ + PADNAME *pn; + if (++retval <= names_fill && + (pn = names[retval]) && PadnamePV(pn)) + continue; + sv = *av_fetch(PL_comppad, retval, TRUE); + if (!(SvFLAGS(sv) & #ifdef USE_PAD_RESET - (konst ? SVs_PADTMP : 0) + (konst ? SVs_PADTMP : 0) #else - SVs_PADTMP + SVs_PADTMP #endif - )) - break; - } - if (konst) { - padnamelist_store(PL_comppad_name, retval, &PL_padname_const); - tmptype &= ~SVf_READONLY; - tmptype |= SVs_PADTMP; - } - *(konst ? &PL_constpadix : &PL_padix) = retval; + )) + break; + } + if (konst) { + padnamelist_store(PL_comppad_name, retval, &PL_padname_const); + tmptype &= ~SVf_READONLY; + tmptype |= SVs_PADTMP; + } + *(konst ? &PL_constpadix : &PL_padix) = retval; } SvFLAGS(sv) |= tmptype; PL_curpad = AvARRAY(PL_comppad); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] alloc: %ld for %s\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval, - PL_op_name[optype])); + "Pad 0x%" UVxf "[0x%" UVxf "] alloc: %ld for %s\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval, + PL_op_name[optype])); #ifdef DEBUG_LEAKING_SCALARS sv->sv_debug_optype = optype; sv->sv_debug_inpad = 1; @@ -809,9 +809,9 @@ Perl_pad_add_anon(pTHX_ CV* func, I32 optype) /* to avoid ref loops, we never have parent + child referencing each * other simultaneously */ if (CvOUTSIDE(func)) { - assert(!CvWEAKOUTSIDE(func)); - CvWEAKOUTSIDE_on(func); - SvREFCNT_dec_NN(CvOUTSIDE(func)); + assert(!CvWEAKOUTSIDE(func)); + CvWEAKOUTSIDE_on(func); + SvREFCNT_dec_NN(CvOUTSIDE(func)); } return ix; } @@ -862,58 +862,58 @@ S_pad_check_dup(pTHX_ PADNAME *name, U32 flags, const HV *ourstash) assert((flags & ~padadd_OUR) == 0); if (PadnamelistMAX(PL_comppad_name) < 0 || !ckWARN(WARN_SHADOW)) - return; /* nothing to check */ + return; /* nothing to check */ svp = PadnamelistARRAY(PL_comppad_name); top = PadnamelistMAX(PL_comppad_name); /* check the current scope */ for (off = top; off > PL_comppad_name_floor; off--) { - PADNAME * const sv = svp[off]; - if (sv - && PadnameLEN(sv) == PadnameLEN(name) - && !PadnameOUTER(sv) - && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO - || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) - && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name))) - { - if (is_our && (SvPAD_OUR(sv))) - break; /* "our" masking "our" */ - /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */ - Perl_warner(aTHX_ packWARN(WARN_SHADOW), - "\"%s\" %s %" PNf " masks earlier declaration in same %s", - ( is_our ? "our" : + PADNAME * const sv = svp[off]; + if (sv + && PadnameLEN(sv) == PadnameLEN(name) + && !PadnameOUTER(sv) + && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO + || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) + && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name))) + { + if (is_our && (SvPAD_OUR(sv))) + break; /* "our" masking "our" */ + /* diag_listed_as: "%s" variable %s masks earlier declaration in same %s */ + Perl_warner(aTHX_ packWARN(WARN_SHADOW), + "\"%s\" %s %" PNf " masks earlier declaration in same %s", + ( is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : PL_parser->in_my == KEY_sigvar ? "my" : "state" ), - *PadnamePV(sv) == '&' ? "subroutine" : "variable", - PNfARG(sv), - (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO - ? "scope" : "statement")); - --off; - break; - } + *PadnamePV(sv) == '&' ? "subroutine" : "variable", + PNfARG(sv), + (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO + ? "scope" : "statement")); + --off; + break; + } } /* check the rest of the pad */ if (is_our) { - while (off > 0) { - PADNAME * const sv = svp[off]; - if (sv - && PadnameLEN(sv) == PadnameLEN(name) - && !PadnameOUTER(sv) - && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO - || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) - && SvOURSTASH(sv) == ourstash - && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name))) - { - Perl_warner(aTHX_ packWARN(WARN_SHADOW), - "\"our\" variable %" PNf " redeclared", PNfARG(sv)); - if (off <= PL_comppad_name_floor) - Perl_warner(aTHX_ packWARN(WARN_SHADOW), - "\t(Did you mean \"local\" instead of \"our\"?)\n"); - break; - } - --off; - } + while (off > 0) { + PADNAME * const sv = svp[off]; + if (sv + && PadnameLEN(sv) == PadnameLEN(name) + && !PadnameOUTER(sv) + && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO + || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) + && SvOURSTASH(sv) == ourstash + && memEQ(PadnamePV(sv), PadnamePV(name), PadnameLEN(name))) + { + Perl_warner(aTHX_ packWARN(WARN_SHADOW), + "\"our\" variable %" PNf " redeclared", PNfARG(sv)); + if (off <= PL_comppad_name_floor) + Perl_warner(aTHX_ packWARN(WARN_SHADOW), + "\t(Did you mean \"local\" instead of \"our\"?)\n"); + break; + } + --off; + } } } @@ -947,8 +947,8 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) pad_peg("pad_findmy_pvn"); if (flags) - Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf, + (UV)flags); /* compilation errors can zero PL_compcv */ if (!PL_compcv) @@ -957,7 +957,7 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) offset = pad_findlex(namepv, namelen, flags, PL_compcv, PL_cop_seqmax, 1, NULL, &out_pn, &out_flags); if (offset != NOT_IN_PAD) - return offset; + return offset; /* Skip the ‘our’ hack for subroutines, as the warning does not apply. */ @@ -977,8 +977,8 @@ Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags) && ( PadnamePV(name) == namepv || memEQ(PadnamePV(name), namepv, namelen) ) && COP_SEQ_RANGE_LOW(name) == PERL_PADSEQ_INTRO - ) - return offset; + ) + return offset; } return NOT_IN_PAD; } @@ -1088,16 +1088,16 @@ S_unavailable(pTHX_ PADNAME *name) { /* diag_listed_as: Variable "%s" is not available */ Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE), - "%s \"%" PNf "\" is not available", - *PadnamePV(name) == '&' - ? "Subroutine" - : "Variable", - PNfARG(name)); + "%s \"%" PNf "\" is not available", + *PadnamePV(name) == '&' + ? "Subroutine" + : "Variable", + PNfARG(name)); } STATIC PADOFFSET S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, U32 seq, - int warn, SV** out_capture, PADNAME** out_name, int *out_flags) + int warn, SV** out_capture, PADNAME** out_name, int *out_flags) { PADOFFSET offset, new_offset; SV *new_capture; @@ -1109,226 +1109,226 @@ S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, U32 flags, const CV* cv, flags &= ~ padadd_STALEOK; /* one-shot flag */ if (flags) - Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf, - (UV)flags); + Perl_croak(aTHX_ "panic: pad_findlex illegal flag bits 0x%" UVxf, + (UV)flags); *out_flags = 0; DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " searching \"%.*s\" seq=%d%s\n", - PTR2UV(cv), (int)namelen, namepv, (int)seq, - out_capture ? " capturing" : "" )); + "Pad findlex cv=0x%" UVxf " searching \"%.*s\" seq=%d%s\n", + PTR2UV(cv), (int)namelen, namepv, (int)seq, + out_capture ? " capturing" : "" )); /* first, search this pad */ if (padlist) { /* not an undef CV */ - PADOFFSET fake_offset = 0; + PADOFFSET fake_offset = 0; const PADNAMELIST * const names = PadlistNAMES(padlist); - PADNAME * const * const name_p = PadnamelistARRAY(names); + PADNAME * const * const name_p = PadnamelistARRAY(names); - for (offset = PadnamelistMAXNAMED(names); offset > 0; offset--) { + for (offset = PadnamelistMAXNAMED(names); offset > 0; offset--) { const PADNAME * const name = name_p[offset]; if (name && PadnameLEN(name) == namelen && ( PadnamePV(name) == namepv || memEQ(PadnamePV(name), namepv, namelen) )) - { - if (PadnameOUTER(name)) { - fake_offset = offset; /* in case we don't find a real one */ - continue; - } - if (PadnameIN_SCOPE(name, seq)) - break; - } - } - - if (offset > 0 || fake_offset > 0 ) { /* a match! */ - if (offset > 0) { /* not fake */ - fake_offset = 0; - *out_name = name_p[offset]; /* return the name */ - - /* set PAD_FAKELEX_MULTI if this lex can have multiple - * instances. For now, we just test !CvUNIQUE(cv), but - * ideally, we should detect my's declared within loops - * etc - this would allow a wider range of 'not stayed - * shared' warnings. We also treated already-compiled - * lexes as not multi as viewed from evals. */ - - *out_flags = CvANON(cv) ? - PAD_FAKELEX_ANON : - (!CvUNIQUE(cv) && ! CvCOMPILED(cv)) - ? PAD_FAKELEX_MULTI : 0; - - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " matched: offset=%ld (%lu,%lu)\n", - PTR2UV(cv), (long)offset, - (unsigned long)COP_SEQ_RANGE_LOW(*out_name), - (unsigned long)COP_SEQ_RANGE_HIGH(*out_name))); - } - else { /* fake match */ - offset = fake_offset; - *out_name = name_p[offset]; /* return the name */ - *out_flags = PARENT_FAKELEX_FLAGS(*out_name); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " matched: offset=%ld flags=0x%lx index=%lu\n", - PTR2UV(cv), (long)offset, (unsigned long)*out_flags, - (unsigned long) PARENT_PAD_INDEX(*out_name) - )); - } - - /* return the lex? */ - - if (out_capture) { - - /* our ? */ - if (PadnameIsOUR(*out_name)) { - *out_capture = NULL; - return offset; - } - - /* trying to capture from an anon prototype? */ - if (CvCOMPILED(cv) - ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv) - : *out_flags & PAD_FAKELEX_ANON) - { - if (warn) - S_unavailable(aTHX_ - *out_name); - - *out_capture = NULL; - } - - /* real value */ - else { - int newwarn = warn; - if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI) - && !PadnameIsSTATE(name_p[offset]) - && warn && ckWARN(WARN_CLOSURE)) { - newwarn = 0; - /* diag_listed_as: Variable "%s" will not stay - shared */ - Perl_warner(aTHX_ packWARN(WARN_CLOSURE), - "%s \"%" UTF8f "\" will not stay shared", - *namepv == '&' ? "Subroutine" : "Variable", - UTF8fARG(1, namelen, namepv)); - } - - if (fake_offset && CvANON(cv) - && CvCLONE(cv) &&!CvCLONED(cv)) - { - PADNAME *n; - /* not yet caught - look further up */ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " chasing lex in outer pad\n", - PTR2UV(cv))); - n = *out_name; - (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), - CvOUTSIDE_SEQ(cv), - newwarn, out_capture, out_name, out_flags); - *out_name = n; - return offset; - } - - *out_capture = AvARRAY(PadlistARRAY(padlist)[ - CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset]; - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " found lex=0x%" UVxf "\n", - PTR2UV(cv), PTR2UV(*out_capture))); - - if (SvPADSTALE(*out_capture) - && (!CvDEPTH(cv) || !staleok) - && !PadnameIsSTATE(name_p[offset])) - { - S_unavailable(aTHX_ - name_p[offset]); - *out_capture = NULL; - } - } - if (!*out_capture) { - if (namelen != 0 && *namepv == '@') - *out_capture = sv_2mortal(MUTABLE_SV(newAV())); - else if (namelen != 0 && *namepv == '%') - *out_capture = sv_2mortal(MUTABLE_SV(newHV())); - else if (namelen != 0 && *namepv == '&') - *out_capture = sv_2mortal(newSV_type(SVt_PVCV)); - else - *out_capture = sv_newmortal(); - } - } - - return offset; - } + { + if (PadnameOUTER(name)) { + fake_offset = offset; /* in case we don't find a real one */ + continue; + } + if (PadnameIN_SCOPE(name, seq)) + break; + } + } + + if (offset > 0 || fake_offset > 0 ) { /* a match! */ + if (offset > 0) { /* not fake */ + fake_offset = 0; + *out_name = name_p[offset]; /* return the name */ + + /* set PAD_FAKELEX_MULTI if this lex can have multiple + * instances. For now, we just test !CvUNIQUE(cv), but + * ideally, we should detect my's declared within loops + * etc - this would allow a wider range of 'not stayed + * shared' warnings. We also treated already-compiled + * lexes as not multi as viewed from evals. */ + + *out_flags = CvANON(cv) ? + PAD_FAKELEX_ANON : + (!CvUNIQUE(cv) && ! CvCOMPILED(cv)) + ? PAD_FAKELEX_MULTI : 0; + + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad findlex cv=0x%" UVxf " matched: offset=%ld (%lu,%lu)\n", + PTR2UV(cv), (long)offset, + (unsigned long)COP_SEQ_RANGE_LOW(*out_name), + (unsigned long)COP_SEQ_RANGE_HIGH(*out_name))); + } + else { /* fake match */ + offset = fake_offset; + *out_name = name_p[offset]; /* return the name */ + *out_flags = PARENT_FAKELEX_FLAGS(*out_name); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad findlex cv=0x%" UVxf " matched: offset=%ld flags=0x%lx index=%lu\n", + PTR2UV(cv), (long)offset, (unsigned long)*out_flags, + (unsigned long) PARENT_PAD_INDEX(*out_name) + )); + } + + /* return the lex? */ + + if (out_capture) { + + /* our ? */ + if (PadnameIsOUR(*out_name)) { + *out_capture = NULL; + return offset; + } + + /* trying to capture from an anon prototype? */ + if (CvCOMPILED(cv) + ? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv) + : *out_flags & PAD_FAKELEX_ANON) + { + if (warn) + S_unavailable(aTHX_ + *out_name); + + *out_capture = NULL; + } + + /* real value */ + else { + int newwarn = warn; + if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI) + && !PadnameIsSTATE(name_p[offset]) + && warn && ckWARN(WARN_CLOSURE)) { + newwarn = 0; + /* diag_listed_as: Variable "%s" will not stay + shared */ + Perl_warner(aTHX_ packWARN(WARN_CLOSURE), + "%s \"%" UTF8f "\" will not stay shared", + *namepv == '&' ? "Subroutine" : "Variable", + UTF8fARG(1, namelen, namepv)); + } + + if (fake_offset && CvANON(cv) + && CvCLONE(cv) &&!CvCLONED(cv)) + { + PADNAME *n; + /* not yet caught - look further up */ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad findlex cv=0x%" UVxf " chasing lex in outer pad\n", + PTR2UV(cv))); + n = *out_name; + (void) pad_findlex(namepv, namelen, flags, CvOUTSIDE(cv), + CvOUTSIDE_SEQ(cv), + newwarn, out_capture, out_name, out_flags); + *out_name = n; + return offset; + } + + *out_capture = AvARRAY(PadlistARRAY(padlist)[ + CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset]; + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad findlex cv=0x%" UVxf " found lex=0x%" UVxf "\n", + PTR2UV(cv), PTR2UV(*out_capture))); + + if (SvPADSTALE(*out_capture) + && (!CvDEPTH(cv) || !staleok) + && !PadnameIsSTATE(name_p[offset])) + { + S_unavailable(aTHX_ + name_p[offset]); + *out_capture = NULL; + } + } + if (!*out_capture) { + if (namelen != 0 && *namepv == '@') + *out_capture = sv_2mortal(MUTABLE_SV(newAV())); + else if (namelen != 0 && *namepv == '%') + *out_capture = sv_2mortal(MUTABLE_SV(newHV())); + else if (namelen != 0 && *namepv == '&') + *out_capture = sv_2mortal(newSV_type(SVt_PVCV)); + else + *out_capture = sv_newmortal(); + } + } + + return offset; + } } /* it's not in this pad - try above */ if (!CvOUTSIDE(cv)) - return NOT_IN_PAD; + return NOT_IN_PAD; /* out_capture non-null means caller wants us to capture lex; in * addition we capture ourselves unless it's an ANON/format */ new_capturep = out_capture ? out_capture : - CvLATE(cv) ? NULL : &new_capture; + CvLATE(cv) ? NULL : &new_capture; offset = pad_findlex(namepv, namelen, - flags | padadd_STALEOK*(new_capturep == &new_capture), - CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1, - new_capturep, out_name, out_flags); + flags | padadd_STALEOK*(new_capturep == &new_capture), + CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1, + new_capturep, out_name, out_flags); if (offset == NOT_IN_PAD) - return NOT_IN_PAD; + return NOT_IN_PAD; /* found in an outer CV. Add appropriate fake entry to this pad */ /* don't add new fake entries (via eval) to CVs that we have already * finished compiling, or to undef CVs */ if (CvCOMPILED(cv) || !padlist) - return 0; /* this dummy (and invalid) value isnt used by the caller */ + return 0; /* this dummy (and invalid) value isnt used by the caller */ { - PADNAME *new_name = newPADNAMEouter(*out_name); - PADNAMELIST * const ocomppad_name = PL_comppad_name; - PAD * const ocomppad = PL_comppad; - PL_comppad_name = PadlistNAMES(padlist); - PL_comppad = PadlistARRAY(padlist)[1]; - PL_curpad = AvARRAY(PL_comppad); - - new_offset - = pad_alloc_name(new_name, - PadnameIsSTATE(*out_name) ? padadd_STATE : 0, - PadnameTYPE(*out_name), - PadnameOURSTASH(*out_name) - ); - - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad addname: %ld \"%.*s\" FAKE\n", - (long)new_offset, - (int) PadnameLEN(new_name), - PadnamePV(new_name))); - PARENT_FAKELEX_FLAGS_set(new_name, *out_flags); - - PARENT_PAD_INDEX_set(new_name, 0); - if (PadnameIsOUR(new_name)) { - NOOP; /* do nothing */ - } - else if (CvLATE(cv)) { - /* delayed creation - just note the offset within parent pad */ - PARENT_PAD_INDEX_set(new_name, offset); - CvCLONE_on(cv); - } - else { - /* immediate creation - capture outer value right now */ - av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep)); - /* But also note the offset, as newMYSUB needs it */ - PARENT_PAD_INDEX_set(new_name, offset); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%" UVxf " saved captured sv 0x%" UVxf " at offset %ld\n", - PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset)); - } - *out_name = new_name; - *out_flags = PARENT_FAKELEX_FLAGS(new_name); - - PL_comppad_name = ocomppad_name; - PL_comppad = ocomppad; - PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL; + PADNAME *new_name = newPADNAMEouter(*out_name); + PADNAMELIST * const ocomppad_name = PL_comppad_name; + PAD * const ocomppad = PL_comppad; + PL_comppad_name = PadlistNAMES(padlist); + PL_comppad = PadlistARRAY(padlist)[1]; + PL_curpad = AvARRAY(PL_comppad); + + new_offset + = pad_alloc_name(new_name, + PadnameIsSTATE(*out_name) ? padadd_STATE : 0, + PadnameTYPE(*out_name), + PadnameOURSTASH(*out_name) + ); + + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad addname: %ld \"%.*s\" FAKE\n", + (long)new_offset, + (int) PadnameLEN(new_name), + PadnamePV(new_name))); + PARENT_FAKELEX_FLAGS_set(new_name, *out_flags); + + PARENT_PAD_INDEX_set(new_name, 0); + if (PadnameIsOUR(new_name)) { + NOOP; /* do nothing */ + } + else if (CvLATE(cv)) { + /* delayed creation - just note the offset within parent pad */ + PARENT_PAD_INDEX_set(new_name, offset); + CvCLONE_on(cv); + } + else { + /* immediate creation - capture outer value right now */ + av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep)); + /* But also note the offset, as newMYSUB needs it */ + PARENT_PAD_INDEX_set(new_name, offset); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad findlex cv=0x%" UVxf " saved captured sv 0x%" UVxf " at offset %ld\n", + PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset)); + } + *out_name = new_name; + *out_flags = PARENT_FAKELEX_FLAGS(new_name); + + PL_comppad_name = ocomppad_name; + PL_comppad = ocomppad; + PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL; } return new_offset; } @@ -1350,10 +1350,10 @@ Perl_pad_sv(pTHX_ PADOFFSET po) ASSERT_CURPAD_ACTIVE("pad_sv"); if (!po) - Perl_croak(aTHX_ "panic: pad_sv po"); + Perl_croak(aTHX_ "panic: pad_sv po"); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] sv: %ld sv=0x%" UVxf "\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po])) + "Pad 0x%" UVxf "[0x%" UVxf "] sv: %ld sv=0x%" UVxf "\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po])) ); return PL_curpad[po]; } @@ -1375,8 +1375,8 @@ Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv) ASSERT_CURPAD_ACTIVE("pad_setsv"); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] setsv: %ld sv=0x%" UVxf "\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv)) + "Pad 0x%" UVxf "[0x%" UVxf "] setsv: %ld sv=0x%" UVxf "\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv)) ); PL_curpad[po] = sv; } @@ -1398,9 +1398,9 @@ Perl_pad_block_start(pTHX_ int full) save_strlen((STRLEN *)&PL_comppad_name_floor); PL_comppad_name_floor = PadnamelistMAX(PL_comppad_name); if (full) - PL_comppad_name_fill = PL_comppad_name_floor; + PL_comppad_name_fill = PL_comppad_name_floor; if (PL_comppad_name_floor < 0) - PL_comppad_name_floor = 0; + PL_comppad_name_floor = 0; save_strlen((STRLEN *)&PL_min_intro_pending); save_strlen((STRLEN *)&PL_max_intro_pending); PL_min_intro_pending = 0; @@ -1409,7 +1409,7 @@ Perl_pad_block_start(pTHX_ int full) /* PL_padix_floor is what PL_padix is reset to at the start of each statement, by pad_reset(). We set it when entering a new scope to keep things like this working: - print "$foo$bar", do { this(); that() . "foo" }; + print "$foo$bar", do { this(); that() . "foo" }; We must not let "$foo$bar" and the later concatenation share the same target. */ PL_padix_floor = PL_padix; @@ -1435,36 +1435,36 @@ Perl_intro_my(pTHX) ASSERT_CURPAD_ACTIVE("intro_my"); if (PL_compiling.cop_seq) { - seq = PL_compiling.cop_seq; - PL_compiling.cop_seq = 0; + seq = PL_compiling.cop_seq; + PL_compiling.cop_seq = 0; } else - seq = PL_cop_seqmax; + seq = PL_cop_seqmax; if (! PL_min_intro_pending) - return seq; + return seq; svp = PadnamelistARRAY(PL_comppad_name); for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) { - PADNAME * const sv = svp[i]; - - if (sv && PadnameLEN(sv) && !PadnameOUTER(sv) - && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO) - { - COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */ - COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad intromy: %ld \"%s\", (%lu,%lu)\n", - (long)i, PadnamePV(sv), - (unsigned long)COP_SEQ_RANGE_LOW(sv), - (unsigned long)COP_SEQ_RANGE_HIGH(sv)) - ); - } + PADNAME * const sv = svp[i]; + + if (sv && PadnameLEN(sv) && !PadnameOUTER(sv) + && COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO) + { + COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */ + COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad intromy: %ld \"%s\", (%lu,%lu)\n", + (long)i, PadnamePV(sv), + (unsigned long)COP_SEQ_RANGE_LOW(sv), + (unsigned long)COP_SEQ_RANGE_HIGH(sv)) + ); + } } COP_SEQMAX_INC; PL_min_intro_pending = 0; PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */ DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax))); + "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax))); return seq; } @@ -1489,39 +1489,39 @@ Perl_pad_leavemy(pTHX) ASSERT_CURPAD_ACTIVE("pad_leavemy"); if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) { - for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) { - const PADNAME * const name = svp[off]; - if (name && PadnameLEN(name) && !PadnameOUTER(name)) - Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), - "%" PNf " never introduced", - PNfARG(name)); - } + for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) { + const PADNAME * const name = svp[off]; + if (name && PadnameLEN(name) && !PadnameOUTER(name)) + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), + "%" PNf " never introduced", + PNfARG(name)); + } } /* "Deintroduce" my variables that are leaving with this scope. */ for (off = PadnamelistMAX(PL_comppad_name); - off > PL_comppad_name_fill; off--) { - PADNAME * const sv = svp[off]; - if (sv && PadnameLEN(sv) && !PadnameOUTER(sv) - && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) - { - COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax); - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad leavemy: %ld \"%s\", (%lu,%lu)\n", - (long)off, PadnamePV(sv), - (unsigned long)COP_SEQ_RANGE_LOW(sv), - (unsigned long)COP_SEQ_RANGE_HIGH(sv)) - ); - if (!PadnameIsSTATE(sv) && !PadnameIsOUR(sv) - && *PadnamePV(sv) == '&' && PadnameLEN(sv) > 1) { - OP *kid = newOP(OP_INTROCV, 0); - kid->op_targ = off; - o = op_prepend_elem(OP_LINESEQ, kid, o); - } - } + off > PL_comppad_name_fill; off--) { + PADNAME * const sv = svp[off]; + if (sv && PadnameLEN(sv) && !PadnameOUTER(sv) + && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO) + { + COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax); + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad leavemy: %ld \"%s\", (%lu,%lu)\n", + (long)off, PadnamePV(sv), + (unsigned long)COP_SEQ_RANGE_LOW(sv), + (unsigned long)COP_SEQ_RANGE_HIGH(sv)) + ); + if (!PadnameIsSTATE(sv) && !PadnameIsOUR(sv) + && *PadnamePV(sv) == '&' && PadnameLEN(sv) > 1) { + OP *kid = newOP(OP_INTROCV, 0); + kid->op_targ = off; + o = op_prepend_elem(OP_LINESEQ, kid, o); + } + } } COP_SEQMAX_INC; DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax)); + "Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax)); return o; } @@ -1539,20 +1539,20 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) { ASSERT_CURPAD_LEGAL("pad_swipe"); if (!PL_curpad) - return; + return; if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p", - AvARRAY(PL_comppad), PL_curpad); + Perl_croak(aTHX_ "panic: pad_swipe curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (!po || ((SSize_t)po) > AvFILLp(PL_comppad)) - Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld", - (long)po, (long)AvFILLp(PL_comppad)); + Perl_croak(aTHX_ "panic: pad_swipe po=%ld, fill=%ld", + (long)po, (long)AvFILLp(PL_comppad)); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] swipe: %ld\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)); + "Pad 0x%" UVxf "[0x%" UVxf "] swipe: %ld\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)); if (refadjust) - SvREFCNT_dec(PL_curpad[po]); + SvREFCNT_dec(PL_curpad[po]); /* if pad tmps aren't shared between ops, then there's no need to @@ -1565,16 +1565,16 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust) #endif if (PadnamelistMAX(PL_comppad_name) != -1 && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) { - if (PadnamelistARRAY(PL_comppad_name)[po]) { - assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po])); - } - PadnamelistARRAY(PL_comppad_name)[po] = &PL_padname_undef; + if (PadnamelistARRAY(PL_comppad_name)[po]) { + assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po])); + } + PadnamelistARRAY(PL_comppad_name)[po] = &PL_padname_undef; } /* Use PL_constpadix here, not PL_padix. The latter may have been reset by pad_reset. We don’t want pad_alloc to have to scan the whole pad when allocating a constant. */ if (po < PL_constpadix) - PL_constpadix = po - 1; + PL_constpadix = po - 1; } /* @@ -1595,18 +1595,18 @@ S_pad_reset(pTHX) { #ifdef USE_PAD_RESET if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p", - AvARRAY(PL_comppad), PL_curpad); + Perl_croak(aTHX_ "panic: pad_reset curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] reset: padix %ld -> %ld", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), - (long)PL_padix, (long)PL_padix_floor - ) + "Pad 0x%" UVxf "[0x%" UVxf "] reset: padix %ld -> %ld", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), + (long)PL_padix, (long)PL_padix_floor + ) ); if (!TAINTING_get) { /* Can't mix tainted and non-tainted temporaries. */ - PL_padix = PL_padix_floor; + PL_padix = PL_padix_floor; } #endif PL_pad_reset_pending = FALSE; @@ -1652,79 +1652,79 @@ Perl_pad_tidy(pTHX_ padtidy_type type) if (PL_cv_has_eval || PL_perldb) { const CV *cv; - for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) { - if (cv != PL_compcv && CvCOMPILED(cv)) - break; /* no need to mark already-compiled code */ - if (CvANON(cv)) { - DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad clone on cv=0x%" UVxf "\n", PTR2UV(cv))); - CvCLONE_on(cv); - } - CvHASEVAL_on(cv); - } + for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) { + if (cv != PL_compcv && CvCOMPILED(cv)) + break; /* no need to mark already-compiled code */ + if (CvANON(cv)) { + DEBUG_Xv(PerlIO_printf(Perl_debug_log, + "Pad clone on cv=0x%" UVxf "\n", PTR2UV(cv))); + CvCLONE_on(cv); + } + CvHASEVAL_on(cv); + } } /* extend namepad to match curpad */ if (PadnamelistMAX(PL_comppad_name) < AvFILLp(PL_comppad)) - padnamelist_store(PL_comppad_name, AvFILLp(PL_comppad), NULL); + padnamelist_store(PL_comppad_name, AvFILLp(PL_comppad), NULL); if (type == padtidy_SUBCLONE) { - PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); - PADOFFSET ix; - - for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { - PADNAME *namesv; - if (!namep[ix]) namep[ix] = &PL_padname_undef; - - /* - * The only things that a clonable function needs in its - * pad are anonymous subs, constants and GVs. - * The rest are created anew during cloning. - */ - if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])) - continue; - namesv = namep[ix]; - if (!(PadnamePV(namesv) && - (!PadnameLEN(namesv) || *PadnamePV(namesv) == '&'))) - { - SvREFCNT_dec(PL_curpad[ix]); - PL_curpad[ix] = NULL; - } - } + PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); + PADOFFSET ix; + + for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { + PADNAME *namesv; + if (!namep[ix]) namep[ix] = &PL_padname_undef; + + /* + * The only things that a clonable function needs in its + * pad are anonymous subs, constants and GVs. + * The rest are created anew during cloning. + */ + if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])) + continue; + namesv = namep[ix]; + if (!(PadnamePV(namesv) && + (!PadnameLEN(namesv) || *PadnamePV(namesv) == '&'))) + { + SvREFCNT_dec(PL_curpad[ix]); + PL_curpad[ix] = NULL; + } + } } else if (type == padtidy_SUB) { - AV * const av = newAV(); /* Will be @_ */ - av_store(PL_comppad, 0, MUTABLE_SV(av)); - AvREIFY_only(av); + AV * const av = newAV(); /* Will be @_ */ + av_store(PL_comppad, 0, MUTABLE_SV(av)); + AvREIFY_only(av); } if (type == padtidy_SUB || type == padtidy_FORMAT) { - PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); - PADOFFSET ix; - for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { - if (!namep[ix]) namep[ix] = &PL_padname_undef; - if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])) - continue; - if (SvPADMY(PL_curpad[ix]) && !PadnameOUTER(namep[ix])) { - /* This is a work around for how the current implementation of - ?{ } blocks in regexps interacts with lexicals. - - One of our lexicals. - Can't do this on all lexicals, otherwise sub baz() won't - compile in - - my $foo; - - sub bar { ++$foo; } - - sub baz { ++$foo; } - - because completion of compiling &bar calling pad_tidy() - would cause (top level) $foo to be marked as stale, and - "no longer available". */ - SvPADSTALE_on(PL_curpad[ix]); - } - } + PADNAME ** const namep = PadnamelistARRAY(PL_comppad_name); + PADOFFSET ix; + for (ix = AvFILLp(PL_comppad); ix > 0; ix--) { + if (!namep[ix]) namep[ix] = &PL_padname_undef; + if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])) + continue; + if (SvPADMY(PL_curpad[ix]) && !PadnameOUTER(namep[ix])) { + /* This is a work around for how the current implementation of + ?{ } blocks in regexps interacts with lexicals. + + One of our lexicals. + Can't do this on all lexicals, otherwise sub baz() won't + compile in + + my $foo; + + sub bar { ++$foo; } + + sub baz { ++$foo; } + + because completion of compiling &bar calling pad_tidy() + would cause (top level) $foo to be marked as stale, and + "no longer available". */ + SvPADSTALE_on(PL_curpad[ix]); + } + } } PL_curpad = AvARRAY(PL_comppad); } @@ -1745,25 +1745,25 @@ Perl_pad_free(pTHX_ PADOFFSET po) #endif ASSERT_CURPAD_LEGAL("pad_free"); if (!PL_curpad) - return; + return; if (AvARRAY(PL_comppad) != PL_curpad) - Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p", - AvARRAY(PL_comppad), PL_curpad); + Perl_croak(aTHX_ "panic: pad_free curpad, %p!=%p", + AvARRAY(PL_comppad), PL_curpad); if (!po) - Perl_croak(aTHX_ "panic: pad_free po"); + Perl_croak(aTHX_ "panic: pad_free po"); DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad 0x%" UVxf "[0x%" UVxf "] free: %ld\n", - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po) + "Pad 0x%" UVxf "[0x%" UVxf "] free: %ld\n", + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po) ); #ifndef USE_PAD_RESET sv = PL_curpad[po]; if (sv && sv != &PL_sv_undef && !SvPADMY(sv)) - SvFLAGS(sv) &= ~SVs_PADTMP; + SvFLAGS(sv) &= ~SVs_PADTMP; if (po < PL_padix) - PL_padix = po - 1; + PL_padix = po - 1; #endif } @@ -1787,53 +1787,53 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) PERL_ARGS_ASSERT_DO_DUMP_PAD; if (!padlist) { - return; + return; } pad_name = PadlistNAMES(padlist); pad = PadlistARRAY(padlist)[1]; pname = PadnamelistARRAY(pad_name); ppad = AvARRAY(pad); Perl_dump_indent(aTHX_ level, file, - "PADNAME = 0x%" UVxf "(0x%" UVxf ") PAD = 0x%" UVxf "(0x%" UVxf ")\n", - PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad) + "PADNAME = 0x%" UVxf "(0x%" UVxf ") PAD = 0x%" UVxf "(0x%" UVxf ")\n", + PTR2UV(pad_name), PTR2UV(pname), PTR2UV(pad), PTR2UV(ppad) ); for (ix = 1; ix <= PadnamelistMAX(pad_name); ix++) { const PADNAME *namesv = pname[ix]; - if (namesv && !PadnameLEN(namesv)) { - namesv = NULL; - } - if (namesv) { - if (PadnameOUTER(namesv)) - Perl_dump_indent(aTHX_ level+1, file, - "%2d. 0x%" UVxf "<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n", - (int) ix, - PTR2UV(ppad[ix]), - (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), - PadnamePV(namesv), - (unsigned long)PARENT_FAKELEX_FLAGS(namesv), - (unsigned long)PARENT_PAD_INDEX(namesv) - - ); - else - Perl_dump_indent(aTHX_ level+1, file, - "%2d. 0x%" UVxf "<%lu> (%lu,%lu) \"%s\"\n", - (int) ix, - PTR2UV(ppad[ix]), - (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), - (unsigned long)COP_SEQ_RANGE_LOW(namesv), - (unsigned long)COP_SEQ_RANGE_HIGH(namesv), - PadnamePV(namesv) - ); - } - else if (full) { - Perl_dump_indent(aTHX_ level+1, file, - "%2d. 0x%" UVxf "<%lu>\n", - (int) ix, - PTR2UV(ppad[ix]), - (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0) - ); - } + if (namesv && !PadnameLEN(namesv)) { + namesv = NULL; + } + if (namesv) { + if (PadnameOUTER(namesv)) + Perl_dump_indent(aTHX_ level+1, file, + "%2d. 0x%" UVxf "<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n", + (int) ix, + PTR2UV(ppad[ix]), + (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), + PadnamePV(namesv), + (unsigned long)PARENT_FAKELEX_FLAGS(namesv), + (unsigned long)PARENT_PAD_INDEX(namesv) + + ); + else + Perl_dump_indent(aTHX_ level+1, file, + "%2d. 0x%" UVxf "<%lu> (%lu,%lu) \"%s\"\n", + (int) ix, + PTR2UV(ppad[ix]), + (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), + (unsigned long)COP_SEQ_RANGE_LOW(namesv), + (unsigned long)COP_SEQ_RANGE_HIGH(namesv), + PadnamePV(namesv) + ); + } + else if (full) { + Perl_dump_indent(aTHX_ level+1, file, + "%2d. 0x%" UVxf "<%lu>\n", + (int) ix, + PTR2UV(ppad[ix]), + (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0) + ); + } } } @@ -1856,23 +1856,23 @@ S_cv_dump(pTHX_ const CV *cv, const char *title) PERL_ARGS_ASSERT_CV_DUMP; PerlIO_printf(Perl_debug_log, - " %s: CV=0x%" UVxf " (%s), OUTSIDE=0x%" UVxf " (%s)\n", - title, - PTR2UV(cv), - (CvANON(cv) ? "ANON" - : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT" - : (cv == PL_main_cv) ? "MAIN" - : CvUNIQUE(cv) ? "UNIQUE" - : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"), - PTR2UV(outside), - (!outside ? "null" - : CvANON(outside) ? "ANON" - : (outside == PL_main_cv) ? "MAIN" - : CvUNIQUE(outside) ? "UNIQUE" - : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); + " %s: CV=0x%" UVxf " (%s), OUTSIDE=0x%" UVxf " (%s)\n", + title, + PTR2UV(cv), + (CvANON(cv) ? "ANON" + : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT" + : (cv == PL_main_cv) ? "MAIN" + : CvUNIQUE(cv) ? "UNIQUE" + : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"), + PTR2UV(outside), + (!outside ? "null" + : CvANON(outside) ? "ANON" + : (outside == PL_main_cv) ? "MAIN" + : CvUNIQUE(outside) ? "UNIQUE" + : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED")); PerlIO_printf(Perl_debug_log, - " PADLIST = 0x%" UVxf "\n", PTR2UV(padlist)); + " PADLIST = 0x%" UVxf "\n", PTR2UV(padlist)); do_dump_pad(1, Perl_debug_log, padlist, 1); } @@ -1894,7 +1894,7 @@ static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned); static CV * S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, - bool newcv) + bool newcv) { PADOFFSET ix; PADLIST* const protopadlist = CvPADLIST(proto); @@ -1923,22 +1923,22 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, if (!outside) { if (CvWEAKOUTSIDE(proto)) - outside = find_runcv(NULL); + outside = find_runcv(NULL); else { - outside = CvOUTSIDE(proto); - if ((CvCLONE(outside) && ! CvCLONED(outside)) - || !CvPADLIST(outside) - || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) { - outside = find_runcv_where( - FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL - ); - /* outside could be null */ - } + outside = CvOUTSIDE(proto); + if ((CvCLONE(outside) && ! CvCLONED(outside)) + || !CvPADLIST(outside) + || CvPADLIST(outside)->xpadl_id != protopadlist->xpadl_outid) { + outside = find_runcv_where( + FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL + ); + /* outside could be null */ + } } } depth = outside ? CvDEPTH(outside) : 0; if (!depth) - depth = 1; + depth = 1; ENTER; SAVESPTR(PL_compcv); @@ -1946,7 +1946,7 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */ if (CvHASEVAL(cv)) - CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside)); + CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside)); SAVESPTR(PL_comppad_name); PL_comppad_name = protopad_name; @@ -1958,226 +1958,226 @@ S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned, PL_curpad = AvARRAY(PL_comppad); outpad = outside && CvPADLIST(outside) - ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth]) - : NULL; + ? AvARRAY(PadlistARRAY(CvPADLIST(outside))[depth]) + : NULL; if (outpad) CvPADLIST(cv)->xpadl_outid = CvPADLIST(outside)->xpadl_id; for (ix = fpad; ix > 0; ix--) { - PADNAME* const namesv = (ix <= fname) ? pname[ix] : NULL; - SV *sv = NULL; - if (namesv && PadnameLEN(namesv)) { /* lexical */ - if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */ - NOOP; - } - else { - if (PadnameOUTER(namesv)) { /* lexical from outside? */ - /* formats may have an inactive, or even undefined, parent; - but state vars are always available. */ - if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)]) - || ( SvPADSTALE(sv) && !SvPAD_STATE(namesv) - && (!outside || !CvDEPTH(outside))) ) { - S_unavailable(aTHX_ namesv); - sv = NULL; - } - else - SvREFCNT_inc_simple_void_NN(sv); - } - if (!sv) { + PADNAME* const namesv = (ix <= fname) ? pname[ix] : NULL; + SV *sv = NULL; + if (namesv && PadnameLEN(namesv)) { /* lexical */ + if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */ + NOOP; + } + else { + if (PadnameOUTER(namesv)) { /* lexical from outside? */ + /* formats may have an inactive, or even undefined, parent; + but state vars are always available. */ + if (!outpad || !(sv = outpad[PARENT_PAD_INDEX(namesv)]) + || ( SvPADSTALE(sv) && !SvPAD_STATE(namesv) + && (!outside || !CvDEPTH(outside))) ) { + S_unavailable(aTHX_ namesv); + sv = NULL; + } + else + SvREFCNT_inc_simple_void_NN(sv); + } + if (!sv) { const char sigil = PadnamePV(namesv)[0]; if (sigil == '&') - /* If there are state subs, we need to clone them, too. - But they may need to close over variables we have - not cloned yet. So we will have to do a second - pass. Furthermore, there may be state subs clos- - ing over other state subs’ entries, so we have - to put a stub here and then clone into it on the - second pass. */ - if (SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])) { - assert(SvTYPE(ppad[ix]) == SVt_PVCV); - subclones ++; - if (CvOUTSIDE(ppad[ix]) != proto) - trouble = TRUE; - sv = newSV_type(SVt_PVCV); - CvLEXICAL_on(sv); - } - else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv)) - { - /* my sub */ - /* Just provide a stub, but name it. It will be - upgraded to the real thing on scope entry. */ - U32 hash; - PERL_HASH(hash, PadnamePV(namesv)+1, - PadnameLEN(namesv) - 1); - sv = newSV_type(SVt_PVCV); - CvNAME_HEK_set( - sv, - share_hek(PadnamePV(namesv)+1, - 1 - PadnameLEN(namesv), - hash) - ); - CvLEXICAL_on(sv); - } - else sv = SvREFCNT_inc(ppad[ix]); + /* If there are state subs, we need to clone them, too. + But they may need to close over variables we have + not cloned yet. So we will have to do a second + pass. Furthermore, there may be state subs clos- + ing over other state subs’ entries, so we have + to put a stub here and then clone into it on the + second pass. */ + if (SvPAD_STATE(namesv) && !CvCLONED(ppad[ix])) { + assert(SvTYPE(ppad[ix]) == SVt_PVCV); + subclones ++; + if (CvOUTSIDE(ppad[ix]) != proto) + trouble = TRUE; + sv = newSV_type(SVt_PVCV); + CvLEXICAL_on(sv); + } + else if (PadnameLEN(namesv)>1 && !PadnameIsOUR(namesv)) + { + /* my sub */ + /* Just provide a stub, but name it. It will be + upgraded to the real thing on scope entry. */ + U32 hash; + PERL_HASH(hash, PadnamePV(namesv)+1, + PadnameLEN(namesv) - 1); + sv = newSV_type(SVt_PVCV); + CvNAME_HEK_set( + sv, + share_hek(PadnamePV(namesv)+1, + 1 - PadnameLEN(namesv), + hash) + ); + CvLEXICAL_on(sv); + } + else sv = SvREFCNT_inc(ppad[ix]); else if (sigil == '@') - sv = MUTABLE_SV(newAV()); + sv = MUTABLE_SV(newAV()); else if (sigil == '%') - sv = MUTABLE_SV(newHV()); - else - sv = newSV(0); - /* reset the 'assign only once' flag on each state var */ - if (sigil != '&' && SvPAD_STATE(namesv)) - SvPADSTALE_on(sv); - } - } - } - else if (namesv && PadnamePV(namesv)) { - sv = SvREFCNT_inc_NN(ppad[ix]); - } - else { - sv = newSV(0); - SvPADTMP_on(sv); - } - PL_curpad[ix] = sv; + sv = MUTABLE_SV(newHV()); + else + sv = newSV(0); + /* reset the 'assign only once' flag on each state var */ + if (sigil != '&' && SvPAD_STATE(namesv)) + SvPADSTALE_on(sv); + } + } + } + else if (namesv && PadnamePV(namesv)) { + sv = SvREFCNT_inc_NN(ppad[ix]); + } + else { + sv = newSV(0); + SvPADTMP_on(sv); + } + PL_curpad[ix] = sv; } if (subclones) { - if (trouble || cloned) { - /* Uh-oh, we have trouble! At least one of the state subs here - has its CvOUTSIDE pointer pointing somewhere unexpected. It - could be pointing to another state protosub that we are - about to clone. So we have to track which sub clones come - from which protosubs. If the CvOUTSIDE pointer for a parti- - cular sub points to something we have not cloned yet, we - delay cloning it. We must loop through the pad entries, - until we get a full pass with no cloning. If any uncloned - subs remain (probably nested inside anonymous or ‘my’ subs), - then they get cloned in a final pass. - */ - bool cloned_in_this_pass; - if (!cloned) - cloned = (HV *)sv_2mortal((SV *)newHV()); - do { - cloned_in_this_pass = FALSE; - for (ix = fpad; ix > 0; ix--) { - PADNAME * const name = - (ix <= fname) ? pname[ix] : NULL; - if (name && name != &PL_padname_undef - && !PadnameOUTER(name) && PadnamePV(name)[0] == '&' - && PadnameIsSTATE(name) && !CvCLONED(PL_curpad[ix])) - { - CV * const protokey = CvOUTSIDE(ppad[ix]); - CV ** const cvp = protokey == proto - ? &cv - : (CV **)hv_fetch(cloned, (char *)&protokey, - sizeof(CV *), 0); - if (cvp && *cvp) { - S_cv_clone(aTHX_ (CV *)ppad[ix], - (CV *)PL_curpad[ix], - *cvp, cloned); - (void)hv_store(cloned, (char *)&ppad[ix], - sizeof(CV *), - SvREFCNT_inc_simple_NN(PL_curpad[ix]), - 0); - subclones--; - cloned_in_this_pass = TRUE; - } - } - } - } while (cloned_in_this_pass); - if (subclones) - for (ix = fpad; ix > 0; ix--) { - PADNAME * const name = - (ix <= fname) ? pname[ix] : NULL; - if (name && name != &PL_padname_undef - && !PadnameOUTER(name) && PadnamePV(name)[0] == '&' - && PadnameIsSTATE(name) && !CvCLONED(PL_curpad[ix])) - S_cv_clone(aTHX_ (CV *)ppad[ix], - (CV *)PL_curpad[ix], - CvOUTSIDE(ppad[ix]), cloned); - } - } - else for (ix = fpad; ix > 0; ix--) { - PADNAME * const name = (ix <= fname) ? pname[ix] : NULL; - if (name && name != &PL_padname_undef && !PadnameOUTER(name) - && PadnamePV(name)[0] == '&' && PadnameIsSTATE(name)) - S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv, - NULL); - } + if (trouble || cloned) { + /* Uh-oh, we have trouble! At least one of the state subs here + has its CvOUTSIDE pointer pointing somewhere unexpected. It + could be pointing to another state protosub that we are + about to clone. So we have to track which sub clones come + from which protosubs. If the CvOUTSIDE pointer for a parti- + cular sub points to something we have not cloned yet, we + delay cloning it. We must loop through the pad entries, + until we get a full pass with no cloning. If any uncloned + subs remain (probably nested inside anonymous or ‘my’ subs), + then they get cloned in a final pass. + */ + bool cloned_in_this_pass; + if (!cloned) + cloned = (HV *)sv_2mortal((SV *)newHV()); + do { + cloned_in_this_pass = FALSE; + for (ix = fpad; ix > 0; ix--) { + PADNAME * const name = + (ix <= fname) ? pname[ix] : NULL; + if (name && name != &PL_padname_undef + && !PadnameOUTER(name) && PadnamePV(name)[0] == '&' + && PadnameIsSTATE(name) && !CvCLONED(PL_curpad[ix])) + { + CV * const protokey = CvOUTSIDE(ppad[ix]); + CV ** const cvp = protokey == proto + ? &cv + : (CV **)hv_fetch(cloned, (char *)&protokey, + sizeof(CV *), 0); + if (cvp && *cvp) { + S_cv_clone(aTHX_ (CV *)ppad[ix], + (CV *)PL_curpad[ix], + *cvp, cloned); + (void)hv_store(cloned, (char *)&ppad[ix], + sizeof(CV *), + SvREFCNT_inc_simple_NN(PL_curpad[ix]), + 0); + subclones--; + cloned_in_this_pass = TRUE; + } + } + } + } while (cloned_in_this_pass); + if (subclones) + for (ix = fpad; ix > 0; ix--) { + PADNAME * const name = + (ix <= fname) ? pname[ix] : NULL; + if (name && name != &PL_padname_undef + && !PadnameOUTER(name) && PadnamePV(name)[0] == '&' + && PadnameIsSTATE(name) && !CvCLONED(PL_curpad[ix])) + S_cv_clone(aTHX_ (CV *)ppad[ix], + (CV *)PL_curpad[ix], + CvOUTSIDE(ppad[ix]), cloned); + } + } + else for (ix = fpad; ix > 0; ix--) { + PADNAME * const name = (ix <= fname) ? pname[ix] : NULL; + if (name && name != &PL_padname_undef && !PadnameOUTER(name) + && PadnamePV(name)[0] == '&' && PadnameIsSTATE(name)) + S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv, + NULL); + } } if (newcv) SvREFCNT_inc_simple_void_NN(cv); LEAVE; if (CvCONST(cv)) { - /* Constant sub () { $x } closing over $x: - * The prototype was marked as a candiate for const-ization, - * so try to grab the current const value, and if successful, - * turn into a const sub: - */ - SV* const_sv; - OP *o = CvSTART(cv); - assert(newcv); - for (; o; o = o->op_next) - if (o->op_type == OP_PADSV) - break; - ASSUME(o->op_type == OP_PADSV); - const_sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ); - /* the candidate should have 1 ref from this pad and 1 ref - * from the parent */ - if (const_sv && SvREFCNT(const_sv) == 2) { - const bool was_method = cBOOL(CvMETHOD(cv)); - if (outside) { - PADNAME * const pn = - PadlistNAMESARRAY(CvPADLIST(outside)) - [PARENT_PAD_INDEX(PadlistNAMESARRAY( - CvPADLIST(cv))[o->op_targ])]; - assert(PadnameOUTER(PadlistNAMESARRAY(CvPADLIST(cv)) - [o->op_targ])); - if (PadnameLVALUE(pn)) { - /* We have a lexical that is potentially modifiable - elsewhere, so making a constant will break clo- - sure behaviour. If this is a ‘simple lexical - op tree’, i.e., sub(){$x}, emit a deprecation - warning, but continue to exhibit the old behav- - iour of making it a constant based on the ref- - count of the candidate variable. - - A simple lexical op tree looks like this: - - leavesub - lineseq - nextstate - padsv - */ - if (OpSIBLING( - cUNOPx(cUNOPx(CvROOT(cv))->op_first)->op_first - ) == o - && !OpSIBLING(o)) - { + /* Constant sub () { $x } closing over $x: + * The prototype was marked as a candiate for const-ization, + * so try to grab the current const value, and if successful, + * turn into a const sub: + */ + SV* const_sv; + OP *o = CvSTART(cv); + assert(newcv); + for (; o; o = o->op_next) + if (o->op_type == OP_PADSV) + break; + ASSUME(o->op_type == OP_PADSV); + const_sv = PAD_BASE_SV(CvPADLIST(cv), o->op_targ); + /* the candidate should have 1 ref from this pad and 1 ref + * from the parent */ + if (const_sv && SvREFCNT(const_sv) == 2) { + const bool was_method = cBOOL(CvMETHOD(cv)); + if (outside) { + PADNAME * const pn = + PadlistNAMESARRAY(CvPADLIST(outside)) + [PARENT_PAD_INDEX(PadlistNAMESARRAY( + CvPADLIST(cv))[o->op_targ])]; + assert(PadnameOUTER(PadlistNAMESARRAY(CvPADLIST(cv)) + [o->op_targ])); + if (PadnameLVALUE(pn)) { + /* We have a lexical that is potentially modifiable + elsewhere, so making a constant will break clo- + sure behaviour. If this is a ‘simple lexical + op tree’, i.e., sub(){$x}, emit a deprecation + warning, but continue to exhibit the old behav- + iour of making it a constant based on the ref- + count of the candidate variable. + + A simple lexical op tree looks like this: + + leavesub + lineseq + nextstate + padsv + */ + if (OpSIBLING( + cUNOPx(cUNOPx(CvROOT(cv))->op_first)->op_first + ) == o + && !OpSIBLING(o)) + { Perl_croak(aTHX_ "Constants from lexical variables potentially modified " "elsewhere are no longer permitted"); - } - else - goto constoff; - } - } + } + else + goto constoff; + } + } SvREFCNT_inc_simple_void_NN(const_sv); - /* If the lexical is not used elsewhere, it is safe to turn on - SvPADTMP, since it is only when it is used in lvalue con- - text that the difference is observable. */ - SvREADONLY_on(const_sv); - SvPADTMP_on(const_sv); - SvREFCNT_dec_NN(cv); - cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv); - if (was_method) - CvMETHOD_on(cv); - } - else { - constoff: - CvCONST_off(cv); - } + /* If the lexical is not used elsewhere, it is safe to turn on + SvPADTMP, since it is only when it is used in lvalue con- + text that the difference is observable. */ + SvREADONLY_on(const_sv); + SvPADTMP_on(const_sv); + SvREFCNT_dec_NN(cv); + cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv); + if (was_method) + CvMETHOD_on(cv); + } + else { + constoff: + CvCONST_off(cv); + } } return cv; @@ -2192,13 +2192,13 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned) if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto))); CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC - |CVf_SLABBED); + |CVf_SLABBED); CvCLONED_on(cv); CvFILE(cv) = CvDYNFILE(proto) ? savepv(CvFILE(proto)) - : CvFILE(proto); + : CvFILE(proto); if (CvNAMED(proto)) - CvNAME_HEK_set(cv, share_hek_hek(CvNAME_HEK(proto))); + CvNAME_HEK_set(cv, share_hek_hek(CvNAME_HEK(proto))); else CvGV_set(cv,CvGV(proto)); CvSTASH_set(cv, CvSTASH(proto)); OP_REFCNT_LOCK; @@ -2208,21 +2208,21 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned) CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto); if (SvPOK(proto)) { - sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto)); + sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto)); if (SvUTF8(proto)) SvUTF8_on(MUTABLE_SV(cv)); } if (SvMAGIC(proto)) - mg_copy((SV *)proto, (SV *)cv, 0, 0); + mg_copy((SV *)proto, (SV *)cv, 0, 0); if (CvPADLIST(proto)) - cv = S_cv_clone_pad(aTHX_ proto, cv, outside, cloned, newcv); + cv = S_cv_clone_pad(aTHX_ proto, cv, outside, cloned, newcv); DEBUG_Xv( - PerlIO_printf(Perl_debug_log, "\nPad CV clone\n"); - if (CvOUTSIDE(cv)) cv_dump(CvOUTSIDE(cv), "Outside"); - cv_dump(proto, "Proto"); - cv_dump(cv, "To"); + PerlIO_printf(Perl_debug_log, "\nPad CV clone\n"); + if (CvOUTSIDE(cv)) cv_dump(CvOUTSIDE(cv), "Outside"); + cv_dump(proto, "Proto"); + cv_dump(cv, "To"); ); return cv; @@ -2272,31 +2272,31 @@ Perl_cv_name(pTHX_ CV *cv, SV *sv, U32 flags) { PERL_ARGS_ASSERT_CV_NAME; if (!isGV_with_GP(cv) && SvTYPE(cv) != SVt_PVCV) { - if (sv) sv_setsv(sv,(SV *)cv); - return sv ? (sv) : (SV *)cv; + if (sv) sv_setsv(sv,(SV *)cv); + return sv ? (sv) : (SV *)cv; } { - SV * const retsv = sv ? (sv) : sv_newmortal(); - if (SvTYPE(cv) == SVt_PVCV) { - if (CvNAMED(cv)) { - if (CvLEXICAL(cv) || flags & CV_NAME_NOTQUAL) - sv_sethek(retsv, CvNAME_HEK(cv)); - else { - if (CvSTASH(cv) && HvNAME_HEK(CvSTASH(cv))) - sv_sethek(retsv, HvNAME_HEK(CvSTASH(cv))); - else - sv_setpvs(retsv, "__ANON__"); - sv_catpvs(retsv, "::"); - sv_cathek(retsv, CvNAME_HEK(cv)); - } - } - else if (CvLEXICAL(cv) || flags & CV_NAME_NOTQUAL) - sv_sethek(retsv, GvNAME_HEK(GvEGV(CvGV(cv)))); - else gv_efullname3(retsv, CvGV(cv), NULL); - } - else if (flags & CV_NAME_NOTQUAL) sv_sethek(retsv, GvNAME_HEK(cv)); - else gv_efullname3(retsv,(GV *)cv,NULL); - return retsv; + SV * const retsv = sv ? (sv) : sv_newmortal(); + if (SvTYPE(cv) == SVt_PVCV) { + if (CvNAMED(cv)) { + if (CvLEXICAL(cv) || flags & CV_NAME_NOTQUAL) + sv_sethek(retsv, CvNAME_HEK(cv)); + else { + if (CvSTASH(cv) && HvNAME_HEK(CvSTASH(cv))) + sv_sethek(retsv, HvNAME_HEK(CvSTASH(cv))); + else + sv_setpvs(retsv, "__ANON__"); + sv_catpvs(retsv, "::"); + sv_cathek(retsv, CvNAME_HEK(cv)); + } + } + else if (CvLEXICAL(cv) || flags & CV_NAME_NOTQUAL) + sv_sethek(retsv, GvNAME_HEK(GvEGV(CvGV(cv)))); + else gv_efullname3(retsv, CvGV(cv), NULL); + } + else if (flags & CV_NAME_NOTQUAL) sv_sethek(retsv, GvNAME_HEK(cv)); + else gv_efullname3(retsv,(GV *)cv,NULL); + return retsv; } } @@ -2324,51 +2324,51 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv) for (ix = PadnamelistMAX(comppad_name); ix > 0; ix--) { const PADNAME *name = namepad[ix]; - if (name && name != &PL_padname_undef && !PadnameIsOUR(name) - && *PadnamePV(name) == '&') - { - CV *innercv = MUTABLE_CV(curpad[ix]); - if (UNLIKELY(PadnameOUTER(name))) { - CV *cv = new_cv; - PADNAME **names = namepad; - PADOFFSET i = ix; - while (PadnameOUTER(name)) { - assert(SvTYPE(cv) == SVt_PVCV); - cv = CvOUTSIDE(cv); - names = PadlistNAMESARRAY(CvPADLIST(cv)); - i = PARENT_PAD_INDEX(name); - name = names[i]; - } - innercv = (CV *)PadARRAY(PadlistARRAY(CvPADLIST(cv))[1])[i]; - } - if (SvTYPE(innercv) == SVt_PVCV) { - /* XXX 0afba48f added code here to check for a proto CV - attached to the pad entry by magic. But shortly there- - after 81df9f6f95 moved the magic to the pad name. The - code here was never updated, so it wasn’t doing anything - and got deleted when PADNAME became a distinct type. Is - there any bug as a result? */ - if (CvOUTSIDE(innercv) == old_cv) { - if (!CvWEAKOUTSIDE(innercv)) { - SvREFCNT_dec(old_cv); - SvREFCNT_inc_simple_void_NN(new_cv); - } - CvOUTSIDE(innercv) = new_cv; - } - } - else { /* format reference */ - SV * const rv = curpad[ix]; - CV *innercv; - if (!SvOK(rv)) continue; - assert(SvROK(rv)); - assert(SvWEAKREF(rv)); - innercv = (CV *)SvRV(rv); - assert(!CvWEAKOUTSIDE(innercv)); - assert(CvOUTSIDE(innercv) == old_cv); - SvREFCNT_dec(CvOUTSIDE(innercv)); - CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv); - } - } + if (name && name != &PL_padname_undef && !PadnameIsOUR(name) + && *PadnamePV(name) == '&') + { + CV *innercv = MUTABLE_CV(curpad[ix]); + if (UNLIKELY(PadnameOUTER(name))) { + CV *cv = new_cv; + PADNAME **names = namepad; + PADOFFSET i = ix; + while (PadnameOUTER(name)) { + assert(SvTYPE(cv) == SVt_PVCV); + cv = CvOUTSIDE(cv); + names = PadlistNAMESARRAY(CvPADLIST(cv)); + i = PARENT_PAD_INDEX(name); + name = names[i]; + } + innercv = (CV *)PadARRAY(PadlistARRAY(CvPADLIST(cv))[1])[i]; + } + if (SvTYPE(innercv) == SVt_PVCV) { + /* XXX 0afba48f added code here to check for a proto CV + attached to the pad entry by magic. But shortly there- + after 81df9f6f95 moved the magic to the pad name. The + code here was never updated, so it wasn’t doing anything + and got deleted when PADNAME became a distinct type. Is + there any bug as a result? */ + if (CvOUTSIDE(innercv) == old_cv) { + if (!CvWEAKOUTSIDE(innercv)) { + SvREFCNT_dec(old_cv); + SvREFCNT_inc_simple_void_NN(new_cv); + } + CvOUTSIDE(innercv) = new_cv; + } + } + else { /* format reference */ + SV * const rv = curpad[ix]; + CV *innercv; + if (!SvOK(rv)) continue; + assert(SvROK(rv)); + assert(SvWEAKREF(rv)); + innercv = (CV *)SvRV(rv); + assert(!CvWEAKOUTSIDE(innercv)); + assert(CvOUTSIDE(innercv) == old_cv); + SvREFCNT_dec(CvOUTSIDE(innercv)); + CvOUTSIDE(innercv) = (CV *)SvREFCNT_inc_simple_NN(new_cv); + } + } } } @@ -2388,50 +2388,50 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) PERL_ARGS_ASSERT_PAD_PUSH; if (depth > PadlistMAX(padlist) || !PadlistARRAY(padlist)[depth]) { - PAD** const svp = PadlistARRAY(padlist); - AV* const newpad = newAV(); - SV** const oldpad = AvARRAY(svp[depth-1]); - PADOFFSET ix = AvFILLp((const AV *)svp[1]); - const PADOFFSET names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]); - PADNAME ** const names = PadnamelistARRAY((PADNAMELIST *)svp[0]); - AV *av; - - for ( ;ix > 0; ix--) { - if (names_fill >= ix && PadnameLEN(names[ix])) { - const char sigil = PadnamePV(names[ix])[0]; - if (PadnameOUTER(names[ix]) - || PadnameIsSTATE(names[ix]) - || sigil == '&') - { - /* outer lexical or anon code */ - av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); - } - else { /* our own lexical */ - SV *sv; - if (sigil == '@') - sv = MUTABLE_SV(newAV()); - else if (sigil == '%') - sv = MUTABLE_SV(newHV()); - else - sv = newSV(0); - av_store(newpad, ix, sv); - } - } - else if (PadnamePV(names[ix])) { - av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix])); - } - else { - /* save temporaries on recursion? */ - SV * const sv = newSV(0); - av_store(newpad, ix, sv); - SvPADTMP_on(sv); - } - } - av = newAV(); - av_store(newpad, 0, MUTABLE_SV(av)); - AvREIFY_only(av); - - padlist_store(padlist, depth, newpad); + PAD** const svp = PadlistARRAY(padlist); + AV* const newpad = newAV(); + SV** const oldpad = AvARRAY(svp[depth-1]); + PADOFFSET ix = AvFILLp((const AV *)svp[1]); + const PADOFFSET names_fill = PadnamelistMAX((PADNAMELIST *)svp[0]); + PADNAME ** const names = PadnamelistARRAY((PADNAMELIST *)svp[0]); + AV *av; + + for ( ;ix > 0; ix--) { + if (names_fill >= ix && PadnameLEN(names[ix])) { + const char sigil = PadnamePV(names[ix])[0]; + if (PadnameOUTER(names[ix]) + || PadnameIsSTATE(names[ix]) + || sigil == '&') + { + /* outer lexical or anon code */ + av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); + } + else { /* our own lexical */ + SV *sv; + if (sigil == '@') + sv = MUTABLE_SV(newAV()); + else if (sigil == '%') + sv = MUTABLE_SV(newHV()); + else + sv = newSV(0); + av_store(newpad, ix, sv); + } + } + else if (PadnamePV(names[ix])) { + av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix])); + } + else { + /* save temporaries on recursion? */ + SV * const sv = newSV(0); + av_store(newpad, ix, sv); + SvPADTMP_on(sv); + } + } + av = newAV(); + av_store(newpad, 0, MUTABLE_SV(av)); + AvREIFY_only(av); + + padlist_store(padlist, depth, newpad); } } @@ -2467,89 +2467,89 @@ Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param) Newx(PadlistARRAY(dstpad), max + 1, PAD *); PadlistARRAY(dstpad)[0] = (PAD *) - padnamelist_dup(PadlistNAMES(srcpad), param); + padnamelist_dup(PadlistNAMES(srcpad), param); PadnamelistREFCNT(PadlistNAMES(dstpad))++; if (cloneall) { - PADOFFSET depth; - for (depth = 1; depth <= max; ++depth) - PadlistARRAY(dstpad)[depth] = - av_dup_inc(PadlistARRAY(srcpad)[depth], param); + PADOFFSET depth; + for (depth = 1; depth <= max; ++depth) + PadlistARRAY(dstpad)[depth] = + av_dup_inc(PadlistARRAY(srcpad)[depth], param); } else { - /* CvDEPTH() on our subroutine will be set to 0, so there's no need - to build anything other than the first level of pads. */ - PADOFFSET ix = AvFILLp(PadlistARRAY(srcpad)[1]); - AV *pad1; - const PADOFFSET names_fill = PadnamelistMAX(PadlistNAMES(srcpad)); - const PAD *const srcpad1 = PadlistARRAY(srcpad)[1]; - SV **oldpad = AvARRAY(srcpad1); - PADNAME ** const names = PadnamelistARRAY(PadlistNAMES(dstpad)); - SV **pad1a; - AV *args; - - pad1 = newAV(); - - av_extend(pad1, ix); - PadlistARRAY(dstpad)[1] = pad1; - pad1a = AvARRAY(pad1); - - if (ix > -1) { - AvFILLp(pad1) = ix; - - for ( ;ix > 0; ix--) { - if (!oldpad[ix]) { - pad1a[ix] = NULL; - } else if (names_fill >= ix && names[ix] && - PadnameLEN(names[ix])) { - const char sigil = PadnamePV(names[ix])[0]; - if (PadnameOUTER(names[ix]) - || PadnameIsSTATE(names[ix]) - || sigil == '&') - { - /* outer lexical or anon code */ - pad1a[ix] = sv_dup_inc(oldpad[ix], param); - } - else { /* our own lexical */ - if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) { - /* This is a work around for how the current - implementation of ?{ } blocks in regexps - interacts with lexicals. */ - pad1a[ix] = sv_dup_inc(oldpad[ix], param); - } else { - SV *sv; - - if (sigil == '@') - sv = MUTABLE_SV(newAV()); - else if (sigil == '%') - sv = MUTABLE_SV(newHV()); - else - sv = newSV(0); - pad1a[ix] = sv; - } - } - } - else if (( names_fill >= ix && names[ix] - && PadnamePV(names[ix]) )) { - pad1a[ix] = sv_dup_inc(oldpad[ix], param); - } - else { - /* save temporaries on recursion? */ - SV * const sv = newSV(0); - pad1a[ix] = sv; - - /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs - FIXTHAT before merging this branch. - (And I know how to) */ - if (SvPADTMP(oldpad[ix])) - SvPADTMP_on(sv); - } - } - - if (oldpad[0]) { - args = newAV(); /* Will be @_ */ - AvREIFY_only(args); - pad1a[0] = (SV *)args; - } - } + /* CvDEPTH() on our subroutine will be set to 0, so there's no need + to build anything other than the first level of pads. */ + PADOFFSET ix = AvFILLp(PadlistARRAY(srcpad)[1]); + AV *pad1; + const PADOFFSET names_fill = PadnamelistMAX(PadlistNAMES(srcpad)); + const PAD *const srcpad1 = PadlistARRAY(srcpad)[1]; + SV **oldpad = AvARRAY(srcpad1); + PADNAME ** const names = PadnamelistARRAY(PadlistNAMES(dstpad)); + SV **pad1a; + AV *args; + + pad1 = newAV(); + + av_extend(pad1, ix); + PadlistARRAY(dstpad)[1] = pad1; + pad1a = AvARRAY(pad1); + + if (ix > -1) { + AvFILLp(pad1) = ix; + + for ( ;ix > 0; ix--) { + if (!oldpad[ix]) { + pad1a[ix] = NULL; + } else if (names_fill >= ix && names[ix] && + PadnameLEN(names[ix])) { + const char sigil = PadnamePV(names[ix])[0]; + if (PadnameOUTER(names[ix]) + || PadnameIsSTATE(names[ix]) + || sigil == '&') + { + /* outer lexical or anon code */ + pad1a[ix] = sv_dup_inc(oldpad[ix], param); + } + else { /* our own lexical */ + if(SvPADSTALE(oldpad[ix]) && SvREFCNT(oldpad[ix]) > 1) { + /* This is a work around for how the current + implementation of ?{ } blocks in regexps + interacts with lexicals. */ + pad1a[ix] = sv_dup_inc(oldpad[ix], param); + } else { + SV *sv; + + if (sigil == '@') + sv = MUTABLE_SV(newAV()); + else if (sigil == '%') + sv = MUTABLE_SV(newHV()); + else + sv = newSV(0); + pad1a[ix] = sv; + } + } + } + else if (( names_fill >= ix && names[ix] + && PadnamePV(names[ix]) )) { + pad1a[ix] = sv_dup_inc(oldpad[ix], param); + } + else { + /* save temporaries on recursion? */ + SV * const sv = newSV(0); + pad1a[ix] = sv; + + /* SvREFCNT(oldpad[ix]) != 1 for some code in threads.xs + FIXTHAT before merging this branch. + (And I know how to) */ + if (SvPADTMP(oldpad[ix])) + SvPADTMP_on(sv); + } + } + + if (oldpad[0]) { + args = newAV(); /* Will be @_ */ + AvREIFY_only(args); + pad1a[0] = (SV *)args; + } + } } return dstpad; @@ -2568,11 +2568,11 @@ Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val) assert(key >= 0); if (key > PadlistMAX(padlist)) { - av_extend_guts(NULL,key,&PadlistMAX(padlist), - (SV ***)&PadlistARRAY(padlist), - (SV ***)&PadlistARRAY(padlist)); - Zero(PadlistARRAY(padlist)+oldmax+1, PadlistMAX(padlist)-oldmax, - PAD *); + av_extend_guts(NULL,key,&PadlistMAX(padlist), + (SV ***)&PadlistARRAY(padlist), + (SV ***)&PadlistARRAY(padlist)); + Zero(PadlistARRAY(padlist)+oldmax+1, PadlistMAX(padlist)-oldmax, + PAD *); } ary = PadlistARRAY(padlist); SvREFCNT_dec(ary[key]); @@ -2621,17 +2621,17 @@ Perl_padnamelist_store(pTHX_ PADNAMELIST *pnl, SSize_t key, PADNAME *val) assert(key >= 0); if (key > pnl->xpadnl_max) - av_extend_guts(NULL,key,&pnl->xpadnl_max, - (SV ***)&PadnamelistARRAY(pnl), - (SV ***)&PadnamelistARRAY(pnl)); + av_extend_guts(NULL,key,&pnl->xpadnl_max, + (SV ***)&PadnamelistARRAY(pnl), + (SV ***)&PadnamelistARRAY(pnl)); if (PadnamelistMAX(pnl) < key) { - Zero(PadnamelistARRAY(pnl)+PadnamelistMAX(pnl)+1, - key-PadnamelistMAX(pnl), PADNAME *); - PadnamelistMAX(pnl) = key; + Zero(PadnamelistARRAY(pnl)+PadnamelistMAX(pnl)+1, + key-PadnamelistMAX(pnl), PADNAME *); + PadnamelistMAX(pnl) = key; } ary = PadnamelistARRAY(pnl); if (ary[key]) - PadnameREFCNT_dec(ary[key]); + PadnameREFCNT_dec(ary[key]); ary[key] = val; return &ary[key]; } @@ -2658,15 +2658,15 @@ Perl_padnamelist_free(pTHX_ PADNAMELIST *pnl) { PERL_ARGS_ASSERT_PADNAMELIST_FREE; if (!--PadnamelistREFCNT(pnl)) { - while(PadnamelistMAX(pnl) >= 0) - { - PADNAME * const pn = - PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]; - if (pn) - PadnameREFCNT_dec(pn); - } - Safefree(PadnamelistARRAY(pnl)); - Safefree(pnl); + while(PadnamelistMAX(pnl) >= 0) + { + PADNAME * const pn = + PadnamelistARRAY(pnl)[PadnamelistMAX(pnl)--]; + if (pn) + PadnameREFCNT_dec(pn); + } + Safefree(PadnamelistARRAY(pnl)); + Safefree(pnl); } } @@ -2691,7 +2691,7 @@ Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) /* look for it in the table first */ dstpad = (PADNAMELIST *)ptr_table_fetch(PL_ptr_table, srcpad); if (dstpad) - return dstpad; + return dstpad; dstpad = newPADNAMELIST(max); PadnamelistREFCNT(dstpad) = 0; /* The caller will increment it. */ @@ -2701,9 +2701,9 @@ Perl_padnamelist_dup(pTHX_ PADNAMELIST *srcpad, CLONE_PARAMS *param) ptr_table_store(PL_ptr_table, srcpad, dstpad); for (; max >= 0; max--) if (PadnamelistARRAY(srcpad)[max]) { - PadnamelistARRAY(dstpad)[max] = - padname_dup(PadnamelistARRAY(srcpad)[max], param); - PadnameREFCNT(PadnamelistARRAY(dstpad)[max])++; + PadnamelistARRAY(dstpad)[max] = + padname_dup(PadnamelistARRAY(srcpad)[max], param); + PadnameREFCNT(PadnamelistARRAY(dstpad)[max])++; } return dstpad; @@ -2729,8 +2729,8 @@ Perl_newPADNAMEpvn(const char *s, STRLEN len) PADNAME *pn; PERL_ARGS_ASSERT_NEWPADNAMEPVN; Newxz(alloc2, - STRUCT_OFFSET(struct padname_with_str, xpadn_str[0]) + len + 1, - char); + STRUCT_OFFSET(struct padname_with_str, xpadn_str[0]) + len + 1, + char); alloc = (struct padname_with_str *)alloc2; pn = (PADNAME *)alloc; PadnameREFCNT(pn) = 1; @@ -2775,15 +2775,15 @@ Perl_padname_free(pTHX_ PADNAME *pn) { PERL_ARGS_ASSERT_PADNAME_FREE; if (!--PadnameREFCNT(pn)) { - if (UNLIKELY(pn == &PL_padname_undef || pn == &PL_padname_const)) { - PadnameREFCNT(pn) = SvREFCNT_IMMORTAL; - return; - } - SvREFCNT_dec(PadnameTYPE(pn)); /* Takes care of protocv, too. */ - SvREFCNT_dec(PadnameOURSTASH(pn)); - if (PadnameOUTER(pn)) - PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn))); - Safefree(pn); + if (UNLIKELY(pn == &PL_padname_undef || pn == &PL_padname_const)) { + PadnameREFCNT(pn) = SvREFCNT_IMMORTAL; + return; + } + SvREFCNT_dec(PadnameTYPE(pn)); /* Takes care of protocv, too. */ + SvREFCNT_dec(PadnameOURSTASH(pn)); + if (PadnameOUTER(pn)) + PadnameREFCNT_dec(PADNAME_FROM_PV(PadnamePV(pn))); + Safefree(pn); } } @@ -2807,12 +2807,12 @@ Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param) /* look for it in the table first */ dst = (PADNAME *)ptr_table_fetch(PL_ptr_table, src); if (dst) - return dst; + return dst; if (!PadnamePV(src)) { - dst = &PL_padname_undef; - ptr_table_store(PL_ptr_table, src, dst); - return dst; + dst = &PL_padname_undef; + ptr_table_store(PL_ptr_table, src, dst); + return dst; } dst = PadnameOUTER(src) @@ -2824,7 +2824,7 @@ Perl_padname_dup(pTHX_ PADNAME *src, CLONE_PARAMS *param) PadnameREFCNT(dst) = 0; /* The caller will increment it. */ PadnameTYPE (dst) = (HV *)sv_dup_inc((SV *)PadnameTYPE(src), param); PadnameOURSTASH(dst) = (HV *)sv_dup_inc((SV *)PadnameOURSTASH(src), - param); + param); dst->xpadn_low = src->xpadn_low; dst->xpadn_high = src->xpadn_high; dst->xpadn_gen = src->xpadn_gen; diff --git a/pad.h b/pad.h index 6636ca79a0c1..07c4d8686330 100644 --- a/pad.h +++ b/pad.h @@ -23,13 +23,13 @@ typedef SSize_t PADOFFSET; /* signed so that -1 is a valid value */ struct padlist { SSize_t xpadl_max; /* max index for which array has space */ union { - PAD ** xpadlarr_alloc; /* Pointer to beginning of array of AVs. - index 0 is a padnamelist * */ - struct { - PADNAMELIST * padnl; - PAD * pad_1; /* this slice of PAD * array always alloced */ - PAD * pad_2; /* maybe unalloced */ - } * xpadlarr_dbg; /* for use with a C debugger only */ + PAD ** xpadlarr_alloc; /* Pointer to beginning of array of AVs. + index 0 is a padnamelist * */ + struct { + PADNAMELIST * padnl; + PAD * pad_1; /* this slice of PAD * array always alloced */ + PAD * pad_2; /* maybe unalloced */ + } * xpadlarr_dbg; /* for use with a C debugger only */ } xpadl_arr; U32 xpadl_id; /* Semi-unique ID, shared between clones */ U32 xpadl_outid; /* ID of outer pad */ @@ -58,8 +58,8 @@ struct padnamelist { char * xpadn_pv; \ HV * xpadn_ourstash; \ union { \ - HV * xpadn_typestash; \ - CV * xpadn_protocv; \ + HV * xpadn_typestash; \ + CV * xpadn_protocv; \ } xpadn_type_u; \ U32 xpadn_low; \ U32 xpadn_high; \ @@ -92,8 +92,8 @@ struct padname_with_str { */ #define PERL_PADSEQ_INTRO U32_MAX #define COP_SEQMAX_INC \ - (PL_cop_seqmax++, \ - (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++)) + (PL_cop_seqmax++, \ + (void)(PL_cop_seqmax == PERL_PADSEQ_INTRO && PL_cop_seqmax++)) /* B.xs needs these for the benefit of B::Deparse */ @@ -119,9 +119,9 @@ struct padname_with_str { /* values for the pad_tidy() function */ typedef enum { - padtidy_SUB, /* tidy up a pad for a sub, */ - padtidy_SUBCLONE, /* a cloned sub, */ - padtidy_FORMAT /* or a format */ + padtidy_SUB, /* tidy up a pad for a sub, */ + padtidy_SUBCLONE, /* a cloned sub, */ + padtidy_FORMAT /* or a format */ } padtidy_type; /* flags for pad_add_name_pvn. */ @@ -130,7 +130,7 @@ typedef enum { #define padadd_STATE 0x02 /* state declaration. */ #define padadd_NO_DUP_CHECK 0x04 /* skip warning on dups. */ #define padadd_STALEOK 0x08 /* allow stale lexical in active - * sub, but only one level up */ + * sub, but only one level up */ /* ASSERT_CURPAD_LEGAL and ASSERT_CURPAD_ACTIVE respectively determine * whether PL_comppad and PL_curpad are consistent and whether they have @@ -142,15 +142,15 @@ typedef enum { # define ASSERT_CURPAD_LEGAL(label) \ pad_peg(label); \ if (PL_comppad ? (AvARRAY(PL_comppad) != PL_curpad) : (PL_curpad != 0)) \ - Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ - label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); + Perl_croak(aTHX_ "panic: illegal pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ + label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); # define ASSERT_CURPAD_ACTIVE(label) \ pad_peg(label); \ if (!PL_comppad || (AvARRAY(PL_comppad) != PL_curpad)) \ - Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ - label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); + Perl_croak(aTHX_ "panic: invalid pad in %s: 0x%" UVxf "[0x%" UVxf "]",\ + label, PTR2UV(PL_comppad), PTR2UV(PL_curpad)); #else # define ASSERT_CURPAD_LEGAL(label) # define ASSERT_CURPAD_ACTIVE(label) @@ -313,7 +313,7 @@ Restore the old pad saved into the local variable C by C #define PadnameLEN(pn) (pn)->xpadn_len #define PadnameUTF8(pn) 1 #define PadnameSV(pn) \ - newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8) + newSVpvn_flags(PadnamePV(pn), PadnameLEN(pn), SVs_TEMP|SVf_UTF8) #define PadnameFLAGS(pn) (pn)->xpadn_flags #define PadnameIsOUR(pn) (!!(pn)->xpadn_ourstash) #define PadnameOURSTASH(pn) (pn)->xpadn_ourstash @@ -360,43 +360,43 @@ Restore the old pad saved into the local variable C by C #define PAD_SVl(po) (PL_curpad[po]) #define PAD_BASE_SV(padlist, po) \ - (PadlistARRAY(padlist)[1]) \ - ? AvARRAY(MUTABLE_AV((PadlistARRAY(padlist)[1])))[po] \ - : NULL; + (PadlistARRAY(padlist)[1]) \ + ? AvARRAY(MUTABLE_AV((PadlistARRAY(padlist)[1])))[po] \ + : NULL; #define PAD_SET_CUR_NOSAVE(padlist,nth) \ - PL_comppad = (PAD*) (PadlistARRAY(padlist)[nth]); \ - PL_curpad = AvARRAY(PL_comppad); \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] set_cur depth=%d\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); + PL_comppad = (PAD*) (PadlistARRAY(padlist)[nth]); \ + PL_curpad = AvARRAY(PL_comppad); \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] set_cur depth=%d\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad), (int)(nth))); #define PAD_SET_CUR(padlist,nth) \ - SAVECOMPPAD(); \ - PAD_SET_CUR_NOSAVE(padlist,nth); + SAVECOMPPAD(); \ + PAD_SET_CUR_NOSAVE(padlist,nth); #define PAD_SAVE_SETNULLPAD() SAVECOMPPAD(); \ - PL_comppad = NULL; PL_curpad = NULL; \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n")); + PL_comppad = NULL; PL_curpad = NULL; \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad set_null\n")); #define PAD_SAVE_LOCAL(opad,npad) \ - opad = PL_comppad; \ - PL_comppad = (npad); \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] save_local\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad))); + opad = PL_comppad; \ + PL_comppad = (npad); \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] save_local\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad))); #define PAD_RESTORE_LOCAL(opad) \ assert(!opad || !SvIS_FREED(opad)); \ - PL_comppad = opad; \ - PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ - DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ - "Pad 0x%" UVxf "[0x%" UVxf "] restore_local\n", \ - PTR2UV(PL_comppad), PTR2UV(PL_curpad))); + PL_comppad = opad; \ + PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ + DEBUG_Xv(PerlIO_printf(Perl_debug_log, \ + "Pad 0x%" UVxf "[0x%" UVxf "] restore_local\n", \ + PTR2UV(PL_comppad), PTR2UV(PL_curpad))); /* @@ -479,7 +479,7 @@ Clone the state variables associated with running and compiling pads. PL_comppad = av_dup(proto_perl->Icomppad, param); \ PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL; \ PL_comppad_name = \ - padnamelist_dup(proto_perl->Icomppad_name, param); \ + padnamelist_dup(proto_perl->Icomppad_name, param); \ PL_comppad_name_fill = proto_perl->Icomppad_name_fill; \ PL_comppad_name_floor = proto_perl->Icomppad_name_floor; \ PL_min_intro_pending = proto_perl->Imin_intro_pending; \ diff --git a/parser.h b/parser.h index abffd25c424b..d5bc3c86165f 100644 --- a/parser.h +++ b/parser.h @@ -56,7 +56,7 @@ typedef struct yy_parser { char *lex_casestack; /* what kind of case mods in effect */ U8 lex_defer; /* state after determined token */ U8 lex_dojoin; /* doing an array interpolation - 1 = @{...} 2 = ->@ */ + 1 = @{...} 2 = ->@ */ U8 expect; /* how to interpret ambiguous tokens */ bool preambled; bool sub_no_recover; /* can't recover from a sublex error */ @@ -81,8 +81,8 @@ typedef struct yy_parser { LEXSHARED *lex_shared; SV *linestr; /* current chunk of src text */ char *bufptr; /* carries the cursor (current parsing - position) from one invocation of yylex - to the next */ + position) from one invocation of yylex + to the next */ char *oldbufptr; /* in yylex, beginning of current token */ char *oldoldbufptr; /* in yylex, beginning of previous token */ char *bufend; @@ -137,8 +137,8 @@ typedef struct yy_parser { # define LEX_START_COPIED 0x00000008 # define LEX_DONT_CLOSE_RSFP 0x00000010 # define LEX_START_FLAGS \ - (LEX_START_SAME_FILTER|LEX_START_COPIED \ - |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP) + (LEX_START_SAME_FILTER|LEX_START_COPIED \ + |LEX_IGNORE_UTF8_HINTS|LEX_EVALBYTES|LEX_DONT_CLOSE_RSFP) #endif /* flags for parser API */ diff --git a/patchlevel.h b/patchlevel.h index 77bc59cfcb08..7803e0ebdb9d 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -71,42 +71,42 @@ Instead use one of the version comparison macros. See C>. #endif /* - local_patches -- list of locally applied less-than-subversion patches. - If you're distributing such a patch, please give it a name and a - one-line description, placed just before the last NULL in the array - below. If your patch fixes a bug in the perlbug database, please - mention the bugid. If your patch *IS* dependent on a prior patch, - please place your applied patch line after its dependencies. This - will help tracking of patch dependencies. - - Please either use 'diff --unified=0' if your diff supports - that or edit the hunk of the diff output which adds your patch - to this list, to remove context lines which would give patch - problems. For instance, if the original context diff is - - *** patchlevel.h.orig - --- patchlevel.h - *** 38,43 *** - --- 38,44 --- - ,"FOO1235 - some patch" - ,"BAR3141 - another patch" - ,"BAZ2718 - and another patch" - + ,"MINE001 - my new patch" - ,NULL - }; - - please change it to - *** patchlevel.h.orig - --- patchlevel.h - *** 41,43 *** - --- 41,44 --- - + ,"MINE001 - my new patch" - ,NULL - }; - - (Note changes to line numbers as well as removal of context lines.) - This will prevent patch from choking if someone has previously - applied different patches than you. + local_patches -- list of locally applied less-than-subversion patches. + If you're distributing such a patch, please give it a name and a + one-line description, placed just before the last NULL in the array + below. If your patch fixes a bug in the perlbug database, please + mention the bugid. If your patch *IS* dependent on a prior patch, + please place your applied patch line after its dependencies. This + will help tracking of patch dependencies. + + Please either use 'diff --unified=0' if your diff supports + that or edit the hunk of the diff output which adds your patch + to this list, to remove context lines which would give patch + problems. For instance, if the original context diff is + + *** patchlevel.h.orig + --- patchlevel.h + *** 38,43 *** + --- 38,44 --- + ,"FOO1235 - some patch" + ,"BAR3141 - another patch" + ,"BAZ2718 - and another patch" + + ,"MINE001 - my new patch" + ,NULL + }; + + please change it to + *** patchlevel.h.orig + --- patchlevel.h + *** 41,43 *** + --- 41,44 --- + + ,"MINE001 - my new patch" + ,NULL + }; + + (Note changes to line numbers as well as removal of context lines.) + This will prevent patch from choking if someone has previously + applied different patches than you. History has shown that nobody distributes patches that also modify patchlevel.h. Do it yourself. The following perl @@ -120,8 +120,8 @@ my $seen=0; while () { if (/\t,NULL/ and $seen) { while (my $c = shift @ARGV){ - $c =~ s|\\|\\\\|g; - $c =~ s|"|\\"|g; + $c =~ s|\\|\\\\|g; + $c =~ s|"|\\"|g; print PLOUT qq{\t,"$c"\n}; } } @@ -156,19 +156,19 @@ hunk. #include "git_version.h" # endif static const char * const local_patches[] = { - NULL + NULL #ifdef PERL_GIT_UNCOMMITTED_CHANGES - ,"uncommitted-changes" + ,"uncommitted-changes" #endif - PERL_GIT_UNPUSHED_COMMITS /* do not remove this line */ - ,NULL + PERL_GIT_UNPUSHED_COMMITS /* do not remove this line */ + ,NULL }; /* Initial space prevents this variable from being inserted in config.sh */ # define LOCAL_PATCH_COUNT \ - ((int)(C_ARRAY_LENGTH(local_patches)-2)) + ((int)(C_ARRAY_LENGTH(local_patches)-2)) /* the old terms of reference, add them only when explicitly included */ #define PATCHLEVEL PERL_VERSION diff --git a/perl_inc_macro.h b/perl_inc_macro.h index 5a2f20dfaeb2..b9cd60947e1f 100644 --- a/perl_inc_macro.h +++ b/perl_inc_macro.h @@ -24,7 +24,7 @@ #ifdef APPLLIB_EXP # define INCPUSH_APPLLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ - INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif #ifdef SITEARCH_EXP @@ -32,7 +32,7 @@ * DLL-based path intuition to work correctly */ # if !defined(WIN32) # define INCPUSH_SITEARCH_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITEARCH_EXP), \ - INCPUSH_CAN_RELOCATE); + INCPUSH_CAN_RELOCATE); # endif #endif @@ -40,10 +40,10 @@ # if defined(WIN32) /* this picks up sitearch as well */ # define INCPUSH_SITELIB_EXP s = PerlEnv_sitelib_path(PERL_FS_VERSION, &len); \ - if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else # define INCPUSH_SITELIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_EXP), \ - INCPUSH_CAN_RELOCATE); + INCPUSH_CAN_RELOCATE); # endif #endif @@ -59,7 +59,7 @@ # if defined(WIN32) /* this picks up vendorarch as well */ # define INCPUSH_PERL_VENDORLIB_EXP s = PerlEnv_vendorlib_path(PERL_FS_VERSION, &len); \ - if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); + if (s) incpush_use_sep(s, len, INCPUSH_ADD_SUB_DIRS|INCPUSH_CAN_RELOCATE); # else # define INCPUSH_PERL_VENDORLIB_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_EXP), INCPUSH_CAN_RELOCATE); # endif @@ -85,7 +85,7 @@ #ifdef PERL_OTHERLIBDIRS # define INCPUSH_PERL_OTHERLIBDIRS S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ - INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_VERSIONED_SUB_DIRS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); #endif @@ -106,17 +106,17 @@ # define _INCPUSH_PERL5LIB_ADD _INCPUSH_PERL5LIB_IF incpush_use_sep(perl5lib, 0, INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); #else /* VMS */ - /* Treat PERL5?LIB as a possible search list logical name -- the - * "natural" VMS idiom for a Unix path string. We allow each - * element to be a set of |-separated directories for compatibility. - */ + /* Treat PERL5?LIB as a possible search list logical name -- the + * "natural" VMS idiom for a Unix path string. We allow each + * element to be a set of |-separated directories for compatibility. + */ # define _INCPUSH_PERL5LIB_ADD char buf[256]; \ - int idx = 0; \ - if (vmstrnenv("PERL5LIB",buf,0,NULL,0)) \ - do { \ - incpush_use_sep(buf, 0, \ - INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); \ - } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0)); + int idx = 0; \ + if (vmstrnenv("PERL5LIB",buf,0,NULL,0)) \ + do { \ + incpush_use_sep(buf, 0, \ + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR); \ + } while (vmstrnenv("PERL5LIB",buf,++idx,NULL,0)); #endif /* this macro is special and use submacros from above */ @@ -127,25 +127,25 @@ */ #ifdef APPLLIB_EXP # define INCPUSH_APPLLIB_OLD_EXP S_incpush_use_sep(aTHX_ STR_WITH_LEN(APPLLIB_EXP), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_OLD_VERS|INCPUSH_NOT_BASEDIR|INCPUSH_CAN_RELOCATE); #endif #if defined(SITELIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ # define INCPUSH_SITELIB_STEM S_incpush_use_sep(aTHX_ STR_WITH_LEN(SITELIB_STEM), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); #endif #if defined(PERL_VENDORLIB_STEM) && defined(PERL_INC_VERSION_LIST) /* Search for version-specific dirs below here */ # define INCPUSH_PERL_VENDORLIB_STEM S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_VENDORLIB_STEM), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_OLD_VERS|INCPUSH_CAN_RELOCATE); #endif #ifdef PERL_OTHERLIBDIRS # define INCPUSH_PERL_OTHERLIBDIRS_ARCHONLY S_incpush_use_sep(aTHX_ STR_WITH_LEN(PERL_OTHERLIBDIRS), \ - INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_CAN_RELOCATE); + INCPUSH_ADD_OLD_VERS|INCPUSH_ADD_ARCHONLY_SUB_DIRS|INCPUSH_CAN_RELOCATE); #endif diff --git a/perlio.c b/perlio.c index b3b4327491f7..aa85c16f8c90 100644 --- a/perlio.c +++ b/perlio.c @@ -57,52 +57,52 @@ /* Call the callback or PerlIOBase, and return failure. */ #define Perl_PerlIO_or_Base(f, callback, base, failure, args) \ - if (PerlIOValid(f)) { \ - const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ - if (tab && tab->callback) \ - return (*tab->callback) args; \ - else \ - return PerlIOBase_ ## base args; \ - } \ - else \ - SETERRNO(EBADF, SS_IVCHAN); \ - return failure + if (PerlIOValid(f)) { \ + const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ + if (tab && tab->callback) \ + return (*tab->callback) args; \ + else \ + return PerlIOBase_ ## base args; \ + } \ + else \ + SETERRNO(EBADF, SS_IVCHAN); \ + return failure /* Call the callback or fail, and return failure. */ #define Perl_PerlIO_or_fail(f, callback, failure, args) \ - if (PerlIOValid(f)) { \ - const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ - if (tab && tab->callback) \ - return (*tab->callback) args; \ - SETERRNO(EINVAL, LIB_INVARG); \ - } \ - else \ - SETERRNO(EBADF, SS_IVCHAN); \ - return failure + if (PerlIOValid(f)) { \ + const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ + if (tab && tab->callback) \ + return (*tab->callback) args; \ + SETERRNO(EINVAL, LIB_INVARG); \ + } \ + else \ + SETERRNO(EBADF, SS_IVCHAN); \ + return failure /* Call the callback or PerlIOBase, and be void. */ #define Perl_PerlIO_or_Base_void(f, callback, base, args) \ - if (PerlIOValid(f)) { \ - const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ - if (tab && tab->callback) \ - (*tab->callback) args; \ - else \ - PerlIOBase_ ## base args; \ - } \ - else \ - SETERRNO(EBADF, SS_IVCHAN) + if (PerlIOValid(f)) { \ + const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ + if (tab && tab->callback) \ + (*tab->callback) args; \ + else \ + PerlIOBase_ ## base args; \ + } \ + else \ + SETERRNO(EBADF, SS_IVCHAN) /* Call the callback or fail, and be void. */ #define Perl_PerlIO_or_fail_void(f, callback, args) \ - if (PerlIOValid(f)) { \ - const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ - if (tab && tab->callback) \ - (*tab->callback) args; \ - else \ - SETERRNO(EINVAL, LIB_INVARG); \ - } \ - else \ - SETERRNO(EBADF, SS_IVCHAN) + if (PerlIOValid(f)) { \ + const PerlIO_funcs * const tab = PerlIOBase(f)->tab;\ + if (tab && tab->callback) \ + (*tab->callback) args; \ + else \ + SETERRNO(EINVAL, LIB_INVARG); \ + } \ + else \ + SETERRNO(EBADF, SS_IVCHAN) #if defined(__osf__) && _XOPEN_SOURCE < 500 extern int fseeko(FILE *, off_t, int); @@ -163,42 +163,42 @@ PerlIO_intmode2str(int rawmode, char *mode, int *writing) int ptype; switch (result) { case O_RDONLY: - ptype = IoTYPE_RDONLY; - break; + ptype = IoTYPE_RDONLY; + break; case O_WRONLY: - ptype = IoTYPE_WRONLY; - break; + ptype = IoTYPE_WRONLY; + break; case O_RDWR: default: - ptype = IoTYPE_RDWR; - break; + ptype = IoTYPE_RDWR; + break; } if (writing) - *writing = (result != O_RDONLY); + *writing = (result != O_RDONLY); if (result == O_RDONLY) { - mode[ix++] = 'r'; + mode[ix++] = 'r'; } #ifdef O_APPEND else if (rawmode & O_APPEND) { - mode[ix++] = 'a'; - if (result != O_WRONLY) - mode[ix++] = '+'; + mode[ix++] = 'a'; + if (result != O_WRONLY) + mode[ix++] = '+'; } #endif else { - if (result == O_WRONLY) - mode[ix++] = 'w'; - else { - mode[ix++] = 'r'; - mode[ix++] = '+'; - } + if (result == O_WRONLY) + mode[ix++] = 'w'; + else { + mode[ix++] = 'r'; + mode[ix++] = '+'; + } } #if O_BINARY != 0 /* Unless O_BINARY is different from zero, bit-and:ing * with it won't do much good. */ if (rawmode & O_BINARY) - mode[ix++] = 'b'; + mode[ix++] = 'b'; #endif mode[ix] = '\0'; return ptype; @@ -213,7 +213,7 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) || strEQ(names, ":raw") || strEQ(names, ":bytes") ) { - return 0; + return 0; } Perl_croak(aTHX_ "Cannot apply \"%s\" in non-PerlIO perl", names); /* @@ -245,22 +245,22 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) return win32_fdupopen(f); # else if (f) { - const int fd = PerlLIO_dup_cloexec(PerlIO_fileno(f)); - if (fd >= 0) { - char mode[8]; + const int fd = PerlLIO_dup_cloexec(PerlIO_fileno(f)); + if (fd >= 0) { + char mode[8]; # ifdef DJGPP - const int omode = djgpp_get_stream_mode(f); + const int omode = djgpp_get_stream_mode(f); # else - const int omode = fcntl(fd, F_GETFL); + const int omode = fcntl(fd, F_GETFL); # endif - PerlIO_intmode2str(omode,mode,NULL); - /* the r+ is a hack */ - return PerlIO_fdopen(fd, mode); - } - return NULL; + PerlIO_intmode2str(omode,mode,NULL); + /* the r+ is a hack */ + return PerlIO_fdopen(fd, mode); + } + return NULL; } else { - SETERRNO(EBADF, SS_IVCHAN); + SETERRNO(EBADF, SS_IVCHAN); } # endif return NULL; @@ -274,35 +274,35 @@ PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, - int imode, int perm, PerlIO *old, int narg, SV **args) + int imode, int perm, PerlIO *old, int narg, SV **args) { if (narg) { - if (narg > 1) { - Perl_croak(aTHX_ "More than one argument to open"); - } - if (*args == &PL_sv_undef) - return PerlIO_tmpfile(); - else { + if (narg > 1) { + Perl_croak(aTHX_ "More than one argument to open"); + } + if (*args == &PL_sv_undef) + return PerlIO_tmpfile(); + else { STRLEN len; - const char *name = SvPV_const(*args, len); + const char *name = SvPV_const(*args, len); if (!IS_SAFE_PATHNAME(name, len, "open")) return NULL; - if (*mode == IoTYPE_NUMERIC) { - fd = PerlLIO_open3_cloexec(name, imode, perm); - if (fd >= 0) - return PerlIO_fdopen(fd, mode + 1); - } - else if (old) { - return PerlIO_reopen(name, mode, old); - } - else { - return PerlIO_open(name, mode); - } - } + if (*mode == IoTYPE_NUMERIC) { + fd = PerlLIO_open3_cloexec(name, imode, perm); + if (fd >= 0) + return PerlIO_fdopen(fd, mode + 1); + } + else if (old) { + return PerlIO_reopen(name, mode, old); + } + else { + return PerlIO_open(name, mode); + } + } } else { - return PerlIO_fdopen(fd, (char *) mode); + return PerlIO_fdopen(fd, (char *) mode); } return NULL; } @@ -312,12 +312,12 @@ XS(XS_PerlIO__Layer__find) { dXSARGS; if (items < 2) - Perl_croak(aTHX_ "Usage class->find(name[,load])"); + Perl_croak(aTHX_ "Usage class->find(name[,load])"); else { - const char * const name = SvPV_nolen_const(ST(1)); - ST(0) = (strEQ(name, "crlf") - || strEQ(name, "raw")) ? &PL_sv_yes : &PL_sv_undef; - XSRETURN(1); + const char * const name = SvPV_nolen_const(ST(1)); + ST(0) = (strEQ(name, "crlf") + || strEQ(name, "raw")) ? &PL_sv_yes : &PL_sv_undef; + XSRETURN(1); } } @@ -350,27 +350,27 @@ PerlIO_debug(const char *fmt, ...) va_start(ap, fmt); if (!PL_perlio_debug_fd) { - if (!TAINTING_get && - PerlProc_getuid() == PerlProc_geteuid() && - PerlProc_getgid() == PerlProc_getegid()) { - const char * const s = PerlEnv_getenv("PERLIO_DEBUG"); - if (s && *s) - PL_perlio_debug_fd = PerlLIO_open3_cloexec(s, - O_WRONLY | O_CREAT | O_APPEND, 0666); - else - PL_perlio_debug_fd = PerlLIO_dup_cloexec(2); /* stderr */ - } else { - /* tainting or set*id, so ignore the environment and send the + if (!TAINTING_get && + PerlProc_getuid() == PerlProc_geteuid() && + PerlProc_getgid() == PerlProc_getegid()) { + const char * const s = PerlEnv_getenv("PERLIO_DEBUG"); + if (s && *s) + PL_perlio_debug_fd = PerlLIO_open3_cloexec(s, + O_WRONLY | O_CREAT | O_APPEND, 0666); + else + PL_perlio_debug_fd = PerlLIO_dup_cloexec(2); /* stderr */ + } else { + /* tainting or set*id, so ignore the environment and send the debug output to stderr, like other -D switches. */ - PL_perlio_debug_fd = PerlLIO_dup_cloexec(2); /* stderr */ - } + PL_perlio_debug_fd = PerlLIO_dup_cloexec(2); /* stderr */ + } } if (PL_perlio_debug_fd > 0) { #ifdef USE_ITHREADS - const char * const s = CopFILE(PL_curcop); - /* Use fixed buffer as sv_catpvf etc. needs SVs */ - char buffer[1024]; - const STRLEN len1 = my_snprintf(buffer, sizeof(buffer), "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop)); + const char * const s = CopFILE(PL_curcop); + /* Use fixed buffer as sv_catpvf etc. needs SVs */ + char buffer[1024]; + const STRLEN len1 = my_snprintf(buffer, sizeof(buffer), "%.40s:%" IVdf " ", s ? s : "(none)", (IV) CopLINE(PL_curcop)); # ifdef USE_QUADMATH # ifdef HAS_VSNPRINTF /* my_vsnprintf() isn't available with quadmath, but the native vsnprintf() @@ -382,19 +382,19 @@ PerlIO_debug(const char *fmt, ...) STATIC_ASSERT_STMT(0); # endif # else - const STRLEN len2 = my_vsnprintf(buffer + len1, sizeof(buffer) - len1, fmt, ap); + const STRLEN len2 = my_vsnprintf(buffer + len1, sizeof(buffer) - len1, fmt, ap); # endif - PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, buffer, len1 + len2)); + PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, buffer, len1 + len2)); #else - const char *s = CopFILE(PL_curcop); - STRLEN len; - SV * const sv = Perl_newSVpvf(aTHX_ "%s:%" IVdf " ", s ? s : "(none)", - (IV) CopLINE(PL_curcop)); - Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap); - - s = SvPV_const(sv, len); - PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, s, len)); - SvREFCNT_dec(sv); + const char *s = CopFILE(PL_curcop); + STRLEN len; + SV * const sv = Perl_newSVpvf(aTHX_ "%s:%" IVdf " ", s ? s : "(none)", + (IV) CopLINE(PL_curcop)); + Perl_sv_vcatpvf(aTHX_ sv, fmt, &ap); + + s = SvPV_const(sv, len); + PERL_UNUSED_RESULT(PerlLIO_write(PL_perlio_debug_fd, s, len)); + SvREFCNT_dec(sv); #endif } va_end(ap); @@ -419,14 +419,14 @@ PerlIO_verify_head(pTHX_ PerlIO *f) PERL_UNUSED_CONTEXT; # endif if (!PerlIOValid(f)) - return; + return; p = head = PerlIOBase(f)->head; assert(p); do { - assert(p->head == head); - if (p == (PerlIOl*)f) - seen = 1; - p = p->next; + assert(p->head == head); + if (p == (PerlIOl*)f) + seen = 1; + p = p->next; } while (p); assert(seen); } @@ -444,7 +444,7 @@ static void PerlIO_init_table(pTHX) { if (PL_perlio) - return; + return; Newxz(PL_perlio, PERLIO_TABLE_SIZE, PerlIOl); } @@ -460,17 +460,17 @@ PerlIO_allocate(pTHX) PerlIOl *f; last = &PL_perlio; while ((f = *last)) { - int i; - last = (PerlIOl **) (f); - for (i = 1; i < PERLIO_TABLE_SIZE; i++) { - if (!((++f)->next)) { - goto good_exit; - } - } + int i; + last = (PerlIOl **) (f); + for (i = 1; i < PERLIO_TABLE_SIZE; i++) { + if (!((++f)->next)) { + goto good_exit; + } + } } Newxz(f,PERLIO_TABLE_SIZE,PerlIOl); if (!f) { - return NULL; + return NULL; } *last = (PerlIOl*) f++; @@ -486,16 +486,16 @@ PerlIO * PerlIO_fdupopen(pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags) { if (PerlIOValid(f)) { - const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - DEBUG_i( PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param) ); - if (tab && tab->Dup) - return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags); - else { - return PerlIOBase_dup(aTHX_ PerlIO_allocate(aTHX), f, param, flags); - } + const PerlIO_funcs * const tab = PerlIOBase(f)->tab; + DEBUG_i( PerlIO_debug("fdupopen f=%p param=%p\n",(void*)f,(void*)param) ); + if (tab && tab->Dup) + return (*tab->Dup)(aTHX_ PerlIO_allocate(aTHX), f, param, flags); + else { + return PerlIOBase_dup(aTHX_ PerlIO_allocate(aTHX), f, param, flags); + } } else - SETERRNO(EBADF, SS_IVCHAN); + SETERRNO(EBADF, SS_IVCHAN); return NULL; } @@ -505,16 +505,16 @@ PerlIO_cleantable(pTHX_ PerlIOl **tablep) { PerlIOl * const table = *tablep; if (table) { - int i; - PerlIO_cleantable(aTHX_(PerlIOl **) & (table[0])); - for (i = PERLIO_TABLE_SIZE - 1; i > 0; i--) { - PerlIOl * const f = table + i; - if (f->next) { - PerlIO_close(&(f->next)); - } - } - Safefree(table); - *tablep = NULL; + int i; + PerlIO_cleantable(aTHX_(PerlIOl **) & (table[0])); + for (i = PERLIO_TABLE_SIZE - 1; i > 0; i--) { + PerlIOl * const f = table + i; + if (f->next) { + PerlIO_close(&(f->next)); + } + } + Safefree(table); + *tablep = NULL; } } @@ -533,15 +533,15 @@ void PerlIO_list_free(pTHX_ PerlIO_list_t *list) { if (list) { - if (--list->refcnt == 0) { - if (list->array) { - IV i; - for (i = 0; i < list->cur; i++) - SvREFCNT_dec(list->array[i].arg); - Safefree(list->array); - } - Safefree(list); - } + if (--list->refcnt == 0) { + if (list->array) { + IV i; + for (i = 0; i < list->cur; i++) + SvREFCNT_dec(list->array[i].arg); + Safefree(list->array); + } + Safefree(list); + } } } @@ -553,16 +553,16 @@ PerlIO_list_push(pTHX_ PerlIO_list_t *list, PerlIO_funcs *funcs, SV *arg) if (list->cur >= list->len) { const IV new_len = list->len + 8; - if (list->array) - Renew(list->array, new_len, PerlIO_pair_t); - else - Newx(list->array, new_len, PerlIO_pair_t); - list->len = new_len; + if (list->array) + Renew(list->array, new_len, PerlIO_pair_t); + else + Newx(list->array, new_len, PerlIO_pair_t); + list->len = new_len; } p = &(list->array[list->cur++]); p->funcs = funcs; if ((p->arg = arg)) { - SvREFCNT_inc_simple_void_NN(arg); + SvREFCNT_inc_simple_void_NN(arg); } } @@ -571,18 +571,18 @@ PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param) { PerlIO_list_t *list = NULL; if (proto) { - int i; - list = PerlIO_list_alloc(aTHX); - for (i=0; i < proto->cur; i++) { - SV *arg = proto->array[i].arg; + int i; + list = PerlIO_list_alloc(aTHX); + for (i=0; i < proto->cur; i++) { + SV *arg = proto->array[i].arg; #ifdef USE_ITHREADS - if (arg && param) - arg = sv_dup(arg, param); + if (arg && param) + arg = sv_dup(arg, param); #else - PERL_UNUSED_ARG(param); + PERL_UNUSED_ARG(param); #endif - PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg); - } + PerlIO_list_push(aTHX_ list, proto->array[i].funcs, arg); + } } return list; } @@ -599,15 +599,15 @@ PerlIO_clone(pTHX_ PerlInterpreter *proto, CLONE_PARAMS *param) PerlIO_init_table(aTHX); DEBUG_i( PerlIO_debug("Clone %p from %p\n",(void*)aTHX,(void*)proto) ); while ((f = *table)) { - int i; - table = (PerlIOl **) (f++); - for (i = 1; i < PERLIO_TABLE_SIZE; i++) { - if (f->next) { - (void) fp_dup(&(f->next), 0, param); - } - f++; - } - } + int i; + table = (PerlIOl **) (f++); + for (i = 1; i < PERLIO_TABLE_SIZE; i++) { + if (f->next) { + (void) fp_dup(&(f->next), 0, param); + } + f++; + } + } #else PERL_UNUSED_CONTEXT; PERL_UNUSED_ARG(proto); @@ -624,23 +624,23 @@ PerlIO_destruct(pTHX) DEBUG_i( PerlIO_debug("Destruct %p\n",(void*)aTHX) ); #endif while ((f = *table)) { - int i; - table = (PerlIOl **) (f++); - for (i = 1; i < PERLIO_TABLE_SIZE; i++) { - PerlIO *x = &(f->next); - const PerlIOl *l; - while ((l = *x)) { - if (l->tab && l->tab->kind & PERLIO_K_DESTRUCT) { - DEBUG_i( PerlIO_debug("Destruct popping %s\n", l->tab->name) ); - PerlIO_flush(x); - PerlIO_pop(aTHX_ x); - } - else { - x = PerlIONext(x); - } - } - f++; - } + int i; + table = (PerlIOl **) (f++); + for (i = 1; i < PERLIO_TABLE_SIZE; i++) { + PerlIO *x = &(f->next); + const PerlIOl *l; + while ((l = *x)) { + if (l->tab && l->tab->kind & PERLIO_K_DESTRUCT) { + DEBUG_i( PerlIO_debug("Destruct popping %s\n", l->tab->name) ); + PerlIO_flush(x); + PerlIO_pop(aTHX_ x); + } + else { + x = PerlIONext(x); + } + } + f++; + } } } @@ -650,26 +650,26 @@ PerlIO_pop(pTHX_ PerlIO *f) const PerlIOl *l = *f; VERIFY_HEAD(f); if (l) { - DEBUG_i( PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, + DEBUG_i( PerlIO_debug("PerlIO_pop f=%p %s\n", (void*)f, l->tab ? l->tab->name : "(Null)") ); - if (l->tab && l->tab->Popped) { - /* - * If popped returns non-zero do not free its layer structure - * it has either done so itself, or it is shared and still in - * use - */ - if ((*l->tab->Popped) (aTHX_ f) != 0) - return; - } - if (PerlIO_lockcnt(f)) { - /* we're in use; defer freeing the structure */ - PerlIOBase(f)->flags = PERLIO_F_CLEARED; - PerlIOBase(f)->tab = NULL; - } - else { - *f = l->next; - Safefree(l); - } + if (l->tab && l->tab->Popped) { + /* + * If popped returns non-zero do not free its layer structure + * it has either done so itself, or it is shared and still in + * use + */ + if ((*l->tab->Popped) (aTHX_ f) != 0) + return; + } + if (PerlIO_lockcnt(f)) { + /* we're in use; defer freeing the structure */ + PerlIOBase(f)->flags = PERLIO_F_CLEARED; + PerlIOBase(f)->tab = NULL; + } + else { + *f = l->next; + Safefree(l); + } } } @@ -686,23 +686,23 @@ PerlIO_get_layers(pTHX_ PerlIO *f) AV * const av = newAV(); if (PerlIOValid(f)) { - PerlIOl *l = PerlIOBase(f); - - while (l) { - /* There is some collusion in the implementation of - XS_PerlIO_get_layers - it knows that name and flags are - generated as fresh SVs here, and takes advantage of that to - "copy" them by taking a reference. If it changes here, it needs - to change there too. */ - SV * const name = l->tab && l->tab->name ? - newSVpv(l->tab->name, 0) : &PL_sv_undef; - SV * const arg = l->tab && l->tab->Getarg ? - (*l->tab->Getarg)(aTHX_ &l, 0, 0) : &PL_sv_undef; - av_push(av, name); - av_push(av, arg); - av_push(av, newSViv((IV)l->flags)); - l = l->next; - } + PerlIOl *l = PerlIOBase(f); + + while (l) { + /* There is some collusion in the implementation of + XS_PerlIO_get_layers - it knows that name and flags are + generated as fresh SVs here, and takes advantage of that to + "copy" them by taking a reference. If it changes here, it needs + to change there too. */ + SV * const name = l->tab && l->tab->name ? + newSVpv(l->tab->name, 0) : &PL_sv_undef; + SV * const arg = l->tab && l->tab->Getarg ? + (*l->tab->Getarg)(aTHX_ &l, 0, 0) : &PL_sv_undef; + av_push(av, name); + av_push(av, arg); + av_push(av, newSViv((IV)l->flags)); + l = l->next; + } } return av; @@ -719,38 +719,38 @@ PerlIO_find_layer(pTHX_ const char *name, STRLEN len, int load) IV i; if ((SSize_t) len <= 0) - len = strlen(name); + len = strlen(name); for (i = 0; i < PL_known_layers->cur; i++) { - PerlIO_funcs * const f = PL_known_layers->array[i].funcs; + PerlIO_funcs * const f = PL_known_layers->array[i].funcs; const STRLEN this_len = strlen(f->name); if (this_len == len && memEQ(f->name, name, len)) { - DEBUG_i( PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f) ); - return f; - } + DEBUG_i( PerlIO_debug("%.*s => %p\n", (int) len, name, (void*)f) ); + return f; + } } if (load && PL_subname && PL_def_layerlist - && PL_def_layerlist->cur >= 2) { - if (PL_in_load_module) { - Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer"); - return NULL; - } else { - SV * const pkgsv = newSVpvs("PerlIO"); - SV * const layer = newSVpvn(name, len); - CV * const cv = get_cvs("PerlIO::Layer::NoWarnings", 0); - ENTER; - SAVEBOOL(PL_in_load_module); - if (cv) { - SAVEGENERICSV(PL_warnhook); - PL_warnhook = MUTABLE_SV((SvREFCNT_inc_simple_NN(cv))); - } - PL_in_load_module = TRUE; - /* - * The two SVs are magically freed by load_module - */ - Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL); - LEAVE; - return PerlIO_find_layer(aTHX_ name, len, 0); - } + && PL_def_layerlist->cur >= 2) { + if (PL_in_load_module) { + Perl_croak(aTHX_ "Recursive call to Perl_load_module in PerlIO_find_layer"); + return NULL; + } else { + SV * const pkgsv = newSVpvs("PerlIO"); + SV * const layer = newSVpvn(name, len); + CV * const cv = get_cvs("PerlIO::Layer::NoWarnings", 0); + ENTER; + SAVEBOOL(PL_in_load_module); + if (cv) { + SAVEGENERICSV(PL_warnhook); + PL_warnhook = MUTABLE_SV((SvREFCNT_inc_simple_NN(cv))); + } + PL_in_load_module = TRUE; + /* + * The two SVs are magically freed by load_module + */ + Perl_load_module(aTHX_ 0, pkgsv, NULL, layer, NULL); + LEAVE; + return PerlIO_find_layer(aTHX_ name, len, 0); + } } DEBUG_i( PerlIO_debug("Cannot find %.*s\n", (int) len, name) ); return NULL; @@ -762,11 +762,11 @@ static int perlio_mg_set(pTHX_ SV *sv, MAGIC *mg) { if (SvROK(sv)) { - IO * const io = GvIOn(MUTABLE_GV(SvRV(sv))); - PerlIO * const ifp = IoIFP(io); - PerlIO * const ofp = IoOFP(io); - Perl_warn(aTHX_ "set %" SVf " %p %p %p", - SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); + IO * const io = GvIOn(MUTABLE_GV(SvRV(sv))); + PerlIO * const ifp = IoIFP(io); + PerlIO * const ofp = IoOFP(io); + Perl_warn(aTHX_ "set %" SVf " %p %p %p", + SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); } return 0; } @@ -775,11 +775,11 @@ static int perlio_mg_get(pTHX_ SV *sv, MAGIC *mg) { if (SvROK(sv)) { - IO * const io = GvIOn(MUTABLE_GV(SvRV(sv))); - PerlIO * const ifp = IoIFP(io); - PerlIO * const ofp = IoOFP(io); - Perl_warn(aTHX_ "get %" SVf " %p %p %p", - SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); + IO * const io = GvIOn(MUTABLE_GV(SvRV(sv))); + PerlIO * const ifp = IoIFP(io); + PerlIO * const ofp = IoOFP(io); + Perl_warn(aTHX_ "get %" SVf " %p %p %p", + SVfARG(sv), (void*)io, (void*)ifp, (void*)ofp); } return 0; } @@ -822,16 +822,16 @@ XS(XS_io_MODIFY_SCALAR_ATTRIBUTES) mg_magical(sv); Perl_warn(aTHX_ "attrib %" SVf, SVfARG(sv)); for (i = 2; i < items; i++) { - STRLEN len; - const char * const name = SvPV_const(ST(i), len); - SV * const layer = PerlIO_find_layer(aTHX_ name, len, 1); - if (layer) { - av_push(av, SvREFCNT_inc_simple_NN(layer)); - } - else { - ST(count) = ST(i); - count++; - } + STRLEN len; + const char * const name = SvPV_const(ST(i), len); + SV * const layer = PerlIO_find_layer(aTHX_ name, len, 1); + if (layer) { + av_push(av, SvREFCNT_inc_simple_NN(layer)); + } + else { + ST(count) = ST(i); + count++; + } } SvREFCNT_dec(av); XSRETURN(count); @@ -866,16 +866,16 @@ XS(XS_PerlIO__Layer__find) { dXSARGS; if (items < 2) - Perl_croak(aTHX_ "Usage class->find(name[,load])"); + Perl_croak(aTHX_ "Usage class->find(name[,load])"); else { - STRLEN len; - const char * const name = SvPV_const(ST(1), len); - const bool load = (items > 2) ? SvTRUE_NN(ST(2)) : 0; - PerlIO_funcs * const layer = PerlIO_find_layer(aTHX_ name, len, load); - ST(0) = - (layer) ? sv_2mortal(PerlIO_tab_sv(aTHX_ layer)) : - &PL_sv_undef; - XSRETURN(1); + STRLEN len; + const char * const name = SvPV_const(ST(1), len); + const bool load = (items > 2) ? SvTRUE_NN(ST(2)) : 0; + PerlIO_funcs * const layer = PerlIO_find_layer(aTHX_ name, len, load); + ST(0) = + (layer) ? sv_2mortal(PerlIO_tab_sv(aTHX_ layer)) : + &PL_sv_undef; + XSRETURN(1); } } @@ -883,7 +883,7 @@ void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab) { if (!PL_known_layers) - PL_known_layers = PerlIO_list_alloc(aTHX); + PL_known_layers = PerlIO_list_alloc(aTHX); PerlIO_list_push(aTHX_ PL_known_layers, tab, NULL); DEBUG_i( PerlIO_debug("define %s %p\n", tab->name, (void*)tab) ); } @@ -892,88 +892,88 @@ int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names) { if (names) { - const char *s = names; - while (*s) { - while (isSPACE(*s) || *s == ':') - s++; - if (*s) { - STRLEN llen = 0; - const char *e = s; - const char *as = NULL; - STRLEN alen = 0; - if (!isIDFIRST(*s)) { - /* - * Message is consistent with how attribute lists are - * passed. Even though this means "foo : : bar" is - * seen as an invalid separator character. - */ - const char q = ((*s == '\'') ? '"' : '\''); - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), - "Invalid separator character %c%c%c in PerlIO layer specification %s", - q, *s, q, s); - SETERRNO(EINVAL, LIB_INVARG); - return -1; - } - do { - e++; - } while (isWORDCHAR(*e)); - llen = e - s; - if (*e == '(') { - int nesting = 1; - as = ++e; - while (nesting) { - switch (*e++) { - case ')': - if (--nesting == 0) - alen = (e - 1) - as; - break; - case '(': - ++nesting; - break; - case '\\': - /* - * It's a nul terminated string, not allowed - * to \ the terminating null. Anything other - * character is passed over. - */ - if (*e++) { - break; - } + const char *s = names; + while (*s) { + while (isSPACE(*s) || *s == ':') + s++; + if (*s) { + STRLEN llen = 0; + const char *e = s; + const char *as = NULL; + STRLEN alen = 0; + if (!isIDFIRST(*s)) { + /* + * Message is consistent with how attribute lists are + * passed. Even though this means "foo : : bar" is + * seen as an invalid separator character. + */ + const char q = ((*s == '\'') ? '"' : '\''); + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), + "Invalid separator character %c%c%c in PerlIO layer specification %s", + q, *s, q, s); + SETERRNO(EINVAL, LIB_INVARG); + return -1; + } + do { + e++; + } while (isWORDCHAR(*e)); + llen = e - s; + if (*e == '(') { + int nesting = 1; + as = ++e; + while (nesting) { + switch (*e++) { + case ')': + if (--nesting == 0) + alen = (e - 1) - as; + break; + case '(': + ++nesting; + break; + case '\\': + /* + * It's a nul terminated string, not allowed + * to \ the terminating null. Anything other + * character is passed over. + */ + if (*e++) { + break; + } /* Fall through */ - case '\0': - e--; - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), - "Argument list not closed for PerlIO layer \"%.*s\"", - (int) (e - s), s); - return -1; - default: - /* - * boring. - */ - break; - } - } - } - if (e > s) { - PerlIO_funcs * const layer = - PerlIO_find_layer(aTHX_ s, llen, 1); - if (layer) { - SV *arg = NULL; - if (as) - arg = newSVpvn(as, alen); - PerlIO_list_push(aTHX_ av, layer, - (arg) ? arg : &PL_sv_undef); - SvREFCNT_dec(arg); - } - else { - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", - (int) llen, s); - return -1; - } - } - s = e; - } - } + case '\0': + e--; + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), + "Argument list not closed for PerlIO layer \"%.*s\"", + (int) (e - s), s); + return -1; + default: + /* + * boring. + */ + break; + } + } + } + if (e > s) { + PerlIO_funcs * const layer = + PerlIO_find_layer(aTHX_ s, llen, 1); + if (layer) { + SV *arg = NULL; + if (as) + arg = newSVpvn(as, alen); + PerlIO_list_push(aTHX_ av, layer, + (arg) ? arg : &PL_sv_undef); + SvREFCNT_dec(arg); + } + else { + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"%.*s\"", + (int) llen, s); + return -1; + } + } + s = e; + } + } } return 0; } @@ -986,7 +986,7 @@ PerlIO_default_buffer(pTHX_ PerlIO_list_t *av) tab = &PerlIO_crlf; #else if (PerlIO_stdio.Set_ptrcnt) - tab = &PerlIO_stdio; + tab = &PerlIO_stdio; #endif DEBUG_i( PerlIO_debug("Pushing %s\n", tab->name) ); PerlIO_list_push(aTHX_ av, (PerlIO_funcs *)tab, &PL_sv_undef); @@ -1002,12 +1002,12 @@ PerlIO_funcs * PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def) { if (n >= 0 && n < av->cur) { - DEBUG_i( PerlIO_debug("Layer %" IVdf " is %s\n", n, + DEBUG_i( PerlIO_debug("Layer %" IVdf " is %s\n", n, av->array[n].funcs->name) ); - return av->array[n].funcs; + return av->array[n].funcs; } if (!def) - Perl_croak(aTHX_ "panic: PerlIO layer array corrupt"); + Perl_croak(aTHX_ "panic: PerlIO layer array corrupt"); return def; } @@ -1018,9 +1018,9 @@ PerlIOPop_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PERL_UNUSED_ARG(arg); PERL_UNUSED_ARG(tab); if (PerlIOValid(f)) { - PerlIO_flush(f); - PerlIO_pop(aTHX_ f); - return 0; + PerlIO_flush(f); + PerlIO_pop(aTHX_ f); + return 0; } return -1; } @@ -1060,34 +1060,34 @@ PerlIO_list_t * PerlIO_default_layers(pTHX) { if (!PL_def_layerlist) { - const char * const s = TAINTING_get ? NULL : PerlEnv_getenv("PERLIO"); - PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix; - PL_def_layerlist = PerlIO_list_alloc(aTHX); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix)); + const char * const s = TAINTING_get ? NULL : PerlEnv_getenv("PERLIO"); + PERLIO_FUNCS_DECL(*osLayer) = &PerlIO_unix; + PL_def_layerlist = PerlIO_list_alloc(aTHX); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_unix)); #if defined(WIN32) - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_win32)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_win32)); # if 0 - osLayer = &PerlIO_win32; + osLayer = &PerlIO_win32; # endif #endif - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_raw)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_perlio)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_stdio)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_crlf)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_utf8)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_remove)); - PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_byte)); - PerlIO_list_push(aTHX_ PL_def_layerlist, (PerlIO_funcs *)osLayer, + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_raw)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_perlio)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_stdio)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_crlf)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_utf8)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_remove)); + PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_byte)); + PerlIO_list_push(aTHX_ PL_def_layerlist, (PerlIO_funcs *)osLayer, &PL_sv_undef); - if (s) { - PerlIO_parse_layers(aTHX_ PL_def_layerlist, s); - } - else { - PerlIO_default_buffer(aTHX_ PL_def_layerlist); - } + if (s) { + PerlIO_parse_layers(aTHX_ PL_def_layerlist, s); + } + else { + PerlIO_default_buffer(aTHX_ PL_def_layerlist); + } } if (PL_def_layerlist->cur < 2) { - PerlIO_default_buffer(aTHX_ PL_def_layerlist); + PerlIO_default_buffer(aTHX_ PL_def_layerlist); } return PL_def_layerlist; } @@ -1097,7 +1097,7 @@ Perl_boot_core_PerlIO(pTHX) { #ifdef USE_ATTRIBUTES_FOR_PERLIO newXS("io::MODIFY_SCALAR_ATTRIBUTES", XS_io_MODIFY_SCALAR_ATTRIBUTES, - __FILE__); + __FILE__); #endif newXS("PerlIO::Layer::find", XS_PerlIO__Layer__find, __FILE__); newXS("PerlIO::Layer::NoWarnings", XS_PerlIO__Layer__NoWarnings, __FILE__); @@ -1108,7 +1108,7 @@ PerlIO_default_layer(pTHX_ I32 n) { PerlIO_list_t * const av = PerlIO_default_layers(aTHX); if (n < 0) - n += av->cur; + n += av->cur; return PerlIO_layer_fetch(aTHX_ av, n, PERLIO_FUNCS_CAST(&PerlIO_stdio)); } @@ -1119,10 +1119,10 @@ void PerlIO_stdstreams(pTHX) { if (!PL_perlio) { - PerlIO_init_table(aTHX); - PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT); - PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT); - PerlIO_fdopen(2, "Iw" PERLIO_STDTEXT); + PerlIO_init_table(aTHX); + PerlIO_fdopen(0, "Ir" PERLIO_STDTEXT); + PerlIO_fdopen(1, "Iw" PERLIO_STDTEXT); + PerlIO_fdopen(2, "Iw" PERLIO_STDTEXT); } } @@ -1131,68 +1131,68 @@ PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), const char *mode, SV *arg) { VERIFY_HEAD(f); if (tab->fsize != sizeof(PerlIO_funcs)) { - Perl_croak( aTHX_ - "%s (%" UVuf ") does not match %s (%" UVuf ")", - "PerlIO layer function table size", (UV)tab->fsize, - "size expected by this perl", (UV)sizeof(PerlIO_funcs) ); + Perl_croak( aTHX_ + "%s (%" UVuf ") does not match %s (%" UVuf ")", + "PerlIO layer function table size", (UV)tab->fsize, + "size expected by this perl", (UV)sizeof(PerlIO_funcs) ); } if (tab->size) { - PerlIOl *l; - if (tab->size < sizeof(PerlIOl)) { - Perl_croak( aTHX_ - "%s (%" UVuf ") smaller than %s (%" UVuf ")", - "PerlIO layer instance size", (UV)tab->size, - "size expected by this perl", (UV)sizeof(PerlIOl) ); - } - /* Real layer with a data area */ - if (f) { - char *temp; - Newxz(temp, tab->size, char); - l = (PerlIOl*)temp; - if (l) { - l->next = *f; - l->tab = (PerlIO_funcs*) tab; - l->head = ((PerlIOl*)f)->head; - *f = l; - DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", + PerlIOl *l; + if (tab->size < sizeof(PerlIOl)) { + Perl_croak( aTHX_ + "%s (%" UVuf ") smaller than %s (%" UVuf ")", + "PerlIO layer instance size", (UV)tab->size, + "size expected by this perl", (UV)sizeof(PerlIOl) ); + } + /* Real layer with a data area */ + if (f) { + char *temp; + Newxz(temp, tab->size, char); + l = (PerlIOl*)temp; + if (l) { + l->next = *f; + l->tab = (PerlIO_funcs*) tab; + l->head = ((PerlIOl*)f)->head; + *f = l; + DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, (mode) ? mode : "(Null)", (void*)arg) ); - if (*l->tab->Pushed && - (*l->tab->Pushed) - (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { - PerlIO_pop(aTHX_ f); - return NULL; - } - } - else - return NULL; - } + if (*l->tab->Pushed && + (*l->tab->Pushed) + (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { + PerlIO_pop(aTHX_ f); + return NULL; + } + } + else + return NULL; + } } else if (f) { - /* Pseudo-layer where push does its own stack adjust */ - DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, + /* Pseudo-layer where push does its own stack adjust */ + DEBUG_i( PerlIO_debug("PerlIO_push f=%p %s %s %p\n", (void*)f, tab->name, (mode) ? mode : "(Null)", (void*)arg) ); - if (tab->Pushed && - (*tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { - return NULL; - } + if (tab->Pushed && + (*tab->Pushed) (aTHX_ f, mode, arg, (PerlIO_funcs*) tab) != 0) { + return NULL; + } } return f; } PerlIO * PerlIOBase_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, - IV n, const char *mode, int fd, int imode, int perm, - PerlIO *old, int narg, SV **args) + IV n, const char *mode, int fd, int imode, int perm, + PerlIO *old, int narg, SV **args) { PerlIO_funcs * const tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_layer(aTHX_ 0)); if (tab && tab->Open) { - PerlIO* ret = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, old, narg, args); - if (ret && PerlIO_push(aTHX_ ret, self, mode, PerlIOArg) == NULL) { - PerlIO_close(ret); - return NULL; - } - return ret; + PerlIO* ret = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, old, narg, args); + if (ret && PerlIO_push(aTHX_ ret, self, mode, PerlIOArg) == NULL) { + PerlIO_close(ret); + return NULL; + } + return ret; } SETERRNO(EINVAL, LIB_INVARG); return NULL; @@ -1202,16 +1202,16 @@ IV PerlIOBase_binmode(pTHX_ PerlIO *f) { if (PerlIOValid(f)) { - /* Is layer suitable for raw stream ? */ - if (PerlIOBase(f)->tab && PerlIOBase(f)->tab->kind & PERLIO_K_RAW) { - /* Yes - turn off UTF-8-ness, to undo UTF-8 locale effects */ - PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; - } - else { - /* Not suitable - pop it */ - PerlIO_pop(aTHX_ f); - } - return 0; + /* Is layer suitable for raw stream ? */ + if (PerlIOBase(f)->tab && PerlIOBase(f)->tab->kind & PERLIO_K_RAW) { + /* Yes - turn off UTF-8-ness, to undo UTF-8 locale effects */ + PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; + } + else { + /* Not suitable - pop it */ + PerlIO_pop(aTHX_ f); + } + return 0; } return -1; } @@ -1224,54 +1224,54 @@ PerlIORaw_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PERL_UNUSED_ARG(tab); if (PerlIOValid(f)) { - PerlIO *t; - const PerlIOl *l; - PerlIO_flush(f); - /* - * Strip all layers that are not suitable for a raw stream - */ - t = f; - while (t && (l = *t)) { - if (l->tab && l->tab->Binmode) { - /* Has a handler - normal case */ - if ((*l->tab->Binmode)(aTHX_ t) == 0) { - if (*t == l) { - /* Layer still there - move down a layer */ - t = PerlIONext(t); - } - } - else { - return -1; - } - } - else { - /* No handler - pop it */ - PerlIO_pop(aTHX_ t); - } - } - if (PerlIOValid(f)) { - DEBUG_i( PerlIO_debug(":raw f=%p :%s\n", (void*)f, + PerlIO *t; + const PerlIOl *l; + PerlIO_flush(f); + /* + * Strip all layers that are not suitable for a raw stream + */ + t = f; + while (t && (l = *t)) { + if (l->tab && l->tab->Binmode) { + /* Has a handler - normal case */ + if ((*l->tab->Binmode)(aTHX_ t) == 0) { + if (*t == l) { + /* Layer still there - move down a layer */ + t = PerlIONext(t); + } + } + else { + return -1; + } + } + else { + /* No handler - pop it */ + PerlIO_pop(aTHX_ t); + } + } + if (PerlIOValid(f)) { + DEBUG_i( PerlIO_debug(":raw f=%p :%s\n", (void*)f, PerlIOBase(f)->tab ? PerlIOBase(f)->tab->name : "(Null)") ); - return 0; - } + return 0; + } } return -1; } int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, - PerlIO_list_t *layers, IV n, IV max) + PerlIO_list_t *layers, IV n, IV max) { int code = 0; while (n < max) { - PerlIO_funcs * const tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL); - if (tab) { - if (!PerlIO_push(aTHX_ f, tab, mode, PerlIOArg)) { - code = -1; - break; - } - } - n++; + PerlIO_funcs * const tab = PerlIO_layer_fetch(aTHX_ layers, n, NULL); + if (tab) { + if (!PerlIO_push(aTHX_ f, tab, mode, PerlIOArg)) { + code = -1; + break; + } + } + n++; } return code; } @@ -1283,12 +1283,12 @@ PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, const char *names) ENTER; save_scalar(PL_errgv); if (f && names) { - PerlIO_list_t * const layers = PerlIO_list_alloc(aTHX); - code = PerlIO_parse_layers(aTHX_ layers, names); - if (code == 0) { - code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0, layers->cur); - } - PerlIO_list_free(aTHX_ layers); + PerlIO_list_t * const layers = PerlIO_list_alloc(aTHX); + code = PerlIO_parse_layers(aTHX_ layers, names); + if (code == 0) { + code = PerlIO_apply_layera(aTHX_ f, mode, layers, 0, layers->cur); + } + PerlIO_list_free(aTHX_ layers); } LEAVE; return code; @@ -1313,53 +1313,53 @@ PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int mode, const char *names) iotype, mode, (names) ? names : "(Null)") ); if (names) { - /* Do not flush etc. if (e.g.) switching encodings. - if a pushed layer knows it needs to flush lower layers - (for example :unix which is never going to call them) - it can do the flush when it is pushed. - */ - return cBOOL(PerlIO_apply_layers(aTHX_ f, NULL, names) == 0); + /* Do not flush etc. if (e.g.) switching encodings. + if a pushed layer knows it needs to flush lower layers + (for example :unix which is never going to call them) + it can do the flush when it is pushed. + */ + return cBOOL(PerlIO_apply_layers(aTHX_ f, NULL, names) == 0); } else { - /* Fake 5.6 legacy of using this call to turn ON O_TEXT */ + /* Fake 5.6 legacy of using this call to turn ON O_TEXT */ #ifdef PERLIO_USING_CRLF - /* Legacy binmode only has meaning if O_TEXT has a value distinct from - O_BINARY so we can look for it in mode. - */ - if (!(mode & O_BINARY)) { - /* Text mode */ - /* FIXME?: Looking down the layer stack seems wrong, - but is a way of reaching past (say) an encoding layer - to flip CRLF-ness of the layer(s) below - */ - while (*f) { - /* Perhaps we should turn on bottom-most aware layer - e.g. Ilya's idea that UNIX TTY could serve - */ - if (PerlIOBase(f)->tab && - PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) - { - if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) { - /* Not in text mode - flush any pending stuff and flip it */ - PerlIO_flush(f); - PerlIOBase(f)->flags |= PERLIO_F_CRLF; - } - /* Only need to turn it on in one layer so we are done */ - return TRUE; - } - f = PerlIONext(f); - } - /* Not finding a CRLF aware layer presumably means we are binary - which is not what was requested - so we failed - We _could_ push :crlf layer but so could caller - */ - return FALSE; - } + /* Legacy binmode only has meaning if O_TEXT has a value distinct from + O_BINARY so we can look for it in mode. + */ + if (!(mode & O_BINARY)) { + /* Text mode */ + /* FIXME?: Looking down the layer stack seems wrong, + but is a way of reaching past (say) an encoding layer + to flip CRLF-ness of the layer(s) below + */ + while (*f) { + /* Perhaps we should turn on bottom-most aware layer + e.g. Ilya's idea that UNIX TTY could serve + */ + if (PerlIOBase(f)->tab && + PerlIOBase(f)->tab->kind & PERLIO_K_CANCRLF) + { + if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) { + /* Not in text mode - flush any pending stuff and flip it */ + PerlIO_flush(f); + PerlIOBase(f)->flags |= PERLIO_F_CRLF; + } + /* Only need to turn it on in one layer so we are done */ + return TRUE; + } + f = PerlIONext(f); + } + /* Not finding a CRLF aware layer presumably means we are binary + which is not what was requested - so we failed + We _could_ push :crlf layer but so could caller + */ + return FALSE; + } #endif - /* Legacy binmode is now _defined_ as being equivalent to pushing :raw - So code that used to be here is now in PerlIORaw_pushed(). - */ - return cBOOL(PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL)); + /* Legacy binmode is now _defined_ as being equivalent to pushing :raw + So code that used to be here is now in PerlIORaw_pushed(). + */ + return cBOOL(PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_raw), NULL, NULL)); } } @@ -1367,15 +1367,15 @@ int PerlIO__close(pTHX_ PerlIO *f) { if (PerlIOValid(f)) { - PerlIO_funcs * const tab = PerlIOBase(f)->tab; - if (tab && tab->Close) - return (*tab->Close)(aTHX_ f); - else - return PerlIOBase_close(aTHX_ f); + PerlIO_funcs * const tab = PerlIOBase(f)->tab; + if (tab && tab->Close) + return (*tab->Close)(aTHX_ f); + else + return PerlIOBase_close(aTHX_ f); } else { - SETERRNO(EBADF, SS_IVCHAN); - return -1; + SETERRNO(EBADF, SS_IVCHAN); + return -1; } } @@ -1384,10 +1384,10 @@ Perl_PerlIO_close(pTHX_ PerlIO *f) { const int code = PerlIO__close(aTHX_ f); while (PerlIOValid(f)) { - PerlIO_pop(aTHX_ f); - if (PerlIO_lockcnt(f)) - /* we're in use; the 'pop' deferred freeing the structure */ - f = PerlIONext(f); + PerlIO_pop(aTHX_ f); + if (PerlIO_lockcnt(f)) + /* we're in use; the 'pop' deferred freeing the structure */ + f = PerlIONext(f); } return code; } @@ -1406,13 +1406,13 @@ PerlIO_layer_from_ref(pTHX_ SV *sv) * For any scalar type load the handler which is bundled with perl */ if (SvTYPE(sv) < SVt_PVAV && (!isGV_with_GP(sv) || SvFAKE(sv))) { - PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1); - /* This isn't supposed to happen, since PerlIO::scalar is core, - * but could happen anyway in smaller installs or with PAR */ - if (!f) - /* diag_listed_as: Unknown PerlIO layer "%s" */ - Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\""); - return f; + PerlIO_funcs *f = PerlIO_find_layer(aTHX_ STR_WITH_LEN("scalar"), 1); + /* This isn't supposed to happen, since PerlIO::scalar is core, + * but could happen anyway in smaller installs or with PAR */ + if (!f) + /* diag_listed_as: Unknown PerlIO layer "%s" */ + Perl_ck_warner(aTHX_ packWARN(WARN_LAYER), "Unknown PerlIO layer \"scalar\""); + return f; } /* @@ -1420,156 +1420,156 @@ PerlIO_layer_from_ref(pTHX_ SV *sv) */ switch (SvTYPE(sv)) { case SVt_PVAV: - return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Array"), 0); case SVt_PVHV: - return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Hash"), 0); case SVt_PVCV: - return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Code"), 0); case SVt_PVGV: - return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0); + return PerlIO_find_layer(aTHX_ STR_WITH_LEN("Glob"), 0); default: - return NULL; + return NULL; } } PerlIO_list_t * PerlIO_resolve_layers(pTHX_ const char *layers, - const char *mode, int narg, SV **args) + const char *mode, int narg, SV **args) { PerlIO_list_t *def = PerlIO_default_layers(aTHX); int incdef = 1; if (!PL_perlio) - PerlIO_stdstreams(aTHX); + PerlIO_stdstreams(aTHX); if (narg) { - SV * const arg = *args; - /* - * If it is a reference but not an object see if we have a handler - * for it - */ - if (SvROK(arg) && !SvOBJECT(SvRV(arg))) { - PerlIO_funcs * const handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg)); - if (handler) { - def = PerlIO_list_alloc(aTHX); - PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef); - incdef = 0; - } - /* - * Don't fail if handler cannot be found :via(...) etc. may do - * something sensible else we will just stringfy and open - * resulting string. - */ - } + SV * const arg = *args; + /* + * If it is a reference but not an object see if we have a handler + * for it + */ + if (SvROK(arg) && !SvOBJECT(SvRV(arg))) { + PerlIO_funcs * const handler = PerlIO_layer_from_ref(aTHX_ SvRV(arg)); + if (handler) { + def = PerlIO_list_alloc(aTHX); + PerlIO_list_push(aTHX_ def, handler, &PL_sv_undef); + incdef = 0; + } + /* + * Don't fail if handler cannot be found :via(...) etc. may do + * something sensible else we will just stringfy and open + * resulting string. + */ + } } if (!layers || !*layers) - layers = Perl_PerlIO_context_layers(aTHX_ mode); + layers = Perl_PerlIO_context_layers(aTHX_ mode); if (layers && *layers) { - PerlIO_list_t *av; - if (incdef) { - av = PerlIO_clone_list(aTHX_ def, NULL); - } - else { - av = def; - } - if (PerlIO_parse_layers(aTHX_ av, layers) == 0) { - return av; - } - else { - PerlIO_list_free(aTHX_ av); - return NULL; - } + PerlIO_list_t *av; + if (incdef) { + av = PerlIO_clone_list(aTHX_ def, NULL); + } + else { + av = def; + } + if (PerlIO_parse_layers(aTHX_ av, layers) == 0) { + return av; + } + else { + PerlIO_list_free(aTHX_ av); + return NULL; + } } else { - if (incdef) - def->refcnt++; - return def; + if (incdef) + def->refcnt++; + return def; } } PerlIO * PerlIO_openn(pTHX_ const char *layers, const char *mode, int fd, - int imode, int perm, PerlIO *f, int narg, SV **args) + int imode, int perm, PerlIO *f, int narg, SV **args) { if (!f && narg == 1 && *args == &PL_sv_undef) { imode = PerlIOUnix_oflags(mode); - if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) { - if (!layers || !*layers) - layers = Perl_PerlIO_context_layers(aTHX_ mode); - if (layers && *layers) - PerlIO_apply_layers(aTHX_ f, mode, layers); - } + if (imode != -1 && (f = PerlIO_tmpfile_flags(imode))) { + if (!layers || !*layers) + layers = Perl_PerlIO_context_layers(aTHX_ mode); + if (layers && *layers) + PerlIO_apply_layers(aTHX_ f, mode, layers); + } } else { - PerlIO_list_t *layera; - IV n; - PerlIO_funcs *tab = NULL; - if (PerlIOValid(f)) { - /* - * This is "reopen" - it is not tested as perl does not use it - * yet - */ - PerlIOl *l = *f; - layera = PerlIO_list_alloc(aTHX); - while (l) { - SV *arg = NULL; - if (l->tab && l->tab->Getarg) - arg = (*l->tab->Getarg) (aTHX_ &l, NULL, 0); - PerlIO_list_push(aTHX_ layera, l->tab, - (arg) ? arg : &PL_sv_undef); - SvREFCNT_dec(arg); - l = *PerlIONext(&l); - } - } - else { - layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args); - if (!layera) { - return NULL; - } - } - /* - * Start at "top" of layer stack - */ - n = layera->cur - 1; - while (n >= 0) { - PerlIO_funcs * const t = PerlIO_layer_fetch(aTHX_ layera, n, NULL); - if (t && t->Open) { - tab = t; - break; - } - n--; - } - if (tab) { - /* - * Found that layer 'n' can do opens - call it - */ - if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) { - Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name); - } - DEBUG_i( PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", + PerlIO_list_t *layera; + IV n; + PerlIO_funcs *tab = NULL; + if (PerlIOValid(f)) { + /* + * This is "reopen" - it is not tested as perl does not use it + * yet + */ + PerlIOl *l = *f; + layera = PerlIO_list_alloc(aTHX); + while (l) { + SV *arg = NULL; + if (l->tab && l->tab->Getarg) + arg = (*l->tab->Getarg) (aTHX_ &l, NULL, 0); + PerlIO_list_push(aTHX_ layera, l->tab, + (arg) ? arg : &PL_sv_undef); + SvREFCNT_dec(arg); + l = *PerlIONext(&l); + } + } + else { + layera = PerlIO_resolve_layers(aTHX_ layers, mode, narg, args); + if (!layera) { + return NULL; + } + } + /* + * Start at "top" of layer stack + */ + n = layera->cur - 1; + while (n >= 0) { + PerlIO_funcs * const t = PerlIO_layer_fetch(aTHX_ layera, n, NULL); + if (t && t->Open) { + tab = t; + break; + } + n--; + } + if (tab) { + /* + * Found that layer 'n' can do opens - call it + */ + if (narg > 1 && !(tab->kind & PERLIO_K_MULTIARG)) { + Perl_croak(aTHX_ "More than one argument to open(,':%s')",tab->name); + } + DEBUG_i( PerlIO_debug("openn(%s,'%s','%s',%d,%x,%o,%p,%d,%p)\n", tab->name, layers ? layers : "(Null)", mode, fd, imode, perm, (void*)f, narg, (void*)args) ); - if (tab->Open) - f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm, - f, narg, args); - else { - SETERRNO(EINVAL, LIB_INVARG); - f = NULL; - } - if (f) { - if (n + 1 < layera->cur) { - /* - * More layers above the one that we used to open - - * apply them now - */ - if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1, layera->cur) != 0) { - /* If pushing layers fails close the file */ - PerlIO_close(f); - f = NULL; - } - } - } - } - PerlIO_list_free(aTHX_ layera); + if (tab->Open) + f = (*tab->Open) (aTHX_ tab, layera, n, mode, fd, imode, perm, + f, narg, args); + else { + SETERRNO(EINVAL, LIB_INVARG); + f = NULL; + } + if (f) { + if (n + 1 < layera->cur) { + /* + * More layers above the one that we used to open - + * apply them now + */ + if (PerlIO_apply_layera(aTHX_ f, mode, layera, n + 1, layera->cur) != 0) { + /* If pushing layers fails close the file */ + PerlIO_close(f); + f = NULL; + } + } + } + } + PerlIO_list_free(aTHX_ layera); } return f; } @@ -1615,41 +1615,41 @@ int Perl_PerlIO_flush(pTHX_ PerlIO *f) { if (f) { - if (*f) { - const PerlIO_funcs *tab = PerlIOBase(f)->tab; - - if (tab && tab->Flush) - return (*tab->Flush) (aTHX_ f); - else - return 0; /* If no Flush defined, silently succeed. */ - } - else { - DEBUG_i( PerlIO_debug("Cannot flush f=%p\n", (void*)f) ); - SETERRNO(EBADF, SS_IVCHAN); - return -1; - } + if (*f) { + const PerlIO_funcs *tab = PerlIOBase(f)->tab; + + if (tab && tab->Flush) + return (*tab->Flush) (aTHX_ f); + else + return 0; /* If no Flush defined, silently succeed. */ + } + else { + DEBUG_i( PerlIO_debug("Cannot flush f=%p\n", (void*)f) ); + SETERRNO(EBADF, SS_IVCHAN); + return -1; + } } else { - /* - * Is it good API design to do flush-all on NULL, a potentially - * erroneous input? Maybe some magical value (PerlIO* - * PERLIO_FLUSH_ALL = (PerlIO*)-1;)? Yes, stdio does similar - * things on fflush(NULL), but should we be bound by their design - * decisions? --jhi - */ - PerlIOl **table = &PL_perlio; - PerlIOl *ff; - int code = 0; - while ((ff = *table)) { - int i; - table = (PerlIOl **) (ff++); - for (i = 1; i < PERLIO_TABLE_SIZE; i++) { - if (ff->next && PerlIO_flush(&(ff->next)) != 0) - code = -1; - ff++; - } - } - return code; + /* + * Is it good API design to do flush-all on NULL, a potentially + * erroneous input? Maybe some magical value (PerlIO* + * PERLIO_FLUSH_ALL = (PerlIO*)-1;)? Yes, stdio does similar + * things on fflush(NULL), but should we be bound by their design + * decisions? --jhi + */ + PerlIOl **table = &PL_perlio; + PerlIOl *ff; + int code = 0; + while ((ff = *table)) { + int i; + table = (PerlIOl **) (ff++); + for (i = 1; i < PERLIO_TABLE_SIZE; i++) { + if (ff->next && PerlIO_flush(&(ff->next)) != 0) + code = -1; + ff++; + } + } + return code; } } @@ -1659,16 +1659,16 @@ PerlIOBase_flush_linebuf(pTHX) PerlIOl **table = &PL_perlio; PerlIOl *f; while ((f = *table)) { - int i; - table = (PerlIOl **) (f++); - for (i = 1; i < PERLIO_TABLE_SIZE; i++) { - if (f->next - && (PerlIOBase(&(f->next))-> - flags & (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE)) - == (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE)) - PerlIO_flush(&(f->next)); - f++; - } + int i; + table = (PerlIOl **) (f++); + for (i = 1; i < PERLIO_TABLE_SIZE; i++) { + if (f->next + && (PerlIOBase(&(f->next))-> + flags & (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE)) + == (PERLIO_F_LINEBUF | PERLIO_F_CANWRITE)) + PerlIO_flush(&(f->next)); + f++; + } } } @@ -1682,9 +1682,9 @@ int PerlIO_isutf8(PerlIO *f) { if (PerlIOValid(f)) - return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0; + return (PerlIOBase(f)->flags & PERLIO_F_UTF8) != 0; else - SETERRNO(EBADF, SS_IVCHAN); + SETERRNO(EBADF, SS_IVCHAN); return -1; } @@ -1717,10 +1717,10 @@ int PerlIO_has_base(PerlIO *f) { if (PerlIOValid(f)) { - const PerlIO_funcs * const tab = PerlIOBase(f)->tab; + const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - if (tab) - return (tab->Get_base != NULL); + if (tab) + return (tab->Get_base != NULL); } return 0; @@ -1730,12 +1730,12 @@ int PerlIO_fast_gets(PerlIO *f) { if (PerlIOValid(f)) { - if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) { - const PerlIO_funcs * const tab = PerlIOBase(f)->tab; + if (PerlIOBase(f)->flags & PERLIO_F_FASTGETS) { + const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - if (tab) - return (tab->Set_ptrcnt != NULL); - } + if (tab) + return (tab->Set_ptrcnt != NULL); + } } return 0; @@ -1745,10 +1745,10 @@ int PerlIO_has_cntptr(PerlIO *f) { if (PerlIOValid(f)) { - const PerlIO_funcs * const tab = PerlIOBase(f)->tab; + const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - if (tab) - return (tab->Get_ptr != NULL && tab->Get_cnt != NULL); + if (tab) + return (tab->Get_ptr != NULL && tab->Get_cnt != NULL); } return 0; @@ -1758,10 +1758,10 @@ int PerlIO_canset_cnt(PerlIO *f) { if (PerlIOValid(f)) { - const PerlIO_funcs * const tab = PerlIOBase(f)->tab; + const PerlIO_funcs * const tab = PerlIOBase(f)->tab; - if (tab) - return (tab->Set_ptrcnt != NULL); + if (tab) + return (tab->Set_ptrcnt != NULL); } return 0; @@ -1817,11 +1817,11 @@ PerlIOUtf8_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PERL_UNUSED_ARG(mode); PERL_UNUSED_ARG(arg); if (PerlIOValid(f)) { - if (tab && tab->kind & PERLIO_K_UTF8) - PerlIOBase(f)->flags |= PERLIO_F_UTF8; - else - PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; - return 0; + if (tab && tab->kind & PERLIO_K_UTF8) + PerlIOBase(f)->flags |= PERLIO_F_UTF8; + else + PerlIOBase(f)->flags &= ~PERLIO_F_UTF8; + return 0; } return -1; } @@ -1935,27 +1935,27 @@ PerlIO_modestr(PerlIO * f, char *buf) { char *s = buf; if (PerlIOValid(f)) { - const IV flags = PerlIOBase(f)->flags; - if (flags & PERLIO_F_APPEND) { - *s++ = 'a'; - if (flags & PERLIO_F_CANREAD) { - *s++ = '+'; - } - } - else if (flags & PERLIO_F_CANREAD) { - *s++ = 'r'; - if (flags & PERLIO_F_CANWRITE) - *s++ = '+'; - } - else if (flags & PERLIO_F_CANWRITE) { - *s++ = 'w'; - if (flags & PERLIO_F_CANREAD) { - *s++ = '+'; - } - } + const IV flags = PerlIOBase(f)->flags; + if (flags & PERLIO_F_APPEND) { + *s++ = 'a'; + if (flags & PERLIO_F_CANREAD) { + *s++ = '+'; + } + } + else if (flags & PERLIO_F_CANREAD) { + *s++ = 'r'; + if (flags & PERLIO_F_CANWRITE) + *s++ = '+'; + } + else if (flags & PERLIO_F_CANWRITE) { + *s++ = 'w'; + if (flags & PERLIO_F_CANREAD) { + *s++ = '+'; + } + } #ifdef PERLIO_USING_CRLF - if (!(flags & PERLIO_F_CRLF)) - *s++ = 'b'; + if (!(flags & PERLIO_F_CRLF)) + *s++ = 'b'; #endif } *s = '\0'; @@ -1971,87 +1971,87 @@ PerlIOBase_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PERL_UNUSED_ARG(arg); l->flags &= ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | - PERLIO_F_TRUNCATE | PERLIO_F_APPEND); + PERLIO_F_TRUNCATE | PERLIO_F_APPEND); if (tab && tab->Set_ptrcnt != NULL) - l->flags |= PERLIO_F_FASTGETS; + l->flags |= PERLIO_F_FASTGETS; if (mode) { - if (*mode == IoTYPE_NUMERIC || *mode == IoTYPE_IMPLICIT) - mode++; - switch (*mode++) { - case 'r': - l->flags |= PERLIO_F_CANREAD; - break; - case 'a': - l->flags |= PERLIO_F_APPEND | PERLIO_F_CANWRITE; - break; - case 'w': - l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE; - break; - default: - SETERRNO(EINVAL, LIB_INVARG); - return -1; - } + if (*mode == IoTYPE_NUMERIC || *mode == IoTYPE_IMPLICIT) + mode++; + switch (*mode++) { + case 'r': + l->flags |= PERLIO_F_CANREAD; + break; + case 'a': + l->flags |= PERLIO_F_APPEND | PERLIO_F_CANWRITE; + break; + case 'w': + l->flags |= PERLIO_F_TRUNCATE | PERLIO_F_CANWRITE; + break; + default: + SETERRNO(EINVAL, LIB_INVARG); + return -1; + } #ifdef EBCDIC - { + { /* The mode variable contains one positional parameter followed by * optional keyword parameters. The positional parameters must be * passed as lowercase characters. The keyword parameters can be * passed in mixed case. They must be separated by commas. Only one * instance of a keyword can be specified. */ - int comma = 0; - while (*mode) { - switch (*mode++) { - case '+': - if(!comma) - l->flags |= PERLIO_F_CANREAD | PERLIO_F_CANWRITE; - break; - case 'b': - if(!comma) - l->flags &= ~PERLIO_F_CRLF; - break; - case 't': - if(!comma) - l->flags |= PERLIO_F_CRLF; - break; - case ',': - comma = 1; - break; - default: - break; - } - } - } + int comma = 0; + while (*mode) { + switch (*mode++) { + case '+': + if(!comma) + l->flags |= PERLIO_F_CANREAD | PERLIO_F_CANWRITE; + break; + case 'b': + if(!comma) + l->flags &= ~PERLIO_F_CRLF; + break; + case 't': + if(!comma) + l->flags |= PERLIO_F_CRLF; + break; + case ',': + comma = 1; + break; + default: + break; + } + } + } #else - while (*mode) { - switch (*mode++) { - case '+': - l->flags |= PERLIO_F_CANREAD | PERLIO_F_CANWRITE; - break; - case 'b': - l->flags &= ~PERLIO_F_CRLF; - break; - case 't': - l->flags |= PERLIO_F_CRLF; - break; - default: - SETERRNO(EINVAL, LIB_INVARG); - return -1; - } - } + while (*mode) { + switch (*mode++) { + case '+': + l->flags |= PERLIO_F_CANREAD | PERLIO_F_CANWRITE; + break; + case 'b': + l->flags &= ~PERLIO_F_CRLF; + break; + case 't': + l->flags |= PERLIO_F_CRLF; + break; + default: + SETERRNO(EINVAL, LIB_INVARG); + return -1; + } + } #endif } else { - if (l->next) { - l->flags |= l->next->flags & - (PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_TRUNCATE | - PERLIO_F_APPEND); - } + if (l->next) { + l->flags |= l->next->flags & + (PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_TRUNCATE | + PERLIO_F_APPEND); + } } #if 0 DEBUG_i( PerlIO_debug("PerlIOBase_pushed f=%p %s %s fl=%08" UVxf " (%s)\n", - (void*)f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)", - l->flags, PerlIO_modestr(f, temp)); + (void*)f, PerlIOBase(f)->tab->name, (omode) ? omode : "(Null)", + l->flags, PerlIO_modestr(f, temp)); ); #endif return 0; @@ -2083,34 +2083,34 @@ PerlIOBase_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) STDCHAR *buf = (STDCHAR *) vbuf; if (f) { if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD)) { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - SETERRNO(EBADF, SS_IVCHAN); - PerlIO_save_errno(f); - return 0; - } - while (count > 0) { - get_cnt: - { - SSize_t avail = PerlIO_get_cnt(f); - SSize_t take = 0; - if (avail > 0) - take = (((SSize_t) count >= 0) && ((SSize_t)count < avail)) ? (SSize_t)count : avail; - if (take > 0) { - STDCHAR *ptr = PerlIO_get_ptr(f); - Copy(ptr, buf, take, STDCHAR); - PerlIO_set_ptrcnt(f, ptr + take, (avail -= take)); - count -= take; - buf += take; - if (avail == 0) /* set_ptrcnt could have reset avail */ - goto get_cnt; - } - if (count > 0 && avail <= 0) { - if (PerlIO_fill(f) != 0) - break; - } - } - } - return (buf - (STDCHAR *) vbuf); + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + SETERRNO(EBADF, SS_IVCHAN); + PerlIO_save_errno(f); + return 0; + } + while (count > 0) { + get_cnt: + { + SSize_t avail = PerlIO_get_cnt(f); + SSize_t take = 0; + if (avail > 0) + take = (((SSize_t) count >= 0) && ((SSize_t)count < avail)) ? (SSize_t)count : avail; + if (take > 0) { + STDCHAR *ptr = PerlIO_get_ptr(f); + Copy(ptr, buf, take, STDCHAR); + PerlIO_set_ptrcnt(f, ptr + take, (avail -= take)); + count -= take; + buf += take; + if (avail == 0) /* set_ptrcnt could have reset avail */ + goto get_cnt; + } + if (count > 0 && avail <= 0) { + if (PerlIO_fill(f) != 0) + break; + } + } + } + return (buf - (STDCHAR *) vbuf); } return 0; } @@ -2136,26 +2136,26 @@ PerlIOBase_close(pTHX_ PerlIO *f) { IV code = -1; if (PerlIOValid(f)) { - PerlIO *n = PerlIONext(f); - code = PerlIO_flush(f); - PerlIOBase(f)->flags &= - ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN); - while (PerlIOValid(n)) { - const PerlIO_funcs * const tab = PerlIOBase(n)->tab; - if (tab && tab->Close) { - if ((*tab->Close)(aTHX_ n) != 0) - code = -1; - break; - } - else { - PerlIOBase(n)->flags &= - ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN); - } - n = PerlIONext(n); - } + PerlIO *n = PerlIONext(f); + code = PerlIO_flush(f); + PerlIOBase(f)->flags &= + ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN); + while (PerlIOValid(n)) { + const PerlIO_funcs * const tab = PerlIOBase(n)->tab; + if (tab && tab->Close) { + if ((*tab->Close)(aTHX_ n) != 0) + code = -1; + break; + } + else { + PerlIOBase(n)->flags &= + ~(PERLIO_F_CANREAD | PERLIO_F_CANWRITE | PERLIO_F_OPEN); + } + n = PerlIONext(n); + } } else { - SETERRNO(EBADF, SS_IVCHAN); + SETERRNO(EBADF, SS_IVCHAN); } return code; } @@ -2165,7 +2165,7 @@ PerlIOBase_eof(pTHX_ PerlIO *f) { PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { - return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0; + return (PerlIOBase(f)->flags & PERLIO_F_EOF) != 0; } return 1; } @@ -2175,7 +2175,7 @@ PerlIOBase_error(pTHX_ PerlIO *f) { PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { - return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0; + return (PerlIOBase(f)->flags & PERLIO_F_ERROR) != 0; } return 1; } @@ -2184,10 +2184,10 @@ void PerlIOBase_clearerr(pTHX_ PerlIO *f) { if (PerlIOValid(f)) { - PerlIO * const n = PerlIONext(f); - PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF); - if (PerlIOValid(n)) - PerlIO_clearerr(n); + PerlIO * const n = PerlIONext(f); + PerlIOBase(f)->flags &= ~(PERLIO_F_ERROR | PERLIO_F_EOF); + if (PerlIOValid(n)) + PerlIO_clearerr(n); } } @@ -2196,7 +2196,7 @@ PerlIOBase_setlinebuf(pTHX_ PerlIO *f) { PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { - PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; + PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; } } @@ -2204,15 +2204,15 @@ SV * PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param) { if (!arg) - return NULL; + return NULL; #ifdef USE_ITHREADS if (param) { - arg = sv_dup(arg, param); - SvREFCNT_inc_simple_void_NN(arg); - return arg; + arg = sv_dup(arg, param); + SvREFCNT_inc_simple_void_NN(arg); + return arg; } else { - return newSVsv(arg); + return newSVsv(arg); } #else PERL_UNUSED_ARG(param); @@ -2225,26 +2225,26 @@ PerlIOBase_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) { PerlIO * const nexto = PerlIONext(o); if (PerlIOValid(nexto)) { - const PerlIO_funcs * const tab = PerlIOBase(nexto)->tab; - if (tab && tab->Dup) - f = (*tab->Dup)(aTHX_ f, nexto, param, flags); - else - f = PerlIOBase_dup(aTHX_ f, nexto, param, flags); + const PerlIO_funcs * const tab = PerlIOBase(nexto)->tab; + if (tab && tab->Dup) + f = (*tab->Dup)(aTHX_ f, nexto, param, flags); + else + f = PerlIOBase_dup(aTHX_ f, nexto, param, flags); } if (f) { - PerlIO_funcs * const self = PerlIOBase(o)->tab; - SV *arg = NULL; - char buf[8]; - assert(self); - DEBUG_i(PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n", + PerlIO_funcs * const self = PerlIOBase(o)->tab; + SV *arg = NULL; + char buf[8]; + assert(self); + DEBUG_i(PerlIO_debug("PerlIOBase_dup %s f=%p o=%p param=%p\n", self->name, (void*)f, (void*)o, (void*)param) ); - if (self->Getarg) - arg = (*self->Getarg)(aTHX_ o, param, flags); - f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); - if (f && PerlIOBase(o)->flags & PERLIO_F_UTF8) - PerlIOBase(f)->flags |= PERLIO_F_UTF8; - SvREFCNT_dec(arg); + if (self->Getarg) + arg = (*self->Getarg)(aTHX_ o, param, flags); + f = PerlIO_push(aTHX_ f, self, PerlIO_modestr(o,buf), arg); + if (f && PerlIOBase(o)->flags & PERLIO_F_UTF8) + PerlIOBase(f)->flags |= PERLIO_F_UTF8; + SvREFCNT_dec(arg); } return f; } @@ -2268,7 +2268,7 @@ S_more_refcounted_fds(pTHX_ const int new_fd) old_max, new_fd, new_max) ); if (new_fd < old_max) { - return; + return; } assert (new_max > new_fd); @@ -2278,8 +2278,8 @@ S_more_refcounted_fds(pTHX_ const int new_fd) new_array = (int*) realloc(PL_perlio_fd_refcnt, new_max * sizeof(int)); if (!new_array) { - MUTEX_UNLOCK(&PL_perlio_mutex); - croak_no_mem(); + MUTEX_UNLOCK(&PL_perlio_mutex); + croak_no_mem(); } PL_perlio_fd_refcnt_size = new_max; @@ -2306,23 +2306,23 @@ PerlIOUnix_refcnt_inc(int fd) dTHX; if (fd >= 0) { - MUTEX_LOCK(&PL_perlio_mutex); - if (fd >= PL_perlio_fd_refcnt_size) - S_more_refcounted_fds(aTHX_ fd); - - PL_perlio_fd_refcnt[fd]++; - if (PL_perlio_fd_refcnt[fd] <= 0) { - /* diag_listed_as: refcnt_inc: fd %d%s */ - Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n", - fd, PL_perlio_fd_refcnt[fd]); - } - DEBUG_i( PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n", + MUTEX_LOCK(&PL_perlio_mutex); + if (fd >= PL_perlio_fd_refcnt_size) + S_more_refcounted_fds(aTHX_ fd); + + PL_perlio_fd_refcnt[fd]++; + if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt_inc: fd %d%s */ + Perl_croak(aTHX_ "refcnt_inc: fd %d: %d <= 0\n", + fd, PL_perlio_fd_refcnt[fd]); + } + DEBUG_i( PerlIO_debug("refcnt_inc: fd %d refcnt=%d\n", fd, PL_perlio_fd_refcnt[fd]) ); - MUTEX_UNLOCK(&PL_perlio_mutex); + MUTEX_UNLOCK(&PL_perlio_mutex); } else { - /* diag_listed_as: refcnt_inc: fd %d%s */ - Perl_croak(aTHX_ "refcnt_inc: fd %d < 0\n", fd); + /* diag_listed_as: refcnt_inc: fd %d%s */ + Perl_croak(aTHX_ "refcnt_inc: fd %d < 0\n", fd); } } @@ -2334,23 +2334,23 @@ PerlIOUnix_refcnt_dec(int fd) #ifdef DEBUGGING dTHX; #endif - MUTEX_LOCK(&PL_perlio_mutex); - if (fd >= PL_perlio_fd_refcnt_size) { - /* diag_listed_as: refcnt_dec: fd %d%s */ - Perl_croak_nocontext("refcnt_dec: fd %d >= refcnt_size %d\n", - fd, PL_perlio_fd_refcnt_size); - } - if (PL_perlio_fd_refcnt[fd] <= 0) { - /* diag_listed_as: refcnt_dec: fd %d%s */ - Perl_croak_nocontext("refcnt_dec: fd %d: %d <= 0\n", - fd, PL_perlio_fd_refcnt[fd]); - } - cnt = --PL_perlio_fd_refcnt[fd]; - DEBUG_i( PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt) ); - MUTEX_UNLOCK(&PL_perlio_mutex); + MUTEX_LOCK(&PL_perlio_mutex); + if (fd >= PL_perlio_fd_refcnt_size) { + /* diag_listed_as: refcnt_dec: fd %d%s */ + Perl_croak_nocontext("refcnt_dec: fd %d >= refcnt_size %d\n", + fd, PL_perlio_fd_refcnt_size); + } + if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt_dec: fd %d%s */ + Perl_croak_nocontext("refcnt_dec: fd %d: %d <= 0\n", + fd, PL_perlio_fd_refcnt[fd]); + } + cnt = --PL_perlio_fd_refcnt[fd]; + DEBUG_i( PerlIO_debug("refcnt_dec: fd %d refcnt=%d\n", fd, cnt) ); + MUTEX_UNLOCK(&PL_perlio_mutex); } else { - /* diag_listed_as: refcnt_dec: fd %d%s */ - Perl_croak_nocontext("refcnt_dec: fd %d < 0\n", fd); + /* diag_listed_as: refcnt_dec: fd %d%s */ + Perl_croak_nocontext("refcnt_dec: fd %d < 0\n", fd); } return cnt; } @@ -2361,22 +2361,22 @@ PerlIOUnix_refcnt(int fd) dTHX; int cnt = 0; if (fd >= 0) { - MUTEX_LOCK(&PL_perlio_mutex); - if (fd >= PL_perlio_fd_refcnt_size) { - /* diag_listed_as: refcnt: fd %d%s */ - Perl_croak(aTHX_ "refcnt: fd %d >= refcnt_size %d\n", - fd, PL_perlio_fd_refcnt_size); - } - if (PL_perlio_fd_refcnt[fd] <= 0) { - /* diag_listed_as: refcnt: fd %d%s */ - Perl_croak(aTHX_ "refcnt: fd %d: %d <= 0\n", - fd, PL_perlio_fd_refcnt[fd]); - } - cnt = PL_perlio_fd_refcnt[fd]; - MUTEX_UNLOCK(&PL_perlio_mutex); + MUTEX_LOCK(&PL_perlio_mutex); + if (fd >= PL_perlio_fd_refcnt_size) { + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d >= refcnt_size %d\n", + fd, PL_perlio_fd_refcnt_size); + } + if (PL_perlio_fd_refcnt[fd] <= 0) { + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d: %d <= 0\n", + fd, PL_perlio_fd_refcnt[fd]); + } + cnt = PL_perlio_fd_refcnt[fd]; + MUTEX_UNLOCK(&PL_perlio_mutex); } else { - /* diag_listed_as: refcnt: fd %d%s */ - Perl_croak(aTHX_ "refcnt: fd %d < 0\n", fd); + /* diag_listed_as: refcnt: fd %d%s */ + Perl_croak(aTHX_ "refcnt: fd %d < 0\n", fd); } return cnt; } @@ -2393,19 +2393,19 @@ PerlIO_cleanup(pTHX) /* Raise STDIN..STDERR refcount so we don't close them */ for (i=0; i < 3; i++) - PerlIOUnix_refcnt_inc(i); + PerlIOUnix_refcnt_inc(i); PerlIO_cleantable(aTHX_ &PL_perlio); /* Restore STDIN..STDERR refcount */ for (i=0; i < 3; i++) - PerlIOUnix_refcnt_dec(i); + PerlIOUnix_refcnt_dec(i); if (PL_known_layers) { - PerlIO_list_free(aTHX_ PL_known_layers); - PL_known_layers = NULL; + PerlIO_list_free(aTHX_ PL_known_layers); + PL_known_layers = NULL; } if (PL_def_layerlist) { - PerlIO_list_free(aTHX_ PL_def_layerlist); - PL_def_layerlist = NULL; + PerlIO_list_free(aTHX_ PL_def_layerlist); + PL_def_layerlist = NULL; } } @@ -2419,22 +2419,22 @@ void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */ */ # ifdef DEBUGGING { - /* By now all filehandles should have been closed, so any - * stray (non-STD-)filehandles indicate *possible* (PerlIO) - * errors. */ + /* By now all filehandles should have been closed, so any + * stray (non-STD-)filehandles indicate *possible* (PerlIO) + * errors. */ #define PERLIO_TEARDOWN_MESSAGE_BUF_SIZE 64 #define PERLIO_TEARDOWN_MESSAGE_FD 2 - char buf[PERLIO_TEARDOWN_MESSAGE_BUF_SIZE]; - int i; - for (i = 3; i < PL_perlio_fd_refcnt_size; i++) { - if (PL_perlio_fd_refcnt[i]) { - const STRLEN len = - my_snprintf(buf, sizeof(buf), - "PerlIO_teardown: fd %d refcnt=%d\n", - i, PL_perlio_fd_refcnt[i]); - PerlLIO_write(PERLIO_TEARDOWN_MESSAGE_FD, buf, len); - } - } + char buf[PERLIO_TEARDOWN_MESSAGE_BUF_SIZE]; + int i; + for (i = 3; i < PL_perlio_fd_refcnt_size; i++) { + if (PL_perlio_fd_refcnt[i]) { + const STRLEN len = + my_snprintf(buf, sizeof(buf), + "PerlIO_teardown: fd %d refcnt=%d\n", + i, PL_perlio_fd_refcnt[i]); + PerlLIO_write(PERLIO_TEARDOWN_MESSAGE_FD, buf, len); + } + } } # endif #endif @@ -2442,9 +2442,9 @@ void PerlIO_teardown(void) /* Call only from PERL_SYS_TERM(). */ * all the interpreters are gone. */ if (PL_perlio_fd_refcnt_size /* Assuming initial size of zero. */ && PL_perlio_fd_refcnt) { - free(PL_perlio_fd_refcnt); /* To match realloc() in S_more_refcounted_fds(). */ - PL_perlio_fd_refcnt = NULL; - PL_perlio_fd_refcnt_size = 0; + free(PL_perlio_fd_refcnt); /* To match realloc() in S_more_refcounted_fds(). */ + PL_perlio_fd_refcnt = NULL; + PL_perlio_fd_refcnt_size = 0; } } @@ -2479,19 +2479,19 @@ S_perlio_async_run(pTHX_ PerlIO* f) { PerlIO_lockcnt(f)++; PERL_ASYNC_CHECK(); if ( !(PerlIOBase(f)->flags & PERLIO_F_CLEARED) ) { - LEAVE; - return 0; + LEAVE; + return 0; } /* we've just run some perl-level code that could have done * anything, including closing the file or clearing this layer. * If so, free any lower layers that have already been * cleared, then return an error. */ while (PerlIOValid(f) && - (PerlIOBase(f)->flags & PERLIO_F_CLEARED)) + (PerlIOBase(f)->flags & PERLIO_F_CLEARED)) { - const PerlIOl *l = *f; - *f = l->next; - Safefree(l); + const PerlIOl *l = *f; + *f = l->next; + Safefree(l); } LEAVE; return 1; @@ -2502,35 +2502,35 @@ PerlIOUnix_oflags(const char *mode) { int oflags = -1; if (*mode == IoTYPE_IMPLICIT || *mode == IoTYPE_NUMERIC) - mode++; + mode++; switch (*mode) { case 'r': - oflags = O_RDONLY; - if (*++mode == '+') { - oflags = O_RDWR; - mode++; - } - break; + oflags = O_RDONLY; + if (*++mode == '+') { + oflags = O_RDWR; + mode++; + } + break; case 'w': - oflags = O_CREAT | O_TRUNC; - if (*++mode == '+') { - oflags |= O_RDWR; - mode++; - } - else - oflags |= O_WRONLY; - break; + oflags = O_CREAT | O_TRUNC; + if (*++mode == '+') { + oflags |= O_RDWR; + mode++; + } + else + oflags |= O_WRONLY; + break; case 'a': - oflags = O_CREAT | O_APPEND; - if (*++mode == '+') { - oflags |= O_RDWR; - mode++; - } - else - oflags |= O_WRONLY; - break; + oflags = O_CREAT | O_APPEND; + if (*++mode == '+') { + oflags |= O_RDWR; + mode++; + } + else + oflags |= O_WRONLY; + break; } /* XXX TODO: PerlIO_open() test that exercises 'rb' and 'rt'. */ @@ -2542,35 +2542,35 @@ PerlIOUnix_oflags(const char *mode) case 'b': #if O_TEXT != O_BINARY oflags |= O_BINARY; - oflags &= ~O_TEXT; + oflags &= ~O_TEXT; #endif mode++; break; case 't': #if O_TEXT != O_BINARY - oflags |= O_TEXT; - oflags &= ~O_BINARY; + oflags |= O_TEXT; + oflags &= ~O_BINARY; #endif mode++; break; default: #if O_BINARY != 0 /* bit-or:ing with zero O_BINARY would be useless. */ - /* - * If neither "t" nor "b" was specified, open the file - * in O_BINARY mode. + /* + * If neither "t" nor "b" was specified, open the file + * in O_BINARY mode. * * Note that if something else than the zero byte was seen * here (e.g. bogus mode "rx"), just few lines later we will * set the errno and invalidate the flags. - */ - oflags |= O_BINARY; + */ + oflags |= O_BINARY; #endif break; } if (*mode || oflags == -1) { - SETERRNO(EINVAL, LIB_INVARG); - oflags = -1; + SETERRNO(EINVAL, LIB_INVARG); + oflags = -1; } return oflags; } @@ -2589,13 +2589,13 @@ PerlIOUnix_setfd(pTHX_ PerlIO *f, int fd, int imode) #if defined(WIN32) Stat_t st; if (PerlLIO_fstat(fd, &st) == 0) { - if (!S_ISREG(st.st_mode)) { - DEBUG_i( PerlIO_debug("%d is not regular file\n",fd) ); - PerlIOBase(f)->flags |= PERLIO_F_NOTREG; - } - else { - DEBUG_i( PerlIO_debug("%d _is_ a regular file\n",fd) ); - } + if (!S_ISREG(st.st_mode)) { + DEBUG_i( PerlIO_debug("%d is not regular file\n",fd) ); + PerlIOBase(f)->flags |= PERLIO_F_NOTREG; + } + else { + DEBUG_i( PerlIO_debug("%d _is_ a regular file\n",fd) ); + } } #endif s->fd = fd; @@ -2609,13 +2609,13 @@ PerlIOUnix_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) { IV code = PerlIOBase_pushed(aTHX_ f, mode, arg, tab); if (*PerlIONext(f)) { - /* We never call down so do any pending stuff now */ - PerlIO_flush(PerlIONext(f)); - /* - * XXX could (or should) we retrieve the oflags from the open file - * handle rather than believing the "mode" we are passed in? XXX - * Should the value on NULL mode be 0 or -1? - */ + /* We never call down so do any pending stuff now */ + PerlIO_flush(PerlIONext(f)); + /* + * XXX could (or should) we retrieve the oflags from the open file + * handle rather than believing the "mode" we are passed in? XXX + * Should the value on NULL mode be 0 or -1? + */ PerlIOUnix_setfd(aTHX_ f, PerlIO_fileno(PerlIONext(f)), mode ? PerlIOUnix_oflags(mode) : -1); } @@ -2632,79 +2632,79 @@ PerlIOUnix_seek(pTHX_ PerlIO *f, Off_t offset, int whence) PERL_UNUSED_CONTEXT; if (PerlIOBase(f)->flags & PERLIO_F_NOTREG) { #ifdef ESPIPE - SETERRNO(ESPIPE, LIB_INVARG); + SETERRNO(ESPIPE, LIB_INVARG); #else - SETERRNO(EINVAL, LIB_INVARG); + SETERRNO(EINVAL, LIB_INVARG); #endif - return -1; + return -1; } new_loc = PerlLIO_lseek(fd, offset, whence); if (new_loc == (Off_t) - 1) - return -1; + return -1; PerlIOBase(f)->flags &= ~PERLIO_F_EOF; return 0; } PerlIO * PerlIOUnix_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, - IV n, const char *mode, int fd, int imode, - int perm, PerlIO *f, int narg, SV **args) + IV n, const char *mode, int fd, int imode, + int perm, PerlIO *f, int narg, SV **args) { bool known_cloexec = 0; if (PerlIOValid(f)) { - if (PerlIOBase(f)->tab && PerlIOBase(f)->flags & PERLIO_F_OPEN) - (*PerlIOBase(f)->tab->Close)(aTHX_ f); + if (PerlIOBase(f)->tab && PerlIOBase(f)->flags & PERLIO_F_OPEN) + (*PerlIOBase(f)->tab->Close)(aTHX_ f); } if (narg > 0) { - if (*mode == IoTYPE_NUMERIC) - mode++; - else { - imode = PerlIOUnix_oflags(mode); + if (*mode == IoTYPE_NUMERIC) + mode++; + else { + imode = PerlIOUnix_oflags(mode); #ifdef VMS - perm = 0777; /* preserve RMS defaults, ACL inheritance, etc. */ + perm = 0777; /* preserve RMS defaults, ACL inheritance, etc. */ #else - perm = 0666; + perm = 0666; #endif - } - if (imode != -1) { + } + if (imode != -1) { STRLEN len; - const char *path = SvPV_const(*args, len); - if (!IS_SAFE_PATHNAME(path, len, "open")) + const char *path = SvPV_const(*args, len); + if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; - fd = PerlLIO_open3_cloexec(path, imode, perm); - known_cloexec = 1; - } + fd = PerlLIO_open3_cloexec(path, imode, perm); + known_cloexec = 1; + } } if (fd >= 0) { - if (known_cloexec) - setfd_inhexec_for_sysfd(fd); - else - setfd_cloexec_or_inhexec_by_sysfdness(fd); - if (*mode == IoTYPE_IMPLICIT) - mode++; - if (!f) { - f = PerlIO_allocate(aTHX); - } - if (!PerlIOValid(f)) { - if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) { - PerlLIO_close(fd); - return NULL; - } - } + if (known_cloexec) + setfd_inhexec_for_sysfd(fd); + else + setfd_cloexec_or_inhexec_by_sysfdness(fd); + if (*mode == IoTYPE_IMPLICIT) + mode++; + if (!f) { + f = PerlIO_allocate(aTHX); + } + if (!PerlIOValid(f)) { + if (!(f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) { + PerlLIO_close(fd); + return NULL; + } + } PerlIOUnix_setfd(aTHX_ f, fd, imode); - PerlIOBase(f)->flags |= PERLIO_F_OPEN; - if (*mode == IoTYPE_APPEND) - PerlIOUnix_seek(aTHX_ f, 0, SEEK_END); - return f; + PerlIOBase(f)->flags |= PERLIO_F_OPEN; + if (*mode == IoTYPE_APPEND) + PerlIOUnix_seek(aTHX_ f, 0, SEEK_END); + return f; } else { - if (f) { - NOOP; - /* - * FIXME: pop layers ??? - */ - } - return NULL; + if (f) { + NOOP; + /* + * FIXME: pop layers ??? + */ + } + return NULL; } } @@ -2714,17 +2714,17 @@ PerlIOUnix_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) const PerlIOUnix * const os = PerlIOSelf(o, PerlIOUnix); int fd = os->fd; if (flags & PERLIO_DUP_FD) { - fd = PerlLIO_dup_cloexec(fd); - if (fd >= 0) - setfd_inhexec_for_sysfd(fd); + fd = PerlLIO_dup_cloexec(fd); + if (fd >= 0) + setfd_inhexec_for_sysfd(fd); } if (fd >= 0) { - f = PerlIOBase_dup(aTHX_ f, o, param, flags); - if (f) { - /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */ - PerlIOUnix_setfd(aTHX_ f, fd, os->oflags); - return f; - } + f = PerlIOBase_dup(aTHX_ f, o, param, flags); + if (f) { + /* If all went well overwrite fd in dup'ed lay with the dup()'ed fd */ + PerlIOUnix_setfd(aTHX_ f, fd, os->oflags); + return f; + } PerlLIO_close(fd); } return NULL; @@ -2736,30 +2736,30 @@ PerlIOUnix_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { int fd; if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */ - return -1; + return -1; fd = PerlIOSelf(f, PerlIOUnix)->fd; if (!(PerlIOBase(f)->flags & PERLIO_F_CANREAD) || PerlIOBase(f)->flags & (PERLIO_F_EOF|PERLIO_F_ERROR)) { - return 0; + return 0; } while (1) { - const SSize_t len = PerlLIO_read(fd, vbuf, count); - if (len >= 0 || errno != EINTR) { - if (len < 0) { - if (errno != EAGAIN) { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - PerlIO_save_errno(f); - } - } - else if (len == 0 && count != 0) { - PerlIOBase(f)->flags |= PERLIO_F_EOF; - SETERRNO(0,0); - } - return len; - } - /* EINTR */ - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; + const SSize_t len = PerlLIO_read(fd, vbuf, count); + if (len >= 0 || errno != EINTR) { + if (len < 0) { + if (errno != EAGAIN) { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + PerlIO_save_errno(f); + } + } + else if (len == 0 && count != 0) { + PerlIOBase(f)->flags |= PERLIO_F_EOF; + SETERRNO(0,0); + } + return len; + } + /* EINTR */ + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; } NOT_REACHED; /*NOTREACHED*/ } @@ -2769,22 +2769,22 @@ PerlIOUnix_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { int fd; if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */ - return -1; + return -1; fd = PerlIOSelf(f, PerlIOUnix)->fd; while (1) { - const SSize_t len = PerlLIO_write(fd, vbuf, count); - if (len >= 0 || errno != EINTR) { - if (len < 0) { - if (errno != EAGAIN) { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - PerlIO_save_errno(f); - } - } - return len; - } - /* EINTR */ - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; + const SSize_t len = PerlLIO_write(fd, vbuf, count); + if (len >= 0 || errno != EINTR) { + if (len < 0) { + if (errno != EAGAIN) { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + PerlIO_save_errno(f); + } + } + return len; + } + /* EINTR */ + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; } NOT_REACHED; /*NOTREACHED*/ } @@ -2805,26 +2805,26 @@ PerlIOUnix_close(pTHX_ PerlIO *f) int code = 0; if (PerlIOBase(f)->flags & PERLIO_F_OPEN) { code = PerlIOBase_close(aTHX_ f); - if (PerlIOUnix_refcnt_dec(fd) > 0) { - PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; - return 0; - } + if (PerlIOUnix_refcnt_dec(fd) > 0) { + PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; + return 0; + } } else { - SETERRNO(EBADF,SS_IVCHAN); - return -1; + SETERRNO(EBADF,SS_IVCHAN); + return -1; } while (PerlLIO_close(fd) != 0) { - if (errno != EINTR) { - code = -1; - break; - } - /* EINTR */ - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; + if (errno != EINTR) { + code = -1; + break; + } + /* EINTR */ + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; } if (code == 0) { - PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; + PerlIOBase(f)->flags &= ~PERLIO_F_OPEN; } return code; } @@ -2884,9 +2884,9 @@ PerlIOStdio_fileno(pTHX_ PerlIO *f) PERL_UNUSED_CONTEXT; if (PerlIOValid(f)) { - FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio; - if (s) - return PerlSIO_fileno(s); + FILE * const s = PerlIOSelf(f, PerlIOStdio)->stdio; + if (s) + return PerlSIO_fileno(s); } errno = EBADF; return -1; @@ -2897,9 +2897,9 @@ PerlIOStdio_mode(const char *mode, char *tmode) { char * const ret = tmode; if (mode) { - while (*mode) { - *tmode++ = *mode++; - } + while (*mode) { + *tmode++ = *mode++; + } } #if defined(PERLIO_USING_CRLF) || defined(__CYGWIN__) *tmode++ = 'b'; @@ -2913,25 +2913,25 @@ PerlIOStdio_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab { PerlIO *n; if (PerlIOValid(f) && PerlIOValid(n = PerlIONext(f))) { - PerlIO_funcs * const toptab = PerlIOBase(n)->tab; + PerlIO_funcs * const toptab = PerlIOBase(n)->tab; if (toptab == tab) { - /* Top is already stdio - pop self (duplicate) and use original */ - PerlIO_pop(aTHX_ f); - return 0; - } else { - const int fd = PerlIO_fileno(n); - char tmode[8]; - FILE *stdio; - if (fd >= 0 && (stdio = PerlSIO_fdopen(fd, - mode = PerlIOStdio_mode(mode, tmode)))) { - PerlIOSelf(f, PerlIOStdio)->stdio = stdio; - /* We never call down so do any pending stuff now */ - PerlIO_flush(PerlIONext(f)); + /* Top is already stdio - pop self (duplicate) and use original */ + PerlIO_pop(aTHX_ f); + return 0; + } else { + const int fd = PerlIO_fileno(n); + char tmode[8]; + FILE *stdio; + if (fd >= 0 && (stdio = PerlSIO_fdopen(fd, + mode = PerlIOStdio_mode(mode, tmode)))) { + PerlIOSelf(f, PerlIOStdio)->stdio = stdio; + /* We never call down so do any pending stuff now */ + PerlIO_flush(PerlIONext(f)); return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); - } - else { - return -1; - } + } + else { + return -1; + } } } return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); @@ -2944,182 +2944,182 @@ PerlIO_importFILE(FILE *stdio, const char *mode) dTHX; PerlIO *f = NULL; #ifdef EBCDIC - int rc; - char filename[FILENAME_MAX]; - fldata_t fileinfo; + int rc; + char filename[FILENAME_MAX]; + fldata_t fileinfo; #endif if (stdio) { - PerlIOStdio *s; + PerlIOStdio *s; int fd0 = fileno(stdio); if (fd0 < 0) { #ifdef EBCDIC - rc = fldata(stdio,filename,&fileinfo); - if(rc != 0){ - return NULL; - } - if(fileinfo.__dsorgHFS){ + rc = fldata(stdio,filename,&fileinfo); + if(rc != 0){ + return NULL; + } + if(fileinfo.__dsorgHFS){ return NULL; } - /*This MVS dataset , OK!*/ + /*This MVS dataset , OK!*/ #else return NULL; #endif } - if (!mode || !*mode) { - /* We need to probe to see how we can open the stream - so start with read/write and then try write and read - we dup() so that we can fclose without loosing the fd. - - Note that the errno value set by a failing fdopen - varies between stdio implementations. - */ + if (!mode || !*mode) { + /* We need to probe to see how we can open the stream + so start with read/write and then try write and read + we dup() so that we can fclose without loosing the fd. + + Note that the errno value set by a failing fdopen + varies between stdio implementations. + */ const int fd = PerlLIO_dup_cloexec(fd0); - FILE *f2; + FILE *f2; if (fd < 0) { return f; } - f2 = PerlSIO_fdopen(fd, (mode = "r+")); - if (!f2) { - f2 = PerlSIO_fdopen(fd, (mode = "w")); - } - if (!f2) { - f2 = PerlSIO_fdopen(fd, (mode = "r")); - } - if (!f2) { - /* Don't seem to be able to open */ - PerlLIO_close(fd); - return f; - } - fclose(f2); - } - if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) { - s = PerlIOSelf(f, PerlIOStdio); - s->stdio = stdio; - fd0 = fileno(stdio); - if(fd0 != -1){ - PerlIOUnix_refcnt_inc(fd0); - setfd_cloexec_or_inhexec_by_sysfdness(fd0); - } + f2 = PerlSIO_fdopen(fd, (mode = "r+")); + if (!f2) { + f2 = PerlSIO_fdopen(fd, (mode = "w")); + } + if (!f2) { + f2 = PerlSIO_fdopen(fd, (mode = "r")); + } + if (!f2) { + /* Don't seem to be able to open */ + PerlLIO_close(fd); + return f; + } + fclose(f2); + } + if ((f = PerlIO_push(aTHX_(PerlIO_allocate(aTHX)), PERLIO_FUNCS_CAST(&PerlIO_stdio), mode, NULL))) { + s = PerlIOSelf(f, PerlIOStdio); + s->stdio = stdio; + fd0 = fileno(stdio); + if(fd0 != -1){ + PerlIOUnix_refcnt_inc(fd0); + setfd_cloexec_or_inhexec_by_sysfdness(fd0); + } #ifdef EBCDIC - else{ - rc = fldata(stdio,filename,&fileinfo); - if(rc != 0){ - PerlIOUnix_refcnt_inc(fd0); - } - if(fileinfo.__dsorgHFS){ - PerlIOUnix_refcnt_inc(fd0); - } - /*This MVS dataset , OK!*/ - } + else{ + rc = fldata(stdio,filename,&fileinfo); + if(rc != 0){ + PerlIOUnix_refcnt_inc(fd0); + } + if(fileinfo.__dsorgHFS){ + PerlIOUnix_refcnt_inc(fd0); + } + /*This MVS dataset , OK!*/ + } #endif - } + } } return f; } PerlIO * PerlIOStdio_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, - IV n, const char *mode, int fd, int imode, - int perm, PerlIO *f, int narg, SV **args) + IV n, const char *mode, int fd, int imode, + int perm, PerlIO *f, int narg, SV **args) { char tmode[8]; if (PerlIOValid(f)) { STRLEN len; - const char * const path = SvPV_const(*args, len); - PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio); - FILE *stdio; - if (!IS_SAFE_PATHNAME(path, len, "open")) + const char * const path = SvPV_const(*args, len); + PerlIOStdio * const s = PerlIOSelf(f, PerlIOStdio); + FILE *stdio; + if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; - PerlIOUnix_refcnt_dec(fileno(s->stdio)); - stdio = PerlSIO_freopen(path, PerlIOStdio_mode(mode, tmode), + PerlIOUnix_refcnt_dec(fileno(s->stdio)); + stdio = PerlSIO_freopen(path, PerlIOStdio_mode(mode, tmode), s->stdio); - if (!s->stdio) - return NULL; - s->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); - return f; + if (!s->stdio) + return NULL; + s->stdio = stdio; + fd = fileno(stdio); + PerlIOUnix_refcnt_inc(fd); + setfd_cloexec_or_inhexec_by_sysfdness(fd); + return f; } else { - if (narg > 0) { + if (narg > 0) { STRLEN len; - const char * const path = SvPV_const(*args, len); + const char * const path = SvPV_const(*args, len); if (!IS_SAFE_PATHNAME(path, len, "open")) return NULL; - if (*mode == IoTYPE_NUMERIC) { - mode++; - fd = PerlLIO_open3_cloexec(path, imode, perm); - } - else { - FILE *stdio; - bool appended = FALSE; + if (*mode == IoTYPE_NUMERIC) { + mode++; + fd = PerlLIO_open3_cloexec(path, imode, perm); + } + else { + FILE *stdio; + bool appended = FALSE; #ifdef __CYGWIN__ - /* Cygwin wants its 'b' early. */ - appended = TRUE; - mode = PerlIOStdio_mode(mode, tmode); + /* Cygwin wants its 'b' early. */ + appended = TRUE; + mode = PerlIOStdio_mode(mode, tmode); #endif - stdio = PerlSIO_fopen(path, mode); - if (stdio) { - if (!f) { - f = PerlIO_allocate(aTHX); - } - if (!appended) - mode = PerlIOStdio_mode(mode, tmode); - f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg); - if (f) { - PerlIOSelf(f, PerlIOStdio)->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); - } else { - PerlSIO_fclose(stdio); - } - return f; - } - else { - return NULL; - } - } - } - if (fd >= 0) { - FILE *stdio = NULL; - int init = 0; - if (*mode == IoTYPE_IMPLICIT) { - init = 1; - mode++; - } - if (init) { - switch (fd) { - case 0: - stdio = PerlSIO_stdin; - break; - case 1: - stdio = PerlSIO_stdout; - break; - case 2: - stdio = PerlSIO_stderr; - break; - } - } - else { - stdio = PerlSIO_fdopen(fd, mode = - PerlIOStdio_mode(mode, tmode)); - } - if (stdio) { - if (!f) { - f = PerlIO_allocate(aTHX); - } - if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) { - PerlIOSelf(f, PerlIOStdio)->stdio = stdio; - fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); - } - return f; - } + stdio = PerlSIO_fopen(path, mode); + if (stdio) { + if (!f) { + f = PerlIO_allocate(aTHX); + } + if (!appended) + mode = PerlIOStdio_mode(mode, tmode); + f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg); + if (f) { + PerlIOSelf(f, PerlIOStdio)->stdio = stdio; + fd = fileno(stdio); + PerlIOUnix_refcnt_inc(fd); + setfd_cloexec_or_inhexec_by_sysfdness(fd); + } else { + PerlSIO_fclose(stdio); + } + return f; + } + else { + return NULL; + } + } + } + if (fd >= 0) { + FILE *stdio = NULL; + int init = 0; + if (*mode == IoTYPE_IMPLICIT) { + init = 1; + mode++; + } + if (init) { + switch (fd) { + case 0: + stdio = PerlSIO_stdin; + break; + case 1: + stdio = PerlSIO_stdout; + break; + case 2: + stdio = PerlSIO_stderr; + break; + } + } + else { + stdio = PerlSIO_fdopen(fd, mode = + PerlIOStdio_mode(mode, tmode)); + } + if (stdio) { + if (!f) { + f = PerlIO_allocate(aTHX); + } + if ((f = PerlIO_push(aTHX_ f, self, mode, PerlIOArg))) { + PerlIOSelf(f, PerlIOStdio)->stdio = stdio; + fd = fileno(stdio); + PerlIOUnix_refcnt_inc(fd); + setfd_cloexec_or_inhexec_by_sysfdness(fd); + } + return f; + } PerlLIO_close(fd); - } + } } return NULL; } @@ -3131,29 +3131,29 @@ PerlIOStdio_dup(pTHX_ PerlIO *f, PerlIO *o, CLONE_PARAMS *param, int flags) happens, but is not how I remember it. NI-S 2001/10/16 */ if ((f = PerlIOBase_dup(aTHX_ f, o, param, flags))) { - FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio; - const int fd = fileno(stdio); - char mode[8]; - if (flags & PERLIO_DUP_FD) { - const int dfd = PerlLIO_dup_cloexec(fileno(stdio)); - if (dfd >= 0) { - stdio = PerlSIO_fdopen(dfd, PerlIO_modestr(o,mode)); - goto set_this; - } - else { - NOOP; - /* FIXME: To avoid messy error recovery if dup fails - re-use the existing stdio as though flag was not set - */ - } - } - stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode)); + FILE *stdio = PerlIOSelf(o, PerlIOStdio)->stdio; + const int fd = fileno(stdio); + char mode[8]; + if (flags & PERLIO_DUP_FD) { + const int dfd = PerlLIO_dup_cloexec(fileno(stdio)); + if (dfd >= 0) { + stdio = PerlSIO_fdopen(dfd, PerlIO_modestr(o,mode)); + goto set_this; + } + else { + NOOP; + /* FIXME: To avoid messy error recovery if dup fails + re-use the existing stdio as though flag was not set + */ + } + } + stdio = PerlSIO_fdopen(fd, PerlIO_modestr(o,mode)); set_this: - PerlIOSelf(f, PerlIOStdio)->stdio = stdio; + PerlIOSelf(f, PerlIOStdio)->stdio = stdio; if(stdio) { - int fd = fileno(stdio); - PerlIOUnix_refcnt_inc(fd); - setfd_cloexec_or_inhexec_by_sysfdness(fd); + int fd = fileno(stdio); + PerlIOUnix_refcnt_inc(fd); + setfd_cloexec_or_inhexec_by_sysfdness(fd); } } return f; @@ -3175,7 +3175,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) return 1; #elif defined(__GLIBC__) /* There may be a better way for GLIBC: - - libio.h defines a flag to not close() on cleanup + - libio.h defines a flag to not close() on cleanup */ f->_fileno = -1; return 1; @@ -3197,14 +3197,14 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) #elif defined(__FreeBSD__) /* There may be a better way on FreeBSD: - we could insert a dummy func in the _close function entry - f->_close = (int (*)(void *)) dummy_close; + f->_close = (int (*)(void *)) dummy_close; */ f->_file = -1; return 1; #elif defined(__OpenBSD__) /* There may be a better way on OpenBSD: - we could insert a dummy func in the _close function entry - f->_close = (int (*)(void *)) dummy_close; + f->_close = (int (*)(void *)) dummy_close; */ f->_file = -1; return 1; @@ -3215,7 +3215,7 @@ PerlIOStdio_invalidate_fileno(pTHX_ FILE *f) #elif defined(__CYGWIN__) /* There may be a better way on CYGWIN: - we could insert a dummy func in the _close function entry - f->_close = (int (*)(void *)) dummy_close; + f->_close = (int (*)(void *)) dummy_close; */ f->_file = -1; return 1; @@ -3239,40 +3239,40 @@ PerlIOStdio_close(pTHX_ PerlIO *f) { FILE * const stdio = PerlIOSelf(f, PerlIOStdio)->stdio; if (!stdio) { - errno = EBADF; - return -1; + errno = EBADF; + return -1; } else { const int fd = fileno(stdio); - int invalidate = 0; - IV result = 0; - int dupfd = -1; - dSAVEDERRNO; + int invalidate = 0; + IV result = 0; + int dupfd = -1; + dSAVEDERRNO; #ifdef SOCKS5_VERSION_NAME - /* Socks lib overrides close() but stdio isn't linked to - that library (though we are) - so we must call close() - on sockets on stdio's behalf. - */ - int optval; - Sock_size_t optlen = sizeof(int); - if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) - invalidate = 1; + /* Socks lib overrides close() but stdio isn't linked to + that library (though we are) - so we must call close() + on sockets on stdio's behalf. + */ + int optval; + Sock_size_t optlen = sizeof(int); + if (getsockopt(fd, SOL_SOCKET, SO_TYPE, (void *) &optval, &optlen) == 0) + invalidate = 1; #endif - /* Test for -1, as *BSD stdio (at least) on fclose sets the FILE* such - that a subsequent fileno() on it returns -1. Don't want to croak() - from within PerlIOUnix_refcnt_dec() if some buggy caller code is - trying to close an already closed handle which somehow it still has - a reference to. (via.xs, I'm looking at you). */ - if (fd != -1 && PerlIOUnix_refcnt_dec(fd) > 0) { - /* File descriptor still in use */ - invalidate = 1; - } - if (invalidate) { - /* For STD* handles, don't close stdio, since we shared the FILE *, too. */ - if (stdio == stdin) /* Some stdios are buggy fflush-ing inputs */ - return 0; - if (stdio == stdout || stdio == stderr) - return PerlIO_flush(f); + /* Test for -1, as *BSD stdio (at least) on fclose sets the FILE* such + that a subsequent fileno() on it returns -1. Don't want to croak() + from within PerlIOUnix_refcnt_dec() if some buggy caller code is + trying to close an already closed handle which somehow it still has + a reference to. (via.xs, I'm looking at you). */ + if (fd != -1 && PerlIOUnix_refcnt_dec(fd) > 0) { + /* File descriptor still in use */ + invalidate = 1; + } + if (invalidate) { + /* For STD* handles, don't close stdio, since we shared the FILE *, too. */ + if (stdio == stdin) /* Some stdios are buggy fflush-ing inputs */ + return 0; + if (stdio == stdout || stdio == stderr) + return PerlIO_flush(f); } MUTEX_LOCK(&PL_perlio_mutex); /* Right. We need a mutex here because for a brief while we @@ -3292,46 +3292,46 @@ PerlIOStdio_close(pTHX_ PerlIO *f) Except that correctness trumps speed. Advice from klortho #11912. */ - if (invalidate) { + if (invalidate) { /* Tricky - must fclose(stdio) to free memory but not close(fd) - Use Sarathy's trick from maint-5.6 to invalidate the - fileno slot of the FILE * - */ - result = PerlIO_flush(f); - SAVE_ERRNO; - invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio); - if (!invalidate) { - dupfd = PerlLIO_dup_cloexec(fd); + Use Sarathy's trick from maint-5.6 to invalidate the + fileno slot of the FILE * + */ + result = PerlIO_flush(f); + SAVE_ERRNO; + invalidate = PerlIOStdio_invalidate_fileno(aTHX_ stdio); + if (!invalidate) { + dupfd = PerlLIO_dup_cloexec(fd); #ifdef USE_ITHREADS - if (dupfd < 0) { - /* Oh cXap. This isn't going to go well. Not sure if we can - recover from here, or if closing this particular FILE * - is a good idea now. */ - } + if (dupfd < 0) { + /* Oh cXap. This isn't going to go well. Not sure if we can + recover from here, or if closing this particular FILE * + is a good idea now. */ + } #endif - } - } else { - SAVE_ERRNO; /* This is here only to silence compiler warnings */ - } + } + } else { + SAVE_ERRNO; /* This is here only to silence compiler warnings */ + } result = PerlSIO_fclose(stdio); - /* We treat error from stdio as success if we invalidated - errno may NOT be expected EBADF - */ - if (invalidate && result != 0) { - RESTORE_ERRNO; - result = 0; - } + /* We treat error from stdio as success if we invalidated + errno may NOT be expected EBADF + */ + if (invalidate && result != 0) { + RESTORE_ERRNO; + result = 0; + } #ifdef SOCKS5_VERSION_NAME - /* in SOCKS' case, let close() determine return value */ - result = close(fd); + /* in SOCKS' case, let close() determine return value */ + result = close(fd); #endif - if (dupfd >= 0) { - PerlLIO_dup2_cloexec(dupfd, fd); - setfd_inhexec_for_sysfd(fd); - PerlLIO_close(dupfd); - } + if (dupfd >= 0) { + PerlLIO_dup2_cloexec(dupfd, fd); + setfd_inhexec_for_sysfd(fd); + PerlLIO_close(dupfd); + } MUTEX_UNLOCK(&PL_perlio_mutex); - return result; + return result; } } @@ -3341,30 +3341,30 @@ PerlIOStdio_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) FILE * s; SSize_t got = 0; if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */ - return -1; + return -1; s = PerlIOSelf(f, PerlIOStdio)->stdio; for (;;) { - if (count == 1) { - STDCHAR *buf = (STDCHAR *) vbuf; - /* - * Perl is expecting PerlIO_getc() to fill the buffer Linux's - * stdio does not do that for fread() - */ - const int ch = PerlSIO_fgetc(s); - if (ch != EOF) { - *buf = ch; - got = 1; - } - } - else - got = PerlSIO_fread(vbuf, 1, count, s); - if (got == 0 && PerlSIO_ferror(s)) - got = -1; - if (got >= 0 || errno != EINTR) - break; - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; - SETERRNO(0,0); /* just in case */ + if (count == 1) { + STDCHAR *buf = (STDCHAR *) vbuf; + /* + * Perl is expecting PerlIO_getc() to fill the buffer Linux's + * stdio does not do that for fread() + */ + const int ch = PerlSIO_fgetc(s); + if (ch != EOF) { + *buf = ch; + got = 1; + } + } + else + got = PerlSIO_fread(vbuf, 1, count, s); + if (got == 0 && PerlSIO_ferror(s)) + got = -1; + if (got >= 0 || errno != EINTR) + break; + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; + SETERRNO(0,0); /* just in case */ } #ifdef __sgi /* Under some circumstances IRIX stdio fgetc() and fread() @@ -3383,52 +3383,52 @@ PerlIOStdio_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) #ifdef STDIO_BUFFER_WRITABLE if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) { - STDCHAR *buf = ((STDCHAR *) vbuf) + count; - STDCHAR *base = PerlIO_get_base(f); - SSize_t cnt = PerlIO_get_cnt(f); - STDCHAR *ptr = PerlIO_get_ptr(f); - SSize_t avail = ptr - base; - if (avail > 0) { - if (avail > count) { - avail = count; - } - ptr -= avail; - Move(buf-avail,ptr,avail,STDCHAR); - count -= avail; - unread += avail; - PerlIO_set_ptrcnt(f,ptr,cnt+avail); - if (PerlSIO_feof(s) && unread >= 0) - PerlSIO_clearerr(s); - } + STDCHAR *buf = ((STDCHAR *) vbuf) + count; + STDCHAR *base = PerlIO_get_base(f); + SSize_t cnt = PerlIO_get_cnt(f); + STDCHAR *ptr = PerlIO_get_ptr(f); + SSize_t avail = ptr - base; + if (avail > 0) { + if (avail > count) { + avail = count; + } + ptr -= avail; + Move(buf-avail,ptr,avail,STDCHAR); + count -= avail; + unread += avail; + PerlIO_set_ptrcnt(f,ptr,cnt+avail); + if (PerlSIO_feof(s) && unread >= 0) + PerlSIO_clearerr(s); + } } else #endif if (PerlIO_has_cntptr(f)) { - /* We can get pointer to buffer but not its base - Do ungetc() but check chars are ending up in the - buffer - */ - STDCHAR *eptr = (STDCHAR*)PerlSIO_get_ptr(s); - STDCHAR *buf = ((STDCHAR *) vbuf) + count; - while (count > 0) { - const int ch = *--buf & 0xFF; - if (ungetc(ch,s) != ch) { - /* ungetc did not work */ - break; - } - if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { - /* Did not change pointer as expected */ - if (fgetc(s) != EOF) /* get char back again */ + /* We can get pointer to buffer but not its base + Do ungetc() but check chars are ending up in the + buffer + */ + STDCHAR *eptr = (STDCHAR*)PerlSIO_get_ptr(s); + STDCHAR *buf = ((STDCHAR *) vbuf) + count; + while (count > 0) { + const int ch = *--buf & 0xFF; + if (ungetc(ch,s) != ch) { + /* ungetc did not work */ + break; + } + if ((STDCHAR*)PerlSIO_get_ptr(s) != --eptr || ((*eptr & 0xFF) != ch)) { + /* Did not change pointer as expected */ + if (fgetc(s) != EOF) /* get char back again */ break; - } - /* It worked ! */ - count--; - unread++; - } + } + /* It worked ! */ + count--; + unread++; + } } if (count > 0) { - unread += PerlIOBase_unread(aTHX_ f, vbuf, count); + unread += PerlIOBase_unread(aTHX_ f, vbuf, count); } return unread; } @@ -3438,15 +3438,15 @@ PerlIOStdio_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { SSize_t got; if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */ - return -1; + return -1; for (;;) { - got = PerlSIO_fwrite(vbuf, 1, count, - PerlIOSelf(f, PerlIOStdio)->stdio); - if (got >= 0 || errno != EINTR) - break; - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; - SETERRNO(0,0); /* just in case */ + got = PerlSIO_fwrite(vbuf, 1, count, + PerlIOSelf(f, PerlIOStdio)->stdio); + if (got >= 0 || errno != EINTR) + break; + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; + SETERRNO(0,0); /* just in case */ } return got; } @@ -3476,23 +3476,23 @@ PerlIOStdio_flush(pTHX_ PerlIO *f) PERL_UNUSED_CONTEXT; if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { - return PerlSIO_fflush(stdio); + return PerlSIO_fflush(stdio); } else { - NOOP; + NOOP; #if 0 - /* - * FIXME: This discards ungetc() and pre-read stuff which is not - * right if this is just a "sync" from a layer above Suspect right - * design is to do _this_ but not have layer above flush this - * layer read-to-read - */ - /* - * Not writeable - sync by attempting a seek - */ - dSAVE_ERRNO; - if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0) - RESTORE_ERRNO; + /* + * FIXME: This discards ungetc() and pre-read stuff which is not + * right if this is just a "sync" from a layer above Suspect right + * design is to do _this_ but not have layer above flush this + * layer read-to-read + */ + /* + * Not writeable - sync by attempting a seek + */ + dSAVE_ERRNO; + if (PerlSIO_fseek(stdio, (Off_t) 0, SEEK_CUR) != 0) + RESTORE_ERRNO; #endif } return 0; @@ -3588,19 +3588,19 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) * * So let's try silencing the warning at least for gcc. */ GCC_DIAG_IGNORE_STMT(-Wpointer-sign); - PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */ + PerlSIO_set_ptr(stdio, ptr); /* LHS STDCHAR* cast non-portable */ GCC_DIAG_RESTORE_STMT; # ifdef STDIO_PTR_LVAL_SETS_CNT - assert(PerlSIO_get_cnt(stdio) == (cnt)); + assert(PerlSIO_get_cnt(stdio) == (cnt)); # endif # if (!defined(STDIO_PTR_LVAL_NOCHANGE_CNT)) - /* - * Setting ptr _does_ change cnt - we are done - */ - return; + /* + * Setting ptr _does_ change cnt - we are done + */ + return; # endif # else /* STDIO_PTR_LVALUE */ - PerlProc_abort(); + PerlProc_abort(); # endif /* STDIO_PTR_LVALUE */ } /* @@ -3610,8 +3610,8 @@ PerlIOStdio_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) PerlSIO_set_cnt(stdio, cnt); # elif (defined(STDIO_PTR_LVALUE) && defined(STDIO_PTR_LVAL_SETS_CNT)) PerlSIO_set_ptr(stdio, - PerlSIO_get_ptr(stdio) + (PerlSIO_get_cnt(stdio) - - cnt)); + PerlSIO_get_ptr(stdio) + (PerlSIO_get_cnt(stdio) - + cnt)); # else /* STDIO_PTR_LVAL_SETS_CNT */ PerlProc_abort(); # endif /* STDIO_CNT_LVALUE */ @@ -3627,52 +3627,52 @@ PerlIOStdio_fill(pTHX_ PerlIO *f) int c; PERL_UNUSED_CONTEXT; if (PerlIO_lockcnt(f)) /* in use: abort ungracefully */ - return -1; + return -1; stdio = PerlIOSelf(f, PerlIOStdio)->stdio; /* * fflush()ing read-only streams can cause trouble on some stdio-s */ if ((PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) { - if (PerlSIO_fflush(stdio) != 0) - return EOF; + if (PerlSIO_fflush(stdio) != 0) + return EOF; } for (;;) { - c = PerlSIO_fgetc(stdio); - if (c != EOF) - break; - if (! PerlSIO_ferror(stdio) || errno != EINTR) - return EOF; - if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) - return -1; - SETERRNO(0,0); + c = PerlSIO_fgetc(stdio); + if (c != EOF) + break; + if (! PerlSIO_ferror(stdio) || errno != EINTR) + return EOF; + if (PL_sig_pending && S_perlio_async_run(aTHX_ f)) + return -1; + SETERRNO(0,0); } #if (defined(STDIO_PTR_LVALUE) && (defined(STDIO_CNT_LVALUE) || defined(STDIO_PTR_LVAL_SETS_CNT))) # ifdef STDIO_BUFFER_WRITABLE if (PerlIO_fast_gets(f) && PerlIO_has_base(f)) { - /* Fake ungetc() to the real buffer in case system's ungetc - goes elsewhere - */ - STDCHAR *base = (STDCHAR*)PerlSIO_get_base(stdio); - SSize_t cnt = PerlSIO_get_cnt(stdio); - STDCHAR *ptr = (STDCHAR*)PerlSIO_get_ptr(stdio); - if (ptr == base+1) { - *--ptr = (STDCHAR) c; - PerlIOStdio_set_ptrcnt(aTHX_ f,ptr,cnt+1); - if (PerlSIO_feof(stdio)) - PerlSIO_clearerr(stdio); - return 0; - } + /* Fake ungetc() to the real buffer in case system's ungetc + goes elsewhere + */ + STDCHAR *base = (STDCHAR*)PerlSIO_get_base(stdio); + SSize_t cnt = PerlSIO_get_cnt(stdio); + STDCHAR *ptr = (STDCHAR*)PerlSIO_get_ptr(stdio); + if (ptr == base+1) { + *--ptr = (STDCHAR) c; + PerlIOStdio_set_ptrcnt(aTHX_ f,ptr,cnt+1); + if (PerlSIO_feof(stdio)) + PerlSIO_clearerr(stdio); + return 0; + } } else # endif if (PerlIO_has_cntptr(f)) { - STDCHAR ch = c; - if (PerlIOStdio_unread(aTHX_ f,&ch,1) == 1) { - return 0; - } + STDCHAR ch = c; + if (PerlIOStdio_unread(aTHX_ f,&ch,1) == 1) { + return 0; + } } #endif @@ -3680,7 +3680,7 @@ PerlIOStdio_fill(pTHX_ PerlIO *f) using ungetc(). */ if (PerlSIO_ungetc(c, stdio) != c) - return EOF; + return EOF; return 0; } @@ -3741,33 +3741,33 @@ PerlIO_exportFILE(PerlIO * f, const char *mode) dTHX; FILE *stdio = NULL; if (PerlIOValid(f)) { - char buf[8]; + char buf[8]; int fd = PerlIO_fileno(f); if (fd < 0) { return NULL; } - PerlIO_flush(f); - if (!mode || !*mode) { - mode = PerlIO_modestr(f, buf); - } - stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode); - if (stdio) { - PerlIOl *l = *f; - PerlIO *f2; - /* De-link any lower layers so new :stdio sticks */ - *f = NULL; - if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) { - PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio); - s->stdio = stdio; - PerlIOUnix_refcnt_inc(fileno(stdio)); - /* Link previous lower layers under new one */ - *PerlIONext(f) = l; - } - else { - /* restore layers list */ - *f = l; - } - } + PerlIO_flush(f); + if (!mode || !*mode) { + mode = PerlIO_modestr(f, buf); + } + stdio = PerlSIO_fdopen(PerlIO_fileno(f), mode); + if (stdio) { + PerlIOl *l = *f; + PerlIO *f2; + /* De-link any lower layers so new :stdio sticks */ + *f = NULL; + if ((f2 = PerlIO_push(aTHX_ f, PERLIO_FUNCS_CAST(&PerlIO_stdio), buf, NULL))) { + PerlIOStdio *s = PerlIOSelf((f = f2), PerlIOStdio); + s->stdio = stdio; + PerlIOUnix_refcnt_inc(fileno(stdio)); + /* Link previous lower layers under new one */ + *PerlIONext(f) = l; + } + else { + /* restore layers list */ + *f = l; + } + } } return stdio; } @@ -3779,11 +3779,11 @@ PerlIO_findFILE(PerlIO *f) PerlIOl *l = *f; FILE *stdio; while (l) { - if (l->tab == &PerlIO_stdio) { - PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio); - return s->stdio; - } - l = *PerlIONext(&l); + if (l->tab == &PerlIO_stdio) { + PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio); + return s->stdio; + } + l = *PerlIONext(&l); } /* Uses fallback "mode" via PerlIO_modestr() in PerlIO_exportFILE */ /* However, we're not really exporting a FILE * to someone else (who @@ -3794,9 +3794,9 @@ PerlIO_findFILE(PerlIO *f) only one way to be consistent. */ stdio = PerlIO_exportFILE(f, NULL); if (stdio) { - const int fd = fileno(stdio); - if (fd >= 0) - PerlIOUnix_refcnt_dec(fd); + const int fd = fileno(stdio); + if (fd >= 0) + PerlIOUnix_refcnt_dec(fd); } return stdio; } @@ -3807,20 +3807,20 @@ PerlIO_releaseFILE(PerlIO *p, FILE *f) { PerlIOl *l; while ((l = *p)) { - if (l->tab == &PerlIO_stdio) { - PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio); - if (s->stdio == f) { /* not in a loop */ - const int fd = fileno(f); - if (fd >= 0) - PerlIOUnix_refcnt_dec(fd); - { - dTHX; - PerlIO_pop(aTHX_ p); - } - return; - } - } - p = PerlIONext(p); + if (l->tab == &PerlIO_stdio) { + PerlIOStdio *s = PerlIOSelf(&l, PerlIOStdio); + if (s->stdio == f) { /* not in a loop */ + const int fd = fileno(f); + if (fd >= 0) + PerlIOUnix_refcnt_dec(fd); + { + dTHX; + PerlIO_pop(aTHX_ p); + } + return; + } + } + p = PerlIONext(p); } return; } @@ -3836,91 +3836,91 @@ PerlIOBuf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); const int fd = PerlIO_fileno(f); if (fd >= 0 && PerlLIO_isatty(fd)) { - PerlIOBase(f)->flags |= PERLIO_F_LINEBUF | PERLIO_F_TTY; + PerlIOBase(f)->flags |= PERLIO_F_LINEBUF | PERLIO_F_TTY; } if (*PerlIONext(f)) { - const Off_t posn = PerlIO_tell(PerlIONext(f)); - if (posn != (Off_t) - 1) { - b->posn = posn; - } + const Off_t posn = PerlIO_tell(PerlIONext(f)); + if (posn != (Off_t) - 1) { + b->posn = posn; + } } return PerlIOBase_pushed(aTHX_ f, mode, arg, tab); } PerlIO * PerlIOBuf_open(pTHX_ PerlIO_funcs *self, PerlIO_list_t *layers, - IV n, const char *mode, int fd, int imode, int perm, - PerlIO *f, int narg, SV **args) + IV n, const char *mode, int fd, int imode, int perm, + PerlIO *f, int narg, SV **args) { if (PerlIOValid(f)) { - PerlIO *next = PerlIONext(f); - PerlIO_funcs *tab = - PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); - if (tab && tab->Open) - next = - (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, - next, narg, args); - if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) { - return NULL; - } + PerlIO *next = PerlIONext(f); + PerlIO_funcs *tab = + PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIOBase(next)->tab); + if (tab && tab->Open) + next = + (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, + next, narg, args); + if (!next || (*PerlIOBase(f)->tab->Pushed) (aTHX_ f, mode, PerlIOArg, self) != 0) { + return NULL; + } } else { - PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm()); - int init = 0; - if (*mode == IoTYPE_IMPLICIT) { - init = 1; - /* - * mode++; - */ - } - if (tab && tab->Open) - f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, - f, narg, args); - else - SETERRNO(EINVAL, LIB_INVARG); - if (f) { - if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) { - /* - * if push fails during open, open fails. close will pop us. - */ - PerlIO_close (f); - return NULL; - } else { - fd = PerlIO_fileno(f); - if (init && fd == 2) { - /* - * Initial stderr is unbuffered - */ - PerlIOBase(f)->flags |= PERLIO_F_UNBUF; - } + PerlIO_funcs *tab = PerlIO_layer_fetch(aTHX_ layers, n - 1, PerlIO_default_btm()); + int init = 0; + if (*mode == IoTYPE_IMPLICIT) { + init = 1; + /* + * mode++; + */ + } + if (tab && tab->Open) + f = (*tab->Open)(aTHX_ tab, layers, n - 1, mode, fd, imode, perm, + f, narg, args); + else + SETERRNO(EINVAL, LIB_INVARG); + if (f) { + if (PerlIO_push(aTHX_ f, self, mode, PerlIOArg) == 0) { + /* + * if push fails during open, open fails. close will pop us. + */ + PerlIO_close (f); + return NULL; + } else { + fd = PerlIO_fileno(f); + if (init && fd == 2) { + /* + * Initial stderr is unbuffered + */ + PerlIOBase(f)->flags |= PERLIO_F_UNBUF; + } #ifdef PERLIO_USING_CRLF # ifdef PERLIO_IS_BINMODE_FD - if (PERLIO_IS_BINMODE_FD(fd)) - PerlIO_binmode(aTHX_ f, '<'/*not used*/, O_BINARY, NULL); - else + if (PERLIO_IS_BINMODE_FD(fd)) + PerlIO_binmode(aTHX_ f, '<'/*not used*/, O_BINARY, NULL); + else # endif - /* - * do something about failing setmode()? --jhi - */ - PerlLIO_setmode(fd, O_BINARY); + /* + * do something about failing setmode()? --jhi + */ + PerlLIO_setmode(fd, O_BINARY); #endif #ifdef VMS - /* Enable line buffering with record-oriented regular files - * so we don't introduce an extraneous record boundary when - * the buffer fills up. - */ - if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { - Stat_t st; - if (PerlLIO_fstat(fd, &st) == 0 - && S_ISREG(st.st_mode) - && (st.st_fab_rfm == FAB$C_VAR - || st.st_fab_rfm == FAB$C_VFC)) { - PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; - } - } + /* Enable line buffering with record-oriented regular files + * so we don't introduce an extraneous record boundary when + * the buffer fills up. + */ + if (PerlIOBase(f)->flags & PERLIO_F_CANWRITE) { + Stat_t st; + if (PerlLIO_fstat(fd, &st) == 0 + && S_ISREG(st.st_mode) + && (st.st_fab_rfm == FAB$C_VAR + || st.st_fab_rfm == FAB$C_VFC)) { + PerlIOBase(f)->flags |= PERLIO_F_LINEBUF; + } + } #endif - } - } + } + } } return f; } @@ -3940,54 +3940,54 @@ PerlIOBuf_flush(pTHX_ PerlIO *f) int code = 0; PerlIO *n = PerlIONext(f); if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) { - /* - * write() the buffer - */ - const STDCHAR *buf = b->buf; - const STDCHAR *p = buf; - while (p < b->ptr) { - SSize_t count = PerlIO_write(n, p, b->ptr - p); - if (count > 0) { - p += count; - } - else if (count < 0 || PerlIO_error(n)) { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - PerlIO_save_errno(f); - code = -1; - break; - } - } - b->posn += (p - buf); + /* + * write() the buffer + */ + const STDCHAR *buf = b->buf; + const STDCHAR *p = buf; + while (p < b->ptr) { + SSize_t count = PerlIO_write(n, p, b->ptr - p); + if (count > 0) { + p += count; + } + else if (count < 0 || PerlIO_error(n)) { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + PerlIO_save_errno(f); + code = -1; + break; + } + } + b->posn += (p - buf); } else if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { - STDCHAR *buf = PerlIO_get_base(f); - /* - * Note position change - */ - b->posn += (b->ptr - buf); - if (b->ptr < b->end) { - /* We did not consume all of it - try and seek downstream to - our logical position - */ - if (PerlIOValid(n) && PerlIO_seek(n, b->posn, SEEK_SET) == 0) { - /* Reload n as some layers may pop themselves on seek */ - b->posn = PerlIO_tell(n = PerlIONext(f)); - } - else { - /* Seek failed (e.g. pipe or tty). Do NOT clear buffer or pre-read - data is lost for good - so return saying "ok" having undone - the position adjust - */ - b->posn -= (b->ptr - buf); - return code; - } - } + STDCHAR *buf = PerlIO_get_base(f); + /* + * Note position change + */ + b->posn += (b->ptr - buf); + if (b->ptr < b->end) { + /* We did not consume all of it - try and seek downstream to + our logical position + */ + if (PerlIOValid(n) && PerlIO_seek(n, b->posn, SEEK_SET) == 0) { + /* Reload n as some layers may pop themselves on seek */ + b->posn = PerlIO_tell(n = PerlIONext(f)); + } + else { + /* Seek failed (e.g. pipe or tty). Do NOT clear buffer or pre-read + data is lost for good - so return saying "ok" having undone + the position adjust + */ + b->posn -= (b->ptr - buf); + return code; + } + } } b->ptr = b->end = b->buf; PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); /* We check for Valid because of dubious decision to make PerlIO_flush(NULL) flush all */ if (PerlIOValid(n) && PerlIO_flush(n) != 0) - code = -1; + code = -1; return code; } @@ -4006,60 +4006,60 @@ PerlIOBuf_fill(pTHX_ PerlIO *f) * we would not normally be fill'ing if there was data left in anycase. */ if (PerlIO_flush(f) != 0) /* XXXX Check that its seek() succeeded?! */ - return -1; + return -1; if (PerlIOBase(f)->flags & PERLIO_F_TTY) - PerlIOBase_flush_linebuf(aTHX); + PerlIOBase_flush_linebuf(aTHX); if (!b->buf) - PerlIO_get_base(f); /* allocate via vtable */ + PerlIO_get_base(f); /* allocate via vtable */ assert(b->buf); /* The b->buf does get allocated via the vtable system. */ b->ptr = b->end = b->buf; if (!PerlIOValid(n)) { - PerlIOBase(f)->flags |= PERLIO_F_EOF; - return -1; + PerlIOBase(f)->flags |= PERLIO_F_EOF; + return -1; } if (PerlIO_fast_gets(n)) { - /* - * Layer below is also buffered. We do _NOT_ want to call its - * ->Read() because that will loop till it gets what we asked for - * which may hang on a pipe etc. Instead take anything it has to - * hand, or ask it to fill _once_. - */ - avail = PerlIO_get_cnt(n); - if (avail <= 0) { - avail = PerlIO_fill(n); - if (avail == 0) - avail = PerlIO_get_cnt(n); - else { - if (!PerlIO_error(n) && PerlIO_eof(n)) - avail = 0; - } - } - if (avail > 0) { - STDCHAR *ptr = PerlIO_get_ptr(n); - const SSize_t cnt = avail; - if (avail > (SSize_t)b->bufsiz) - avail = b->bufsiz; - Copy(ptr, b->buf, avail, STDCHAR); - PerlIO_set_ptrcnt(n, ptr + avail, cnt - avail); - } + /* + * Layer below is also buffered. We do _NOT_ want to call its + * ->Read() because that will loop till it gets what we asked for + * which may hang on a pipe etc. Instead take anything it has to + * hand, or ask it to fill _once_. + */ + avail = PerlIO_get_cnt(n); + if (avail <= 0) { + avail = PerlIO_fill(n); + if (avail == 0) + avail = PerlIO_get_cnt(n); + else { + if (!PerlIO_error(n) && PerlIO_eof(n)) + avail = 0; + } + } + if (avail > 0) { + STDCHAR *ptr = PerlIO_get_ptr(n); + const SSize_t cnt = avail; + if (avail > (SSize_t)b->bufsiz) + avail = b->bufsiz; + Copy(ptr, b->buf, avail, STDCHAR); + PerlIO_set_ptrcnt(n, ptr + avail, cnt - avail); + } } else { - avail = PerlIO_read(n, b->ptr, b->bufsiz); + avail = PerlIO_read(n, b->ptr, b->bufsiz); } if (avail <= 0) { - if (avail == 0) - PerlIOBase(f)->flags |= PERLIO_F_EOF; - else - { - PerlIOBase(f)->flags |= PERLIO_F_ERROR; - PerlIO_save_errno(f); - } - return -1; + if (avail == 0) + PerlIOBase(f)->flags |= PERLIO_F_EOF; + else + { + PerlIOBase(f)->flags |= PERLIO_F_ERROR; + PerlIO_save_errno(f); + } + return -1; } b->end = b->buf + avail; PerlIOBase(f)->flags |= PERLIO_F_RDBUF; @@ -4071,9 +4071,9 @@ PerlIOBuf_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) { if (PerlIOValid(f)) { const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - if (!b->ptr) - PerlIO_get_base(f); - return PerlIOBase_read(aTHX_ f, vbuf, count); + if (!b->ptr) + PerlIO_get_base(f); + return PerlIOBase_read(aTHX_ f, vbuf, count); } return 0; } @@ -4086,54 +4086,54 @@ PerlIOBuf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) SSize_t unread = 0; SSize_t avail; if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) - PerlIO_flush(f); + PerlIO_flush(f); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); if (b->buf) { - if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { - /* - * Buffer is already a read buffer, we can overwrite any chars - * which have been read back to buffer start - */ - avail = (b->ptr - b->buf); - } - else { - /* - * Buffer is idle, set it up so whole buffer is available for - * unread - */ - avail = b->bufsiz; - b->end = b->buf + avail; - b->ptr = b->end; - PerlIOBase(f)->flags |= PERLIO_F_RDBUF; - /* - * Buffer extends _back_ from where we are now - */ - b->posn -= b->bufsiz; - } - if ((SSize_t) count >= 0 && avail > (SSize_t) count) { - /* - * If we have space for more than count, just move count - */ - avail = count; - } - if (avail > 0) { - b->ptr -= avail; - buf -= avail; - /* - * In simple stdio-like ungetc() case chars will be already - * there - */ - if (buf != b->ptr) { - Copy(buf, b->ptr, avail, STDCHAR); - } - count -= avail; - unread += avail; - PerlIOBase(f)->flags &= ~PERLIO_F_EOF; - } + if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { + /* + * Buffer is already a read buffer, we can overwrite any chars + * which have been read back to buffer start + */ + avail = (b->ptr - b->buf); + } + else { + /* + * Buffer is idle, set it up so whole buffer is available for + * unread + */ + avail = b->bufsiz; + b->end = b->buf + avail; + b->ptr = b->end; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; + /* + * Buffer extends _back_ from where we are now + */ + b->posn -= b->bufsiz; + } + if ((SSize_t) count >= 0 && avail > (SSize_t) count) { + /* + * If we have space for more than count, just move count + */ + avail = count; + } + if (avail > 0) { + b->ptr -= avail; + buf -= avail; + /* + * In simple stdio-like ungetc() case chars will be already + * there + */ + if (buf != b->ptr) { + Copy(buf, b->ptr, avail, STDCHAR); + } + count -= avail; + unread += avail; + PerlIOBase(f)->flags &= ~PERLIO_F_EOF; + } } if (count > 0) { - unread += PerlIOBase_unread(aTHX_ f, vbuf, count); + unread += PerlIOBase_unread(aTHX_ f, vbuf, count); } return unread; } @@ -4146,41 +4146,41 @@ PerlIOBuf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) const STDCHAR *flushptr = buf; Size_t written = 0; if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) - return 0; + return 0; if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { - if (PerlIO_flush(f) != 0) { - return 0; - } + if (PerlIO_flush(f) != 0) { + return 0; + } } if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) { - flushptr = buf + count; - while (flushptr > buf && *(flushptr - 1) != '\n') - --flushptr; + flushptr = buf + count; + while (flushptr > buf && *(flushptr - 1) != '\n') + --flushptr; } while (count > 0) { - SSize_t avail = b->bufsiz - (b->ptr - b->buf); - if ((SSize_t) count >= 0 && (SSize_t) count < avail) - avail = count; - if (flushptr > buf && flushptr <= buf + avail) - avail = flushptr - buf; - PerlIOBase(f)->flags |= PERLIO_F_WRBUF; - if (avail) { - Copy(buf, b->ptr, avail, STDCHAR); - count -= avail; - buf += avail; - written += avail; - b->ptr += avail; - if (buf == flushptr) - PerlIO_flush(f); - } - if (b->ptr >= (b->buf + b->bufsiz)) - if (PerlIO_flush(f) == -1) - return -1; + SSize_t avail = b->bufsiz - (b->ptr - b->buf); + if ((SSize_t) count >= 0 && (SSize_t) count < avail) + avail = count; + if (flushptr > buf && flushptr <= buf + avail) + avail = flushptr - buf; + PerlIOBase(f)->flags |= PERLIO_F_WRBUF; + if (avail) { + Copy(buf, b->ptr, avail, STDCHAR); + count -= avail; + buf += avail; + written += avail; + b->ptr += avail; + if (buf == flushptr) + PerlIO_flush(f); + } + if (b->ptr >= (b->buf + b->bufsiz)) + if (PerlIO_flush(f) == -1) + return -1; } if (PerlIOBase(f)->flags & PERLIO_F_UNBUF) - PerlIO_flush(f); + PerlIO_flush(f); return written; } @@ -4189,12 +4189,12 @@ PerlIOBuf_seek(pTHX_ PerlIO *f, Off_t offset, int whence) { IV code; if ((code = PerlIO_flush(f)) == 0) { - PerlIOBase(f)->flags &= ~PERLIO_F_EOF; - code = PerlIO_seek(PerlIONext(f), offset, whence); - if (code == 0) { - PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); - b->posn = PerlIO_tell(PerlIONext(f)); - } + PerlIOBase(f)->flags &= ~PERLIO_F_EOF; + code = PerlIO_seek(PerlIONext(f), offset, whence); + if (code == 0) { + PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); + b->posn = PerlIO_tell(PerlIONext(f)); + } } return code; } @@ -4210,21 +4210,21 @@ PerlIOBuf_tell(pTHX_ PerlIO *f) if ((PerlIOBase(f)->flags & PERLIO_F_APPEND) && (PerlIOBase(f)->flags & PERLIO_F_WRBUF)) { #if 1 - /* As O_APPEND files are normally shared in some sense it is better - to flush : - */ - PerlIO_flush(f); + /* As O_APPEND files are normally shared in some sense it is better + to flush : + */ + PerlIO_flush(f); #else /* when file is NOT shared then this is sufficient */ - PerlIO_seek(PerlIONext(f),0, SEEK_END); + PerlIO_seek(PerlIONext(f),0, SEEK_END); #endif - posn = b->posn = PerlIO_tell(PerlIONext(f)); + posn = b->posn = PerlIO_tell(PerlIONext(f)); } if (b->buf) { - /* - * If buffer is valid adjust position by amount in buffer - */ - posn += (b->ptr - b->buf); + /* + * If buffer is valid adjust position by amount in buffer + */ + posn += (b->ptr - b->buf); } return posn; } @@ -4235,7 +4235,7 @@ PerlIOBuf_popped(pTHX_ PerlIO *f) const IV code = PerlIOBase_popped(aTHX_ f); PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (b->buf && b->buf != (STDCHAR *) & b->oneword) { - Safefree(b->buf); + Safefree(b->buf); } b->ptr = b->end = b->buf = NULL; PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); @@ -4248,7 +4248,7 @@ PerlIOBuf_close(pTHX_ PerlIO *f) const IV code = PerlIOBase_close(aTHX_ f); PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (b->buf && b->buf != (STDCHAR *) & b->oneword) { - Safefree(b->buf); + Safefree(b->buf); } b->ptr = b->end = b->buf = NULL; PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); @@ -4260,7 +4260,7 @@ PerlIOBuf_get_ptr(pTHX_ PerlIO *f) { const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); return b->ptr; } @@ -4269,9 +4269,9 @@ PerlIOBuf_get_cnt(pTHX_ PerlIO *f) { const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) - return (b->end - b->ptr); + return (b->end - b->ptr); return 0; } @@ -4282,14 +4282,14 @@ PerlIOBuf_get_base(pTHX_ PerlIO *f) PERL_UNUSED_CONTEXT; if (!b->buf) { - if (!b->bufsiz) - b->bufsiz = PERLIOBUF_DEFAULT_BUFSIZ; - Newx(b->buf,b->bufsiz, STDCHAR); - if (!b->buf) { - b->buf = (STDCHAR *) & b->oneword; - b->bufsiz = sizeof(b->oneword); - } - b->end = b->ptr = b->buf; + if (!b->bufsiz) + b->bufsiz = PERLIOBUF_DEFAULT_BUFSIZ; + Newx(b->buf,b->bufsiz, STDCHAR); + if (!b->buf) { + b->buf = (STDCHAR *) & b->oneword; + b->bufsiz = sizeof(b->oneword); + } + b->end = b->ptr = b->buf; } return b->buf; } @@ -4299,7 +4299,7 @@ PerlIOBuf_bufsiz(pTHX_ PerlIO *f) { const PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); return (b->end - b->buf); } @@ -4311,7 +4311,7 @@ PerlIOBuf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) PERL_UNUSED_ARG(cnt); #endif if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); b->ptr = ptr; assert(PerlIO_get_cnt(f) == cnt); assert(b->ptr >= b->buf); @@ -4398,8 +4398,8 @@ PerlIOPending_flush(pTHX_ PerlIO *f) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (b->buf && b->buf != (STDCHAR *) & b->oneword) { - Safefree(b->buf); - b->buf = NULL; + Safefree(b->buf); + b->buf = NULL; } PerlIO_pop(aTHX_ f); return 0; @@ -4409,10 +4409,10 @@ void PerlIOPending_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) { if (cnt <= 0) { - PerlIO_flush(f); + PerlIO_flush(f); } else { - PerlIOBuf_set_ptrcnt(aTHX_ f, ptr, cnt); + PerlIOBuf_set_ptrcnt(aTHX_ f, ptr, cnt); } } @@ -4426,8 +4426,8 @@ PerlIOPending_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *t * etc. get muddled when it changes mid-string when we auto-pop. */ l->flags = (l->flags & ~(PERLIO_F_FASTGETS | PERLIO_F_UTF8)) | - (PerlIOBase(PerlIONext(f))-> - flags & (PERLIO_F_FASTGETS | PERLIO_F_UTF8)); + (PerlIOBase(PerlIONext(f))-> + flags & (PERLIO_F_FASTGETS | PERLIO_F_UTF8)); return code; } @@ -4437,14 +4437,14 @@ PerlIOPending_read(pTHX_ PerlIO *f, void *vbuf, Size_t count) SSize_t avail = PerlIO_get_cnt(f); SSize_t got = 0; if ((SSize_t) count >= 0 && (SSize_t)count < avail) - avail = count; + avail = count; if (avail > 0) - got = PerlIOBuf_read(aTHX_ f, vbuf, avail); + got = PerlIOBuf_read(aTHX_ f, vbuf, avail); if (got >= 0 && got < (SSize_t)count) { - const SSize_t more = - PerlIO_read(f, ((STDCHAR *) vbuf) + got, count - got); - if (more >= 0 || got == 0) - got += more; + const SSize_t more = + PerlIO_read(f, ((STDCHAR *) vbuf) + got, count - got); + if (more >= 0 || got == 0) + got += more; } return got; } @@ -4500,7 +4500,7 @@ PERLIO_FUNCS_DECL(PerlIO_pending) = { typedef struct { PerlIOBuf base; /* PerlIOBuf stuff */ STDCHAR *nl; /* Position of crlf we "lied" about in the - * buffer */ + * buffer */ } PerlIOCrlf; /* Inherit the PERLIO_F_UTF8 flag from previous layer. @@ -4512,9 +4512,9 @@ S_inherit_utf8_flag(PerlIO *f) { PerlIO *g = PerlIONext(f); if (PerlIOValid(g)) { - if (PerlIOBase(g)->flags & PERLIO_F_UTF8) { - PerlIOBase(f)->flags |= PERLIO_F_UTF8; - } + if (PerlIOBase(g)->flags & PERLIO_F_UTF8) { + PerlIOBase(f)->flags |= PERLIO_F_UTF8; + } } } @@ -4527,24 +4527,24 @@ PerlIOCrlf_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab) #if 0 DEBUG_i( PerlIO_debug("PerlIOCrlf_pushed f=%p %s %s fl=%08" UVxf "\n", - (void*)f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)", - PerlIOBase(f)->flags); + (void*)f, PerlIOBase(f)->tab->name, (mode) ? mode : "(Null)", + PerlIOBase(f)->flags); ); #endif { /* If the old top layer is a CRLF layer, reactivate it (if * necessary) and remove this new layer from the stack */ - PerlIO *g = PerlIONext(f); - if (PerlIOValid(g)) { - PerlIOl *b = PerlIOBase(g); - if (b && b->tab == &PerlIO_crlf) { - if (!(b->flags & PERLIO_F_CRLF)) - b->flags |= PERLIO_F_CRLF; - S_inherit_utf8_flag(g); - PerlIO_pop(aTHX_ f); - return code; - } - } + PerlIO *g = PerlIONext(f); + if (PerlIOValid(g)) { + PerlIOl *b = PerlIOBase(g); + if (b && b->tab == &PerlIO_crlf) { + if (!(b->flags & PERLIO_F_CRLF)) + b->flags |= PERLIO_F_CRLF; + S_inherit_utf8_flag(g); + PerlIO_pop(aTHX_ f); + return code; + } + } } S_inherit_utf8_flag(f); return code; @@ -4556,52 +4556,52 @@ PerlIOCrlf_unread(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf); if (c->nl) { /* XXXX Shouldn't it be done only if b->ptr > c->nl? */ - *(c->nl) = NATIVE_0xd; - c->nl = NULL; + *(c->nl) = NATIVE_0xd; + c->nl = NULL; } if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) - return PerlIOBuf_unread(aTHX_ f, vbuf, count); + return PerlIOBuf_unread(aTHX_ f, vbuf, count); else { - const STDCHAR *buf = (const STDCHAR *) vbuf + count; - PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); - SSize_t unread = 0; - if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) - PerlIO_flush(f); - if (!b->buf) - PerlIO_get_base(f); - if (b->buf) { - if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { - b->end = b->ptr = b->buf + b->bufsiz; - PerlIOBase(f)->flags |= PERLIO_F_RDBUF; - b->posn -= b->bufsiz; - } - while (count > 0 && b->ptr > b->buf) { - const int ch = *--buf; - if (ch == '\n') { - if (b->ptr - 2 >= b->buf) { - *--(b->ptr) = NATIVE_0xa; - *--(b->ptr) = NATIVE_0xd; - unread++; - count--; - } - else { - /* If b->ptr - 1 == b->buf, we are undoing reading 0xa */ + const STDCHAR *buf = (const STDCHAR *) vbuf + count; + PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); + SSize_t unread = 0; + if (PerlIOBase(f)->flags & PERLIO_F_WRBUF) + PerlIO_flush(f); + if (!b->buf) + PerlIO_get_base(f); + if (b->buf) { + if (!(PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { + b->end = b->ptr = b->buf + b->bufsiz; + PerlIOBase(f)->flags |= PERLIO_F_RDBUF; + b->posn -= b->bufsiz; + } + while (count > 0 && b->ptr > b->buf) { + const int ch = *--buf; + if (ch == '\n') { + if (b->ptr - 2 >= b->buf) { + *--(b->ptr) = NATIVE_0xa; + *--(b->ptr) = NATIVE_0xd; + unread++; + count--; + } + else { + /* If b->ptr - 1 == b->buf, we are undoing reading 0xa */ *--(b->ptr) = NATIVE_0xa; /* Works even if 0xa == '\r' */ - unread++; - count--; - } - } - else { - *--(b->ptr) = ch; - unread++; - count--; - } - } - } + unread++; + count--; + } + } + else { + *--(b->ptr) = ch; + unread++; + count--; + } + } + } if (count > 0) unread += PerlIOBase_unread(aTHX_ f, (const STDCHAR *) vbuf + unread, count); - return unread; + return unread; } } @@ -4611,69 +4611,69 @@ PerlIOCrlf_get_cnt(pTHX_ PerlIO *f) { PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { - PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf); - if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == NATIVE_0xd)) { - STDCHAR *nl = (c->nl) ? c->nl : b->ptr; - scan: - while (nl < b->end && *nl != NATIVE_0xd) - nl++; - if (nl < b->end && *nl == NATIVE_0xd) { - test: - if (nl + 1 < b->end) { - if (nl[1] == NATIVE_0xa) { - *nl = '\n'; - c->nl = nl; - } - else { - /* - * Not CR,LF but just CR - */ - nl++; - goto scan; - } - } - else { - /* - * Blast - found CR as last char in buffer - */ - - if (b->ptr < nl) { - /* - * They may not care, defer work as long as - * possible - */ - c->nl = nl; - return (nl - b->ptr); - } - else { - int code; - b->ptr++; /* say we have read it as far as - * flush() is concerned */ - b->buf++; /* Leave space in front of buffer */ - /* Note as we have moved buf up flush's - posn += ptr-buf - will naturally make posn point at CR - */ - b->bufsiz--; /* Buffer is thus smaller */ - code = PerlIO_fill(f); /* Fetch some more */ - b->bufsiz++; /* Restore size for next time */ - b->buf--; /* Point at space */ - b->ptr = nl = b->buf; /* Which is what we hand - * off */ - *nl = NATIVE_0xd; /* Fill in the CR */ - if (code == 0) - goto test; /* fill() call worked */ - /* - * CR at EOF - just fall through - */ - /* Should we clear EOF though ??? */ - } - } - } - } - return (((c->nl) ? (c->nl + 1) : b->end) - b->ptr); + PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf); + if ((PerlIOBase(f)->flags & PERLIO_F_CRLF) && (!c->nl || *c->nl == NATIVE_0xd)) { + STDCHAR *nl = (c->nl) ? c->nl : b->ptr; + scan: + while (nl < b->end && *nl != NATIVE_0xd) + nl++; + if (nl < b->end && *nl == NATIVE_0xd) { + test: + if (nl + 1 < b->end) { + if (nl[1] == NATIVE_0xa) { + *nl = '\n'; + c->nl = nl; + } + else { + /* + * Not CR,LF but just CR + */ + nl++; + goto scan; + } + } + else { + /* + * Blast - found CR as last char in buffer + */ + + if (b->ptr < nl) { + /* + * They may not care, defer work as long as + * possible + */ + c->nl = nl; + return (nl - b->ptr); + } + else { + int code; + b->ptr++; /* say we have read it as far as + * flush() is concerned */ + b->buf++; /* Leave space in front of buffer */ + /* Note as we have moved buf up flush's + posn += ptr-buf + will naturally make posn point at CR + */ + b->bufsiz--; /* Buffer is thus smaller */ + code = PerlIO_fill(f); /* Fetch some more */ + b->bufsiz++; /* Restore size for next time */ + b->buf--; /* Point at space */ + b->ptr = nl = b->buf; /* Which is what we hand + * off */ + *nl = NATIVE_0xd; /* Fill in the CR */ + if (code == 0) + goto test; /* fill() call worked */ + /* + * CR at EOF - just fall through + */ + /* Should we clear EOF though ??? */ + } + } + } + } + return (((c->nl) ? (c->nl + 1) : b->end) - b->ptr); } return 0; } @@ -4684,50 +4684,50 @@ PerlIOCrlf_set_ptrcnt(pTHX_ PerlIO *f, STDCHAR * ptr, SSize_t cnt) PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf); if (!b->buf) - PerlIO_get_base(f); + PerlIO_get_base(f); if (!ptr) { - if (c->nl) { - ptr = c->nl + 1; - if (ptr == b->end && *c->nl == NATIVE_0xd) { - /* Deferred CR at end of buffer case - we lied about count */ - ptr--; - } - } - else { - ptr = b->end; - } - ptr -= cnt; + if (c->nl) { + ptr = c->nl + 1; + if (ptr == b->end && *c->nl == NATIVE_0xd) { + /* Deferred CR at end of buffer case - we lied about count */ + ptr--; + } + } + else { + ptr = b->end; + } + ptr -= cnt; } else { - NOOP; + NOOP; #if 0 - /* - * Test code - delete when it works ... - */ - IV flags = PerlIOBase(f)->flags; - STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end; - if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == NATIVE_0xd) { - /* Deferred CR at end of buffer case - we lied about count */ - chk--; - } - chk -= cnt; - - if (ptr != chk ) { - Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf - " nl=%p e=%p for %d", (void*)ptr, (void*)chk, - flags, c->nl, b->end, cnt); - } + /* + * Test code - delete when it works ... + */ + IV flags = PerlIOBase(f)->flags; + STDCHAR *chk = (c->nl) ? (c->nl+1) : b->end; + if (ptr+cnt == c->nl && c->nl+1 == b->end && *c->nl == NATIVE_0xd) { + /* Deferred CR at end of buffer case - we lied about count */ + chk--; + } + chk -= cnt; + + if (ptr != chk ) { + Perl_croak(aTHX_ "ptr wrong %p != %p fl=%08" UVxf + " nl=%p e=%p for %d", (void*)ptr, (void*)chk, + flags, c->nl, b->end, cnt); + } #endif } if (c->nl) { - if (ptr > c->nl) { - /* - * They have taken what we lied about - */ - *(c->nl) = NATIVE_0xd; - c->nl = NULL; - ptr++; - } + if (ptr > c->nl) { + /* + * They have taken what we lied about + */ + *(c->nl) = NATIVE_0xd; + c->nl = NULL; + ptr++; + } } b->ptr = ptr; PerlIOBase(f)->flags |= PERLIO_F_RDBUF; @@ -4737,49 +4737,49 @@ SSize_t PerlIOCrlf_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) { if (!(PerlIOBase(f)->flags & PERLIO_F_CRLF)) - return PerlIOBuf_write(aTHX_ f, vbuf, count); + return PerlIOBuf_write(aTHX_ f, vbuf, count); else { - PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); - const STDCHAR *buf = (const STDCHAR *) vbuf; - const STDCHAR * const ebuf = buf + count; - if (!b->buf) - PerlIO_get_base(f); - if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) - return 0; - while (buf < ebuf) { - const STDCHAR * const eptr = b->buf + b->bufsiz; - PerlIOBase(f)->flags |= PERLIO_F_WRBUF; - while (buf < ebuf && b->ptr < eptr) { - if (*buf == '\n') { - if ((b->ptr + 2) > eptr) { - /* - * Not room for both - */ - PerlIO_flush(f); - break; - } - else { - *(b->ptr)++ = NATIVE_0xd; /* CR */ - *(b->ptr)++ = NATIVE_0xa; /* LF */ - buf++; - if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) { - PerlIO_flush(f); - break; - } - } - } - else { - *(b->ptr)++ = *buf++; - } - if (b->ptr >= eptr) { - PerlIO_flush(f); - break; - } - } - } - if (PerlIOBase(f)->flags & PERLIO_F_UNBUF) - PerlIO_flush(f); - return (buf - (STDCHAR *) vbuf); + PerlIOBuf * const b = PerlIOSelf(f, PerlIOBuf); + const STDCHAR *buf = (const STDCHAR *) vbuf; + const STDCHAR * const ebuf = buf + count; + if (!b->buf) + PerlIO_get_base(f); + if (!(PerlIOBase(f)->flags & PERLIO_F_CANWRITE)) + return 0; + while (buf < ebuf) { + const STDCHAR * const eptr = b->buf + b->bufsiz; + PerlIOBase(f)->flags |= PERLIO_F_WRBUF; + while (buf < ebuf && b->ptr < eptr) { + if (*buf == '\n') { + if ((b->ptr + 2) > eptr) { + /* + * Not room for both + */ + PerlIO_flush(f); + break; + } + else { + *(b->ptr)++ = NATIVE_0xd; /* CR */ + *(b->ptr)++ = NATIVE_0xa; /* LF */ + buf++; + if (PerlIOBase(f)->flags & PERLIO_F_LINEBUF) { + PerlIO_flush(f); + break; + } + } + } + else { + *(b->ptr)++ = *buf++; + } + if (b->ptr >= eptr) { + PerlIO_flush(f); + break; + } + } + } + if (PerlIOBase(f)->flags & PERLIO_F_UNBUF) + PerlIO_flush(f); + return (buf - (STDCHAR *) vbuf); } } @@ -4788,8 +4788,8 @@ PerlIOCrlf_flush(pTHX_ PerlIO *f) { PerlIOCrlf * const c = PerlIOSelf(f, PerlIOCrlf); if (c->nl) { - *(c->nl) = NATIVE_0xd; - c->nl = NULL; + *(c->nl) = NATIVE_0xd; + c->nl = NULL; } return PerlIOBuf_flush(aTHX_ f); } @@ -4798,11 +4798,11 @@ IV PerlIOCrlf_binmode(pTHX_ PerlIO *f) { if ((PerlIOBase(f)->flags & PERLIO_F_CRLF)) { - /* In text mode - flush any pending stuff and flip it */ - PerlIOBase(f)->flags &= ~PERLIO_F_CRLF; + /* In text mode - flush any pending stuff and flip it */ + PerlIOBase(f)->flags &= ~PERLIO_F_CRLF; #ifndef PERLIO_USING_CRLF - /* CRLF is unusual case - if this is just the :crlf layer pop it */ - PerlIO_pop(aTHX_ f); + /* CRLF is unusual case - if this is just the :crlf layer pop it */ + PerlIO_pop(aTHX_ f); #endif } return PerlIOBase_binmode(aTHX_ f); @@ -4843,7 +4843,7 @@ PerlIO * Perl_PerlIO_stdin(pTHX) { if (!PL_perlio) { - PerlIO_stdstreams(aTHX); + PerlIO_stdstreams(aTHX); } return (PerlIO*)&PL_perlio[1]; } @@ -4852,7 +4852,7 @@ PerlIO * Perl_PerlIO_stdout(pTHX) { if (!PL_perlio) { - PerlIO_stdstreams(aTHX); + PerlIO_stdstreams(aTHX); } return (PerlIO*)&PL_perlio[2]; } @@ -4861,7 +4861,7 @@ PerlIO * Perl_PerlIO_stderr(pTHX) { if (!PL_perlio) { - PerlIO_stdstreams(aTHX); + PerlIO_stdstreams(aTHX); } return (PerlIO*)&PL_perlio[3]; } @@ -4877,12 +4877,12 @@ PerlIO_getname(PerlIO *f, char *buf) bool exported = FALSE; FILE *stdio = PerlIOSelf(f, PerlIOStdio)->stdio; if (!stdio) { - stdio = PerlIO_exportFILE(f,0); - exported = TRUE; + stdio = PerlIO_exportFILE(f,0); + exported = TRUE; } if (stdio) { - name = fgetname(stdio, buf); - if (exported) PerlIO_releaseFILE(f,stdio); + name = fgetname(stdio, buf); + if (exported) PerlIO_releaseFILE(f,stdio); } return name; #else @@ -4933,7 +4933,7 @@ PerlIO_getc(PerlIO *f) dTHX; STDCHAR buf[1]; if ( 1 == PerlIO_read(f, buf, 1) ) { - return (unsigned char) buf[0]; + return (unsigned char) buf[0]; } return EOF; } @@ -4944,9 +4944,9 @@ PerlIO_ungetc(PerlIO *f, int ch) { dTHX; if (ch != EOF) { - STDCHAR buf = ch; - if (PerlIO_unread(f, &buf, 1) == 1) - return ch; + STDCHAR buf = ch; + if (PerlIO_unread(f, &buf, 1) == 1) + return ch; } return EOF; } @@ -5045,7 +5045,7 @@ PerlIO_tmpfile_flags(int imode) #ifdef WIN32 const int fd = win32_tmpfd_mode(imode); if (fd >= 0) - f = PerlIO_fdopen(fd, "w+b"); + f = PerlIO_fdopen(fd, "w+b"); #elif ! defined(OS2) int fd = -1; char tempname[] = "/tmp/PerlIO_XXXXXX"; @@ -5054,16 +5054,16 @@ PerlIO_tmpfile_flags(int imode) int old_umask = umask(0177); imode &= ~MKOSTEMP_MODE_MASK; if (tmpdir && *tmpdir) { - /* if TMPDIR is set and not empty, we try that first */ - sv = newSVpv(tmpdir, 0); - sv_catpv(sv, tempname + 4); - fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); + /* if TMPDIR is set and not empty, we try that first */ + sv = newSVpv(tmpdir, 0); + sv_catpv(sv, tempname + 4); + fd = Perl_my_mkostemp_cloexec(SvPVX(sv), imode | O_VMS_DELETEONCLOSE); } if (fd < 0) { - SvREFCNT_dec(sv); - sv = NULL; - /* else we try /tmp */ - fd = Perl_my_mkostemp_cloexec(tempname, imode | O_VMS_DELETEONCLOSE); + SvREFCNT_dec(sv); + sv = NULL; + /* else we try /tmp */ + fd = Perl_my_mkostemp_cloexec(tempname, imode | O_VMS_DELETEONCLOSE); } if (fd < 0) { /* Try cwd */ @@ -5078,10 +5078,10 @@ PerlIO_tmpfile_flags(int imode) int writing = 1; (void)PerlIO_intmode2str(imode | MKOSTEMP_MODES, mode, &writing); f = PerlIO_fdopen(fd, mode); - if (f) - PerlIOBase(f)->flags |= PERLIO_F_TEMP; + if (f) + PerlIOBase(f)->flags |= PERLIO_F_TEMP; # ifndef VMS - PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); + PerlLIO_unlink(sv ? SvPVX_const(sv) : tempname); # endif } SvREFCNT_dec(sv); @@ -5089,7 +5089,7 @@ PerlIO_tmpfile_flags(int imode) FILE * const stdio = PerlSIO_tmpfile(); if (stdio) - f = PerlIO_fdopen(fileno(stdio), "w+"); + f = PerlIO_fdopen(fileno(stdio), "w+"); #endif /* else WIN32 */ return f; @@ -5100,7 +5100,7 @@ Perl_PerlIO_save_errno(pTHX_ PerlIO *f) { PERL_UNUSED_CONTEXT; if (!PerlIOValid(f)) - return; + return; PerlIOBase(f)->err = errno; #ifdef VMS PerlIOBase(f)->os_err = vaxc$errno; @@ -5116,7 +5116,7 @@ Perl_PerlIO_restore_errno(pTHX_ PerlIO *f) { PERL_UNUSED_CONTEXT; if (!PerlIOValid(f)) - return; + return; SETERRNO(PerlIOBase(f)->err, PerlIOBase(f)->os_err); #ifdef OS2 Perl_rc = PerlIOBase(f)->os_err); @@ -5144,17 +5144,17 @@ Perl_PerlIO_context_layers(pTHX_ const char *mode) */ if (!PL_curcop) - return NULL; + return NULL; if (mode && mode[0] != 'r') { - if (PL_curcop->cop_hints & HINT_LEXICAL_IO_OUT) - direction = "open>"; + if (PL_curcop->cop_hints & HINT_LEXICAL_IO_OUT) + direction = "open>"; } else { - if (PL_curcop->cop_hints & HINT_LEXICAL_IO_IN) - direction = "open<"; + if (PL_curcop->cop_hints & HINT_LEXICAL_IO_IN) + direction = "open<"; } if (!direction) - return NULL; + return NULL; layers = cop_hints_fetch_pvn(PL_curcop, direction, 5, 0, 0); @@ -5169,13 +5169,13 @@ int PerlIO_setpos(PerlIO *f, SV *pos) { if (SvOK(pos)) { - if (f) { - dTHX; - STRLEN len; - const Off_t * const posn = (Off_t *) SvPV(pos, len); - if(len == sizeof(Off_t)) - return PerlIO_seek(f, *posn, SEEK_SET); - } + if (f) { + dTHX; + STRLEN len; + const Off_t * const posn = (Off_t *) SvPV(pos, len); + if(len == sizeof(Off_t)) + return PerlIO_seek(f, *posn, SEEK_SET); + } } SETERRNO(EINVAL, SS_IVCHAN); return -1; @@ -5186,17 +5186,17 @@ int PerlIO_setpos(PerlIO *f, SV *pos) { if (SvOK(pos)) { - if (f) { - dTHX; - STRLEN len; - Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len); - if(len == sizeof(Fpos_t)) + if (f) { + dTHX; + STRLEN len; + Fpos_t * const fpos = (Fpos_t *) SvPV(pos, len); + if(len == sizeof(Fpos_t)) # if defined(USE_64_BIT_STDIO) && defined(USE_FSETPOS64) - return fsetpos64(f, fpos); + return fsetpos64(f, fpos); # else - return fsetpos(f, fpos); + return fsetpos(f, fpos); # endif - } + } } SETERRNO(EINVAL, SS_IVCHAN); return -1; diff --git a/perlio.h b/perlio.h index 836ff6f72f4b..f444fa86d017 100644 --- a/perlio.h +++ b/perlio.h @@ -69,9 +69,9 @@ typedef PerlIOl *PerlIO; PERL_CALLCONV void PerlIO_define_layer(pTHX_ PerlIO_funcs *tab); PERL_CALLCONV PerlIO_funcs *PerlIO_find_layer(pTHX_ const char *name, STRLEN len, - int load); + int load); PERL_CALLCONV PerlIO *PerlIO_push(pTHX_ PerlIO *f, PERLIO_FUNCS_DECL(*tab), - const char *mode, SV *arg); + const char *mode, SV *arg); PERL_CALLCONV void PerlIO_pop(pTHX_ PerlIO *f); PERL_CALLCONV AV* PerlIO_get_layers(pTHX_ PerlIO *f); PERL_CALLCONV void PerlIO_clone(pTHX_ PerlInterpreter *proto, @@ -182,8 +182,8 @@ PERL_CALLCONV PerlIO *PerlIO_open(const char *, const char *); #endif #ifndef PerlIO_openn PERL_CALLCONV PerlIO *PerlIO_openn(pTHX_ const char *layers, const char *mode, - int fd, int imode, int perm, PerlIO *old, - int narg, SV **arg); + int fd, int imode, int perm, PerlIO *old, + int narg, SV **arg); #endif #ifndef PerlIO_eof PERL_CALLCONV int PerlIO_eof(PerlIO *); @@ -308,11 +308,11 @@ PERL_CALLCONV int PerlIO_isutf8(PerlIO *); #endif #ifndef PerlIO_apply_layers PERL_CALLCONV int PerlIO_apply_layers(pTHX_ PerlIO *f, const char *mode, - const char *names); + const char *names); #endif #ifndef PerlIO_binmode PERL_CALLCONV int PerlIO_binmode(pTHX_ PerlIO *f, int iotype, int omode, - const char *names); + const char *names); #endif #ifndef PerlIO_getname PERL_CALLCONV char *PerlIO_getname(PerlIO *, char *); diff --git a/perliol.h b/perliol.h index 66100614b20e..691e09533f78 100644 --- a/perliol.h +++ b/perliol.h @@ -21,10 +21,10 @@ struct _PerlIO_funcs { IV (*Pushed) (pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab); IV (*Popped) (pTHX_ PerlIO *f); PerlIO *(*Open) (pTHX_ PerlIO_funcs *tab, - PerlIO_list_t *layers, IV n, - const char *mode, - int fd, int imode, int perm, - PerlIO *old, int narg, SV **args); + PerlIO_list_t *layers, IV n, + const char *mode, + int fd, int imode, int perm, + PerlIO *old, int narg, SV **args); IV (*Binmode)(pTHX_ PerlIO *f); SV *(*Getarg) (pTHX_ PerlIO *f, CLONE_PARAMS *param, int flags); IV (*Fileno) (pTHX_ PerlIO *f); @@ -144,7 +144,7 @@ typedef struct { } PerlIOBuf; PERL_CALLCONV int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode, - PerlIO_list_t *layers, IV n, IV max); + PerlIO_list_t *layers, IV n, IV max); PERL_CALLCONV int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names); PERL_CALLCONV PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def); diff --git a/perlvars.h b/perlvars.h index 3bfd46fe9415..0518c0fe4ab6 100644 --- a/perlvars.h +++ b/perlvars.h @@ -38,9 +38,9 @@ use the variable. PERLVAR(G, op_mutex, perl_mutex) /* Mutex for op refcounting */ #endif PERLVARI(G, curinterp, PerlInterpreter *, NULL) - /* currently running interpreter - * (initial parent interpreter under - * useithreads) */ + /* currently running interpreter + * (initial parent interpreter under + * useithreads) */ #if defined(USE_ITHREADS) PERLVAR(G, thr_key, perl_key) /* key to retrieve per-thread struct */ #endif @@ -57,7 +57,7 @@ PERLVARI(G, sig_handlers_initted, int, 0) #endif #ifdef FAKE_PERSISTENT_SIGNAL_HANDLERS PERLVARA(G, sig_ignoring, SIG_SIZE, int) - /* which signals we are ignoring */ + /* which signals we are ignoring */ #endif #ifdef FAKE_DEFAULT_SIGNAL_HANDLERS PERLVARA(G, sig_defaulting, SIG_SIZE, int) @@ -190,9 +190,9 @@ PERLVARI(G, veto_cleanup, int, FALSE) /* exit without cleanup */ Function pointer, pointing at a function used to handle extended keywords. The function should be declared as - int keyword_plugin_function(pTHX_ - char *keyword_ptr, STRLEN keyword_len, - OP **op_ptr) + int keyword_plugin_function(pTHX_ + char *keyword_ptr, STRLEN keyword_len, + OP **op_ptr) The function is called from the tokeniser, whenever a possible keyword is seen. C points at the word in the parser's input diff --git a/perly.c b/perly.c index ad79c49c4998..20854ae542b3 100644 --- a/perly.c +++ b/perly.c @@ -93,15 +93,15 @@ typedef signed char yysigned_char; # define YYDPRINTF(Args) \ do { \ if (yydebug) \ - YYFPRINTF Args; \ + YYFPRINTF Args; \ } while (0) # define YYDSYMPRINTF(Title, Token, Value) \ do { \ if (yydebug) { \ - YYFPRINTF (Perl_debug_log, "%s ", Title); \ - yysymprint (aTHX_ Perl_debug_log, Token, Value); \ - YYFPRINTF (Perl_debug_log, "\n"); \ + YYFPRINTF (Perl_debug_log, "%s ", Title); \ + yysymprint (aTHX_ Perl_debug_log, Token, Value); \ + YYFPRINTF (Perl_debug_log, "\n"); \ } \ } while (0) @@ -114,15 +114,15 @@ yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyva { PERL_UNUSED_CONTEXT; if (yytype < YYNTOKENS) { - YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); + YYFPRINTF (yyoutput, "token %s (", yytname[yytype]); # ifdef YYPRINT - YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); + YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep); # else - YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival); + YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival); # endif } else - YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); + YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]); YYFPRINTF (yyoutput, ")"); } @@ -139,36 +139,36 @@ yy_stack_print (pTHX_ const yy_parser *parser) min = parser->ps - 8 + 1; if (min <= parser->stack) - min = parser->stack + 1; + min = parser->stack + 1; PerlIO_printf(Perl_debug_log, "\nindex:"); for (ps = min; ps <= parser->ps; ps++) - PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack)); + PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack)); PerlIO_printf(Perl_debug_log, "\nstate:"); for (ps = min; ps <= parser->ps; ps++) - PerlIO_printf(Perl_debug_log, " %8d", ps->state); + PerlIO_printf(Perl_debug_log, " %8d", ps->state); PerlIO_printf(Perl_debug_log, "\ntoken:"); for (ps = min; ps <= parser->ps; ps++) - PerlIO_printf(Perl_debug_log, " %8.8s", ps->name); + PerlIO_printf(Perl_debug_log, " %8.8s", ps->name); PerlIO_printf(Perl_debug_log, "\nvalue:"); for (ps = min; ps <= parser->ps; ps++) { - switch (yy_type_tab[yystos[ps->state]]) { - case toketype_opval: - PerlIO_printf(Perl_debug_log, " %8.8s", - ps->val.opval - ? PL_op_name[ps->val.opval->op_type] - : "(Nullop)" - ); - break; - case toketype_ival: - PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival); - break; - default: - PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival); - } + switch (yy_type_tab[yystos[ps->state]]) { + case toketype_opval: + PerlIO_printf(Perl_debug_log, " %8.8s", + ps->val.opval + ? PL_op_name[ps->val.opval->op_type] + : "(Nullop)" + ); + break; + case toketype_ival: + PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival); + break; + default: + PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival); + } } PerlIO_printf(Perl_debug_log, "\n\n"); } @@ -176,7 +176,7 @@ yy_stack_print (pTHX_ const yy_parser *parser) # define YY_STACK_PRINT(parser) \ do { \ if (yydebug && DEBUG_v_TEST) \ - yy_stack_print (aTHX_ parser); \ + yy_stack_print (aTHX_ parser); \ } while (0) @@ -190,15 +190,15 @@ yy_reduce_print (pTHX_ int yyrule) int yyi; const unsigned int yylineno = yyrline[yyrule]; YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ", - yyrule - 1, yylineno); + yyrule - 1, yylineno); /* Print the symbols being reduced, and their result. */ #if PERL_BISON_VERSION >= 30000 /* 3.0+ */ for (yyi = 0; yyi < yyr2[yyrule]; yyi++) - YYFPRINTF (Perl_debug_log, "%s ", + YYFPRINTF (Perl_debug_log, "%s ", yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]); #else for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++) - YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]); + YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]); #endif YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]); } @@ -206,7 +206,7 @@ yy_reduce_print (pTHX_ int yyrule) # define YY_REDUCE_PRINT(Rule) \ do { \ if (yydebug) \ - yy_reduce_print (aTHX_ Rule); \ + yy_reduce_print (aTHX_ Rule); \ } while (0) #else /* !DEBUGGING */ @@ -226,32 +226,32 @@ S_clear_yystack(pTHX_ const yy_parser *parser) int i = 0; if (!parser->stack) - return; + return; YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n")); for (i=0; i< parser->yylen; i++) { - SvREFCNT_dec(ps[-i].compcv); + SvREFCNT_dec(ps[-i].compcv); } ps -= parser->yylen; /* now free whole the stack, including the just-reduced ops */ while (ps > parser->stack) { - LEAVE_SCOPE(ps->savestack_ix); - if (yy_type_tab[yystos[ps->state]] == toketype_opval - && ps->val.opval) - { - if (ps->compcv && (ps->compcv != PL_compcv)) { - PL_compcv = ps->compcv; - PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); - PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv)); - } - YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); - op_free(ps->val.opval); - } - SvREFCNT_dec(ps->compcv); - ps--; + LEAVE_SCOPE(ps->savestack_ix); + if (yy_type_tab[yystos[ps->state]] == toketype_opval + && ps->val.opval) + { + if (ps->compcv && (ps->compcv != PL_compcv)) { + PL_compcv = ps->compcv; + PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1); + PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv)); + } + YYDPRINTF ((Perl_debug_log, "(freeing op)\n")); + op_free(ps->val.opval); + } + SvREFCNT_dec(ps->compcv); + ps--; } Safefree(parser->stack); @@ -279,7 +279,7 @@ Perl_yyparse (pTHX_ int gramtype) #define YYPUSHSTACK parser->ps = ++ps /* The variable used to return semantic value and location from the - action routines: ie $$. */ + action routines: ie $$. */ YYSTYPE yyval; YYDPRINTF ((Perl_debug_log, "Starting parse\n")); @@ -592,7 +592,7 @@ Perl_yyparse (pTHX_ int gramtype) yyacceptlab: yyresult = 0; for (ps=parser->ps; ps > parser->stack; ps--) { - SvREFCNT_dec(ps->compcv); + SvREFCNT_dec(ps->compcv); } parser->ps = parser->stack; /* disable cleanup */ goto yyreturn; diff --git a/plan9/plan9.c b/plan9/plan9.c index 02ef76c97bbb..9872306d7e82 100644 --- a/plan9/plan9.c +++ b/plan9/plan9.c @@ -11,18 +11,18 @@ #define SHIFT 20 int fpclassify(double d) { - FPdbleword x; - - /* order matters: only isNaN can operate on NaN */ - if ( isNaN(d) ) - return FP_NAN; - else if ( isInf(d, 0) ) - return FP_INFINITE; - else if ( d == 0 ) - return FP_ZERO; - - x.x = fabs(d); - return (x.hi >> SHIFT) ? FP_NORMAL : FP_SUBNORMAL; + FPdbleword x; + + /* order matters: only isNaN can operate on NaN */ + if ( isNaN(d) ) + return FP_NAN; + else if ( isInf(d, 0) ) + return FP_INFINITE; + else if ( d == 0 ) + return FP_ZERO; + + x.x = fabs(d); + return (x.hi >> SHIFT) ? FP_NORMAL : FP_SUBNORMAL; } /* Functions mentioned in /sys/include/ape/sys/socket.h but not implemented */ diff --git a/plan9/plan9ish.h b/plan9/plan9ish.h index 7fd8c7e5dbff..a5a318e70423 100644 --- a/plan9/plan9ish.h +++ b/plan9/plan9ish.h @@ -105,7 +105,7 @@ #define BIT_BUCKET "/dev/null" #define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) PERLIO_INIT; MALLOC_INIT + MALLOC_CHECK_TAINT2(*c,*v) PERLIO_INIT; MALLOC_INIT #define dXSUB_SYS dNOOP #define PERL_SYS_TERM_BODY() PERLIO_TERM; MALLOC_TERM diff --git a/pp.h b/pp.h index da4e9da7d54f..cea956db4078 100644 --- a/pp.h +++ b/pp.h @@ -70,7 +70,7 @@ value for the OP, but some use it for other purposes. I32 * mark_stack_entry; \ if (UNLIKELY((mark_stack_entry = ++PL_markstack_ptr) \ == PL_markstack_max)) \ - mark_stack_entry = markstack_grow(); \ + mark_stack_entry = markstack_grow(); \ *mark_stack_entry = (I32)((p) - PL_stack_base); \ DEBUG_s(DEBUG_v(PerlIO_printf(Perl_debug_log, \ "MARK push %p %" IVdf "\n", \ @@ -520,7 +520,7 @@ Does not use C. See also C>, C> and C>. #define dPOPXiirl(X) IV right = POPi; IV left = CAT2(X,i) #define USE_LEFT(sv) \ - (SvOK(sv) || !(PL_op->op_flags & OPf_STACKED)) + (SvOK(sv) || !(PL_op->op_flags & OPf_STACKED)) #define dPOPXiirl_ul_nomg(X) \ IV right = (sp--, SvIV_nomg(TOPp1s)); \ SV *leftsv = CAT2(X,s); \ @@ -554,18 +554,18 @@ Does not use C. See also C>, C> and C>. #define SWITCHSTACK(f,t) \ STMT_START { \ - AvFILLp(f) = sp - PL_stack_base; \ - PL_stack_base = AvARRAY(t); \ - PL_stack_max = PL_stack_base + AvMAX(t); \ - sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ - PL_curstack = t; \ + AvFILLp(f) = sp - PL_stack_base; \ + PL_stack_base = AvARRAY(t); \ + PL_stack_max = PL_stack_base + AvMAX(t); \ + sp = PL_stack_sp = PL_stack_base + AvFILLp(t); \ + PL_curstack = t; \ } STMT_END #define EXTEND_MORTAL(n) \ STMT_START { \ - SSize_t eMiX = PL_tmps_ix + (n); \ - if (UNLIKELY(eMiX >= PL_tmps_max)) \ - (void)Perl_tmps_grow_p(aTHX_ eMiX); \ + SSize_t eMiX = PL_tmps_ix + (n); \ + if (UNLIKELY(eMiX >= PL_tmps_max)) \ + (void)Perl_tmps_grow_p(aTHX_ eMiX); \ } STMT_END #define AMGf_noright 1 @@ -581,14 +581,14 @@ Does not use C. See also C>, C> and C>. /* do SvGETMAGIC on the stack args before checking for overload */ #define tryAMAGICun_MG(method, flags) STMT_START { \ - if ( UNLIKELY((SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG))) \ - && Perl_try_amagic_un(aTHX_ method, flags)) \ - return NORMAL; \ + if ( UNLIKELY((SvFLAGS(TOPs) & (SVf_ROK|SVs_GMG))) \ + && Perl_try_amagic_un(aTHX_ method, flags)) \ + return NORMAL; \ } STMT_END #define tryAMAGICbin_MG(method, flags) STMT_START { \ - if ( UNLIKELY(((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG))) \ - && Perl_try_amagic_bin(aTHX_ method, flags)) \ - return NORMAL; \ + if ( UNLIKELY(((SvFLAGS(TOPm1s)|SvFLAGS(TOPs)) & (SVf_ROK|SVs_GMG))) \ + && Perl_try_amagic_bin(aTHX_ method, flags)) \ + return NORMAL; \ } STMT_END #define AMG_CALLunary(sv,meth) \ @@ -599,16 +599,16 @@ Does not use C. See also C>, C> and C>. #define tryAMAGICunTARGETlist(meth, jump) \ STMT_START { \ - dSP; \ - SV *tmpsv; \ - SV *arg= *sp; \ + dSP; \ + SV *tmpsv; \ + SV *arg= *sp; \ U8 gimme = GIMME_V; \ - if (UNLIKELY(SvAMAGIC(arg) && \ - (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \ - AMGf_want_list | AMGf_noright \ - |AMGf_unary)))) \ + if (UNLIKELY(SvAMAGIC(arg) && \ + (tmpsv = amagic_call(arg, &PL_sv_undef, meth, \ + AMGf_want_list | AMGf_noright \ + |AMGf_unary)))) \ { \ - SPAGAIN; \ + SPAGAIN; \ if (gimme == G_VOID) { \ NOOP; \ } \ @@ -629,25 +629,25 @@ Does not use C. See also C>, C> and C>. sp--; \ SETTARG; \ } \ - PUTBACK; \ - if (jump) { \ - OP *jump_o = NORMAL->op_next; \ - while (jump_o->op_type == OP_NULL) \ - jump_o = jump_o->op_next; \ - assert(jump_o->op_type == OP_ENTERSUB); \ - (void)POPMARK; \ - return jump_o->op_next; \ - } \ - return NORMAL; \ - } \ + PUTBACK; \ + if (jump) { \ + OP *jump_o = NORMAL->op_next; \ + while (jump_o->op_type == OP_NULL) \ + jump_o = jump_o->op_next; \ + assert(jump_o->op_type == OP_ENTERSUB); \ + (void)POPMARK; \ + return jump_o->op_next; \ + } \ + return NORMAL; \ + } \ } STMT_END /* This is no longer used anywhere in the core. You might wish to consider calling amagic_deref_call() directly, as it has a cleaner interface. */ #define tryAMAGICunDEREF(meth) \ STMT_START { \ - sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ - SPAGAIN; \ + sv = amagic_deref_call(*sp, CAT2(meth,_amg)); \ + SPAGAIN; \ } STMT_END @@ -682,13 +682,13 @@ True if this op will be the return value of an lvalue subroutine /* Used in various places that need to dereference a glob or globref */ # define MAYBE_DEREF_GV_flags(sv,phlags) \ ( \ - (void)(phlags & SV_GMAGIC && (SvGETMAGIC(sv),0)), \ - isGV_with_GP(sv) \ - ? (GV *)(sv) \ - : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \ - (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \ - ? (GV *)SvRV(sv) \ - : NULL \ + (void)(phlags & SV_GMAGIC && (SvGETMAGIC(sv),0)), \ + isGV_with_GP(sv) \ + ? (GV *)(sv) \ + : SvROK(sv) && SvTYPE(SvRV(sv)) <= SVt_PVLV && \ + (SvGETMAGIC(SvRV(sv)), isGV_with_GP(SvRV(sv))) \ + ? (GV *)SvRV(sv) \ + : NULL \ ) # define MAYBE_DEREF_GV(sv) MAYBE_DEREF_GV_flags(sv,SV_GMAGIC) # define MAYBE_DEREF_GV_nomg(sv) MAYBE_DEREF_GV_flags(sv,0) diff --git a/pp_ctl.c b/pp_ctl.c index ed451c02e855..654ecca270b1 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -53,22 +53,22 @@ PP(pp_wantarray) EXTEND(SP, 1); if (PL_op->op_private & OPpOFFBYONE) { - if (!(cx = caller_cx(1,NULL))) RETPUSHUNDEF; + if (!(cx = caller_cx(1,NULL))) RETPUSHUNDEF; } else { cxix = dopopto_cursub(); if (cxix < 0) - RETPUSHUNDEF; + RETPUSHUNDEF; cx = &cxstack[cxix]; } switch (cx->blk_gimme) { case G_ARRAY: - RETPUSHYES; + RETPUSHYES; case G_SCALAR: - RETPUSHNO; + RETPUSHNO; default: - RETPUSHUNDEF; + RETPUSHUNDEF; } } @@ -90,20 +90,20 @@ PP(pp_regcomp) bool is_bare_re= FALSE; if (PL_op->op_flags & OPf_STACKED) { - dMARK; - nargs = SP - MARK; - args = ++MARK; + dMARK; + nargs = SP - MARK; + args = ++MARK; } else { - nargs = 1; - args = SP; + nargs = 1; + args = SP; } /* prevent recompiling under /o and ithreads. */ #if defined(USE_ITHREADS) if (pm->op_pmflags & PMf_KEEP && PM_GETRE(pm)) { - SP = args-1; - RETURN; + SP = args-1; + RETURN; } #endif @@ -112,57 +112,57 @@ PP(pp_regcomp) eng = re ? RX_ENGINE(re) : current_re_engine(); new_re = (eng->op_comp - ? eng->op_comp - : &Perl_re_op_compile - )(aTHX_ args, nargs, pm->op_code_list, eng, re, - &is_bare_re, + ? eng->op_comp + : &Perl_re_op_compile + )(aTHX_ args, nargs, pm->op_code_list, eng, re, + &is_bare_re, (pm->op_pmflags & RXf_PMf_FLAGCOPYMASK), - pm->op_pmflags | - (PL_op->op_flags & OPf_SPECIAL ? PMf_USE_RE_EVAL : 0)); + pm->op_pmflags | + (PL_op->op_flags & OPf_SPECIAL ? PMf_USE_RE_EVAL : 0)); if (pm->op_pmflags & PMf_HAS_CV) - ReANY(new_re)->qr_anoncv - = (CV*) SvREFCNT_inc(PAD_SV(PL_op->op_targ)); + ReANY(new_re)->qr_anoncv + = (CV*) SvREFCNT_inc(PAD_SV(PL_op->op_targ)); if (is_bare_re) { - REGEXP *tmp; - /* The match's LHS's get-magic might need to access this op's regexp - (e.g. $' =~ /$re/ while foo; see bug 70764). So we must call - get-magic now before we replace the regexp. Hopefully this hack can - be replaced with the approach described at - http://www.nntp.perl.org/group/perl.perl5.porters/2007/03/msg122415.html - some day. */ - if (pm->op_type == OP_MATCH) { - SV *lhs; - const bool was_tainted = TAINT_get; - if (pm->op_flags & OPf_STACKED) - lhs = args[-1]; - else if (pm->op_targ) - lhs = PAD_SV(pm->op_targ); - else lhs = DEFSV; - SvGETMAGIC(lhs); - /* Restore the previous value of PL_tainted (which may have been - modified by get-magic), to avoid incorrectly setting the - RXf_TAINTED flag with RX_TAINT_on further down. */ - TAINT_set(was_tainted); + REGEXP *tmp; + /* The match's LHS's get-magic might need to access this op's regexp + (e.g. $' =~ /$re/ while foo; see bug 70764). So we must call + get-magic now before we replace the regexp. Hopefully this hack can + be replaced with the approach described at + http://www.nntp.perl.org/group/perl.perl5.porters/2007/03/msg122415.html + some day. */ + if (pm->op_type == OP_MATCH) { + SV *lhs; + const bool was_tainted = TAINT_get; + if (pm->op_flags & OPf_STACKED) + lhs = args[-1]; + else if (pm->op_targ) + lhs = PAD_SV(pm->op_targ); + else lhs = DEFSV; + SvGETMAGIC(lhs); + /* Restore the previous value of PL_tainted (which may have been + modified by get-magic), to avoid incorrectly setting the + RXf_TAINTED flag with RX_TAINT_on further down. */ + TAINT_set(was_tainted); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was_tainted); #endif - } - tmp = reg_temp_copy(NULL, new_re); - ReREFCNT_dec(new_re); - new_re = tmp; + } + tmp = reg_temp_copy(NULL, new_re); + ReREFCNT_dec(new_re); + new_re = tmp; } if (re != new_re) { - ReREFCNT_dec(re); - PM_SETRE(pm, new_re); + ReREFCNT_dec(re); + PM_SETRE(pm, new_re); } assert(TAINTING_get || !TAINT_get); if (TAINT_get) { - SvTAINTED_on((SV*)new_re); + SvTAINTED_on((SV*)new_re); RX_TAINT_on(new_re); } @@ -179,7 +179,7 @@ PP(pp_regcomp) /* can't change the optree at runtime either */ /* PMf_KEEP is handled differently under threads to avoid these problems */ if (pm->op_pmflags & PMf_KEEP) { - cLOGOP->op_first->op_next = PL_op->op_next; + cLOGOP->op_first->op_next = PL_op->op_next; } #endif @@ -204,82 +204,82 @@ PP(pp_substcont) PERL_ASYNC_CHECK(); if(old != rx) { - if(old) - ReREFCNT_dec(old); - PM_SETRE(pm,ReREFCNT_inc(rx)); + if(old) + ReREFCNT_dec(old); + PM_SETRE(pm,ReREFCNT_inc(rx)); } rxres_restore(&cx->sb_rxres, rx); if (cx->sb_iters++) { - const SSize_t saviters = cx->sb_iters; - if (cx->sb_iters > cx->sb_maxiters) - DIE(aTHX_ "Substitution loop"); + const SSize_t saviters = cx->sb_iters; + if (cx->sb_iters > cx->sb_maxiters) + DIE(aTHX_ "Substitution loop"); - SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */ + SvGETMAGIC(TOPs); /* possibly clear taint on $1 etc: #67962 */ - /* See "how taint works" above pp_subst() */ - sv_catsv_nomg(dstr, POPs); - if (UNLIKELY(TAINT_get)) - cx->sb_rxtainted |= SUBST_TAINT_REPL; - if (CxONCE(cx) || s < orig || + /* See "how taint works" above pp_subst() */ + sv_catsv_nomg(dstr, POPs); + if (UNLIKELY(TAINT_get)) + cx->sb_rxtainted |= SUBST_TAINT_REPL; + if (CxONCE(cx) || s < orig || !CALLREGEXEC(rx, s, cx->sb_strend, orig, - (s == m), cx->sb_targ, NULL, + (s == m), cx->sb_targ, NULL, (REXEC_IGNOREPOS|REXEC_NOT_FIRST|REXEC_FAIL_ON_UNDERFLOW))) - { - SV *targ = cx->sb_targ; - - assert(cx->sb_strend >= s); - if(cx->sb_strend > s) { - if (DO_UTF8(dstr) && !SvUTF8(targ)) - sv_catpvn_nomg_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv); - else - sv_catpvn_nomg(dstr, s, cx->sb_strend - s); - } - if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ - cx->sb_rxtainted |= SUBST_TAINT_PAT; - - if (pm->op_pmflags & PMf_NONDESTRUCT) { - PUSHs(dstr); - /* From here on down we're using the copy, and leaving the - original untouched. */ - targ = dstr; - } - else { - SV_CHECK_THINKFIRST_COW_DROP(targ); - if (isGV(targ)) Perl_croak_no_modify(); - SvPV_free(targ); - SvPV_set(targ, SvPVX(dstr)); - SvCUR_set(targ, SvCUR(dstr)); - SvLEN_set(targ, SvLEN(dstr)); - if (DO_UTF8(dstr)) - SvUTF8_on(targ); - SvPV_set(dstr, NULL); - - PL_tainted = 0; - mPUSHi(saviters - 1); - - (void)SvPOK_only_UTF8(targ); - } - - /* update the taint state of various variables in - * preparation for final exit. - * See "how taint works" above pp_subst() */ - if (TAINTING_get) { - if ((cx->sb_rxtainted & SUBST_TAINT_PAT) || - ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) - == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) - ) - (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */ - - if (!(cx->sb_rxtainted & SUBST_TAINT_BOOLRET) - && (cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT)) - ) - SvTAINTED_on(TOPs); /* taint return value */ - /* needed for mg_set below */ - TAINT_set( + { + SV *targ = cx->sb_targ; + + assert(cx->sb_strend >= s); + if(cx->sb_strend > s) { + if (DO_UTF8(dstr) && !SvUTF8(targ)) + sv_catpvn_nomg_utf8_upgrade(dstr, s, cx->sb_strend - s, nsv); + else + sv_catpvn_nomg(dstr, s, cx->sb_strend - s); + } + if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ + cx->sb_rxtainted |= SUBST_TAINT_PAT; + + if (pm->op_pmflags & PMf_NONDESTRUCT) { + PUSHs(dstr); + /* From here on down we're using the copy, and leaving the + original untouched. */ + targ = dstr; + } + else { + SV_CHECK_THINKFIRST_COW_DROP(targ); + if (isGV(targ)) Perl_croak_no_modify(); + SvPV_free(targ); + SvPV_set(targ, SvPVX(dstr)); + SvCUR_set(targ, SvCUR(dstr)); + SvLEN_set(targ, SvLEN(dstr)); + if (DO_UTF8(dstr)) + SvUTF8_on(targ); + SvPV_set(dstr, NULL); + + PL_tainted = 0; + mPUSHi(saviters - 1); + + (void)SvPOK_only_UTF8(targ); + } + + /* update the taint state of various variables in + * preparation for final exit. + * See "how taint works" above pp_subst() */ + if (TAINTING_get) { + if ((cx->sb_rxtainted & SUBST_TAINT_PAT) || + ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) + == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) + ) + (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */ + + if (!(cx->sb_rxtainted & SUBST_TAINT_BOOLRET) + && (cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT)) + ) + SvTAINTED_on(TOPs); /* taint return value */ + /* needed for mg_set below */ + TAINT_set( cBOOL(cx->sb_rxtainted & - (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL)) + (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL)) ); /* sv_magic(), when adding magic (e.g.taint magic), also @@ -299,42 +299,42 @@ PP(pp_substcont) } } - SvTAINT(TARG); - } - /* PL_tainted must be correctly set for this mg_set */ - SvSETMAGIC(TARG); - TAINT_NOT; + SvTAINT(TARG); + } + /* PL_tainted must be correctly set for this mg_set */ + SvSETMAGIC(TARG); + TAINT_NOT; - CX_LEAVE_SCOPE(cx); - CX_POPSUBST(cx); + CX_LEAVE_SCOPE(cx); + CX_POPSUBST(cx); CX_POP(cx); - PERL_ASYNC_CHECK(); - RETURNOP(pm->op_next); - NOT_REACHED; /* NOTREACHED */ - } - cx->sb_iters = saviters; + PERL_ASYNC_CHECK(); + RETURNOP(pm->op_next); + NOT_REACHED; /* NOTREACHED */ + } + cx->sb_iters = saviters; } if (RX_MATCH_COPIED(rx) && RX_SUBBEG(rx) != orig) { - m = s; - s = orig; + m = s; + s = orig; assert(!RX_SUBOFFSET(rx)); - cx->sb_orig = orig = RX_SUBBEG(rx); - s = orig + (m - s); - cx->sb_strend = s + (cx->sb_strend - m); + cx->sb_orig = orig = RX_SUBBEG(rx); + s = orig + (m - s); + cx->sb_strend = s + (cx->sb_strend - m); } cx->sb_m = m = RX_OFFS(rx)[0].start + orig; if (m > s) { - if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ)) - sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv); - else - sv_catpvn_nomg(dstr, s, m-s); + if (DO_UTF8(dstr) && !SvUTF8(cx->sb_targ)) + sv_catpvn_nomg_utf8_upgrade(dstr, s, m - s, nsv); + else + sv_catpvn_nomg(dstr, s, m-s); } cx->sb_s = RX_OFFS(rx)[0].end + orig; { /* Update the pos() information. */ - SV * const sv - = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ; - MAGIC *mg; + SV * const sv + = (pm->op_pmflags & PMf_NONDESTRUCT) ? cx->sb_dstr : cx->sb_targ; + MAGIC *mg; /* the string being matched against may no longer be a string, * e.g. $_=0; s/.../$_++/ge */ @@ -342,31 +342,31 @@ PP(pp_substcont) if (!SvPOK(sv)) SvPV_force_nomg_nolen(sv); - if (!(mg = mg_find_mglob(sv))) { - mg = sv_magicext_mglob(sv); - } - MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig); + if (!(mg = mg_find_mglob(sv))) { + mg = sv_magicext_mglob(sv); + } + MgBYTEPOS_set(mg, sv, SvPVX(sv), m - orig); } if (old != rx) - (void)ReREFCNT_inc(rx); + (void)ReREFCNT_inc(rx); /* update the taint state of various variables in preparation * for calling the code block. * See "how taint works" above pp_subst() */ if (TAINTING_get) { - if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ - cx->sb_rxtainted |= SUBST_TAINT_PAT; + if (RX_MATCH_TAINTED(rx)) /* run time pattern taint, eg locale */ + cx->sb_rxtainted |= SUBST_TAINT_PAT; - if ((cx->sb_rxtainted & SUBST_TAINT_PAT) || - ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) - == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) - ) - (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */ + if ((cx->sb_rxtainted & SUBST_TAINT_PAT) || + ((cx->sb_rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) + == (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) + ) + (RX_MATCH_TAINTED_on(rx)); /* taint $1 et al */ - if (cx->sb_iters > 1 && (cx->sb_rxtainted & - (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))) - SvTAINTED_on((pm->op_pmflags & PMf_NONDESTRUCT) - ? cx->sb_dstr : cx->sb_targ); - TAINT_NOT; + if (cx->sb_iters > 1 && (cx->sb_rxtainted & + (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL))) + SvTAINTED_on((pm->op_pmflags & PMf_NONDESTRUCT) + ? cx->sb_dstr : cx->sb_targ); + TAINT_NOT; } rxres_save(&cx->sb_rxres, rx); PL_curpm = pm; @@ -384,15 +384,15 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) if (!p || p[1] < RX_NPARENS(rx)) { #ifdef PERL_ANY_COW - i = 7 + (RX_NPARENS(rx)+1) * 2; + i = 7 + (RX_NPARENS(rx)+1) * 2; #else - i = 6 + (RX_NPARENS(rx)+1) * 2; + i = 6 + (RX_NPARENS(rx)+1) * 2; #endif - if (!p) - Newx(p, i, UV); - else - Renew(p, i, UV); - *rsp = (void*)p; + if (!p) + Newx(p, i, UV); + else + Renew(p, i, UV); + *rsp = (void*)p; } /* what (if anything) to free on croak */ @@ -410,8 +410,8 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx) *p++ = (UV)RX_SUBOFFSET(rx); *p++ = (UV)RX_SUBCOFFSET(rx); for (i = 0; i <= RX_NPARENS(rx); ++i) { - *p++ = (UV)RX_OFFS(rx)[i].start; - *p++ = (UV)RX_OFFS(rx)[i].end; + *p++ = (UV)RX_OFFS(rx)[i].start; + *p++ = (UV)RX_OFFS(rx)[i].end; } } @@ -431,7 +431,7 @@ S_rxres_restore(pTHX_ void **rsp, REGEXP *rx) #ifdef PERL_ANY_COW if (RX_SAVED_COPY(rx)) - SvREFCNT_dec (RX_SAVED_COPY(rx)); + SvREFCNT_dec (RX_SAVED_COPY(rx)); RX_SAVED_COPY(rx) = INT2PTR(SV*,*p); *p++ = 0; #endif @@ -441,8 +441,8 @@ S_rxres_restore(pTHX_ void **rsp, REGEXP *rx) RX_SUBOFFSET(rx) = (I32)*p++; RX_SUBCOFFSET(rx) = (I32)*p++; for (i = 0; i <= RX_NPARENS(rx); ++i) { - RX_OFFS(rx)[i].start = (I32)(*p++); - RX_OFFS(rx)[i].end = (I32)(*p++); + RX_OFFS(rx)[i].start = (I32)(*p++); + RX_OFFS(rx)[i].end = (I32)(*p++); } } @@ -455,12 +455,12 @@ S_rxres_free(pTHX_ void **rsp) PERL_UNUSED_CONTEXT; if (p) { - void *tmp = INT2PTR(char*,*p); + void *tmp = INT2PTR(char*,*p); #ifdef PERL_POISON #ifdef PERL_ANY_COW - U32 i = 9 + p[1] * 2; + U32 i = 9 + p[1] * 2; #else - U32 i = 8 + p[1] * 2; + U32 i = 8 + p[1] * 2; #endif #endif @@ -471,9 +471,9 @@ S_rxres_free(pTHX_ void **rsp) PoisonFree(p, i, sizeof(UV)); #endif - Safefree(tmp); - Safefree(p); - *rsp = NULL; + Safefree(tmp); + Safefree(p); + *rsp = NULL; } } @@ -521,9 +521,9 @@ PP(pp_formline) SvPV_force(PL_formtarget, len); if (SvTAINTED(tmpForm) || SvTAINTED(formsv)) - SvTAINTED_on(PL_formtarget); + SvTAINTED_on(PL_formtarget); if (DO_UTF8(PL_formtarget)) - targ_is_utf8 = TRUE; + targ_is_utf8 = TRUE; /* this is an initial estimate of how much output buffer space * to allocate. It may be exceeded later */ linemax = (SvCUR(formsv) * (IN_BYTES ? 1 : 3) + 1); @@ -533,76 +533,76 @@ PP(pp_formline) f = SvPV_const(formsv, len); for (;;) { - DEBUG_f( { - const char *name = "???"; - arg = -1; - switch (*fpc) { - case FF_LITERAL: arg = fpc[1]; name = "LITERAL"; break; - case FF_BLANK: arg = fpc[1]; name = "BLANK"; break; - case FF_SKIP: arg = fpc[1]; name = "SKIP"; break; - case FF_FETCH: arg = fpc[1]; name = "FETCH"; break; - case FF_DECIMAL: arg = fpc[1]; name = "DECIMAL"; break; - - case FF_CHECKNL: name = "CHECKNL"; break; - case FF_CHECKCHOP: name = "CHECKCHOP"; break; - case FF_SPACE: name = "SPACE"; break; - case FF_HALFSPACE: name = "HALFSPACE"; break; - case FF_ITEM: name = "ITEM"; break; - case FF_CHOP: name = "CHOP"; break; - case FF_LINEGLOB: name = "LINEGLOB"; break; - case FF_NEWLINE: name = "NEWLINE"; break; - case FF_MORE: name = "MORE"; break; - case FF_LINEMARK: name = "LINEMARK"; break; - case FF_END: name = "END"; break; - case FF_0DECIMAL: name = "0DECIMAL"; break; - case FF_LINESNGL: name = "LINESNGL"; break; - } - if (arg >= 0) - PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); - else - PerlIO_printf(Perl_debug_log, "%-16s\n", name); - } ); - switch (*fpc++) { - case FF_LINEMARK: /* start (or end) of a line */ - linemark = t - SvPVX(PL_formtarget); - lines++; - gotsome = FALSE; - break; - - case FF_LITERAL: /* append literal chars */ - to_copy = *fpc++; - source = (U8 *)f; - f += to_copy; - trans = '~'; - item_is_utf8 = targ_is_utf8 ? !!DO_UTF8(formsv) : !!SvUTF8(formsv); - goto append; - - case FF_SKIP: /* skip chars in format */ - f += *fpc++; - break; - - case FF_FETCH: /* get next item and set field size to */ - arg = *fpc++; - f += arg; - fieldsize = arg; - - if (MARK < SP) - sv = *++MARK; - else { - sv = &PL_sv_no; - Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments"); - } - if (SvTAINTED(sv)) - SvTAINTED_on(PL_formtarget); - break; - - case FF_CHECKNL: /* find max len of item (up to \n) that fits field */ - { - const char *s = item = SvPV_const(sv, len); - const char *send = s + len; + DEBUG_f( { + const char *name = "???"; + arg = -1; + switch (*fpc) { + case FF_LITERAL: arg = fpc[1]; name = "LITERAL"; break; + case FF_BLANK: arg = fpc[1]; name = "BLANK"; break; + case FF_SKIP: arg = fpc[1]; name = "SKIP"; break; + case FF_FETCH: arg = fpc[1]; name = "FETCH"; break; + case FF_DECIMAL: arg = fpc[1]; name = "DECIMAL"; break; + + case FF_CHECKNL: name = "CHECKNL"; break; + case FF_CHECKCHOP: name = "CHECKCHOP"; break; + case FF_SPACE: name = "SPACE"; break; + case FF_HALFSPACE: name = "HALFSPACE"; break; + case FF_ITEM: name = "ITEM"; break; + case FF_CHOP: name = "CHOP"; break; + case FF_LINEGLOB: name = "LINEGLOB"; break; + case FF_NEWLINE: name = "NEWLINE"; break; + case FF_MORE: name = "MORE"; break; + case FF_LINEMARK: name = "LINEMARK"; break; + case FF_END: name = "END"; break; + case FF_0DECIMAL: name = "0DECIMAL"; break; + case FF_LINESNGL: name = "LINESNGL"; break; + } + if (arg >= 0) + PerlIO_printf(Perl_debug_log, "%-16s%ld\n", name, (long) arg); + else + PerlIO_printf(Perl_debug_log, "%-16s\n", name); + } ); + switch (*fpc++) { + case FF_LINEMARK: /* start (or end) of a line */ + linemark = t - SvPVX(PL_formtarget); + lines++; + gotsome = FALSE; + break; + + case FF_LITERAL: /* append literal chars */ + to_copy = *fpc++; + source = (U8 *)f; + f += to_copy; + trans = '~'; + item_is_utf8 = targ_is_utf8 ? !!DO_UTF8(formsv) : !!SvUTF8(formsv); + goto append; + + case FF_SKIP: /* skip chars in format */ + f += *fpc++; + break; + + case FF_FETCH: /* get next item and set field size to */ + arg = *fpc++; + f += arg; + fieldsize = arg; + + if (MARK < SP) + sv = *++MARK; + else { + sv = &PL_sv_no; + Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Not enough format arguments"); + } + if (SvTAINTED(sv)) + SvTAINTED_on(PL_formtarget); + break; + + case FF_CHECKNL: /* find max len of item (up to \n) that fits field */ + { + const char *s = item = SvPV_const(sv, len); + const char *send = s + len; itemsize = 0; - item_is_utf8 = DO_UTF8(sv); + item_is_utf8 = DO_UTF8(sv); while (s < send) { if (!isCNTRL(*s)) gotsome = TRUE; @@ -619,17 +619,17 @@ PP(pp_formline) } itembytes = s - item; chophere = s; - break; - } + break; + } - case FF_CHECKCHOP: /* like CHECKNL, but up to highest split point */ - { - const char *s = item = SvPV_const(sv, len); - const char *send = s + len; + case FF_CHECKCHOP: /* like CHECKNL, but up to highest split point */ + { + const char *s = item = SvPV_const(sv, len); + const char *send = s + len; I32 size = 0; chophere = NULL; - item_is_utf8 = DO_UTF8(sv); + item_is_utf8 = DO_UTF8(sv); while (s < send) { /* look for a legal split position */ if (isSPACE(*s)) { @@ -678,37 +678,37 @@ PP(pp_formline) } itembytes = chophere - item; - break; - } - - case FF_SPACE: /* append padding space (diff of field, item size) */ - arg = fieldsize - itemsize; - if (arg) { - fieldsize -= arg; - while (arg-- > 0) - *t++ = ' '; - } - break; - - case FF_HALFSPACE: /* like FF_SPACE, but only append half as many */ - arg = fieldsize - itemsize; - if (arg) { - arg /= 2; - fieldsize -= arg; - while (arg-- > 0) - *t++ = ' '; - } - break; - - case FF_ITEM: /* append a text item, while blanking ctrl chars */ - to_copy = itembytes; - source = (U8 *)item; - trans = 1; - goto append; - - case FF_CHOP: /* (for ^*) chop the current item */ - if (sv != &PL_sv_no) { - const char *s = chophere; + break; + } + + case FF_SPACE: /* append padding space (diff of field, item size) */ + arg = fieldsize - itemsize; + if (arg) { + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + break; + + case FF_HALFSPACE: /* like FF_SPACE, but only append half as many */ + arg = fieldsize - itemsize; + if (arg) { + arg /= 2; + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + break; + + case FF_ITEM: /* append a text item, while blanking ctrl chars */ + to_copy = itembytes; + source = (U8 *)item; + trans = 1; + goto append; + + case FF_CHOP: /* (for ^*) chop the current item */ + if (sv != &PL_sv_no) { + const char *s = chophere; if (!copied_form && ((sv == tmpForm || SvSMAGICAL(sv)) || (SvGMAGICAL(tmpForm) && !sv_only_taint_gmagic(tmpForm))) ) { @@ -726,154 +726,154 @@ PP(pp_formline) copied_form = TRUE; } - if (chopspace) { - while (isSPACE(*s)) - s++; - } + if (chopspace) { + while (isSPACE(*s)) + s++; + } if (SvPOKp(sv)) sv_chop(sv,s); else /* tied, overloaded or similar strangeness. * Do it the hard way */ sv_setpvn(sv, s, len - (s-item)); - SvSETMAGIC(sv); - break; - } + SvSETMAGIC(sv); + break; + } /* FALLTHROUGH */ - case FF_LINESNGL: /* process ^* */ - chopspace = 0; + case FF_LINESNGL: /* process ^* */ + chopspace = 0; /* FALLTHROUGH */ - case FF_LINEGLOB: /* process @* */ - { - const bool oneline = fpc[-1] == FF_LINESNGL; - const char *s = item = SvPV_const(sv, len); - const char *const send = s + len; - - item_is_utf8 = DO_UTF8(sv); - chophere = s + len; - if (!len) - break; - trans = 0; - gotsome = TRUE; - source = (U8 *) s; - to_copy = len; - while (s < send) { - if (*s++ == '\n') { - if (oneline) { - to_copy = s - item - 1; - chophere = s; - break; - } else { - if (s == send) { - to_copy--; - } else - lines++; - } - } - } - } - - append: - /* append to_copy bytes from source to PL_formstring. - * item_is_utf8 implies source is utf8. - * if trans, translate certain characters during the copy */ - { - U8 *tmp = NULL; - STRLEN grow = 0; - - SvCUR_set(PL_formtarget, - t - SvPVX_const(PL_formtarget)); - - if (targ_is_utf8 && !item_is_utf8) { - source = tmp = bytes_to_utf8(source, &to_copy); + case FF_LINEGLOB: /* process @* */ + { + const bool oneline = fpc[-1] == FF_LINESNGL; + const char *s = item = SvPV_const(sv, len); + const char *const send = s + len; + + item_is_utf8 = DO_UTF8(sv); + chophere = s + len; + if (!len) + break; + trans = 0; + gotsome = TRUE; + source = (U8 *) s; + to_copy = len; + while (s < send) { + if (*s++ == '\n') { + if (oneline) { + to_copy = s - item - 1; + chophere = s; + break; + } else { + if (s == send) { + to_copy--; + } else + lines++; + } + } + } + } + + append: + /* append to_copy bytes from source to PL_formstring. + * item_is_utf8 implies source is utf8. + * if trans, translate certain characters during the copy */ + { + U8 *tmp = NULL; + STRLEN grow = 0; + + SvCUR_set(PL_formtarget, + t - SvPVX_const(PL_formtarget)); + + if (targ_is_utf8 && !item_is_utf8) { + source = tmp = bytes_to_utf8(source, &to_copy); grow = to_copy; - } else { - if (item_is_utf8 && !targ_is_utf8) { - U8 *s; - /* Upgrade targ to UTF8, and then we reduce it to - a problem we have a simple solution for. - Don't need get magic. */ - sv_utf8_upgrade_nomg(PL_formtarget); - targ_is_utf8 = TRUE; - /* re-calculate linemark */ - s = (U8*)SvPVX(PL_formtarget); - /* the bytes we initially allocated to append the - * whole line may have been gobbled up during the - * upgrade, so allocate a whole new line's worth - * for safety */ - grow = linemax; - while (linemark--) - s += UTF8_SAFE_SKIP(s, + } else { + if (item_is_utf8 && !targ_is_utf8) { + U8 *s; + /* Upgrade targ to UTF8, and then we reduce it to + a problem we have a simple solution for. + Don't need get magic. */ + sv_utf8_upgrade_nomg(PL_formtarget); + targ_is_utf8 = TRUE; + /* re-calculate linemark */ + s = (U8*)SvPVX(PL_formtarget); + /* the bytes we initially allocated to append the + * whole line may have been gobbled up during the + * upgrade, so allocate a whole new line's worth + * for safety */ + grow = linemax; + while (linemark--) + s += UTF8_SAFE_SKIP(s, (U8 *) SvEND(PL_formtarget)); - linemark = s - (U8*)SvPVX(PL_formtarget); - } - /* Easy. They agree. */ - assert (item_is_utf8 == targ_is_utf8); - } - if (!trans) - /* @* and ^* are the only things that can exceed - * the linemax, so grow by the output size, plus - * a whole new form's worth in case of any further - * output */ - grow = linemax + to_copy; - if (grow) - SvGROW(PL_formtarget, SvCUR(PL_formtarget) + grow + 1); - t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); - - Copy(source, t, to_copy, char); - if (trans) { - /* blank out ~ or control chars, depending on trans. - * works on bytes not chars, so relies on not - * matching utf8 continuation bytes */ - U8 *s = (U8*)t; - U8 *send = s + to_copy; - while (s < send) { - const int ch = *s; - if (trans == '~' ? (ch == '~') : isCNTRL(ch)) - *s = ' '; - s++; - } - } - - t += to_copy; - SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy); - if (tmp) - Safefree(tmp); - break; - } - - case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */ - arg = *fpc++; - fmt = (const char *) - ((arg & FORM_NUM_POINT) ? "%#0*.*" NVff : "%0*.*" NVff); - goto ff_dec; - - case FF_DECIMAL: /* do @##, ^##, where =(precision|flags) */ - arg = *fpc++; - fmt = (const char *) - ((arg & FORM_NUM_POINT) ? "%#*.*" NVff : "%*.*" NVff); - ff_dec: - /* If the field is marked with ^ and the value is undefined, - blank it out. */ - if ((arg & FORM_NUM_BLANK) && !SvOK(sv)) { - arg = fieldsize; - while (arg--) - *t++ = ' '; - break; - } - gotsome = TRUE; - value = SvNV(sv); - /* overflow evidence */ - if (num_overflow(value, fieldsize, arg)) { - arg = fieldsize; - while (arg--) - *t++ = '#'; - break; - } - /* Formats aren't yet marked for locales, so assume "yes". */ - { + linemark = s - (U8*)SvPVX(PL_formtarget); + } + /* Easy. They agree. */ + assert (item_is_utf8 == targ_is_utf8); + } + if (!trans) + /* @* and ^* are the only things that can exceed + * the linemax, so grow by the output size, plus + * a whole new form's worth in case of any further + * output */ + grow = linemax + to_copy; + if (grow) + SvGROW(PL_formtarget, SvCUR(PL_formtarget) + grow + 1); + t = SvPVX(PL_formtarget) + SvCUR(PL_formtarget); + + Copy(source, t, to_copy, char); + if (trans) { + /* blank out ~ or control chars, depending on trans. + * works on bytes not chars, so relies on not + * matching utf8 continuation bytes */ + U8 *s = (U8*)t; + U8 *send = s + to_copy; + while (s < send) { + const int ch = *s; + if (trans == '~' ? (ch == '~') : isCNTRL(ch)) + *s = ' '; + s++; + } + } + + t += to_copy; + SvCUR_set(PL_formtarget, SvCUR(PL_formtarget) + to_copy); + if (tmp) + Safefree(tmp); + break; + } + + case FF_0DECIMAL: /* like FF_DECIMAL but for 0### */ + arg = *fpc++; + fmt = (const char *) + ((arg & FORM_NUM_POINT) ? "%#0*.*" NVff : "%0*.*" NVff); + goto ff_dec; + + case FF_DECIMAL: /* do @##, ^##, where =(precision|flags) */ + arg = *fpc++; + fmt = (const char *) + ((arg & FORM_NUM_POINT) ? "%#*.*" NVff : "%*.*" NVff); + ff_dec: + /* If the field is marked with ^ and the value is undefined, + blank it out. */ + if ((arg & FORM_NUM_BLANK) && !SvOK(sv)) { + arg = fieldsize; + while (arg--) + *t++ = ' '; + break; + } + gotsome = TRUE; + value = SvNV(sv); + /* overflow evidence */ + if (num_overflow(value, fieldsize, arg)) { + arg = fieldsize; + while (arg--) + *t++ = '#'; + break; + } + /* Formats aren't yet marked for locales, so assume "yes". */ + { Size_t max = SvLEN(PL_formtarget) - (t - SvPVX(PL_formtarget)); int len; DECLARATION_FOR_LC_NUMERIC_MANIPULATION; @@ -896,73 +896,73 @@ PP(pp_formline) #endif PERL_MY_SNPRINTF_POST_GUARD(len, max); RESTORE_LC_NUMERIC(); - } - t += fieldsize; - break; - - case FF_NEWLINE: /* delete trailing spaces, then append \n */ - f++; - while (t-- > (SvPVX(PL_formtarget) + linemark) && *t == ' ') ; - t++; - *t++ = '\n'; - break; - - case FF_BLANK: /* for arg==0: do '~'; for arg>0 : do '~~' */ - arg = *fpc++; - if (gotsome) { - if (arg) { /* repeat until fields exhausted? */ - fpc--; - goto end; - } - } - else { - t = SvPVX(PL_formtarget) + linemark; - lines--; - } - break; - - case FF_MORE: /* replace long end of string with '...' */ - { - const char *s = chophere; - const char *send = item + len; - if (chopspace) { - while (isSPACE(*s) && (s < send)) - s++; - } - if (s < send) { - char *s1; - arg = fieldsize - itemsize; - if (arg) { - fieldsize -= arg; - while (arg-- > 0) - *t++ = ' '; - } - s1 = t - 3; - if (strBEGINs(s1," ")) { - while (s1 > SvPVX_const(PL_formtarget) && isSPACE(s1[-1])) - s1--; - } - *s1++ = '.'; - *s1++ = '.'; - *s1++ = '.'; - } - break; - } - - case FF_END: /* tidy up, then return */ - end: - assert(t < SvPVX_const(PL_formtarget) + SvLEN(PL_formtarget)); - *t = '\0'; - SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); - if (targ_is_utf8) - SvUTF8_on(PL_formtarget); - FmLINES(PL_formtarget) += lines; - SP = ORIGMARK; - if (fpc[-1] == FF_BLANK) - RETURNOP(cLISTOP->op_first); - else - RETPUSHYES; - } + } + t += fieldsize; + break; + + case FF_NEWLINE: /* delete trailing spaces, then append \n */ + f++; + while (t-- > (SvPVX(PL_formtarget) + linemark) && *t == ' ') ; + t++; + *t++ = '\n'; + break; + + case FF_BLANK: /* for arg==0: do '~'; for arg>0 : do '~~' */ + arg = *fpc++; + if (gotsome) { + if (arg) { /* repeat until fields exhausted? */ + fpc--; + goto end; + } + } + else { + t = SvPVX(PL_formtarget) + linemark; + lines--; + } + break; + + case FF_MORE: /* replace long end of string with '...' */ + { + const char *s = chophere; + const char *send = item + len; + if (chopspace) { + while (isSPACE(*s) && (s < send)) + s++; + } + if (s < send) { + char *s1; + arg = fieldsize - itemsize; + if (arg) { + fieldsize -= arg; + while (arg-- > 0) + *t++ = ' '; + } + s1 = t - 3; + if (strBEGINs(s1," ")) { + while (s1 > SvPVX_const(PL_formtarget) && isSPACE(s1[-1])) + s1--; + } + *s1++ = '.'; + *s1++ = '.'; + *s1++ = '.'; + } + break; + } + + case FF_END: /* tidy up, then return */ + end: + assert(t < SvPVX_const(PL_formtarget) + SvLEN(PL_formtarget)); + *t = '\0'; + SvCUR_set(PL_formtarget, t - SvPVX_const(PL_formtarget)); + if (targ_is_utf8) + SvUTF8_on(PL_formtarget); + FmLINES(PL_formtarget) += lines; + SP = ORIGMARK; + if (fpc[-1] == FF_BLANK) + RETURNOP(cLISTOP->op_first); + else + RETPUSHYES; + } } } @@ -973,10 +973,10 @@ PP(pp_grepstart) SV *src; if (PL_stack_base + TOPMARK == SP) { - (void)POPMARK; - if (GIMME_V == G_SCALAR) - XPUSHs(&PL_sv_zero); - RETURNOP(PL_op->op_next->op_next); + (void)POPMARK; + if (GIMME_V == G_SCALAR) + XPUSHs(&PL_sv_zero); + RETURNOP(PL_op->op_next->op_next); } PL_stack_sp = PL_stack_base + TOPMARK + 1; Perl_pp_pushmark(aTHX); /* push dst */ @@ -990,15 +990,15 @@ PP(pp_grepstart) src = PL_stack_base[TOPMARK]; if (SvPADTMP(src)) { - src = PL_stack_base[TOPMARK] = sv_mortalcopy(src); - PL_tmps_floor++; + src = PL_stack_base[TOPMARK] = sv_mortalcopy(src); + PL_tmps_floor++; } SvTEMP_off(src); DEFSV_set(src); PUTBACK; if (PL_op->op_type == OP_MAPSTART) - Perl_pp_pushmark(aTHX); /* push top */ + Perl_pp_pushmark(aTHX); /* push top */ return ((LOGOP*)PL_op->op_next)->op_other; } @@ -1017,127 +1017,127 @@ PP(pp_mapwhile) /* if there are new items, push them into the destination list */ if (items && gimme != G_VOID) { - /* might need to make room back there first */ - if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { - /* XXX this implementation is very pessimal because the stack - * is repeatedly extended for every set of items. Is possible - * to do this without any stack extension or copying at all - * by maintaining a separate list over which the map iterates - * (like foreach does). --gsar */ - - /* everything in the stack after the destination list moves - * towards the end the stack by the amount of room needed */ - shift = items - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); - - /* items to shift up (accounting for the moved source pointer) */ - count = (SP - PL_stack_base) - (PL_markstack_ptr[-1] - 1); - - /* This optimization is by Ben Tilly and it does - * things differently from what Sarathy (gsar) - * is describing. The downside of this optimization is - * that leaves "holes" (uninitialized and hopefully unused areas) - * to the Perl stack, but on the other hand this - * shouldn't be a problem. If Sarathy's idea gets - * implemented, this optimization should become - * irrelevant. --jhi */ + /* might need to make room back there first */ + if (items > PL_markstack_ptr[-1] - PL_markstack_ptr[-2]) { + /* XXX this implementation is very pessimal because the stack + * is repeatedly extended for every set of items. Is possible + * to do this without any stack extension or copying at all + * by maintaining a separate list over which the map iterates + * (like foreach does). --gsar */ + + /* everything in the stack after the destination list moves + * towards the end the stack by the amount of room needed */ + shift = items - (PL_markstack_ptr[-1] - PL_markstack_ptr[-2]); + + /* items to shift up (accounting for the moved source pointer) */ + count = (SP - PL_stack_base) - (PL_markstack_ptr[-1] - 1); + + /* This optimization is by Ben Tilly and it does + * things differently from what Sarathy (gsar) + * is describing. The downside of this optimization is + * that leaves "holes" (uninitialized and hopefully unused areas) + * to the Perl stack, but on the other hand this + * shouldn't be a problem. If Sarathy's idea gets + * implemented, this optimization should become + * irrelevant. --jhi */ if (shift < count) shift = count; /* Avoid shifting too often --Ben Tilly */ - EXTEND(SP,shift); - src = SP; - dst = (SP += shift); - PL_markstack_ptr[-1] += shift; - *PL_markstack_ptr += shift; - while (count--) - *dst-- = *src--; - } - /* copy the new items down to the destination list */ - dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1; - if (gimme == G_ARRAY) { - /* add returned items to the collection (making mortal copies - * if necessary), then clear the current temps stack frame - * *except* for those items. We do this splicing the items - * into the start of the tmps frame (so some items may be on - * the tmps stack twice), then moving PL_tmps_floor above - * them, then freeing the frame. That way, the only tmps that - * accumulate over iterations are the return values for map. - * We have to do to this way so that everything gets correctly - * freed if we die during the map. - */ - I32 tmpsbase; - I32 i = items; - /* make space for the slice */ - EXTEND_MORTAL(items); - tmpsbase = PL_tmps_floor + 1; - Move(PL_tmps_stack + tmpsbase, - PL_tmps_stack + tmpsbase + items, - PL_tmps_ix - PL_tmps_floor, - SV*); - PL_tmps_ix += items; - - while (i-- > 0) { - SV *sv = POPs; - if (!SvTEMP(sv)) - sv = sv_mortalcopy(sv); - *dst-- = sv; - PL_tmps_stack[tmpsbase++] = SvREFCNT_inc_simple(sv); - } - /* clear the stack frame except for the items */ - PL_tmps_floor += items; - FREETMPS; - /* FREETMPS may have cleared the TEMP flag on some of the items */ - i = items; - while (i-- > 0) - SvTEMP_on(PL_tmps_stack[--tmpsbase]); - } - else { - /* scalar context: we don't care about which values map returns - * (we use undef here). And so we certainly don't want to do mortal - * copies of meaningless values. */ - while (items-- > 0) { - (void)POPs; - *dst-- = &PL_sv_undef; - } - FREETMPS; - } + EXTEND(SP,shift); + src = SP; + dst = (SP += shift); + PL_markstack_ptr[-1] += shift; + *PL_markstack_ptr += shift; + while (count--) + *dst-- = *src--; + } + /* copy the new items down to the destination list */ + dst = PL_stack_base + (PL_markstack_ptr[-2] += items) - 1; + if (gimme == G_ARRAY) { + /* add returned items to the collection (making mortal copies + * if necessary), then clear the current temps stack frame + * *except* for those items. We do this splicing the items + * into the start of the tmps frame (so some items may be on + * the tmps stack twice), then moving PL_tmps_floor above + * them, then freeing the frame. That way, the only tmps that + * accumulate over iterations are the return values for map. + * We have to do to this way so that everything gets correctly + * freed if we die during the map. + */ + I32 tmpsbase; + I32 i = items; + /* make space for the slice */ + EXTEND_MORTAL(items); + tmpsbase = PL_tmps_floor + 1; + Move(PL_tmps_stack + tmpsbase, + PL_tmps_stack + tmpsbase + items, + PL_tmps_ix - PL_tmps_floor, + SV*); + PL_tmps_ix += items; + + while (i-- > 0) { + SV *sv = POPs; + if (!SvTEMP(sv)) + sv = sv_mortalcopy(sv); + *dst-- = sv; + PL_tmps_stack[tmpsbase++] = SvREFCNT_inc_simple(sv); + } + /* clear the stack frame except for the items */ + PL_tmps_floor += items; + FREETMPS; + /* FREETMPS may have cleared the TEMP flag on some of the items */ + i = items; + while (i-- > 0) + SvTEMP_on(PL_tmps_stack[--tmpsbase]); + } + else { + /* scalar context: we don't care about which values map returns + * (we use undef here). And so we certainly don't want to do mortal + * copies of meaningless values. */ + while (items-- > 0) { + (void)POPs; + *dst-- = &PL_sv_undef; + } + FREETMPS; + } } else { - FREETMPS; + FREETMPS; } LEAVE_with_name("grep_item"); /* exit inner scope */ /* All done yet? */ if (PL_markstack_ptr[-1] > TOPMARK) { - (void)POPMARK; /* pop top */ - LEAVE_with_name("grep"); /* exit outer scope */ - (void)POPMARK; /* pop src */ - items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; - (void)POPMARK; /* pop dst */ - SP = PL_stack_base + POPMARK; /* pop original mark */ - if (gimme == G_SCALAR) { - dTARGET; - XPUSHi(items); - } - else if (gimme == G_ARRAY) - SP += items; - RETURN; + (void)POPMARK; /* pop top */ + LEAVE_with_name("grep"); /* exit outer scope */ + (void)POPMARK; /* pop src */ + items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; + (void)POPMARK; /* pop dst */ + SP = PL_stack_base + POPMARK; /* pop original mark */ + if (gimme == G_SCALAR) { + dTARGET; + XPUSHi(items); + } + else if (gimme == G_ARRAY) + SP += items; + RETURN; } else { - SV *src; + SV *src; - ENTER_with_name("grep_item"); /* enter inner scope */ - SAVEVPTR(PL_curpm); + ENTER_with_name("grep_item"); /* enter inner scope */ + SAVEVPTR(PL_curpm); - /* set $_ to the new source item */ - src = PL_stack_base[PL_markstack_ptr[-1]]; - if (SvPADTMP(src)) { + /* set $_ to the new source item */ + src = PL_stack_base[PL_markstack_ptr[-1]]; + if (SvPADTMP(src)) { src = sv_mortalcopy(src); } - SvTEMP_off(src); - DEFSV_set(src); + SvTEMP_off(src); + DEFSV_set(src); - RETURNOP(cLOGOP->op_other); + RETURNOP(cLOGOP->op_other); } } @@ -1147,12 +1147,12 @@ PP(pp_range) { dTARG; if (GIMME_V == G_ARRAY) - return NORMAL; + return NORMAL; GETTARGET; if (SvTRUE_NN(targ)) - return cLOGOP->op_other; + return cLOGOP->op_other; else - return NORMAL; + return NORMAL; } PP(pp_flip) @@ -1160,41 +1160,41 @@ PP(pp_flip) dSP; if (GIMME_V == G_ARRAY) { - RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); + RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); } else { - dTOPss; - SV * const targ = PAD_SV(PL_op->op_targ); - int flip = 0; - - if (PL_op->op_private & OPpFLIP_LINENUM) { - if (GvIO(PL_last_in_gv)) { - flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); - } - else { - GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); - if (gv && GvSV(gv)) - flip = SvIV(sv) == SvIV(GvSV(gv)); - } - } else { - flip = SvTRUE_NN(sv); - } - if (flip) { - sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); - if (PL_op->op_flags & OPf_SPECIAL) { - sv_setiv(targ, 1); - SETs(targ); - RETURN; - } - else { - sv_setiv(targ, 0); - SP--; - RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); - } - } + dTOPss; + SV * const targ = PAD_SV(PL_op->op_targ); + int flip = 0; + + if (PL_op->op_private & OPpFLIP_LINENUM) { + if (GvIO(PL_last_in_gv)) { + flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); + } + else { + GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); + if (gv && GvSV(gv)) + flip = SvIV(sv) == SvIV(GvSV(gv)); + } + } else { + flip = SvTRUE_NN(sv); + } + if (flip) { + sv_setiv(PAD_SV(cUNOP->op_first->op_targ), 1); + if (PL_op->op_flags & OPf_SPECIAL) { + sv_setiv(targ, 1); + SETs(targ); + RETURN; + } + else { + sv_setiv(targ, 0); + SP--; + RETURNOP(((LOGOP*)cUNOP->op_first)->op_other); + } + } SvPVCLEAR(TARG); - SETs(targ); - RETURN; + SETs(targ); + RETURN; } } @@ -1206,9 +1206,9 @@ PP(pp_flip) perlop [#133695] */ #define RANGE_IS_NUMERIC(left,right) ( \ - SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ - SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ - (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \ + SvNIOKp(left) || (SvOK(left) && !SvPOKp(left)) || \ + SvNIOKp(right) || (SvOK(right) && !SvPOKp(right)) || \ + (((!SvOK(left) && SvOK(right)) || ((!SvOK(left) || \ looks_like_number(left)) && SvPOKp(left) \ && !(*SvPVX_const(left) == '0' && SvCUR(left)>1 ) )) \ && (!SvOK(right) || looks_like_number(right)))) @@ -1218,21 +1218,21 @@ PP(pp_flop) dSP; if (GIMME_V == G_ARRAY) { - dPOPPOPssrl; - - SvGETMAGIC(left); - SvGETMAGIC(right); - - if (RANGE_IS_NUMERIC(left,right)) { - IV i, j, n; - if ((SvOK(left) && !SvIOK(left) && SvNV_nomg(left) < IV_MIN) || - (SvOK(right) && (SvIOK(right) - ? SvIsUV(right) && SvUV(right) > IV_MAX - : SvNV_nomg(right) > (NV) IV_MAX))) - DIE(aTHX_ "Range iterator outside integer range"); - i = SvIV_nomg(left); - j = SvIV_nomg(right); - if (j >= i) { + dPOPPOPssrl; + + SvGETMAGIC(left); + SvGETMAGIC(right); + + if (RANGE_IS_NUMERIC(left,right)) { + IV i, j, n; + if ((SvOK(left) && !SvIOK(left) && SvNV_nomg(left) < IV_MIN) || + (SvOK(right) && (SvIOK(right) + ? SvIsUV(right) && SvUV(right) > IV_MAX + : SvNV_nomg(right) > (NV) IV_MAX))) + DIE(aTHX_ "Range iterator outside integer range"); + i = SvIV_nomg(left); + j = SvIV_nomg(right); + if (j >= i) { /* Dance carefully around signed max. */ bool overflow = (i <= 0 && j > SSize_t_MAX + i - 1); if (!overflow) { @@ -1249,59 +1249,59 @@ PP(pp_flop) } if (overflow) Perl_croak(aTHX_ "Out of memory during list extend"); - EXTEND_MORTAL(n); - EXTEND(SP, n); - } - else - n = 0; - while (n--) { - SV * const sv = sv_2mortal(newSViv(i)); - PUSHs(sv); + EXTEND_MORTAL(n); + EXTEND(SP, n); + } + else + n = 0; + while (n--) { + SV * const sv = sv_2mortal(newSViv(i)); + PUSHs(sv); if (n) /* avoid incrementing above IV_MAX */ i++; - } - } - else { - STRLEN len, llen; - const char * const lpv = SvPV_nomg_const(left, llen); - const char * const tmps = SvPV_nomg_const(right, len); - - SV *sv = newSVpvn_flags(lpv, llen, SvUTF8(left)|SVs_TEMP); + } + } + else { + STRLEN len, llen; + const char * const lpv = SvPV_nomg_const(left, llen); + const char * const tmps = SvPV_nomg_const(right, len); + + SV *sv = newSVpvn_flags(lpv, llen, SvUTF8(left)|SVs_TEMP); if (DO_UTF8(right) && IN_UNI_8_BIT) len = sv_len_utf8_nomg(right); - while (!SvNIOKp(sv) && SvCUR(sv) <= len) { - XPUSHs(sv); - if (strEQ(SvPVX_const(sv),tmps)) - break; - sv = sv_2mortal(newSVsv(sv)); - sv_inc(sv); - } - } + while (!SvNIOKp(sv) && SvCUR(sv) <= len) { + XPUSHs(sv); + if (strEQ(SvPVX_const(sv),tmps)) + break; + sv = sv_2mortal(newSVsv(sv)); + sv_inc(sv); + } + } } else { - dTOPss; - SV * const targ = PAD_SV(cUNOP->op_first->op_targ); - int flop = 0; - sv_inc(targ); - - if (PL_op->op_private & OPpFLIP_LINENUM) { - if (GvIO(PL_last_in_gv)) { - flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); - } - else { - GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); - if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv)); - } - } - else { - flop = SvTRUE_NN(sv); - } - - if (flop) { - sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); - sv_catpvs(targ, "E0"); - } - SETs(targ); + dTOPss; + SV * const targ = PAD_SV(cUNOP->op_first->op_targ); + int flop = 0; + sv_inc(targ); + + if (PL_op->op_private & OPpFLIP_LINENUM) { + if (GvIO(PL_last_in_gv)) { + flop = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv)); + } + else { + GV * const gv = gv_fetchpvs(".", GV_ADD|GV_NOTQUAL, SVt_PV); + if (gv && GvSV(gv)) flop = SvIV(sv) == SvIV(GvSV(gv)); + } + } + else { + flop = SvTRUE_NN(sv); + } + + if (flop) { + sv_setiv(PAD_SV(((UNOP*)cUNOP->op_first)->op_first->op_targ), 0); + sv_catpvs(targ, "E0"); + } + SETs(targ); } RETURN; @@ -1333,29 +1333,29 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) PERL_ARGS_ASSERT_DOPOPTOLABEL; for (i = cxstack_ix; i >= 0; i--) { - const PERL_CONTEXT * const cx = &cxstack[i]; - switch (CxTYPE(cx)) { - case CXt_SUBST: - case CXt_SUB: - case CXt_FORMAT: - case CXt_EVAL: - case CXt_NULL: - /* diag_listed_as: Exiting subroutine via %s */ - Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", - context_name[CxTYPE(cx)], OP_NAME(PL_op)); - if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */ - return -1; - break; - case CXt_LOOP_PLAIN: - case CXt_LOOP_LAZYIV: - case CXt_LOOP_LAZYSV: - case CXt_LOOP_LIST: - case CXt_LOOP_ARY: - { + const PERL_CONTEXT * const cx = &cxstack[i]; + switch (CxTYPE(cx)) { + case CXt_SUBST: + case CXt_SUB: + case CXt_FORMAT: + case CXt_EVAL: + case CXt_NULL: + /* diag_listed_as: Exiting subroutine via %s */ + Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", + context_name[CxTYPE(cx)], OP_NAME(PL_op)); + if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */ + return -1; + break; + case CXt_LOOP_PLAIN: + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: + { STRLEN cx_label_len = 0; U32 cx_label_flags = 0; - const char *cx_label = CxLABEL_len_flags(cx, &cx_label_len, &cx_label_flags); - if (!cx_label || !( + const char *cx_label = CxLABEL_len_flags(cx, &cx_label_len, &cx_label_flags); + if (!cx_label || !( ( (cx_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ? (flags & SVf_UTF8) ? (bytes_cmp_utf8( @@ -1366,14 +1366,14 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags) (const U8*)cx_label, cx_label_len) == 0) : (len == cx_label_len && ((cx_label == label) || memEQ(cx_label, label, len))) )) { - DEBUG_l(Perl_deb(aTHX_ "(poptolabel(): skipping label at cx=%ld %s)\n", - (long)i, cx_label)); - continue; - } - DEBUG_l( Perl_deb(aTHX_ "(poptolabel(): found label at cx=%ld %s)\n", (long)i, label)); - return i; - } - } + DEBUG_l(Perl_deb(aTHX_ "(poptolabel(): skipping label at cx=%ld %s)\n", + (long)i, cx_label)); + continue; + } + DEBUG_l( Perl_deb(aTHX_ "(poptolabel(): found label at cx=%ld %s)\n", (long)i, label)); + return i; + } + } } return i; } @@ -1395,11 +1395,11 @@ Perl_block_gimme(pTHX) const I32 cxix = dopopto_cursub(); U8 gimme; if (cxix < 0) - return G_VOID; + return G_VOID; gimme = (cxstack[cxix].blk_gimme & G_WANT); if (!gimme) - Perl_croak(aTHX_ "panic: bad gimme: %d\n", gimme); + Perl_croak(aTHX_ "panic: bad gimme: %d\n", gimme); return gimme; } @@ -1411,9 +1411,9 @@ Perl_is_lvalue_sub(pTHX) assert(cxix >= 0); /* We should only be called from inside subs */ if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv)) - return CxLVAL(cxstack + cxix); + return CxLVAL(cxstack + cxix); else - return 0; + return 0; } /* only used by cx_pushsub() */ @@ -1424,9 +1424,9 @@ Perl_was_lvalue_sub(pTHX) assert(cxix >= 0); /* We should only be called from inside subs */ if (CxLVAL(cxstack + cxix) && CvLVALUE(cxstack[cxix].blk_sub.cv)) - return CxLVAL(cxstack + cxix); + return CxLVAL(cxstack + cxix); else - return 0; + return 0; } STATIC I32 @@ -1440,11 +1440,11 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) #endif for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT * const cx = &cxstk[i]; - switch (CxTYPE(cx)) { - default: - continue; - case CXt_SUB: + const PERL_CONTEXT * const cx = &cxstk[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_SUB: /* in sub foo { /(?{...})/ }, foo ends up on the CX stack * twice; the first for the normal foo() call, and the second * for a faked up re-entry into the sub to execute the @@ -1452,11 +1452,11 @@ S_dopoptosub_at(pTHX_ const PERL_CONTEXT *cxstk, I32 startingblock) if (cx->cx_type & CXp_SUB_RE_FAKE) continue; /* FALLTHROUGH */ - case CXt_EVAL: - case CXt_FORMAT: - DEBUG_l( Perl_deb(aTHX_ "(dopoptosub_at(): found sub at cx=%ld)\n", (long)i)); - return i; - } + case CXt_EVAL: + case CXt_FORMAT: + DEBUG_l( Perl_deb(aTHX_ "(dopoptosub_at(): found sub at cx=%ld)\n", (long)i)); + return i; + } } return i; } @@ -1466,14 +1466,14 @@ S_dopoptoeval(pTHX_ I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT *cx = &cxstack[i]; - switch (CxTYPE(cx)) { - default: - continue; - case CXt_EVAL: - DEBUG_l( Perl_deb(aTHX_ "(dopoptoeval(): found eval at cx=%ld)\n", (long)i)); - return i; - } + const PERL_CONTEXT *cx = &cxstack[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_EVAL: + DEBUG_l( Perl_deb(aTHX_ "(dopoptoeval(): found eval at cx=%ld)\n", (long)i)); + return i; + } } return i; } @@ -1483,27 +1483,27 @@ S_dopoptoloop(pTHX_ I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT * const cx = &cxstack[i]; - switch (CxTYPE(cx)) { - case CXt_SUBST: - case CXt_SUB: - case CXt_FORMAT: - case CXt_EVAL: - case CXt_NULL: - /* diag_listed_as: Exiting subroutine via %s */ - Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", - context_name[CxTYPE(cx)], OP_NAME(PL_op)); - if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */ - return -1; - break; - case CXt_LOOP_PLAIN: - case CXt_LOOP_LAZYIV: - case CXt_LOOP_LAZYSV: - case CXt_LOOP_LIST: - case CXt_LOOP_ARY: - DEBUG_l( Perl_deb(aTHX_ "(dopoptoloop(): found loop at cx=%ld)\n", (long)i)); - return i; - } + const PERL_CONTEXT * const cx = &cxstack[i]; + switch (CxTYPE(cx)) { + case CXt_SUBST: + case CXt_SUB: + case CXt_FORMAT: + case CXt_EVAL: + case CXt_NULL: + /* diag_listed_as: Exiting subroutine via %s */ + Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s", + context_name[CxTYPE(cx)], OP_NAME(PL_op)); + if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */ + return -1; + break; + case CXt_LOOP_PLAIN: + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: + DEBUG_l( Perl_deb(aTHX_ "(dopoptoloop(): found loop at cx=%ld)\n", (long)i)); + return i; + } } return i; } @@ -1515,25 +1515,25 @@ S_dopoptogivenfor(pTHX_ I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT *cx = &cxstack[i]; - switch (CxTYPE(cx)) { - default: - continue; - case CXt_GIVEN: - DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found given at cx=%ld)\n", (long)i)); - return i; - case CXt_LOOP_PLAIN: + const PERL_CONTEXT *cx = &cxstack[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_GIVEN: + DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found given at cx=%ld)\n", (long)i)); + return i; + case CXt_LOOP_PLAIN: assert(!(cx->cx_type & CXp_FOR_DEF)); - break; - case CXt_LOOP_LAZYIV: - case CXt_LOOP_LAZYSV: - case CXt_LOOP_LIST: - case CXt_LOOP_ARY: + break; + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: if (cx->cx_type & CXp_FOR_DEF) { - DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found foreach at cx=%ld)\n", (long)i)); - return i; - } - } + DEBUG_l( Perl_deb(aTHX_ "(dopoptogivenfor(): found foreach at cx=%ld)\n", (long)i)); + return i; + } + } } return i; } @@ -1543,14 +1543,14 @@ S_dopoptowhen(pTHX_ I32 startingblock) { I32 i; for (i = startingblock; i >= 0; i--) { - const PERL_CONTEXT *cx = &cxstack[i]; - switch (CxTYPE(cx)) { - default: - continue; - case CXt_WHEN: - DEBUG_l( Perl_deb(aTHX_ "(dopoptowhen(): found when at cx=%ld)\n", (long)i)); - return i; - } + const PERL_CONTEXT *cx = &cxstack[i]; + switch (CxTYPE(cx)) { + default: + continue; + case CXt_WHEN: + DEBUG_l( Perl_deb(aTHX_ "(dopoptowhen(): found when at cx=%ld)\n", (long)i)); + return i; + } } return i; } @@ -1566,57 +1566,57 @@ void Perl_dounwind(pTHX_ I32 cxix) { if (!PL_curstackinfo) /* can happen if die during thread cloning */ - return; + return; while (cxstack_ix > cxix) { PERL_CONTEXT *cx = CX_CUR(); - CX_DEBUG(cx, "UNWIND"); - /* Note: we don't need to restore the base context info till the end. */ + CX_DEBUG(cx, "UNWIND"); + /* Note: we don't need to restore the base context info till the end. */ CX_LEAVE_SCOPE(cx); - switch (CxTYPE(cx)) { - case CXt_SUBST: - CX_POPSUBST(cx); + switch (CxTYPE(cx)) { + case CXt_SUBST: + CX_POPSUBST(cx); /* CXt_SUBST is not a block context type, so skip the * cx_popblock(cx) below */ if (cxstack_ix == cxix + 1) { cxstack_ix--; return; } - break; - case CXt_SUB: - cx_popsub(cx); - break; - case CXt_EVAL: - cx_popeval(cx); - break; - case CXt_LOOP_PLAIN: - case CXt_LOOP_LAZYIV: - case CXt_LOOP_LAZYSV: - case CXt_LOOP_LIST: - case CXt_LOOP_ARY: - cx_poploop(cx); - break; - case CXt_WHEN: - cx_popwhen(cx); - break; - case CXt_GIVEN: - cx_popgiven(cx); - break; - case CXt_BLOCK: - case CXt_NULL: + break; + case CXt_SUB: + cx_popsub(cx); + break; + case CXt_EVAL: + cx_popeval(cx); + break; + case CXt_LOOP_PLAIN: + case CXt_LOOP_LAZYIV: + case CXt_LOOP_LAZYSV: + case CXt_LOOP_LIST: + case CXt_LOOP_ARY: + cx_poploop(cx); + break; + case CXt_WHEN: + cx_popwhen(cx); + break; + case CXt_GIVEN: + cx_popgiven(cx); + break; + case CXt_BLOCK: + case CXt_NULL: /* these two don't have a POPFOO() */ - break; - case CXt_FORMAT: - cx_popformat(cx); - break; - } + break; + case CXt_FORMAT: + cx_popformat(cx); + break; + } if (cxstack_ix == cxix + 1) { cx_popblock(cx); } - cxstack_ix--; + cxstack_ix--; } } @@ -1627,19 +1627,19 @@ Perl_qerror(pTHX_ SV *err) PERL_ARGS_ASSERT_QERROR; if (PL_in_eval) { - if (PL_in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, + if (PL_in_eval & EVAL_KEEPERR) { + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, SVfARG(err)); - } - else - sv_catsv(ERRSV, err); + } + else + sv_catsv(ERRSV, err); } else if (PL_errors) - sv_catsv(PL_errors, err); + sv_catsv(PL_errors, err); else - Perl_warn(aTHX_ "%" SVf, SVfARG(err)); + Perl_warn(aTHX_ "%" SVf, SVfARG(err)); if (PL_parser) - ++PL_parser->error_count; + ++PL_parser->error_count; } @@ -1708,7 +1708,7 @@ Perl_die_unwind(pTHX_ SV *msv) PERL_ARGS_ASSERT_DIE_UNWIND; if (in_eval) { - I32 cxix; + I32 cxix; /* We need to keep this SV alive through all the stack unwinding * and FREETMPSing below, while ensuing that it doesn't leak @@ -1722,64 +1722,64 @@ Perl_die_unwind(pTHX_ SV *msv) exceptsv = sv_2mortal(SvREFCNT_inc_simple_NN(exceptsv)); } - /* - * Historically, perl used to set ERRSV ($@) early in the die - * process and rely on it not getting clobbered during unwinding. - * That sucked, because it was liable to get clobbered, so the - * setting of ERRSV used to emit the exception from eval{} has - * been moved to much later, after unwinding (see just before - * JMPENV_JUMP below). However, some modules were relying on the - * early setting, by examining $@ during unwinding to use it as - * a flag indicating whether the current unwinding was caused by - * an exception. It was never a reliable flag for that purpose, - * being totally open to false positives even without actual - * clobberage, but was useful enough for production code to - * semantically rely on it. - * - * We'd like to have a proper introspective interface that - * explicitly describes the reason for whatever unwinding - * operations are currently in progress, so that those modules - * work reliably and $@ isn't further overloaded. But we don't - * have one yet. In its absence, as a stopgap measure, ERRSV is - * now *additionally* set here, before unwinding, to serve as the - * (unreliable) flag that it used to. - * - * This behaviour is temporary, and should be removed when a - * proper way to detect exceptional unwinding has been developed. - * As of 2010-12, the authors of modules relying on the hack - * are aware of the issue, because the modules failed on - * perls 5.13.{1..7} which had late setting of $@ without this - * early-setting hack. - */ - if (!(in_eval & EVAL_KEEPERR)) { + /* + * Historically, perl used to set ERRSV ($@) early in the die + * process and rely on it not getting clobbered during unwinding. + * That sucked, because it was liable to get clobbered, so the + * setting of ERRSV used to emit the exception from eval{} has + * been moved to much later, after unwinding (see just before + * JMPENV_JUMP below). However, some modules were relying on the + * early setting, by examining $@ during unwinding to use it as + * a flag indicating whether the current unwinding was caused by + * an exception. It was never a reliable flag for that purpose, + * being totally open to false positives even without actual + * clobberage, but was useful enough for production code to + * semantically rely on it. + * + * We'd like to have a proper introspective interface that + * explicitly describes the reason for whatever unwinding + * operations are currently in progress, so that those modules + * work reliably and $@ isn't further overloaded. But we don't + * have one yet. In its absence, as a stopgap measure, ERRSV is + * now *additionally* set here, before unwinding, to serve as the + * (unreliable) flag that it used to. + * + * This behaviour is temporary, and should be removed when a + * proper way to detect exceptional unwinding has been developed. + * As of 2010-12, the authors of modules relying on the hack + * are aware of the issue, because the modules failed on + * perls 5.13.{1..7} which had late setting of $@ without this + * early-setting hack. + */ + if (!(in_eval & EVAL_KEEPERR)) { /* remove any read-only/magic from the SV, so we don't get infinite recursion when setting ERRSV */ SANE_ERRSV(); - sv_setsv_flags(ERRSV, exceptsv, + sv_setsv_flags(ERRSV, exceptsv, (SV_GMAGIC|SV_DO_COW_SVSETSV|SV_NOSTEAL)); } - if (in_eval & EVAL_KEEPERR) { - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, - SVfARG(exceptsv)); - } - - while ((cxix = dopoptoeval(cxstack_ix)) < 0 - && PL_curstackinfo->si_prev) - { - dounwind(-1); - POPSTACK; - } - - if (cxix >= 0) { - PERL_CONTEXT *cx; - SV **oldsp; + if (in_eval & EVAL_KEEPERR) { + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "\t(in cleanup) %" SVf, + SVfARG(exceptsv)); + } + + while ((cxix = dopoptoeval(cxstack_ix)) < 0 + && PL_curstackinfo->si_prev) + { + dounwind(-1); + POPSTACK; + } + + if (cxix >= 0) { + PERL_CONTEXT *cx; + SV **oldsp; U8 gimme; - JMPENV *restartjmpenv; - OP *restartop; + JMPENV *restartjmpenv; + OP *restartop; - if (cxix < cxstack_ix) - dounwind(cxix); + if (cxix < cxstack_ix) + dounwind(cxix); cx = CX_CUR(); assert(CxTYPE(cx) == CXt_EVAL); @@ -1787,12 +1787,12 @@ Perl_die_unwind(pTHX_ SV *msv) /* return false to the caller of eval */ oldsp = PL_stack_base + cx->blk_oldsp; gimme = cx->blk_gimme; - if (gimme == G_SCALAR) - *++oldsp = &PL_sv_undef; - PL_stack_sp = oldsp; + if (gimme == G_SCALAR) + *++oldsp = &PL_sv_undef; + PL_stack_sp = oldsp; - restartjmpenv = cx->blk_eval.cur_top_env; - restartop = cx->blk_eval.retop; + restartjmpenv = cx->blk_eval.cur_top_env; + restartop = cx->blk_eval.retop; /* We need a FREETMPS here to avoid late-called destructors * clobbering $@ *after* we set it below, e.g. @@ -1819,15 +1819,15 @@ Perl_die_unwind(pTHX_ SV *msv) */ S_pop_eval_context_maybe_croak(aTHX_ cx, exceptsv, 2); - if (!(in_eval & EVAL_KEEPERR)) { + if (!(in_eval & EVAL_KEEPERR)) { SANE_ERRSV(); - sv_setsv(ERRSV, exceptsv); + sv_setsv(ERRSV, exceptsv); } - PL_restartjmpenv = restartjmpenv; - PL_restartop = restartop; - JMPENV_JUMP(3); - NOT_REACHED; /* NOTREACHED */ - } + PL_restartjmpenv = restartjmpenv; + PL_restartop = restartop; + JMPENV_JUMP(3); + NOT_REACHED; /* NOTREACHED */ + } } write_to_stderr(exceptsv); @@ -1839,9 +1839,9 @@ PP(pp_xor) { dSP; dPOPTOPssrl; if (SvTRUE_NN(left) != SvTRUE_NN(right)) - RETSETYES; + RETSETYES; else - RETSETNO; + RETSETNO; } /* @@ -1875,21 +1875,21 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) const PERL_SI *top_si = PL_curstackinfo; for (;;) { - /* we may be in a higher stacklevel, so dig down deeper */ - while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { - top_si = top_si->si_prev; - ccstack = top_si->si_cxstack; - cxix = dopoptosub_at(ccstack, top_si->si_cxix); - } - if (cxix < 0) - return NULL; - /* caller() should not report the automatic calls to &DB::sub */ - if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 && - ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) - count++; - if (!count--) - break; - cxix = dopoptosub_at(ccstack, cxix - 1); + /* we may be in a higher stacklevel, so dig down deeper */ + while (cxix < 0 && top_si->si_type != PERLSI_MAIN) { + top_si = top_si->si_prev; + ccstack = top_si->si_cxstack; + cxix = dopoptosub_at(ccstack, top_si->si_cxix); + } + if (cxix < 0) + return NULL; + /* caller() should not report the automatic calls to &DB::sub */ + if (PL_DBsub && GvCV(PL_DBsub) && cxix >= 0 && + ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub)) + count++; + if (!count--) + break; + cxix = dopoptosub_at(ccstack, cxix - 1); } cx = &ccstack[cxix]; @@ -1897,11 +1897,11 @@ Perl_caller_cx(pTHX_ I32 count, const PERL_CONTEXT **dbcxp) if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { const I32 dbcxix = dopoptosub_at(ccstack, cxix - 1); - /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the - field below is defined for any cx. */ - /* caller() should not report the automatic calls to &DB::sub */ - if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) - cx = &ccstack[dbcxix]; + /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the + field below is defined for any cx. */ + /* caller() should not report the automatic calls to &DB::sub */ + if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) + cx = &ccstack[dbcxix]; } return cx; @@ -1920,17 +1920,17 @@ PP(pp_caller) if (MAXARG) { if (has_arg) - count = POPi; + count = POPi; else (void)POPs; } cx = caller_cx(count + !!(PL_op->op_private & OPpOFFBYONE), &dbcx); if (!cx) { - if (gimme != G_ARRAY) { - EXTEND(SP, 1); - RETPUSHUNDEF; - } - RETURN; + if (gimme != G_ARRAY) { + EXTEND(SP, 1); + RETPUSHUNDEF; + } + RETURN; } CX_DEBUG(cx, "CALLER"); @@ -1940,56 +1940,56 @@ PP(pp_caller) : NULL; if (gimme != G_ARRAY) { EXTEND(SP, 1); - if (!stash_hek) - PUSHs(&PL_sv_undef); - else { - dTARGET; - sv_sethek(TARG, stash_hek); - PUSHs(TARG); - } - RETURN; + if (!stash_hek) + PUSHs(&PL_sv_undef); + else { + dTARGET; + sv_sethek(TARG, stash_hek); + PUSHs(TARG); + } + RETURN; } EXTEND(SP, 11); if (!stash_hek) - PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); else { - dTARGET; - sv_sethek(TARG, stash_hek); - PUSHTARG; + dTARGET; + sv_sethek(TARG, stash_hek); + PUSHTARG; } mPUSHs(newSVpv(OutCopFILE(cx->blk_oldcop), 0)); lcop = closest_cop(cx->blk_oldcop, OpSIBLING(cx->blk_oldcop), - cx->blk_sub.retop, TRUE); + cx->blk_sub.retop, TRUE); if (!lcop) - lcop = cx->blk_oldcop; + lcop = cx->blk_oldcop; mPUSHu(CopLINE(lcop)); if (!has_arg) - RETURN; + RETURN; if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - /* So is ccstack[dbcxix]. */ - if (CvHASGV(dbcx->blk_sub.cv)) { - PUSHs(cv_name(dbcx->blk_sub.cv, 0, 0)); - PUSHs(boolSV(CxHASARGS(cx))); - } - else { - PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP)); - PUSHs(boolSV(CxHASARGS(cx))); - } + /* So is ccstack[dbcxix]. */ + if (CvHASGV(dbcx->blk_sub.cv)) { + PUSHs(cv_name(dbcx->blk_sub.cv, 0, 0)); + PUSHs(boolSV(CxHASARGS(cx))); + } + else { + PUSHs(newSVpvs_flags("(unknown)", SVs_TEMP)); + PUSHs(boolSV(CxHASARGS(cx))); + } } else { - PUSHs(newSVpvs_flags("(eval)", SVs_TEMP)); - PUSHs(&PL_sv_zero); + PUSHs(newSVpvs_flags("(eval)", SVs_TEMP)); + PUSHs(&PL_sv_zero); } gimme = cx->blk_gimme; if (gimme == G_VOID) - PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); else - PUSHs(boolSV((gimme & G_WANT) == G_ARRAY)); + PUSHs(boolSV((gimme & G_WANT) == G_ARRAY)); if (CxTYPE(cx) == CXt_EVAL) { - /* eval STRING */ - if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) { + /* eval STRING */ + if (CxOLD_OP_TYPE(cx) == OP_ENTEREVAL) { SV *cur_text = cx->blk_eval.cur_text; if (SvCUR(cur_text) >= 2) { PUSHs(newSVpvn_flags(SvPVX(cur_text), SvCUR(cur_text)-2, @@ -2000,61 +2000,61 @@ PP(pp_caller) PUSHs(sv_2mortal(newSVsv(cur_text))); } - PUSHs(&PL_sv_no); - } - /* require */ - else if (cx->blk_eval.old_namesv) { - mPUSHs(newSVsv(cx->blk_eval.old_namesv)); - PUSHs(&PL_sv_yes); - } - /* eval BLOCK (try blocks have old_namesv == 0) */ - else { - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_undef); - } + PUSHs(&PL_sv_no); + } + /* require */ + else if (cx->blk_eval.old_namesv) { + mPUSHs(newSVsv(cx->blk_eval.old_namesv)); + PUSHs(&PL_sv_yes); + } + /* eval BLOCK (try blocks have old_namesv == 0) */ + else { + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); + } } else { - PUSHs(&PL_sv_undef); - PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); } if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx) - && CopSTASH_eq(PL_curcop, PL_debstash)) + && CopSTASH_eq(PL_curcop, PL_debstash)) { /* slot 0 of the pad contains the original @_ */ - AV * const ary = MUTABLE_AV(AvARRAY(MUTABLE_AV( + AV * const ary = MUTABLE_AV(AvARRAY(MUTABLE_AV( PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ cx->blk_sub.olddepth+1]))[0]); - const SSize_t off = AvARRAY(ary) - AvALLOC(ary); + const SSize_t off = AvARRAY(ary) - AvALLOC(ary); - Perl_init_dbargs(aTHX); + Perl_init_dbargs(aTHX); - if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) - av_extend(PL_dbargs, AvFILLp(ary) + off); + if (AvMAX(PL_dbargs) < AvFILLp(ary) + off) + av_extend(PL_dbargs, AvFILLp(ary) + off); if (AvFILLp(ary) + 1 + off) Copy(AvALLOC(ary), AvARRAY(PL_dbargs), AvFILLp(ary) + 1 + off, SV*); - AvFILLp(PL_dbargs) = AvFILLp(ary) + off; + AvFILLp(PL_dbargs) = AvFILLp(ary) + off; } mPUSHi(CopHINTS_get(cx->blk_oldcop)); { - SV * mask ; - STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ; + SV * mask ; + STRLEN * const old_warnings = cx->blk_oldcop->cop_warnings ; - if (old_warnings == pWARN_NONE) + if (old_warnings == pWARN_NONE) mask = newSVpvn(WARN_NONEstring, WARNsize) ; - else if (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0) + else if (old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0) mask = &PL_sv_undef ; else if (old_warnings == pWARN_ALL || - (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) { - mask = newSVpvn(WARN_ALLstring, WARNsize) ; - } + (old_warnings == pWARN_STD && PL_dowarn & G_WARN_ON)) { + mask = newSVpvn(WARN_ALLstring, WARNsize) ; + } else mask = newSVpvn((char *) (old_warnings + 1), old_warnings[0]); mPUSHs(mask); } PUSHs(cx->blk_oldcop->cop_hints_hash ? - sv_2mortal(newRV_noinc(MUTABLE_SV(cop_hints_2hv(cx->blk_oldcop, 0)))) - : &PL_sv_undef); + sv_2mortal(newRV_noinc(MUTABLE_SV(cop_hints_2hv(cx->blk_oldcop, 0)))) + : &PL_sv_undef); RETURN; } @@ -2065,10 +2065,10 @@ PP(pp_reset) STRLEN len = 0; if (MAXARG < 1 || (!TOPs && !POPs)) { EXTEND(SP, 1); - tmps = NULL, len = 0; + tmps = NULL, len = 0; } else - tmps = SvPVx_const(POPs, len); + tmps = SvPVx_const(POPs, len); sv_resetpvn(tmps, len, CopSTASH(PL_curcop)); PUSHs(&PL_sv_yes); RETURN; @@ -2086,39 +2086,39 @@ PP(pp_dbstate) PERL_ASYNC_CHECK(); if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */ - || PL_DBsingle_iv || PL_DBsignal_iv || PL_DBtrace_iv) + || PL_DBsingle_iv || PL_DBsignal_iv || PL_DBtrace_iv) { - dSP; - PERL_CONTEXT *cx; - const U8 gimme = G_ARRAY; - GV * const gv = PL_DBgv; - CV * cv = NULL; + dSP; + PERL_CONTEXT *cx; + const U8 gimme = G_ARRAY; + GV * const gv = PL_DBgv; + CV * cv = NULL; if (gv && isGV_with_GP(gv)) cv = GvCV(gv); - if (!cv || (!CvROOT(cv) && !CvXSUB(cv))) - DIE(aTHX_ "No DB::DB routine defined"); + if (!cv || (!CvROOT(cv) && !CvXSUB(cv))) + DIE(aTHX_ "No DB::DB routine defined"); - if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG)) - /* don't do recursive DB::DB call */ - return NORMAL; + if (CvDEPTH(cv) >= 1 && !(PL_debug & DEBUG_DB_RECURSE_FLAG)) + /* don't do recursive DB::DB call */ + return NORMAL; - if (CvISXSUB(cv)) { + if (CvISXSUB(cv)) { ENTER; SAVEI32(PL_debug); PL_debug = 0; SAVESTACK_POS(); SAVETMPS; - PUSHMARK(SP); - (void)(*CvXSUB(cv))(aTHX_ cv); - FREETMPS; - LEAVE; - return NORMAL; - } - else { - cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix); - cx_pushsub(cx, cv, PL_op->op_next, 0); + PUSHMARK(SP); + (void)(*CvXSUB(cv))(aTHX_ cv); + FREETMPS; + LEAVE; + return NORMAL; + } + else { + cx = cx_pushblock(CXt_SUB, gimme, SP, PL_savestack_ix); + cx_pushsub(cx, cv, PL_op->op_next, 0); /* OP_DBSTATE's op_private holds hint bits rather than * the lvalue-ish flags seen in OP_ENTERSUB. So cancel * any CxLVAL() flags that have now been mis-calculated */ @@ -2127,15 +2127,15 @@ PP(pp_dbstate) SAVEI32(PL_debug); PL_debug = 0; SAVESTACK_POS(); - CvDEPTH(cv)++; - if (CvDEPTH(cv) >= 2) - pad_push(CvPADLIST(cv), CvDEPTH(cv)); - PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv)); - RETURNOP(CvSTART(cv)); - } + CvDEPTH(cv)++; + if (CvDEPTH(cv) >= 2) + pad_push(CvPADLIST(cv), CvDEPTH(cv)); + PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv)); + RETURNOP(CvSTART(cv)); + } } else - return NORMAL; + return NORMAL; } @@ -2159,7 +2159,7 @@ PP(pp_leave) if (PL_op->op_flags & OPf_SPECIAL) /* fake block should preserve $1 et al; e.g. /(...)/ while ...; */ - cx->blk_oldpm = PL_curpm; + cx->blk_oldpm = PL_curpm; oldsp = PL_stack_base + cx->blk_oldsp; gimme = cx->blk_gimme; @@ -2209,21 +2209,21 @@ PP(pp_enteriter) U8 cxflags = 0; if (PL_op->op_targ) { /* "my" variable */ - itervarp = &PAD_SVl(PL_op->op_targ); + itervarp = &PAD_SVl(PL_op->op_targ); itersave = *(SV**)itervarp; assert(itersave); - if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */ + if (PL_op->op_private & OPpLVAL_INTRO) { /* for my $x (...) */ /* the SV currently in the pad slot is never live during * iteration (the slot is always aliased to one of the items) * so it's always stale */ - SvPADSTALE_on(itersave); - } + SvPADSTALE_on(itersave); + } SvREFCNT_inc_simple_void_NN(itersave); - cxflags = CXp_FOR_PAD; + cxflags = CXp_FOR_PAD; } else { - SV * const sv = POPs; - itervarp = (void *)sv; + SV * const sv = POPs; + itervarp = (void *)sv; if (LIKELY(isGV(sv))) { /* symbol table variable */ itersave = GvSV(sv); SvREFCNT_inc_simple_void(itersave); @@ -2254,56 +2254,56 @@ PP(pp_enteriter) /* OPf_STACKED implies either a single array: for(@), with a * single AV on the stack, or a range: for (1..5), with 1 and 5 on * the stack */ - SV *maybe_ary = POPs; - if (SvTYPE(maybe_ary) != SVt_PVAV) { + SV *maybe_ary = POPs; + if (SvTYPE(maybe_ary) != SVt_PVAV) { /* range */ - dPOPss; - SV * const right = maybe_ary; - if (UNLIKELY(cxflags & CXp_FOR_LVREF)) - DIE(aTHX_ "Assigned value is not a reference"); - SvGETMAGIC(sv); - SvGETMAGIC(right); - if (RANGE_IS_NUMERIC(sv,right)) { - cx->cx_type |= CXt_LOOP_LAZYIV; - if (S_outside_integer(aTHX_ sv) || + dPOPss; + SV * const right = maybe_ary; + if (UNLIKELY(cxflags & CXp_FOR_LVREF)) + DIE(aTHX_ "Assigned value is not a reference"); + SvGETMAGIC(sv); + SvGETMAGIC(right); + if (RANGE_IS_NUMERIC(sv,right)) { + cx->cx_type |= CXt_LOOP_LAZYIV; + if (S_outside_integer(aTHX_ sv) || S_outside_integer(aTHX_ right)) - DIE(aTHX_ "Range iterator outside integer range"); - cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv); - cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right); - } - else { - cx->cx_type |= CXt_LOOP_LAZYSV; - cx->blk_loop.state_u.lazysv.cur = newSVsv(sv); - cx->blk_loop.state_u.lazysv.end = right; - SvREFCNT_inc_simple_void_NN(right); - (void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur); - /* This will do the upgrade to SVt_PV, and warn if the value - is uninitialised. */ - (void) SvPV_nolen_const(right); - /* Doing this avoids a check every time in pp_iter in pp_hot.c - to replace !SvOK() with a pointer to "". */ - if (!SvOK(right)) { - SvREFCNT_dec(right); - cx->blk_loop.state_u.lazysv.end = &PL_sv_no; - } - } - } - else /* SvTYPE(maybe_ary) == SVt_PVAV */ { + DIE(aTHX_ "Range iterator outside integer range"); + cx->blk_loop.state_u.lazyiv.cur = SvIV_nomg(sv); + cx->blk_loop.state_u.lazyiv.end = SvIV_nomg(right); + } + else { + cx->cx_type |= CXt_LOOP_LAZYSV; + cx->blk_loop.state_u.lazysv.cur = newSVsv(sv); + cx->blk_loop.state_u.lazysv.end = right; + SvREFCNT_inc_simple_void_NN(right); + (void) SvPV_force_nolen(cx->blk_loop.state_u.lazysv.cur); + /* This will do the upgrade to SVt_PV, and warn if the value + is uninitialised. */ + (void) SvPV_nolen_const(right); + /* Doing this avoids a check every time in pp_iter in pp_hot.c + to replace !SvOK() with a pointer to "". */ + if (!SvOK(right)) { + SvREFCNT_dec(right); + cx->blk_loop.state_u.lazysv.end = &PL_sv_no; + } + } + } + else /* SvTYPE(maybe_ary) == SVt_PVAV */ { /* for (@array) {} */ cx->cx_type |= CXt_LOOP_ARY; - cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary); - SvREFCNT_inc_simple_void_NN(maybe_ary); - cx->blk_loop.state_u.ary.ix = - (PL_op->op_private & OPpITER_REVERSED) ? - AvFILL(cx->blk_loop.state_u.ary.ary) + 1 : - -1; - } + cx->blk_loop.state_u.ary.ary = MUTABLE_AV(maybe_ary); + SvREFCNT_inc_simple_void_NN(maybe_ary); + cx->blk_loop.state_u.ary.ix = + (PL_op->op_private & OPpITER_REVERSED) ? + AvFILL(cx->blk_loop.state_u.ary.ary) + 1 : + -1; + } /* EXTEND(SP, 1) not needed in this branch because we just did POPs */ } else { /* iterating over items on the stack */ cx->cx_type |= CXt_LOOP_LIST; cx->blk_oldsp = SP - PL_stack_base; - cx->blk_loop.state_u.stack.basesp = MARK - PL_stack_base; + cx->blk_loop.state_u.stack.basesp = MARK - PL_stack_base; cx->blk_loop.state_u.stack.ix = (PL_op->op_private & OPpITER_REVERSED) ? cx->blk_oldsp + 1 @@ -2381,7 +2381,7 @@ PP(pp_leavesublv) /* entry zero of a stack is always PL_sv_undef, which * simplifies converting a '()' return into undef in scalar context */ assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef); - return 0; + return 0; } gimme = cx->blk_gimme; @@ -2527,7 +2527,7 @@ PP(pp_return) CxTYPE(cx) == CXt_SUB && CvLVALUE(cx->blk_sub.cv) ? 3 : 0); SPAGAIN; - dounwind(cxix); + dounwind(cxix); cx = &cxstack[cxix]; /* CX stack may have been realloced */ } else { @@ -2573,7 +2573,7 @@ PP(pp_return) case CXt_FORMAT: return Perl_pp_leavewrite(aTHX); default: - DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx)); + DIE(aTHX_ "panic: return, type=%u", (unsigned) CxTYPE(cx)); } } @@ -2584,29 +2584,29 @@ S_unwind_loop(pTHX) { I32 cxix; if (PL_op->op_flags & OPf_SPECIAL) { - cxix = dopoptoloop(cxstack_ix); - if (cxix < 0) - /* diag_listed_as: Can't "last" outside a loop block */ - Perl_croak(aTHX_ "Can't \"%s\" outside a loop block", + cxix = dopoptoloop(cxstack_ix); + if (cxix < 0) + /* diag_listed_as: Can't "last" outside a loop block */ + Perl_croak(aTHX_ "Can't \"%s\" outside a loop block", OP_NAME(PL_op)); } else { - dSP; - STRLEN label_len; - const char * const label = - PL_op->op_flags & OPf_STACKED - ? SvPV(TOPs,label_len) - : (label_len = strlen(cPVOP->op_pv), cPVOP->op_pv); - const U32 label_flags = - PL_op->op_flags & OPf_STACKED - ? SvUTF8(POPs) - : (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0; - PUTBACK; + dSP; + STRLEN label_len; + const char * const label = + PL_op->op_flags & OPf_STACKED + ? SvPV(TOPs,label_len) + : (label_len = strlen(cPVOP->op_pv), cPVOP->op_pv); + const U32 label_flags = + PL_op->op_flags & OPf_STACKED + ? SvUTF8(POPs) + : (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0; + PUTBACK; cxix = dopoptolabel(label, label_len, label_flags); - if (cxix < 0) - /* diag_listed_as: Label not found for "last %s" */ - Perl_croak(aTHX_ "Label not found for \"%s %" SVf "\"", - OP_NAME(PL_op), + if (cxix < 0) + /* diag_listed_as: Label not found for "last %s" */ + Perl_croak(aTHX_ "Label not found for \"%s %" SVf "\"", + OP_NAME(PL_op), SVfARG(PL_op->op_flags & OPf_STACKED && !SvGMAGICAL(TOPp1s) ? TOPp1s @@ -2615,7 +2615,7 @@ S_unwind_loop(pTHX) label_flags | SVs_TEMP))); } if (cxix < cxstack_ix) - dounwind(cxix); + dounwind(cxix); return &cxstack[cxix]; } @@ -2667,11 +2667,11 @@ PP(pp_redo) OP* redo_op = cx->blk_loop.my_op->op_redoop; if (redo_op->op_type == OP_ENTER) { - /* pop one less context to avoid $x being freed in while (my $x..) */ - cxstack_ix++; + /* pop one less context to avoid $x being freed in while (my $x..) */ + cxstack_ix++; cx = CX_CUR(); - assert(CxTYPE(cx) == CXt_BLOCK); - redo_op = redo_op->op_next; + assert(CxTYPE(cx) == CXt_BLOCK); + redo_op = redo_op->op_next; } FREETMPS; @@ -2694,47 +2694,47 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac PERL_ARGS_ASSERT_DOFINDLABEL; if (ops >= oplimit) - Perl_croak(aTHX_ "%s", too_deep); + Perl_croak(aTHX_ "%s", too_deep); if (o->op_type == OP_LEAVE || - o->op_type == OP_SCOPE || - o->op_type == OP_LEAVELOOP || - o->op_type == OP_LEAVESUB || - o->op_type == OP_LEAVETRY || - o->op_type == OP_LEAVEGIVEN) + o->op_type == OP_SCOPE || + o->op_type == OP_LEAVELOOP || + o->op_type == OP_LEAVESUB || + o->op_type == OP_LEAVETRY || + o->op_type == OP_LEAVEGIVEN) { - *ops++ = cUNOPo->op_first; + *ops++ = cUNOPo->op_first; } else if (oplimit - opstack < GOTO_DEPTH) { if (o->op_flags & OPf_KIDS - && cUNOPo->op_first->op_type == OP_PUSHMARK) { - *ops++ = UNENTERABLE; + && cUNOPo->op_first->op_type == OP_PUSHMARK) { + *ops++ = UNENTERABLE; } else if (o->op_flags & OPf_KIDS && PL_opargs[o->op_type] - && OP_CLASS(o) != OA_LOGOP - && o->op_type != OP_LINESEQ - && o->op_type != OP_SREFGEN - && o->op_type != OP_ENTEREVAL - && o->op_type != OP_GLOB - && o->op_type != OP_RV2CV) { - OP * const kid = cUNOPo->op_first; - if (OP_GIMME(kid, 0) != G_SCALAR || OpHAS_SIBLING(kid)) - *ops++ = UNENTERABLE; + && OP_CLASS(o) != OA_LOGOP + && o->op_type != OP_LINESEQ + && o->op_type != OP_SREFGEN + && o->op_type != OP_ENTEREVAL + && o->op_type != OP_GLOB + && o->op_type != OP_RV2CV) { + OP * const kid = cUNOPo->op_first; + if (OP_GIMME(kid, 0) != G_SCALAR || OpHAS_SIBLING(kid)) + *ops++ = UNENTERABLE; } } if (ops >= oplimit) - Perl_croak(aTHX_ "%s", too_deep); + Perl_croak(aTHX_ "%s", too_deep); *ops = 0; if (o->op_flags & OPf_KIDS) { - OP *kid; - OP * const kid1 = cUNOPo->op_first; - /* First try all the kids at this level, since that's likeliest. */ - for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { - if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { + OP *kid; + OP * const kid1 = cUNOPo->op_first; + /* First try all the kids at this level, since that's likeliest. */ + for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { STRLEN kid_label_len; U32 kid_label_flags; - const char *kid_label = CopLABEL_len_flags(kCOP, + const char *kid_label = CopLABEL_len_flags(kCOP, &kid_label_len, &kid_label_flags); - if (kid_label && ( + if (kid_label && ( ( (kid_label_flags & SVf_UTF8) != (flags & SVf_UTF8) ) ? (flags & SVf_UTF8) ? (bytes_cmp_utf8( @@ -2745,32 +2745,32 @@ S_dofindlabel(pTHX_ OP *o, const char *label, STRLEN len, U32 flags, OP **opstac (const U8*)kid_label, kid_label_len) == 0) : ( len == kid_label_len && ((kid_label == label) || memEQ(kid_label, label, len))))) - return kid; - } - } - for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { - bool first_kid_of_binary = FALSE; - if (kid == PL_lastgotoprobe) - continue; - if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { - if (ops == opstack) - *ops++ = kid; - else if (ops[-1] != UNENTERABLE - && (ops[-1]->op_type == OP_NEXTSTATE || - ops[-1]->op_type == OP_DBSTATE)) - ops[-1] = kid; - else - *ops++ = kid; - } - if (kid == kid1 && ops != opstack && ops[-1] == UNENTERABLE) { - first_kid_of_binary = TRUE; - ops--; - } - if ((o = dofindlabel(kid, label, len, flags, ops, oplimit))) - return o; - if (first_kid_of_binary) - *ops++ = UNENTERABLE; - } + return kid; + } + } + for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { + bool first_kid_of_binary = FALSE; + if (kid == PL_lastgotoprobe) + continue; + if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) { + if (ops == opstack) + *ops++ = kid; + else if (ops[-1] != UNENTERABLE + && (ops[-1]->op_type == OP_NEXTSTATE || + ops[-1]->op_type == OP_DBSTATE)) + ops[-1] = kid; + else + *ops++ = kid; + } + if (kid == kid1 && ops != opstack && ops[-1] == UNENTERABLE) { + first_kid_of_binary = TRUE; + ops--; + } + if ((o = dofindlabel(kid, label, len, flags, ops, oplimit))) + return o; + if (first_kid_of_binary) + *ops++ = UNENTERABLE; + } } *ops = 0; return 0; @@ -2784,7 +2784,7 @@ S_check_op_type(pTHX_ OP * const o) * for each op. For now, we punt on the hard ones. */ /* XXX This comment seems to me like wishful thinking. --sprout */ if (o == UNENTERABLE) - Perl_croak(aTHX_ + Perl_croak(aTHX_ "Can't \"goto\" into a binary or list expression"); if (o->op_type == OP_ENTERITER) Perl_croak(aTHX_ @@ -2812,74 +2812,74 @@ PP(pp_goto) if (PL_op->op_flags & OPf_STACKED) { /* goto EXPR or goto &foo */ - SV * const sv = POPs; - SvGETMAGIC(sv); + SV * const sv = POPs; + SvGETMAGIC(sv); - if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVCV) { /* This egregious kludge implements goto &subroutine */ - I32 cxix; - PERL_CONTEXT *cx; - CV *cv = MUTABLE_CV(SvRV(sv)); - AV *arg = GvAV(PL_defgv); - - while (!CvROOT(cv) && !CvXSUB(cv)) { - const GV * const gv = CvGV(cv); - if (gv) { - GV *autogv; - SV *tmpstr; - /* autoloaded stub? */ - if (cv != GvCV(gv) && (cv = GvCV(gv))) - continue; - autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), - GvNAMELEN(gv), + I32 cxix; + PERL_CONTEXT *cx; + CV *cv = MUTABLE_CV(SvRV(sv)); + AV *arg = GvAV(PL_defgv); + + while (!CvROOT(cv) && !CvXSUB(cv)) { + const GV * const gv = CvGV(cv); + if (gv) { + GV *autogv; + SV *tmpstr; + /* autoloaded stub? */ + if (cv != GvCV(gv) && (cv = GvCV(gv))) + continue; + autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), + GvNAMELEN(gv), GvNAMEUTF8(gv) ? SVf_UTF8 : 0); - if (autogv && (cv = GvCV(autogv))) - continue; - tmpstr = sv_newmortal(); - gv_efullname3(tmpstr, gv, NULL); - DIE(aTHX_ "Goto undefined subroutine &%" SVf, SVfARG(tmpstr)); - } - DIE(aTHX_ "Goto undefined subroutine"); - } - - cxix = dopopto_cursub(); + if (autogv && (cv = GvCV(autogv))) + continue; + tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, gv, NULL); + DIE(aTHX_ "Goto undefined subroutine &%" SVf, SVfARG(tmpstr)); + } + DIE(aTHX_ "Goto undefined subroutine"); + } + + cxix = dopopto_cursub(); if (cxix < 0) { DIE(aTHX_ "Can't goto subroutine outside a subroutine"); } cx = &cxstack[cxix]; - /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */ - if (CxTYPE(cx) == CXt_EVAL) { - if (CxREALEVAL(cx)) - /* diag_listed_as: Can't goto subroutine from an eval-%s */ - DIE(aTHX_ "Can't goto subroutine from an eval-string"); - else - /* diag_listed_as: Can't goto subroutine from an eval-%s */ - DIE(aTHX_ "Can't goto subroutine from an eval-block"); - } - else if (CxMULTICALL(cx)) - DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)"); - - /* First do some returnish stuff. */ - - SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */ - FREETMPS; - if (cxix < cxstack_ix) { - dounwind(cxix); + /* ban goto in eval: see <20050521150056.GC20213@iabyn.com> */ + if (CxTYPE(cx) == CXt_EVAL) { + if (CxREALEVAL(cx)) + /* diag_listed_as: Can't goto subroutine from an eval-%s */ + DIE(aTHX_ "Can't goto subroutine from an eval-string"); + else + /* diag_listed_as: Can't goto subroutine from an eval-%s */ + DIE(aTHX_ "Can't goto subroutine from an eval-block"); + } + else if (CxMULTICALL(cx)) + DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)"); + + /* First do some returnish stuff. */ + + SvREFCNT_inc_simple_void(cv); /* avoid premature free during unwind */ + FREETMPS; + if (cxix < cxstack_ix) { + dounwind(cxix); } cx = CX_CUR(); - cx_topblock(cx); - SPAGAIN; + cx_topblock(cx); + SPAGAIN; /* protect @_ during save stack unwind. */ if (arg) SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg))); - assert(PL_scopestack_ix == cx->blk_oldscopesp); + assert(PL_scopestack_ix == cx->blk_oldscopesp); CX_LEAVE_SCOPE(cx); - if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) { + if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) { /* this is part of cx_popsub_args() */ - AV* av = MUTABLE_AV(PAD_SVl(0)); + AV* av = MUTABLE_AV(PAD_SVl(0)); assert(AvARRAY(MUTABLE_AV( PadlistARRAY(CvPADLIST(cx->blk_sub.cv))[ CvDEPTH(cx->blk_sub.cv)])) == PL_curpad); @@ -2890,10 +2890,10 @@ PP(pp_goto) * unless pad[0] and @_ differ (e.g. if the old sub did * local *_ = []); in which case clear the old pad[0] * array in the usual way */ - if (av == arg || AvREAL(av)) + if (av == arg || AvREAL(av)) clear_defarray(av, av == arg); - else CLEAR_ARGARRAY(av); - } + else CLEAR_ARGARRAY(av); + } /* don't restore PL_comppad here. It won't be needed if the * sub we're going to is non-XS, but restoring it early then @@ -2901,66 +2901,66 @@ PP(pp_goto) * means the CX block gets processed again in dounwind, * but this time with the wrong PL_comppad */ - /* A destructor called during LEAVE_SCOPE could have undefined - * our precious cv. See bug #99850. */ - if (!CvROOT(cv) && !CvXSUB(cv)) { - const GV * const gv = CvGV(cv); - if (gv) { - SV * const tmpstr = sv_newmortal(); - gv_efullname3(tmpstr, gv, NULL); - DIE(aTHX_ "Goto undefined subroutine &%" SVf, - SVfARG(tmpstr)); - } - DIE(aTHX_ "Goto undefined subroutine"); - } - - if (CxTYPE(cx) == CXt_SUB) { - CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth; + /* A destructor called during LEAVE_SCOPE could have undefined + * our precious cv. See bug #99850. */ + if (!CvROOT(cv) && !CvXSUB(cv)) { + const GV * const gv = CvGV(cv); + if (gv) { + SV * const tmpstr = sv_newmortal(); + gv_efullname3(tmpstr, gv, NULL); + DIE(aTHX_ "Goto undefined subroutine &%" SVf, + SVfARG(tmpstr)); + } + DIE(aTHX_ "Goto undefined subroutine"); + } + + if (CxTYPE(cx) == CXt_SUB) { + CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth; SvREFCNT_dec_NN(cx->blk_sub.cv); } - /* Now do some callish stuff. */ - if (CvISXSUB(cv)) { - const SSize_t items = arg ? AvFILL(arg) + 1 : 0; - const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0; - SV** mark; + /* Now do some callish stuff. */ + if (CvISXSUB(cv)) { + const SSize_t items = arg ? AvFILL(arg) + 1 : 0; + const bool m = arg ? cBOOL(SvRMAGICAL(arg)) : 0; + SV** mark; ENTER; SAVETMPS; SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ - /* put GvAV(defgv) back onto stack */ - if (items) { - EXTEND(SP, items+1); /* @_ could have been extended. */ - } - mark = SP; - if (items) { - SSize_t index; - bool r = cBOOL(AvREAL(arg)); - for (index=0; indexblk_sub.retop; + retop = cx->blk_sub.retop; PL_comppad = cx->blk_sub.prevcomppad; PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL; - /* XS subs don't have a CXt_SUB, so pop it; + /* XS subs don't have a CXt_SUB, so pop it; * this is a cx_popblock(), less all the stuff we already did * for cx_topblock() earlier */ PL_curcop = cx->blk_oldcop; @@ -2969,78 +2969,78 @@ PP(pp_goto) CX_POP(cx); - /* Push a mark for the start of arglist */ - PUSHMARK(mark); - PUTBACK; - (void)(*CvXSUB(cv))(aTHX_ cv); - LEAVE; - goto _return; - } - else { - PADLIST * const padlist = CvPADLIST(cv); + /* Push a mark for the start of arglist */ + PUSHMARK(mark); + PUTBACK; + (void)(*CvXSUB(cv))(aTHX_ cv); + LEAVE; + goto _return; + } + else { + PADLIST * const padlist = CvPADLIST(cv); SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */ /* partial unrolled cx_pushsub(): */ - cx->blk_sub.cv = cv; - cx->blk_sub.olddepth = CvDEPTH(cv); + cx->blk_sub.cv = cv; + cx->blk_sub.olddepth = CvDEPTH(cv); - CvDEPTH(cv)++; + CvDEPTH(cv)++; SvREFCNT_inc_simple_void_NN(cv); - if (CvDEPTH(cv) > 1) { - if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION)) - sub_crush_depth(cv); - pad_push(padlist, CvDEPTH(cv)); - } - PL_curcop = cx->blk_oldcop; - PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); - if (CxHASARGS(cx)) - { + if (CvDEPTH(cv) > 1) { + if (CvDEPTH(cv) == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION)) + sub_crush_depth(cv); + pad_push(padlist, CvDEPTH(cv)); + } + PL_curcop = cx->blk_oldcop; + PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv)); + if (CxHASARGS(cx)) + { /* second half of donating @_ from the old sub to the * new sub: abandon the original pad[0] AV in the * new sub, and replace it with the donated @_. * pad[0] takes ownership of the extra refcount * we gave arg earlier */ - if (arg) { - SvREFCNT_dec(PAD_SVl(0)); - PAD_SVl(0) = (SV *)arg; + if (arg) { + SvREFCNT_dec(PAD_SVl(0)); + PAD_SVl(0) = (SV *)arg; SvREFCNT_inc_simple_void_NN(arg); - } - - /* GvAV(PL_defgv) might have been modified on scope - exit, so point it at arg again. */ - if (arg != GvAV(PL_defgv)) { - AV * const av = GvAV(PL_defgv); - GvAV(PL_defgv) = (AV *)SvREFCNT_inc_simple(arg); - SvREFCNT_dec(av); - } - } - - if (PERLDB_SUB) { /* Checking curstash breaks DProf. */ - Perl_get_db_sub(aTHX_ NULL, cv); - if (PERLDB_GOTO) { - CV * const gotocv = get_cvs("DB::goto", 0); - if (gotocv) { - PUSHMARK( PL_stack_sp ); - call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG); - PL_stack_sp--; - } - } - } - retop = CvSTART(cv); - goto putback_return; - } - } - else { + } + + /* GvAV(PL_defgv) might have been modified on scope + exit, so point it at arg again. */ + if (arg != GvAV(PL_defgv)) { + AV * const av = GvAV(PL_defgv); + GvAV(PL_defgv) = (AV *)SvREFCNT_inc_simple(arg); + SvREFCNT_dec(av); + } + } + + if (PERLDB_SUB) { /* Checking curstash breaks DProf. */ + Perl_get_db_sub(aTHX_ NULL, cv); + if (PERLDB_GOTO) { + CV * const gotocv = get_cvs("DB::goto", 0); + if (gotocv) { + PUSHMARK( PL_stack_sp ); + call_sv(MUTABLE_SV(gotocv), G_SCALAR | G_NODEBUG); + PL_stack_sp--; + } + } + } + retop = CvSTART(cv); + goto putback_return; + } + } + else { /* goto EXPR */ - label = SvPV_nomg_const(sv, label_len); + label = SvPV_nomg_const(sv, label_len); label_flags = SvUTF8(sv); - } + } } else if (!(PL_op->op_flags & OPf_SPECIAL)) { /* goto LABEL or dump LABEL */ - label = cPVOP->op_pv; + label = cPVOP->op_pv; label_flags = (cPVOP->op_private & OPpPV_IS_UTF8) ? SVf_UTF8 : 0; label_len = strlen(label); } @@ -3049,27 +3049,27 @@ PP(pp_goto) PERL_ASYNC_CHECK(); if (label_len) { - OP *gotoprobe = NULL; - bool leaving_eval = FALSE; - bool in_block = FALSE; - bool pseudo_block = FALSE; - PERL_CONTEXT *last_eval_cx = NULL; - - /* find label */ - - PL_lastgotoprobe = NULL; - *enterops = 0; - for (ix = cxstack_ix; ix >= 0; ix--) { - cx = &cxstack[ix]; - switch (CxTYPE(cx)) { - case CXt_EVAL: - leaving_eval = TRUE; + OP *gotoprobe = NULL; + bool leaving_eval = FALSE; + bool in_block = FALSE; + bool pseudo_block = FALSE; + PERL_CONTEXT *last_eval_cx = NULL; + + /* find label */ + + PL_lastgotoprobe = NULL; + *enterops = 0; + for (ix = cxstack_ix; ix >= 0; ix--) { + cx = &cxstack[ix]; + switch (CxTYPE(cx)) { + case CXt_EVAL: + leaving_eval = TRUE; if (!CxTRYBLOCK(cx)) { - gotoprobe = (last_eval_cx ? - last_eval_cx->blk_eval.old_eval_root : - PL_eval_root); - last_eval_cx = cx; - break; + gotoprobe = (last_eval_cx ? + last_eval_cx->blk_eval.old_eval_root : + PL_eval_root); + last_eval_cx = cx; + break; } /* else fall through */ case CXt_LOOP_PLAIN: @@ -3077,118 +3077,118 @@ PP(pp_goto) case CXt_LOOP_LAZYSV: case CXt_LOOP_LIST: case CXt_LOOP_ARY: - case CXt_GIVEN: - case CXt_WHEN: - gotoprobe = OpSIBLING(cx->blk_oldcop); - break; - case CXt_SUBST: - continue; - case CXt_BLOCK: - if (ix) { - gotoprobe = OpSIBLING(cx->blk_oldcop); - in_block = TRUE; - } else - gotoprobe = PL_main_root; - break; - case CXt_SUB: - gotoprobe = CvROOT(cx->blk_sub.cv); - pseudo_block = cBOOL(CxMULTICALL(cx)); - break; - case CXt_FORMAT: - case CXt_NULL: - DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); - default: - if (ix) - DIE(aTHX_ "panic: goto, type=%u, ix=%ld", - CxTYPE(cx), (long) ix); - gotoprobe = PL_main_root; - break; - } - if (gotoprobe) { + case CXt_GIVEN: + case CXt_WHEN: + gotoprobe = OpSIBLING(cx->blk_oldcop); + break; + case CXt_SUBST: + continue; + case CXt_BLOCK: + if (ix) { + gotoprobe = OpSIBLING(cx->blk_oldcop); + in_block = TRUE; + } else + gotoprobe = PL_main_root; + break; + case CXt_SUB: + gotoprobe = CvROOT(cx->blk_sub.cv); + pseudo_block = cBOOL(CxMULTICALL(cx)); + break; + case CXt_FORMAT: + case CXt_NULL: + DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); + default: + if (ix) + DIE(aTHX_ "panic: goto, type=%u, ix=%ld", + CxTYPE(cx), (long) ix); + gotoprobe = PL_main_root; + break; + } + if (gotoprobe) { OP *sibl1, *sibl2; - retop = dofindlabel(gotoprobe, label, label_len, label_flags, - enterops, enterops + GOTO_DEPTH); - if (retop) - break; - if ( (sibl1 = OpSIBLING(gotoprobe)) && - sibl1->op_type == OP_UNSTACK && - (sibl2 = OpSIBLING(sibl1))) + retop = dofindlabel(gotoprobe, label, label_len, label_flags, + enterops, enterops + GOTO_DEPTH); + if (retop) + break; + if ( (sibl1 = OpSIBLING(gotoprobe)) && + sibl1->op_type == OP_UNSTACK && + (sibl2 = OpSIBLING(sibl1))) { - retop = dofindlabel(sibl2, - label, label_len, label_flags, enterops, - enterops + GOTO_DEPTH); - if (retop) - break; - } - } - if (pseudo_block) - DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); - PL_lastgotoprobe = gotoprobe; - } - if (!retop) - DIE(aTHX_ "Can't find label %" UTF8f, - UTF8fARG(label_flags, label_len, label)); - - /* if we're leaving an eval, check before we pop any frames + retop = dofindlabel(sibl2, + label, label_len, label_flags, enterops, + enterops + GOTO_DEPTH); + if (retop) + break; + } + } + if (pseudo_block) + DIE(aTHX_ "Can't \"goto\" out of a pseudo block"); + PL_lastgotoprobe = gotoprobe; + } + if (!retop) + DIE(aTHX_ "Can't find label %" UTF8f, + UTF8fARG(label_flags, label_len, label)); + + /* if we're leaving an eval, check before we pop any frames that we're not going to punt, otherwise the error - won't be caught */ + won't be caught */ - if (leaving_eval && *enterops && enterops[1]) { - I32 i; + if (leaving_eval && *enterops && enterops[1]) { + I32 i; for (i = 1; enterops[i]; i++) S_check_op_type(aTHX_ enterops[i]); - } - - if (*enterops && enterops[1]) { - I32 i = enterops[1] != UNENTERABLE - && enterops[1]->op_type == OP_ENTER && in_block - ? 2 - : 1; - if (enterops[i]) - deprecate("\"goto\" to jump into a construct"); - } - - /* pop unwanted frames */ - - if (ix < cxstack_ix) { - if (ix < 0) - DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix); - dounwind(ix); + } + + if (*enterops && enterops[1]) { + I32 i = enterops[1] != UNENTERABLE + && enterops[1]->op_type == OP_ENTER && in_block + ? 2 + : 1; + if (enterops[i]) + deprecate("\"goto\" to jump into a construct"); + } + + /* pop unwanted frames */ + + if (ix < cxstack_ix) { + if (ix < 0) + DIE(aTHX_ "panic: docatch: illegal ix=%ld", (long)ix); + dounwind(ix); cx = CX_CUR(); - cx_topblock(cx); - } - - /* push wanted frames */ - - if (*enterops && enterops[1]) { - OP * const oldop = PL_op; - ix = enterops[1] != UNENTERABLE - && enterops[1]->op_type == OP_ENTER && in_block - ? 2 - : 1; - for (; enterops[ix]; ix++) { - PL_op = enterops[ix]; - S_check_op_type(aTHX_ PL_op); - DEBUG_l( Perl_deb(aTHX_ "pp_goto: Entering %s\n", - OP_NAME(PL_op))); - PL_op->op_ppaddr(aTHX); - } - PL_op = oldop; - } + cx_topblock(cx); + } + + /* push wanted frames */ + + if (*enterops && enterops[1]) { + OP * const oldop = PL_op; + ix = enterops[1] != UNENTERABLE + && enterops[1]->op_type == OP_ENTER && in_block + ? 2 + : 1; + for (; enterops[ix]; ix++) { + PL_op = enterops[ix]; + S_check_op_type(aTHX_ PL_op); + DEBUG_l( Perl_deb(aTHX_ "pp_goto: Entering %s\n", + OP_NAME(PL_op))); + PL_op->op_ppaddr(aTHX); + } + PL_op = oldop; + } } if (do_dump) { #ifdef VMS - if (!retop) retop = PL_main_start; + if (!retop) retop = PL_main_start; #endif - PL_restartop = retop; - PL_do_undump = TRUE; + PL_restartop = retop; + PL_do_undump = TRUE; - my_unexec(); + my_unexec(); - PL_restartop = 0; /* hmm, must be GNU unexec().. */ - PL_do_undump = FALSE; + PL_restartop = 0; /* hmm, must be GNU unexec().. */ + PL_do_undump = FALSE; } putback_return: @@ -3204,16 +3204,16 @@ PP(pp_exit) I32 anum; if (MAXARG < 1) - anum = 0; + anum = 0; else if (!TOPs) { - anum = 0; (void)POPs; + anum = 0; (void)POPs; } else { - anum = SvIVx(POPs); + anum = SvIVx(POPs); #ifdef VMS - if (anum == 1 - && SvTRUE(cop_hints_fetch_pvs(PL_curcop, "vmsish_exit", 0))) - anum = 0; + if (anum == 1 + && SvTRUE(cop_hints_fetch_pvs(PL_curcop, "vmsish_exit", 0))) + anum = 0; VMSISH_HUSHED = VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH); #endif @@ -3236,18 +3236,18 @@ S_save_lines(pTHX_ AV *array, SV *sv) PERL_ARGS_ASSERT_SAVE_LINES; while (s && s < send) { - const char *t; - SV * const tmpstr = newSV_type(SVt_PVMG); + const char *t; + SV * const tmpstr = newSV_type(SVt_PVMG); - t = (const char *)memchr(s, '\n', send - s); - if (t) - t++; - else - t = send; + t = (const char *)memchr(s, '\n', send - s); + if (t) + t++; + else + t = send; - sv_setpvn(tmpstr, s, t - s); - av_store(array, line++, tmpstr); - s = t; + sv_setpvn(tmpstr, s, t - s); + av_store(array, line++, tmpstr); + s = t; } } @@ -3277,24 +3277,24 @@ S_docatch(pTHX_ Perl_ppaddr_t firstpp) JMPENV_PUSH(ret); switch (ret) { case 0: - PL_op = firstpp(aTHX); + PL_op = firstpp(aTHX); redo_body: - CALLRUNOPS(aTHX); - break; + CALLRUNOPS(aTHX); + break; case 3: - /* die caught by an inner eval - continue inner loop */ - if (PL_restartop && PL_restartjmpenv == PL_top_env) { - PL_restartjmpenv = NULL; - PL_op = PL_restartop; - PL_restartop = 0; - goto redo_body; - } - /* FALLTHROUGH */ + /* die caught by an inner eval - continue inner loop */ + if (PL_restartop && PL_restartjmpenv == PL_top_env) { + PL_restartjmpenv = NULL; + PL_op = PL_restartop; + PL_restartop = 0; + goto redo_body; + } + /* FALLTHROUGH */ default: - JMPENV_POP; - PL_op = oldop; - JMPENV_JUMP(ret); - NOT_REACHED; /* NOTREACHED */ + JMPENV_POP; + PL_op = oldop; + JMPENV_JUMP(ret); + NOT_REACHED; /* NOTREACHED */ } JMPENV_POP; PL_op = oldop; @@ -3328,43 +3328,43 @@ Perl_find_runcv_where(pTHX_ U8 cond, IV arg, U32 *db_seqp) int level = 0; if (db_seqp) - *db_seqp = + *db_seqp = PL_curcop == &PL_compiling ? PL_cop_seqmax : PL_curcop->cop_seq; for (si = PL_curstackinfo; si; si = si->si_prev) { I32 ix; - for (ix = si->si_cxix; ix >= 0; ix--) { - const PERL_CONTEXT *cx = &(si->si_cxstack[ix]); - CV *cv = NULL; - if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { - cv = cx->blk_sub.cv; - /* skip DB:: code */ - if (db_seqp && PL_debstash && CvSTASH(cv) == PL_debstash) { - *db_seqp = cx->blk_oldcop->cop_seq; - continue; - } + for (ix = si->si_cxix; ix >= 0; ix--) { + const PERL_CONTEXT *cx = &(si->si_cxstack[ix]); + CV *cv = NULL; + if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) { + cv = cx->blk_sub.cv; + /* skip DB:: code */ + if (db_seqp && PL_debstash && CvSTASH(cv) == PL_debstash) { + *db_seqp = cx->blk_oldcop->cop_seq; + continue; + } if (cx->cx_type & CXp_SUB_RE) continue; - } - else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx)) - cv = cx->blk_eval.cv; - if (cv) { - switch (cond) { - case FIND_RUNCV_padid_eq: - if (!CvPADLIST(cv) - || CvPADLIST(cv)->xpadl_id != (U32)arg) - continue; - return cv; - case FIND_RUNCV_level_eq: - if (level++ != arg) continue; + } + else if (CxTYPE(cx) == CXt_EVAL && !CxTRYBLOCK(cx)) + cv = cx->blk_eval.cv; + if (cv) { + switch (cond) { + case FIND_RUNCV_padid_eq: + if (!CvPADLIST(cv) + || CvPADLIST(cv)->xpadl_id != (U32)arg) + continue; + return cv; + case FIND_RUNCV_level_eq: + if (level++ != arg) continue; /* FALLTHROUGH */ - default: - return cv; - } - } - } + default: + return cv; + } + } + } } return cond == FIND_RUNCV_padid_eq ? NULL : PL_main_cv; } @@ -3385,14 +3385,14 @@ S_try_yyparse(pTHX_ int gramtype) JMPENV_PUSH(ret); switch (ret) { case 0: - ret = yyparse(gramtype) ? 1 : 0; - break; + ret = yyparse(gramtype) ? 1 : 0; + break; case 3: - break; + break; default: - JMPENV_POP; - JMPENV_JUMP(ret); - NOT_REACHED; /* NOTREACHED */ + JMPENV_POP; + JMPENV_JUMP(ret); + NOT_REACHED; /* NOTREACHED */ } JMPENV_POP; return ret; @@ -3425,8 +3425,8 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) CV *evalcv; PL_in_eval = (in_require - ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL)) - : (EVAL_INEVAL | + ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL)) + : (EVAL_INEVAL | ((PL_op->op_private & OPpEVAL_RE_REPARSING) ? EVAL_RE_REPARSING : 0))); @@ -3452,14 +3452,14 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) /* make sure we compile in the right package */ if (CopSTASH_ne(PL_curcop, PL_curstash)) { - SAVEGENERICSV(PL_curstash); - PL_curstash = (HV *)CopSTASH(PL_curcop); - if (SvTYPE(PL_curstash) != SVt_PVHV) PL_curstash = NULL; - else { - SvREFCNT_inc_simple_void(PL_curstash); - save_item(PL_curstname); - sv_sethek(PL_curstname, HvNAME_HEK(PL_curstash)); - } + SAVEGENERICSV(PL_curstash); + PL_curstash = (HV *)CopSTASH(PL_curcop); + if (SvTYPE(PL_curstash) != SVt_PVHV) PL_curstash = NULL; + else { + SvREFCNT_inc_simple_void(PL_curstash); + save_item(PL_curstname); + sv_sethek(PL_curstname, HvNAME_HEK(PL_curstash)); + } } /* XXX:ajgo do we really need to alloc an AV for begin/checkunit */ SAVESPTR(PL_beginav); @@ -3479,19 +3479,19 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) PL_eval_root = NULL; PL_curcop = &PL_compiling; if ((saveop->op_type != OP_REQUIRE) && (saveop->op_flags & OPf_SPECIAL)) - PL_in_eval |= EVAL_KEEPERR; + PL_in_eval |= EVAL_KEEPERR; else - CLEAR_ERRSV(); + CLEAR_ERRSV(); SAVEHINTS(); if (clear_hints) { - PL_hints = HINTS_DEFAULT; - hv_clear(GvHV(PL_hintgv)); + PL_hints = HINTS_DEFAULT; + hv_clear(GvHV(PL_hintgv)); CLEARFEATUREBITS(); } else { - PL_hints = saveop->op_private & OPpEVAL_COPHH - ? oldcurcop->cop_hints : (U32)saveop->op_targ; + PL_hints = saveop->op_private & OPpEVAL_COPHH + ? oldcurcop->cop_hints : (U32)saveop->op_targ; /* making 'use re eval' not be in scope when compiling the * qr/mabye_has_runtime_code_block/ ensures that we don't get @@ -3501,37 +3501,37 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) if (PL_in_eval & EVAL_RE_REPARSING) PL_hints &= ~HINT_RE_EVAL; - if (hh) { - /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */ - SvREFCNT_dec(GvHV(PL_hintgv)); - GvHV(PL_hintgv) = hh; + if (hh) { + /* SAVEHINTS created a new HV in PL_hintgv, which we need to GC */ + SvREFCNT_dec(GvHV(PL_hintgv)); + GvHV(PL_hintgv) = hh; FETCHFEATUREBITSHH(hh); - } + } } SAVECOMPILEWARNINGS(); if (clear_hints) { - if (PL_dowarn & G_WARN_ALL_ON) - PL_compiling.cop_warnings = pWARN_ALL ; - else if (PL_dowarn & G_WARN_ALL_OFF) - PL_compiling.cop_warnings = pWARN_NONE ; - else - PL_compiling.cop_warnings = pWARN_STD ; + if (PL_dowarn & G_WARN_ALL_ON) + PL_compiling.cop_warnings = pWARN_ALL ; + else if (PL_dowarn & G_WARN_ALL_OFF) + PL_compiling.cop_warnings = pWARN_NONE ; + else + PL_compiling.cop_warnings = pWARN_STD ; } else { - PL_compiling.cop_warnings = - DUP_WARNINGS(oldcurcop->cop_warnings); - cophh_free(CopHINTHASH_get(&PL_compiling)); - if (Perl_cop_fetch_label(aTHX_ oldcurcop, NULL, NULL)) { - /* The label, if present, is the first entry on the chain. So rather - than writing a blank label in front of it (which involves an - allocation), just use the next entry in the chain. */ - PL_compiling.cop_hints_hash - = cophh_copy(oldcurcop->cop_hints_hash->refcounted_he_next); - /* Check the assumption that this removed the label. */ - assert(Perl_cop_fetch_label(aTHX_ &PL_compiling, NULL, NULL) == NULL); - } - else - PL_compiling.cop_hints_hash = cophh_copy(oldcurcop->cop_hints_hash); + PL_compiling.cop_warnings = + DUP_WARNINGS(oldcurcop->cop_warnings); + cophh_free(CopHINTHASH_get(&PL_compiling)); + if (Perl_cop_fetch_label(aTHX_ oldcurcop, NULL, NULL)) { + /* The label, if present, is the first entry on the chain. So rather + than writing a blank label in front of it (which involves an + allocation), just use the next entry in the chain. */ + PL_compiling.cop_hints_hash + = cophh_copy(oldcurcop->cop_hints_hash->refcounted_he_next); + /* Check the assumption that this removed the label. */ + assert(Perl_cop_fetch_label(aTHX_ &PL_compiling, NULL, NULL) == NULL); + } + else + PL_compiling.cop_hints_hash = cophh_copy(oldcurcop->cop_hints_hash); } CALL_BLOCK_HOOKS(bhk_eval, saveop); @@ -3544,37 +3544,37 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) yystatus = (!in_require && CATCH_GET) ? S_try_yyparse(aTHX_ GRAMPROG) : yyparse(GRAMPROG); if (yystatus || PL_parser->error_count || !PL_eval_root) { - PERL_CONTEXT *cx; + PERL_CONTEXT *cx; SV *errsv; - PL_op = saveop; - /* note that if yystatus == 3, then the require/eval died during + PL_op = saveop; + /* note that if yystatus == 3, then the require/eval died during * compilation, so the EVAL CX block has already been popped, and * various vars restored */ - if (yystatus != 3) { - if (PL_eval_root) { - op_free(PL_eval_root); - PL_eval_root = NULL; - } - SP = PL_stack_base + POPMARK; /* pop original mark */ + if (yystatus != 3) { + if (PL_eval_root) { + op_free(PL_eval_root); + PL_eval_root = NULL; + } + SP = PL_stack_base + POPMARK; /* pop original mark */ cx = CX_CUR(); assert(CxTYPE(cx) == CXt_EVAL); /* pop the CXt_EVAL, and if was a require, croak */ S_pop_eval_context_maybe_croak(aTHX_ cx, ERRSV, 2); - } + } /* die_unwind() re-croaks when in require, having popped the * require EVAL context. So we should never catch a require * exception here */ - assert(!in_require); + assert(!in_require); - errsv = ERRSV; + errsv = ERRSV; if (!*(SvPV_nolen_const(errsv))) sv_setpvs(errsv, "Compilation error"); - if (gimme != G_ARRAY) PUSHs(&PL_sv_undef); - PUTBACK; - return FALSE; + if (gimme != G_ARRAY) PUSHs(&PL_sv_undef); + PUTBACK; + return FALSE; } /* Compilation successful. Now clean up */ @@ -3589,20 +3589,20 @@ S_doeval_compile(pTHX_ U8 gimme, CV* outside, U32 seq, HV *hh) /* Register with debugger: */ if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) { - CV * const cv = get_cvs("DB::postponed", 0); - if (cv) { - dSP; - PUSHMARK(SP); - XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling))); - PUTBACK; - call_sv(MUTABLE_SV(cv), G_DISCARD); - } + CV * const cv = get_cvs("DB::postponed", 0); + if (cv) { + dSP; + PUSHMARK(SP); + XPUSHs(MUTABLE_SV(CopFILEGV(&PL_compiling))); + PUTBACK; + call_sv(MUTABLE_SV(cv), G_DISCARD); + } } if (PL_unitcheckav) { - OP *es = PL_eval_start; - call_list(PL_scopestack_ix, PL_unitcheckav); - PL_eval_start = es; + OP *es = PL_eval_start; + call_list(PL_scopestack_ix, PL_unitcheckav); + PL_eval_start = es; } CvDEPTH(evalcv) = 1; @@ -3649,19 +3649,19 @@ S_check_type_and_open(pTHX_ SV *name) st_rc = PerlLIO_stat(p, &st); if (st_rc < 0) - return NULL; + return NULL; else { - int eno; - if(S_ISBLK(st.st_mode)) { - eno = EINVAL; - goto not_file; - } - else if(S_ISDIR(st.st_mode)) { - eno = EISDIR; - not_file: - errno = eno; - return NULL; - } + int eno; + if(S_ISBLK(st.st_mode)) { + eno = EINVAL; + goto not_file; + } + else if(S_ISDIR(st.st_mode)) { + eno = EISDIR; + not_file: + errno = eno; + return NULL; + } } #endif @@ -3670,17 +3670,17 @@ S_check_type_and_open(pTHX_ SV *name) /* EACCES stops the INC search early in pp_require to implement feature RT #113422 */ if(!retio && errno == EACCES) { /* exists but probably a directory */ - int eno; - st_rc = PerlLIO_stat(p, &st); - if (st_rc >= 0) { - if(S_ISDIR(st.st_mode)) - eno = EISDIR; - else if(S_ISBLK(st.st_mode)) - eno = EINVAL; - else - eno = EACCES; - errno = eno; - } + int eno; + st_rc = PerlLIO_stat(p, &st); + if (st_rc >= 0) { + if(S_ISDIR(st.st_mode)) + eno = EISDIR; + else if(S_ISBLK(st.st_mode)) + eno = EINVAL; + else + eno = EACCES; + errno = eno; + } } #endif return retio; @@ -3708,15 +3708,15 @@ S_doopen_pm(pTHX_ SV *name) return NULL; if (memENDPs(p, namelen, ".pm")) { - SV *const pmcsv = sv_newmortal(); - PerlIO * pmcio; + SV *const pmcsv = sv_newmortal(); + PerlIO * pmcio; - SvSetSV_nosteal(pmcsv,name); - sv_catpvs(pmcsv, "c"); + SvSetSV_nosteal(pmcsv,name); + sv_catpvs(pmcsv, "c"); - pmcio = check_type_and_open(pmcsv); - if (pmcio) - return pmcio; + pmcio = check_type_and_open(pmcsv); + if (pmcio) + return pmcio; } return check_type_and_open(name); } @@ -3733,21 +3733,21 @@ S_path_is_searchable(const char *name) if (PERL_FILE_IS_ABSOLUTE(name) #ifdef WIN32 - || (*name == '.' && ((name[1] == '/' || - (name[1] == '.' && name[2] == '/')) - || (name[1] == '\\' || - ( name[1] == '.' && name[2] == '\\'))) - ) + || (*name == '.' && ((name[1] == '/' || + (name[1] == '.' && name[2] == '/')) + || (name[1] == '\\' || + ( name[1] == '.' && name[2] == '\\'))) + ) #else - || (*name == '.' && (name[1] == '/' || - (name[1] == '.' && name[2] == '/'))) + || (*name == '.' && (name[1] == '/' || + (name[1] == '.' && name[2] == '/'))) #endif - ) + ) { - return FALSE; + return FALSE; } else - return TRUE; + return TRUE; } @@ -3861,12 +3861,12 @@ S_require_file(pTHX_ SV *sv) DIE(aTHX_ "Missing or undefined argument to %s", op_name); #ifndef VMS - /* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */ - if (op_is_require) { - /* can optimize to only perform one single lookup */ - svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0); - if ( svp_cached && (SvGETMAGIC(*svp_cached), SvOK(*svp_cached)) ) RETPUSHYES; - } + /* try to return earlier (save the SAFE_PATHNAME check) if INC already got the name */ + if (op_is_require) { + /* can optimize to only perform one single lookup */ + svp_cached = hv_fetch(GvHVn(PL_incgv), (char*) name, len, 0); + if ( svp_cached && (SvGETMAGIC(*svp_cached), SvOK(*svp_cached)) ) RETPUSHYES; + } #endif if (!IS_SAFE_PATHNAME(name, len, op_name)) { @@ -3892,33 +3892,33 @@ S_require_file(pTHX_ SV *sv) */ if ((unixname = - tounixspec(name, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))) - != NULL) { - unixlen = strlen(unixname); - vms_unixname = 1; + tounixspec(name, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))) + != NULL) { + unixlen = strlen(unixname); + vms_unixname = 1; } else #endif { /* if not VMS or VMS name can not be translated to UNIX, pass it - * through. - */ - unixname = (char *) name; - unixlen = len; + * through. + */ + unixname = (char *) name; + unixlen = len; } if (op_is_require) { - /* reuse the previous hv_fetch result if possible */ - SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); - if ( svp ) { + /* reuse the previous hv_fetch result if possible */ + SV * const * const svp = svp_cached ? svp_cached : hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); + if ( svp ) { /* we already did a get magic if this was cached */ if (!svp_cached) SvGETMAGIC(*svp); - if (SvOK(*svp)) - RETPUSHYES; - else - DIE(aTHX_ "Attempt to reload %s aborted.\n" - "Compilation failed in require", unixname); - } + if (SvOK(*svp)) + RETPUSHYES; + else + DIE(aTHX_ "Attempt to reload %s aborted.\n" + "Compilation failed in require", unixname); + } /*XXX OPf_KIDS should always be true? -dapm 4/2017 */ if (PL_op->op_flags & OPf_KIDS) { @@ -3974,9 +3974,9 @@ S_require_file(pTHX_ SV *sv) /* with "/foo/bar.pm", "./foo.pm" and "../foo/bar.pm", try to load * the file directly rather than via @INC ... */ if (!path_searchable) { - /* At this point, name is SvPVX(sv) */ - tryname = name; - tryrsfp = doopen_pm(sv); + /* At this point, name is SvPVX(sv) */ + tryname = name; + tryrsfp = doopen_pm(sv); } /* ... but if we fail, still search @INC for code references; @@ -3986,207 +3986,207 @@ S_require_file(pTHX_ SV *sv) * For searchable paths, just search @INC normally */ if (!tryrsfp && !(errno == EACCES && !path_searchable)) { - AV * const ar = GvAVn(PL_incgv); - SSize_t i; + AV * const ar = GvAVn(PL_incgv); + SSize_t i; #ifdef VMS - if (vms_unixname) + if (vms_unixname) #endif - { - SV *nsv = sv; - namesv = newSV_type(SVt_PV); - for (i = 0; i <= AvFILL(ar); i++) { - SV * const dirsv = *av_fetch(ar, i, TRUE); - - SvGETMAGIC(dirsv); - if (SvROK(dirsv)) { - int count; - SV **svp; - SV *loader = dirsv; - - if (SvTYPE(SvRV(loader)) == SVt_PVAV - && !SvOBJECT(SvRV(loader))) - { - loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE); - SvGETMAGIC(loader); - } - - Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%" UVxf "/%s", - PTR2UV(SvRV(dirsv)), name); - tryname = SvPVX_const(namesv); - tryrsfp = NULL; - - if (SvPADTMP(nsv)) { - nsv = sv_newmortal(); - SvSetSV_nosteal(nsv,sv); - } - - ENTER_with_name("call_INC"); - SAVETMPS; - EXTEND(SP, 2); - - PUSHMARK(SP); - PUSHs(dirsv); - PUSHs(nsv); - PUTBACK; - if (SvGMAGICAL(loader)) { - SV *l = sv_newmortal(); - sv_setsv_nomg(l, loader); - loader = l; - } - if (sv_isobject(loader)) - count = call_method("INC", G_ARRAY); - else - count = call_sv(loader, G_ARRAY); - SPAGAIN; - - if (count > 0) { - int i = 0; - SV *arg; - - SP -= count - 1; - arg = SP[i++]; - - if (SvROK(arg) && (SvTYPE(SvRV(arg)) <= SVt_PVLV) - && !isGV_with_GP(SvRV(arg))) { - filter_cache = SvRV(arg); - - if (i < count) { - arg = SP[i++]; - } - } - - if (SvROK(arg) && isGV_with_GP(SvRV(arg))) { - arg = SvRV(arg); - } - - if (isGV_with_GP(arg)) { - IO * const io = GvIO((const GV *)arg); - - ++filter_has_file; - - if (io) { - tryrsfp = IoIFP(io); - if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { - PerlIO_close(IoOFP(io)); - } - IoIFP(io) = NULL; - IoOFP(io) = NULL; - } - - if (i < count) { - arg = SP[i++]; - } - } - - if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) { - filter_sub = arg; - SvREFCNT_inc_simple_void_NN(filter_sub); - - if (i < count) { - filter_state = SP[i]; - SvREFCNT_inc_simple_void(filter_state); - } - } - - if (!tryrsfp && (filter_cache || filter_sub)) { - tryrsfp = PerlIO_open(BIT_BUCKET, - PERL_SCRIPT_MODE); - } - SP--; - } - - /* FREETMPS may free our filter_cache */ - SvREFCNT_inc_simple_void(filter_cache); - - PUTBACK; - FREETMPS; - LEAVE_with_name("call_INC"); - - /* Now re-mortalize it. */ - sv_2mortal(filter_cache); - - /* Adjust file name if the hook has set an %INC entry. - This needs to happen after the FREETMPS above. */ - svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); - if (svp) - tryname = SvPV_nolen_const(*svp); - - if (tryrsfp) { - hook_sv = dirsv; - break; - } - - filter_has_file = 0; - filter_cache = NULL; - if (filter_state) { - SvREFCNT_dec_NN(filter_state); - filter_state = NULL; - } - if (filter_sub) { - SvREFCNT_dec_NN(filter_sub); - filter_sub = NULL; - } - } - else if (path_searchable) { + { + SV *nsv = sv; + namesv = newSV_type(SVt_PV); + for (i = 0; i <= AvFILL(ar); i++) { + SV * const dirsv = *av_fetch(ar, i, TRUE); + + SvGETMAGIC(dirsv); + if (SvROK(dirsv)) { + int count; + SV **svp; + SV *loader = dirsv; + + if (SvTYPE(SvRV(loader)) == SVt_PVAV + && !SvOBJECT(SvRV(loader))) + { + loader = *av_fetch(MUTABLE_AV(SvRV(loader)), 0, TRUE); + SvGETMAGIC(loader); + } + + Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%" UVxf "/%s", + PTR2UV(SvRV(dirsv)), name); + tryname = SvPVX_const(namesv); + tryrsfp = NULL; + + if (SvPADTMP(nsv)) { + nsv = sv_newmortal(); + SvSetSV_nosteal(nsv,sv); + } + + ENTER_with_name("call_INC"); + SAVETMPS; + EXTEND(SP, 2); + + PUSHMARK(SP); + PUSHs(dirsv); + PUSHs(nsv); + PUTBACK; + if (SvGMAGICAL(loader)) { + SV *l = sv_newmortal(); + sv_setsv_nomg(l, loader); + loader = l; + } + if (sv_isobject(loader)) + count = call_method("INC", G_ARRAY); + else + count = call_sv(loader, G_ARRAY); + SPAGAIN; + + if (count > 0) { + int i = 0; + SV *arg; + + SP -= count - 1; + arg = SP[i++]; + + if (SvROK(arg) && (SvTYPE(SvRV(arg)) <= SVt_PVLV) + && !isGV_with_GP(SvRV(arg))) { + filter_cache = SvRV(arg); + + if (i < count) { + arg = SP[i++]; + } + } + + if (SvROK(arg) && isGV_with_GP(SvRV(arg))) { + arg = SvRV(arg); + } + + if (isGV_with_GP(arg)) { + IO * const io = GvIO((const GV *)arg); + + ++filter_has_file; + + if (io) { + tryrsfp = IoIFP(io); + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { + PerlIO_close(IoOFP(io)); + } + IoIFP(io) = NULL; + IoOFP(io) = NULL; + } + + if (i < count) { + arg = SP[i++]; + } + } + + if (SvROK(arg) && SvTYPE(SvRV(arg)) == SVt_PVCV) { + filter_sub = arg; + SvREFCNT_inc_simple_void_NN(filter_sub); + + if (i < count) { + filter_state = SP[i]; + SvREFCNT_inc_simple_void(filter_state); + } + } + + if (!tryrsfp && (filter_cache || filter_sub)) { + tryrsfp = PerlIO_open(BIT_BUCKET, + PERL_SCRIPT_MODE); + } + SP--; + } + + /* FREETMPS may free our filter_cache */ + SvREFCNT_inc_simple_void(filter_cache); + + PUTBACK; + FREETMPS; + LEAVE_with_name("call_INC"); + + /* Now re-mortalize it. */ + sv_2mortal(filter_cache); + + /* Adjust file name if the hook has set an %INC entry. + This needs to happen after the FREETMPS above. */ + svp = hv_fetch(GvHVn(PL_incgv), name, len, 0); + if (svp) + tryname = SvPV_nolen_const(*svp); + + if (tryrsfp) { + hook_sv = dirsv; + break; + } + + filter_has_file = 0; + filter_cache = NULL; + if (filter_state) { + SvREFCNT_dec_NN(filter_state); + filter_state = NULL; + } + if (filter_sub) { + SvREFCNT_dec_NN(filter_sub); + filter_sub = NULL; + } + } + else if (path_searchable) { /* match against a plain @INC element (non-searchable * paths are only matched against refs in @INC) */ - const char *dir; - STRLEN dirlen; - - if (SvOK(dirsv)) { - dir = SvPV_nomg_const(dirsv, dirlen); - } else { - dir = ""; - dirlen = 0; - } - - if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", op_name)) - continue; + const char *dir; + STRLEN dirlen; + + if (SvOK(dirsv)) { + dir = SvPV_nomg_const(dirsv, dirlen); + } else { + dir = ""; + dirlen = 0; + } + + if (!IS_SAFE_SYSCALL(dir, dirlen, "@INC entry", op_name)) + continue; #ifdef VMS - if ((unixdir = - tounixpath(dir, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))) - == NULL) - continue; - sv_setpv(namesv, unixdir); - sv_catpv(namesv, unixname); + if ((unixdir = + tounixpath(dir, SvPVX(sv_2mortal(newSVpv("", VMS_MAXRSS-1))))) + == NULL) + continue; + sv_setpv(namesv, unixdir); + sv_catpv(namesv, unixname); #else - /* The equivalent of - Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); - but without the need to parse the format string, or - call strlen on either pointer, and with the correct - allocation up front. */ - { - char *tmp = SvGROW(namesv, dirlen + len + 2); - - memcpy(tmp, dir, dirlen); - tmp +=dirlen; - - /* Avoid '

//' */ - if (!dirlen || *(tmp-1) != '/') { - *tmp++ = '/'; - } else { - /* So SvCUR_set reports the correct length below */ - dirlen--; - } - - /* name came from an SV, so it will have a '\0' at the - end that we can copy as part of this memcpy(). */ - memcpy(tmp, name, len + 1); - - SvCUR_set(namesv, dirlen + len + 1); - SvPOK_on(namesv); - } + /* The equivalent of + Perl_sv_setpvf(aTHX_ namesv, "%s/%s", dir, name); + but without the need to parse the format string, or + call strlen on either pointer, and with the correct + allocation up front. */ + { + char *tmp = SvGROW(namesv, dirlen + len + 2); + + memcpy(tmp, dir, dirlen); + tmp +=dirlen; + + /* Avoid '//' */ + if (!dirlen || *(tmp-1) != '/') { + *tmp++ = '/'; + } else { + /* So SvCUR_set reports the correct length below */ + dirlen--; + } + + /* name came from an SV, so it will have a '\0' at the + end that we can copy as part of this memcpy(). */ + memcpy(tmp, name, len + 1); + + SvCUR_set(namesv, dirlen + len + 1); + SvPOK_on(namesv); + } #endif - TAINT_PROPER(op_name); - tryname = SvPVX_const(namesv); - tryrsfp = doopen_pm(namesv); - if (tryrsfp) { - if (tryname[0] == '.' && tryname[1] == '/') { - ++tryname; - while (*++tryname == '/') {} - } - break; - } + TAINT_PROPER(op_name); + tryname = SvPVX_const(namesv); + tryrsfp = doopen_pm(namesv); + if (tryrsfp) { + if (tryname[0] == '.' && tryname[1] == '/') { + ++tryname; + while (*++tryname == '/') {} + } + break; + } else if (errno == EMFILE || errno == EACCES) { /* no point in trying other paths if out of handles; * on the other hand, if we couldn't open one of the @@ -4195,9 +4195,9 @@ S_require_file(pTHX_ SV *sv) */ break; } - } - } - } + } + } + } } /* at this point we've ether opened a file (tryrsfp) or set errno */ @@ -4206,24 +4206,24 @@ S_require_file(pTHX_ SV *sv) sv_2mortal(namesv); if (!tryrsfp) { /* we failed; croak if require() or return undef if do() */ - if (op_is_require) { - if(saved_errno == EMFILE || saved_errno == EACCES) { - /* diag_listed_as: Can't locate %s */ - DIE(aTHX_ "Can't locate %s: %s: %s", - name, tryname, Strerror(saved_errno)); - } else { - if (path_searchable) { /* did we lookup @INC? */ - AV * const ar = GvAVn(PL_incgv); - SSize_t i; - SV *const msg = newSVpvs_flags("", SVs_TEMP); - SV *const inc = newSVpvs_flags("", SVs_TEMP); - for (i = 0; i <= AvFILL(ar); i++) { - sv_catpvs(inc, " "); - sv_catsv(inc, *av_fetch(ar, i, TRUE)); - } - if (memENDPs(name, len, ".pm")) { + if (op_is_require) { + if(saved_errno == EMFILE || saved_errno == EACCES) { + /* diag_listed_as: Can't locate %s */ + DIE(aTHX_ "Can't locate %s: %s: %s", + name, tryname, Strerror(saved_errno)); + } else { + if (path_searchable) { /* did we lookup @INC? */ + AV * const ar = GvAVn(PL_incgv); + SSize_t i; + SV *const msg = newSVpvs_flags("", SVs_TEMP); + SV *const inc = newSVpvs_flags("", SVs_TEMP); + for (i = 0; i <= AvFILL(ar); i++) { + sv_catpvs(inc, " "); + sv_catsv(inc, *av_fetch(ar, i, TRUE)); + } + if (memENDPs(name, len, ".pm")) { const char *e = name + len - (sizeof(".pm") - 1); - const char *c; + const char *c; bool utf8 = cBOOL(SvUTF8(sv)); /* if the filename, when converted from "Foo/Bar.pm" @@ -4233,7 +4233,7 @@ S_require_file(pTHX_ SV *sv) * * this loop is modelled after the one in S_parse_ident */ - c = name; + c = name; while (c < e) { if (utf8 && isIDFIRST_utf8_safe(c, e)) { c += UTF8SKIP(c); @@ -4245,7 +4245,7 @@ S_require_file(pTHX_ SV *sv) while (c < e && isWORDCHAR_A(*c)) c++; } - else if (*c == '/') + else if (*c == '/') c++; else break; @@ -4263,22 +4263,22 @@ S_require_file(pTHX_ SV *sv) } sv_catpvs(msg, " module)"); } - } - else if (memENDs(name, len, ".h")) { - sv_catpvs(msg, " (change .h to .ph maybe?) (did you run h2ph?)"); - } - else if (memENDs(name, len, ".ph")) { - sv_catpvs(msg, " (did you run h2ph?)"); - } - - /* diag_listed_as: Can't locate %s */ - DIE(aTHX_ - "Can't locate %s in @INC%" SVf " (@INC contains:%" SVf ")", - name, msg, inc); - } - } - DIE(aTHX_ "Can't locate %s", name); - } + } + else if (memENDs(name, len, ".h")) { + sv_catpvs(msg, " (change .h to .ph maybe?) (did you run h2ph?)"); + } + else if (memENDs(name, len, ".ph")) { + sv_catpvs(msg, " (did you run h2ph?)"); + } + + /* diag_listed_as: Can't locate %s */ + DIE(aTHX_ + "Can't locate %s in @INC%" SVf " (@INC contains:%" SVf ")", + name, msg, inc); + } + } + DIE(aTHX_ "Can't locate %s", name); + } else { #ifdef DEFAULT_INC_EXCLUDES_DOT Stat_t st; @@ -4306,19 +4306,19 @@ S_require_file(pTHX_ SV *sv) } } else - SETERRNO(0, SS_NORMAL); + SETERRNO(0, SS_NORMAL); /* Update %INC. Assume success here to prevent recursive requirement. */ /* name is never assigned to again, so len is still strlen(name) */ /* Check whether a hook in @INC has already filled %INC */ if (!hook_sv) { - (void)hv_store(GvHVn(PL_incgv), - unixname, unixlen, newSVpv(tryname,0),0); + (void)hv_store(GvHVn(PL_incgv), + unixname, unixlen, newSVpv(tryname,0),0); } else { - SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); - if (!svp) - (void)hv_store(GvHVn(PL_incgv), - unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 ); + SV** const svp = hv_fetch(GvHVn(PL_incgv), unixname, unixlen, 0); + if (!svp) + (void)hv_store(GvHVn(PL_incgv), + unixname, unixlen, SvREFCNT_inc_simple(hook_sv), 0 ); } /* Now parse the file */ @@ -4329,17 +4329,17 @@ S_require_file(pTHX_ SV *sv) lex_start(NULL, tryrsfp, 0); if (filter_sub || filter_cache) { - /* We can use the SvPV of the filter PVIO itself as our cache, rather - than hanging another SV from it. In turn, filter_add() optionally - takes the SV to use as the filter (or creates a new SV if passed - NULL), so simply pass in whatever value filter_cache has. */ - SV * const fc = filter_cache ? newSV(0) : NULL; - SV *datasv; - if (fc) sv_copypv(fc, filter_cache); - datasv = filter_add(S_run_user_filter, fc); - IoLINES(datasv) = filter_has_file; - IoTOP_GV(datasv) = MUTABLE_GV(filter_state); - IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub); + /* We can use the SvPV of the filter PVIO itself as our cache, rather + than hanging another SV from it. In turn, filter_add() optionally + takes the SV to use as the filter (or creates a new SV if passed + NULL), so simply pass in whatever value filter_cache has. */ + SV * const fc = filter_cache ? newSV(0) : NULL; + SV *datasv; + if (fc) sv_copypv(fc, filter_cache); + datasv = filter_add(S_run_user_filter, fc); + IoLINES(datasv) = filter_has_file; + IoTOP_GV(datasv) = MUTABLE_GV(filter_state); + IoBOTTOM_GV(datasv) = MUTABLE_GV(filter_sub); } /* switch to eval mode */ @@ -4353,9 +4353,9 @@ S_require_file(pTHX_ SV *sv) PUTBACK; if (doeval_compile(gimme, NULL, PL_curcop->cop_seq, NULL)) - op = PL_eval_start; + op = PL_eval_start; else - op = PL_op->op_next; + op = PL_op->op_next; PERL_DTRACE_PROBE_FILE_LOADED(unixname); @@ -4370,13 +4370,13 @@ PP(pp_require) RUN_PP_CATCHABLY(Perl_pp_require); { - dSP; - SV *sv = POPs; - SvGETMAGIC(sv); - PUTBACK; - return ((SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) - ? S_require_version(aTHX_ sv) - : S_require_file(aTHX_ sv); + dSP; + SV *sv = POPs; + SvGETMAGIC(sv); + PUTBACK; + return ((SvNIOKp(sv) || SvVOK(sv)) && PL_op->op_type != OP_DOFILE) + ? S_require_version(aTHX_ sv) + : S_require_file(aTHX_ sv); } } @@ -4421,36 +4421,36 @@ PP(pp_entereval) bytes = PL_op->op_private & OPpEVAL_BYTES; if (PL_op->op_private & OPpEVAL_HAS_HH) { - saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs)); + saved_hh = MUTABLE_HV(SvREFCNT_inc(POPs)); } else if (PL_hints & HINT_LOCALIZE_HH || ( - PL_op->op_private & OPpEVAL_COPHH - && PL_curcop->cop_hints & HINT_LOCALIZE_HH - )) { - saved_hh = cop_hints_2hv(PL_curcop, 0); - hv_magic(saved_hh, NULL, PERL_MAGIC_hints); + PL_op->op_private & OPpEVAL_COPHH + && PL_curcop->cop_hints & HINT_LOCALIZE_HH + )) { + saved_hh = cop_hints_2hv(PL_curcop, 0); + hv_magic(saved_hh, NULL, PERL_MAGIC_hints); } sv = POPs; if (!SvPOK(sv)) { - /* make sure we've got a plain PV (no overload etc) before testing - * for taint. Making a copy here is probably overkill, but better - * safe than sorry */ - STRLEN len; - const char * const p = SvPV_const(sv, len); + /* make sure we've got a plain PV (no overload etc) before testing + * for taint. Making a copy here is probably overkill, but better + * safe than sorry */ + STRLEN len; + const char * const p = SvPV_const(sv, len); - sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv)); - lex_flags |= LEX_START_COPIED; + sv = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv)); + lex_flags |= LEX_START_COPIED; - if (bytes && SvUTF8(sv)) - SvPVbyte_force(sv, len); + if (bytes && SvUTF8(sv)) + SvPVbyte_force(sv, len); } else if (bytes && SvUTF8(sv)) { - /* Don't modify someone else's scalar */ - STRLEN len; - sv = newSVsv(sv); - (void)sv_2mortal(sv); - SvPVbyte_force(sv,len); - lex_flags |= LEX_START_COPIED; + /* Don't modify someone else's scalar */ + STRLEN len; + sv = newSVsv(sv); + (void)sv_2mortal(sv); + SvPVbyte_force(sv,len); + lex_flags |= LEX_START_COPIED; } TAINT_IF(SvTAINTED(sv)); @@ -4459,23 +4459,23 @@ PP(pp_entereval) old_savestack_ix = PL_savestack_ix; lex_start(sv, NULL, lex_flags | (PL_op->op_private & OPpEVAL_UNICODE - ? LEX_IGNORE_UTF8_HINTS - : bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER - ) - ); + ? LEX_IGNORE_UTF8_HINTS + : bytes ? LEX_EVALBYTES : LEX_START_SAME_FILTER + ) + ); /* switch to eval mode */ if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) { - SV * const temp_sv = sv_newmortal(); - Perl_sv_setpvf(aTHX_ temp_sv, "_<(eval %lu)[%s:%" IVdf "]", - (unsigned long)++PL_evalseq, - CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); - tmpbuf = SvPVX(temp_sv); - len = SvCUR(temp_sv); + SV * const temp_sv = sv_newmortal(); + Perl_sv_setpvf(aTHX_ temp_sv, "_<(eval %lu)[%s:%" IVdf "]", + (unsigned long)++PL_evalseq, + CopFILE(PL_curcop), (IV)CopLINE(PL_curcop)); + tmpbuf = SvPVX(temp_sv); + len = SvCUR(temp_sv); } else - len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned long)++PL_evalseq); + len = my_snprintf(tmpbuf, sizeof(tbuf), "_<(eval %lu)", (unsigned long)++PL_evalseq); SAVECOPFILE_FREE(&PL_compiling); CopFILE_set(&PL_compiling, tmpbuf+2); SAVECOPLINE(&PL_compiling); @@ -4494,41 +4494,41 @@ PP(pp_entereval) /* prepare to compile string */ if (PERLDB_LINE_OR_SAVESRC && PL_curstash != PL_debstash) - save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr); + save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr); else { - /* XXX For Cs within BEGIN {} blocks, this ends up - deleting the eval's FILEGV from the stash before gv_check() runs - (i.e. before run-time proper). To work around the coredump that - ensues, we always turn GvMULTI_on for any globals that were - introduced within evals. See force_ident(). GSAR 96-10-12 */ - char *const safestr = savepvn(tmpbuf, len); - SAVEDELETE(PL_defstash, safestr, len); - saved_delete = TRUE; + /* XXX For Cs within BEGIN {} blocks, this ends up + deleting the eval's FILEGV from the stash before gv_check() runs + (i.e. before run-time proper). To work around the coredump that + ensues, we always turn GvMULTI_on for any globals that were + introduced within evals. See force_ident(). GSAR 96-10-12 */ + char *const safestr = savepvn(tmpbuf, len); + SAVEDELETE(PL_defstash, safestr, len); + saved_delete = TRUE; } PUTBACK; if (doeval_compile(gimme, runcv, seq, saved_hh)) { - if (was != PL_breakable_sub_gen /* Some subs defined here. */ - ? PERLDB_LINE_OR_SAVESRC - : PERLDB_SAVESRC_NOSUBS) { - /* Retain the filegv we created. */ - } else if (!saved_delete) { - char *const safestr = savepvn(tmpbuf, len); - SAVEDELETE(PL_defstash, safestr, len); - } - return PL_eval_start; + if (was != PL_breakable_sub_gen /* Some subs defined here. */ + ? PERLDB_LINE_OR_SAVESRC + : PERLDB_SAVESRC_NOSUBS) { + /* Retain the filegv we created. */ + } else if (!saved_delete) { + char *const safestr = savepvn(tmpbuf, len); + SAVEDELETE(PL_defstash, safestr, len); + } + return PL_eval_start; } else { - /* We have already left the scope set up earlier thanks to the LEAVE - in doeval_compile(). */ - if (was != PL_breakable_sub_gen /* Some subs defined here. */ - ? PERLDB_LINE_OR_SAVESRC - : PERLDB_SAVESRC_INVALID) { - /* Retain the filegv we created. */ - } else if (!saved_delete) { - (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD); - } - return PL_op->op_next; + /* We have already left the scope set up earlier thanks to the LEAVE + in doeval_compile(). */ + if (was != PL_breakable_sub_gen /* Some subs defined here. */ + ? PERLDB_LINE_OR_SAVESRC + : PERLDB_SAVESRC_INVALID) { + /* Retain the filegv we created. */ + } else if (!saved_delete) { + (void)hv_delete(PL_defstash, tmpbuf, len, G_DISCARD); + } + return PL_op->op_next; } } @@ -4599,7 +4599,7 @@ void Perl_delete_eval_scope(pTHX) { PERL_CONTEXT *cx; - + cx = CX_CUR(); CX_LEAVE_SCOPE(cx); cx_popeval(cx); @@ -4614,18 +4614,18 @@ Perl_create_eval_scope(pTHX_ OP *retop, U32 flags) { PERL_CONTEXT *cx; const U8 gimme = GIMME_V; - + cx = cx_pushblock((CXt_EVAL|CXp_TRYBLOCK), gimme, PL_stack_sp, PL_savestack_ix); cx_pusheval(cx, retop, NULL); PL_in_eval = EVAL_INEVAL; if (flags & G_KEEPERR) - PL_in_eval |= EVAL_KEEPERR; + PL_in_eval |= EVAL_KEEPERR; else - CLEAR_ERRSV(); + CLEAR_ERRSV(); if (flags & G_FAKINGEVAL) { - PL_eval_root = PL_op; /* Only needed so that goto works right. */ + PL_eval_root = PL_op; /* Only needed so that goto works right. */ } } @@ -4781,30 +4781,30 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) /* Take care only to invoke mg_get() once for each argument. * Currently we do this by copying the SV if it's magical. */ if (d) { - if (!copied && SvGMAGICAL(d)) - d = sv_mortalcopy(d); + if (!copied && SvGMAGICAL(d)) + d = sv_mortalcopy(d); } else - d = &PL_sv_undef; + d = &PL_sv_undef; assert(e); if (SvGMAGICAL(e)) - e = sv_mortalcopy(e); + e = sv_mortalcopy(e); /* First of all, handle overload magic of the rightmost argument */ if (SvAMAGIC(e)) { - SV * tmpsv; - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n")); - DEBUG_M(Perl_deb(aTHX_ " attempting overload\n")); + SV * tmpsv; + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n")); + DEBUG_M(Perl_deb(aTHX_ " attempting overload\n")); - tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft); - if (tmpsv) { - SPAGAIN; - (void)POPs; - SETs(tmpsv); - RETURN; - } - DEBUG_M(Perl_deb(aTHX_ " failed to run overload method; continuing...\n")); + tmpsv = amagic_call(d, e, smart_amg, AMGf_noleft); + if (tmpsv) { + SPAGAIN; + (void)POPs; + SETs(tmpsv); + RETURN; + } + DEBUG_M(Perl_deb(aTHX_ " failed to run overload method; continuing...\n")); } SP -= 2; /* Pop the values */ @@ -4812,433 +4812,433 @@ S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other, const bool copied) /* ~~ undef */ if (!SvOK(e)) { - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-undef\n")); - if (SvOK(d)) - RETPUSHNO; - else - RETPUSHYES; + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-undef\n")); + if (SvOK(d)) + RETPUSHNO; + else + RETPUSHYES; } if (SvROK(e) && SvOBJECT(SvRV(e)) && (SvTYPE(SvRV(e)) != SVt_REGEXP)) { - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n")); - Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Object\n")); + Perl_croak(aTHX_ "Smart matching a non-overloaded object breaks encapsulation"); } if (SvROK(d) && SvOBJECT(SvRV(d)) && (SvTYPE(SvRV(d)) != SVt_REGEXP)) - object_on_left = TRUE; + object_on_left = TRUE; /* ~~ sub */ if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVCV) { - I32 c; - if (object_on_left) { - goto sm_any_sub; /* Treat objects like scalars */ - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { - /* Test sub truth for each key */ - HE *he; - bool andedresults = TRUE; - HV *hv = (HV*) SvRV(d); - I32 numkeys = hv_iterinit(hv); - DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-CodeRef\n")); - if (numkeys == 0) - RETPUSHYES; - while ( (he = hv_iternext(hv)) ) { - DEBUG_M(Perl_deb(aTHX_ " testing hash key...\n")); - ENTER_with_name("smartmatch_hash_key_test"); - SAVETMPS; - PUSHMARK(SP); - PUSHs(hv_iterkeysv(he)); - PUTBACK; - c = call_sv(e, G_SCALAR); - SPAGAIN; - if (c == 0) - andedresults = FALSE; - else - andedresults = SvTRUEx(POPs) && andedresults; - FREETMPS; - LEAVE_with_name("smartmatch_hash_key_test"); - } - if (andedresults) - RETPUSHYES; - else - RETPUSHNO; - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { - /* Test sub truth for each element */ - Size_t i; - bool andedresults = TRUE; - AV *av = (AV*) SvRV(d); - const Size_t len = av_count(av); - DEBUG_M(Perl_deb(aTHX_ " applying rule Array-CodeRef\n")); - if (len == 0) - RETPUSHYES; - for (i = 0; i < len; ++i) { - SV * const * const svp = av_fetch(av, i, FALSE); - DEBUG_M(Perl_deb(aTHX_ " testing array element...\n")); - ENTER_with_name("smartmatch_array_elem_test"); - SAVETMPS; - PUSHMARK(SP); - if (svp) - PUSHs(*svp); - PUTBACK; - c = call_sv(e, G_SCALAR); - SPAGAIN; - if (c == 0) - andedresults = FALSE; - else - andedresults = SvTRUEx(POPs) && andedresults; - FREETMPS; - LEAVE_with_name("smartmatch_array_elem_test"); - } - if (andedresults) - RETPUSHYES; - else - RETPUSHNO; - } - else { - sm_any_sub: - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-CodeRef\n")); - ENTER_with_name("smartmatch_coderef"); - SAVETMPS; - PUSHMARK(SP); - PUSHs(d); - PUTBACK; - c = call_sv(e, G_SCALAR); - SPAGAIN; - if (c == 0) - PUSHs(&PL_sv_no); - else if (SvTEMP(TOPs)) - SvREFCNT_inc_void(TOPs); - FREETMPS; - LEAVE_with_name("smartmatch_coderef"); - RETURN; - } + I32 c; + if (object_on_left) { + goto sm_any_sub; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + /* Test sub truth for each key */ + HE *he; + bool andedresults = TRUE; + HV *hv = (HV*) SvRV(d); + I32 numkeys = hv_iterinit(hv); + DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-CodeRef\n")); + if (numkeys == 0) + RETPUSHYES; + while ( (he = hv_iternext(hv)) ) { + DEBUG_M(Perl_deb(aTHX_ " testing hash key...\n")); + ENTER_with_name("smartmatch_hash_key_test"); + SAVETMPS; + PUSHMARK(SP); + PUSHs(hv_iterkeysv(he)); + PUTBACK; + c = call_sv(e, G_SCALAR); + SPAGAIN; + if (c == 0) + andedresults = FALSE; + else + andedresults = SvTRUEx(POPs) && andedresults; + FREETMPS; + LEAVE_with_name("smartmatch_hash_key_test"); + } + if (andedresults) + RETPUSHYES; + else + RETPUSHNO; + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + /* Test sub truth for each element */ + Size_t i; + bool andedresults = TRUE; + AV *av = (AV*) SvRV(d); + const Size_t len = av_count(av); + DEBUG_M(Perl_deb(aTHX_ " applying rule Array-CodeRef\n")); + if (len == 0) + RETPUSHYES; + for (i = 0; i < len; ++i) { + SV * const * const svp = av_fetch(av, i, FALSE); + DEBUG_M(Perl_deb(aTHX_ " testing array element...\n")); + ENTER_with_name("smartmatch_array_elem_test"); + SAVETMPS; + PUSHMARK(SP); + if (svp) + PUSHs(*svp); + PUTBACK; + c = call_sv(e, G_SCALAR); + SPAGAIN; + if (c == 0) + andedresults = FALSE; + else + andedresults = SvTRUEx(POPs) && andedresults; + FREETMPS; + LEAVE_with_name("smartmatch_array_elem_test"); + } + if (andedresults) + RETPUSHYES; + else + RETPUSHNO; + } + else { + sm_any_sub: + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-CodeRef\n")); + ENTER_with_name("smartmatch_coderef"); + SAVETMPS; + PUSHMARK(SP); + PUSHs(d); + PUTBACK; + c = call_sv(e, G_SCALAR); + SPAGAIN; + if (c == 0) + PUSHs(&PL_sv_no); + else if (SvTEMP(TOPs)) + SvREFCNT_inc_void(TOPs); + FREETMPS; + LEAVE_with_name("smartmatch_coderef"); + RETURN; + } } /* ~~ %hash */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVHV) { - if (object_on_left) { - goto sm_any_hash; /* Treat objects like scalars */ - } - else if (!SvOK(d)) { - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Hash ($a undef)\n")); - RETPUSHNO; - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { - /* Check that the key-sets are identical */ - HE *he; - HV *other_hv = MUTABLE_HV(SvRV(d)); - bool tied; - bool other_tied; - U32 this_key_count = 0, - other_key_count = 0; - HV *hv = MUTABLE_HV(SvRV(e)); - - DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Hash\n")); - /* Tied hashes don't know how many keys they have. */ - tied = cBOOL(SvTIED_mg((SV*)hv, PERL_MAGIC_tied)); - other_tied = cBOOL(SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied)); - if (!tied ) { - if(other_tied) { - /* swap HV sides */ - HV * const temp = other_hv; - other_hv = hv; - hv = temp; - tied = TRUE; - other_tied = FALSE; - } - else if(HvUSEDKEYS((const HV *) hv) != HvUSEDKEYS(other_hv)) - RETPUSHNO; - } - - /* The hashes have the same number of keys, so it suffices - to check that one is a subset of the other. */ - (void) hv_iterinit(hv); - while ( (he = hv_iternext(hv)) ) { - SV *key = hv_iterkeysv(he); - - DEBUG_M(Perl_deb(aTHX_ " comparing hash key...\n")); - ++ this_key_count; - - if(!hv_exists_ent(other_hv, key, 0)) { - (void) hv_iterinit(hv); /* reset iterator */ - RETPUSHNO; - } - } - - if (other_tied) { - (void) hv_iterinit(other_hv); - while ( hv_iternext(other_hv) ) - ++other_key_count; - } - else - other_key_count = HvUSEDKEYS(other_hv); - - if (this_key_count != other_key_count) - RETPUSHNO; - else - RETPUSHYES; - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { - AV * const other_av = MUTABLE_AV(SvRV(d)); - const Size_t other_len = av_count(other_av); - Size_t i; - HV *hv = MUTABLE_HV(SvRV(e)); - - DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Hash\n")); - for (i = 0; i < other_len; ++i) { - SV ** const svp = av_fetch(other_av, i, FALSE); - DEBUG_M(Perl_deb(aTHX_ " checking for key existence...\n")); - if (svp) { /* ??? When can this not happen? */ - if (hv_exists_ent(hv, *svp, 0)) - RETPUSHYES; - } - } - RETPUSHNO; - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { - DEBUG_M(Perl_deb(aTHX_ " applying rule Regex-Hash\n")); - sm_regex_hash: - { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); - HE *he; - HV *hv = MUTABLE_HV(SvRV(e)); - - (void) hv_iterinit(hv); - while ( (he = hv_iternext(hv)) ) { - DEBUG_M(Perl_deb(aTHX_ " testing key against pattern...\n")); + if (object_on_left) { + goto sm_any_hash; /* Treat objects like scalars */ + } + else if (!SvOK(d)) { + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Hash ($a undef)\n")); + RETPUSHNO; + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + /* Check that the key-sets are identical */ + HE *he; + HV *other_hv = MUTABLE_HV(SvRV(d)); + bool tied; + bool other_tied; + U32 this_key_count = 0, + other_key_count = 0; + HV *hv = MUTABLE_HV(SvRV(e)); + + DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Hash\n")); + /* Tied hashes don't know how many keys they have. */ + tied = cBOOL(SvTIED_mg((SV*)hv, PERL_MAGIC_tied)); + other_tied = cBOOL(SvTIED_mg((const SV *)other_hv, PERL_MAGIC_tied)); + if (!tied ) { + if(other_tied) { + /* swap HV sides */ + HV * const temp = other_hv; + other_hv = hv; + hv = temp; + tied = TRUE; + other_tied = FALSE; + } + else if(HvUSEDKEYS((const HV *) hv) != HvUSEDKEYS(other_hv)) + RETPUSHNO; + } + + /* The hashes have the same number of keys, so it suffices + to check that one is a subset of the other. */ + (void) hv_iterinit(hv); + while ( (he = hv_iternext(hv)) ) { + SV *key = hv_iterkeysv(he); + + DEBUG_M(Perl_deb(aTHX_ " comparing hash key...\n")); + ++ this_key_count; + + if(!hv_exists_ent(other_hv, key, 0)) { + (void) hv_iterinit(hv); /* reset iterator */ + RETPUSHNO; + } + } + + if (other_tied) { + (void) hv_iterinit(other_hv); + while ( hv_iternext(other_hv) ) + ++other_key_count; + } + else + other_key_count = HvUSEDKEYS(other_hv); + + if (this_key_count != other_key_count) + RETPUSHNO; + else + RETPUSHYES; + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + AV * const other_av = MUTABLE_AV(SvRV(d)); + const Size_t other_len = av_count(other_av); + Size_t i; + HV *hv = MUTABLE_HV(SvRV(e)); + + DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Hash\n")); + for (i = 0; i < other_len; ++i) { + SV ** const svp = av_fetch(other_av, i, FALSE); + DEBUG_M(Perl_deb(aTHX_ " checking for key existence...\n")); + if (svp) { /* ??? When can this not happen? */ + if (hv_exists_ent(hv, *svp, 0)) + RETPUSHYES; + } + } + RETPUSHNO; + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { + DEBUG_M(Perl_deb(aTHX_ " applying rule Regex-Hash\n")); + sm_regex_hash: + { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); + HE *he; + HV *hv = MUTABLE_HV(SvRV(e)); + + (void) hv_iterinit(hv); + while ( (he = hv_iternext(hv)) ) { + DEBUG_M(Perl_deb(aTHX_ " testing key against pattern...\n")); PUTBACK; - if (matcher_matches_sv(matcher, hv_iterkeysv(he))) { + if (matcher_matches_sv(matcher, hv_iterkeysv(he))) { SPAGAIN; - (void) hv_iterinit(hv); - destroy_matcher(matcher); - RETPUSHYES; - } + (void) hv_iterinit(hv); + destroy_matcher(matcher); + RETPUSHYES; + } SPAGAIN; - } - destroy_matcher(matcher); - RETPUSHNO; - } - } - else { - sm_any_hash: - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Hash\n")); - if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0)) - RETPUSHYES; - else - RETPUSHNO; - } + } + destroy_matcher(matcher); + RETPUSHNO; + } + } + else { + sm_any_hash: + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Hash\n")); + if (hv_exists_ent(MUTABLE_HV(SvRV(e)), d, 0)) + RETPUSHYES; + else + RETPUSHNO; + } } /* ~~ @array */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_PVAV) { - if (object_on_left) { - goto sm_any_array; /* Treat objects like scalars */ - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { - AV * const other_av = MUTABLE_AV(SvRV(e)); - const Size_t other_len = av_count(other_av); - Size_t i; - - DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Array\n")); - for (i = 0; i < other_len; ++i) { - SV ** const svp = av_fetch(other_av, i, FALSE); - - DEBUG_M(Perl_deb(aTHX_ " testing for key existence...\n")); - if (svp) { /* ??? When can this not happen? */ - if (hv_exists_ent(MUTABLE_HV(SvRV(d)), *svp, 0)) - RETPUSHYES; - } - } - RETPUSHNO; - } - if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { - AV *other_av = MUTABLE_AV(SvRV(d)); - DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Array\n")); - if (av_count(MUTABLE_AV(SvRV(e))) != av_count(other_av)) - RETPUSHNO; - else { + if (object_on_left) { + goto sm_any_array; /* Treat objects like scalars */ + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + AV * const other_av = MUTABLE_AV(SvRV(e)); + const Size_t other_len = av_count(other_av); + Size_t i; + + DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Array\n")); + for (i = 0; i < other_len; ++i) { + SV ** const svp = av_fetch(other_av, i, FALSE); + + DEBUG_M(Perl_deb(aTHX_ " testing for key existence...\n")); + if (svp) { /* ??? When can this not happen? */ + if (hv_exists_ent(MUTABLE_HV(SvRV(d)), *svp, 0)) + RETPUSHYES; + } + } + RETPUSHNO; + } + if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + AV *other_av = MUTABLE_AV(SvRV(d)); + DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Array\n")); + if (av_count(MUTABLE_AV(SvRV(e))) != av_count(other_av)) + RETPUSHNO; + else { Size_t i; const Size_t other_len = av_count(other_av); - if (NULL == seen_this) { - seen_this = newHV(); - (void) sv_2mortal(MUTABLE_SV(seen_this)); - } - if (NULL == seen_other) { - seen_other = newHV(); - (void) sv_2mortal(MUTABLE_SV(seen_other)); - } - for(i = 0; i < other_len; ++i) { - SV * const * const this_elem = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - SV * const * const other_elem = av_fetch(other_av, i, FALSE); - - if (!this_elem || !other_elem) { - if ((this_elem && SvOK(*this_elem)) - || (other_elem && SvOK(*other_elem))) - RETPUSHNO; - } - else if (hv_exists_ent(seen_this, - sv_2mortal(newSViv(PTR2IV(*this_elem))), 0) || - hv_exists_ent(seen_other, - sv_2mortal(newSViv(PTR2IV(*other_elem))), 0)) - { - if (*this_elem != *other_elem) - RETPUSHNO; - } - else { - (void)hv_store_ent(seen_this, - sv_2mortal(newSViv(PTR2IV(*this_elem))), - &PL_sv_undef, 0); - (void)hv_store_ent(seen_other, - sv_2mortal(newSViv(PTR2IV(*other_elem))), - &PL_sv_undef, 0); - PUSHs(*other_elem); - PUSHs(*this_elem); - - PUTBACK; - DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n")); - (void) do_smartmatch(seen_this, seen_other, 0); - SPAGAIN; - DEBUG_M(Perl_deb(aTHX_ " recursion finished\n")); - - if (!SvTRUEx(POPs)) - RETPUSHNO; - } - } - RETPUSHYES; - } - } - else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { - DEBUG_M(Perl_deb(aTHX_ " applying rule Regex-Array\n")); - sm_regex_array: - { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); - const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); - Size_t i; - - for(i = 0; i < this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - DEBUG_M(Perl_deb(aTHX_ " testing element against pattern...\n")); + if (NULL == seen_this) { + seen_this = newHV(); + (void) sv_2mortal(MUTABLE_SV(seen_this)); + } + if (NULL == seen_other) { + seen_other = newHV(); + (void) sv_2mortal(MUTABLE_SV(seen_other)); + } + for(i = 0; i < other_len; ++i) { + SV * const * const this_elem = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + SV * const * const other_elem = av_fetch(other_av, i, FALSE); + + if (!this_elem || !other_elem) { + if ((this_elem && SvOK(*this_elem)) + || (other_elem && SvOK(*other_elem))) + RETPUSHNO; + } + else if (hv_exists_ent(seen_this, + sv_2mortal(newSViv(PTR2IV(*this_elem))), 0) || + hv_exists_ent(seen_other, + sv_2mortal(newSViv(PTR2IV(*other_elem))), 0)) + { + if (*this_elem != *other_elem) + RETPUSHNO; + } + else { + (void)hv_store_ent(seen_this, + sv_2mortal(newSViv(PTR2IV(*this_elem))), + &PL_sv_undef, 0); + (void)hv_store_ent(seen_other, + sv_2mortal(newSViv(PTR2IV(*other_elem))), + &PL_sv_undef, 0); + PUSHs(*other_elem); + PUSHs(*this_elem); + + PUTBACK; + DEBUG_M(Perl_deb(aTHX_ " recursively comparing array element...\n")); + (void) do_smartmatch(seen_this, seen_other, 0); + SPAGAIN; + DEBUG_M(Perl_deb(aTHX_ " recursion finished\n")); + + if (!SvTRUEx(POPs)) + RETPUSHNO; + } + } + RETPUSHYES; + } + } + else if (SvROK(d) && SvTYPE(SvRV(d)) == SVt_REGEXP) { + DEBUG_M(Perl_deb(aTHX_ " applying rule Regex-Array\n")); + sm_regex_array: + { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(d)); + const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); + Size_t i; + + for(i = 0; i < this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + DEBUG_M(Perl_deb(aTHX_ " testing element against pattern...\n")); PUTBACK; - if (svp && matcher_matches_sv(matcher, *svp)) { + if (svp && matcher_matches_sv(matcher, *svp)) { SPAGAIN; - destroy_matcher(matcher); - RETPUSHYES; - } + destroy_matcher(matcher); + RETPUSHYES; + } + SPAGAIN; + } + destroy_matcher(matcher); + RETPUSHNO; + } + } + else if (!SvOK(d)) { + /* undef ~~ array */ + const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); + Size_t i; + + DEBUG_M(Perl_deb(aTHX_ " applying rule Undef-Array\n")); + for (i = 0; i < this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + DEBUG_M(Perl_deb(aTHX_ " testing for undef element...\n")); + if (!svp || !SvOK(*svp)) + RETPUSHYES; + } + RETPUSHNO; + } + else { + sm_any_array: + { + Size_t i; + const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); + + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Array\n")); + for (i = 0; i < this_len; ++i) { + SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); + if (!svp) + continue; + + PUSHs(d); + PUSHs(*svp); + PUTBACK; + /* infinite recursion isn't supposed to happen here */ + DEBUG_M(Perl_deb(aTHX_ " recursively testing array element...\n")); + (void) do_smartmatch(NULL, NULL, 1); SPAGAIN; - } - destroy_matcher(matcher); - RETPUSHNO; - } - } - else if (!SvOK(d)) { - /* undef ~~ array */ - const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); - Size_t i; - - DEBUG_M(Perl_deb(aTHX_ " applying rule Undef-Array\n")); - for (i = 0; i < this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - DEBUG_M(Perl_deb(aTHX_ " testing for undef element...\n")); - if (!svp || !SvOK(*svp)) - RETPUSHYES; - } - RETPUSHNO; - } - else { - sm_any_array: - { - Size_t i; - const Size_t this_len = av_count(MUTABLE_AV(SvRV(e))); - - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Array\n")); - for (i = 0; i < this_len; ++i) { - SV * const * const svp = av_fetch(MUTABLE_AV(SvRV(e)), i, FALSE); - if (!svp) - continue; - - PUSHs(d); - PUSHs(*svp); - PUTBACK; - /* infinite recursion isn't supposed to happen here */ - DEBUG_M(Perl_deb(aTHX_ " recursively testing array element...\n")); - (void) do_smartmatch(NULL, NULL, 1); - SPAGAIN; - DEBUG_M(Perl_deb(aTHX_ " recursion finished\n")); - if (SvTRUEx(POPs)) - RETPUSHYES; - } - RETPUSHNO; - } - } + DEBUG_M(Perl_deb(aTHX_ " recursion finished\n")); + if (SvTRUEx(POPs)) + RETPUSHYES; + } + RETPUSHNO; + } + } } /* ~~ qr// */ else if (SvROK(e) && SvTYPE(SvRV(e)) == SVt_REGEXP) { - if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { - SV *t = d; d = e; e = t; - DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Regex\n")); - goto sm_regex_hash; - } - else if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { - SV *t = d; d = e; e = t; - DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Regex\n")); - goto sm_regex_array; - } - else { - PMOP * const matcher = make_matcher((REGEXP*) SvRV(e)); + if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVHV) { + SV *t = d; d = e; e = t; + DEBUG_M(Perl_deb(aTHX_ " applying rule Hash-Regex\n")); + goto sm_regex_hash; + } + else if (!object_on_left && SvROK(d) && SvTYPE(SvRV(d)) == SVt_PVAV) { + SV *t = d; d = e; e = t; + DEBUG_M(Perl_deb(aTHX_ " applying rule Array-Regex\n")); + goto sm_regex_array; + } + else { + PMOP * const matcher = make_matcher((REGEXP*) SvRV(e)); bool result; - DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Regex\n")); - PUTBACK; - result = matcher_matches_sv(matcher, d); + DEBUG_M(Perl_deb(aTHX_ " applying rule Any-Regex\n")); + PUTBACK; + result = matcher_matches_sv(matcher, d); SPAGAIN; - PUSHs(result ? &PL_sv_yes : &PL_sv_no); - destroy_matcher(matcher); - RETURN; - } + PUSHs(result ? &PL_sv_yes : &PL_sv_no); + destroy_matcher(matcher); + RETURN; + } } /* ~~ scalar */ /* See if there is overload magic on left */ else if (object_on_left && SvAMAGIC(d)) { - SV *tmpsv; - DEBUG_M(Perl_deb(aTHX_ " applying rule Object-Any\n")); - DEBUG_M(Perl_deb(aTHX_ " attempting overload\n")); - PUSHs(d); PUSHs(e); - PUTBACK; - tmpsv = amagic_call(d, e, smart_amg, AMGf_noright); - if (tmpsv) { - SPAGAIN; - (void)POPs; - SETs(tmpsv); - RETURN; - } - SP -= 2; - DEBUG_M(Perl_deb(aTHX_ " failed to run overload method; falling back...\n")); - goto sm_any_scalar; + SV *tmpsv; + DEBUG_M(Perl_deb(aTHX_ " applying rule Object-Any\n")); + DEBUG_M(Perl_deb(aTHX_ " attempting overload\n")); + PUSHs(d); PUSHs(e); + PUTBACK; + tmpsv = amagic_call(d, e, smart_amg, AMGf_noright); + if (tmpsv) { + SPAGAIN; + (void)POPs; + SETs(tmpsv); + RETURN; + } + SP -= 2; + DEBUG_M(Perl_deb(aTHX_ " failed to run overload method; falling back...\n")); + goto sm_any_scalar; } else if (!SvOK(d)) { - /* undef ~~ scalar ; we already know that the scalar is SvOK */ - DEBUG_M(Perl_deb(aTHX_ " applying rule undef-Any\n")); - RETPUSHNO; + /* undef ~~ scalar ; we already know that the scalar is SvOK */ + DEBUG_M(Perl_deb(aTHX_ " applying rule undef-Any\n")); + RETPUSHNO; } else sm_any_scalar: if (SvNIOK(e) || (SvPOK(e) && looks_like_number(e) && SvNIOK(d))) { - DEBUG_M(if (SvNIOK(e)) - Perl_deb(aTHX_ " applying rule Any-Num\n"); - else - Perl_deb(aTHX_ " applying rule Num-numish\n"); - ); - /* numeric comparison */ - PUSHs(d); PUSHs(e); - PUTBACK; - if (CopHINTS_get(PL_curcop) & HINT_INTEGER) - (void) Perl_pp_i_eq(aTHX); - else - (void) Perl_pp_eq(aTHX); - SPAGAIN; - if (SvTRUEx(POPs)) - RETPUSHYES; - else - RETPUSHNO; + DEBUG_M(if (SvNIOK(e)) + Perl_deb(aTHX_ " applying rule Any-Num\n"); + else + Perl_deb(aTHX_ " applying rule Num-numish\n"); + ); + /* numeric comparison */ + PUSHs(d); PUSHs(e); + PUTBACK; + if (CopHINTS_get(PL_curcop) & HINT_INTEGER) + (void) Perl_pp_i_eq(aTHX); + else + (void) Perl_pp_eq(aTHX); + SPAGAIN; + if (SvTRUEx(POPs)) + RETPUSHYES; + else + RETPUSHNO; } /* As a last resort, use string comparison */ @@ -5261,9 +5261,9 @@ PP(pp_enterwhen) RETURNOP calls PUTBACK which restores the stack pointer after the POPs. */ if (!(PL_op->op_flags & OPf_SPECIAL) && !SvTRUEx(POPs)) { - if (gimme == G_SCALAR) - PUSHs(&PL_sv_undef); - RETURNOP(cLOGOP->op_other->op_next); + if (gimme == G_SCALAR) + PUSHs(&PL_sv_undef); + RETURNOP(cLOGOP->op_other->op_next); } cx = cx_pushblock(CXt_WHEN, gimme, SP, PL_savestack_ix); @@ -5285,9 +5285,9 @@ PP(pp_leavewhen) cxix = dopoptogivenfor(cxstack_ix); if (cxix < 0) - /* diag_listed_as: Can't "when" outside a topicalizer */ - DIE(aTHX_ "Can't \"%s\" outside a topicalizer", - PL_op->op_flags & OPf_SPECIAL ? "default" : "when"); + /* diag_listed_as: Can't "when" outside a topicalizer */ + DIE(aTHX_ "Can't \"%s\" outside a topicalizer", + PL_op->op_flags & OPf_SPECIAL ? "default" : "when"); oldsp = PL_stack_base + cx->blk_oldsp; if (gimme == G_VOID) @@ -5305,14 +5305,14 @@ PP(pp_leavewhen) /* emulate pp_next. Note that any stack(s) cleanup will be * done by the pp_unstack which op_nextop should point to */ cx = CX_CUR(); - cx_topblock(cx); - PL_curcop = cx->blk_oldcop; - return cx->blk_loop.my_op->op_nextop; + cx_topblock(cx); + PL_curcop = cx->blk_oldcop; + return cx->blk_loop.my_op->op_nextop; } else { - PERL_ASYNC_CHECK(); + PERL_ASYNC_CHECK(); assert(cx->blk_givwhen.leave_op->op_type == OP_LEAVEGIVEN); - return cx->blk_givwhen.leave_op; + return cx->blk_givwhen.leave_op; } } @@ -5324,7 +5324,7 @@ PP(pp_continue) cxix = dopoptowhen(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"continue\" outside a when block"); + DIE(aTHX_ "Can't \"continue\" outside a when block"); if (cxix < cxstack_ix) dounwind(cxix); @@ -5348,11 +5348,11 @@ PP(pp_break) cxix = dopoptogivenfor(cxstack_ix); if (cxix < 0) - DIE(aTHX_ "Can't \"break\" outside a given block"); + DIE(aTHX_ "Can't \"break\" outside a given block"); cx = &cxstack[cxix]; if (CxFOREACH(cx)) - DIE(aTHX_ "Can't \"break\" in a loop topicalizer"); + DIE(aTHX_ "Can't \"break\" in a loop topicalizer"); if (cxix < cxstack_ix) dounwind(cxix); @@ -5388,35 +5388,35 @@ S_doparseform(pTHX_ SV *sv) PERL_ARGS_ASSERT_DOPARSEFORM; if (len == 0) - Perl_croak(aTHX_ "Null picture in formline"); + Perl_croak(aTHX_ "Null picture in formline"); if (SvTYPE(sv) >= SVt_PVMG) { - /* This might, of course, still return NULL. */ - mg = mg_find(sv, PERL_MAGIC_fm); + /* This might, of course, still return NULL. */ + mg = mg_find(sv, PERL_MAGIC_fm); } else { - sv_upgrade(sv, SVt_PVMG); + sv_upgrade(sv, SVt_PVMG); } if (mg) { - /* still the same as previously-compiled string? */ - SV *old = mg->mg_obj; - if ( !(!!SvUTF8(old) ^ !!SvUTF8(sv)) - && len == SvCUR(old) + /* still the same as previously-compiled string? */ + SV *old = mg->mg_obj; + if ( !(!!SvUTF8(old) ^ !!SvUTF8(sv)) + && len == SvCUR(old) && strnEQ(SvPVX(old), s, len) - ) { - DEBUG_f(PerlIO_printf(Perl_debug_log,"Re-using compiled format\n")); - return mg; - } + ) { + DEBUG_f(PerlIO_printf(Perl_debug_log,"Re-using compiled format\n")); + return mg; + } - DEBUG_f(PerlIO_printf(Perl_debug_log, "Re-compiling format\n")); - Safefree(mg->mg_ptr); - mg->mg_ptr = NULL; - SvREFCNT_dec(old); - mg->mg_obj = NULL; + DEBUG_f(PerlIO_printf(Perl_debug_log, "Re-compiling format\n")); + Safefree(mg->mg_ptr); + mg->mg_ptr = NULL; + SvREFCNT_dec(old); + mg->mg_obj = NULL; } else { - DEBUG_f(PerlIO_printf(Perl_debug_log, "Compiling format\n")); - mg = sv_magicext(sv, NULL, PERL_MAGIC_fm, &PL_vtbl_fm, NULL, 0); + DEBUG_f(PerlIO_printf(Perl_debug_log, "Compiling format\n")); + mg = sv_magicext(sv, NULL, PERL_MAGIC_fm, &PL_vtbl_fm, NULL, 0); } sv_copy = newSVpvn_utf8(s, len, SvUTF8(sv)); @@ -5426,8 +5426,8 @@ S_doparseform(pTHX_ SV *sv) /* estimate the buffer size needed */ for (base = s; s <= send; s++) { - if (*s == '\n' || *s == '@' || *s == '^') - maxops += 10; + if (*s == '\n' || *s == '@' || *s == '^') + maxops += 10; } s = base; base = NULL; @@ -5436,117 +5436,117 @@ S_doparseform(pTHX_ SV *sv) fpc = fops; if (s < send) { - linepc = fpc; - *fpc++ = FF_LINEMARK; - noblank = repeat = FALSE; - base = s; + linepc = fpc; + *fpc++ = FF_LINEMARK; + noblank = repeat = FALSE; + base = s; } while (s <= send) { - switch (*s++) { - default: - skipspaces = 0; - continue; - - case '~': - if (*s == '~') { - repeat = TRUE; - skipspaces++; - s++; - } - noblank = TRUE; - /* FALLTHROUGH */ - case ' ': case '\t': - skipspaces++; - continue; + switch (*s++) { + default: + skipspaces = 0; + continue; + + case '~': + if (*s == '~') { + repeat = TRUE; + skipspaces++; + s++; + } + noblank = TRUE; + /* FALLTHROUGH */ + case ' ': case '\t': + skipspaces++; + continue; case 0: - if (s < send) { - skipspaces = 0; + if (s < send) { + skipspaces = 0; continue; } /* FALLTHROUGH */ - case '\n': - arg = s - base; - skipspaces++; - arg -= skipspaces; - if (arg) { - if (postspace) - *fpc++ = FF_SPACE; - *fpc++ = FF_LITERAL; - *fpc++ = (U32)arg; - } - postspace = FALSE; - if (s <= send) - skipspaces--; - if (skipspaces) { - *fpc++ = FF_SKIP; - *fpc++ = (U32)skipspaces; - } - skipspaces = 0; - if (s <= send) - *fpc++ = FF_NEWLINE; - if (noblank) { - *fpc++ = FF_BLANK; - if (repeat) - arg = fpc - linepc + 1; - else - arg = 0; - *fpc++ = (U32)arg; - } - if (s < send) { - linepc = fpc; - *fpc++ = FF_LINEMARK; - noblank = repeat = FALSE; - base = s; - } - else - s++; - continue; - - case '@': - case '^': - ischop = s[-1] == '^'; - - if (postspace) { - *fpc++ = FF_SPACE; - postspace = FALSE; - } - arg = (s - base) - 1; - if (arg) { - *fpc++ = FF_LITERAL; - *fpc++ = (U32)arg; - } - - base = s - 1; - *fpc++ = FF_FETCH; - if (*s == '*') { /* @* or ^* */ - s++; - *fpc++ = 2; /* skip the @* or ^* */ - if (ischop) { - *fpc++ = FF_LINESNGL; - *fpc++ = FF_CHOP; - } else - *fpc++ = FF_LINEGLOB; - } - else if (*s == '#' || (*s == '.' && s[1] == '#')) { /* @###, ^### */ - arg = ischop ? FORM_NUM_BLANK : 0; - base = s - 1; - while (*s == '#') - s++; - if (*s == '.') { + case '\n': + arg = s - base; + skipspaces++; + arg -= skipspaces; + if (arg) { + if (postspace) + *fpc++ = FF_SPACE; + *fpc++ = FF_LITERAL; + *fpc++ = (U32)arg; + } + postspace = FALSE; + if (s <= send) + skipspaces--; + if (skipspaces) { + *fpc++ = FF_SKIP; + *fpc++ = (U32)skipspaces; + } + skipspaces = 0; + if (s <= send) + *fpc++ = FF_NEWLINE; + if (noblank) { + *fpc++ = FF_BLANK; + if (repeat) + arg = fpc - linepc + 1; + else + arg = 0; + *fpc++ = (U32)arg; + } + if (s < send) { + linepc = fpc; + *fpc++ = FF_LINEMARK; + noblank = repeat = FALSE; + base = s; + } + else + s++; + continue; + + case '@': + case '^': + ischop = s[-1] == '^'; + + if (postspace) { + *fpc++ = FF_SPACE; + postspace = FALSE; + } + arg = (s - base) - 1; + if (arg) { + *fpc++ = FF_LITERAL; + *fpc++ = (U32)arg; + } + + base = s - 1; + *fpc++ = FF_FETCH; + if (*s == '*') { /* @* or ^* */ + s++; + *fpc++ = 2; /* skip the @* or ^* */ + if (ischop) { + *fpc++ = FF_LINESNGL; + *fpc++ = FF_CHOP; + } else + *fpc++ = FF_LINEGLOB; + } + else if (*s == '#' || (*s == '.' && s[1] == '#')) { /* @###, ^### */ + arg = ischop ? FORM_NUM_BLANK : 0; + base = s - 1; + while (*s == '#') + s++; + if (*s == '.') { const char * const f = ++s; - while (*s == '#') - s++; - arg |= FORM_NUM_POINT + (s - f); - } - *fpc++ = s - base; /* fieldsize for FETCH */ - *fpc++ = FF_DECIMAL; + while (*s == '#') + s++; + arg |= FORM_NUM_POINT + (s - f); + } + *fpc++ = s - base; /* fieldsize for FETCH */ + *fpc++ = FF_DECIMAL; *fpc++ = (U32)arg; unchopnum |= ! ischop; } else if (*s == '0' && s[1] == '#') { /* Zero padded decimals */ arg = ischop ? FORM_NUM_BLANK : 0; - base = s - 1; + base = s - 1; s++; /* skip the '0' first */ while (*s == '#') s++; @@ -5558,47 +5558,47 @@ S_doparseform(pTHX_ SV *sv) } *fpc++ = s - base; /* fieldsize for FETCH */ *fpc++ = FF_0DECIMAL; - *fpc++ = (U32)arg; + *fpc++ = (U32)arg; unchopnum |= ! ischop; - } - else { /* text field */ - I32 prespace = 0; - bool ismore = FALSE; - - if (*s == '>') { - while (*++s == '>') ; - prespace = FF_SPACE; - } - else if (*s == '|') { - while (*++s == '|') ; - prespace = FF_HALFSPACE; - postspace = TRUE; - } - else { - if (*s == '<') - while (*++s == '<') ; - postspace = TRUE; - } - if (*s == '.' && s[1] == '.' && s[2] == '.') { - s += 3; - ismore = TRUE; - } - *fpc++ = s - base; /* fieldsize for FETCH */ - - *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL; - - if (prespace) - *fpc++ = (U32)prespace; /* add SPACE or HALFSPACE */ - *fpc++ = FF_ITEM; - if (ismore) - *fpc++ = FF_MORE; - if (ischop) - *fpc++ = FF_CHOP; - } - base = s; - skipspaces = 0; - continue; - } + } + else { /* text field */ + I32 prespace = 0; + bool ismore = FALSE; + + if (*s == '>') { + while (*++s == '>') ; + prespace = FF_SPACE; + } + else if (*s == '|') { + while (*++s == '|') ; + prespace = FF_HALFSPACE; + postspace = TRUE; + } + else { + if (*s == '<') + while (*++s == '<') ; + postspace = TRUE; + } + if (*s == '.' && s[1] == '.' && s[2] == '.') { + s += 3; + ismore = TRUE; + } + *fpc++ = s - base; /* fieldsize for FETCH */ + + *fpc++ = ischop ? FF_CHECKCHOP : FF_CHECKNL; + + if (prespace) + *fpc++ = (U32)prespace; /* add SPACE or HALFSPACE */ + *fpc++ = FF_ITEM; + if (ismore) + *fpc++ = FF_MORE; + if (ischop) + *fpc++ = FF_CHOP; + } + base = s; + skipspaces = 0; + continue; + } } *fpc++ = FF_END; @@ -5636,10 +5636,10 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize) if( value >= 0 ){ if (value + eps >= pwr) - res = TRUE; + res = TRUE; } else { if (value - eps <= -pwr) - res = TRUE; + res = TRUE; } return res; } @@ -5671,41 +5671,41 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) not sure where the trouble is yet. XXX */ { - SV *const cache = datasv; - if (SvOK(cache)) { - STRLEN cache_len; - const char *cache_p = SvPV(cache, cache_len); - STRLEN take = 0; - - if (umaxlen) { - /* Running in block mode and we have some cached data already. - */ - if (cache_len >= umaxlen) { - /* In fact, so much data we don't even need to call - filter_read. */ - take = umaxlen; - } - } else { - const char *const first_nl = - (const char *)memchr(cache_p, '\n', cache_len); - if (first_nl) { - take = first_nl + 1 - cache_p; - } - } - if (take) { - sv_catpvn(buf_sv, cache_p, take); - sv_chop(cache, cache_p + take); - /* Definitely not EOF */ - return 1; - } - - sv_catsv(buf_sv, cache); - if (umaxlen) { - umaxlen -= cache_len; - } - SvOK_off(cache); - read_from_cache = TRUE; - } + SV *const cache = datasv; + if (SvOK(cache)) { + STRLEN cache_len; + const char *cache_p = SvPV(cache, cache_len); + STRLEN take = 0; + + if (umaxlen) { + /* Running in block mode and we have some cached data already. + */ + if (cache_len >= umaxlen) { + /* In fact, so much data we don't even need to call + filter_read. */ + take = umaxlen; + } + } else { + const char *const first_nl = + (const char *)memchr(cache_p, '\n', cache_len); + if (first_nl) { + take = first_nl + 1 - cache_p; + } + } + if (take) { + sv_catpvn(buf_sv, cache_p, take); + sv_chop(cache, cache_p + take); + /* Definitely not EOF */ + return 1; + } + + sv_catsv(buf_sv, cache); + if (umaxlen) { + umaxlen -= cache_len; + } + SvOK_off(cache); + read_from_cache = TRUE; + } } /* Filter API says that the filter appends to the contents of the buffer. @@ -5714,97 +5714,97 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) don't want to pass it in a second time. I'm going to use a mortal in case the upstream filter croaks. */ upstream = ((SvOK(buf_sv) && sv_len(buf_sv)) || SvGMAGICAL(buf_sv)) - ? sv_newmortal() : buf_sv; + ? sv_newmortal() : buf_sv; SvUPGRADE(upstream, SVt_PV); - + if (filter_has_file) { - status = FILTER_READ(idx+1, upstream, 0); + status = FILTER_READ(idx+1, upstream, 0); } if (filter_sub && status >= 0) { - dSP; - int count; - - ENTER_with_name("call_filter_sub"); - SAVE_DEFSV; - SAVETMPS; - EXTEND(SP, 2); - - DEFSV_set(upstream); - PUSHMARK(SP); - PUSHs(&PL_sv_zero); - if (filter_state) { - PUSHs(filter_state); - } - PUTBACK; - count = call_sv(filter_sub, G_SCALAR|G_EVAL); - SPAGAIN; - - if (count > 0) { - SV *out = POPs; - SvGETMAGIC(out); - if (SvOK(out)) { - status = SvIV(out); - } + dSP; + int count; + + ENTER_with_name("call_filter_sub"); + SAVE_DEFSV; + SAVETMPS; + EXTEND(SP, 2); + + DEFSV_set(upstream); + PUSHMARK(SP); + PUSHs(&PL_sv_zero); + if (filter_state) { + PUSHs(filter_state); + } + PUTBACK; + count = call_sv(filter_sub, G_SCALAR|G_EVAL); + SPAGAIN; + + if (count > 0) { + SV *out = POPs; + SvGETMAGIC(out); + if (SvOK(out)) { + status = SvIV(out); + } else { SV * const errsv = ERRSV; if (SvTRUE_NN(errsv)) err = newSVsv(errsv); } - } + } - PUTBACK; - FREETMPS; - LEAVE_with_name("call_filter_sub"); + PUTBACK; + FREETMPS; + LEAVE_with_name("call_filter_sub"); } if (SvGMAGICAL(upstream)) { - mg_get(upstream); - if (upstream == buf_sv) mg_free(buf_sv); + mg_get(upstream); + if (upstream == buf_sv) mg_free(buf_sv); } if (SvIsCOW(upstream)) sv_force_normal(upstream); if(!err && SvOK(upstream)) { - got_p = SvPV_nomg(upstream, got_len); - if (umaxlen) { - if (got_len > umaxlen) { - prune_from = got_p + umaxlen; - } - } else { - char *const first_nl = (char *)memchr(got_p, '\n', got_len); - if (first_nl && first_nl + 1 < got_p + got_len) { - /* There's a second line here... */ - prune_from = first_nl + 1; - } - } + got_p = SvPV_nomg(upstream, got_len); + if (umaxlen) { + if (got_len > umaxlen) { + prune_from = got_p + umaxlen; + } + } else { + char *const first_nl = (char *)memchr(got_p, '\n', got_len); + if (first_nl && first_nl + 1 < got_p + got_len) { + /* There's a second line here... */ + prune_from = first_nl + 1; + } + } } if (!err && prune_from) { - /* Oh. Too long. Stuff some in our cache. */ - STRLEN cached_len = got_p + got_len - prune_from; - SV *const cache = datasv; - - if (SvOK(cache)) { - /* Cache should be empty. */ - assert(!SvCUR(cache)); - } - - sv_setpvn(cache, prune_from, cached_len); - /* If you ask for block mode, you may well split UTF-8 characters. - "If it breaks, you get to keep both parts" - (Your code is broken if you don't put them back together again - before something notices.) */ - if (SvUTF8(upstream)) { - SvUTF8_on(cache); - } - if (SvPOK(upstream)) SvCUR_set(upstream, got_len - cached_len); - else - /* Cannot just use sv_setpvn, as that could free the buffer - before we have a chance to assign it. */ - sv_usepvn(upstream, savepvn(got_p, got_len - cached_len), - got_len - cached_len); - *prune_from = 0; - /* Can't yet be EOF */ - if (status == 0) - status = 1; + /* Oh. Too long. Stuff some in our cache. */ + STRLEN cached_len = got_p + got_len - prune_from; + SV *const cache = datasv; + + if (SvOK(cache)) { + /* Cache should be empty. */ + assert(!SvCUR(cache)); + } + + sv_setpvn(cache, prune_from, cached_len); + /* If you ask for block mode, you may well split UTF-8 characters. + "If it breaks, you get to keep both parts" + (Your code is broken if you don't put them back together again + before something notices.) */ + if (SvUTF8(upstream)) { + SvUTF8_on(cache); + } + if (SvPOK(upstream)) SvCUR_set(upstream, got_len - cached_len); + else + /* Cannot just use sv_setpvn, as that could free the buffer + before we have a chance to assign it. */ + sv_usepvn(upstream, savepvn(got_p, got_len - cached_len), + got_len - cached_len); + *prune_from = 0; + /* Can't yet be EOF */ + if (status == 0) + status = 1; } /* If they are at EOF but buf_sv has something in it, then they may never @@ -5813,31 +5813,31 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen) */ if (!err && upstream != buf_sv && SvOK(upstream)) { - sv_catsv_nomg(buf_sv, upstream); + sv_catsv_nomg(buf_sv, upstream); } else if (SvOK(upstream)) (void)SvPV_force_nolen(buf_sv); if (status <= 0) { - IoLINES(datasv) = 0; - if (filter_state) { - SvREFCNT_dec(filter_state); - IoTOP_GV(datasv) = NULL; - } - if (filter_sub) { - SvREFCNT_dec(filter_sub); - IoBOTTOM_GV(datasv) = NULL; - } - filter_del(S_run_user_filter); + IoLINES(datasv) = 0; + if (filter_state) { + SvREFCNT_dec(filter_state); + IoTOP_GV(datasv) = NULL; + } + if (filter_sub) { + SvREFCNT_dec(filter_sub); + IoBOTTOM_GV(datasv) = NULL; + } + filter_del(S_run_user_filter); } if (err) croak_sv(err); if (status == 0 && read_from_cache) { - /* If we read some data from the cache (and by getting here it implies - that we emptied the cache) then we aren't yet at EOF, and mustn't - report that to our caller. */ - return 1; + /* If we read some data from the cache (and by getting here it implies + that we emptied the cache) then we aren't yet at EOF, and mustn't + report that to our caller. */ + return 1; } return status; } diff --git a/pp_hot.c b/pp_hot.c index 0f5e4170a542..5119638b9ff6 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -60,9 +60,9 @@ PP(pp_gvsv) dSP; EXTEND(SP,1); if (UNLIKELY(PL_op->op_private & OPpLVAL_INTRO)) - PUSHs(save_scalar(cGVOP_gv)); + PUSHs(save_scalar(cGVOP_gv)); else - PUSHs(GvSVn(cGVOP_gv)); + PUSHs(GvSVn(cGVOP_gv)); RETURN; } @@ -107,19 +107,19 @@ PP(pp_and) { PERL_ASYNC_CHECK(); { - /* SP is not used to remove a variable that is saved across the - sv_2bool_flags call in SvTRUE_NN, if a RISC/CISC or low/high machine - register or load/store vs direct mem ops macro is introduced, this - should be a define block between direct PL_stack_sp and dSP operations, - presently, using PL_stack_sp is bias towards CISC cpus */ - SV * const sv = *PL_stack_sp; - if (!SvTRUE_NN(sv)) - return NORMAL; - else { - if (PL_op->op_type == OP_AND) - --PL_stack_sp; - return cLOGOP->op_other; - } + /* SP is not used to remove a variable that is saved across the + sv_2bool_flags call in SvTRUE_NN, if a RISC/CISC or low/high machine + register or load/store vs direct mem ops macro is introduced, this + should be a define block between direct PL_stack_sp and dSP operations, + presently, using PL_stack_sp is bias towards CISC cpus */ + SV * const sv = *PL_stack_sp; + if (!SvTRUE_NN(sv)) + return NORMAL; + else { + if (PL_op->op_type == OP_AND) + --PL_stack_sp; + return cLOGOP->op_other; + } } } @@ -132,98 +132,98 @@ PP(pp_sassign) SV *left = POPs; SV *right = TOPs; if (PL_op->op_private & OPpASSIGN_BACKWARDS) { /* {or,and,dor}assign */ - SV * const temp = left; - left = right; right = temp; + SV * const temp = left; + left = right; right = temp; } assert(TAINTING_get || !TAINT_get); if (UNLIKELY(TAINT_get) && !SvTAINTED(right)) - TAINT_NOT; + TAINT_NOT; if (UNLIKELY(PL_op->op_private & OPpASSIGN_CV_TO_GV)) { /* *foo =\&bar */ - SV * const cv = SvRV(right); - const U32 cv_type = SvTYPE(cv); - const bool is_gv = isGV_with_GP(left); - const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM; - - if (!got_coderef) { - assert(SvROK(cv)); - } - - /* Can do the optimisation if left (LVALUE) is not a typeglob, - right (RVALUE) is a reference to something, and we're in void - context. */ - if (!got_coderef && !is_gv && GIMME_V == G_VOID) { - /* Is the target symbol table currently empty? */ - GV * const gv = gv_fetchsv_nomg(left, GV_NOINIT, SVt_PVGV); - if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) { - /* Good. Create a new proxy constant subroutine in the target. - The gv becomes a(nother) reference to the constant. */ - SV *const value = SvRV(cv); - - SvUPGRADE(MUTABLE_SV(gv), SVt_IV); - SvPCS_IMPORTED_on(gv); - SvRV_set(gv, value); - SvREFCNT_inc_simple_void(value); - SETs(left); - RETURN; - } - } - - /* Need to fix things up. */ - if (!is_gv) { - /* Need to fix GV. */ - left = MUTABLE_SV(gv_fetchsv_nomg(left,GV_ADD, SVt_PVGV)); - } - - if (!got_coderef) { - /* We've been returned a constant rather than a full subroutine, - but they expect a subroutine reference to apply. */ - if (SvROK(cv)) { - ENTER_with_name("sassign_coderef"); - SvREFCNT_inc_void(SvRV(cv)); - /* newCONSTSUB takes a reference count on the passed in SV - from us. We set the name to NULL, otherwise we get into - all sorts of fun as the reference to our new sub is - donated to the GV that we're about to assign to. - */ - SvRV_set(right, MUTABLE_SV(newCONSTSUB(GvSTASH(left), NULL, - SvRV(cv)))); - SvREFCNT_dec_NN(cv); - LEAVE_with_name("sassign_coderef"); - } else { - /* What can happen for the corner case *{"BONK"} = \&{"BONK"}; - is that - First: ops for \&{"BONK"}; return us the constant in the - symbol table - Second: ops for *{"BONK"} cause that symbol table entry - (and our reference to it) to be upgraded from RV - to typeblob) - Thirdly: We get here. cv is actually PVGV now, and its - GvCV() is actually the subroutine we're looking for - - So change the reference so that it points to the subroutine - of that typeglob, as that's what they were after all along. - */ - GV *const upgraded = MUTABLE_GV(cv); - CV *const source = GvCV(upgraded); - - assert(source); - assert(CvFLAGS(source) & CVf_CONST); - - SvREFCNT_inc_simple_void_NN(source); - SvREFCNT_dec_NN(upgraded); - SvRV_set(right, MUTABLE_SV(source)); - } - } + SV * const cv = SvRV(right); + const U32 cv_type = SvTYPE(cv); + const bool is_gv = isGV_with_GP(left); + const bool got_coderef = cv_type == SVt_PVCV || cv_type == SVt_PVFM; + + if (!got_coderef) { + assert(SvROK(cv)); + } + + /* Can do the optimisation if left (LVALUE) is not a typeglob, + right (RVALUE) is a reference to something, and we're in void + context. */ + if (!got_coderef && !is_gv && GIMME_V == G_VOID) { + /* Is the target symbol table currently empty? */ + GV * const gv = gv_fetchsv_nomg(left, GV_NOINIT, SVt_PVGV); + if (SvTYPE(gv) != SVt_PVGV && !SvOK(gv)) { + /* Good. Create a new proxy constant subroutine in the target. + The gv becomes a(nother) reference to the constant. */ + SV *const value = SvRV(cv); + + SvUPGRADE(MUTABLE_SV(gv), SVt_IV); + SvPCS_IMPORTED_on(gv); + SvRV_set(gv, value); + SvREFCNT_inc_simple_void(value); + SETs(left); + RETURN; + } + } + + /* Need to fix things up. */ + if (!is_gv) { + /* Need to fix GV. */ + left = MUTABLE_SV(gv_fetchsv_nomg(left,GV_ADD, SVt_PVGV)); + } + + if (!got_coderef) { + /* We've been returned a constant rather than a full subroutine, + but they expect a subroutine reference to apply. */ + if (SvROK(cv)) { + ENTER_with_name("sassign_coderef"); + SvREFCNT_inc_void(SvRV(cv)); + /* newCONSTSUB takes a reference count on the passed in SV + from us. We set the name to NULL, otherwise we get into + all sorts of fun as the reference to our new sub is + donated to the GV that we're about to assign to. + */ + SvRV_set(right, MUTABLE_SV(newCONSTSUB(GvSTASH(left), NULL, + SvRV(cv)))); + SvREFCNT_dec_NN(cv); + LEAVE_with_name("sassign_coderef"); + } else { + /* What can happen for the corner case *{"BONK"} = \&{"BONK"}; + is that + First: ops for \&{"BONK"}; return us the constant in the + symbol table + Second: ops for *{"BONK"} cause that symbol table entry + (and our reference to it) to be upgraded from RV + to typeblob) + Thirdly: We get here. cv is actually PVGV now, and its + GvCV() is actually the subroutine we're looking for + + So change the reference so that it points to the subroutine + of that typeglob, as that's what they were after all along. + */ + GV *const upgraded = MUTABLE_GV(cv); + CV *const source = GvCV(upgraded); + + assert(source); + assert(CvFLAGS(source) & CVf_CONST); + + SvREFCNT_inc_simple_void_NN(source); + SvREFCNT_dec_NN(upgraded); + SvRV_set(right, MUTABLE_SV(source)); + } + } } if ( UNLIKELY(SvTEMP(left)) && !SvSMAGICAL(left) && SvREFCNT(left) == 1 && (!isGV_with_GP(left) || SvFAKE(left)) && ckWARN(WARN_MISC) ) - Perl_warner(aTHX_ - packWARN(WARN_MISC), "Useless assignment to a temporary" - ); + Perl_warner(aTHX_ + packWARN(WARN_MISC), "Useless assignment to a temporary" + ); SvSetMagicSV(left, right); SETs(left); RETURN; @@ -249,7 +249,7 @@ PP(pp_unstack) FREETMPS; if (!(PL_op->op_flags & OPf_SPECIAL)) { assert(CxTYPE(cx) == CXt_BLOCK || CxTYPE_is_LOOP(cx)); - CX_LEAVE_SCOPE(cx); + CX_LEAVE_SCOPE(cx); } return NORMAL; } @@ -272,53 +272,53 @@ S_do_concat(pTHX_ SV *left, SV *right, SV *targ, U8 targmy) bool rcopied = FALSE; if (TARG == right && right != left) { /* $r = $l.$r */ - rpv = SvPV_nomg_const(right, rlen); - rbyte = !DO_UTF8(right); - right = newSVpvn_flags(rpv, rlen, SVs_TEMP); - rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ - rcopied = TRUE; + rpv = SvPV_nomg_const(right, rlen); + rbyte = !DO_UTF8(right); + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); + rpv = SvPV_const(right, rlen); /* no point setting UTF-8 here */ + rcopied = TRUE; } if (TARG != left) { /* not $l .= $r */ STRLEN llen; const char* const lpv = SvPV_nomg_const(left, llen); - lbyte = !DO_UTF8(left); - sv_setpvn(TARG, lpv, llen); - if (!lbyte) - SvUTF8_on(TARG); - else - SvUTF8_off(TARG); + lbyte = !DO_UTF8(left); + sv_setpvn(TARG, lpv, llen); + if (!lbyte) + SvUTF8_on(TARG); + else + SvUTF8_off(TARG); } else { /* $l .= $r and left == TARG */ - if (!SvOK(left)) { + if (!SvOK(left)) { if ((left == right /* $l .= $l */ || targmy) /* $l = $l . $r */ && ckWARN(WARN_UNINITIALIZED) ) report_uninit(left); SvPVCLEAR(left); - } + } else { SvPV_force_nomg_nolen(left); } - lbyte = !DO_UTF8(left); - if (IN_BYTES) - SvUTF8_off(left); + lbyte = !DO_UTF8(left); + if (IN_BYTES) + SvUTF8_off(left); } if (!rcopied) { - rpv = SvPV_nomg_const(right, rlen); - rbyte = !DO_UTF8(right); + rpv = SvPV_nomg_const(right, rlen); + rbyte = !DO_UTF8(right); } if (lbyte != rbyte) { - if (lbyte) - sv_utf8_upgrade_nomg(TARG); - else { - if (!rcopied) - right = newSVpvn_flags(rpv, rlen, SVs_TEMP); - sv_utf8_upgrade_nomg(right); - rpv = SvPV_nomg_const(right, rlen); - } + if (lbyte) + sv_utf8_upgrade_nomg(TARG); + else { + if (!rcopied) + right = newSVpvn_flags(rpv, rlen, SVs_TEMP); + sv_utf8_upgrade_nomg(right); + rpv = SvPV_nomg_const(right, rlen); + } } sv_catpvn_nomg(TARG, rpv, rlen); SvSETMAGIC(TARG); @@ -1142,7 +1142,7 @@ S_pushav(pTHX_ AV* const av) PADOFFSET i; for (i=0; i < (PADOFFSET)maxarg; i++) { SV *sv = AvARRAY(av)[i]; - SP[i+1] = LIKELY(sv) + SP[i+1] = LIKELY(sv) ? sv : UNLIKELY(PL_op->op_flags & OPf_MOD) ? av_nonelem(av,i) @@ -1207,28 +1207,28 @@ PP(pp_padsv) dSP; EXTEND(SP, 1); { - OP * const op = PL_op; - /* access PL_curpad once */ - SV ** const padentry = &(PAD_SVl(op->op_targ)); - { - dTARG; - TARG = *padentry; - PUSHs(TARG); - PUTBACK; /* no pop/push after this, TOPs ok */ - } - if (op->op_flags & OPf_MOD) { - if (op->op_private & OPpLVAL_INTRO) - if (!(op->op_private & OPpPAD_STATE)) - save_clearsv(padentry); - if (op->op_private & OPpDEREF) { - /* TOPs is equivalent to TARG here. Using TOPs (SP) rather - than TARG reduces the scope of TARG, so it does not - span the call to save_clearsv, resulting in smaller - machine code. */ - TOPs = vivify_ref(TOPs, op->op_private & OPpDEREF); - } - } - return op->op_next; + OP * const op = PL_op; + /* access PL_curpad once */ + SV ** const padentry = &(PAD_SVl(op->op_targ)); + { + dTARG; + TARG = *padentry; + PUSHs(TARG); + PUTBACK; /* no pop/push after this, TOPs ok */ + } + if (op->op_flags & OPf_MOD) { + if (op->op_private & OPpLVAL_INTRO) + if (!(op->op_private & OPpPAD_STATE)) + save_clearsv(padentry); + if (op->op_private & OPpDEREF) { + /* TOPs is equivalent to TARG here. Using TOPs (SP) rather + than TARG reduces the scope of TARG, so it does not + span the call to save_clearsv, resulting in smaller + machine code. */ + TOPs = vivify_ref(TOPs, op->op_private & OPpDEREF); + } + } + return op->op_next; } } @@ -1238,22 +1238,22 @@ PP(pp_readline) /* pp_coreargs pushes a NULL to indicate no args passed to * CORE::readline() */ if (TOPs) { - SvGETMAGIC(TOPs); - tryAMAGICunTARGETlist(iter_amg, 0); - PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--); + SvGETMAGIC(TOPs); + tryAMAGICunTARGETlist(iter_amg, 0); + PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--); } else PL_last_in_gv = PL_argvgv, PL_stack_sp--; if (!isGV_with_GP(PL_last_in_gv)) { - if (SvROK(PL_last_in_gv) && isGV_with_GP(SvRV(PL_last_in_gv))) - PL_last_in_gv = MUTABLE_GV(SvRV(PL_last_in_gv)); - else { - dSP; - XPUSHs(MUTABLE_SV(PL_last_in_gv)); - PUTBACK; - Perl_pp_rv2gv(aTHX); - PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--); + if (SvROK(PL_last_in_gv) && isGV_with_GP(SvRV(PL_last_in_gv))) + PL_last_in_gv = MUTABLE_GV(SvRV(PL_last_in_gv)); + else { + dSP; + XPUSHs(MUTABLE_SV(PL_last_in_gv)); + PUTBACK; + Perl_pp_rv2gv(aTHX); + PL_last_in_gv = MUTABLE_GV(*PL_stack_sp--); assert((SV*)PL_last_in_gv == &PL_sv_undef || isGV_with_GP(PL_last_in_gv)); - } + } } return do_readline(); } @@ -1293,10 +1293,10 @@ PP(pp_preinc) == SVf_IOK)) && SvIVX(sv) != IV_MAX) { - SvIV_set(sv, SvIVX(sv) + 1); + SvIV_set(sv, SvIVX(sv) + 1); } else /* Do all the PERL_PRESERVE_IVUV and hard cases in sv_inc */ - sv_inc(sv); + sv_inc(sv); SvSETMAGIC(sv); return NORMAL; } @@ -1314,10 +1314,10 @@ PP(pp_predec) == SVf_IOK)) && SvIVX(sv) != IV_MIN) { - SvIV_set(sv, SvIVX(sv) - 1); + SvIV_set(sv, SvIVX(sv) - 1); } else /* Do all the PERL_PRESERVE_IVUV and hard cases in sv_dec */ - sv_dec(sv); + sv_dec(sv); SvSETMAGIC(sv); return NORMAL; } @@ -1332,11 +1332,11 @@ PP(pp_or) PERL_ASYNC_CHECK(); sv = TOPs; if (SvTRUE_NN(sv)) - RETURN; + RETURN; else { - if (PL_op->op_type == OP_OR) + if (PL_op->op_type == OP_OR) --SP; - RETURNOP(cLOGOP->op_other); + RETURNOP(cLOGOP->op_other); } } @@ -1352,16 +1352,16 @@ PP(pp_defined) const bool is_dor = (op_type == OP_DOR || op_type == OP_DORASSIGN); if (is_dor) { - PERL_ASYNC_CHECK(); + PERL_ASYNC_CHECK(); sv = TOPs; if (UNLIKELY(!sv || !SvANY(sv))) { - if (op_type == OP_DOR) - --SP; + if (op_type == OP_DOR) + --SP; RETURNOP(cLOGOP->op_other); } } else { - /* OP_DEFINED */ + /* OP_DEFINED */ sv = POPs; if (UNLIKELY(!sv || !SvANY(sv))) RETPUSHNO; @@ -1370,22 +1370,22 @@ PP(pp_defined) defined = FALSE; switch (SvTYPE(sv)) { case SVt_PVAV: - if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) - defined = TRUE; - break; + if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + defined = TRUE; + break; case SVt_PVHV: - if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) - defined = TRUE; - break; + if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied))) + defined = TRUE; + break; case SVt_PVCV: - if (CvROOT(sv) || CvXSUB(sv)) - defined = TRUE; - break; + if (CvROOT(sv) || CvXSUB(sv)) + defined = TRUE; + break; default: - SvGETMAGIC(sv); - if (SvOK(sv)) - defined = TRUE; - break; + SvGETMAGIC(sv); + if (SvOK(sv)) + defined = TRUE; + break; } if (is_dor) { @@ -1503,103 +1503,103 @@ PP(pp_add) */ if (SvIV_please_nomg(svr)) { - /* Unless the left argument is integer in range we are going to have to - use NV maths. Hence only attempt to coerce the right argument if - we know the left is integer. */ - UV auv = 0; - bool auvok = FALSE; - bool a_valid = 0; - - if (!useleft) { - auv = 0; - a_valid = auvok = 1; - /* left operand is undef, treat as zero. + 0 is identity, - Could SETi or SETu right now, but space optimise by not adding - lots of code to speed up what is probably a rarish case. */ - } else { - /* Left operand is defined, so is it IV? */ - if (SvIV_please_nomg(svl)) { - if ((auvok = SvUOK(svl))) - auv = SvUVX(svl); - else { - const IV aiv = SvIVX(svl); - if (aiv >= 0) { - auv = aiv; - auvok = 1; /* Now acting as a sign flag. */ - } else { + /* Unless the left argument is integer in range we are going to have to + use NV maths. Hence only attempt to coerce the right argument if + we know the left is integer. */ + UV auv = 0; + bool auvok = FALSE; + bool a_valid = 0; + + if (!useleft) { + auv = 0; + a_valid = auvok = 1; + /* left operand is undef, treat as zero. + 0 is identity, + Could SETi or SETu right now, but space optimise by not adding + lots of code to speed up what is probably a rarish case. */ + } else { + /* Left operand is defined, so is it IV? */ + if (SvIV_please_nomg(svl)) { + if ((auvok = SvUOK(svl))) + auv = SvUVX(svl); + else { + const IV aiv = SvIVX(svl); + if (aiv >= 0) { + auv = aiv; + auvok = 1; /* Now acting as a sign flag. */ + } else { /* Using 0- here and later to silence bogus warning * from MS VC */ auv = (UV) (0 - (UV) aiv); - } - } - a_valid = 1; - } - } - if (a_valid) { - bool result_good = 0; - UV result; - UV buv; - bool buvok = SvUOK(svr); - - if (buvok) - buv = SvUVX(svr); - else { - const IV biv = SvIVX(svr); - if (biv >= 0) { - buv = biv; - buvok = 1; - } else + } + } + a_valid = 1; + } + } + if (a_valid) { + bool result_good = 0; + UV result; + UV buv; + bool buvok = SvUOK(svr); + + if (buvok) + buv = SvUVX(svr); + else { + const IV biv = SvIVX(svr); + if (biv >= 0) { + buv = biv; + buvok = 1; + } else buv = (UV) (0 - (UV) biv); - } - /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, - else "IV" now, independent of how it came in. - if a, b represents positive, A, B negative, a maps to -A etc - a + b => (a + b) - A + b => -(a - b) - a + B => (a - b) - A + B => -(a + b) - all UV maths. negate result if A negative. - add if signs same, subtract if signs differ. */ - - if (auvok ^ buvok) { - /* Signs differ. */ - if (auv >= buv) { - result = auv - buv; - /* Must get smaller */ - if (result <= auv) - result_good = 1; - } else { - result = buv - auv; - if (result <= buv) { - /* result really should be -(auv-buv). as its negation - of true value, need to swap our result flag */ - auvok = !auvok; - result_good = 1; - } - } - } else { - /* Signs same */ - result = auv + buv; - if (result >= auv) - result_good = 1; - } - if (result_good) { - SP--; - if (auvok) - SETu( result ); - else { - /* Negate result */ - if (result <= (UV)IV_MIN) + } + /* ?uvok if value is >= 0. basically, flagged as UV if it's +ve, + else "IV" now, independent of how it came in. + if a, b represents positive, A, B negative, a maps to -A etc + a + b => (a + b) + A + b => -(a - b) + a + B => (a - b) + A + B => -(a + b) + all UV maths. negate result if A negative. + add if signs same, subtract if signs differ. */ + + if (auvok ^ buvok) { + /* Signs differ. */ + if (auv >= buv) { + result = auv - buv; + /* Must get smaller */ + if (result <= auv) + result_good = 1; + } else { + result = buv - auv; + if (result <= buv) { + /* result really should be -(auv-buv). as its negation + of true value, need to swap our result flag */ + auvok = !auvok; + result_good = 1; + } + } + } else { + /* Signs same */ + result = auv + buv; + if (result >= auv) + result_good = 1; + } + if (result_good) { + SP--; + if (auvok) + SETu( result ); + else { + /* Negate result */ + if (result <= (UV)IV_MIN) SETi(result == (UV)IV_MIN ? IV_MIN : -(IV)result); - else { - /* result valid, but out of range for IV. */ - SETn( -(NV)result ); - } - } - RETURN; - } /* Overflow, drop through to NVs. */ - } + else { + /* result valid, but out of range for IV. */ + SETn( -(NV)result ); + } + } + RETURN; + } /* Overflow, drop through to NVs. */ + } } #else @@ -1607,15 +1607,15 @@ PP(pp_add) #endif { - NV value = SvNV_nomg(svr); - (void)POPs; - if (!useleft) { - /* left operand is undef, treat as zero. + 0.0 is identity. */ - SETn(value); - RETURN; - } - SETn( value + SvNV_nomg(svl) ); - RETURN; + NV value = SvNV_nomg(svr); + (void)POPs; + if (!useleft) { + /* left operand is undef, treat as zero. + 0.0 is identity. */ + SETn(value); + RETURN; + } + SETn( value + SvNV_nomg(svl) ); + RETURN; } } @@ -1626,7 +1626,7 @@ PP(pp_aelemfast) { dSP; AV * const av = PL_op->op_type == OP_AELEMFAST_LEX - ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv); + ? MUTABLE_AV(PAD_SV(PL_op->op_targ)) : GvAVn(cGVOP_gv); const U32 lval = PL_op->op_flags & OPf_MOD; const I8 key = (I8)PL_op->op_private; SV** svp; @@ -1653,7 +1653,7 @@ PP(pp_aelemfast) DIE(aTHX_ PL_no_aelem, (int)key); if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */ - mg_get(sv); + mg_get(sv); PUSHs(sv); RETURN; } @@ -1678,83 +1678,83 @@ PP(pp_print) PerlIO *fp; MAGIC *mg; GV * const gv - = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv; + = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv; IO *io = GvIO(gv); if (io - && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { had_magic: - if (MARK == ORIGMARK) { - /* If using default handle then we need to make space to - * pass object as 1st arg, so move other args up ... - */ - MEXTEND(SP, 1); - ++MARK; - Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); - ++SP; - } - return Perl_tied_method(aTHX_ SV_CONST(PRINT), mark - 1, MUTABLE_SV(io), - mg, - (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK - | (PL_op->op_type == OP_SAY - ? TIED_METHOD_SAY : 0)), sp - mark); + if (MARK == ORIGMARK) { + /* If using default handle then we need to make space to + * pass object as 1st arg, so move other args up ... + */ + MEXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + return Perl_tied_method(aTHX_ SV_CONST(PRINT), mark - 1, MUTABLE_SV(io), + mg, + (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK + | (PL_op->op_type == OP_SAY + ? TIED_METHOD_SAY : 0)), sp - mark); } if (!io) { if ( gv && GvEGVx(gv) && (io = GvIO(GvEGV(gv))) - && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) goto had_magic; - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - goto just_say_no; + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + goto just_say_no; } else if (!(fp = IoOFP(io))) { - if (IoIFP(io)) - report_wrongway_fh(gv, '<'); - else - report_evil_fh(gv); - SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); - goto just_say_no; + if (IoIFP(io)) + report_wrongway_fh(gv, '<'); + else + report_evil_fh(gv); + SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); + goto just_say_no; } else { - SV * const ofs = GvSV(PL_ofsgv); /* $, */ - MARK++; - if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) { - while (MARK <= SP) { - if (!do_print(*MARK, fp)) - break; - MARK++; - if (MARK <= SP) { - /* don't use 'ofs' here - it may be invalidated by magic callbacks */ - if (!do_print(GvSV(PL_ofsgv), fp)) { - MARK--; - break; - } - } - } - } - else { - while (MARK <= SP) { - if (!do_print(*MARK, fp)) - break; - MARK++; - } - } - if (MARK <= SP) - goto just_say_no; - else { - if (PL_op->op_type == OP_SAY) { - if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp)) - goto just_say_no; - } + SV * const ofs = GvSV(PL_ofsgv); /* $, */ + MARK++; + if (ofs && (SvGMAGICAL(ofs) || SvOK(ofs))) { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + if (MARK <= SP) { + /* don't use 'ofs' here - it may be invalidated by magic callbacks */ + if (!do_print(GvSV(PL_ofsgv), fp)) { + MARK--; + break; + } + } + } + } + else { + while (MARK <= SP) { + if (!do_print(*MARK, fp)) + break; + MARK++; + } + } + if (MARK <= SP) + goto just_say_no; + else { + if (PL_op->op_type == OP_SAY) { + if (PerlIO_write(fp, "\n", 1) == 0 || PerlIO_error(fp)) + goto just_say_no; + } else if (PL_ors_sv && SvOK(PL_ors_sv)) - if (!do_print(PL_ors_sv, fp)) /* $\ */ - goto just_say_no; + if (!do_print(PL_ors_sv, fp)) /* $\ */ + goto just_say_no; - if (IoFLAGS(io) & IOf_FLUSH) - if (PerlIO_flush(fp) == EOF) - goto just_say_no; - } + if (IoFLAGS(io) & IOf_FLUSH) + if (PerlIO_flush(fp) == EOF) + goto just_say_no; + } } SP = ORIGMARK; XPUSHs(&PL_sv_yes); @@ -1859,18 +1859,18 @@ PP(pp_padav) U8 gimme; assert(SvTYPE(TARG) == SVt_PVAV); if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO )) - if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) - SAVECLEARSV(PAD_SVl(PL_op->op_targ)); + if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); EXTEND(SP, 1); if (PL_op->op_flags & OPf_REF) { - PUSHs(TARG); - RETURN; + PUSHs(TARG); + RETURN; } else if (PL_op->op_private & OPpMAYBE_LVSUB) { const I32 flags = is_lvalue_sub(); if (flags && !(flags & OPpENTERSUB_INARGS)) { - if (GIMME_V == G_SCALAR) + if (GIMME_V == G_SCALAR) /* diag_listed_as: Can't return %s to lvalue scalar context */ Perl_croak(aTHX_ "Can't return array to lvalue scalar context"); PUSHs(TARG); @@ -1883,7 +1883,7 @@ PP(pp_padav) return S_pushav(aTHX_ (AV*)TARG); if (gimme == G_SCALAR) { - const SSize_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; + const SSize_t maxarg = AvFILL(MUTABLE_AV(TARG)) + 1; if (!maxarg) PUSHs(&PL_sv_zero); else if (PL_op->op_private & OPpTRUEBOOL) @@ -1902,14 +1902,14 @@ PP(pp_padhv) assert(SvTYPE(TARG) == SVt_PVHV); if (UNLIKELY( PL_op->op_private & OPpLVAL_INTRO )) - if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) - SAVECLEARSV(PAD_SVl(PL_op->op_targ)); + if (LIKELY( !(PL_op->op_private & OPpPAD_STATE) )) + SAVECLEARSV(PAD_SVl(PL_op->op_targ)); EXTEND(SP, 1); if (PL_op->op_flags & OPf_REF) { PUSHs(TARG); - RETURN; + RETURN; } else if (PL_op->op_private & OPpMAYBE_LVSUB) { const I32 flags = is_lvalue_sub(); @@ -1940,70 +1940,70 @@ PP(pp_rv2av) static const char an_array[] = "an ARRAY"; static const char a_hash[] = "a HASH"; const bool is_pp_rv2av = PL_op->op_type == OP_RV2AV - || PL_op->op_type == OP_LVAVREF; + || PL_op->op_type == OP_LVAVREF; const svtype type = is_pp_rv2av ? SVt_PVAV : SVt_PVHV; SvGETMAGIC(sv); if (SvROK(sv)) { - if (UNLIKELY(SvAMAGIC(sv))) { - sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg); - } - sv = SvRV(sv); - if (UNLIKELY(SvTYPE(sv) != type)) - /* diag_listed_as: Not an ARRAY reference */ - DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash); - else if (UNLIKELY(PL_op->op_flags & OPf_MOD - && PL_op->op_private & OPpLVAL_INTRO)) - Perl_croak(aTHX_ "%s", PL_no_localize_ref); + if (UNLIKELY(SvAMAGIC(sv))) { + sv = amagic_deref_call(sv, is_pp_rv2av ? to_av_amg : to_hv_amg); + } + sv = SvRV(sv); + if (UNLIKELY(SvTYPE(sv) != type)) + /* diag_listed_as: Not an ARRAY reference */ + DIE(aTHX_ "Not %s reference", is_pp_rv2av ? an_array : a_hash); + else if (UNLIKELY(PL_op->op_flags & OPf_MOD + && PL_op->op_private & OPpLVAL_INTRO)) + Perl_croak(aTHX_ "%s", PL_no_localize_ref); } else if (UNLIKELY(SvTYPE(sv) != type)) { - GV *gv; - - if (!isGV_with_GP(sv)) { - gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash, - type, &sp); - if (!gv) - RETURN; - } - else { - gv = MUTABLE_GV(sv); - } - sv = is_pp_rv2av ? MUTABLE_SV(GvAVn(gv)) : MUTABLE_SV(GvHVn(gv)); - if (PL_op->op_private & OPpLVAL_INTRO) - sv = is_pp_rv2av ? MUTABLE_SV(save_ary(gv)) : MUTABLE_SV(save_hash(gv)); + GV *gv; + + if (!isGV_with_GP(sv)) { + gv = Perl_softref2xv(aTHX_ sv, is_pp_rv2av ? an_array : a_hash, + type, &sp); + if (!gv) + RETURN; + } + else { + gv = MUTABLE_GV(sv); + } + sv = is_pp_rv2av ? MUTABLE_SV(GvAVn(gv)) : MUTABLE_SV(GvHVn(gv)); + if (PL_op->op_private & OPpLVAL_INTRO) + sv = is_pp_rv2av ? MUTABLE_SV(save_ary(gv)) : MUTABLE_SV(save_hash(gv)); } if (PL_op->op_flags & OPf_REF) { - SETs(sv); - RETURN; + SETs(sv); + RETURN; } else if (UNLIKELY(PL_op->op_private & OPpMAYBE_LVSUB)) { - const I32 flags = is_lvalue_sub(); - if (flags && !(flags & OPpENTERSUB_INARGS)) { - if (gimme != G_ARRAY) - goto croak_cant_return; - SETs(sv); - RETURN; - } + const I32 flags = is_lvalue_sub(); + if (flags && !(flags & OPpENTERSUB_INARGS)) { + if (gimme != G_ARRAY) + goto croak_cant_return; + SETs(sv); + RETURN; + } } if (is_pp_rv2av) { - AV *const av = MUTABLE_AV(sv); + AV *const av = MUTABLE_AV(sv); - if (gimme == G_ARRAY) { + if (gimme == G_ARRAY) { SP--; PUTBACK; return S_pushav(aTHX_ av); - } + } - if (gimme == G_SCALAR) { - const SSize_t maxarg = AvFILL(av) + 1; + if (gimme == G_SCALAR) { + const SSize_t maxarg = AvFILL(av) + 1; if (PL_op->op_private & OPpTRUEBOOL) SETs(maxarg ? &PL_sv_yes : &PL_sv_zero); else { dTARGET; SETi(maxarg); } - } + } } else { SP--; PUTBACK; @@ -2015,7 +2015,7 @@ PP(pp_rv2av) croak_cant_return: Perl_croak(aTHX_ "Can't return %s to lvalue scalar context", - is_pp_rv2av ? "array" : "hash"); + is_pp_rv2av ? "array" : "hash"); RETURN; } @@ -2026,18 +2026,18 @@ S_do_oddball(pTHX_ SV **oddkey, SV **firstkey) if (*oddkey) { if (ckWARN(WARN_MISC)) { - const char *err; - if (oddkey == firstkey && - SvROK(*oddkey) && - (SvTYPE(SvRV(*oddkey)) == SVt_PVAV || - SvTYPE(SvRV(*oddkey)) == SVt_PVHV)) - { - err = "Reference found where even-sized list expected"; - } - else - err = "Odd number of elements in hash assignment"; - Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", err); - } + const char *err; + if (oddkey == firstkey && + SvROK(*oddkey) && + (SvTYPE(SvRV(*oddkey)) == SVt_PVAV || + SvTYPE(SvRV(*oddkey)) == SVt_PVHV)) + { + err = "Reference found where even-sized list expected"; + } + else + err = "Odd number of elements in hash assignment"; + Perl_warner(aTHX_ packWARN(WARN_MISC), "%s", err); + } } } @@ -2282,20 +2282,20 @@ PP(pp_aassign) /* first lelem loop while there are still relems */ while (LIKELY(lelem <= lastlelem)) { - bool alias = FALSE; - SV *lsv = *lelem++; + bool alias = FALSE; + SV *lsv = *lelem++; TAINT_NOT; /* Each item stands on its own, taintwise. */ assert(relem <= lastrelem); - if (UNLIKELY(!lsv)) { - alias = TRUE; - lsv = *lelem++; - ASSUME(SvTYPE(lsv) == SVt_PVAV); - } - - switch (SvTYPE(lsv)) { - case SVt_PVAV: { + if (UNLIKELY(!lsv)) { + alias = TRUE; + lsv = *lelem++; + ASSUME(SvTYPE(lsv) == SVt_PVAV); + } + + switch (SvTYPE(lsv)) { + case SVt_PVAV: { SV **svp; SSize_t i; SSize_t tmps_base; @@ -2457,16 +2457,16 @@ PP(pp_aassign) PL_tmps_ix -= (nelems + 1); } - if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA)) + if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA)) /* its assumed @ISA set magic can't die and leak ary */ - SvSETMAGIC(MUTABLE_SV(ary)); + SvSETMAGIC(MUTABLE_SV(ary)); SvREFCNT_dec_NN(ary); relem = lastrelem + 1; - goto no_relems; + goto no_relems; } - case SVt_PVHV: { /* normal hash */ + case SVt_PVHV: { /* normal hash */ SV **svp; bool dirty_tmps; @@ -2668,11 +2668,11 @@ PP(pp_aassign) SvREFCNT_dec_NN(hash); relem = lastrelem + 1; - goto no_relems; - } + goto no_relems; + } - default: - if (!SvIMMORTAL(lsv)) { + default: + if (!SvIMMORTAL(lsv)) { SV *ref; if (UNLIKELY( @@ -2707,7 +2707,7 @@ PP(pp_aassign) } if (++relem > lastrelem) goto no_relems; - break; + break; } /* switch */ } /* while */ @@ -2716,17 +2716,17 @@ PP(pp_aassign) /* simplified lelem loop for when there are no relems left */ while (LIKELY(lelem <= lastlelem)) { - SV *lsv = *lelem++; + SV *lsv = *lelem++; TAINT_NOT; /* Each item stands on its own, taintwise. */ - if (UNLIKELY(!lsv)) { - lsv = *lelem++; - ASSUME(SvTYPE(lsv) == SVt_PVAV); - } + if (UNLIKELY(!lsv)) { + lsv = *lelem++; + ASSUME(SvTYPE(lsv) == SVt_PVAV); + } - switch (SvTYPE(lsv)) { - case SVt_PVAV: + switch (SvTYPE(lsv)) { + case SVt_PVAV: if (SvRMAGICAL(lsv) || AvFILLp((SV*)lsv) >= 0) { av_clear((AV*)lsv); if (UNLIKELY(PL_delaymagic & DM_ARRAY_ISA)) @@ -2734,34 +2734,34 @@ PP(pp_aassign) } break; - case SVt_PVHV: + case SVt_PVHV: if (SvRMAGICAL(lsv) || HvUSEDKEYS((HV*)lsv)) hv_clear((HV*)lsv); break; - default: - if (!SvIMMORTAL(lsv)) { + default: + if (!SvIMMORTAL(lsv)) { sv_set_undef(lsv); SvSETMAGIC(lsv); } *relem++ = lsv; - break; + break; } /* switch */ } /* while */ TAINT_NOT; /* result of list assign isn't tainted */ if (UNLIKELY(PL_delaymagic & ~DM_DELAY)) { - /* Will be used to set PL_tainting below */ - Uid_t tmp_uid = PerlProc_getuid(); - Uid_t tmp_euid = PerlProc_geteuid(); - Gid_t tmp_gid = PerlProc_getgid(); - Gid_t tmp_egid = PerlProc_getegid(); + /* Will be used to set PL_tainting below */ + Uid_t tmp_uid = PerlProc_getuid(); + Uid_t tmp_euid = PerlProc_geteuid(); + Gid_t tmp_gid = PerlProc_getgid(); + Gid_t tmp_egid = PerlProc_getegid(); /* XXX $> et al currently silently ignore failures */ - if (PL_delaymagic & DM_UID) { + if (PL_delaymagic & DM_UID) { #ifdef HAS_SETRESUID - PERL_UNUSED_RESULT( + PERL_UNUSED_RESULT( setresuid((PL_delaymagic & DM_RUID) ? PL_delaymagic_uid : (Uid_t)-1, (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1, (Uid_t)-1)); @@ -2771,62 +2771,62 @@ PP(pp_aassign) (PL_delaymagic & DM_EUID) ? PL_delaymagic_euid : (Uid_t)-1)); #else # ifdef HAS_SETRUID - if ((PL_delaymagic & DM_UID) == DM_RUID) { - PERL_UNUSED_RESULT(setruid(PL_delaymagic_uid)); - PL_delaymagic &= ~DM_RUID; - } + if ((PL_delaymagic & DM_UID) == DM_RUID) { + PERL_UNUSED_RESULT(setruid(PL_delaymagic_uid)); + PL_delaymagic &= ~DM_RUID; + } # endif /* HAS_SETRUID */ # ifdef HAS_SETEUID - if ((PL_delaymagic & DM_UID) == DM_EUID) { - PERL_UNUSED_RESULT(seteuid(PL_delaymagic_euid)); - PL_delaymagic &= ~DM_EUID; - } + if ((PL_delaymagic & DM_UID) == DM_EUID) { + PERL_UNUSED_RESULT(seteuid(PL_delaymagic_euid)); + PL_delaymagic &= ~DM_EUID; + } # endif /* HAS_SETEUID */ - if (PL_delaymagic & DM_UID) { - if (PL_delaymagic_uid != PL_delaymagic_euid) - DIE(aTHX_ "No setreuid available"); - PERL_UNUSED_RESULT(PerlProc_setuid(PL_delaymagic_uid)); - } + if (PL_delaymagic & DM_UID) { + if (PL_delaymagic_uid != PL_delaymagic_euid) + DIE(aTHX_ "No setreuid available"); + PERL_UNUSED_RESULT(PerlProc_setuid(PL_delaymagic_uid)); + } #endif /* HAS_SETRESUID */ - tmp_uid = PerlProc_getuid(); - tmp_euid = PerlProc_geteuid(); - } + tmp_uid = PerlProc_getuid(); + tmp_euid = PerlProc_geteuid(); + } /* XXX $> et al currently silently ignore failures */ - if (PL_delaymagic & DM_GID) { + if (PL_delaymagic & DM_GID) { #ifdef HAS_SETRESGID - PERL_UNUSED_RESULT( + PERL_UNUSED_RESULT( setresgid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1, (Gid_t)-1)); #elif defined(HAS_SETREGID) - PERL_UNUSED_RESULT( + PERL_UNUSED_RESULT( setregid((PL_delaymagic & DM_RGID) ? PL_delaymagic_gid : (Gid_t)-1, (PL_delaymagic & DM_EGID) ? PL_delaymagic_egid : (Gid_t)-1)); #else # ifdef HAS_SETRGID - if ((PL_delaymagic & DM_GID) == DM_RGID) { - PERL_UNUSED_RESULT(setrgid(PL_delaymagic_gid)); - PL_delaymagic &= ~DM_RGID; - } + if ((PL_delaymagic & DM_GID) == DM_RGID) { + PERL_UNUSED_RESULT(setrgid(PL_delaymagic_gid)); + PL_delaymagic &= ~DM_RGID; + } # endif /* HAS_SETRGID */ # ifdef HAS_SETEGID - if ((PL_delaymagic & DM_GID) == DM_EGID) { - PERL_UNUSED_RESULT(setegid(PL_delaymagic_egid)); - PL_delaymagic &= ~DM_EGID; - } + if ((PL_delaymagic & DM_GID) == DM_EGID) { + PERL_UNUSED_RESULT(setegid(PL_delaymagic_egid)); + PL_delaymagic &= ~DM_EGID; + } # endif /* HAS_SETEGID */ - if (PL_delaymagic & DM_GID) { - if (PL_delaymagic_gid != PL_delaymagic_egid) - DIE(aTHX_ "No setregid available"); - PERL_UNUSED_RESULT(PerlProc_setgid(PL_delaymagic_gid)); - } + if (PL_delaymagic & DM_GID) { + if (PL_delaymagic_gid != PL_delaymagic_egid) + DIE(aTHX_ "No setregid available"); + PERL_UNUSED_RESULT(PerlProc_setgid(PL_delaymagic_gid)); + } #endif /* HAS_SETRESGID */ - tmp_gid = PerlProc_getgid(); - tmp_egid = PerlProc_getegid(); - } - TAINTING_set( TAINTING_get | (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid)) ); + tmp_gid = PerlProc_getgid(); + tmp_egid = PerlProc_getegid(); + } + TAINTING_set( TAINTING_get | (tmp_uid && (tmp_euid != tmp_uid || tmp_egid != tmp_gid)) ); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(tmp_uid); PERL_UNUSED_VAR(tmp_euid); @@ -2837,9 +2837,9 @@ PP(pp_aassign) PL_delaymagic = old_delaymagic; if (gimme == G_VOID) - SP = firstrelem - 1; + SP = firstrelem - 1; else if (gimme == G_SCALAR) { - SP = firstrelem; + SP = firstrelem; EXTEND(SP,1); if (PL_op->op_private & OPpASSIGN_TRUEBOOL) SETs((firstlelem - firstrelem) ? &PL_sv_yes : &PL_sv_zero); @@ -2877,14 +2877,14 @@ PP(pp_qr) cvp = &( ReANY((REGEXP *)SvRV(rv))->qr_anoncv); if (UNLIKELY((cv = *cvp) && CvCLONE(*cvp))) { - *cvp = cv_clone(cv); - SvREFCNT_dec_NN(cv); + *cvp = cv_clone(cv); + SvREFCNT_dec_NN(cv); } if (pkg) { - HV *const stash = gv_stashsv(pkg, GV_ADD); - SvREFCNT_dec_NN(pkg); - (void)sv_bless(rv, stash); + HV *const stash = gv_stashsv(pkg, GV_ADD); + SvREFCNT_dec_NN(pkg); + (void)sv_bless(rv, stash); } if (UNLIKELY(RXp_ISTAINTED(prog))) { @@ -2957,27 +2957,27 @@ PP(pp_match) MAGIC *mg = NULL; if (PL_op->op_flags & OPf_STACKED) - TARG = POPs; + TARG = POPs; else { if (ARGTARG) GETTARGET; else { TARG = DEFSV; } - EXTEND(SP,1); + EXTEND(SP,1); } PUTBACK; /* EVAL blocks need stack_sp. */ /* Skip get-magic if this is a qr// clone, because regcomp has already done it. */ truebase = prog->mother_re - ? SvPV_nomg_const(TARG, len) - : SvPV_const(TARG, len); + ? SvPV_nomg_const(TARG, len) + : SvPV_const(TARG, len); if (!truebase) - DIE(aTHX_ "panic: pp_match"); + DIE(aTHX_ "panic: pp_match"); strend = truebase + len; rxtainted = (RXp_ISTAINTED(prog) || - (TAINT_get && (pm->op_pmflags & PMf_RETAINT))); + (TAINT_get && (pm->op_pmflags & PMf_RETAINT))); TAINT_NOT; /* We need to know this in case we fail out early - pos() must be reset */ @@ -2994,7 +2994,7 @@ PP(pp_match) if (UNLIKELY(should_we_output_Debug_r(prog))) { PerlIO_printf(Perl_debug_log, "?? already matched once"); } - goto nope; + goto nope; } /* handle the empty pattern */ @@ -3020,7 +3020,7 @@ PP(pp_match) "String shorter than min possible regex match (%zd < %zd)\n", len, RXp_MINLEN(prog)); } - goto nope; + goto nope; } /* get pos() if //g */ @@ -3042,7 +3042,7 @@ PP(pp_match) ) #endif { - r_flags |= (REXEC_COPY_STR|REXEC_COPY_SKIP_PRE); + r_flags |= (REXEC_COPY_STR|REXEC_COPY_SKIP_PRE); /* in @a =~ /(.)/g, we iterate multiple times, but copy the buffer * only on the first iteration. Therefore we need to copy $' as well * as $&, to make the rest of the string available for captures in @@ -3060,22 +3060,22 @@ PP(pp_match) play_it_again: if (global) - s = truebase + curpos; + s = truebase + curpos; if (!CALLREGEXEC(rx, (char*)s, (char *)strend, (char*)truebase, - had_zerolen, TARG, NULL, r_flags)) - goto nope; + had_zerolen, TARG, NULL, r_flags)) + goto nope; PL_curpm = pm; if (dynpm->op_pmflags & PMf_ONCE) #ifdef USE_ITHREADS - SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]); + SvREADONLY_on(PL_regex_pad[dynpm->op_pmoffset]); #else - dynpm->op_pmflags |= PMf_USED; + dynpm->op_pmflags |= PMf_USED; #endif if (rxtainted) - RXp_MATCH_TAINTED_on(prog); + RXp_MATCH_TAINTED_on(prog); TAINT_IF(RXp_MATCH_TAINTED(prog)); /* update pos */ @@ -3091,49 +3091,49 @@ PP(pp_match) } if ((!RXp_NPARENS(prog) && !global) || gimme != G_ARRAY) { - LEAVE_SCOPE(oldsave); - RETPUSHYES; + LEAVE_SCOPE(oldsave); + RETPUSHYES; } /* push captures on stack */ { - const I32 nparens = RXp_NPARENS(prog); - I32 i = (global && !nparens) ? 1 : 0; - - SPAGAIN; /* EVAL blocks could move the stack. */ - EXTEND(SP, nparens + i); - EXTEND_MORTAL(nparens + i); - for (i = !i; i <= nparens; i++) { - PUSHs(sv_newmortal()); - if (LIKELY((RXp_OFFS(prog)[i].start != -1) + const I32 nparens = RXp_NPARENS(prog); + I32 i = (global && !nparens) ? 1 : 0; + + SPAGAIN; /* EVAL blocks could move the stack. */ + EXTEND(SP, nparens + i); + EXTEND_MORTAL(nparens + i); + for (i = !i; i <= nparens; i++) { + PUSHs(sv_newmortal()); + if (LIKELY((RXp_OFFS(prog)[i].start != -1) && RXp_OFFS(prog)[i].end != -1 )) { - const I32 len = RXp_OFFS(prog)[i].end - RXp_OFFS(prog)[i].start; - const char * const s = RXp_OFFS(prog)[i].start + truebase; - if (UNLIKELY( RXp_OFFS(prog)[i].end < 0 + const I32 len = RXp_OFFS(prog)[i].end - RXp_OFFS(prog)[i].start; + const char * const s = RXp_OFFS(prog)[i].start + truebase; + if (UNLIKELY( RXp_OFFS(prog)[i].end < 0 || RXp_OFFS(prog)[i].start < 0 || len < 0 || len > strend - s) ) - DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, " - "start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf, - (long) i, (long) RXp_OFFS(prog)[i].start, - (long)RXp_OFFS(prog)[i].end, s, strend, (UV) len); - sv_setpvn(*SP, s, len); - if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len)) - SvUTF8_on(*SP); - } - } - if (global) { + DIE(aTHX_ "panic: pp_match start/end pointers, i=%ld, " + "start=%ld, end=%ld, s=%p, strend=%p, len=%" UVuf, + (long) i, (long) RXp_OFFS(prog)[i].start, + (long)RXp_OFFS(prog)[i].end, s, strend, (UV) len); + sv_setpvn(*SP, s, len); + if (DO_UTF8(TARG) && is_utf8_string((U8*)s, len)) + SvUTF8_on(*SP); + } + } + if (global) { curpos = (UV)RXp_OFFS(prog)[0].end; - had_zerolen = RXp_ZERO_LEN(prog); - PUTBACK; /* EVAL blocks may use stack */ - r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST; - goto play_it_again; - } - LEAVE_SCOPE(oldsave); - RETURN; + had_zerolen = RXp_ZERO_LEN(prog); + PUTBACK; /* EVAL blocks may use stack */ + r_flags |= REXEC_IGNOREPOS | REXEC_NOT_FIRST; + goto play_it_again; + } + LEAVE_SCOPE(oldsave); + RETURN; } NOT_REACHED; /* NOTREACHED */ @@ -3146,7 +3146,7 @@ PP(pp_match) } LEAVE_SCOPE(oldsave); if (gimme == G_ARRAY) - RETURN; + RETURN; RETPUSHNO; } @@ -3163,104 +3163,104 @@ Perl_do_readline(pTHX) const U8 gimme = GIMME_V; if (io) { - const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - Perl_tied_method(aTHX_ SV_CONST(READLINE), SP, MUTABLE_SV(io), mg, gimme, 0); - if (gimme == G_SCALAR) { - SPAGAIN; - SvSetSV_nosteal(TARG, TOPs); - SETTARG; - } - return NORMAL; - } + const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + Perl_tied_method(aTHX_ SV_CONST(READLINE), SP, MUTABLE_SV(io), mg, gimme, 0); + if (gimme == G_SCALAR) { + SPAGAIN; + SvSetSV_nosteal(TARG, TOPs); + SETTARG; + } + return NORMAL; + } } fp = NULL; if (io) { - fp = IoIFP(io); - if (!fp) { - if (IoFLAGS(io) & IOf_ARGV) { - if (IoFLAGS(io) & IOf_START) { - IoLINES(io) = 0; - if (av_count(GvAVn(PL_last_in_gv)) == 0) { - IoFLAGS(io) &= ~IOf_START; - do_open6(PL_last_in_gv, "-", 1, NULL, NULL, 0); - SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */ - sv_setpvs(GvSVn(PL_last_in_gv), "-"); - SvSETMAGIC(GvSV(PL_last_in_gv)); - fp = IoIFP(io); - goto have_fp; - } - } - fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); - if (!fp) { /* Note: fp != IoIFP(io) */ - (void)do_close(PL_last_in_gv, FALSE); /* now it does*/ - } - } - else if (type == OP_GLOB) - fp = Perl_start_glob(aTHX_ POPs, io); - } - else if (type == OP_GLOB) - SP--; - else if (IoTYPE(io) == IoTYPE_WRONLY) { - report_wrongway_fh(PL_last_in_gv, '>'); - } + fp = IoIFP(io); + if (!fp) { + if (IoFLAGS(io) & IOf_ARGV) { + if (IoFLAGS(io) & IOf_START) { + IoLINES(io) = 0; + if (av_count(GvAVn(PL_last_in_gv)) == 0) { + IoFLAGS(io) &= ~IOf_START; + do_open6(PL_last_in_gv, "-", 1, NULL, NULL, 0); + SvTAINTED_off(GvSVn(PL_last_in_gv)); /* previous tainting irrelevant */ + sv_setpvs(GvSVn(PL_last_in_gv), "-"); + SvSETMAGIC(GvSV(PL_last_in_gv)); + fp = IoIFP(io); + goto have_fp; + } + } + fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); + if (!fp) { /* Note: fp != IoIFP(io) */ + (void)do_close(PL_last_in_gv, FALSE); /* now it does*/ + } + } + else if (type == OP_GLOB) + fp = Perl_start_glob(aTHX_ POPs, io); + } + else if (type == OP_GLOB) + SP--; + else if (IoTYPE(io) == IoTYPE_WRONLY) { + report_wrongway_fh(PL_last_in_gv, '>'); + } } if (!fp) { - if ((!io || !(IoFLAGS(io) & IOf_START)) - && ckWARN(WARN_CLOSED) + if ((!io || !(IoFLAGS(io) & IOf_START)) + && ckWARN(WARN_CLOSED) && type != OP_GLOB) - { - report_evil_fh(PL_last_in_gv); - } - if (gimme == G_SCALAR) { - /* undef TARG, and push that undefined value */ - if (type != OP_RCATLINE) { - sv_set_undef(TARG); - } - PUSHTARG; - } - RETURN; + { + report_evil_fh(PL_last_in_gv); + } + if (gimme == G_SCALAR) { + /* undef TARG, and push that undefined value */ + if (type != OP_RCATLINE) { + sv_set_undef(TARG); + } + PUSHTARG; + } + RETURN; } have_fp: if (gimme == G_SCALAR) { - sv = TARG; - if (type == OP_RCATLINE && SvGMAGICAL(sv)) - mg_get(sv); - if (SvROK(sv)) { - if (type == OP_RCATLINE) - SvPV_force_nomg_nolen(sv); - else - sv_unref(sv); - } - else if (isGV_with_GP(sv)) { - SvPV_force_nomg_nolen(sv); - } - SvUPGRADE(sv, SVt_PV); - tmplen = SvLEN(sv); /* remember if already alloced */ - if (!tmplen && !SvREADONLY(sv) && !SvIsCOW(sv)) { + sv = TARG; + if (type == OP_RCATLINE && SvGMAGICAL(sv)) + mg_get(sv); + if (SvROK(sv)) { + if (type == OP_RCATLINE) + SvPV_force_nomg_nolen(sv); + else + sv_unref(sv); + } + else if (isGV_with_GP(sv)) { + SvPV_force_nomg_nolen(sv); + } + SvUPGRADE(sv, SVt_PV); + tmplen = SvLEN(sv); /* remember if already alloced */ + if (!tmplen && !SvREADONLY(sv) && !SvIsCOW(sv)) { /* try short-buffering it. Please update t/op/readline.t - * if you change the growth length. - */ - Sv_Grow(sv, 80); - } - offset = 0; - if (type == OP_RCATLINE && SvOK(sv)) { - if (!SvPOK(sv)) { - SvPV_force_nomg_nolen(sv); - } - offset = SvCUR(sv); - } + * if you change the growth length. + */ + Sv_Grow(sv, 80); + } + offset = 0; + if (type == OP_RCATLINE && SvOK(sv)) { + if (!SvPOK(sv)) { + SvPV_force_nomg_nolen(sv); + } + offset = SvCUR(sv); + } } else { - sv = sv_2mortal(newSV(80)); - offset = 0; + sv = sv_2mortal(newSV(80)); + offset = 0; } /* This should not be marked tainted if the fp is marked clean */ #define MAYBE_TAINT_LINE(io, sv) \ if (!(IoFLAGS(io) & IOf_UNTAINT)) { \ - TAINT; \ - SvTAINTED_on(sv); \ + TAINT; \ + SvTAINTED_on(sv); \ } /* delay EOF state for a snarfed empty file */ @@ -3269,93 +3269,93 @@ Perl_do_readline(pTHX) || (IoFLAGS(io) & IOf_NOLINE) || !RsSNARF(rs)) for (;;) { - PUTBACK; - if (!sv_gets(sv, fp, offset) - && (type == OP_GLOB - || SNARF_EOF(gimme, PL_rs, io, sv) - || PerlIO_error(fp))) - { - PerlIO_clearerr(fp); - if (IoFLAGS(io) & IOf_ARGV) { - fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); - if (fp) - continue; - (void)do_close(PL_last_in_gv, FALSE); - } - else if (type == OP_GLOB) { - if (!do_close(PL_last_in_gv, FALSE)) { - Perl_ck_warner(aTHX_ packWARN(WARN_GLOB), - "glob failed (child exited with status %d%s)", - (int)(STATUS_CURRENT >> 8), - (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); - } - } - if (gimme == G_SCALAR) { - if (type != OP_RCATLINE) { - SV_CHECK_THINKFIRST_COW_DROP(TARG); - SvOK_off(TARG); - } - SPAGAIN; - PUSHTARG; - } - MAYBE_TAINT_LINE(io, sv); - RETURN; - } - MAYBE_TAINT_LINE(io, sv); - IoLINES(io)++; - IoFLAGS(io) |= IOf_NOLINE; - SvSETMAGIC(sv); - SPAGAIN; - XPUSHs(sv); - if (type == OP_GLOB) { - const char *t1; - Stat_t statbuf; - - if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) { - char * const tmps = SvEND(sv) - 1; - if (*tmps == *SvPVX_const(PL_rs)) { - *tmps = '\0'; - SvCUR_set(sv, SvCUR(sv) - 1); - } - } - for (t1 = SvPVX_const(sv); *t1; t1++) + PUTBACK; + if (!sv_gets(sv, fp, offset) + && (type == OP_GLOB + || SNARF_EOF(gimme, PL_rs, io, sv) + || PerlIO_error(fp))) + { + PerlIO_clearerr(fp); + if (IoFLAGS(io) & IOf_ARGV) { + fp = nextargv(PL_last_in_gv, PL_op->op_flags & OPf_SPECIAL); + if (fp) + continue; + (void)do_close(PL_last_in_gv, FALSE); + } + else if (type == OP_GLOB) { + if (!do_close(PL_last_in_gv, FALSE)) { + Perl_ck_warner(aTHX_ packWARN(WARN_GLOB), + "glob failed (child exited with status %d%s)", + (int)(STATUS_CURRENT >> 8), + (STATUS_CURRENT & 0x80) ? ", core dumped" : ""); + } + } + if (gimme == G_SCALAR) { + if (type != OP_RCATLINE) { + SV_CHECK_THINKFIRST_COW_DROP(TARG); + SvOK_off(TARG); + } + SPAGAIN; + PUSHTARG; + } + MAYBE_TAINT_LINE(io, sv); + RETURN; + } + MAYBE_TAINT_LINE(io, sv); + IoLINES(io)++; + IoFLAGS(io) |= IOf_NOLINE; + SvSETMAGIC(sv); + SPAGAIN; + XPUSHs(sv); + if (type == OP_GLOB) { + const char *t1; + Stat_t statbuf; + + if (SvCUR(sv) > 0 && SvCUR(PL_rs) > 0) { + char * const tmps = SvEND(sv) - 1; + if (*tmps == *SvPVX_const(PL_rs)) { + *tmps = '\0'; + SvCUR_set(sv, SvCUR(sv) - 1); + } + } + for (t1 = SvPVX_const(sv); *t1; t1++) #ifdef __VMS - if (memCHRs("*%?", *t1)) + if (memCHRs("*%?", *t1)) #else - if (memCHRs("$&*(){}[]'\";\\|?<>~`", *t1)) + if (memCHRs("$&*(){}[]'\";\\|?<>~`", *t1)) #endif - break; - if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &statbuf) < 0) { - (void)POPs; /* Unmatched wildcard? Chuck it... */ - continue; - } - } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ - if (ckWARN(WARN_UTF8)) { - const U8 * const s = (const U8*)SvPVX_const(sv) + offset; - const STRLEN len = SvCUR(sv) - offset; - const U8 *f; - - if (!is_utf8_string_loc(s, len, &f)) - /* Emulate :encoding(utf8) warning in the same case. */ - Perl_warner(aTHX_ packWARN(WARN_UTF8), - "utf8 \"\\x%02X\" does not map to Unicode", - f < (U8*)SvEND(sv) ? *f : 0); - } - } - if (gimme == G_ARRAY) { - if (SvLEN(sv) - SvCUR(sv) > 20) { - SvPV_shrink_to_cur(sv); - } - sv = sv_2mortal(newSV(80)); - continue; - } - else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) { - /* try to reclaim a bit of scalar space (only on 1st alloc) */ - const STRLEN new_len - = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */ - SvPV_renew(sv, new_len); - } - RETURN; + break; + if (*t1 && PerlLIO_lstat(SvPVX_const(sv), &statbuf) < 0) { + (void)POPs; /* Unmatched wildcard? Chuck it... */ + continue; + } + } else if (SvUTF8(sv)) { /* OP_READLINE, OP_RCATLINE */ + if (ckWARN(WARN_UTF8)) { + const U8 * const s = (const U8*)SvPVX_const(sv) + offset; + const STRLEN len = SvCUR(sv) - offset; + const U8 *f; + + if (!is_utf8_string_loc(s, len, &f)) + /* Emulate :encoding(utf8) warning in the same case. */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "utf8 \"\\x%02X\" does not map to Unicode", + f < (U8*)SvEND(sv) ? *f : 0); + } + } + if (gimme == G_ARRAY) { + if (SvLEN(sv) - SvCUR(sv) > 20) { + SvPV_shrink_to_cur(sv); + } + sv = sv_2mortal(newSV(80)); + continue; + } + else if (gimme == G_SCALAR && !tmplen && SvLEN(sv) - SvCUR(sv) > 80) { + /* try to reclaim a bit of scalar space (only on 1st alloc) */ + const STRLEN new_len + = SvCUR(sv) < 60 ? 80 : SvCUR(sv)+40; /* allow some slop */ + SvPV_renew(sv, new_len); + } + RETURN; } } @@ -3373,52 +3373,52 @@ PP(pp_helem) bool preeminent = TRUE; if (SvTYPE(hv) != SVt_PVHV) - RETPUSHUNDEF; + RETPUSHUNDEF; if (localizing) { - MAGIC *mg; - HV *stash; + MAGIC *mg; + HV *stash; - /* If we can determine whether the element exist, - * Try to preserve the existenceness of a tied hash - * element by using EXISTS and DELETE if possible. - * Fallback to FETCH and STORE otherwise. */ - if (SvCANEXISTDELETE(hv)) - preeminent = hv_exists_ent(hv, keysv, 0); + /* If we can determine whether the element exist, + * Try to preserve the existenceness of a tied hash + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise. */ + if (SvCANEXISTDELETE(hv)) + preeminent = hv_exists_ent(hv, keysv, 0); } he = hv_fetch_ent(hv, keysv, lval && !defer, 0); svp = he ? &HeVAL(he) : NULL; if (lval) { - if (!svp || !*svp || *svp == &PL_sv_undef) { - SV* lv; - SV* key2; - if (!defer) { - DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); - } - lv = sv_newmortal(); - sv_upgrade(lv, SVt_PVLV); - LvTYPE(lv) = 'y'; - sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0); - SvREFCNT_dec_NN(key2); /* sv_magic() increments refcount */ - LvTARG(lv) = SvREFCNT_inc_simple_NN(hv); - LvTARGLEN(lv) = 1; - PUSHs(lv); - RETURN; - } - if (localizing) { - if (HvNAME_get(hv) && isGV_or_RVCV(*svp)) - save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); - else if (preeminent) - save_helem_flags(hv, keysv, svp, - (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); - else - SAVEHDELETE(hv, keysv); - } - else if (PL_op->op_private & OPpDEREF) { - PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF)); - RETURN; - } + if (!svp || !*svp || *svp == &PL_sv_undef) { + SV* lv; + SV* key2; + if (!defer) { + DIE(aTHX_ PL_no_helem_sv, SVfARG(keysv)); + } + lv = sv_newmortal(); + sv_upgrade(lv, SVt_PVLV); + LvTYPE(lv) = 'y'; + sv_magic(lv, key2 = newSVsv(keysv), PERL_MAGIC_defelem, NULL, 0); + SvREFCNT_dec_NN(key2); /* sv_magic() increments refcount */ + LvTARG(lv) = SvREFCNT_inc_simple_NN(hv); + LvTARGLEN(lv) = 1; + PUSHs(lv); + RETURN; + } + if (localizing) { + if (HvNAME_get(hv) && isGV_or_RVCV(*svp)) + save_gp(MUTABLE_GV(*svp), !(PL_op->op_flags & OPf_SPECIAL)); + else if (preeminent) + save_helem_flags(hv, keysv, svp, + (PL_op->op_flags & OPf_SPECIAL) ? 0 : SAVEf_SETMAGIC); + else + SAVEHDELETE(hv, keysv); + } + else if (PL_op->op_private & OPpDEREF) { + PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF)); + RETURN; + } } sv = (svp && *svp ? *svp : &PL_sv_undef); /* Originally this did a conditional C; this @@ -3434,7 +3434,7 @@ PP(pp_helem) * compromise, do the get magic here. (The MGf_GSKIP flag will stop it * being called too many times). */ if (!lval && SvRMAGICAL(hv) && SvGMAGICAL(sv)) - mg_get(sv); + mg_get(sv); PUSHs(sv); RETURN; } @@ -3445,14 +3445,14 @@ PP(pp_helem) STATIC GV * S_softref2xv_lite(pTHX_ SV *const sv, const char *const what, - const svtype type) + const svtype type) { if (PL_op->op_private & HINT_STRICT_REFS) { - if (SvOK(sv)) - Perl_die(aTHX_ PL_no_symref_sv, sv, - (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what); - else - Perl_die(aTHX_ PL_no_usym, what); + if (SvOK(sv)) + Perl_die(aTHX_ PL_no_symref_sv, sv, + (SvPOKp(sv) && SvCUR(sv)>32 ? "..." : ""), what); + else + Perl_die(aTHX_ PL_no_usym, what); } if (!SvOK(sv)) Perl_die(aTHX_ PL_no_usym, what); @@ -3938,13 +3938,13 @@ PP(pp_iter) case CXt_LOOP_LAZYIV: /* integer increment */ { IV cur = cx->blk_loop.state_u.lazyiv.cur; - if (UNLIKELY(cur > cx->blk_loop.state_u.lazyiv.end)) - goto retno; + if (UNLIKELY(cur > cx->blk_loop.state_u.lazyiv.end)) + goto retno; oldsv = *itersvp; - /* see NB comment above */ - if (oldsv && LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) { - /* safe to reuse old SV */ + /* see NB comment above */ + if (oldsv && LIKELY(SvREFCNT(oldsv) == 1 && !SvMAGICAL(oldsv))) { + /* safe to reuse old SV */ if ( (SvFLAGS(oldsv) & (SVTYPEMASK|SVf_THINKFIRST|SVf_IVisUV)) == SVt_IV) @@ -3961,21 +3961,21 @@ PP(pp_iter) } else sv_setiv(oldsv, cur); - } - else - { - /* we need a fresh SV every time so that loop body sees a - * completely new SV for closures/references to work as they - * used to */ - *itersvp = newSViv(cur); - SvREFCNT_dec(oldsv); - } - - if (UNLIKELY(cur == IV_MAX)) { - /* Handle end of range at IV_MAX */ - cx->blk_loop.state_u.lazyiv.end = IV_MIN; - } else - ++cx->blk_loop.state_u.lazyiv.cur; + } + else + { + /* we need a fresh SV every time so that loop body sees a + * completely new SV for closures/references to work as they + * used to */ + *itersvp = newSViv(cur); + SvREFCNT_dec(oldsv); + } + + if (UNLIKELY(cur == IV_MAX)) { + /* Handle end of range at IV_MAX */ + cx->blk_loop.state_u.lazyiv.end = IV_MIN; + } else + ++cx->blk_loop.state_u.lazyiv.cur; break; } @@ -4045,7 +4045,7 @@ PP(pp_iter) break; default: - DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx)); + DIE(aTHX_ "panic: pp_iter, type=%u", CxTYPE(cx)); } /* Try to bypass pushing &PL_sv_yes and calling pp_and(); instead @@ -4121,34 +4121,34 @@ There are four destinations of taint and they are affected by the sources according to the rules below: * the return value (not including /r): - tainted by the source string and pattern, but only for the - number-of-iterations case; boolean returns aren't tainted; + tainted by the source string and pattern, but only for the + number-of-iterations case; boolean returns aren't tainted; * the modified string (or modified copy under /r): - tainted by the source string, pattern, and replacement strings; + tainted by the source string, pattern, and replacement strings; * $1 et al: - tainted by the pattern, and under 'use re "taint"', by the source - string too; + tainted by the pattern, and under 'use re "taint"', by the source + string too; * PL_taint - i.e. whether subsequent code (e.g. in a /e block) is tainted: - should always be unset before executing subsequent code. + should always be unset before executing subsequent code. The overall action of pp_subst is: * at the start, set bits in rxtainted indicating the taint status of - the various sources. + the various sources. * After each pattern execution, update the SUBST_TAINT_PAT bit in - rxtainted if RXf_TAINTED_SEEN has been set, to indicate that the - pattern has subsequently become tainted via locale ops. + rxtainted if RXf_TAINTED_SEEN has been set, to indicate that the + pattern has subsequently become tainted via locale ops. * If control is being passed to pp_substcont to execute a /e block, - save rxtainted in the CXt_SUBST block, for future use by - pp_substcont. + save rxtainted in the CXt_SUBST block, for future use by + pp_substcont. * Whenever control is being returned to perl code (either by falling - off the "end" of pp_subst/pp_substcont, or by entering a /e block), - use the flag bits in rxtainted to make all the appropriate types of - destination taint visible; e.g. set RXf_TAINTED_SEEN so that $1 - et al will appear tainted. + off the "end" of pp_subst/pp_substcont, or by entering a /e block), + use the flag bits in rxtainted to make all the appropriate types of + destination taint visible; e.g. set RXf_TAINTED_SEEN so that $1 + et al will appear tainted. pp_match is just a simpler version of the above. @@ -4167,7 +4167,7 @@ PP(pp_subst) SSize_t maxiters; bool once; U8 rxtainted = 0; /* holds various SUBST_TAINT_* flag bits. - See "how taint works" above */ + See "how taint works" above */ char *orig; U8 r_flags; REGEXP *rx = PM_GETRE(pm); @@ -4187,14 +4187,14 @@ PP(pp_subst) PERL_ASYNC_CHECK(); if (PL_op->op_flags & OPf_STACKED) - TARG = POPs; + TARG = POPs; else { if (ARGTARG) GETTARGET; else { TARG = DEFSV; } - EXTEND(SP,1); + EXTEND(SP,1); } SvGETMAGIC(TARG); /* must come before cow check */ @@ -4204,14 +4204,14 @@ PP(pp_subst) #endif if (!(rpm->op_pmflags & PMf_NONDESTRUCT)) { #ifndef PERL_ANY_COW - if (SvIsCOW(TARG)) - sv_force_normal_flags(TARG,0); + if (SvIsCOW(TARG)) + sv_force_normal_flags(TARG,0); #endif - if ((SvREADONLY(TARG) - || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) - || SvTYPE(TARG) > SVt_PVLV) - && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) - Perl_croak_no_modify(); + if ((SvREADONLY(TARG) + || ( ((SvTYPE(TARG) == SVt_PVGV && isGV_with_GP(TARG)) + || SvTYPE(TARG) > SVt_PVLV) + && !(SvTYPE(TARG) == SVt_PVGV && SvFAKE(TARG))))) + Perl_croak_no_modify(); } PUTBACK; @@ -4220,31 +4220,31 @@ PP(pp_subst) * to match, we leave as-is; on successful match however, we *will* * coerce into a string, then repeat the match */ if (!SvPOKp(TARG) || SvTYPE(TARG) == SVt_PVGV || SvVOK(TARG)) - force_on_match = 1; + force_on_match = 1; /* only replace once? */ once = !(rpm->op_pmflags & PMf_GLOBAL); /* See "how taint works" above */ if (TAINTING_get) { - rxtainted = ( - (SvTAINTED(TARG) ? SUBST_TAINT_STR : 0) - | (RXp_ISTAINTED(prog) ? SUBST_TAINT_PAT : 0) - | ((pm->op_pmflags & PMf_RETAINT) ? SUBST_TAINT_RETAINT : 0) - | (( (once && !(rpm->op_pmflags & PMf_NONDESTRUCT)) + rxtainted = ( + (SvTAINTED(TARG) ? SUBST_TAINT_STR : 0) + | (RXp_ISTAINTED(prog) ? SUBST_TAINT_PAT : 0) + | ((pm->op_pmflags & PMf_RETAINT) ? SUBST_TAINT_RETAINT : 0) + | (( (once && !(rpm->op_pmflags & PMf_NONDESTRUCT)) || (PL_op->op_private & OPpTRUEBOOL)) ? SUBST_TAINT_BOOLRET : 0)); - TAINT_NOT; + TAINT_NOT; } force_it: if (!pm || !orig) - DIE(aTHX_ "panic: pp_subst, pm=%p, orig=%p", pm, orig); + DIE(aTHX_ "panic: pp_subst, pm=%p, orig=%p", pm, orig); strend = orig + len; slen = DO_UTF8(TARG) ? utf8_length((U8*)orig, (U8*)strend) : len; maxiters = 2 * slen + 10; /* We can match twice at each - position, once with zero-length, - second time with non-zero. */ + position, once with zero-length, + second time with non-zero. */ /* handle the empty pattern */ if (!RX_PRELEN(rx) && PL_curpm && !prog->mother_re) { @@ -4277,40 +4277,40 @@ PP(pp_subst) if (!CALLREGEXEC(rx, orig, strend, orig, 0, TARG, NULL, r_flags)) { - SPAGAIN; - PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no); - LEAVE_SCOPE(oldsave); - RETURN; + SPAGAIN; + PUSHs(rpm->op_pmflags & PMf_NONDESTRUCT ? TARG : &PL_sv_no); + LEAVE_SCOPE(oldsave); + RETURN; } PL_curpm = pm; /* known replacement string? */ if (dstr) { - /* replacement needing upgrading? */ - if (DO_UTF8(TARG) && !doutf8) { - nsv = sv_newmortal(); - SvSetSV(nsv, dstr); - sv_utf8_upgrade(nsv); - c = SvPV_const(nsv, clen); - doutf8 = TRUE; - } - else { - c = SvPV_const(dstr, clen); - doutf8 = DO_UTF8(dstr); - } - - if (UNLIKELY(TAINT_get)) - rxtainted |= SUBST_TAINT_REPL; + /* replacement needing upgrading? */ + if (DO_UTF8(TARG) && !doutf8) { + nsv = sv_newmortal(); + SvSetSV(nsv, dstr); + sv_utf8_upgrade(nsv); + c = SvPV_const(nsv, clen); + doutf8 = TRUE; + } + else { + c = SvPV_const(dstr, clen); + doutf8 = DO_UTF8(dstr); + } + + if (UNLIKELY(TAINT_get)) + rxtainted |= SUBST_TAINT_REPL; } else { - c = NULL; - doutf8 = FALSE; + c = NULL; + doutf8 = FALSE; } /* can do inplace substitution? */ if (c #ifdef PERL_ANY_COW - && !was_cow + && !was_cow #endif && (I32)clen <= RXp_MINLENRET(prog) && ( once @@ -4318,231 +4318,231 @@ PP(pp_subst) || (!SvGMAGICAL(dstr) && !(RXp_EXTFLAGS(prog) & RXf_EVAL_SEEN)) ) && !(RXp_EXTFLAGS(prog) & RXf_NO_INPLACE_SUBST) - && (!doutf8 || SvUTF8(TARG)) - && !(rpm->op_pmflags & PMf_NONDESTRUCT)) + && (!doutf8 || SvUTF8(TARG)) + && !(rpm->op_pmflags & PMf_NONDESTRUCT)) { #ifdef PERL_ANY_COW /* string might have got converted to COW since we set was_cow */ - if (SvIsCOW(TARG)) { - if (!force_on_match) - goto have_a_cow; - assert(SvVOK(TARG)); - } + if (SvIsCOW(TARG)) { + if (!force_on_match) + goto have_a_cow; + assert(SvVOK(TARG)); + } #endif - if (force_on_match) { + if (force_on_match) { /* redo the first match, this time with the orig var * forced into being a string */ - force_on_match = 0; - orig = SvPV_force_nomg(TARG, len); - goto force_it; - } + force_on_match = 0; + orig = SvPV_force_nomg(TARG, len); + goto force_it; + } - if (once) { + if (once) { char *d, *m; - if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */ - rxtainted |= SUBST_TAINT_PAT; - m = orig + RXp_OFFS(prog)[0].start; - d = orig + RXp_OFFS(prog)[0].end; - s = orig; - if (m - s > strend - d) { /* faster to shorten from end */ + if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */ + rxtainted |= SUBST_TAINT_PAT; + m = orig + RXp_OFFS(prog)[0].start; + d = orig + RXp_OFFS(prog)[0].end; + s = orig; + if (m - s > strend - d) { /* faster to shorten from end */ I32 i; - if (clen) { - Copy(c, m, clen, char); - m += clen; - } - i = strend - d; - if (i > 0) { - Move(d, m, i, char); - m += i; - } - *m = '\0'; - SvCUR_set(TARG, m - s); - } - else { /* faster from front */ + if (clen) { + Copy(c, m, clen, char); + m += clen; + } + i = strend - d; + if (i > 0) { + Move(d, m, i, char); + m += i; + } + *m = '\0'; + SvCUR_set(TARG, m - s); + } + else { /* faster from front */ I32 i = m - s; - d -= clen; + d -= clen; if (i > 0) Move(s, d - i, i, char); - sv_chop(TARG, d-i); - if (clen) - Copy(c, d, clen, char); - } - SPAGAIN; - PUSHs(&PL_sv_yes); - } - else { + sv_chop(TARG, d-i); + if (clen) + Copy(c, d, clen, char); + } + SPAGAIN; + PUSHs(&PL_sv_yes); + } + else { char *d, *m; d = s = RXp_OFFS(prog)[0].start + orig; - do { + do { I32 i; - if (UNLIKELY(iters++ > maxiters)) - DIE(aTHX_ "Substitution loop"); + if (UNLIKELY(iters++ > maxiters)) + DIE(aTHX_ "Substitution loop"); /* run time pattern taint, eg locale */ - if (UNLIKELY(RXp_MATCH_TAINTED(prog))) - rxtainted |= SUBST_TAINT_PAT; - m = RXp_OFFS(prog)[0].start + orig; - if ((i = m - s)) { - if (s != d) - Move(s, d, i, char); - d += i; - } - if (clen) { - Copy(c, d, clen, char); - d += clen; - } - s = RXp_OFFS(prog)[0].end + orig; - } while (CALLREGEXEC(rx, s, strend, orig, - s == m, /* don't match same null twice */ - TARG, NULL, + if (UNLIKELY(RXp_MATCH_TAINTED(prog))) + rxtainted |= SUBST_TAINT_PAT; + m = RXp_OFFS(prog)[0].start + orig; + if ((i = m - s)) { + if (s != d) + Move(s, d, i, char); + d += i; + } + if (clen) { + Copy(c, d, clen, char); + d += clen; + } + s = RXp_OFFS(prog)[0].end + orig; + } while (CALLREGEXEC(rx, s, strend, orig, + s == m, /* don't match same null twice */ + TARG, NULL, REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW)); - if (s != d) { + if (s != d) { I32 i = strend - s; - SvCUR_set(TARG, d - SvPVX_const(TARG) + i); - Move(s, d, i+1, char); /* include the NUL */ - } - SPAGAIN; + SvCUR_set(TARG, d - SvPVX_const(TARG) + i); + Move(s, d, i+1, char); /* include the NUL */ + } + SPAGAIN; assert(iters); if (PL_op->op_private & OPpTRUEBOOL) PUSHs(&PL_sv_yes); else mPUSHi(iters); - } + } } else { - bool first; + bool first; char *m; - SV *repl; - if (force_on_match) { + SV *repl; + if (force_on_match) { /* redo the first match, this time with the orig var * forced into being a string */ - force_on_match = 0; - if (rpm->op_pmflags & PMf_NONDESTRUCT) { - /* I feel that it should be possible to avoid this mortal copy - given that the code below copies into a new destination. - However, I suspect it isn't worth the complexity of - unravelling the C for the small number of - cases where it would be viable to drop into the copy code. */ - TARG = sv_2mortal(newSVsv(TARG)); - } - orig = SvPV_force_nomg(TARG, len); - goto force_it; - } + force_on_match = 0; + if (rpm->op_pmflags & PMf_NONDESTRUCT) { + /* I feel that it should be possible to avoid this mortal copy + given that the code below copies into a new destination. + However, I suspect it isn't worth the complexity of + unravelling the C for the small number of + cases where it would be viable to drop into the copy code. */ + TARG = sv_2mortal(newSVsv(TARG)); + } + orig = SvPV_force_nomg(TARG, len); + goto force_it; + } #ifdef PERL_ANY_COW have_a_cow: #endif - if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */ - rxtainted |= SUBST_TAINT_PAT; - repl = dstr; + if (RXp_MATCH_TAINTED(prog)) /* run time pattern taint, eg locale */ + rxtainted |= SUBST_TAINT_PAT; + repl = dstr; s = RXp_OFFS(prog)[0].start + orig; - dstr = newSVpvn_flags(orig, s-orig, + dstr = newSVpvn_flags(orig, s-orig, SVs_TEMP | (DO_UTF8(TARG) ? SVf_UTF8 : 0)); - if (!c) { - PERL_CONTEXT *cx; - SPAGAIN; + if (!c) { + PERL_CONTEXT *cx; + SPAGAIN; m = orig; - /* note that a whole bunch of local vars are saved here for - * use by pp_substcont: here's a list of them in case you're - * searching for places in this sub that uses a particular var: - * iters maxiters r_flags oldsave rxtainted orig dstr targ - * s m strend rx once */ - CX_PUSHSUBST(cx); - RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot); - } - first = TRUE; - do { - if (UNLIKELY(iters++ > maxiters)) - DIE(aTHX_ "Substitution loop"); - if (UNLIKELY(RXp_MATCH_TAINTED(prog))) - rxtainted |= SUBST_TAINT_PAT; - if (RXp_MATCH_COPIED(prog) && RXp_SUBBEG(prog) != orig) { - char *old_s = s; - char *old_orig = orig; + /* note that a whole bunch of local vars are saved here for + * use by pp_substcont: here's a list of them in case you're + * searching for places in this sub that uses a particular var: + * iters maxiters r_flags oldsave rxtainted orig dstr targ + * s m strend rx once */ + CX_PUSHSUBST(cx); + RETURNOP(cPMOP->op_pmreplrootu.op_pmreplroot); + } + first = TRUE; + do { + if (UNLIKELY(iters++ > maxiters)) + DIE(aTHX_ "Substitution loop"); + if (UNLIKELY(RXp_MATCH_TAINTED(prog))) + rxtainted |= SUBST_TAINT_PAT; + if (RXp_MATCH_COPIED(prog) && RXp_SUBBEG(prog) != orig) { + char *old_s = s; + char *old_orig = orig; assert(RXp_SUBOFFSET(prog) == 0); - orig = RXp_SUBBEG(prog); - s = orig + (old_s - old_orig); - strend = s + (strend - old_s); - } - m = RXp_OFFS(prog)[0].start + orig; - sv_catpvn_nomg_maybeutf8(dstr, s, m - s, DO_UTF8(TARG)); - s = RXp_OFFS(prog)[0].end + orig; - if (first) { - /* replacement already stringified */ - if (clen) - sv_catpvn_nomg_maybeutf8(dstr, c, clen, doutf8); - first = FALSE; - } - else { - sv_catsv(dstr, repl); - } - if (once) - break; - } while (CALLREGEXEC(rx, s, strend, orig, + orig = RXp_SUBBEG(prog); + s = orig + (old_s - old_orig); + strend = s + (strend - old_s); + } + m = RXp_OFFS(prog)[0].start + orig; + sv_catpvn_nomg_maybeutf8(dstr, s, m - s, DO_UTF8(TARG)); + s = RXp_OFFS(prog)[0].end + orig; + if (first) { + /* replacement already stringified */ + if (clen) + sv_catpvn_nomg_maybeutf8(dstr, c, clen, doutf8); + first = FALSE; + } + else { + sv_catsv(dstr, repl); + } + if (once) + break; + } while (CALLREGEXEC(rx, s, strend, orig, s == m, /* Yields minend of 0 or 1 */ - TARG, NULL, + TARG, NULL, REXEC_NOT_FIRST|REXEC_IGNOREPOS|REXEC_FAIL_ON_UNDERFLOW)); assert(strend >= s); - sv_catpvn_nomg_maybeutf8(dstr, s, strend - s, DO_UTF8(TARG)); - - if (rpm->op_pmflags & PMf_NONDESTRUCT) { - /* From here on down we're using the copy, and leaving the original - untouched. */ - TARG = dstr; - SPAGAIN; - PUSHs(dstr); - } else { + sv_catpvn_nomg_maybeutf8(dstr, s, strend - s, DO_UTF8(TARG)); + + if (rpm->op_pmflags & PMf_NONDESTRUCT) { + /* From here on down we're using the copy, and leaving the original + untouched. */ + TARG = dstr; + SPAGAIN; + PUSHs(dstr); + } else { #ifdef PERL_ANY_COW - /* The match may make the string COW. If so, brilliant, because - that's just saved us one malloc, copy and free - the regexp has - donated the old buffer, and we malloc an entirely new one, rather - than the regexp malloc()ing a buffer and copying our original, - only for us to throw it away here during the substitution. */ - if (SvIsCOW(TARG)) { - sv_force_normal_flags(TARG, SV_COW_DROP_PV); - } else + /* The match may make the string COW. If so, brilliant, because + that's just saved us one malloc, copy and free - the regexp has + donated the old buffer, and we malloc an entirely new one, rather + than the regexp malloc()ing a buffer and copying our original, + only for us to throw it away here during the substitution. */ + if (SvIsCOW(TARG)) { + sv_force_normal_flags(TARG, SV_COW_DROP_PV); + } else #endif - { - SvPV_free(TARG); - } - SvPV_set(TARG, SvPVX(dstr)); - SvCUR_set(TARG, SvCUR(dstr)); - SvLEN_set(TARG, SvLEN(dstr)); - SvFLAGS(TARG) |= SvUTF8(dstr); - SvPV_set(dstr, NULL); - - SPAGAIN; + { + SvPV_free(TARG); + } + SvPV_set(TARG, SvPVX(dstr)); + SvCUR_set(TARG, SvCUR(dstr)); + SvLEN_set(TARG, SvLEN(dstr)); + SvFLAGS(TARG) |= SvUTF8(dstr); + SvPV_set(dstr, NULL); + + SPAGAIN; if (PL_op->op_private & OPpTRUEBOOL) PUSHs(&PL_sv_yes); else mPUSHi(iters); - } + } } if (!(rpm->op_pmflags & PMf_NONDESTRUCT)) { - (void)SvPOK_only_UTF8(TARG); + (void)SvPOK_only_UTF8(TARG); } /* See "how taint works" above */ if (TAINTING_get) { - if ((rxtainted & SUBST_TAINT_PAT) || - ((rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) == - (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) - ) - (RXp_MATCH_TAINTED_on(prog)); /* taint $1 et al */ - - if (!(rxtainted & SUBST_TAINT_BOOLRET) - && (rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT)) - ) - SvTAINTED_on(TOPs); /* taint return value */ - else - SvTAINTED_off(TOPs); /* may have got tainted earlier */ - - /* needed for mg_set below */ - TAINT_set( - cBOOL(rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL)) + if ((rxtainted & SUBST_TAINT_PAT) || + ((rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) == + (SUBST_TAINT_STR|SUBST_TAINT_RETAINT)) + ) + (RXp_MATCH_TAINTED_on(prog)); /* taint $1 et al */ + + if (!(rxtainted & SUBST_TAINT_BOOLRET) + && (rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT)) + ) + SvTAINTED_on(TOPs); /* taint return value */ + else + SvTAINTED_off(TOPs); /* may have got tainted earlier */ + + /* needed for mg_set below */ + TAINT_set( + cBOOL(rxtainted & (SUBST_TAINT_STR|SUBST_TAINT_PAT|SUBST_TAINT_REPL)) ); - SvTAINT(TARG); + SvTAINT(TARG); } SvSETMAGIC(TARG); /* PL_tainted must be correctly set for this mg_set */ TAINT_NOT; @@ -4556,48 +4556,48 @@ PP(pp_grepwhile) dPOPss; if (SvTRUE_NN(sv)) - PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr]; + PL_stack_base[PL_markstack_ptr[-1]++] = PL_stack_base[*PL_markstack_ptr]; ++*PL_markstack_ptr; FREETMPS; LEAVE_with_name("grep_item"); /* exit inner scope */ /* All done yet? */ if (UNLIKELY(PL_stack_base + *PL_markstack_ptr > SP)) { - I32 items; - const U8 gimme = GIMME_V; - - LEAVE_with_name("grep"); /* exit outer scope */ - (void)POPMARK; /* pop src */ - items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; - (void)POPMARK; /* pop dst */ - SP = PL_stack_base + POPMARK; /* pop original mark */ - if (gimme == G_SCALAR) { + I32 items; + const U8 gimme = GIMME_V; + + LEAVE_with_name("grep"); /* exit outer scope */ + (void)POPMARK; /* pop src */ + items = --*PL_markstack_ptr - PL_markstack_ptr[-1]; + (void)POPMARK; /* pop dst */ + SP = PL_stack_base + POPMARK; /* pop original mark */ + if (gimme == G_SCALAR) { if (PL_op->op_private & OPpTRUEBOOL) PUSHs(items ? &PL_sv_yes : &PL_sv_zero); else { - dTARGET; - PUSHi(items); + dTARGET; + PUSHi(items); } - } - else if (gimme == G_ARRAY) - SP += items; - RETURN; + } + else if (gimme == G_ARRAY) + SP += items; + RETURN; } else { - SV *src; + SV *src; - ENTER_with_name("grep_item"); /* enter inner scope */ - SAVEVPTR(PL_curpm); + ENTER_with_name("grep_item"); /* enter inner scope */ + SAVEVPTR(PL_curpm); - src = PL_stack_base[TOPMARK]; - if (SvPADTMP(src)) { - src = PL_stack_base[TOPMARK] = sv_mortalcopy(src); - PL_tmps_floor++; - } - SvTEMP_off(src); - DEFSV_set(src); + src = PL_stack_base[TOPMARK]; + if (SvPADTMP(src)) { + src = PL_stack_base[TOPMARK] = sv_mortalcopy(src); + PL_tmps_floor++; + } + SvTEMP_off(src); + DEFSV_set(src); - RETURNOP(cLOGOP->op_other); + RETURNOP(cLOGOP->op_other); } } @@ -4939,7 +4939,7 @@ PP(pp_leavesub) /* entry zero of a stack is always PL_sv_undef, which * simplifies converting a '()' return into undef in scalar context */ assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef); - return 0; + return 0; } gimme = cx->blk_gimme; @@ -4993,7 +4993,7 @@ PP(pp_entersub) I32 old_savestack_ix; if (UNLIKELY(!sv)) - goto do_die; + goto do_die; /* Locate the CV to call: * - most common case: RV->CV: f(), $ref->(): @@ -5077,32 +5077,32 @@ PP(pp_entersub) assert(cv); assert((void*)&CvROOT(cv) == (void*)&CvXSUB(cv)); while (UNLIKELY(!CvROOT(cv))) { - GV* autogv; - SV* sub_name; - - /* anonymous or undef'd function leaves us no recourse */ - if (CvLEXICAL(cv) && CvHASGV(cv)) - DIE(aTHX_ "Undefined subroutine &%" SVf " called", - SVfARG(cv_name(cv, NULL, 0))); - if (CvANON(cv) || !CvHASGV(cv)) { - DIE(aTHX_ "Undefined subroutine called"); - } - - /* autoloaded stub? */ - if (cv != GvCV(gv = CvGV(cv))) { - cv = GvCV(gv); - } - /* should call AUTOLOAD now? */ - else { + GV* autogv; + SV* sub_name; + + /* anonymous or undef'd function leaves us no recourse */ + if (CvLEXICAL(cv) && CvHASGV(cv)) + DIE(aTHX_ "Undefined subroutine &%" SVf " called", + SVfARG(cv_name(cv, NULL, 0))); + if (CvANON(cv) || !CvHASGV(cv)) { + DIE(aTHX_ "Undefined subroutine called"); + } + + /* autoloaded stub? */ + if (cv != GvCV(gv = CvGV(cv))) { + cv = GvCV(gv); + } + /* should call AUTOLOAD now? */ + else { try_autoload: - autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), + autogv = gv_autoload_pvn(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), (GvNAMEUTF8(gv) ? SVf_UTF8 : 0) |(PL_op->op_flags & OPf_REF ? GV_AUTOLOAD_ISMETHOD : 0)); cv = autogv ? GvCV(autogv) : NULL; - } - if (!cv) { + } + if (!cv) { sub_name = sv_newmortal(); gv_efullname3(sub_name, gv, NULL); DIE(aTHX_ "Undefined subroutine &%" SVf " called", SVfARG(sub_name)); @@ -5111,31 +5111,31 @@ PP(pp_entersub) /* unrolled "CvCLONE(cv) && ! CvCLONED(cv)" */ if (UNLIKELY((CvFLAGS(cv) & (CVf_CLONE|CVf_CLONED)) == CVf_CLONE)) - DIE(aTHX_ "Closure prototype called"); + DIE(aTHX_ "Closure prototype called"); if (UNLIKELY((PL_op->op_private & OPpENTERSUB_DB) && GvCV(PL_DBsub) && !CvNODEBUG(cv))) { - Perl_get_db_sub(aTHX_ &sv, cv); - if (CvISXSUB(cv)) - PL_curcopdb = PL_curcop; + Perl_get_db_sub(aTHX_ &sv, cv); + if (CvISXSUB(cv)) + PL_curcopdb = PL_curcop; if (CvLVALUE(cv)) { /* check for lsub that handles lvalue subroutines */ - cv = GvCV(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVCV)); + cv = GvCV(gv_fetchpvs("DB::lsub", GV_ADDMULTI, SVt_PVCV)); /* if lsub not found then fall back to DB::sub */ - if (!cv) cv = GvCV(PL_DBsub); + if (!cv) cv = GvCV(PL_DBsub); } else { cv = GvCV(PL_DBsub); } - if (!cv || (!CvXSUB(cv) && !CvSTART(cv))) - DIE(aTHX_ "No DB::sub routine defined"); + if (!cv || (!CvXSUB(cv) && !CvSTART(cv))) + DIE(aTHX_ "No DB::sub routine defined"); } if (!(CvISXSUB(cv))) { - /* This path taken at least 75% of the time */ - dMARK; - PADLIST *padlist; + /* This path taken at least 75% of the time */ + dMARK; + PADLIST *padlist; I32 depth; bool hasargs; U8 gimme; @@ -5145,7 +5145,7 @@ PP(pp_entersub) * in the caller's tmps frame, so they won't be freed until after * we return from the sub. */ - { + { SV **svp = MARK; while (svp < SP) { SV *sv = *++svp; @@ -5154,26 +5154,26 @@ PP(pp_entersub) if (SvPADTMP(sv)) *svp = sv = sv_mortalcopy(sv); SvTEMP_off(sv); - } + } } gimme = GIMME_V; - cx = cx_pushblock(CXt_SUB, gimme, MARK, old_savestack_ix); + cx = cx_pushblock(CXt_SUB, gimme, MARK, old_savestack_ix); hasargs = cBOOL(PL_op->op_flags & OPf_STACKED); - cx_pushsub(cx, cv, PL_op->op_next, hasargs); - - padlist = CvPADLIST(cv); - if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2)) - pad_push(padlist, depth); - PAD_SET_CUR_NOSAVE(padlist, depth); - if (LIKELY(hasargs)) { - AV *const av = MUTABLE_AV(PAD_SVl(0)); + cx_pushsub(cx, cv, PL_op->op_next, hasargs); + + padlist = CvPADLIST(cv); + if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2)) + pad_push(padlist, depth); + PAD_SET_CUR_NOSAVE(padlist, depth); + if (LIKELY(hasargs)) { + AV *const av = MUTABLE_AV(PAD_SVl(0)); SSize_t items; AV **defavp; - defavp = &GvAV(PL_defgv); - cx->blk_sub.savearray = *defavp; - *defavp = MUTABLE_AV(SvREFCNT_inc_simple_NN(av)); + defavp = &GvAV(PL_defgv); + cx->blk_sub.savearray = *defavp; + *defavp = MUTABLE_AV(SvREFCNT_inc_simple_NN(av)); /* it's the responsibility of whoever leaves a sub to ensure * that a clean, empty AV is left in pad[0]. This is normally @@ -5181,7 +5181,7 @@ PP(pp_entersub) assert(!AvREAL(av) && AvFILLp(av) == -1); items = SP - MARK; - if (UNLIKELY(items - 1 > AvMAX(av))) { + if (UNLIKELY(items - 1 > AvMAX(av))) { SV **ary = AvALLOC(av); Renew(ary, items, SV*); AvMAX(av) = items - 1; @@ -5191,94 +5191,94 @@ PP(pp_entersub) if (items) Copy(MARK+1,AvARRAY(av),items,SV*); - AvFILLp(av) = items - 1; - } - if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && - !CvLVALUE(cv))) + AvFILLp(av) = items - 1; + } + if (UNLIKELY((cx->blk_u16 & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && + !CvLVALUE(cv))) DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf, SVfARG(cv_name(cv, NULL, 0))); - /* warning must come *after* we fully set up the context - * stuff so that __WARN__ handlers can safely dounwind() - * if they want to - */ - if (UNLIKELY(depth == PERL_SUB_DEPTH_WARN + /* warning must come *after* we fully set up the context + * stuff so that __WARN__ handlers can safely dounwind() + * if they want to + */ + if (UNLIKELY(depth == PERL_SUB_DEPTH_WARN && ckWARN(WARN_RECURSION) && !(PERLDB_SUB && cv == GvCV(PL_DBsub)))) - sub_crush_depth(cv); - RETURNOP(CvSTART(cv)); + sub_crush_depth(cv); + RETURNOP(CvSTART(cv)); } else { - SSize_t markix = TOPMARK; + SSize_t markix = TOPMARK; bool is_scalar; ENTER; /* pretend we did the ENTER earlier */ - PL_scopestack[PL_scopestack_ix - 1] = old_savestack_ix; + PL_scopestack[PL_scopestack_ix - 1] = old_savestack_ix; - SAVETMPS; - PUTBACK; + SAVETMPS; + PUTBACK; - if (UNLIKELY(((PL_op->op_private - & CX_PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub) + if (UNLIKELY(((PL_op->op_private + & CX_PUSHSUB_GET_LVALUE_MASK(Perl_is_lvalue_sub) ) & OPpENTERSUB_LVAL_MASK) == OPpLVAL_INTRO && - !CvLVALUE(cv))) + !CvLVALUE(cv))) DIE(aTHX_ "Can't modify non-lvalue subroutine call of &%" SVf, SVfARG(cv_name(cv, NULL, 0))); - if (UNLIKELY(!(PL_op->op_flags & OPf_STACKED) && GvAV(PL_defgv))) { - /* Need to copy @_ to stack. Alternative may be to - * switch stack to @_, and copy return values - * back. This would allow popping @_ in XSUB, e.g.. XXXX */ - AV * const av = GvAV(PL_defgv); - const SSize_t items = AvFILL(av) + 1; - - if (items) { - SSize_t i = 0; - const bool m = cBOOL(SvRMAGICAL(av)); - /* Mark is at the end of the stack. */ - EXTEND(SP, items); - for (; i < items; ++i) - { - SV *sv; - if (m) { - SV ** const svp = av_fetch(av, i, 0); - sv = svp ? *svp : NULL; - } - else sv = AvARRAY(av)[i]; - if (sv) SP[i+1] = sv; - else { - SP[i+1] = av_nonelem(av, i); - } - } - SP += items; - PUTBACK ; - } - } - else { - SV **mark = PL_stack_base + markix; - SSize_t items = SP - mark; - while (items--) { - mark++; - if (*mark && SvPADTMP(*mark)) { - *mark = sv_mortalcopy(*mark); + if (UNLIKELY(!(PL_op->op_flags & OPf_STACKED) && GvAV(PL_defgv))) { + /* Need to copy @_ to stack. Alternative may be to + * switch stack to @_, and copy return values + * back. This would allow popping @_ in XSUB, e.g.. XXXX */ + AV * const av = GvAV(PL_defgv); + const SSize_t items = AvFILL(av) + 1; + + if (items) { + SSize_t i = 0; + const bool m = cBOOL(SvRMAGICAL(av)); + /* Mark is at the end of the stack. */ + EXTEND(SP, items); + for (; i < items; ++i) + { + SV *sv; + if (m) { + SV ** const svp = av_fetch(av, i, 0); + sv = svp ? *svp : NULL; + } + else sv = AvARRAY(av)[i]; + if (sv) SP[i+1] = sv; + else { + SP[i+1] = av_nonelem(av, i); + } + } + SP += items; + PUTBACK ; + } + } + else { + SV **mark = PL_stack_base + markix; + SSize_t items = SP - mark; + while (items--) { + mark++; + if (*mark && SvPADTMP(*mark)) { + *mark = sv_mortalcopy(*mark); } - } - } - /* We assume first XSUB in &DB::sub is the called one. */ - if (UNLIKELY(PL_curcopdb)) { - SAVEVPTR(PL_curcop); - PL_curcop = PL_curcopdb; - PL_curcopdb = NULL; - } - /* Do we need to open block here? XXXX */ + } + } + /* We assume first XSUB in &DB::sub is the called one. */ + if (UNLIKELY(PL_curcopdb)) { + SAVEVPTR(PL_curcop); + PL_curcop = PL_curcopdb; + PL_curcopdb = NULL; + } + /* Do we need to open block here? XXXX */ /* calculate gimme here as PL_op might get changed and then not * restored until the LEAVE further down */ is_scalar = (GIMME_V == G_SCALAR); - /* CvXSUB(cv) must not be NULL because newXS() refuses NULL xsub address */ - assert(CvXSUB(cv)); - CvXSUB(cv)(aTHX_ cv); + /* CvXSUB(cv) must not be NULL because newXS() refuses NULL xsub address */ + assert(CvXSUB(cv)); + CvXSUB(cv)(aTHX_ cv); #if defined DEBUGGING && !defined DEBUGGING_RE_ONLY /* This duplicates the check done in runops_debug(), but provides more @@ -5295,16 +5295,16 @@ PP(pp_entersub) PL_stack_base, PL_stack_sp, PL_stack_base + PL_curstackinfo->si_stack_hwm); #endif - /* Enforce some sanity in scalar context. */ - if (is_scalar) { + /* Enforce some sanity in scalar context. */ + if (is_scalar) { SV **svp = PL_stack_base + markix + 1; if (svp != PL_stack_sp) { *svp = svp > PL_stack_sp ? &PL_sv_undef : *PL_stack_sp; PL_stack_sp = svp; } - } - LEAVE; - return NORMAL; + } + LEAVE; + return NORMAL; } } @@ -5314,10 +5314,10 @@ Perl_sub_crush_depth(pTHX_ CV *cv) PERL_ARGS_ASSERT_SUB_CRUSH_DEPTH; if (CvANON(cv)) - Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on anonymous subroutine"); else { - Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"", - SVfARG(cv_name(cv,NULL,0))); + Perl_warner(aTHX_ packWARN(WARN_RECURSION), "Deep recursion on subroutine \"%" SVf "\"", + SVfARG(cv_name(cv,NULL,0))); } } @@ -5357,70 +5357,70 @@ PP(pp_aelem) SV *sv; if (UNLIKELY(SvROK(elemsv) && !SvGAMAGIC(elemsv) && ckWARN(WARN_MISC))) - Perl_warner(aTHX_ packWARN(WARN_MISC), - "Use of reference \"%" SVf "\" as array index", - SVfARG(elemsv)); + Perl_warner(aTHX_ packWARN(WARN_MISC), + "Use of reference \"%" SVf "\" as array index", + SVfARG(elemsv)); if (UNLIKELY(SvTYPE(av) != SVt_PVAV)) - RETPUSHUNDEF; + RETPUSHUNDEF; if (UNLIKELY(localizing)) { - MAGIC *mg; - HV *stash; + MAGIC *mg; + HV *stash; - /* If we can determine whether the element exist, - * Try to preserve the existenceness of a tied array - * element by using EXISTS and DELETE if possible. - * Fallback to FETCH and STORE otherwise. */ - if (SvCANEXISTDELETE(av)) - preeminent = av_exists(av, elem); + /* If we can determine whether the element exist, + * Try to preserve the existenceness of a tied array + * element by using EXISTS and DELETE if possible. + * Fallback to FETCH and STORE otherwise. */ + if (SvCANEXISTDELETE(av)) + preeminent = av_exists(av, elem); } svp = av_fetch(av, elem, lval && !defer); if (lval) { #ifdef PERL_MALLOC_WRAP - if (SvUOK(elemsv)) { - const UV uv = SvUV(elemsv); - elem = uv > IV_MAX ? IV_MAX : uv; - } - else if (SvNOK(elemsv)) - elem = (IV)SvNV(elemsv); - if (elem > 0) { - MEM_WRAP_CHECK_s(elem,SV*,"Out of memory during array extend"); - } + if (SvUOK(elemsv)) { + const UV uv = SvUV(elemsv); + elem = uv > IV_MAX ? IV_MAX : uv; + } + else if (SvNOK(elemsv)) + elem = (IV)SvNV(elemsv); + if (elem > 0) { + MEM_WRAP_CHECK_s(elem,SV*,"Out of memory during array extend"); + } #endif - if (!svp || !*svp) { - IV len; - if (!defer) - DIE(aTHX_ PL_no_aelem, elem); - len = av_top_index(av); - /* Resolve a negative index that falls within the array. Leave - it negative it if falls outside the array. */ - if (elem < 0 && len + elem >= 0) - elem = len + elem; - if (elem >= 0 && elem <= len) - /* Falls within the array. */ - PUSHs(av_nonelem(av,elem)); - else - /* Falls outside the array. If it is negative, - magic_setdefelem will use the index for error reporting. - */ - mPUSHs(newSVavdefelem(av, elem, 1)); - RETURN; - } - if (UNLIKELY(localizing)) { - if (preeminent) - save_aelem(av, elem, svp); - else - SAVEADELETE(av, elem); - } - else if (PL_op->op_private & OPpDEREF) { - PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF)); - RETURN; - } + if (!svp || !*svp) { + IV len; + if (!defer) + DIE(aTHX_ PL_no_aelem, elem); + len = av_top_index(av); + /* Resolve a negative index that falls within the array. Leave + it negative it if falls outside the array. */ + if (elem < 0 && len + elem >= 0) + elem = len + elem; + if (elem >= 0 && elem <= len) + /* Falls within the array. */ + PUSHs(av_nonelem(av,elem)); + else + /* Falls outside the array. If it is negative, + magic_setdefelem will use the index for error reporting. + */ + mPUSHs(newSVavdefelem(av, elem, 1)); + RETURN; + } + if (UNLIKELY(localizing)) { + if (preeminent) + save_aelem(av, elem, svp); + else + SAVEADELETE(av, elem); + } + else if (PL_op->op_private & OPpDEREF) { + PUSHs(vivify_ref(*svp, PL_op->op_private & OPpDEREF)); + RETURN; + } } sv = (svp ? *svp : &PL_sv_undef); if (!lval && SvRMAGICAL(av) && SvGMAGICAL(sv)) /* see note in pp_helem() */ - mg_get(sv); + mg_get(sv); PUSHs(sv); RETURN; } @@ -5432,30 +5432,30 @@ Perl_vivify_ref(pTHX_ SV *sv, U32 to_what) SvGETMAGIC(sv); if (!SvOK(sv)) { - if (SvREADONLY(sv)) - Perl_croak_no_modify(); - prepare_SV_for_RV(sv); - switch (to_what) { - case OPpDEREF_SV: - SvRV_set(sv, newSV(0)); - break; - case OPpDEREF_AV: - SvRV_set(sv, MUTABLE_SV(newAV())); - break; - case OPpDEREF_HV: - SvRV_set(sv, MUTABLE_SV(newHV())); - break; - } - SvROK_on(sv); - SvSETMAGIC(sv); - SvGETMAGIC(sv); + if (SvREADONLY(sv)) + Perl_croak_no_modify(); + prepare_SV_for_RV(sv); + switch (to_what) { + case OPpDEREF_SV: + SvRV_set(sv, newSV(0)); + break; + case OPpDEREF_AV: + SvRV_set(sv, MUTABLE_SV(newAV())); + break; + case OPpDEREF_HV: + SvRV_set(sv, MUTABLE_SV(newHV())); + break; + } + SvROK_on(sv); + SvSETMAGIC(sv); + SvGETMAGIC(sv); } if (SvGMAGICAL(sv)) { - /* copy the sv without magic to prevent magic from being - executed twice */ - SV* msv = sv_newmortal(); - sv_setsv_nomg(msv, sv); - return msv; + /* copy the sv without magic to prevent magic from being + executed twice */ + SV* msv = sv_newmortal(); + sv_setsv_nomg(msv, sv); + return msv; } return sv; } @@ -5467,78 +5467,78 @@ S_opmethod_stash(pTHX_ SV* meth) HV* stash; SV* const sv = PL_stack_base + TOPMARK == PL_stack_sp - ? (Perl_croak(aTHX_ "Can't call method \"%" SVf "\" without a " - "package or object reference", SVfARG(meth)), - (SV *)NULL) - : *(PL_stack_base + TOPMARK + 1); + ? (Perl_croak(aTHX_ "Can't call method \"%" SVf "\" without a " + "package or object reference", SVfARG(meth)), + (SV *)NULL) + : *(PL_stack_base + TOPMARK + 1); PERL_ARGS_ASSERT_OPMETHOD_STASH; if (UNLIKELY(!sv)) undefined: - Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on an undefined value", - SVfARG(meth)); + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on an undefined value", + SVfARG(meth)); if (UNLIKELY(SvGMAGICAL(sv))) mg_get(sv); else if (SvIsCOW_shared_hash(sv)) { /* MyClass->meth() */ - stash = gv_stashsv(sv, GV_CACHE_ONLY); - if (stash) return stash; + stash = gv_stashsv(sv, GV_CACHE_ONLY); + if (stash) return stash; } if (SvROK(sv)) - ob = MUTABLE_SV(SvRV(sv)); + ob = MUTABLE_SV(SvRV(sv)); else if (!SvOK(sv)) goto undefined; else if (isGV_with_GP(sv)) { - if (!GvIO(sv)) - Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " - "without a package or object reference", - SVfARG(meth)); - ob = sv; - if (SvTYPE(ob) == SVt_PVLV && LvTYPE(ob) == 'y') { - assert(!LvTARGLEN(ob)); - ob = LvTARG(ob); - assert(ob); - } - *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(ob)); + if (!GvIO(sv)) + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " + "without a package or object reference", + SVfARG(meth)); + ob = sv; + if (SvTYPE(ob) == SVt_PVLV && LvTYPE(ob) == 'y') { + assert(!LvTARGLEN(ob)); + ob = LvTARG(ob); + assert(ob); + } + *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(ob)); } else { - /* this isn't a reference */ - GV* iogv; + /* this isn't a reference */ + GV* iogv; STRLEN packlen; const char * const packname = SvPV_nomg_const(sv, packlen); const U32 packname_utf8 = SvUTF8(sv); stash = gv_stashpvn(packname, packlen, packname_utf8 | GV_CACHE_ONLY); if (stash) return stash; - if (!(iogv = gv_fetchpvn_flags( - packname, packlen, packname_utf8, SVt_PVIO - )) || - !(ob=MUTABLE_SV(GvIO(iogv)))) - { - /* this isn't the name of a filehandle either */ - if (!packlen) - { - Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " - "without a package or object reference", - SVfARG(meth)); - } - /* assume it's a package name */ - stash = gv_stashpvn(packname, packlen, packname_utf8); - if (stash) return stash; - else return MUTABLE_HV(sv); - } - /* it _is_ a filehandle name -- replace with a reference */ - *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(MUTABLE_SV(iogv))); + if (!(iogv = gv_fetchpvn_flags( + packname, packlen, packname_utf8, SVt_PVIO + )) || + !(ob=MUTABLE_SV(GvIO(iogv)))) + { + /* this isn't the name of a filehandle either */ + if (!packlen) + { + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" " + "without a package or object reference", + SVfARG(meth)); + } + /* assume it's a package name */ + stash = gv_stashpvn(packname, packlen, packname_utf8); + if (stash) return stash; + else return MUTABLE_HV(sv); + } + /* it _is_ a filehandle name -- replace with a reference */ + *(PL_stack_base + TOPMARK + 1) = sv_2mortal(newRV(MUTABLE_SV(iogv))); } /* if we got here, ob should be an object or a glob */ if (!ob || !(SvOBJECT(ob) - || (isGV_with_GP(ob) - && (ob = MUTABLE_SV(GvIO((const GV *)ob))) - && SvOBJECT(ob)))) + || (isGV_with_GP(ob) + && (ob = MUTABLE_SV(GvIO((const GV *)ob))) + && SvOBJECT(ob)))) { - Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on unblessed reference", - SVfARG((SvPOK(meth) && SvPVX(meth) == PL_isa_DOES) + Perl_croak(aTHX_ "Can't call method \"%" SVf "\" on unblessed reference", + SVfARG((SvPOK(meth) && SvPVX(meth) == PL_isa_DOES) ? newSVpvs_flags("DOES", SVs_TEMP) : meth)); } diff --git a/pp_pack.c b/pp_pack.c index f06e8cba1c89..4a4cb31f7408 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -56,18 +56,18 @@ typedef struct tempsym { #define TEMPSYM_INIT(symptr, p, e, f) \ STMT_START { \ - (symptr)->patptr = (p); \ - (symptr)->patend = (e); \ - (symptr)->grpbeg = NULL; \ - (symptr)->grpend = NULL; \ - (symptr)->grpend = NULL; \ - (symptr)->code = 0; \ - (symptr)->length = 0; \ - (symptr)->howlen = e_no_len; \ - (symptr)->level = 0; \ - (symptr)->flags = (f); \ - (symptr)->strbeg = 0; \ - (symptr)->previous = NULL; \ + (symptr)->patptr = (p); \ + (symptr)->patend = (e); \ + (symptr)->grpbeg = NULL; \ + (symptr)->grpend = NULL; \ + (symptr)->grpend = NULL; \ + (symptr)->code = 0; \ + (symptr)->length = 0; \ + (symptr)->howlen = e_no_len; \ + (symptr)->level = 0; \ + (symptr)->flags = (f); \ + (symptr)->strbeg = 0; \ + (symptr)->previous = NULL; \ } STMT_END typedef union { @@ -148,7 +148,7 @@ typedef union { STMT_START { \ if (UNLIKELY(utf8)) { \ if (!S_utf8_to_bytes(aTHX_ &s, strend, \ - (char *) (buf), len, datumtype)) break; \ + (char *) (buf), len, datumtype)) break; \ } else { \ if (UNLIKELY(needs_swap)) \ S_reverse_copy(s, (char *) (buf), len); \ @@ -251,27 +251,27 @@ utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype) UV val; if (*s >= end) { - goto croak; + goto croak; } val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); if (retlen == (STRLEN) -1) croak: - Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack", - (int) TYPE_NO_MODIFIERS(datumtype)); + Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack", + (int) TYPE_NO_MODIFIERS(datumtype)); if (val >= 0x100) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), - "Character in '%c' format wrapped in unpack", - (int) TYPE_NO_MODIFIERS(datumtype)); - val &= 0xff; + Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), + "Character in '%c' format wrapped in unpack", + (int) TYPE_NO_MODIFIERS(datumtype)); + val &= 0xff; } *s += retlen; return (U8)val; } #define SHIFT_BYTE(utf8, s, strend, datumtype) ((utf8) ? \ - utf8_to_byte(aTHX_ &(s), (strend), (datumtype)) : \ - *(U8 *)(s)++) + utf8_to_byte(aTHX_ &(s), (strend), (datumtype)) : \ + *(U8 *)(s)++) STATIC bool S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t buf_len, I32 datumtype) @@ -281,23 +281,23 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t const char *from = *s; int bad = 0; const U32 flags = ckWARN(WARN_UTF8) ? - UTF8_CHECK_ONLY : (UTF8_CHECK_ONLY | UTF8_ALLOW_ANY); + UTF8_CHECK_ONLY : (UTF8_CHECK_ONLY | UTF8_ALLOW_ANY); const bool needs_swap = NEEDS_SWAP(datumtype); if (UNLIKELY(needs_swap)) buf += buf_len; for (;buf_len > 0; buf_len--) { - if (from >= end) return FALSE; - val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags); - if (retlen == (STRLEN) -1) { - from += UTF8_SAFE_SKIP(from, end); - bad |= 1; - } else from += retlen; - if (val >= 0x100) { - bad |= 2; - val &= 0xff; - } + if (from >= end) return FALSE; + val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags); + if (retlen == (STRLEN) -1) { + from += UTF8_SAFE_SKIP(from, end); + bad |= 1; + } else from += retlen; + if (val >= 0x100) { + bad |= 2; + val &= 0xff; + } if (UNLIKELY(needs_swap)) *(U8 *)--buf = (U8)val; else @@ -305,22 +305,22 @@ S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t } /* We have enough characters for the buffer. Did we have problems ? */ if (bad) { - if (bad & 1) { - /* Rewalk the string fragment while warning */ - const char *ptr; - const U32 flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; - for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) { - if (ptr >= end) break; - utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags); - } - if (from > end) from = end; - } - if ((bad & 2)) - Perl_ck_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ? - WARN_PACK : WARN_UNPACK), - "Character(s) in '%c' format wrapped in %s", - (int) TYPE_NO_MODIFIERS(datumtype), - datumtype & TYPE_IS_PACK ? "pack" : "unpack"); + if (bad & 1) { + /* Rewalk the string fragment while warning */ + const char *ptr; + const U32 flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY; + for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) { + if (ptr >= end) break; + utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags); + } + if (from > end) from = end; + } + if ((bad & 2)) + Perl_ck_warner(aTHX_ packWARN(datumtype & TYPE_IS_PACK ? + WARN_PACK : WARN_UNPACK), + "Character(s) in '%c' format wrapped in %s", + (int) TYPE_NO_MODIFIERS(datumtype), + datumtype & TYPE_IS_PACK ? "pack" : "unpack"); } *s = from; return TRUE; @@ -348,13 +348,13 @@ S_my_bytes_to_utf8(const U8 *start, STRLEN len, char *dest, const bool needs_swa #define PUSH_BYTES(utf8, cur, buf, len, needs_swap) \ STMT_START { \ if (UNLIKELY(utf8)) \ - (cur) = my_bytes_to_utf8((U8 *) buf, len, (cur), needs_swap); \ + (cur) = my_bytes_to_utf8((U8 *) buf, len, (cur), needs_swap); \ else { \ if (UNLIKELY(needs_swap)) \ S_reverse_copy((char *)(buf), cur, len); \ else \ Copy(buf, cur, len, char); \ - (cur) += (len); \ + (cur) += (len); \ } \ } STMT_END @@ -380,8 +380,8 @@ STMT_START { \ if (SSize_t_MAX - glen < catcur) \ Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \ if (catcur + glen >= SvLEN(cat)) { \ - (start) = sv_exp_grow(cat, glen); \ - (cur) = (start) + SvCUR(cat); \ + (start) = sv_exp_grow(cat, glen); \ + (cur) = (start) + SvCUR(cat); \ } \ } STMT_END @@ -393,8 +393,8 @@ STMT_START { \ if ((cur) + gl >= (start) + SvLEN(cat)) { \ *cur = '\0'; \ SvCUR_set((cat), (cur) - (start)); \ - (start) = sv_exp_grow(cat, gl); \ - (cur) = (start) + SvCUR(cat); \ + (start) = sv_exp_grow(cat, gl); \ + (cur) = (start) + SvCUR(cat); \ } \ PUSH_BYTES(utf8, cur, buf, glen, 0); \ } STMT_END @@ -402,8 +402,8 @@ STMT_START { \ #define PUSH_BYTE(utf8, s, byte) \ STMT_START { \ if (utf8) { \ - const U8 au8 = (byte); \ - (s) = my_bytes_to_utf8(&au8, 1, (s), 0);\ + const U8 au8 = (byte); \ + (s) = my_bytes_to_utf8(&au8, 1, (s), 0);\ } else *(U8 *)(s)++ = (byte); \ } STMT_END @@ -414,8 +414,8 @@ STMT_START { \ if (str >= end) break; \ val = utf8n_to_uvchr((U8 *) str, end-str, &retlen, utf8_flags); \ if (retlen == (STRLEN) -1) { \ - *cur = '\0'; \ - Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); \ + *cur = '\0'; \ + Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); \ } \ str += retlen; \ } STMT_END @@ -434,100 +434,100 @@ S_measure_struct(pTHX_ tempsym_t* symptr) PERL_ARGS_ASSERT_MEASURE_STRUCT; while (next_symbol(symptr)) { - SSize_t len, size; + SSize_t len, size; switch (symptr->howlen) { - case e_star: - Perl_croak(aTHX_ "Within []-length '*' not allowed in %s", + case e_star: + Perl_croak(aTHX_ "Within []-length '*' not allowed in %s", _action( symptr ) ); - default: - /* e_no_len and e_number */ - len = symptr->length; - break; + default: + /* e_no_len and e_number */ + len = symptr->length; + break; } - size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK; - if (!size) { + size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK; + if (!size) { SSize_t star; - /* endianness doesn't influence the size of a type */ - switch(TYPE_NO_ENDIANNESS(symptr->code)) { - default: - Perl_croak(aTHX_ "Invalid type '%c' in %s", - (int)TYPE_NO_MODIFIERS(symptr->code), + /* endianness doesn't influence the size of a type */ + switch(TYPE_NO_ENDIANNESS(symptr->code)) { + default: + Perl_croak(aTHX_ "Invalid type '%c' in %s", + (int)TYPE_NO_MODIFIERS(symptr->code), _action( symptr ) ); - case '.' | TYPE_IS_SHRIEKING: - case '@' | TYPE_IS_SHRIEKING: - case '@': - case '.': - case '/': - case 'U': /* XXXX Is it correct? */ - case 'w': - case 'u': - Perl_croak(aTHX_ "Within []-length '%c' not allowed in %s", - (int) TYPE_NO_MODIFIERS(symptr->code), + case '.' | TYPE_IS_SHRIEKING: + case '@' | TYPE_IS_SHRIEKING: + case '@': + case '.': + case '/': + case 'U': /* XXXX Is it correct? */ + case 'w': + case 'u': + Perl_croak(aTHX_ "Within []-length '%c' not allowed in %s", + (int) TYPE_NO_MODIFIERS(symptr->code), _action( symptr ) ); - case '%': - size = 0; - break; - case '(': - { - tempsym_t savsym = *symptr; - symptr->patptr = savsym.grpbeg; - symptr->patend = savsym.grpend; - /* XXXX Theoretically, we need to measure many times at - different positions, since the subexpression may contain - alignment commands, but be not of aligned length. - Need to detect this and croak(). */ - size = measure_struct(symptr); - *symptr = savsym; - break; - } - case 'X' | TYPE_IS_SHRIEKING: - /* XXXX Is this useful? Then need to treat MEASURE_BACKWARDS. - */ - if (!len) /* Avoid division by 0 */ - len = 1; - len = total % len; /* Assumed: the start is aligned. */ - /* FALLTHROUGH */ - case 'X': - size = -1; - if (total < len) + case '%': + size = 0; + break; + case '(': + { + tempsym_t savsym = *symptr; + symptr->patptr = savsym.grpbeg; + symptr->patend = savsym.grpend; + /* XXXX Theoretically, we need to measure many times at + different positions, since the subexpression may contain + alignment commands, but be not of aligned length. + Need to detect this and croak(). */ + size = measure_struct(symptr); + *symptr = savsym; + break; + } + case 'X' | TYPE_IS_SHRIEKING: + /* XXXX Is this useful? Then need to treat MEASURE_BACKWARDS. + */ + if (!len) /* Avoid division by 0 */ + len = 1; + len = total % len; /* Assumed: the start is aligned. */ + /* FALLTHROUGH */ + case 'X': + size = -1; + if (total < len) Perl_croak(aTHX_ "'X' outside of string in %s", _action( symptr ) ); - break; - case 'x' | TYPE_IS_SHRIEKING: - if (!len) /* Avoid division by 0 */ - len = 1; - star = total % len; /* Assumed: the start is aligned. */ - if (star) /* Other portable ways? */ - len = len - star; - else - len = 0; - /* FALLTHROUGH */ - case 'x': - case 'A': - case 'Z': - case 'a': - size = 1; - break; - case 'B': - case 'b': - len = (len + 7)/8; - size = 1; - break; - case 'H': - case 'h': - len = (len + 1)/2; - size = 1; - break; - - case 'P': - len = 1; - size = sizeof(char*); - break; - } - } - total += len * size; + break; + case 'x' | TYPE_IS_SHRIEKING: + if (!len) /* Avoid division by 0 */ + len = 1; + star = total % len; /* Assumed: the start is aligned. */ + if (star) /* Other portable ways? */ + len = len - star; + else + len = 0; + /* FALLTHROUGH */ + case 'x': + case 'A': + case 'Z': + case 'a': + size = 1; + break; + case 'B': + case 'b': + len = (len + 7)/8; + size = 1; + break; + case 'H': + case 'h': + len = (len + 1)/2; + size = 1; + break; + + case 'P': + len = 1; + size = sizeof(char*); + break; + } + } + total += len * size; } return total; } @@ -542,20 +542,20 @@ S_group_end(pTHX_ const char *patptr, const char *patend, char ender) PERL_ARGS_ASSERT_GROUP_END; while (patptr < patend) { - const char c = *patptr++; - - if (isSPACE(c)) - continue; - else if (c == ender) - return patptr-1; - else if (c == '#') { - while (patptr < patend && *patptr != '\n') - patptr++; - continue; - } else if (c == '(') - patptr = group_end(patptr, patend, ')') + 1; - else if (c == '[') - patptr = group_end(patptr, patend, ']') + 1; + const char c = *patptr++; + + if (isSPACE(c)) + continue; + else if (c == ender) + return patptr-1; + else if (c == '#') { + while (patptr < patend && *patptr != '\n') + patptr++; + continue; + } else if (c == '(') + patptr = group_end(patptr, patend, ')') + 1; + else if (c == '[') + patptr = group_end(patptr, patend, ']') + 1; } Perl_croak(aTHX_ "No group ending character '%c' found in template", ender); @@ -603,21 +603,21 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) else if (*patptr == '#') { patptr++; while (patptr < patend && *patptr != '\n') - patptr++; + patptr++; if (patptr < patend) - patptr++; + patptr++; } else { /* We should have found a template code */ I32 code = *patptr++ & 0xFF; U32 inherited_modifiers = 0; if (code == ','){ /* grandfather in commas but with a warning */ - if (((symptr->flags & FLAG_COMMA) == 0) && ckWARN(WARN_UNPACK)){ + if (((symptr->flags & FLAG_COMMA) == 0) && ckWARN(WARN_UNPACK)){ symptr->flags |= FLAG_COMMA; - Perl_warner(aTHX_ packWARN(WARN_UNPACK), - "Invalid type ',' in %s", _action( symptr ) ); + Perl_warner(aTHX_ packWARN(WARN_UNPACK), + "Invalid type ',' in %s", _action( symptr ) ); } - continue; + continue; } /* for '(', skip to ')' */ @@ -628,7 +628,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) symptr->grpbeg = patptr; patptr = 1 + ( symptr->grpend = group_end(patptr, patend, ')') ); if( symptr->level >= MAX_SUB_TEMPLATE_LEVEL ) - Perl_croak(aTHX_ "Too deeply nested ()-groups in %s", + Perl_croak(aTHX_ "Too deeply nested ()-groups in %s", _action( symptr ) ); } @@ -677,10 +677,10 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) *patptr, _action( symptr ) ); if ((code & modifier)) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), - "Duplicate modifier '%c' after '%c' in %s", - *patptr, (int) TYPE_NO_MODIFIERS(code), - _action( symptr ) ); + Perl_ck_warner(aTHX_ packWARN(WARN_UNPACK), + "Duplicate modifier '%c' after '%c' in %s", + *patptr, (int) TYPE_NO_MODIFIERS(code), + _action( symptr ) ); } code |= modifier; @@ -692,8 +692,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) /* look for count and/or / */ if (patptr < patend) { - if (isDIGIT(*patptr)) { - patptr = get_num( patptr, &symptr->length ); + if (isDIGIT(*patptr)) { + patptr = get_num( patptr, &symptr->length ); symptr->howlen = e_number; } else if (*patptr == '*') { @@ -729,9 +729,9 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) else if (*patptr == '#') { patptr++; while (patptr < patend && *patptr != '\n') - patptr++; + patptr++; if (patptr < patend) - patptr++; + patptr++; } else { if (*patptr == '/') { symptr->flags |= FLAG_SLASH; @@ -742,8 +742,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr ) _action( symptr ) ); } break; - } - } + } + } } else { /* at end - no count, no / */ symptr->howlen = e_no_len; @@ -776,14 +776,14 @@ need_utf8(const char *pat, const char *patend) PERL_ARGS_ASSERT_NEED_UTF8; while (pat < patend) { - if (pat[0] == '#') { - pat++; - pat = (const char *) memchr(pat, '\n', patend-pat); - if (!pat) return FALSE; - } else if (pat[0] == 'U') { - if (first || pat[1] == '0') return TRUE; - } else first = FALSE; - pat++; + if (pat[0] == '#') { + pat++; + pat = (const char *) memchr(pat, '\n', patend-pat); + if (!pat) return FALSE; + } else if (pat[0] == 'U') { + if (first || pat[1] == '0') return TRUE; + } else first = FALSE; + pat++; } return FALSE; } @@ -793,11 +793,11 @@ first_symbol(const char *pat, const char *patend) { PERL_ARGS_ASSERT_FIRST_SYMBOL; while (pat < patend) { - if (pat[0] != '#') return pat[0]; - pat++; - pat = (const char *) memchr(pat, '\n', patend-pat); - if (!pat) return 0; - pat++; + if (pat[0] != '#') return pat[0]; + pat++; + pat = (const char *) memchr(pat, '\n', patend-pat); + if (!pat) return 0; + pat++; } return 0; } @@ -833,17 +833,17 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8; else if (need_utf8(pat, patend)) { - /* We probably should try to avoid this in case a scalar context call - wouldn't get to the "U0" */ - STRLEN len = strend - s; - s = (char *) bytes_to_utf8((U8 *) s, &len); - SAVEFREEPV(s); - strend = s + len; - flags |= FLAG_DO_UTF8; + /* We probably should try to avoid this in case a scalar context call + wouldn't get to the "U0" */ + STRLEN len = strend - s; + s = (char *) bytes_to_utf8((U8 *) s, &len); + SAVEFREEPV(s); + strend = s + len; + flags |= FLAG_DO_UTF8; } if (first_symbol(pat, patend) != 'U' && (flags & FLAG_DO_UTF8)) - flags |= FLAG_PARSE_UTF8; + flags |= FLAG_PARSE_UTF8; TEMPSYM_INIT(&sym, pat, patend, flags); @@ -871,223 +871,223 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c symptr->strbeg = s - strbeg; while (next_symbol(symptr)) { - packprops_t props; - SSize_t len; + packprops_t props; + SSize_t len; I32 datumtype = symptr->code; bool needs_swap; - /* do first one only unless in list context - / is implemented by unpacking the count, then popping it from the - stack, so must check that we're not in the middle of a / */ + /* do first one only unless in list context + / is implemented by unpacking the count, then popping it from the + stack, so must check that we're not in the middle of a / */ if ( unpack_only_one - && (SP - PL_stack_base == start_sp_offset + 1) - && (datumtype != '/') ) /* XXX can this be omitted */ + && (SP - PL_stack_base == start_sp_offset + 1) + && (datumtype != '/') ) /* XXX can this be omitted */ break; switch (howlen = symptr->howlen) { - case e_star: - len = strend - strbeg; /* long enough */ - break; - default: - /* e_no_len and e_number */ - len = symptr->length; - break; + case e_star: + len = strend - strbeg; /* long enough */ + break; + default: + /* e_no_len and e_number */ + len = symptr->length; + break; } explicit_length = TRUE; redo_switch: beyond = s >= strend; - props = packprops[TYPE_NO_ENDIANNESS(datumtype)]; - if (props) { - /* props nonzero means we can process this letter. */ + props = packprops[TYPE_NO_ENDIANNESS(datumtype)]; + if (props) { + /* props nonzero means we can process this letter. */ const SSize_t size = props & PACK_SIZE_MASK; const SSize_t howmany = (strend - s) / size; - if (len > howmany) - len = howmany; + if (len > howmany) + len = howmany; - if (!checksum || (props & PACK_SIZE_CANNOT_CSUM)) { - if (len && unpack_only_one) len = 1; - EXTEND(SP, len); - EXTEND_MORTAL(len); - } - } + if (!checksum || (props & PACK_SIZE_CANNOT_CSUM)) { + if (len && unpack_only_one) len = 1; + EXTEND(SP, len); + EXTEND_MORTAL(len); + } + } needs_swap = NEEDS_SWAP(datumtype); - switch(TYPE_NO_ENDIANNESS(datumtype)) { - default: - Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)TYPE_NO_MODIFIERS(datumtype) ); + switch(TYPE_NO_ENDIANNESS(datumtype)) { + default: + Perl_croak(aTHX_ "Invalid type '%c' in unpack", (int)TYPE_NO_MODIFIERS(datumtype) ); - case '%': - if (howlen == e_no_len) - len = 16; /* len is not specified */ - checksum = len; - cuv = 0; - cdouble = 0; - continue; + case '%': + if (howlen == e_no_len) + len = 16; /* len is not specified */ + checksum = len; + cuv = 0; + cdouble = 0; + continue; - case '(': - { + case '(': + { tempsym_t savsym = *symptr; const U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags); - symptr->flags |= group_modifiers; + symptr->flags |= group_modifiers; symptr->patend = savsym.grpend; - symptr->previous = &savsym; + symptr->previous = &savsym; symptr->level++; - PUTBACK; - if (len && unpack_only_one) len = 1; - while (len--) { - symptr->patptr = savsym.grpbeg; - if (utf8) symptr->flags |= FLAG_PARSE_UTF8; - else symptr->flags &= ~FLAG_PARSE_UTF8; - unpack_rec(symptr, s, strbeg, strend, &s); + PUTBACK; + if (len && unpack_only_one) len = 1; + while (len--) { + symptr->patptr = savsym.grpbeg; + if (utf8) symptr->flags |= FLAG_PARSE_UTF8; + else symptr->flags &= ~FLAG_PARSE_UTF8; + unpack_rec(symptr, s, strbeg, strend, &s); if (s == strend && savsym.howlen == e_star) - break; /* No way to continue */ - } - SPAGAIN; + break; /* No way to continue */ + } + SPAGAIN; savsym.flags = symptr->flags & ~group_modifiers; *symptr = savsym; - break; - } - case '.' | TYPE_IS_SHRIEKING: - case '.': { - const char *from; - SV *sv; - const bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING); - if (howlen == e_star) from = strbeg; - else if (len <= 0) from = s; - else { - tempsym_t *group = symptr; - - while (--len && group) group = group->previous; - from = group ? strbeg + group->strbeg : strbeg; - } - sv = from <= s ? - newSVuv( u8 ? (UV) utf8_length((const U8*)from, (const U8*)s) : (UV) (s-from)) : - newSViv(-(u8 ? (IV) utf8_length((const U8*)s, (const U8*)from) : (IV) (from-s))); - mXPUSHs(sv); - break; - } - case '@' | TYPE_IS_SHRIEKING: - case '@': - s = strbeg + symptr->strbeg; - if (utf8 && !(datumtype & TYPE_IS_SHRIEKING)) - { - while (len > 0) { - if (s >= strend) - Perl_croak(aTHX_ "'@' outside of string in unpack"); - s += UTF8SKIP(s); - len--; - } - if (s > strend) - Perl_croak(aTHX_ "'@' outside of string with malformed UTF-8 in unpack"); - } else { - if (strend-s < len) - Perl_croak(aTHX_ "'@' outside of string in unpack"); - s += len; - } - break; - case 'X' | TYPE_IS_SHRIEKING: - if (!len) /* Avoid division by 0 */ - len = 1; - if (utf8) { - const char *hop, *last; - SSize_t l = len; - hop = last = strbeg; - while (hop < s) { - hop += UTF8SKIP(hop); - if (--l == 0) { - last = hop; - l = len; - } - } - if (last > s) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - s = last; - break; - } - len = (s - strbeg) % len; - /* FALLTHROUGH */ - case 'X': - if (utf8) { - while (len > 0) { - if (s <= strbeg) - Perl_croak(aTHX_ "'X' outside of string in unpack"); - while (--s, UTF8_IS_CONTINUATION(*s)) { - if (s <= strbeg) - Perl_croak(aTHX_ "'X' outside of string in unpack"); - } - len--; - } - } else { - if (len > s - strbeg) - Perl_croak(aTHX_ "'X' outside of string in unpack" ); - s -= len; - } - break; - case 'x' | TYPE_IS_SHRIEKING: { + break; + } + case '.' | TYPE_IS_SHRIEKING: + case '.': { + const char *from; + SV *sv; + const bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING); + if (howlen == e_star) from = strbeg; + else if (len <= 0) from = s; + else { + tempsym_t *group = symptr; + + while (--len && group) group = group->previous; + from = group ? strbeg + group->strbeg : strbeg; + } + sv = from <= s ? + newSVuv( u8 ? (UV) utf8_length((const U8*)from, (const U8*)s) : (UV) (s-from)) : + newSViv(-(u8 ? (IV) utf8_length((const U8*)s, (const U8*)from) : (IV) (from-s))); + mXPUSHs(sv); + break; + } + case '@' | TYPE_IS_SHRIEKING: + case '@': + s = strbeg + symptr->strbeg; + if (utf8 && !(datumtype & TYPE_IS_SHRIEKING)) + { + while (len > 0) { + if (s >= strend) + Perl_croak(aTHX_ "'@' outside of string in unpack"); + s += UTF8SKIP(s); + len--; + } + if (s > strend) + Perl_croak(aTHX_ "'@' outside of string with malformed UTF-8 in unpack"); + } else { + if (strend-s < len) + Perl_croak(aTHX_ "'@' outside of string in unpack"); + s += len; + } + break; + case 'X' | TYPE_IS_SHRIEKING: + if (!len) /* Avoid division by 0 */ + len = 1; + if (utf8) { + const char *hop, *last; + SSize_t l = len; + hop = last = strbeg; + while (hop < s) { + hop += UTF8SKIP(hop); + if (--l == 0) { + last = hop; + l = len; + } + } + if (last > s) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + s = last; + break; + } + len = (s - strbeg) % len; + /* FALLTHROUGH */ + case 'X': + if (utf8) { + while (len > 0) { + if (s <= strbeg) + Perl_croak(aTHX_ "'X' outside of string in unpack"); + while (--s, UTF8_IS_CONTINUATION(*s)) { + if (s <= strbeg) + Perl_croak(aTHX_ "'X' outside of string in unpack"); + } + len--; + } + } else { + if (len > s - strbeg) + Perl_croak(aTHX_ "'X' outside of string in unpack" ); + s -= len; + } + break; + case 'x' | TYPE_IS_SHRIEKING: { SSize_t ai32; - if (!len) /* Avoid division by 0 */ - len = 1; - if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len; - else ai32 = (s - strbeg) % len; - if (ai32 == 0) break; - len -= ai32; - } - /* FALLTHROUGH */ - case 'x': - if (utf8) { - while (len>0) { - if (s >= strend) - Perl_croak(aTHX_ "'x' outside of string in unpack"); - s += UTF8SKIP(s); - len--; - } - } else { - if (len > strend - s) - Perl_croak(aTHX_ "'x' outside of string in unpack"); - s += len; - } - break; - case '/': - Perl_croak(aTHX_ "'/' must follow a numeric type in unpack"); - - case 'A': - case 'Z': - case 'a': - if (checksum) { - /* Preliminary length estimate is assumed done in 'W' */ - if (len > strend - s) len = strend - s; - goto W_checksum; - } - if (utf8) { - SSize_t l; - const char *hop; - for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) { - if (hop >= strend) { - if (hop > strend) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - break; - } - } - if (hop > strend) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - len = hop - s; - } else if (len > strend - s) - len = strend - s; - - if (datumtype == 'Z') { - /* 'Z' strips stuff after first null */ - const char *ptr, *end; - end = s + len; - for (ptr = s; ptr < end; ptr++) if (*ptr == 0) break; - sv = newSVpvn(s, ptr-s); - if (howlen == e_star) /* exact for 'Z*' */ - len = ptr-s + (ptr != strend ? 1 : 0); - } else if (datumtype == 'A') { - /* 'A' strips both nulls and spaces */ - const char *ptr; - if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) { + if (!len) /* Avoid division by 0 */ + len = 1; + if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len; + else ai32 = (s - strbeg) % len; + if (ai32 == 0) break; + len -= ai32; + } + /* FALLTHROUGH */ + case 'x': + if (utf8) { + while (len>0) { + if (s >= strend) + Perl_croak(aTHX_ "'x' outside of string in unpack"); + s += UTF8SKIP(s); + len--; + } + } else { + if (len > strend - s) + Perl_croak(aTHX_ "'x' outside of string in unpack"); + s += len; + } + break; + case '/': + Perl_croak(aTHX_ "'/' must follow a numeric type in unpack"); + + case 'A': + case 'Z': + case 'a': + if (checksum) { + /* Preliminary length estimate is assumed done in 'W' */ + if (len > strend - s) len = strend - s; + goto W_checksum; + } + if (utf8) { + SSize_t l; + const char *hop; + for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) { + if (hop >= strend) { + if (hop > strend) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + break; + } + } + if (hop > strend) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + len = hop - s; + } else if (len > strend - s) + len = strend - s; + + if (datumtype == 'Z') { + /* 'Z' strips stuff after first null */ + const char *ptr, *end; + end = s + len; + for (ptr = s; ptr < end; ptr++) if (*ptr == 0) break; + sv = newSVpvn(s, ptr-s); + if (howlen == e_star) /* exact for 'Z*' */ + len = ptr-s + (ptr != strend ? 1 : 0); + } else if (datumtype == 'A') { + /* 'A' strips both nulls and spaces */ + const char *ptr; + if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) { for (ptr = s+len-1; ptr >= s; ptr--) { if ( *ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) @@ -1096,610 +1096,610 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c break; } } - if (ptr >= s) ptr += UTF8SKIP(ptr); - else ptr++; - if (ptr > s+len) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - } else { - for (ptr = s+len-1; ptr >= s; ptr--) - if (*ptr != 0 && !isSPACE(*ptr)) break; - ptr++; - } - sv = newSVpvn(s, ptr-s); - } else sv = newSVpvn(s, len); - - if (utf8) { - SvUTF8_on(sv); - /* Undo any upgrade done due to need_utf8() */ - if (!(symptr->flags & FLAG_WAS_UTF8)) - sv_utf8_downgrade(sv, 0); - } - mXPUSHs(sv); - s += len; - break; - case 'B': - case 'b': { - char *str; - if (howlen == e_star || len > (strend - s) * 8) - len = (strend - s) * 8; - if (checksum) { - if (utf8) - while (len >= 8 && s < strend) { - cuv += PL_bitcount[utf8_to_byte(aTHX_ &s, strend, datumtype)]; - len -= 8; - } - else - while (len >= 8) { - cuv += PL_bitcount[*(U8 *)s++]; - len -= 8; - } - if (len && s < strend) { - U8 bits; - bits = SHIFT_BYTE(utf8, s, strend, datumtype); - if (datumtype == 'b') - while (len-- > 0) { - if (bits & 1) cuv++; - bits >>= 1; - } - else - while (len-- > 0) { - if (bits & 0x80) cuv++; - bits <<= 1; - } - } - break; - } - - sv = sv_2mortal(newSV(len ? len : 1)); - SvPOK_on(sv); - str = SvPVX(sv); - if (datumtype == 'b') { - U8 bits = 0; - const SSize_t ai32 = len; - for (len = 0; len < ai32; len++) { - if (len & 7) bits >>= 1; - else if (utf8) { - if (s >= strend) break; - bits = utf8_to_byte(aTHX_ &s, strend, datumtype); - } else bits = *(U8 *) s++; - *str++ = bits & 1 ? '1' : '0'; - } - } else { - U8 bits = 0; - const SSize_t ai32 = len; - for (len = 0; len < ai32; len++) { - if (len & 7) bits <<= 1; - else if (utf8) { - if (s >= strend) break; - bits = utf8_to_byte(aTHX_ &s, strend, datumtype); - } else bits = *(U8 *) s++; - *str++ = bits & 0x80 ? '1' : '0'; - } - } - *str = '\0'; - SvCUR_set(sv, str - SvPVX_const(sv)); - XPUSHs(sv); - break; - } - case 'H': - case 'h': { - char *str = NULL; - /* Preliminary length estimate, acceptable for utf8 too */ - if (howlen == e_star || len > (strend - s) * 2) - len = (strend - s) * 2; - if (!checksum) { - sv = sv_2mortal(newSV(len ? len : 1)); - SvPOK_on(sv); - str = SvPVX(sv); - } - if (datumtype == 'h') { - U8 bits = 0; - SSize_t ai32 = len; - for (len = 0; len < ai32; len++) { - if (len & 1) bits >>= 4; - else if (utf8) { - if (s >= strend) break; - bits = utf8_to_byte(aTHX_ &s, strend, datumtype); - } else bits = * (U8 *) s++; - if (!checksum) - *str++ = PL_hexdigit[bits & 15]; - } - } else { - U8 bits = 0; - const SSize_t ai32 = len; - for (len = 0; len < ai32; len++) { - if (len & 1) bits <<= 4; - else if (utf8) { - if (s >= strend) break; - bits = utf8_to_byte(aTHX_ &s, strend, datumtype); - } else bits = *(U8 *) s++; - if (!checksum) - *str++ = PL_hexdigit[(bits >> 4) & 15]; - } - } - if (!checksum) { - *str = '\0'; - SvCUR_set(sv, str - SvPVX_const(sv)); - XPUSHs(sv); - } - break; - } - case 'C': + if (ptr >= s) ptr += UTF8SKIP(ptr); + else ptr++; + if (ptr > s+len) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + } else { + for (ptr = s+len-1; ptr >= s; ptr--) + if (*ptr != 0 && !isSPACE(*ptr)) break; + ptr++; + } + sv = newSVpvn(s, ptr-s); + } else sv = newSVpvn(s, len); + + if (utf8) { + SvUTF8_on(sv); + /* Undo any upgrade done due to need_utf8() */ + if (!(symptr->flags & FLAG_WAS_UTF8)) + sv_utf8_downgrade(sv, 0); + } + mXPUSHs(sv); + s += len; + break; + case 'B': + case 'b': { + char *str; + if (howlen == e_star || len > (strend - s) * 8) + len = (strend - s) * 8; + if (checksum) { + if (utf8) + while (len >= 8 && s < strend) { + cuv += PL_bitcount[utf8_to_byte(aTHX_ &s, strend, datumtype)]; + len -= 8; + } + else + while (len >= 8) { + cuv += PL_bitcount[*(U8 *)s++]; + len -= 8; + } + if (len && s < strend) { + U8 bits; + bits = SHIFT_BYTE(utf8, s, strend, datumtype); + if (datumtype == 'b') + while (len-- > 0) { + if (bits & 1) cuv++; + bits >>= 1; + } + else + while (len-- > 0) { + if (bits & 0x80) cuv++; + bits <<= 1; + } + } + break; + } + + sv = sv_2mortal(newSV(len ? len : 1)); + SvPOK_on(sv); + str = SvPVX(sv); + if (datumtype == 'b') { + U8 bits = 0; + const SSize_t ai32 = len; + for (len = 0; len < ai32; len++) { + if (len & 7) bits >>= 1; + else if (utf8) { + if (s >= strend) break; + bits = utf8_to_byte(aTHX_ &s, strend, datumtype); + } else bits = *(U8 *) s++; + *str++ = bits & 1 ? '1' : '0'; + } + } else { + U8 bits = 0; + const SSize_t ai32 = len; + for (len = 0; len < ai32; len++) { + if (len & 7) bits <<= 1; + else if (utf8) { + if (s >= strend) break; + bits = utf8_to_byte(aTHX_ &s, strend, datumtype); + } else bits = *(U8 *) s++; + *str++ = bits & 0x80 ? '1' : '0'; + } + } + *str = '\0'; + SvCUR_set(sv, str - SvPVX_const(sv)); + XPUSHs(sv); + break; + } + case 'H': + case 'h': { + char *str = NULL; + /* Preliminary length estimate, acceptable for utf8 too */ + if (howlen == e_star || len > (strend - s) * 2) + len = (strend - s) * 2; + if (!checksum) { + sv = sv_2mortal(newSV(len ? len : 1)); + SvPOK_on(sv); + str = SvPVX(sv); + } + if (datumtype == 'h') { + U8 bits = 0; + SSize_t ai32 = len; + for (len = 0; len < ai32; len++) { + if (len & 1) bits >>= 4; + else if (utf8) { + if (s >= strend) break; + bits = utf8_to_byte(aTHX_ &s, strend, datumtype); + } else bits = * (U8 *) s++; + if (!checksum) + *str++ = PL_hexdigit[bits & 15]; + } + } else { + U8 bits = 0; + const SSize_t ai32 = len; + for (len = 0; len < ai32; len++) { + if (len & 1) bits <<= 4; + else if (utf8) { + if (s >= strend) break; + bits = utf8_to_byte(aTHX_ &s, strend, datumtype); + } else bits = *(U8 *) s++; + if (!checksum) + *str++ = PL_hexdigit[(bits >> 4) & 15]; + } + } + if (!checksum) { + *str = '\0'; + SvCUR_set(sv, str - SvPVX_const(sv)); + XPUSHs(sv); + } + break; + } + case 'C': if (len == 0) { if (explicit_length) - /* Switch to "character" mode */ - utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0; - break; - } - /* FALLTHROUGH */ - case 'c': - while (len-- > 0 && s < strend) { - int aint; - if (utf8) - { - STRLEN retlen; - aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); - if (retlen == (STRLEN) -1) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - s += retlen; - } - else - aint = *(U8 *)(s)++; - if (aint >= 128 && datumtype != 'C') /* fake up signed chars */ - aint -= 256; - if (!checksum) - mPUSHi(aint); - else if (checksum > bits_in_uv) - cdouble += (NV)aint; - else - cuv += aint; - } - break; - case 'W': - W_checksum: - if (utf8) { - while (len-- > 0 && s < strend) { - STRLEN retlen; - const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen, - ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); - if (retlen == (STRLEN) -1) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - s += retlen; - if (!checksum) - mPUSHu(val); - else if (checksum > bits_in_uv) - cdouble += (NV) val; - else - cuv += val; - } - } else if (!checksum) - while (len-- > 0) { - const U8 ch = *(U8 *) s++; - mPUSHu(ch); - } - else if (checksum > bits_in_uv) - while (len-- > 0) cdouble += (NV) *(U8 *) s++; - else - while (len-- > 0) cuv += *(U8 *) s++; - break; - case 'U': - if (len == 0) { + /* Switch to "character" mode */ + utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0; + break; + } + /* FALLTHROUGH */ + case 'c': + while (len-- > 0 && s < strend) { + int aint; + if (utf8) + { + STRLEN retlen; + aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen, + ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + if (retlen == (STRLEN) -1) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + s += retlen; + } + else + aint = *(U8 *)(s)++; + if (aint >= 128 && datumtype != 'C') /* fake up signed chars */ + aint -= 256; + if (!checksum) + mPUSHi(aint); + else if (checksum > bits_in_uv) + cdouble += (NV)aint; + else + cuv += aint; + } + break; + case 'W': + W_checksum: + if (utf8) { + while (len-- > 0 && s < strend) { + STRLEN retlen; + const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen, + ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY); + if (retlen == (STRLEN) -1) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + s += retlen; + if (!checksum) + mPUSHu(val); + else if (checksum > bits_in_uv) + cdouble += (NV) val; + else + cuv += val; + } + } else if (!checksum) + while (len-- > 0) { + const U8 ch = *(U8 *) s++; + mPUSHu(ch); + } + else if (checksum > bits_in_uv) + while (len-- > 0) cdouble += (NV) *(U8 *) s++; + else + while (len-- > 0) cuv += *(U8 *) s++; + break; + case 'U': + if (len == 0) { if (explicit_length && howlen != e_star) { - /* Switch to "bytes in UTF-8" mode */ - if (symptr->flags & FLAG_DO_UTF8) utf8 = 0; - else - /* Should be impossible due to the need_utf8() test */ - Perl_croak(aTHX_ "U0 mode on a byte string"); - } - break; - } - if (len > strend - s) len = strend - s; - if (!checksum) { - if (len && unpack_only_one) len = 1; - EXTEND(SP, len); - EXTEND_MORTAL(len); - } - while (len-- > 0 && s < strend) { - STRLEN retlen; - UV auv; - if (utf8) { - U8 result[UTF8_MAXLEN+1]; - const char *ptr = s; - STRLEN len; - /* Bug: warns about bad utf8 even if we are short on bytes - and will break out of the loop */ - if (!S_utf8_to_bytes(aTHX_ &ptr, strend, (char *) result, 1, - 'U')) - break; - len = UTF8SKIP(result); - if (!S_utf8_to_bytes(aTHX_ &ptr, strend, - (char *) &result[1], len-1, 'U')) break; - auv = NATIVE_TO_UNI(utf8n_to_uvchr(result, + /* Switch to "bytes in UTF-8" mode */ + if (symptr->flags & FLAG_DO_UTF8) utf8 = 0; + else + /* Should be impossible due to the need_utf8() test */ + Perl_croak(aTHX_ "U0 mode on a byte string"); + } + break; + } + if (len > strend - s) len = strend - s; + if (!checksum) { + if (len && unpack_only_one) len = 1; + EXTEND(SP, len); + EXTEND_MORTAL(len); + } + while (len-- > 0 && s < strend) { + STRLEN retlen; + UV auv; + if (utf8) { + U8 result[UTF8_MAXLEN+1]; + const char *ptr = s; + STRLEN len; + /* Bug: warns about bad utf8 even if we are short on bytes + and will break out of the loop */ + if (!S_utf8_to_bytes(aTHX_ &ptr, strend, (char *) result, 1, + 'U')) + break; + len = UTF8SKIP(result); + if (!S_utf8_to_bytes(aTHX_ &ptr, strend, + (char *) &result[1], len-1, 'U')) break; + auv = NATIVE_TO_UNI(utf8n_to_uvchr(result, len, &retlen, UTF8_ALLOW_DEFAULT)); - s = ptr; - } else { - auv = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, + s = ptr; + } else { + auv = NATIVE_TO_UNI(utf8n_to_uvchr((U8*)s, strend - s, &retlen, UTF8_ALLOW_DEFAULT)); - if (retlen == (STRLEN) -1) - Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); - s += retlen; - } - if (!checksum) - mPUSHu(auv); - else if (checksum > bits_in_uv) - cdouble += (NV) auv; - else - cuv += auv; - } - break; - case 's' | TYPE_IS_SHRIEKING: + if (retlen == (STRLEN) -1) + Perl_croak(aTHX_ "Malformed UTF-8 string in unpack"); + s += retlen; + } + if (!checksum) + mPUSHu(auv); + else if (checksum > bits_in_uv) + cdouble += (NV) auv; + else + cuv += auv; + } + break; + case 's' | TYPE_IS_SHRIEKING: #if SHORTSIZE != SIZE16 - while (len-- > 0) { - short ashort; + while (len-- > 0) { + short ashort; SHIFT_VAR(utf8, s, strend, ashort, datumtype, needs_swap); - if (!checksum) - mPUSHi(ashort); - else if (checksum > bits_in_uv) - cdouble += (NV)ashort; - else - cuv += ashort; - } - break; + if (!checksum) + mPUSHi(ashort); + else if (checksum > bits_in_uv) + cdouble += (NV)ashort; + else + cuv += ashort; + } + break; #else - /* FALLTHROUGH */ + /* FALLTHROUGH */ #endif - case 's': - while (len-- > 0) { - I16 ai16; + case 's': + while (len-- > 0) { + I16 ai16; #if U16SIZE > SIZE16 - ai16 = 0; + ai16 = 0; #endif SHIFT16(utf8, s, strend, &ai16, datumtype, needs_swap); #if U16SIZE > SIZE16 - if (ai16 > 32767) - ai16 -= 65536; + if (ai16 > 32767) + ai16 -= 65536; #endif - if (!checksum) - mPUSHi(ai16); - else if (checksum > bits_in_uv) - cdouble += (NV)ai16; - else - cuv += ai16; - } - break; - case 'S' | TYPE_IS_SHRIEKING: + if (!checksum) + mPUSHi(ai16); + else if (checksum > bits_in_uv) + cdouble += (NV)ai16; + else + cuv += ai16; + } + break; + case 'S' | TYPE_IS_SHRIEKING: #if SHORTSIZE != SIZE16 - while (len-- > 0) { - unsigned short aushort; - SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap); - if (!checksum) - mPUSHu(aushort); - else if (checksum > bits_in_uv) - cdouble += (NV)aushort; - else - cuv += aushort; - } - break; + while (len-- > 0) { + unsigned short aushort; + SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap); + if (!checksum) + mPUSHu(aushort); + else if (checksum > bits_in_uv) + cdouble += (NV)aushort; + else + cuv += aushort; + } + break; #else /* FALLTHROUGH */ #endif - case 'v': - case 'n': - case 'S': - while (len-- > 0) { - U16 au16; + case 'v': + case 'n': + case 'S': + while (len-- > 0) { + U16 au16; #if U16SIZE > SIZE16 - au16 = 0; + au16 = 0; #endif SHIFT16(utf8, s, strend, &au16, datumtype, needs_swap); - if (datumtype == 'n') - au16 = PerlSock_ntohs(au16); - if (datumtype == 'v') - au16 = vtohs(au16); - if (!checksum) - mPUSHu(au16); - else if (checksum > bits_in_uv) - cdouble += (NV) au16; - else - cuv += au16; - } - break; - case 'v' | TYPE_IS_SHRIEKING: - case 'n' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - I16 ai16; + if (datumtype == 'n') + au16 = PerlSock_ntohs(au16); + if (datumtype == 'v') + au16 = vtohs(au16); + if (!checksum) + mPUSHu(au16); + else if (checksum > bits_in_uv) + cdouble += (NV) au16; + else + cuv += au16; + } + break; + case 'v' | TYPE_IS_SHRIEKING: + case 'n' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + I16 ai16; # if U16SIZE > SIZE16 - ai16 = 0; + ai16 = 0; # endif SHIFT16(utf8, s, strend, &ai16, datumtype, needs_swap); /* There should never be any byte-swapping here. */ assert(!TYPE_ENDIANNESS(datumtype)); - if (datumtype == ('n' | TYPE_IS_SHRIEKING)) - ai16 = (I16) PerlSock_ntohs((U16) ai16); - if (datumtype == ('v' | TYPE_IS_SHRIEKING)) - ai16 = (I16) vtohs((U16) ai16); - if (!checksum) - mPUSHi(ai16); - else if (checksum > bits_in_uv) - cdouble += (NV) ai16; - else - cuv += ai16; - } - break; - case 'i': - case 'i' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - int aint; + if (datumtype == ('n' | TYPE_IS_SHRIEKING)) + ai16 = (I16) PerlSock_ntohs((U16) ai16); + if (datumtype == ('v' | TYPE_IS_SHRIEKING)) + ai16 = (I16) vtohs((U16) ai16); + if (!checksum) + mPUSHi(ai16); + else if (checksum > bits_in_uv) + cdouble += (NV) ai16; + else + cuv += ai16; + } + break; + case 'i': + case 'i' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + int aint; SHIFT_VAR(utf8, s, strend, aint, datumtype, needs_swap); - if (!checksum) - mPUSHi(aint); - else if (checksum > bits_in_uv) - cdouble += (NV)aint; - else - cuv += aint; - } - break; - case 'I': - case 'I' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - unsigned int auint; + if (!checksum) + mPUSHi(aint); + else if (checksum > bits_in_uv) + cdouble += (NV)aint; + else + cuv += aint; + } + break; + case 'I': + case 'I' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + unsigned int auint; SHIFT_VAR(utf8, s, strend, auint, datumtype, needs_swap); - if (!checksum) - mPUSHu(auint); - else if (checksum > bits_in_uv) - cdouble += (NV)auint; - else - cuv += auint; - } - break; - case 'j': - while (len-- > 0) { - IV aiv; + if (!checksum) + mPUSHu(auint); + else if (checksum > bits_in_uv) + cdouble += (NV)auint; + else + cuv += auint; + } + break; + case 'j': + while (len-- > 0) { + IV aiv; SHIFT_VAR(utf8, s, strend, aiv, datumtype, needs_swap); - if (!checksum) - mPUSHi(aiv); - else if (checksum > bits_in_uv) - cdouble += (NV)aiv; - else - cuv += aiv; - } - break; - case 'J': - while (len-- > 0) { - UV auv; + if (!checksum) + mPUSHi(aiv); + else if (checksum > bits_in_uv) + cdouble += (NV)aiv; + else + cuv += aiv; + } + break; + case 'J': + while (len-- > 0) { + UV auv; SHIFT_VAR(utf8, s, strend, auv, datumtype, needs_swap); - if (!checksum) - mPUSHu(auv); - else if (checksum > bits_in_uv) - cdouble += (NV)auv; - else - cuv += auv; - } - break; - case 'l' | TYPE_IS_SHRIEKING: + if (!checksum) + mPUSHu(auv); + else if (checksum > bits_in_uv) + cdouble += (NV)auv; + else + cuv += auv; + } + break; + case 'l' | TYPE_IS_SHRIEKING: #if LONGSIZE != SIZE32 - while (len-- > 0) { - long along; + while (len-- > 0) { + long along; SHIFT_VAR(utf8, s, strend, along, datumtype, needs_swap); - if (!checksum) - mPUSHi(along); - else if (checksum > bits_in_uv) - cdouble += (NV)along; - else - cuv += along; - } - break; + if (!checksum) + mPUSHi(along); + else if (checksum > bits_in_uv) + cdouble += (NV)along; + else + cuv += along; + } + break; #else - /* FALLTHROUGH */ + /* FALLTHROUGH */ #endif - case 'l': - while (len-- > 0) { - I32 ai32; + case 'l': + while (len-- > 0) { + I32 ai32; #if U32SIZE > SIZE32 - ai32 = 0; + ai32 = 0; #endif SHIFT32(utf8, s, strend, &ai32, datumtype, needs_swap); #if U32SIZE > SIZE32 - if (ai32 > 2147483647) ai32 -= 4294967296; + if (ai32 > 2147483647) ai32 -= 4294967296; #endif - if (!checksum) - mPUSHi(ai32); - else if (checksum > bits_in_uv) - cdouble += (NV)ai32; - else - cuv += ai32; - } - break; - case 'L' | TYPE_IS_SHRIEKING: + if (!checksum) + mPUSHi(ai32); + else if (checksum > bits_in_uv) + cdouble += (NV)ai32; + else + cuv += ai32; + } + break; + case 'L' | TYPE_IS_SHRIEKING: #if LONGSIZE != SIZE32 - while (len-- > 0) { - unsigned long aulong; + while (len-- > 0) { + unsigned long aulong; SHIFT_VAR(utf8, s, strend, aulong, datumtype, needs_swap); - if (!checksum) - mPUSHu(aulong); - else if (checksum > bits_in_uv) - cdouble += (NV)aulong; - else - cuv += aulong; - } - break; + if (!checksum) + mPUSHu(aulong); + else if (checksum > bits_in_uv) + cdouble += (NV)aulong; + else + cuv += aulong; + } + break; #else /* FALLTHROUGH */ #endif - case 'V': - case 'N': - case 'L': - while (len-- > 0) { - U32 au32; + case 'V': + case 'N': + case 'L': + while (len-- > 0) { + U32 au32; #if U32SIZE > SIZE32 - au32 = 0; + au32 = 0; #endif SHIFT32(utf8, s, strend, &au32, datumtype, needs_swap); - if (datumtype == 'N') - au32 = PerlSock_ntohl(au32); - if (datumtype == 'V') - au32 = vtohl(au32); - if (!checksum) - mPUSHu(au32); - else if (checksum > bits_in_uv) - cdouble += (NV)au32; - else - cuv += au32; - } - break; - case 'V' | TYPE_IS_SHRIEKING: - case 'N' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - I32 ai32; + if (datumtype == 'N') + au32 = PerlSock_ntohl(au32); + if (datumtype == 'V') + au32 = vtohl(au32); + if (!checksum) + mPUSHu(au32); + else if (checksum > bits_in_uv) + cdouble += (NV)au32; + else + cuv += au32; + } + break; + case 'V' | TYPE_IS_SHRIEKING: + case 'N' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + I32 ai32; #if U32SIZE > SIZE32 - ai32 = 0; + ai32 = 0; #endif SHIFT32(utf8, s, strend, &ai32, datumtype, needs_swap); /* There should never be any byte swapping here. */ assert(!TYPE_ENDIANNESS(datumtype)); - if (datumtype == ('N' | TYPE_IS_SHRIEKING)) - ai32 = (I32)PerlSock_ntohl((U32)ai32); - if (datumtype == ('V' | TYPE_IS_SHRIEKING)) - ai32 = (I32)vtohl((U32)ai32); - if (!checksum) - mPUSHi(ai32); - else if (checksum > bits_in_uv) - cdouble += (NV)ai32; - else - cuv += ai32; - } - break; - case 'p': - while (len-- > 0) { - const char *aptr; + if (datumtype == ('N' | TYPE_IS_SHRIEKING)) + ai32 = (I32)PerlSock_ntohl((U32)ai32); + if (datumtype == ('V' | TYPE_IS_SHRIEKING)) + ai32 = (I32)vtohl((U32)ai32); + if (!checksum) + mPUSHi(ai32); + else if (checksum > bits_in_uv) + cdouble += (NV)ai32; + else + cuv += ai32; + } + break; + case 'p': + while (len-- > 0) { + const char *aptr; SHIFT_VAR(utf8, s, strend, aptr, datumtype, needs_swap); - /* newSVpv generates undef if aptr is NULL */ - mPUSHs(newSVpv(aptr, 0)); - } - break; - case 'w': - { - UV auv = 0; - size_t bytes = 0; - - while (len > 0 && s < strend) { - U8 ch; - ch = SHIFT_BYTE(utf8, s, strend, datumtype); - auv = (auv << 7) | (ch & 0x7f); + /* newSVpv generates undef if aptr is NULL */ + mPUSHs(newSVpv(aptr, 0)); + } + break; + case 'w': + { + UV auv = 0; + size_t bytes = 0; + + while (len > 0 && s < strend) { + U8 ch; + ch = SHIFT_BYTE(utf8, s, strend, datumtype); + auv = (auv << 7) | (ch & 0x7f); /* UTF8_IS_XXXXX not right here because this is a BER, not * UTF-8 format - using constant 0x80 */ - if (ch < 0x80) { - bytes = 0; - mPUSHu(auv); - len--; - auv = 0; - continue; - } - if (++bytes >= sizeof(UV)) { /* promote to string */ - const char *t; - - sv = Perl_newSVpvf(aTHX_ "%.*" UVuf, + if (ch < 0x80) { + bytes = 0; + mPUSHu(auv); + len--; + auv = 0; + continue; + } + if (++bytes >= sizeof(UV)) { /* promote to string */ + const char *t; + + sv = Perl_newSVpvf(aTHX_ "%.*" UVuf, (int)TYPE_DIGITS(UV), auv); - while (s < strend) { - ch = SHIFT_BYTE(utf8, s, strend, datumtype); - sv = mul128(sv, (U8)(ch & 0x7f)); - if (!(ch & 0x80)) { - bytes = 0; - break; - } - } - t = SvPV_nolen_const(sv); - while (*t == '0') - t++; - sv_chop(sv, t); - mPUSHs(sv); - len--; - auv = 0; - } - } - if ((s >= strend) && bytes) - Perl_croak(aTHX_ "Unterminated compressed integer in unpack"); - } - break; - case 'P': - if (symptr->howlen == e_star) - Perl_croak(aTHX_ "'P' must have an explicit size in unpack"); - EXTEND(SP, 1); - if (s + sizeof(char*) <= strend) { - char *aptr; + while (s < strend) { + ch = SHIFT_BYTE(utf8, s, strend, datumtype); + sv = mul128(sv, (U8)(ch & 0x7f)); + if (!(ch & 0x80)) { + bytes = 0; + break; + } + } + t = SvPV_nolen_const(sv); + while (*t == '0') + t++; + sv_chop(sv, t); + mPUSHs(sv); + len--; + auv = 0; + } + } + if ((s >= strend) && bytes) + Perl_croak(aTHX_ "Unterminated compressed integer in unpack"); + } + break; + case 'P': + if (symptr->howlen == e_star) + Perl_croak(aTHX_ "'P' must have an explicit size in unpack"); + EXTEND(SP, 1); + if (s + sizeof(char*) <= strend) { + char *aptr; SHIFT_VAR(utf8, s, strend, aptr, datumtype, needs_swap); - /* newSVpvn generates undef if aptr is NULL */ - PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP)); - } - break; + /* newSVpvn generates undef if aptr is NULL */ + PUSHs(newSVpvn_flags(aptr, len, SVs_TEMP)); + } + break; #if defined(HAS_QUAD) && IVSIZE >= 8 - case 'q': - while (len-- > 0) { - Quad_t aquad; + case 'q': + while (len-- > 0) { + Quad_t aquad; SHIFT_VAR(utf8, s, strend, aquad, datumtype, needs_swap); - if (!checksum) + if (!checksum) mPUSHs(newSViv((IV)aquad)); - else if (checksum > bits_in_uv) - cdouble += (NV)aquad; - else - cuv += aquad; - } - break; - case 'Q': - while (len-- > 0) { - Uquad_t auquad; + else if (checksum > bits_in_uv) + cdouble += (NV)aquad; + else + cuv += aquad; + } + break; + case 'Q': + while (len-- > 0) { + Uquad_t auquad; SHIFT_VAR(utf8, s, strend, auquad, datumtype, needs_swap); - if (!checksum) - mPUSHs(newSVuv((UV)auquad)); - else if (checksum > bits_in_uv) - cdouble += (NV)auquad; - else - cuv += auquad; - } - break; + if (!checksum) + mPUSHs(newSVuv((UV)auquad)); + else if (checksum > bits_in_uv) + cdouble += (NV)auquad; + else + cuv += auquad; + } + break; #endif - /* float and double added gnb@melba.bby.oz.au 22/11/89 */ - case 'f': - while (len-- > 0) { - float afloat; + /* float and double added gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + while (len-- > 0) { + float afloat; SHIFT_VAR(utf8, s, strend, afloat, datumtype, needs_swap); - if (!checksum) - mPUSHn(afloat); - else - cdouble += afloat; - } - break; - case 'd': - while (len-- > 0) { - double adouble; + if (!checksum) + mPUSHn(afloat); + else + cdouble += afloat; + } + break; + case 'd': + while (len-- > 0) { + double adouble; SHIFT_VAR(utf8, s, strend, adouble, datumtype, needs_swap); - if (!checksum) - mPUSHn(adouble); - else - cdouble += adouble; - } - break; - case 'F': - while (len-- > 0) { - NV_bytes anv; + if (!checksum) + mPUSHn(adouble); + else + cdouble += adouble; + } + break; + case 'F': + while (len-- > 0) { + NV_bytes anv; SHIFT_BYTES(utf8, s, strend, anv.bytes, sizeof(anv.bytes), datumtype, needs_swap); - if (!checksum) - mPUSHn(anv.nv); - else - cdouble += anv.nv; - } - break; + if (!checksum) + mPUSHn(anv.nv); + else + cdouble += anv.nv; + } + break; #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) - case 'D': - while (len-- > 0) { - ld_bytes aldouble; + case 'D': + while (len-- > 0) { + ld_bytes aldouble; SHIFT_BYTES(utf8, s, strend, aldouble.bytes, sizeof(aldouble.bytes), datumtype, needs_swap); /* The most common long double format, the x86 80-bit @@ -1714,22 +1714,22 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c * Note that trying to unpack 'long doubles' of 'long * doubles' packed in another system is in the general * case doomed without having more detail. */ - if (!checksum) - mPUSHn(aldouble.ld); - else - cdouble += aldouble.ld; - } - break; + if (!checksum) + mPUSHn(aldouble.ld); + else + cdouble += aldouble.ld; + } + break; #endif - case 'u': - if (!checksum) { + case 'u': + if (!checksum) { const STRLEN l = (STRLEN) (strend - s) * 3 / 4; - sv = sv_2mortal(newSV(l)); - if (l) { + sv = sv_2mortal(newSV(l)); + if (l) { SvPOK_on(sv); *SvEND(sv) = '\0'; } - } + } /* Note that all legal uuencoded strings are ASCII printables, so * have the same representation under UTF-8 vs not. This means we @@ -1772,25 +1772,25 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c if (s + 1 < strend && s[1] == '\n') s += 2; } - if (!checksum) - XPUSHs(sv); - break; - } /* End of switch */ + if (!checksum) + XPUSHs(sv); + break; + } /* End of switch */ - if (checksum) { - if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) || - (checksum > bits_in_uv && - memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) { - NV trouble, anv; + if (checksum) { + if (memCHRs("fFdD", TYPE_NO_MODIFIERS(datumtype)) || + (checksum > bits_in_uv && + memCHRs("cCsSiIlLnNUWvVqQjJ", TYPE_NO_MODIFIERS(datumtype))) ) { + NV trouble, anv; anv = (NV) (1 << (checksum & 15)); - while (checksum >= 16) { - checksum -= 16; - anv *= 65536.0; - } - while (cdouble < 0.0) - cdouble += anv; - cdouble = Perl_modf(cdouble / anv, &trouble); + while (checksum >= 16) { + checksum -= 16; + anv *= 65536.0; + } + while (cdouble < 0.0) + cdouble += anv; + cdouble = Perl_modf(cdouble / anv, &trouble); #ifdef LONGDOUBLE_DOUBLEDOUBLE /* Workaround for powerpc doubledouble modfl bug: * close to 1.0L and -1.0L cdouble is 0, and trouble @@ -1802,45 +1802,45 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c } #endif cdouble *= anv; - sv = newSVnv(cdouble); - } - else { - if (checksum < bits_in_uv) { - UV mask = nBIT_MASK(checksum); - cuv &= mask; - } - sv = newSVuv(cuv); - } - mXPUSHs(sv); - checksum = 0; - } + sv = newSVnv(cdouble); + } + else { + if (checksum < bits_in_uv) { + UV mask = nBIT_MASK(checksum); + cuv &= mask; + } + sv = newSVuv(cuv); + } + mXPUSHs(sv); + checksum = 0; + } if (symptr->flags & FLAG_SLASH){ if (SP - PL_stack_base - start_sp_offset <= 0) - break; + break; if( next_symbol(symptr) ){ if( symptr->howlen == e_number ) - Perl_croak(aTHX_ "Count after length/code in unpack" ); + Perl_croak(aTHX_ "Count after length/code in unpack" ); if( beyond ){ - /* ...end of char buffer then no decent length available */ - Perl_croak(aTHX_ "length/code after end of string in unpack" ); + /* ...end of char buffer then no decent length available */ + Perl_croak(aTHX_ "length/code after end of string in unpack" ); } else { - /* take top of stack (hope it's numeric) */ + /* take top of stack (hope it's numeric) */ len = POPi; if( len < 0 ) Perl_croak(aTHX_ "Negative '/' count in unpack" ); } } else { - Perl_croak(aTHX_ "Code missing after '/' in unpack" ); + Perl_croak(aTHX_ "Code missing after '/' in unpack" ); } datumtype = symptr->code; explicit_length = FALSE; - goto redo_switch; + goto redo_switch; } } if (new_s) - *new_s = s; + *new_s = s; PUTBACK; return SP - PL_stack_base - start_sp_offset; } @@ -1860,8 +1860,8 @@ PP(pp_unpack) PUTBACK; cnt = unpackstring(pat, patend, s, strend, - ((gimme == G_SCALAR) ? FLAG_UNPACK_ONLY_ONE : 0) - | (DO_UTF8(right) ? FLAG_DO_UTF8 : 0)); + ((gimme == G_SCALAR) ? FLAG_UNPACK_ONLY_ONE : 0) + | (DO_UTF8(right) ? FLAG_DO_UTF8 : 0)); SPAGAIN; if ( !cnt && gimme == G_SCALAR ) @@ -1874,19 +1874,19 @@ doencodes(U8 *h, const U8 *s, SSize_t len) { *h++ = PL_uuemap[len]; while (len > 2) { - *h++ = PL_uuemap[(077 & (s[0] >> 2))]; - *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((s[1] >> 4) & 017)))]; - *h++ = PL_uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; - *h++ = PL_uuemap[(077 & (s[2] & 077))]; - s += 3; - len -= 3; + *h++ = PL_uuemap[(077 & (s[0] >> 2))]; + *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((s[1] >> 4) & 017)))]; + *h++ = PL_uuemap[(077 & (((s[1] << 2) & 074) | ((s[2] >> 6) & 03)))]; + *h++ = PL_uuemap[(077 & (s[2] & 077))]; + s += 3; + len -= 3; } if (len > 0) { const U8 r = (len > 1 ? s[1] : '\0'); - *h++ = PL_uuemap[(077 & (s[0] >> 2))]; - *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((r >> 4) & 017)))]; - *h++ = PL_uuemap[(077 & ((r << 2) & 074))]; - *h++ = PL_uuemap[0]; + *h++ = PL_uuemap[(077 & (s[0] >> 2))]; + *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((r >> 4) & 017)))]; + *h++ = PL_uuemap[(077 & ((r << 2) & 074))]; + *h++ = PL_uuemap[0]; } *h++ = '\n'; return h; @@ -1909,8 +1909,8 @@ S_is_an_int(pTHX_ const char *s, STRLEN l) break; case '+': if (!skip) { - SvREFCNT_dec(result); - return (NULL); + SvREFCNT_dec(result); + return (NULL); } break; case '0': @@ -1925,7 +1925,7 @@ S_is_an_int(pTHX_ const char *s, STRLEN l) case '9': skip = 0; if (!ignore) { - *(out++) = *s; + *(out++) = *s; } break; case '.': @@ -1955,13 +1955,13 @@ S_div128(pTHX_ SV *pnum, bool *done) *done = 1; while (*t) { - const int i = m * 10 + (*t - '0'); - const int r = (i >> 7); /* r < 10 */ - m = i & 0x7F; - if (r) { - *done = 0; - } - *(t++) = '0' + r; + const int i = m * 10 + (*t - '0'); + const int r = (i >> 7); /* r < 10 */ + m = i & 0x7F; + if (r) { + *done = 0; + } + *(t++) = '0' + r; } *(t++) = '\0'; SvCUR_set(pnum, (STRLEN) (t - s)); @@ -1989,7 +1989,7 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, Also make sure any UTF8 flag is loaded */ SvPV_force_nolen(cat); if (DO_UTF8(cat)) - sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8; + sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8; (void)pack_rec( cat, &sym, beglist, endlist ); } @@ -2007,11 +2007,11 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) { from_start = SvPVX_const(sv); from_end = from_start + SvCUR(sv); for (from_ptr = from_start; from_ptr < from_end; from_ptr++) - if (!NATIVE_BYTE_IS_INVARIANT(*from_ptr)) break; + if (!NATIVE_BYTE_IS_INVARIANT(*from_ptr)) break; if (from_ptr == from_end) { - /* Simple case: no character needs to be changed */ - SvUTF8_on(sv); - return; + /* Simple case: no character needs to be changed */ + SvUTF8_on(sv); + return; } len = (from_end-from_ptr)*UTF8_EXPAND+(from_ptr-from_start)+1; @@ -2021,38 +2021,38 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) { Newx(marks, sym_ptr->level+2, const char *); for (group=sym_ptr; group; group = group->previous) - marks[group->level] = from_start + group->strbeg; + marks[group->level] = from_start + group->strbeg; marks[sym_ptr->level+1] = from_end+1; for (m = marks; *m < from_ptr; m++) - *m = to_start + (*m-from_start); + *m = to_start + (*m-from_start); for (;from_ptr < from_end; from_ptr++) { - while (*m == from_ptr) *m++ = to_ptr; - to_ptr = (char *) uvchr_to_utf8((U8 *) to_ptr, *(U8 *) from_ptr); + while (*m == from_ptr) *m++ = to_ptr; + to_ptr = (char *) uvchr_to_utf8((U8 *) to_ptr, *(U8 *) from_ptr); } *to_ptr = 0; while (*m == from_ptr) *m++ = to_ptr; if (m != marks + sym_ptr->level+1) { - Safefree(marks); - Safefree(to_start); - Perl_croak(aTHX_ "panic: marks beyond string end, m=%p, marks=%p, " - "level=%d", m, marks, sym_ptr->level); + Safefree(marks); + Safefree(to_start); + Perl_croak(aTHX_ "panic: marks beyond string end, m=%p, marks=%p, " + "level=%d", m, marks, sym_ptr->level); } for (group=sym_ptr; group; group = group->previous) - group->strbeg = marks[group->level] - to_start; + group->strbeg = marks[group->level] - to_start; Safefree(marks); if (SvOOK(sv)) { - if (SvIVX(sv)) { - SvLEN_set(sv, SvLEN(sv) + SvIVX(sv)); - from_start -= SvIVX(sv); - SvIV_set(sv, 0); - } - SvFLAGS(sv) &= ~SVf_OOK; + if (SvIVX(sv)) { + SvLEN_set(sv, SvLEN(sv) + SvIVX(sv)); + from_start -= SvIVX(sv); + SvIV_set(sv, 0); + } + SvFLAGS(sv) &= ~SVf_OOK; } if (SvLEN(sv) != 0) - Safefree(from_start); + Safefree(from_start); SvPV_set(sv, to_start); SvCUR_set(sv, to_ptr - to_start); SvLEN_set(sv, len); @@ -2081,22 +2081,22 @@ S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype) { SvGETMAGIC(sv); if (UNLIKELY(SvAMAGIC(sv))) - sv = sv_2num(sv); + sv = sv_2num(sv); if (UNLIKELY(isinfnansv(sv))) { - const I32 c = TYPE_NO_MODIFIERS(datumtype); - const NV nv = SvNV_nomg(sv); - if (c == 'w') - Perl_croak(aTHX_ "Cannot compress %" NVgf " in pack", nv); - else - Perl_croak(aTHX_ "Cannot pack %" NVgf " with '%c'", nv, (int) c); + const I32 c = TYPE_NO_MODIFIERS(datumtype); + const NV nv = SvNV_nomg(sv); + if (c == 'w') + Perl_croak(aTHX_ "Cannot compress %" NVgf " in pack", nv); + else + Perl_croak(aTHX_ "Cannot pack %" NVgf " with '%c'", nv, (int) c); } return sv; } #define SvIV_no_inf(sv,d) \ - ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvIV_nomg(sv)) + ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvIV_nomg(sv)) #define SvUV_no_inf(sv,d) \ - ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvUV_nomg(sv)) + ((sv) = S_sv_check_infnan(aTHX_ sv,d), SvUV_nomg(sv)) STATIC SV ** @@ -2112,640 +2112,640 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) PERL_ARGS_ASSERT_PACK_REC; if (symptr->level == 0 && found && symptr->code == 'U') { - marked_upgrade(aTHX_ cat, symptr); - symptr->flags |= FLAG_DO_UTF8; - utf8 = 0; + marked_upgrade(aTHX_ cat, symptr); + symptr->flags |= FLAG_DO_UTF8; + utf8 = 0; } symptr->strbeg = SvCUR(cat); while (found) { - SV *fromstr; - STRLEN fromlen; - SSize_t len; - SV *lengthcode = NULL; + SV *fromstr; + STRLEN fromlen; + SSize_t len; + SV *lengthcode = NULL; I32 datumtype = symptr->code; howlen_t howlen = symptr->howlen; - char *start = SvPVX(cat); - char *cur = start + SvCUR(cat); + char *start = SvPVX(cat); + char *cur = start + SvCUR(cat); bool needs_swap; #define NEXTFROM (lengthcode ? lengthcode : items > 0 ? (--items, *beglist++) : &PL_sv_no) #define PEEKFROM (lengthcode ? lengthcode : items > 0 ? *beglist : &PL_sv_no) switch (howlen) { - case e_star: - len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ? - 0 : items; - break; - default: - /* e_no_len and e_number */ - len = symptr->length; - break; + case e_star: + len = memCHRs("@Xxu", TYPE_NO_MODIFIERS(datumtype)) ? + 0 : items; + break; + default: + /* e_no_len and e_number */ + len = symptr->length; + break; } - if (len) { - packprops_t props = packprops[TYPE_NO_ENDIANNESS(datumtype)]; + if (len) { + packprops_t props = packprops[TYPE_NO_ENDIANNESS(datumtype)]; - if (props && !(props & PACK_SIZE_UNPREDICTABLE)) { - /* We can process this letter. */ - STRLEN size = props & PACK_SIZE_MASK; - GROWING2(utf8, cat, start, cur, size, (STRLEN)len); - } + if (props && !(props & PACK_SIZE_UNPREDICTABLE)) { + /* We can process this letter. */ + STRLEN size = props & PACK_SIZE_MASK; + GROWING2(utf8, cat, start, cur, size, (STRLEN)len); + } } /* Look ahead for next symbol. Do we have code/code? */ lookahead = *symptr; found = next_symbol(&lookahead); - if (symptr->flags & FLAG_SLASH) { - IV count; - if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack"); - if (memCHRs("aAZ", lookahead.code)) { - if (lookahead.howlen == e_number) count = lookahead.length; - else { - if (items > 0) { - count = sv_len_utf8(*beglist); - } - else count = 0; - if (lookahead.code == 'Z') count++; - } - } else { - if (lookahead.howlen == e_number && lookahead.length < items) - count = lookahead.length; - else count = items; - } - lookahead.howlen = e_number; - lookahead.length = count; - lengthcode = sv_2mortal(newSViv(count)); - } + if (symptr->flags & FLAG_SLASH) { + IV count; + if (!found) Perl_croak(aTHX_ "Code missing after '/' in pack"); + if (memCHRs("aAZ", lookahead.code)) { + if (lookahead.howlen == e_number) count = lookahead.length; + else { + if (items > 0) { + count = sv_len_utf8(*beglist); + } + else count = 0; + if (lookahead.code == 'Z') count++; + } + } else { + if (lookahead.howlen == e_number && lookahead.length < items) + count = lookahead.length; + else count = items; + } + lookahead.howlen = e_number; + lookahead.length = count; + lengthcode = sv_2mortal(newSViv(count)); + } needs_swap = NEEDS_SWAP(datumtype); - /* Code inside the switch must take care to properly update - cat (CUR length and '\0' termination) if it updated *cur and - doesn't simply leave using break */ - switch (TYPE_NO_ENDIANNESS(datumtype)) { - default: - Perl_croak(aTHX_ "Invalid type '%c' in pack", - (int) TYPE_NO_MODIFIERS(datumtype)); - case '%': - Perl_croak(aTHX_ "'%%' may not be used in pack"); - - case '.' | TYPE_IS_SHRIEKING: - case '.': - if (howlen == e_star) from = start; - else if (len == 0) from = cur; - else { - tempsym_t *group = symptr; - - while (--len && group) group = group->previous; - from = group ? start + group->strbeg : start; - } - fromstr = NEXTFROM; - len = SvIV_no_inf(fromstr, datumtype); - goto resize; - case '@' | TYPE_IS_SHRIEKING: - case '@': - from = start + symptr->strbeg; - resize: - if (utf8 && !(datumtype & TYPE_IS_SHRIEKING)) - if (len >= 0) { - while (len && from < cur) { - from += UTF8SKIP(from); - len--; - } - if (from > cur) - Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); - if (len) { - /* Here we know from == cur */ - grow: - GROWING(0, cat, start, cur, len); - Zero(cur, len, char); - cur += len; - } else if (from < cur) { - len = cur - from; - goto shrink; - } else goto no_change; - } else { - cur = from; - len = -len; - goto utf8_shrink; - } - else { - len -= cur - from; - if (len > 0) goto grow; - if (len == 0) goto no_change; - len = -len; - goto shrink; - } - break; - - case '(': { + /* Code inside the switch must take care to properly update + cat (CUR length and '\0' termination) if it updated *cur and + doesn't simply leave using break */ + switch (TYPE_NO_ENDIANNESS(datumtype)) { + default: + Perl_croak(aTHX_ "Invalid type '%c' in pack", + (int) TYPE_NO_MODIFIERS(datumtype)); + case '%': + Perl_croak(aTHX_ "'%%' may not be used in pack"); + + case '.' | TYPE_IS_SHRIEKING: + case '.': + if (howlen == e_star) from = start; + else if (len == 0) from = cur; + else { + tempsym_t *group = symptr; + + while (--len && group) group = group->previous; + from = group ? start + group->strbeg : start; + } + fromstr = NEXTFROM; + len = SvIV_no_inf(fromstr, datumtype); + goto resize; + case '@' | TYPE_IS_SHRIEKING: + case '@': + from = start + symptr->strbeg; + resize: + if (utf8 && !(datumtype & TYPE_IS_SHRIEKING)) + if (len >= 0) { + while (len && from < cur) { + from += UTF8SKIP(from); + len--; + } + if (from > cur) + Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); + if (len) { + /* Here we know from == cur */ + grow: + GROWING(0, cat, start, cur, len); + Zero(cur, len, char); + cur += len; + } else if (from < cur) { + len = cur - from; + goto shrink; + } else goto no_change; + } else { + cur = from; + len = -len; + goto utf8_shrink; + } + else { + len -= cur - from; + if (len > 0) goto grow; + if (len == 0) goto no_change; + len = -len; + goto shrink; + } + break; + + case '(': { tempsym_t savsym = *symptr; - U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags); - symptr->flags |= group_modifiers; + U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags); + symptr->flags |= group_modifiers; symptr->patend = savsym.grpend; symptr->level++; - symptr->previous = &lookahead; - while (len--) { - U32 was_utf8; - if (utf8) symptr->flags |= FLAG_PARSE_UTF8; - else symptr->flags &= ~FLAG_PARSE_UTF8; - was_utf8 = SvUTF8(cat); - symptr->patptr = savsym.grpbeg; - beglist = pack_rec(cat, symptr, beglist, endlist); - if (SvUTF8(cat) != was_utf8) - /* This had better be an upgrade while in utf8==0 mode */ - utf8 = 1; - - if (savsym.howlen == e_star && beglist == endlist) - break; /* No way to continue */ - } - items = endlist - beglist; - lookahead.flags = symptr->flags & ~group_modifiers; - goto no_change; - } - case 'X' | TYPE_IS_SHRIEKING: - if (!len) /* Avoid division by 0 */ - len = 1; - if (utf8) { - char *hop, *last; - SSize_t l = len; - hop = last = start; - while (hop < cur) { - hop += UTF8SKIP(hop); - if (--l == 0) { - last = hop; - l = len; - } - } - if (last > cur) - Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); - cur = last; - break; - } - len = (cur-start) % len; - /* FALLTHROUGH */ - case 'X': - if (utf8) { - if (len < 1) goto no_change; - utf8_shrink: - while (len > 0) { - if (cur <= start) - Perl_croak(aTHX_ "'%c' outside of string in pack", - (int) TYPE_NO_MODIFIERS(datumtype)); - while (--cur, UTF8_IS_CONTINUATION(*cur)) { - if (cur <= start) - Perl_croak(aTHX_ "'%c' outside of string in pack", - (int) TYPE_NO_MODIFIERS(datumtype)); - } - len--; - } - } else { - shrink: - if (cur - start < len) - Perl_croak(aTHX_ "'%c' outside of string in pack", - (int) TYPE_NO_MODIFIERS(datumtype)); - cur -= len; - } - if (cur < start+symptr->strbeg) { - /* Make sure group starts don't point into the void */ - tempsym_t *group; - const STRLEN length = cur-start; - for (group = symptr; - group && length < group->strbeg; - group = group->previous) group->strbeg = length; - lookahead.strbeg = length; - } - break; - case 'x' | TYPE_IS_SHRIEKING: { - SSize_t ai32; - if (!len) /* Avoid division by 0 */ - len = 1; - if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len; - else ai32 = (cur - start) % len; - if (ai32 == 0) goto no_change; - len -= ai32; - } - /* FALLTHROUGH */ - case 'x': - goto grow; - case 'A': - case 'Z': - case 'a': { - const char *aptr; - - fromstr = NEXTFROM; - aptr = SvPV_const(fromstr, fromlen); - if (DO_UTF8(fromstr)) { + symptr->previous = &lookahead; + while (len--) { + U32 was_utf8; + if (utf8) symptr->flags |= FLAG_PARSE_UTF8; + else symptr->flags &= ~FLAG_PARSE_UTF8; + was_utf8 = SvUTF8(cat); + symptr->patptr = savsym.grpbeg; + beglist = pack_rec(cat, symptr, beglist, endlist); + if (SvUTF8(cat) != was_utf8) + /* This had better be an upgrade while in utf8==0 mode */ + utf8 = 1; + + if (savsym.howlen == e_star && beglist == endlist) + break; /* No way to continue */ + } + items = endlist - beglist; + lookahead.flags = symptr->flags & ~group_modifiers; + goto no_change; + } + case 'X' | TYPE_IS_SHRIEKING: + if (!len) /* Avoid division by 0 */ + len = 1; + if (utf8) { + char *hop, *last; + SSize_t l = len; + hop = last = start; + while (hop < cur) { + hop += UTF8SKIP(hop); + if (--l == 0) { + last = hop; + l = len; + } + } + if (last > cur) + Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); + cur = last; + break; + } + len = (cur-start) % len; + /* FALLTHROUGH */ + case 'X': + if (utf8) { + if (len < 1) goto no_change; + utf8_shrink: + while (len > 0) { + if (cur <= start) + Perl_croak(aTHX_ "'%c' outside of string in pack", + (int) TYPE_NO_MODIFIERS(datumtype)); + while (--cur, UTF8_IS_CONTINUATION(*cur)) { + if (cur <= start) + Perl_croak(aTHX_ "'%c' outside of string in pack", + (int) TYPE_NO_MODIFIERS(datumtype)); + } + len--; + } + } else { + shrink: + if (cur - start < len) + Perl_croak(aTHX_ "'%c' outside of string in pack", + (int) TYPE_NO_MODIFIERS(datumtype)); + cur -= len; + } + if (cur < start+symptr->strbeg) { + /* Make sure group starts don't point into the void */ + tempsym_t *group; + const STRLEN length = cur-start; + for (group = symptr; + group && length < group->strbeg; + group = group->previous) group->strbeg = length; + lookahead.strbeg = length; + } + break; + case 'x' | TYPE_IS_SHRIEKING: { + SSize_t ai32; + if (!len) /* Avoid division by 0 */ + len = 1; + if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len; + else ai32 = (cur - start) % len; + if (ai32 == 0) goto no_change; + len -= ai32; + } + /* FALLTHROUGH */ + case 'x': + goto grow; + case 'A': + case 'Z': + case 'a': { + const char *aptr; + + fromstr = NEXTFROM; + aptr = SvPV_const(fromstr, fromlen); + if (DO_UTF8(fromstr)) { const char *end, *s; - if (!utf8 && !SvUTF8(cat)) { - marked_upgrade(aTHX_ cat, symptr); - lookahead.flags |= FLAG_DO_UTF8; - lookahead.strbeg = symptr->strbeg; - utf8 = 1; - start = SvPVX(cat); - cur = start + SvCUR(cat); - } - if (howlen == e_star) { - if (utf8) goto string_copy; - len = fromlen+1; - } - s = aptr; - end = aptr + fromlen; - fromlen = datumtype == 'Z' ? len-1 : len; - while ((SSize_t) fromlen > 0 && s < end) { - s += UTF8SKIP(s); - fromlen--; - } - if (s > end) - Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); - if (utf8) { - len = fromlen; - if (datumtype == 'Z') len++; - fromlen = s-aptr; - len += fromlen; - - goto string_copy; - } - fromlen = len - fromlen; - if (datumtype == 'Z') fromlen--; - if (howlen == e_star) { - len = fromlen; - if (datumtype == 'Z') len++; - } - GROWING(0, cat, start, cur, len); - if (!S_utf8_to_bytes(aTHX_ &aptr, end, cur, fromlen, - datumtype | TYPE_IS_PACK)) - Perl_croak(aTHX_ "panic: predicted utf8 length not available, " - "for '%c', aptr=%p end=%p cur=%p, fromlen=%zu", - (int)datumtype, aptr, end, cur, fromlen); - cur += fromlen; - len -= fromlen; - } else if (utf8) { - if (howlen == e_star) { - len = fromlen; - if (datumtype == 'Z') len++; - } - if (len <= (SSize_t) fromlen) { - fromlen = len; - if (datumtype == 'Z' && fromlen > 0) fromlen--; - } - /* assumes a byte expands to at most UTF8_EXPAND bytes on - upgrade, so: - expected_length <= from_len*UTF8_EXPAND + (len-from_len) */ - GROWING(0, cat, start, cur, fromlen*(UTF8_EXPAND-1)+len); - len -= fromlen; - while (fromlen > 0) { - cur = (char *) uvchr_to_utf8((U8 *) cur, * (U8 *) aptr); - aptr++; - fromlen--; - } - } else { - string_copy: - if (howlen == e_star) { - len = fromlen; - if (datumtype == 'Z') len++; - } - if (len <= (SSize_t) fromlen) { - fromlen = len; - if (datumtype == 'Z' && fromlen > 0) fromlen--; - } - GROWING(0, cat, start, cur, len); - Copy(aptr, cur, fromlen, char); - cur += fromlen; - len -= fromlen; - } - memset(cur, datumtype == 'A' ? ' ' : '\0', len); - cur += len; - SvTAINT(cat); - break; - } - case 'B': - case 'b': { - const char *str, *end; - SSize_t l, field_len; - U8 bits; - bool utf8_source; - U32 utf8_flags; - - fromstr = NEXTFROM; - str = SvPV_const(fromstr, fromlen); - end = str + fromlen; - if (DO_UTF8(fromstr)) { - utf8_source = TRUE; - utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; - } else { - utf8_source = FALSE; - utf8_flags = 0; /* Unused, but keep compilers happy */ - } - if (howlen == e_star) len = fromlen; - field_len = (len+7)/8; - GROWING(utf8, cat, start, cur, field_len); - if (len > (SSize_t)fromlen) len = fromlen; - bits = 0; - l = 0; - if (datumtype == 'B') - while (l++ < len) { - if (utf8_source) { - UV val = 0; - NEXT_UNI_VAL(val, cur, str, end, utf8_flags); - bits |= val & 1; - } else bits |= *str++ & 1; - if (l & 7) bits <<= 1; - else { - PUSH_BYTE(utf8, cur, bits); - bits = 0; - } - } - else - /* datumtype == 'b' */ - while (l++ < len) { - if (utf8_source) { - UV val = 0; - NEXT_UNI_VAL(val, cur, str, end, utf8_flags); - if (val & 1) bits |= 0x80; - } else if (*str++ & 1) - bits |= 0x80; - if (l & 7) bits >>= 1; - else { - PUSH_BYTE(utf8, cur, bits); - bits = 0; - } - } - l--; - if (l & 7) { - if (datumtype == 'B') - bits <<= 7 - (l & 7); - else - bits >>= 7 - (l & 7); - PUSH_BYTE(utf8, cur, bits); - l += 7; - } - /* Determine how many chars are left in the requested field */ - l /= 8; - if (howlen == e_star) field_len = 0; - else field_len -= l; - Zero(cur, field_len, char); - cur += field_len; - break; - } - case 'H': - case 'h': { - const char *str, *end; - SSize_t l, field_len; - U8 bits; - bool utf8_source; - U32 utf8_flags; - - fromstr = NEXTFROM; - str = SvPV_const(fromstr, fromlen); - end = str + fromlen; - if (DO_UTF8(fromstr)) { - utf8_source = TRUE; - utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; - } else { - utf8_source = FALSE; - utf8_flags = 0; /* Unused, but keep compilers happy */ - } - if (howlen == e_star) len = fromlen; - field_len = (len+1)/2; - GROWING(utf8, cat, start, cur, field_len); - if (!utf8_source && len > (SSize_t)fromlen) len = fromlen; - bits = 0; - l = 0; - if (datumtype == 'H') - while (l++ < len) { - if (utf8_source) { - UV val = 0; - NEXT_UNI_VAL(val, cur, str, end, utf8_flags); - if (val < 256 && isALPHA(val)) - bits |= (val + 9) & 0xf; - else - bits |= val & 0xf; - } else if (isALPHA(*str)) - bits |= (*str++ + 9) & 0xf; - else - bits |= *str++ & 0xf; - if (l & 1) bits <<= 4; - else { - PUSH_BYTE(utf8, cur, bits); - bits = 0; - } - } - else - while (l++ < len) { - if (utf8_source) { - UV val = 0; - NEXT_UNI_VAL(val, cur, str, end, utf8_flags); - if (val < 256 && isALPHA(val)) - bits |= ((val + 9) & 0xf) << 4; - else - bits |= (val & 0xf) << 4; - } else if (isALPHA(*str)) - bits |= ((*str++ + 9) & 0xf) << 4; - else - bits |= (*str++ & 0xf) << 4; - if (l & 1) bits >>= 4; - else { - PUSH_BYTE(utf8, cur, bits); - bits = 0; - } - } - l--; - if (l & 1) { - PUSH_BYTE(utf8, cur, bits); - l++; - } - /* Determine how many chars are left in the requested field */ - l /= 2; - if (howlen == e_star) field_len = 0; - else field_len -= l; - Zero(cur, field_len, char); - cur += field_len; - break; - } - case 'c': - while (len-- > 0) { - IV aiv; - fromstr = NEXTFROM; + if (!utf8 && !SvUTF8(cat)) { + marked_upgrade(aTHX_ cat, symptr); + lookahead.flags |= FLAG_DO_UTF8; + lookahead.strbeg = symptr->strbeg; + utf8 = 1; + start = SvPVX(cat); + cur = start + SvCUR(cat); + } + if (howlen == e_star) { + if (utf8) goto string_copy; + len = fromlen+1; + } + s = aptr; + end = aptr + fromlen; + fromlen = datumtype == 'Z' ? len-1 : len; + while ((SSize_t) fromlen > 0 && s < end) { + s += UTF8SKIP(s); + fromlen--; + } + if (s > end) + Perl_croak(aTHX_ "Malformed UTF-8 string in pack"); + if (utf8) { + len = fromlen; + if (datumtype == 'Z') len++; + fromlen = s-aptr; + len += fromlen; + + goto string_copy; + } + fromlen = len - fromlen; + if (datumtype == 'Z') fromlen--; + if (howlen == e_star) { + len = fromlen; + if (datumtype == 'Z') len++; + } + GROWING(0, cat, start, cur, len); + if (!S_utf8_to_bytes(aTHX_ &aptr, end, cur, fromlen, + datumtype | TYPE_IS_PACK)) + Perl_croak(aTHX_ "panic: predicted utf8 length not available, " + "for '%c', aptr=%p end=%p cur=%p, fromlen=%zu", + (int)datumtype, aptr, end, cur, fromlen); + cur += fromlen; + len -= fromlen; + } else if (utf8) { + if (howlen == e_star) { + len = fromlen; + if (datumtype == 'Z') len++; + } + if (len <= (SSize_t) fromlen) { + fromlen = len; + if (datumtype == 'Z' && fromlen > 0) fromlen--; + } + /* assumes a byte expands to at most UTF8_EXPAND bytes on + upgrade, so: + expected_length <= from_len*UTF8_EXPAND + (len-from_len) */ + GROWING(0, cat, start, cur, fromlen*(UTF8_EXPAND-1)+len); + len -= fromlen; + while (fromlen > 0) { + cur = (char *) uvchr_to_utf8((U8 *) cur, * (U8 *) aptr); + aptr++; + fromlen--; + } + } else { + string_copy: + if (howlen == e_star) { + len = fromlen; + if (datumtype == 'Z') len++; + } + if (len <= (SSize_t) fromlen) { + fromlen = len; + if (datumtype == 'Z' && fromlen > 0) fromlen--; + } + GROWING(0, cat, start, cur, len); + Copy(aptr, cur, fromlen, char); + cur += fromlen; + len -= fromlen; + } + memset(cur, datumtype == 'A' ? ' ' : '\0', len); + cur += len; + SvTAINT(cat); + break; + } + case 'B': + case 'b': { + const char *str, *end; + SSize_t l, field_len; + U8 bits; + bool utf8_source; + U32 utf8_flags; + + fromstr = NEXTFROM; + str = SvPV_const(fromstr, fromlen); + end = str + fromlen; + if (DO_UTF8(fromstr)) { + utf8_source = TRUE; + utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; + } else { + utf8_source = FALSE; + utf8_flags = 0; /* Unused, but keep compilers happy */ + } + if (howlen == e_star) len = fromlen; + field_len = (len+7)/8; + GROWING(utf8, cat, start, cur, field_len); + if (len > (SSize_t)fromlen) len = fromlen; + bits = 0; + l = 0; + if (datumtype == 'B') + while (l++ < len) { + if (utf8_source) { + UV val = 0; + NEXT_UNI_VAL(val, cur, str, end, utf8_flags); + bits |= val & 1; + } else bits |= *str++ & 1; + if (l & 7) bits <<= 1; + else { + PUSH_BYTE(utf8, cur, bits); + bits = 0; + } + } + else + /* datumtype == 'b' */ + while (l++ < len) { + if (utf8_source) { + UV val = 0; + NEXT_UNI_VAL(val, cur, str, end, utf8_flags); + if (val & 1) bits |= 0x80; + } else if (*str++ & 1) + bits |= 0x80; + if (l & 7) bits >>= 1; + else { + PUSH_BYTE(utf8, cur, bits); + bits = 0; + } + } + l--; + if (l & 7) { + if (datumtype == 'B') + bits <<= 7 - (l & 7); + else + bits >>= 7 - (l & 7); + PUSH_BYTE(utf8, cur, bits); + l += 7; + } + /* Determine how many chars are left in the requested field */ + l /= 8; + if (howlen == e_star) field_len = 0; + else field_len -= l; + Zero(cur, field_len, char); + cur += field_len; + break; + } + case 'H': + case 'h': { + const char *str, *end; + SSize_t l, field_len; + U8 bits; + bool utf8_source; + U32 utf8_flags; + + fromstr = NEXTFROM; + str = SvPV_const(fromstr, fromlen); + end = str + fromlen; + if (DO_UTF8(fromstr)) { + utf8_source = TRUE; + utf8_flags = warn_utf8 ? 0 : UTF8_ALLOW_ANY; + } else { + utf8_source = FALSE; + utf8_flags = 0; /* Unused, but keep compilers happy */ + } + if (howlen == e_star) len = fromlen; + field_len = (len+1)/2; + GROWING(utf8, cat, start, cur, field_len); + if (!utf8_source && len > (SSize_t)fromlen) len = fromlen; + bits = 0; + l = 0; + if (datumtype == 'H') + while (l++ < len) { + if (utf8_source) { + UV val = 0; + NEXT_UNI_VAL(val, cur, str, end, utf8_flags); + if (val < 256 && isALPHA(val)) + bits |= (val + 9) & 0xf; + else + bits |= val & 0xf; + } else if (isALPHA(*str)) + bits |= (*str++ + 9) & 0xf; + else + bits |= *str++ & 0xf; + if (l & 1) bits <<= 4; + else { + PUSH_BYTE(utf8, cur, bits); + bits = 0; + } + } + else + while (l++ < len) { + if (utf8_source) { + UV val = 0; + NEXT_UNI_VAL(val, cur, str, end, utf8_flags); + if (val < 256 && isALPHA(val)) + bits |= ((val + 9) & 0xf) << 4; + else + bits |= (val & 0xf) << 4; + } else if (isALPHA(*str)) + bits |= ((*str++ + 9) & 0xf) << 4; + else + bits |= (*str++ & 0xf) << 4; + if (l & 1) bits >>= 4; + else { + PUSH_BYTE(utf8, cur, bits); + bits = 0; + } + } + l--; + if (l & 1) { + PUSH_BYTE(utf8, cur, bits); + l++; + } + /* Determine how many chars are left in the requested field */ + l /= 2; + if (howlen == e_star) field_len = 0; + else field_len -= l; + Zero(cur, field_len, char); + cur += field_len; + break; + } + case 'c': + while (len-- > 0) { + IV aiv; + fromstr = NEXTFROM; aiv = SvIV_no_inf(fromstr, datumtype); - if ((-128 > aiv || aiv > 127)) - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'c' format wrapped in pack"); - PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff)); - } - break; - case 'C': - if (len == 0) { - utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0; - break; - } - while (len-- > 0) { - IV aiv; - fromstr = NEXTFROM; + if ((-128 > aiv || aiv > 127)) + Perl_ck_warner(aTHX_ packWARN(WARN_PACK), + "Character in 'c' format wrapped in pack"); + PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff)); + } + break; + case 'C': + if (len == 0) { + utf8 = (symptr->flags & FLAG_DO_UTF8) ? 1 : 0; + break; + } + while (len-- > 0) { + IV aiv; + fromstr = NEXTFROM; aiv = SvIV_no_inf(fromstr, datumtype); - if ((0 > aiv || aiv > 0xff)) - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'C' format wrapped in pack"); - PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff)); - } - break; - case 'W': { - char *end; - U8 in_bytes = (U8)IN_BYTES; - - end = start+SvLEN(cat)-1; - if (utf8) end -= UTF8_MAXLEN-1; - while (len-- > 0) { - UV auv; - fromstr = NEXTFROM; - auv = SvUV_no_inf(fromstr, datumtype); - if (in_bytes) auv = auv % 0x100; - if (utf8) { - W_utf8: - if (cur >= end) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - - GROWING(0, cat, start, cur, len+UTF8_MAXLEN); - end = start+SvLEN(cat)-UTF8_MAXLEN; - } - cur = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, 0); - } else { - if (auv >= 0x100) { - if (!SvUTF8(cat)) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - marked_upgrade(aTHX_ cat, symptr); - lookahead.flags |= FLAG_DO_UTF8; - lookahead.strbeg = symptr->strbeg; - utf8 = 1; - start = SvPVX(cat); - cur = start + SvCUR(cat); - end = start+SvLEN(cat)-UTF8_MAXLEN; - goto W_utf8; - } - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Character in 'W' format wrapped in pack"); - auv &= 0xff; - } - if (cur >= end) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - GROWING(0, cat, start, cur, len+1); - end = start+SvLEN(cat)-1; - } - *(U8 *) cur++ = (U8)auv; - } - } - break; - } - case 'U': { - char *end; - - if (len == 0) { - if (!(symptr->flags & FLAG_DO_UTF8)) { - marked_upgrade(aTHX_ cat, symptr); - lookahead.flags |= FLAG_DO_UTF8; - lookahead.strbeg = symptr->strbeg; - } - utf8 = 0; - goto no_change; - } - - end = start+SvLEN(cat); - if (!utf8) end -= UTF8_MAXLEN; - while (len-- > 0) { - UV auv; - fromstr = NEXTFROM; - auv = SvUV_no_inf(fromstr, datumtype); - if (utf8) { - U8 buffer[UTF8_MAXLEN+1], *endb; - endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv), 0); - if (cur+(endb-buffer)*UTF8_EXPAND >= end) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - GROWING(0, cat, start, cur, - len+(endb-buffer)*UTF8_EXPAND); - end = start+SvLEN(cat); - } + if ((0 > aiv || aiv > 0xff)) + Perl_ck_warner(aTHX_ packWARN(WARN_PACK), + "Character in 'C' format wrapped in pack"); + PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff)); + } + break; + case 'W': { + char *end; + U8 in_bytes = (U8)IN_BYTES; + + end = start+SvLEN(cat)-1; + if (utf8) end -= UTF8_MAXLEN-1; + while (len-- > 0) { + UV auv; + fromstr = NEXTFROM; + auv = SvUV_no_inf(fromstr, datumtype); + if (in_bytes) auv = auv % 0x100; + if (utf8) { + W_utf8: + if (cur >= end) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + + GROWING(0, cat, start, cur, len+UTF8_MAXLEN); + end = start+SvLEN(cat)-UTF8_MAXLEN; + } + cur = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, 0); + } else { + if (auv >= 0x100) { + if (!SvUTF8(cat)) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + marked_upgrade(aTHX_ cat, symptr); + lookahead.flags |= FLAG_DO_UTF8; + lookahead.strbeg = symptr->strbeg; + utf8 = 1; + start = SvPVX(cat); + cur = start + SvCUR(cat); + end = start+SvLEN(cat)-UTF8_MAXLEN; + goto W_utf8; + } + Perl_ck_warner(aTHX_ packWARN(WARN_PACK), + "Character in 'W' format wrapped in pack"); + auv &= 0xff; + } + if (cur >= end) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + GROWING(0, cat, start, cur, len+1); + end = start+SvLEN(cat)-1; + } + *(U8 *) cur++ = (U8)auv; + } + } + break; + } + case 'U': { + char *end; + + if (len == 0) { + if (!(symptr->flags & FLAG_DO_UTF8)) { + marked_upgrade(aTHX_ cat, symptr); + lookahead.flags |= FLAG_DO_UTF8; + lookahead.strbeg = symptr->strbeg; + } + utf8 = 0; + goto no_change; + } + + end = start+SvLEN(cat); + if (!utf8) end -= UTF8_MAXLEN; + while (len-- > 0) { + UV auv; + fromstr = NEXTFROM; + auv = SvUV_no_inf(fromstr, datumtype); + if (utf8) { + U8 buffer[UTF8_MAXLEN+1], *endb; + endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv), 0); + if (cur+(endb-buffer)*UTF8_EXPAND >= end) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + GROWING(0, cat, start, cur, + len+(endb-buffer)*UTF8_EXPAND); + end = start+SvLEN(cat); + } cur = my_bytes_to_utf8(buffer, endb-buffer, cur, 0); - } else { - if (cur >= end) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - GROWING(0, cat, start, cur, len+UTF8_MAXLEN); - end = start+SvLEN(cat)-UTF8_MAXLEN; - } - cur = (char *) uvchr_to_utf8_flags((U8 *) cur, + } else { + if (cur >= end) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + GROWING(0, cat, start, cur, len+UTF8_MAXLEN); + end = start+SvLEN(cat)-UTF8_MAXLEN; + } + cur = (char *) uvchr_to_utf8_flags((U8 *) cur, UNI_TO_NATIVE(auv), - 0); - } - } - break; - } - /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */ - case 'f': - while (len-- > 0) { - float afloat; - NV anv; - fromstr = NEXTFROM; - anv = SvNV(fromstr); + 0); + } + } + break; + } + /* Float and double added by gnb@melba.bby.oz.au 22/11/89 */ + case 'f': + while (len-- > 0) { + float afloat; + NV anv; + fromstr = NEXTFROM; + anv = SvNV(fromstr); # if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) - /* IEEE fp overflow shenanigans are unavailable on VAX and optional - * on Alpha; fake it if we don't have them. - */ - if (anv > FLT_MAX) - afloat = FLT_MAX; - else if (anv < -FLT_MAX) - afloat = -FLT_MAX; - else afloat = (float)anv; + /* IEEE fp overflow shenanigans are unavailable on VAX and optional + * on Alpha; fake it if we don't have them. + */ + if (anv > FLT_MAX) + afloat = FLT_MAX; + else if (anv < -FLT_MAX) + afloat = -FLT_MAX; + else afloat = (float)anv; # else # if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) - if(Perl_isnan(anv)) - afloat = (float)NV_NAN; - else + if(Perl_isnan(anv)) + afloat = (float)NV_NAN; + else # endif # ifdef NV_INF /* a simple cast to float is undefined if outside * the range of values that can be represented */ - afloat = (float)(anv > FLT_MAX ? NV_INF : + afloat = (float)(anv > FLT_MAX ? NV_INF : anv < -FLT_MAX ? -NV_INF : anv); # endif # endif PUSH_VAR(utf8, cur, afloat, needs_swap); - } - break; - case 'd': - while (len-- > 0) { - double adouble; - NV anv; - fromstr = NEXTFROM; - anv = SvNV(fromstr); + } + break; + case 'd': + while (len-- > 0) { + double adouble; + NV anv; + fromstr = NEXTFROM; + anv = SvNV(fromstr); # if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT) - /* IEEE fp overflow shenanigans are unavailable on VAX and optional - * on Alpha; fake it if we don't have them. - */ - if (anv > DBL_MAX) - adouble = DBL_MAX; - else if (anv < -DBL_MAX) - adouble = -DBL_MAX; - else adouble = (double)anv; + /* IEEE fp overflow shenanigans are unavailable on VAX and optional + * on Alpha; fake it if we don't have them. + */ + if (anv > DBL_MAX) + adouble = DBL_MAX; + else if (anv < -DBL_MAX) + adouble = -DBL_MAX; + else adouble = (double)anv; # else - adouble = (double)anv; + adouble = (double)anv; # endif PUSH_VAR(utf8, cur, adouble, needs_swap); - } - break; - case 'F': { - NV_bytes anv; - Zero(&anv, 1, NV); /* can be long double with unused bits */ - while (len-- > 0) { - fromstr = NEXTFROM; + } + break; + case 'F': { + NV_bytes anv; + Zero(&anv, 1, NV); /* can be long double with unused bits */ + while (len-- > 0) { + fromstr = NEXTFROM; #ifdef __GNUC__ - /* to work round a gcc/x86 bug; don't use SvNV */ - anv.nv = sv_2nv(fromstr); + /* to work round a gcc/x86 bug; don't use SvNV */ + anv.nv = sv_2nv(fromstr); # if defined(LONGDOUBLE_X86_80_BIT) && defined(USE_LONG_DOUBLE) \ && LONG_DOUBLESIZE > 10 /* GCC sometimes overwrites the padding in the @@ -2753,380 +2753,380 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist ) Zero(anv.bytes+10, sizeof(anv.bytes) - 10, U8); # endif #else - anv.nv = SvNV(fromstr); + anv.nv = SvNV(fromstr); #endif PUSH_BYTES(utf8, cur, anv.bytes, sizeof(anv.bytes), needs_swap); - } - break; - } + } + break; + } #if defined(HAS_LONG_DOUBLE) && defined(USE_LONG_DOUBLE) - case 'D': { - ld_bytes aldouble; - /* long doubles can have unused bits, which may be nonzero */ - Zero(&aldouble, 1, long double); - while (len-- > 0) { - fromstr = NEXTFROM; + case 'D': { + ld_bytes aldouble; + /* long doubles can have unused bits, which may be nonzero */ + Zero(&aldouble, 1, long double); + while (len-- > 0) { + fromstr = NEXTFROM; # ifdef __GNUC__ - /* to work round a gcc/x86 bug; don't use SvNV */ - aldouble.ld = (long double)sv_2nv(fromstr); + /* to work round a gcc/x86 bug; don't use SvNV */ + aldouble.ld = (long double)sv_2nv(fromstr); # if defined(LONGDOUBLE_X86_80_BIT) && LONG_DOUBLESIZE > 10 /* GCC sometimes overwrites the padding in the assignment above */ Zero(aldouble.bytes+10, sizeof(aldouble.bytes) - 10, U8); # endif # else - aldouble.ld = (long double)SvNV(fromstr); + aldouble.ld = (long double)SvNV(fromstr); # endif PUSH_BYTES(utf8, cur, aldouble.bytes, sizeof(aldouble.bytes), needs_swap); - } - break; - } + } + break; + } #endif - case 'n' | TYPE_IS_SHRIEKING: - case 'n': - while (len-- > 0) { - I16 ai16; - fromstr = NEXTFROM; - ai16 = (I16)SvIV_no_inf(fromstr, datumtype); - ai16 = PerlSock_htons(ai16); + case 'n' | TYPE_IS_SHRIEKING: + case 'n': + while (len-- > 0) { + I16 ai16; + fromstr = NEXTFROM; + ai16 = (I16)SvIV_no_inf(fromstr, datumtype); + ai16 = PerlSock_htons(ai16); PUSH16(utf8, cur, &ai16, FALSE); - } - break; - case 'v' | TYPE_IS_SHRIEKING: - case 'v': - while (len-- > 0) { - I16 ai16; - fromstr = NEXTFROM; - ai16 = (I16)SvIV_no_inf(fromstr, datumtype); - ai16 = htovs(ai16); + } + break; + case 'v' | TYPE_IS_SHRIEKING: + case 'v': + while (len-- > 0) { + I16 ai16; + fromstr = NEXTFROM; + ai16 = (I16)SvIV_no_inf(fromstr, datumtype); + ai16 = htovs(ai16); PUSH16(utf8, cur, &ai16, FALSE); - } - break; + } + break; case 'S' | TYPE_IS_SHRIEKING: #if SHORTSIZE != SIZE16 - while (len-- > 0) { - unsigned short aushort; - fromstr = NEXTFROM; - aushort = SvUV_no_inf(fromstr, datumtype); + while (len-- > 0) { + unsigned short aushort; + fromstr = NEXTFROM; + aushort = SvUV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, aushort, needs_swap); - } + } break; #else /* FALLTHROUGH */ #endif - case 'S': - while (len-- > 0) { - U16 au16; - fromstr = NEXTFROM; - au16 = (U16)SvUV_no_inf(fromstr, datumtype); + case 'S': + while (len-- > 0) { + U16 au16; + fromstr = NEXTFROM; + au16 = (U16)SvUV_no_inf(fromstr, datumtype); PUSH16(utf8, cur, &au16, needs_swap); - } - break; - case 's' | TYPE_IS_SHRIEKING: + } + break; + case 's' | TYPE_IS_SHRIEKING: #if SHORTSIZE != SIZE16 - while (len-- > 0) { - short ashort; - fromstr = NEXTFROM; - ashort = SvIV_no_inf(fromstr, datumtype); + while (len-- > 0) { + short ashort; + fromstr = NEXTFROM; + ashort = SvIV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, ashort, needs_swap); - } + } break; #else /* FALLTHROUGH */ #endif - case 's': - while (len-- > 0) { - I16 ai16; - fromstr = NEXTFROM; - ai16 = (I16)SvIV_no_inf(fromstr, datumtype); + case 's': + while (len-- > 0) { + I16 ai16; + fromstr = NEXTFROM; + ai16 = (I16)SvIV_no_inf(fromstr, datumtype); PUSH16(utf8, cur, &ai16, needs_swap); - } - break; - case 'I': - case 'I' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - unsigned int auint; - fromstr = NEXTFROM; - auint = SvUV_no_inf(fromstr, datumtype); + } + break; + case 'I': + case 'I' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + unsigned int auint; + fromstr = NEXTFROM; + auint = SvUV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, auint, needs_swap); - } - break; - case 'j': - while (len-- > 0) { - IV aiv; - fromstr = NEXTFROM; - aiv = SvIV_no_inf(fromstr, datumtype); + } + break; + case 'j': + while (len-- > 0) { + IV aiv; + fromstr = NEXTFROM; + aiv = SvIV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, aiv, needs_swap); - } - break; - case 'J': - while (len-- > 0) { - UV auv; - fromstr = NEXTFROM; - auv = SvUV_no_inf(fromstr, datumtype); + } + break; + case 'J': + while (len-- > 0) { + UV auv; + fromstr = NEXTFROM; + auv = SvUV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, auv, needs_swap); - } - break; - case 'w': + } + break; + case 'w': while (len-- > 0) { - NV anv; - fromstr = NEXTFROM; - S_sv_check_infnan(aTHX_ fromstr, datumtype); - anv = SvNV_nomg(fromstr); - - if (anv < 0) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - Perl_croak(aTHX_ "Cannot compress negative numbers in pack"); - } + NV anv; + fromstr = NEXTFROM; + S_sv_check_infnan(aTHX_ fromstr, datumtype); + anv = SvNV_nomg(fromstr); + + if (anv < 0) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + Perl_croak(aTHX_ "Cannot compress negative numbers in pack"); + } /* 0xFFFFFFFFFFFFFFFF may cast to 18446744073709551616.0, which is == UV_MAX_P1. IOK is fine (instead of UV_only), as any negative IVs will have already been got by the croak() above. IOK is untrue for fractions, so we test them against UV_MAX_P1. */ - if (SvIOK(fromstr) || anv < UV_MAX_P1) { - char buf[(sizeof(UV)*CHAR_BIT)/7+1]; - char *in = buf + sizeof(buf); - UV auv = SvUV_nomg(fromstr); - - do { - *--in = (char)((auv & 0x7f) | 0x80); - auv >>= 7; - } while (auv); - buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ - PUSH_GROWING_BYTES(utf8, cat, start, cur, - in, (buf + sizeof(buf)) - in); - } else if (SvPOKp(fromstr)) - goto w_string; - else if (SvNOKp(fromstr)) { - /* 10**NV_MAX_10_EXP is the largest power of 10 - so 10**(NV_MAX_10_EXP+1) is definitely unrepresentable - given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x: - x = (NV_MAX_10_EXP+1) * log (10) / log (128) - And with that many bytes only Inf can overflow. - Some C compilers are strict about integral constant - expressions so we conservatively divide by a slightly - smaller integer instead of multiplying by the exact - floating-point value. - */ + if (SvIOK(fromstr) || anv < UV_MAX_P1) { + char buf[(sizeof(UV)*CHAR_BIT)/7+1]; + char *in = buf + sizeof(buf); + UV auv = SvUV_nomg(fromstr); + + do { + *--in = (char)((auv & 0x7f) | 0x80); + auv >>= 7; + } while (auv); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + PUSH_GROWING_BYTES(utf8, cat, start, cur, + in, (buf + sizeof(buf)) - in); + } else if (SvPOKp(fromstr)) + goto w_string; + else if (SvNOKp(fromstr)) { + /* 10**NV_MAX_10_EXP is the largest power of 10 + so 10**(NV_MAX_10_EXP+1) is definitely unrepresentable + given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x: + x = (NV_MAX_10_EXP+1) * log (10) / log (128) + And with that many bytes only Inf can overflow. + Some C compilers are strict about integral constant + expressions so we conservatively divide by a slightly + smaller integer instead of multiplying by the exact + floating-point value. + */ #ifdef NV_MAX_10_EXP - /* char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)]; -- invalid C */ - char buf[1 + (int)((NV_MAX_10_EXP + 1) / 2)]; /* valid C */ + /* char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)]; -- invalid C */ + char buf[1 + (int)((NV_MAX_10_EXP + 1) / 2)]; /* valid C */ #else - /* char buf[1 + (int)((308 + 1) * 0.47456)]; -- invalid C */ - char buf[1 + (int)((308 + 1) / 2)]; /* valid C */ + /* char buf[1 + (int)((308 + 1) * 0.47456)]; -- invalid C */ + char buf[1 + (int)((308 + 1) / 2)]; /* valid C */ #endif - char *in = buf + sizeof(buf); - - anv = Perl_floor(anv); - do { - const NV next = Perl_floor(anv / 128); - if (in <= buf) /* this cannot happen ;-) */ - Perl_croak(aTHX_ "Cannot compress integer in pack"); - *--in = (unsigned char)(anv - (next * 128)) | 0x80; - anv = next; - } while (anv > 0); - buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ - PUSH_GROWING_BYTES(utf8, cat, start, cur, - in, (buf + sizeof(buf)) - in); - } else { - const char *from; - char *result, *in; - SV *norm; - STRLEN len; - bool done; - - w_string: - /* Copy string and check for compliance */ - from = SvPV_nomg_const(fromstr, len); - if ((norm = is_an_int(from, len)) == NULL) - Perl_croak(aTHX_ "Can only compress unsigned integers in pack"); - - Newx(result, len, char); - in = result + len; - done = FALSE; - while (!done) *--in = div128(norm, &done) | 0x80; - result[len - 1] &= 0x7F; /* clear continue bit */ - PUSH_GROWING_BYTES(utf8, cat, start, cur, - in, (result + len) - in); - Safefree(result); - SvREFCNT_dec(norm); /* free norm */ - } - } - break; - case 'i': - case 'i' | TYPE_IS_SHRIEKING: - while (len-- > 0) { - int aint; - fromstr = NEXTFROM; - aint = SvIV_no_inf(fromstr, datumtype); + char *in = buf + sizeof(buf); + + anv = Perl_floor(anv); + do { + const NV next = Perl_floor(anv / 128); + if (in <= buf) /* this cannot happen ;-) */ + Perl_croak(aTHX_ "Cannot compress integer in pack"); + *--in = (unsigned char)(anv - (next * 128)) | 0x80; + anv = next; + } while (anv > 0); + buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ + PUSH_GROWING_BYTES(utf8, cat, start, cur, + in, (buf + sizeof(buf)) - in); + } else { + const char *from; + char *result, *in; + SV *norm; + STRLEN len; + bool done; + + w_string: + /* Copy string and check for compliance */ + from = SvPV_nomg_const(fromstr, len); + if ((norm = is_an_int(from, len)) == NULL) + Perl_croak(aTHX_ "Can only compress unsigned integers in pack"); + + Newx(result, len, char); + in = result + len; + done = FALSE; + while (!done) *--in = div128(norm, &done) | 0x80; + result[len - 1] &= 0x7F; /* clear continue bit */ + PUSH_GROWING_BYTES(utf8, cat, start, cur, + in, (result + len) - in); + Safefree(result); + SvREFCNT_dec(norm); /* free norm */ + } + } + break; + case 'i': + case 'i' | TYPE_IS_SHRIEKING: + while (len-- > 0) { + int aint; + fromstr = NEXTFROM; + aint = SvIV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, aint, needs_swap); - } - break; - case 'N' | TYPE_IS_SHRIEKING: - case 'N': - while (len-- > 0) { - U32 au32; - fromstr = NEXTFROM; - au32 = SvUV_no_inf(fromstr, datumtype); - au32 = PerlSock_htonl(au32); + } + break; + case 'N' | TYPE_IS_SHRIEKING: + case 'N': + while (len-- > 0) { + U32 au32; + fromstr = NEXTFROM; + au32 = SvUV_no_inf(fromstr, datumtype); + au32 = PerlSock_htonl(au32); PUSH32(utf8, cur, &au32, FALSE); - } - break; - case 'V' | TYPE_IS_SHRIEKING: - case 'V': - while (len-- > 0) { - U32 au32; - fromstr = NEXTFROM; - au32 = SvUV_no_inf(fromstr, datumtype); - au32 = htovl(au32); + } + break; + case 'V' | TYPE_IS_SHRIEKING: + case 'V': + while (len-- > 0) { + U32 au32; + fromstr = NEXTFROM; + au32 = SvUV_no_inf(fromstr, datumtype); + au32 = htovl(au32); PUSH32(utf8, cur, &au32, FALSE); - } - break; - case 'L' | TYPE_IS_SHRIEKING: + } + break; + case 'L' | TYPE_IS_SHRIEKING: #if LONGSIZE != SIZE32 - while (len-- > 0) { - unsigned long aulong; - fromstr = NEXTFROM; - aulong = SvUV_no_inf(fromstr, datumtype); + while (len-- > 0) { + unsigned long aulong; + fromstr = NEXTFROM; + aulong = SvUV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, aulong, needs_swap); - } - break; + } + break; #else /* Fall though! */ #endif - case 'L': - while (len-- > 0) { - U32 au32; - fromstr = NEXTFROM; - au32 = SvUV_no_inf(fromstr, datumtype); + case 'L': + while (len-- > 0) { + U32 au32; + fromstr = NEXTFROM; + au32 = SvUV_no_inf(fromstr, datumtype); PUSH32(utf8, cur, &au32, needs_swap); - } - break; - case 'l' | TYPE_IS_SHRIEKING: + } + break; + case 'l' | TYPE_IS_SHRIEKING: #if LONGSIZE != SIZE32 - while (len-- > 0) { - long along; - fromstr = NEXTFROM; - along = SvIV_no_inf(fromstr, datumtype); + while (len-- > 0) { + long along; + fromstr = NEXTFROM; + along = SvIV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, along, needs_swap); - } - break; + } + break; #else /* Fall though! */ #endif - case 'l': + case 'l': while (len-- > 0) { - I32 ai32; - fromstr = NEXTFROM; - ai32 = SvIV_no_inf(fromstr, datumtype); + I32 ai32; + fromstr = NEXTFROM; + ai32 = SvIV_no_inf(fromstr, datumtype); PUSH32(utf8, cur, &ai32, needs_swap); - } - break; + } + break; #if defined(HAS_QUAD) && IVSIZE >= 8 - case 'Q': - while (len-- > 0) { - Uquad_t auquad; - fromstr = NEXTFROM; - auquad = (Uquad_t) SvUV_no_inf(fromstr, datumtype); + case 'Q': + while (len-- > 0) { + Uquad_t auquad; + fromstr = NEXTFROM; + auquad = (Uquad_t) SvUV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, auquad, needs_swap); - } - break; - case 'q': - while (len-- > 0) { - Quad_t aquad; - fromstr = NEXTFROM; - aquad = (Quad_t)SvIV_no_inf(fromstr, datumtype); + } + break; + case 'q': + while (len-- > 0) { + Quad_t aquad; + fromstr = NEXTFROM; + aquad = (Quad_t)SvIV_no_inf(fromstr, datumtype); PUSH_VAR(utf8, cur, aquad, needs_swap); - } - break; + } + break; #endif - case 'P': - len = 1; /* assume SV is correct length */ - GROWING(utf8, cat, start, cur, sizeof(char *)); - /* FALLTHROUGH */ - case 'p': - while (len-- > 0) { - const char *aptr; - - fromstr = NEXTFROM; - SvGETMAGIC(fromstr); - if (!SvOK(fromstr)) aptr = NULL; - else { - /* XXX better yet, could spirit away the string to - * a safe spot and hang on to it until the result - * of pack() (and all copies of the result) are - * gone. - */ - if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1) - || (SvPADTMP(fromstr) && - !SvREADONLY(fromstr)))) { - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Attempt to pack pointer to temporary value"); - } - if (SvPOK(fromstr) || SvNIOK(fromstr)) - aptr = SvPV_nomg_const_nolen(fromstr); - else - aptr = SvPV_force_flags_nolen(fromstr, 0); - } + case 'P': + len = 1; /* assume SV is correct length */ + GROWING(utf8, cat, start, cur, sizeof(char *)); + /* FALLTHROUGH */ + case 'p': + while (len-- > 0) { + const char *aptr; + + fromstr = NEXTFROM; + SvGETMAGIC(fromstr); + if (!SvOK(fromstr)) aptr = NULL; + else { + /* XXX better yet, could spirit away the string to + * a safe spot and hang on to it until the result + * of pack() (and all copies of the result) are + * gone. + */ + if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1) + || (SvPADTMP(fromstr) && + !SvREADONLY(fromstr)))) { + Perl_ck_warner(aTHX_ packWARN(WARN_PACK), + "Attempt to pack pointer to temporary value"); + } + if (SvPOK(fromstr) || SvNIOK(fromstr)) + aptr = SvPV_nomg_const_nolen(fromstr); + else + aptr = SvPV_force_flags_nolen(fromstr, 0); + } PUSH_VAR(utf8, cur, aptr, needs_swap); - } - break; - case 'u': { - const char *aptr, *aend; - bool from_utf8; - - fromstr = NEXTFROM; - if (len <= 2) len = 45; - else len = len / 3 * 3; - if (len >= 64) { - Perl_ck_warner(aTHX_ packWARN(WARN_PACK), - "Field too wide in 'u' format in pack"); - len = 63; - } - aptr = SvPV_const(fromstr, fromlen); - from_utf8 = DO_UTF8(fromstr); - if (from_utf8) { - aend = aptr + fromlen; - fromlen = sv_len_utf8_nomg(fromstr); - } else aend = NULL; /* Unused, but keep compilers happy */ - GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2); - while (fromlen > 0) { - U8 *end; - SSize_t todo; - U8 hunk[1+63/3*4+1]; - - if ((SSize_t)fromlen > len) - todo = len; - else - todo = fromlen; - if (from_utf8) { - char buffer[64]; - if (!S_utf8_to_bytes(aTHX_ &aptr, aend, buffer, todo, - 'u' | TYPE_IS_PACK)) { - *cur = '\0'; - SvCUR_set(cat, cur - start); - Perl_croak(aTHX_ "panic: string is shorter than advertised, " - "aptr=%p, aend=%p, buffer=%p, todo=%zd", - aptr, aend, buffer, todo); - } - end = doencodes(hunk, (const U8 *)buffer, todo); - } else { - end = doencodes(hunk, (const U8 *)aptr, todo); - aptr += todo; - } - PUSH_BYTES(utf8, cur, hunk, end-hunk, 0); - fromlen -= todo; - } - break; - } - } - *cur = '\0'; - SvCUR_set(cat, cur - start); + } + break; + case 'u': { + const char *aptr, *aend; + bool from_utf8; + + fromstr = NEXTFROM; + if (len <= 2) len = 45; + else len = len / 3 * 3; + if (len >= 64) { + Perl_ck_warner(aTHX_ packWARN(WARN_PACK), + "Field too wide in 'u' format in pack"); + len = 63; + } + aptr = SvPV_const(fromstr, fromlen); + from_utf8 = DO_UTF8(fromstr); + if (from_utf8) { + aend = aptr + fromlen; + fromlen = sv_len_utf8_nomg(fromstr); + } else aend = NULL; /* Unused, but keep compilers happy */ + GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2); + while (fromlen > 0) { + U8 *end; + SSize_t todo; + U8 hunk[1+63/3*4+1]; + + if ((SSize_t)fromlen > len) + todo = len; + else + todo = fromlen; + if (from_utf8) { + char buffer[64]; + if (!S_utf8_to_bytes(aTHX_ &aptr, aend, buffer, todo, + 'u' | TYPE_IS_PACK)) { + *cur = '\0'; + SvCUR_set(cat, cur - start); + Perl_croak(aTHX_ "panic: string is shorter than advertised, " + "aptr=%p, aend=%p, buffer=%p, todo=%zd", + aptr, aend, buffer, todo); + } + end = doencodes(hunk, (const U8 *)buffer, todo); + } else { + end = doencodes(hunk, (const U8 *)aptr, todo); + aptr += todo; + } + PUSH_BYTES(utf8, cur, hunk, end-hunk, 0); + fromlen -= todo; + } + break; + } + } + *cur = '\0'; + SvCUR_set(cat, cur - start); no_change: - *symptr = lookahead; + *symptr = lookahead; } return beglist; } diff --git a/pp_sys.c b/pp_sys.c index 8a6445e3e3d4..7d0af1f43e5c 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -220,7 +220,7 @@ void endservent(void); #if !defined(PERL_EFF_ACCESS) && defined(HAS_ACCESS) \ && (defined(HAS_SETREUID) || defined(HAS_SETRESUID) \ - || defined(HAS_SETREGID) || defined(HAS_SETRESGID)) + || defined(HAS_SETREGID) || defined(HAS_SETRESGID)) /* The Hard Way. */ STATIC int S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) @@ -239,8 +239,8 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) # elif defined(HAS_SETRESUID) if (setresuid(euid, ruid, (Uid_t)-1)) # endif - /* diag_listed_as: entering effective %s failed */ - Perl_croak(aTHX_ "entering effective uid failed"); + /* diag_listed_as: entering effective %s failed */ + Perl_croak(aTHX_ "entering effective uid failed"); #endif #if !defined(HAS_SETREGID) && !defined(HAS_SETRESGID) @@ -251,8 +251,8 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) # elif defined(HAS_SETRESGID) if (setresgid(egid, rgid, (Gid_t)-1)) # endif - /* diag_listed_as: entering effective %s failed */ - Perl_croak(aTHX_ "entering effective gid failed"); + /* diag_listed_as: entering effective %s failed */ + Perl_croak(aTHX_ "entering effective gid failed"); #endif res = access(path, mode); @@ -262,16 +262,16 @@ S_emulate_eaccess(pTHX_ const char* path, Mode_t mode) #elif defined(HAS_SETRESUID) if (setresuid(ruid, euid, (Uid_t)-1)) #endif - /* diag_listed_as: leaving effective %s failed */ - Perl_croak(aTHX_ "leaving effective uid failed"); + /* diag_listed_as: leaving effective %s failed */ + Perl_croak(aTHX_ "leaving effective uid failed"); #ifdef HAS_SETREGID if (setregid(rgid, egid)) #elif defined(HAS_SETRESGID) if (setresgid(rgid, egid, (Gid_t)-1)) #endif - /* diag_listed_as: leaving effective %s failed */ - Perl_croak(aTHX_ "leaving effective gid failed"); + /* diag_listed_as: leaving effective %s failed */ + Perl_croak(aTHX_ "leaving effective gid failed"); return res; } @@ -288,52 +288,52 @@ PP(pp_backtick) TAINT_PROPER("``"); if (PL_op->op_private & OPpOPEN_IN_RAW) - mode = "rb"; + mode = "rb"; else if (PL_op->op_private & OPpOPEN_IN_CRLF) - mode = "rt"; + mode = "rt"; fp = PerlProc_popen(tmps, mode); if (fp) { const char * const type = Perl_PerlIO_context_layers(aTHX_ NULL); - if (type && *type) - PerlIO_apply_layers(aTHX_ fp,mode,type); - - if (gimme == G_VOID) { - char tmpbuf[256]; - while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0) - NOOP; - } - else if (gimme == G_SCALAR) { - ENTER_with_name("backtick"); - SAVESPTR(PL_rs); - PL_rs = &PL_sv_undef; + if (type && *type) + PerlIO_apply_layers(aTHX_ fp,mode,type); + + if (gimme == G_VOID) { + char tmpbuf[256]; + while (PerlIO_read(fp, tmpbuf, sizeof tmpbuf) > 0) + NOOP; + } + else if (gimme == G_SCALAR) { + ENTER_with_name("backtick"); + SAVESPTR(PL_rs); + PL_rs = &PL_sv_undef; SvPVCLEAR(TARG); /* note that this preserves previous buffer */ - while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL) - NOOP; - LEAVE_with_name("backtick"); - XPUSHs(TARG); - SvTAINTED_on(TARG); - } - else { - for (;;) { - SV * const sv = newSV(79); - if (sv_gets(sv, fp, 0) == NULL) { - SvREFCNT_dec(sv); - break; - } - mXPUSHs(sv); - if (SvLEN(sv) - SvCUR(sv) > 20) { - SvPV_shrink_to_cur(sv); - } - SvTAINTED_on(sv); - } - } - STATUS_NATIVE_CHILD_SET(PerlProc_pclose(fp)); - TAINT; /* "I believe that this is not gratuitous!" */ + while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL) + NOOP; + LEAVE_with_name("backtick"); + XPUSHs(TARG); + SvTAINTED_on(TARG); + } + else { + for (;;) { + SV * const sv = newSV(79); + if (sv_gets(sv, fp, 0) == NULL) { + SvREFCNT_dec(sv); + break; + } + mXPUSHs(sv); + if (SvLEN(sv) - SvCUR(sv) > 20) { + SvPV_shrink_to_cur(sv); + } + SvTAINTED_on(sv); + } + } + STATUS_NATIVE_CHILD_SET(PerlProc_pclose(fp)); + TAINT; /* "I believe that this is not gratuitous!" */ } else { - STATUS_NATIVE_CHILD_SET(-1); - if (gimme == G_SCALAR) - RETPUSHUNDEF; + STATUS_NATIVE_CHILD_SET(-1); + if (gimme == G_SCALAR) + RETPUSHUNDEF; } RETURN; @@ -354,15 +354,15 @@ PP(pp_glob) tryAMAGICunTARGETlist(iter_amg, (PL_op->op_flags & OPf_SPECIAL)); if (PL_op->op_flags & OPf_SPECIAL) { - /* call Perl-level glob function instead. Stack args are: - * MARK, wildcard - * and following OPs should be: gv(CORE::GLOBAL::glob), entersub - * */ - return NORMAL; + /* call Perl-level glob function instead. Stack args are: + * MARK, wildcard + * and following OPs should be: gv(CORE::GLOBAL::glob), entersub + * */ + return NORMAL; } if (PL_globhook) { - PL_globhook(aTHX); - return NORMAL; + PL_globhook(aTHX); + return NORMAL; } /* Note that we only ever get here if File::Glob fails to load @@ -373,12 +373,12 @@ PP(pp_glob) #ifndef VMS if (TAINTING_get) { - /* - * The external globbing program may use things we can't control, - * so for security reasons we must assume the worst. - */ - TAINT; - taint_proper(PL_no_security, "glob"); + /* + * The external globbing program may use things we can't control, + * so for security reasons we must assume the worst. + */ + TAINT; + taint_proper(PL_no_security, "glob"); } #endif /* !VMS */ @@ -410,45 +410,45 @@ PP(pp_warn) SV *exsv; STRLEN len; if (SP - MARK > 1) { - dTARGET; - do_join(TARG, &PL_sv_no, MARK, SP); - exsv = TARG; - SP = MARK + 1; + dTARGET; + do_join(TARG, &PL_sv_no, MARK, SP); + exsv = TARG; + SP = MARK + 1; } else if (SP == MARK) { - exsv = &PL_sv_no; - MEXTEND(SP, 1); - SP = MARK + 1; + exsv = &PL_sv_no; + MEXTEND(SP, 1); + SP = MARK + 1; } else { - exsv = TOPs; - if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv); + exsv = TOPs; + if (SvGMAGICAL(exsv)) exsv = sv_mortalcopy(exsv); } if (SvROK(exsv) || (SvPV_const(exsv, len), len)) { - /* well-formed exception supplied */ + /* well-formed exception supplied */ } else { SV * const errsv = ERRSV; SvGETMAGIC(errsv); if (SvROK(errsv)) { - if (SvGMAGICAL(errsv)) { - exsv = sv_newmortal(); - sv_setsv_nomg(exsv, errsv); - } - else exsv = errsv; + if (SvGMAGICAL(errsv)) { + exsv = sv_newmortal(); + sv_setsv_nomg(exsv, errsv); + } + else exsv = errsv; } else if (SvPOKp(errsv) ? SvCUR(errsv) : SvNIOKp(errsv)) { - exsv = sv_newmortal(); - sv_setsv_nomg(exsv, errsv); - sv_catpvs(exsv, "\t...caught"); + exsv = sv_newmortal(); + sv_setsv_nomg(exsv, errsv); + sv_catpvs(exsv, "\t...caught"); } else { - exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP); + exsv = newSVpvs_flags("Warning: something's wrong", SVs_TEMP); } } if (SvROK(exsv) && !PL_warnhook) - Perl_warn(aTHX_ "%" SVf, SVfARG(exsv)); + Perl_warn(aTHX_ "%" SVf, SVfARG(exsv)); else warn_sv(exsv); RETSETYES; } @@ -460,51 +460,51 @@ PP(pp_die) STRLEN len; #ifdef VMS VMSISH_HUSHED = - VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH); + VMSISH_HUSHED || (PL_curcop->op_private & OPpHUSH_VMSISH); #endif if (SP - MARK != 1) { - dTARGET; - do_join(TARG, &PL_sv_no, MARK, SP); - exsv = TARG; - SP = MARK + 1; + dTARGET; + do_join(TARG, &PL_sv_no, MARK, SP); + exsv = TARG; + SP = MARK + 1; } else { - exsv = TOPs; + exsv = TOPs; } if (SvROK(exsv) || (SvPV_const(exsv, len), len)) { - /* well-formed exception supplied */ + /* well-formed exception supplied */ } else { - SV * const errsv = ERRSV; - SvGETMAGIC(errsv); - if (SvROK(errsv)) { - exsv = errsv; - if (sv_isobject(exsv)) { - HV * const stash = SvSTASH(SvRV(exsv)); - GV * const gv = gv_fetchmethod(stash, "PROPAGATE"); - if (gv) { - SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); - SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); - EXTEND(SP, 3); - PUSHMARK(SP); - PUSHs(exsv); - PUSHs(file); - PUSHs(line); - PUTBACK; - call_sv(MUTABLE_SV(GvCV(gv)), - G_SCALAR|G_EVAL|G_KEEPERR); - exsv = sv_mortalcopy(*PL_stack_sp--); - } - } - } - else if (SvOK(errsv) && (SvPV_nomg(errsv,len), len)) { - exsv = sv_mortalcopy(errsv); - sv_catpvs(exsv, "\t...propagated"); - } - else { - exsv = newSVpvs_flags("Died", SVs_TEMP); - } + SV * const errsv = ERRSV; + SvGETMAGIC(errsv); + if (SvROK(errsv)) { + exsv = errsv; + if (sv_isobject(exsv)) { + HV * const stash = SvSTASH(SvRV(exsv)); + GV * const gv = gv_fetchmethod(stash, "PROPAGATE"); + if (gv) { + SV * const file = sv_2mortal(newSVpv(CopFILE(PL_curcop),0)); + SV * const line = sv_2mortal(newSVuv(CopLINE(PL_curcop))); + EXTEND(SP, 3); + PUSHMARK(SP); + PUSHs(exsv); + PUSHs(file); + PUSHs(line); + PUTBACK; + call_sv(MUTABLE_SV(GvCV(gv)), + G_SCALAR|G_EVAL|G_KEEPERR); + exsv = sv_mortalcopy(*PL_stack_sp--); + } + } + } + else if (SvOK(errsv) && (SvPV_nomg(errsv,len), len)) { + exsv = sv_mortalcopy(errsv); + sv_catpvs(exsv, "\t...propagated"); + } + else { + exsv = newSVpvs_flags("Died", SVs_TEMP); + } } die_sv(exsv); NOT_REACHED; /* NOTREACHED */ @@ -515,7 +515,7 @@ PP(pp_die) OP * Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, - const MAGIC *const mg, const U32 flags, U32 argc, ...) + const MAGIC *const mg, const U32 flags, U32 argc, ...) { SV **orig_sp = sp; I32 ret_args; @@ -547,30 +547,30 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, PUSHMARK(sp); PUSHs(SvTIED_obj(sv, mg)); if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) { - Copy(orig_sp + 2, sp + 1, argc, SV*); /* copy args to new stack */ - sp += argc; + Copy(orig_sp + 2, sp + 1, argc, SV*); /* copy args to new stack */ + sp += argc; } else if (argc) { - const U32 mortalize_not_needed - = flags & TIED_METHOD_MORTALIZE_NOT_NEEDED; - va_list args; - va_start(args, argc); - do { - SV *const arg = va_arg(args, SV *); - if(mortalize_not_needed) - PUSHs(arg); - else - mPUSHs(arg); - } while (--argc); - va_end(args); + const U32 mortalize_not_needed + = flags & TIED_METHOD_MORTALIZE_NOT_NEEDED; + va_list args; + va_start(args, argc); + do { + SV *const arg = va_arg(args, SV *); + if(mortalize_not_needed) + PUSHs(arg); + else + mPUSHs(arg); + } while (--argc); + va_end(args); } PUTBACK; ENTER_with_name("call_tied_method"); if (flags & TIED_METHOD_SAY) { - /* local $\ = "\n" */ - SAVEGENERICSV(PL_ors_sv); - PL_ors_sv = newSVpvs("\n"); + /* local $\ = "\n" */ + SAVEGENERICSV(PL_ors_sv); + PL_ors_sv = newSVpvs("\n"); } ret_args = call_sv(methname, (flags & G_WANT)|G_METHOD_NAMED); SPAGAIN; @@ -578,10 +578,10 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv, POPSTACK; SPAGAIN; if (ret_args) { /* copy results back to original stack */ - EXTEND(sp, ret_args); - Copy(orig_sp - ret_args + 1, sp + 1, ret_args, SV*); - sp += ret_args; - PUTBACK; + EXTEND(sp, ret_args); + Copy(orig_sp - ret_args + 1, sp + 1, ret_args, SV*); + sp += ret_args; + PUTBACK; } LEAVE_with_name("call_tied_method"); return NORMAL; @@ -608,42 +608,42 @@ PP(pp_open) GV * const gv = MUTABLE_GV(*++MARK); if (!isGV(gv) && !(SvTYPE(gv) == SVt_PVLV && isGV_with_GP(gv))) - DIE(aTHX_ PL_no_usym, "filehandle"); + DIE(aTHX_ PL_no_usym, "filehandle"); if ((io = GvIOp(gv))) { - const MAGIC *mg; - IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; - - if (IoDIRP(io)) - Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is already open as a dirhandle", - HEKfARG(GvENAME_HEK(gv))); - - mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - /* Method's args are same as ours ... */ - /* ... except handle is replaced by the object */ - return Perl_tied_method(aTHX_ SV_CONST(OPEN), mark - 1, MUTABLE_SV(io), mg, - G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, - sp - mark); - } + const MAGIC *mg; + IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT; + + if (IoDIRP(io)) + Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is already open as a dirhandle", + HEKfARG(GvENAME_HEK(gv))); + + mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + /* Method's args are same as ours ... */ + /* ... except handle is replaced by the object */ + return Perl_tied_method(aTHX_ SV_CONST(OPEN), mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); + } } if (MARK < SP) { - sv = *++MARK; + sv = *++MARK; } else { - sv = GvSVn(gv); + sv = GvSVn(gv); } tmps = SvPV_const(sv, len); ok = do_open6(gv, tmps, len, NULL, MARK+1, (SP-MARK)); SP = ORIGMARK; if (ok) - PUSHi( (I32)PL_forkprocess ); + PUSHi( (I32)PL_forkprocess ); else if (PL_forkprocess == 0) /* we are a new child */ - PUSHs(&PL_sv_zero); + PUSHs(&PL_sv_zero); else - RETPUSHUNDEF; + RETPUSHUNDEF; RETURN; } @@ -653,19 +653,19 @@ PP(pp_close) /* pp_coreargs pushes a NULL to indicate no args passed to * CORE::close() */ GV * const gv = - MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs); + MAXARG == 0 || (!TOPs && !POPs) ? PL_defoutgv : MUTABLE_GV(POPs); if (MAXARG == 0) - EXTEND(SP, 1); + EXTEND(SP, 1); if (gv) { - IO * const io = GvIO(gv); - if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - return tied_method0(SV_CONST(CLOSE), SP, MUTABLE_SV(io), mg); - } - } + IO * const io = GvIO(gv); + if (io) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + return tied_method0(SV_CONST(CLOSE), SP, MUTABLE_SV(io), mg); + } + } } PUSHs(boolSV(do_close(gv, TRUE))); RETURN; @@ -684,14 +684,14 @@ PP(pp_pipe_op) rstio = GvIOn(rgv); if (IoIFP(rstio)) - do_close(rgv, FALSE); + do_close(rgv, FALSE); wstio = GvIOn(wgv); if (IoIFP(wstio)) - do_close(wgv, FALSE); + do_close(wgv, FALSE); if (PerlProc_pipe_cloexec(fd) < 0) - goto badexit; + goto badexit; IoIFP(rstio) = PerlIO_fdopen(fd[0], "r" PIPE_OPEN_MODE); IoOFP(wstio) = PerlIO_fdopen(fd[1], "w" PIPE_OPEN_MODE); @@ -701,15 +701,15 @@ PP(pp_pipe_op) IoTYPE(wstio) = IoTYPE_WRONLY; if (!IoIFP(rstio) || !IoOFP(wstio)) { - if (IoIFP(rstio)) - PerlIO_close(IoIFP(rstio)); - else - PerlLIO_close(fd[0]); - if (IoOFP(wstio)) - PerlIO_close(IoOFP(wstio)); - else - PerlLIO_close(fd[1]); - goto badexit; + if (IoIFP(rstio)) + PerlIO_close(IoIFP(rstio)); + else + PerlLIO_close(fd[0]); + if (IoOFP(wstio)) + PerlIO_close(IoOFP(wstio)); + else + PerlLIO_close(fd[1]); + goto badexit; } RETPUSHYES; @@ -729,14 +729,14 @@ PP(pp_fileno) const MAGIC *mg; if (MAXARG < 1) - RETPUSHUNDEF; + RETPUSHUNDEF; gv = MUTABLE_GV(POPs); io = GvIO(gv); if (io - && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { - return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg); + return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg); } if (io && IoDIRP(io)) { @@ -756,12 +756,12 @@ PP(pp_fileno) } if (!io || !(fp = IoIFP(io))) { - /* Can't do this because people seem to do things like - defined(fileno($foo)) to check whether $foo is a valid fh. + /* Can't do this because people seem to do things like + defined(fileno($foo)) to check whether $foo is a valid fh. - report_evil_fh(gv); - */ - RETPUSHUNDEF; + report_evil_fh(gv); + */ + RETPUSHUNDEF; } PUSHi(PerlIO_fileno(fp)); @@ -776,15 +776,15 @@ PP(pp_umask) Mode_t anum; if (MAXARG < 1 || (!TOPs && !POPs)) { - anum = PerlLIO_umask(022); - /* setting it to 022 between the two calls to umask avoids - * to have a window where the umask is set to 0 -- meaning - * that another thread could create world-writeable files. */ - if (anum != 022) - (void)PerlLIO_umask(anum); + anum = PerlLIO_umask(022); + /* setting it to 022 between the two calls to umask avoids + * to have a window where the umask is set to 0 -- meaning + * that another thread could create world-writeable files. */ + if (anum != 022) + (void)PerlLIO_umask(anum); } else - anum = PerlLIO_umask(POPi); + anum = PerlLIO_umask(POPi); TAINT_PROPER("umask"); XPUSHi(anum); #else @@ -792,7 +792,7 @@ PP(pp_umask) * Otherwise it's harmless and more useful to just return undef * since 'group' and 'other' concepts probably don't exist here. */ if (MAXARG >= 1 && (TOPs||POPs) && (POPi & 0700)) - DIE(aTHX_ "umask not implemented"); + DIE(aTHX_ "umask not implemented"); XPUSHs(&PL_sv_undef); #endif RETURN; @@ -807,55 +807,55 @@ PP(pp_binmode) SV *discp = NULL; if (MAXARG < 1) - RETPUSHUNDEF; + RETPUSHUNDEF; if (MAXARG > 1) { - discp = POPs; + discp = POPs; } gv = MUTABLE_GV(POPs); io = GvIO(gv); if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - /* This takes advantage of the implementation of the varargs - function, which I don't think that the optimiser will be able to - figure out. Although, as it's a static function, in theory it - could. */ - return Perl_tied_method(aTHX_ SV_CONST(BINMODE), SP, MUTABLE_SV(io), mg, - G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED, - discp ? 1 : 0, discp); - } + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + /* This takes advantage of the implementation of the varargs + function, which I don't think that the optimiser will be able to + figure out. Although, as it's a static function, in theory it + could. */ + return Perl_tied_method(aTHX_ SV_CONST(BINMODE), SP, MUTABLE_SV(io), mg, + G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED, + discp ? 1 : 0, discp); + } } if (!io || !(fp = IoIFP(io))) { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; } PUTBACK; { - STRLEN len = 0; - const char *d = NULL; - int mode; - if (discp) - d = SvPV_const(discp, len); - mode = mode_from_discipline(d, len); - if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) { - if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { - if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) { - SPAGAIN; - RETPUSHUNDEF; - } - } - SPAGAIN; - RETPUSHYES; - } - else { - SPAGAIN; - RETPUSHUNDEF; - } + STRLEN len = 0; + const char *d = NULL; + int mode; + if (discp) + d = SvPV_const(discp, len); + mode = mode_from_discipline(d, len); + if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) { + if (IoOFP(io) && IoOFP(io) != IoIFP(io)) { + if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) { + SPAGAIN; + RETPUSHUNDEF; + } + } + SPAGAIN; + RETPUSHYES; + } + else { + SPAGAIN; + RETPUSHUNDEF; + } } } @@ -872,66 +872,66 @@ PP(pp_tie) SV *varsv = *++MARK; switch(SvTYPE(varsv)) { - case SVt_PVHV: - { - HE *entry; - methname = "TIEHASH"; - if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) { - HvLAZYDEL_off(varsv); - hv_free_ent((HV *)varsv, entry); - } - HvEITER_set(MUTABLE_HV(varsv), 0); - break; - } - case SVt_PVAV: - methname = "TIEARRAY"; - if (!AvREAL(varsv)) { - if (!AvREIFY(varsv)) - Perl_croak(aTHX_ "Cannot tie unreifiable array"); - av_clear((AV *)varsv); - AvREIFY_off(varsv); - AvREAL_on(varsv); - } - break; - case SVt_PVGV: - case SVt_PVLV: - if (isGV_with_GP(varsv) && !SvFAKE(varsv)) { - methname = "TIEHANDLE"; - how = PERL_MAGIC_tiedscalar; - /* For tied filehandles, we apply tiedscalar magic to the IO - slot of the GP rather than the GV itself. AMS 20010812 */ - if (!GvIOp(varsv)) - GvIOp(varsv) = newIO(); - varsv = MUTABLE_SV(GvIOp(varsv)); - break; - } - if (SvTYPE(varsv) == SVt_PVLV && LvTYPE(varsv) == 'y') { - vivify_defelem(varsv); - varsv = LvTARG(varsv); - } - /* FALLTHROUGH */ - default: - methname = "TIESCALAR"; - how = PERL_MAGIC_tiedscalar; - break; + case SVt_PVHV: + { + HE *entry; + methname = "TIEHASH"; + if (HvLAZYDEL(varsv) && (entry = HvEITER((HV *)varsv))) { + HvLAZYDEL_off(varsv); + hv_free_ent((HV *)varsv, entry); + } + HvEITER_set(MUTABLE_HV(varsv), 0); + break; + } + case SVt_PVAV: + methname = "TIEARRAY"; + if (!AvREAL(varsv)) { + if (!AvREIFY(varsv)) + Perl_croak(aTHX_ "Cannot tie unreifiable array"); + av_clear((AV *)varsv); + AvREIFY_off(varsv); + AvREAL_on(varsv); + } + break; + case SVt_PVGV: + case SVt_PVLV: + if (isGV_with_GP(varsv) && !SvFAKE(varsv)) { + methname = "TIEHANDLE"; + how = PERL_MAGIC_tiedscalar; + /* For tied filehandles, we apply tiedscalar magic to the IO + slot of the GP rather than the GV itself. AMS 20010812 */ + if (!GvIOp(varsv)) + GvIOp(varsv) = newIO(); + varsv = MUTABLE_SV(GvIOp(varsv)); + break; + } + if (SvTYPE(varsv) == SVt_PVLV && LvTYPE(varsv) == 'y') { + vivify_defelem(varsv); + varsv = LvTARG(varsv); + } + /* FALLTHROUGH */ + default: + methname = "TIESCALAR"; + how = PERL_MAGIC_tiedscalar; + break; } items = SP - MARK++; if (sv_isobject(*MARK)) { /* Calls GET magic. */ - ENTER_with_name("call_TIE"); - PUSHSTACKi(PERLSI_MAGIC); - PUSHMARK(SP); - EXTEND(SP,(I32)items); - while (items--) - PUSHs(*MARK++); - PUTBACK; - call_method(methname, G_SCALAR); + ENTER_with_name("call_TIE"); + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,(I32)items); + while (items--) + PUSHs(*MARK++); + PUTBACK; + call_method(methname, G_SCALAR); } else { - /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO" - * will attempt to invoke IO::File::TIEARRAY, with (best case) the - * wrong error message, and worse case, supreme action at a distance. - * (Sorry obfuscation writers. You're not going to be given this one.) - */ + /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO" + * will attempt to invoke IO::File::TIEARRAY, with (best case) the + * wrong error message, and worse case, supreme action at a distance. + * (Sorry obfuscation writers. You're not going to be given this one.) + */ stash = gv_stashsv(*MARK, 0); if (!stash) { if (SvROK(*MARK)) @@ -963,28 +963,28 @@ PP(pp_tie) DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" HEKf "\"", methname, HvENAME_HEK_NN(stash)); } - ENTER_with_name("call_TIE"); - PUSHSTACKi(PERLSI_MAGIC); - PUSHMARK(SP); - EXTEND(SP,(I32)items); - while (items--) - PUSHs(*MARK++); - PUTBACK; - call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR); + ENTER_with_name("call_TIE"); + PUSHSTACKi(PERLSI_MAGIC); + PUSHMARK(SP); + EXTEND(SP,(I32)items); + while (items--) + PUSHs(*MARK++); + PUTBACK; + call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR); } SPAGAIN; sv = TOPs; POPSTACK; if (sv_isobject(sv)) { - sv_unmagic(varsv, how); - /* Croak if a self-tie on an aggregate is attempted. */ - if (varsv == SvRV(sv) && - (SvTYPE(varsv) == SVt_PVAV || - SvTYPE(varsv) == SVt_PVHV)) - Perl_croak(aTHX_ - "Self-ties of arrays and hashes are not supported"); - sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0); + sv_unmagic(varsv, how); + /* Croak if a self-tie on an aggregate is attempted. */ + if (varsv == SvRV(sv) && + (SvTYPE(varsv) == SVt_PVAV || + SvTYPE(varsv) == SVt_PVHV)) + Perl_croak(aTHX_ + "Self-ties of arrays and hashes are not supported"); + sv_magic(varsv, (SvRV(sv) == varsv ? NULL : sv), how, NULL, 0); } LEAVE_with_name("call_TIE"); SP = PL_stack_base + markoff; @@ -1001,34 +1001,34 @@ PP(pp_untie) MAGIC *mg; SV *sv = POPs; const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) - ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; + ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv)))) - RETPUSHYES; + RETPUSHYES; if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' && - !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF; + !(sv = defelem_target(sv, NULL))) RETPUSHUNDEF; if ((mg = SvTIED_mg(sv, how))) { - SV * const obj = SvRV(SvTIED_obj(sv, mg)); + SV * const obj = SvRV(SvTIED_obj(sv, mg)); if (obj && SvSTASH(obj)) { - GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE); - CV *cv; - if (gv && isGV(gv) && (cv = GvCV(gv))) { - PUSHMARK(SP); - PUSHs(SvTIED_obj(MUTABLE_SV(gv), mg)); - mXPUSHi(SvREFCNT(obj) - 1); - PUTBACK; - ENTER_with_name("call_UNTIE"); - call_sv(MUTABLE_SV(cv), G_VOID); - LEAVE_with_name("call_UNTIE"); - SPAGAIN; + GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE); + CV *cv; + if (gv && isGV(gv) && (cv = GvCV(gv))) { + PUSHMARK(SP); + PUSHs(SvTIED_obj(MUTABLE_SV(gv), mg)); + mXPUSHi(SvREFCNT(obj) - 1); + PUTBACK; + ENTER_with_name("call_UNTIE"); + call_sv(MUTABLE_SV(cv), G_VOID); + LEAVE_with_name("call_UNTIE"); + SPAGAIN; + } + else if (mg && SvREFCNT(obj) > 1) { + Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE), + "untie attempted while %" UVuf " inner references still exist", + (UV)SvREFCNT(obj) - 1 ) ; } - else if (mg && SvREFCNT(obj) > 1) { - Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE), - "untie attempted while %" UVuf " inner references still exist", - (UV)SvREFCNT(obj) - 1 ) ; - } } } sv_unmagic(sv, how) ; @@ -1041,17 +1041,17 @@ PP(pp_tied) const MAGIC *mg; dTOPss; const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV) - ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; + ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar; if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv)))) - goto ret_undef; + goto ret_undef; if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y' && - !(sv = defelem_target(sv, NULL))) goto ret_undef; + !(sv = defelem_target(sv, NULL))) goto ret_undef; if ((mg = SvTIED_mg(sv, how))) { - SETs(SvTIED_obj(sv, mg)); - return NORMAL; /* PUTBACK not needed, pp_tied never moves SP */ + SETs(SvTIED_obj(sv, mg)); + return NORMAL; /* PUTBACK not needed, pp_tied never moves SP */ } ret_undef: SETs(&PL_sv_undef); @@ -1069,11 +1069,11 @@ PP(pp_dbmopen) SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP); stash = gv_stashsv(sv, 0); if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) { - PUTBACK; - require_pv("AnyDBM_File.pm"); - SPAGAIN; - if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) - DIE(aTHX_ "No dbm on this machine"); + PUTBACK; + require_pv("AnyDBM_File.pm"); + SPAGAIN; + if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) + DIE(aTHX_ "No dbm on this machine"); } ENTER; @@ -1083,11 +1083,11 @@ PP(pp_dbmopen) PUSHs(sv); PUSHs(left); if (SvIV(right)) - mPUSHu(O_RDWR|O_CREAT); + mPUSHu(O_RDWR|O_CREAT); else { - mPUSHu(O_RDWR); - if (!SvOK(right)) right = &PL_sv_no; + mPUSHu(O_RDWR); + if (!SvOK(right)) right = &PL_sv_no; } PUSHs(right); PUTBACK; @@ -1095,22 +1095,22 @@ PP(pp_dbmopen) SPAGAIN; if (!sv_isobject(TOPs)) { - SP--; - PUSHMARK(SP); - PUSHs(sv); - PUSHs(left); - mPUSHu(O_RDONLY); - PUSHs(right); - PUTBACK; - call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR); - SPAGAIN; + SP--; + PUSHMARK(SP); + PUSHs(sv); + PUSHs(left); + mPUSHu(O_RDONLY); + PUSHs(right); + PUTBACK; + call_sv(MUTABLE_SV(GvCV(gv)), G_SCALAR); + SPAGAIN; if (sv_isobject(TOPs)) goto retie; } else { retie: - sv_unmagic(MUTABLE_SV(hv), PERL_MAGIC_tied); - sv_magic(MUTABLE_SV(hv), TOPs, PERL_MAGIC_tied, NULL, 0); + sv_unmagic(MUTABLE_SV(hv), PERL_MAGIC_tied); + sv_magic(MUTABLE_SV(hv), TOPs, PERL_MAGIC_tied, NULL, 0); } LEAVE; RETURN; @@ -1133,9 +1133,9 @@ PP(pp_sselect) char *fd_sets[4]; SV *svs[4]; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - I32 masksize; - I32 offset; - I32 k; + I32 masksize; + I32 offset; + I32 k; # if BYTEORDER & 0xf0000 # define ORDERBYTE (0x88888888 - BYTEORDER) @@ -1147,29 +1147,29 @@ PP(pp_sselect) SP -= 4; for (i = 1; i <= 3; i++) { - SV * const sv = svs[i] = SP[i]; - SvGETMAGIC(sv); - if (!SvOK(sv)) - continue; - if (SvREADONLY(sv)) { - if (!(SvPOK(sv) && SvCUR(sv) == 0)) - Perl_croak_no_modify(); - } - else if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0); - if (!SvPOK(sv)) { - if (!SvPOKp(sv)) - Perl_ck_warner(aTHX_ packWARN(WARN_MISC), - "Non-string passed as bitmask"); - if (SvGAMAGIC(sv)) { - svs[i] = sv_newmortal(); - sv_copypv_nomg(svs[i], sv); - } - else - SvPV_force_nomg_nolen(sv); /* force string conversion */ - } - j = SvCUR(svs[i]); - if (maxlen < j) - maxlen = j; + SV * const sv = svs[i] = SP[i]; + SvGETMAGIC(sv); + if (!SvOK(sv)) + continue; + if (SvREADONLY(sv)) { + if (!(SvPOK(sv) && SvCUR(sv) == 0)) + Perl_croak_no_modify(); + } + else if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0); + if (!SvPOK(sv)) { + if (!SvPOKp(sv)) + Perl_ck_warner(aTHX_ packWARN(WARN_MISC), + "Non-string passed as bitmask"); + if (SvGAMAGIC(sv)) { + svs[i] = sv_newmortal(); + sv_copypv_nomg(svs[i], sv); + } + else + SvPV_force_nomg_nolen(sv); /* force string conversion */ + } + j = SvCUR(svs[i]); + if (maxlen < j) + maxlen = j; } /* little endians can use vecs directly */ @@ -1205,42 +1205,42 @@ PP(pp_sselect) sv = SP[4]; SvGETMAGIC(sv); if (SvOK(sv)) { - value = SvNV_nomg(sv); - if (value < 0.0) - value = 0.0; - timebuf.tv_sec = (long)value; - value -= (NV)timebuf.tv_sec; - timebuf.tv_usec = (long)(value * 1000000.0); + value = SvNV_nomg(sv); + if (value < 0.0) + value = 0.0; + timebuf.tv_sec = (long)value; + value -= (NV)timebuf.tv_sec; + timebuf.tv_usec = (long)(value * 1000000.0); } else - tbuf = NULL; + tbuf = NULL; for (i = 1; i <= 3; i++) { - sv = svs[i]; - if (!SvOK(sv) || SvCUR(sv) == 0) { - fd_sets[i] = 0; - continue; - } - assert(SvPOK(sv)); - j = SvLEN(sv); - if (j < growsize) { - Sv_Grow(sv, growsize); - } - j = SvCUR(sv); - s = SvPVX(sv) + j; - while (++j <= growsize) { - *s++ = '\0'; - } + sv = svs[i]; + if (!SvOK(sv) || SvCUR(sv) == 0) { + fd_sets[i] = 0; + continue; + } + assert(SvPOK(sv)); + j = SvLEN(sv); + if (j < growsize) { + Sv_Grow(sv, growsize); + } + j = SvCUR(sv); + s = SvPVX(sv) + j; + while (++j <= growsize) { + *s++ = '\0'; + } #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - s = SvPVX(sv); - Newx(fd_sets[i], growsize, char); - for (offset = 0; offset < growsize; offset += masksize) { - for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) - fd_sets[i][j+offset] = s[(k % masksize) + offset]; - } + s = SvPVX(sv); + Newx(fd_sets[i], growsize, char); + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + fd_sets[i][j+offset] = s[(k % masksize) + offset]; + } #else - fd_sets[i] = SvPVX(sv); + fd_sets[i] = SvPVX(sv); #endif } @@ -1248,42 +1248,42 @@ PP(pp_sselect) /* Can't make just the (void*) conditional because that would be * cpp #if within cpp macro, and not all compilers like that. */ nfound = PerlSock_select( - maxlen * 8, - (Select_fd_set_t) fd_sets[1], - (Select_fd_set_t) fd_sets[2], - (Select_fd_set_t) fd_sets[3], - (void*) tbuf); /* Workaround for compiler bug. */ + maxlen * 8, + (Select_fd_set_t) fd_sets[1], + (Select_fd_set_t) fd_sets[2], + (Select_fd_set_t) fd_sets[3], + (void*) tbuf); /* Workaround for compiler bug. */ #else nfound = PerlSock_select( - maxlen * 8, - (Select_fd_set_t) fd_sets[1], - (Select_fd_set_t) fd_sets[2], - (Select_fd_set_t) fd_sets[3], - tbuf); + maxlen * 8, + (Select_fd_set_t) fd_sets[1], + (Select_fd_set_t) fd_sets[2], + (Select_fd_set_t) fd_sets[3], + tbuf); #endif for (i = 1; i <= 3; i++) { - if (fd_sets[i]) { - sv = svs[i]; + if (fd_sets[i]) { + sv = svs[i]; #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678 - s = SvPVX(sv); - for (offset = 0; offset < growsize; offset += masksize) { - for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) - s[(k % masksize) + offset] = fd_sets[i][j+offset]; - } - Safefree(fd_sets[i]); + s = SvPVX(sv); + for (offset = 0; offset < growsize; offset += masksize) { + for (j = 0, k=ORDERBYTE; j < masksize; j++, (k >>= 4)) + s[(k % masksize) + offset] = fd_sets[i][j+offset]; + } + Safefree(fd_sets[i]); #endif - if (sv != SP[i]) - SvSetMagicSV(SP[i], sv); - else - SvSETMAGIC(sv); - } + if (sv != SP[i]) + SvSetMagicSV(SP[i], sv); + else + SvSETMAGIC(sv); + } } PUSHi(nfound); if (GIMME_V == G_ARRAY && tbuf) { - value = (NV)(timebuf.tv_sec) + - (NV)(timebuf.tv_usec) / 1000000.0; - mPUSHn(value); + value = (NV)(timebuf.tv_sec) + + (NV)(timebuf.tv_usec) / 1000000.0; + mPUSHn(value); } RETURN; #else @@ -1326,23 +1326,23 @@ PP(pp_select) GV * const *gvp; if (!egv) - egv = PL_defoutgv; + egv = PL_defoutgv; hv = isGV_with_GP(egv) ? GvSTASH(egv) : NULL; gvp = hv && HvENAME(hv) - ? (GV**)hv_fetch(hv, GvNAME(egv), HEK_UTF8(GvNAME_HEK(egv)) ? -GvNAMELEN(egv) : GvNAMELEN(egv), FALSE) - : NULL; + ? (GV**)hv_fetch(hv, GvNAME(egv), HEK_UTF8(GvNAME_HEK(egv)) ? -GvNAMELEN(egv) : GvNAMELEN(egv), FALSE) + : NULL; if (gvp && *gvp == egv) { - gv_efullname4(TARG, PL_defoutgv, NULL, TRUE); - XPUSHTARG; + gv_efullname4(TARG, PL_defoutgv, NULL, TRUE); + XPUSHTARG; } else { - mXPUSHs(newRV(MUTABLE_SV(egv))); + mXPUSHs(newRV(MUTABLE_SV(egv))); } if (newdefout) { - if (!GvIO(newdefout)) - gv_IOadd(newdefout); - setdefout(newdefout); + if (!GvIO(newdefout)) + gv_IOadd(newdefout); + setdefout(newdefout); } RETURN; @@ -1354,42 +1354,42 @@ PP(pp_getc) /* pp_coreargs pushes a NULL to indicate no args passed to * CORE::getc() */ GV * const gv = - MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs); + MAXARG==0 || (!TOPs && !POPs) ? PL_stdingv : MUTABLE_GV(POPs); IO *const io = GvIO(gv); if (MAXARG == 0) - EXTEND(SP, 1); + EXTEND(SP, 1); if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - const U8 gimme = GIMME_V; - Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0); - if (gimme == G_SCALAR) { - SPAGAIN; - SvSetMagicSV_nosteal(TARG, TOPs); - } - return NORMAL; - } + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + const U8 gimme = GIMME_V; + Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0); + if (gimme == G_SCALAR) { + SPAGAIN; + SvSetMagicSV_nosteal(TARG, TOPs); + } + return NORMAL; + } } if (!gv || do_eof(gv)) { /* make sure we have fp with something */ - if (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)) - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - RETPUSHUNDEF; + if (!io || (!IoIFP(io) && IoTYPE(io) != IoTYPE_WRONLY)) + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; } TAINT; sv_setpvs(TARG, " "); *SvPVX(TARG) = PerlIO_getc(IoIFP(GvIOp(gv))); /* should never be EOF */ if (PerlIO_isutf8(IoIFP(GvIOp(gv)))) { - /* Find out how many bytes the char needs */ - Size_t len = UTF8SKIP(SvPVX_const(TARG)); - if (len > 1) { - SvGROW(TARG,len+1); - len = PerlIO_read(IoIFP(GvIOp(gv)),SvPVX(TARG)+1,len-1); - SvCUR_set(TARG,1+len); - } - SvUTF8_on(TARG); + /* Find out how many bytes the char needs */ + Size_t len = UTF8SKIP(SvPVX_const(TARG)); + if (len > 1) { + SvGROW(TARG,len+1); + len = PerlIO_read(IoIFP(GvIOp(gv)),SvPVX(TARG)+1,len-1); + SvCUR_set(TARG,1+len); + } + SvUTF8_on(TARG); } else SvUTF8_off(TARG); PUSHTARG; @@ -1405,12 +1405,12 @@ S_doform(pTHX_ CV *cv, GV *gv, OP *retop) PERL_ARGS_ASSERT_DOFORM; if (CvCLONE(cv)) - cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); + cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv)))); cx = cx_pushblock(CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix); cx_pushformat(cx, cv, retop, gv); if (CvDEPTH(cv) >= 2) - pad_push(CvPADLIST(cv), CvDEPTH(cv)); + pad_push(CvPADLIST(cv), CvDEPTH(cv)); PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv)); setdefout(gv); /* locally select filehandle so $% et al work */ @@ -1426,30 +1426,30 @@ PP(pp_enterwrite) CV *cv = NULL; if (MAXARG == 0) { - EXTEND(SP, 1); - gv = PL_defoutgv; + EXTEND(SP, 1); + gv = PL_defoutgv; } else { - gv = MUTABLE_GV(POPs); - if (!gv) - gv = PL_defoutgv; + gv = MUTABLE_GV(POPs); + if (!gv) + gv = PL_defoutgv; } io = GvIO(gv); if (!io) { - RETPUSHNO; + RETPUSHNO; } if (IoFMT_GV(io)) - fgv = IoFMT_GV(io); + fgv = IoFMT_GV(io); else - fgv = gv; + fgv = gv; assert(fgv); cv = GvFORM(fgv); if (!cv) { SV * const tmpsv = sv_newmortal(); - gv_efullname4(tmpsv, fgv, NULL, FALSE); - DIE(aTHX_ "Undefined format \"%" SVf "\" called", SVfARG(tmpsv)); + gv_efullname4(tmpsv, fgv, NULL, FALSE); + DIE(aTHX_ "Undefined format \"%" SVf "\" called", SVfARG(tmpsv)); } IoFLAGS(io) &= ~IOf_DIDTOP; RETURNOP(doform(cv,gv,PL_op->op_next)); @@ -1470,72 +1470,72 @@ PP(pp_leavewrite) goto forget_top; DEBUG_f(PerlIO_printf(Perl_debug_log, "left=%ld, todo=%ld\n", - (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget))); + (long)IoLINES_LEFT(io), (long)FmLINES(PL_formtarget))); if (IoLINES_LEFT(io) < FmLINES(PL_formtarget) && - PL_formtarget != PL_toptarget) + PL_formtarget != PL_toptarget) { - GV *fgv; - CV *cv; - if (!IoTOP_GV(io)) { - GV *topgv; - - if (!IoTOP_NAME(io)) { - SV *topname; - if (!IoFMT_NAME(io)) - IoFMT_NAME(io) = savepv(GvNAME(gv)); - topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%" HEKf "_TOP", + GV *fgv; + CV *cv; + if (!IoTOP_GV(io)) { + GV *topgv; + + if (!IoTOP_NAME(io)) { + SV *topname; + if (!IoFMT_NAME(io)) + IoFMT_NAME(io) = savepv(GvNAME(gv)); + topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%" HEKf "_TOP", HEKfARG(GvNAME_HEK(gv)))); - topgv = gv_fetchsv(topname, 0, SVt_PVFM); - if ((topgv && GvFORM(topgv)) || - !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM)) - IoTOP_NAME(io) = savesvpv(topname); - else - IoTOP_NAME(io) = savepvs("top"); - } - topgv = gv_fetchpv(IoTOP_NAME(io), 0, SVt_PVFM); - if (!topgv || !GvFORM(topgv)) { - IoLINES_LEFT(io) = IoPAGE_LEN(io); - goto forget_top; - } - IoTOP_GV(io) = topgv; - } - if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */ - I32 lines = IoLINES_LEFT(io); - const char *s = SvPVX_const(PL_formtarget); + topgv = gv_fetchsv(topname, 0, SVt_PVFM); + if ((topgv && GvFORM(topgv)) || + !gv_fetchpvs("top", GV_NOTQUAL, SVt_PVFM)) + IoTOP_NAME(io) = savesvpv(topname); + else + IoTOP_NAME(io) = savepvs("top"); + } + topgv = gv_fetchpv(IoTOP_NAME(io), 0, SVt_PVFM); + if (!topgv || !GvFORM(topgv)) { + IoLINES_LEFT(io) = IoPAGE_LEN(io); + goto forget_top; + } + IoTOP_GV(io) = topgv; + } + if (IoFLAGS(io) & IOf_DIDTOP) { /* Oh dear. It still doesn't fit. */ + I32 lines = IoLINES_LEFT(io); + const char *s = SvPVX_const(PL_formtarget); const char *e = SvEND(PL_formtarget); - if (lines <= 0) /* Yow, header didn't even fit!!! */ - goto forget_top; - while (lines-- > 0) { - s = (char *) memchr(s, '\n', e - s); - if (!s) - break; - s++; - } - if (s) { - const STRLEN save = SvCUR(PL_formtarget); - SvCUR_set(PL_formtarget, s - SvPVX_const(PL_formtarget)); - do_print(PL_formtarget, ofp); - SvCUR_set(PL_formtarget, save); - sv_chop(PL_formtarget, s); - FmLINES(PL_formtarget) -= IoLINES_LEFT(io); - } - } - if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0) - do_print(GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV)), ofp); - IoLINES_LEFT(io) = IoPAGE_LEN(io); - IoPAGE(io)++; - PL_formtarget = PL_toptarget; - IoFLAGS(io) |= IOf_DIDTOP; - fgv = IoTOP_GV(io); - assert(fgv); /* IoTOP_GV(io) should have been set above */ - cv = GvFORM(fgv); - if (!cv) { - SV * const sv = sv_newmortal(); - gv_efullname4(sv, fgv, NULL, FALSE); - DIE(aTHX_ "Undefined top format \"%" SVf "\" called", SVfARG(sv)); - } - return doform(cv, gv, PL_op); + if (lines <= 0) /* Yow, header didn't even fit!!! */ + goto forget_top; + while (lines-- > 0) { + s = (char *) memchr(s, '\n', e - s); + if (!s) + break; + s++; + } + if (s) { + const STRLEN save = SvCUR(PL_formtarget); + SvCUR_set(PL_formtarget, s - SvPVX_const(PL_formtarget)); + do_print(PL_formtarget, ofp); + SvCUR_set(PL_formtarget, save); + sv_chop(PL_formtarget, s); + FmLINES(PL_formtarget) -= IoLINES_LEFT(io); + } + } + if (IoLINES_LEFT(io) >= 0 && IoPAGE(io) > 0) + do_print(GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV)), ofp); + IoLINES_LEFT(io) = IoPAGE_LEN(io); + IoPAGE(io)++; + PL_formtarget = PL_toptarget; + IoFLAGS(io) |= IOf_DIDTOP; + fgv = IoTOP_GV(io); + assert(fgv); /* IoTOP_GV(io) should have been set above */ + cv = GvFORM(fgv); + if (!cv) { + SV * const sv = sv_newmortal(); + gv_efullname4(sv, fgv, NULL, FALSE); + DIE(aTHX_ "Undefined top format \"%" SVf "\" called", SVfARG(sv)); + } + return doform(cv, gv, PL_op); } forget_top: @@ -1555,28 +1555,28 @@ PP(pp_leavewrite) * Currently we ignore any args to 'return' and just return * a single undef in both scalar and list contexts */ - PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); else if (!io || !(fp = IoOFP(io))) { - if (io && IoIFP(io)) - report_wrongway_fh(gv, '<'); - else - report_evil_fh(gv); - PUSHs(&PL_sv_no); + if (io && IoIFP(io)) + report_wrongway_fh(gv, '<'); + else + report_evil_fh(gv); + PUSHs(&PL_sv_no); } else { - if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow"); - } - if (!do_print(PL_formtarget, fp)) - PUSHs(&PL_sv_no); - else { - FmLINES(PL_formtarget) = 0; - SvCUR_set(PL_formtarget, 0); - *SvEND(PL_formtarget) = '\0'; - if (IoFLAGS(io) & IOf_FLUSH) - (void)PerlIO_flush(fp); - PUSHs(&PL_sv_yes); - } + if ((IoLINES_LEFT(io) -= FmLINES(PL_formtarget)) < 0) { + Perl_ck_warner(aTHX_ packWARN(WARN_IO), "page overflow"); + } + if (!do_print(PL_formtarget, fp)) + PUSHs(&PL_sv_no); + else { + FmLINES(PL_formtarget) = 0; + SvCUR_set(PL_formtarget, 0); + *SvEND(PL_formtarget) = '\0'; + if (IoFLAGS(io) & IOf_FLUSH) + (void)PerlIO_flush(fp); + PUSHs(&PL_sv_yes); + } } PL_formtarget = PL_bodytarget; RETURNOP(retop); @@ -1588,50 +1588,50 @@ PP(pp_prtf) PerlIO *fp; GV * const gv - = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv; + = (PL_op->op_flags & OPf_STACKED) ? MUTABLE_GV(*++MARK) : PL_defoutgv; IO *const io = GvIO(gv); /* Treat empty list as "" */ if (MARK == SP) XPUSHs(&PL_sv_no); if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - if (MARK == ORIGMARK) { - MEXTEND(SP, 1); - ++MARK; - Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); - ++SP; - } - return Perl_tied_method(aTHX_ SV_CONST(PRINTF), mark - 1, MUTABLE_SV(io), - mg, - G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, - sp - mark); - } + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + if (MARK == ORIGMARK) { + MEXTEND(SP, 1); + ++MARK; + Move(MARK, MARK + 1, (SP - MARK) + 1, SV*); + ++SP; + } + return Perl_tied_method(aTHX_ SV_CONST(PRINTF), mark - 1, MUTABLE_SV(io), + mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); + } } if (!io) { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - goto just_say_no; + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + goto just_say_no; } else if (!(fp = IoOFP(io))) { - if (IoIFP(io)) - report_wrongway_fh(gv, '<'); - else if (ckWARN(WARN_CLOSED)) - report_evil_fh(gv); - SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); - goto just_say_no; + if (IoIFP(io)) + report_wrongway_fh(gv, '<'); + else if (ckWARN(WARN_CLOSED)) + report_evil_fh(gv); + SETERRNO(EBADF,IoIFP(io)?RMS_FAC:RMS_IFI); + goto just_say_no; } else { - SV *sv = sv_newmortal(); - do_sprintf(sv, SP - MARK, MARK + 1); - if (!do_print(sv, fp)) - goto just_say_no; + SV *sv = sv_newmortal(); + do_sprintf(sv, SP - MARK, MARK + 1); + if (!do_print(sv, fp)) + goto just_say_no; - if (IoFLAGS(io) & IOf_FLUSH) - if (PerlIO_flush(fp) == EOF) - goto just_say_no; + if (IoFLAGS(io) & IOf_FLUSH) + if (PerlIO_flush(fp) == EOF) + goto just_say_no; } SP = ORIGMARK; PUSHs(&PL_sv_yes); @@ -1655,11 +1655,11 @@ PP(pp_sysopen) /* Need TIEHANDLE method ? */ const char * const tmps = SvPV_const(sv, len); if (do_open_raw(gv, tmps, len, mode, perm, NULL)) { - IoLINES(GvIOp(gv)) = 0; - PUSHs(&PL_sv_yes); + IoLINES(GvIOp(gv)) = 0; + PUSHs(&PL_sv_yes); } else { - PUSHs(&PL_sv_undef); + PUSHs(&PL_sv_undef); } RETURN; } @@ -1690,34 +1690,34 @@ PP(pp_sysread) int fd; if ((PL_op->op_type == OP_READ || PL_op->op_type == OP_SYSREAD) - && gv && (io = GvIO(gv)) ) + && gv && (io = GvIO(gv)) ) { - const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - return Perl_tied_method(aTHX_ SV_CONST(READ), mark - 1, MUTABLE_SV(io), mg, - G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, - sp - mark); - } + const MAGIC *const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + return Perl_tied_method(aTHX_ SV_CONST(READ), mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); + } } if (!gv) - goto say_undef; + goto say_undef; bufsv = *++MARK; if (! SvOK(bufsv)) SvPVCLEAR(bufsv); length = SvIVx(*++MARK); if (length < 0) - DIE(aTHX_ "Negative length"); + DIE(aTHX_ "Negative length"); SETERRNO(0,0); if (MARK < SP) - offset = SvIVx(*++MARK); + offset = SvIVx(*++MARK); else - offset = 0; + offset = 0; io = GvIO(gv); if (!io || !IoIFP(io)) { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - goto say_undef; + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + goto say_undef; } /* Note that fd can here validly be -1, don't check it yet. */ @@ -1729,17 +1729,17 @@ PP(pp_sysread) "%s() isn't allowed on :utf8 handles", OP_DESC(PL_op)); } - buffer = SvPVutf8_force(bufsv, blen); - /* UTF-8 may not have been set if they are all low bytes */ - SvUTF8_on(bufsv); - buffer_utf8 = 0; + buffer = SvPVutf8_force(bufsv, blen); + /* UTF-8 may not have been set if they are all low bytes */ + SvUTF8_on(bufsv); + buffer_utf8 = 0; } else { - buffer = SvPV_force(bufsv, blen); - buffer_utf8 = DO_UTF8(bufsv); + buffer = SvPV_force(bufsv, blen); + buffer_utf8 = DO_UTF8(bufsv); } if (DO_UTF8(bufsv)) { - blen = sv_len_utf8_nomg(bufsv); + blen = sv_len_utf8_nomg(bufsv); } charstart = TRUE; @@ -1749,40 +1749,40 @@ PP(pp_sysread) #ifdef HAS_SOCKET if (PL_op->op_type == OP_RECV) { - Sock_size_t bufsize; - char namebuf[MAXPATHLEN]; + Sock_size_t bufsize; + char namebuf[MAXPATHLEN]; if (fd < 0) { SETERRNO(EBADF,SS_IVCHAN); goto say_undef; } #if (defined(VMS_DO_SOCKETS) && defined(DECCRTL_SOCKETS)) || defined(__QNXNTO__) - bufsize = sizeof (struct sockaddr_in); + bufsize = sizeof (struct sockaddr_in); #else - bufsize = sizeof namebuf; + bufsize = sizeof namebuf; #endif #ifdef OS2 /* At least Warp3+IAK: only the first byte of bufsize set */ - if (bufsize >= 256) - bufsize = 255; -#endif - buffer = SvGROW(bufsv, (STRLEN)(length+1)); - /* 'offset' means 'flags' here */ - count = PerlSock_recvfrom(fd, buffer, length, offset, - (struct sockaddr *)namebuf, &bufsize); - if (count < 0) + if (bufsize >= 256) + bufsize = 255; +#endif + buffer = SvGROW(bufsv, (STRLEN)(length+1)); + /* 'offset' means 'flags' here */ + count = PerlSock_recvfrom(fd, buffer, length, offset, + (struct sockaddr *)namebuf, &bufsize); + if (count < 0) goto say_undef; - /* MSG_TRUNC can give oversized count; quietly lose it */ - if (count > length) - count = length; - SvCUR_set(bufsv, count); - *SvEND(bufsv) = '\0'; - (void)SvPOK_only(bufsv); - if (fp_utf8) - SvUTF8_on(bufsv); - SvSETMAGIC(bufsv); - /* This should not be marked tainted if the fp is marked clean */ - if (!(IoFLAGS(io) & IOf_UNTAINT)) - SvTAINTED_on(bufsv); - SP = ORIGMARK; + /* MSG_TRUNC can give oversized count; quietly lose it */ + if (count > length) + count = length; + SvCUR_set(bufsv, count); + *SvEND(bufsv) = '\0'; + (void)SvPOK_only(bufsv); + if (fp_utf8) + SvUTF8_on(bufsv); + SvSETMAGIC(bufsv); + /* This should not be marked tainted if the fp is marked clean */ + if (!(IoFLAGS(io) & IOf_UNTAINT)) + SvTAINTED_on(bufsv); + SP = ORIGMARK; #if defined(__CYGWIN__) /* recvfrom() on cygwin doesn't set bufsize at all for connected sockets, leaving us with trash in the returned @@ -1791,22 +1791,22 @@ PP(pp_sysread) if (bufsize == sizeof namebuf) bufsize = 0; #endif - sv_setpvn(TARG, namebuf, bufsize); - PUSHs(TARG); - RETURN; + sv_setpvn(TARG, namebuf, bufsize); + PUSHs(TARG); + RETURN; } #endif if (offset < 0) { - if (-offset > (SSize_t)blen) - DIE(aTHX_ "Offset outside string"); - offset += blen; + if (-offset > (SSize_t)blen) + DIE(aTHX_ "Offset outside string"); + offset += blen; } if (DO_UTF8(bufsv)) { - /* convert offset-as-chars to offset-as-bytes */ - if (offset >= (SSize_t)blen) - offset += SvCUR(bufsv) - blen; - else - offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; + /* convert offset-as-chars to offset-as-bytes */ + if (offset >= (SSize_t)blen) + offset += SvCUR(bufsv) - blen; + else + offset = utf8_hop((U8 *)buffer,offset) - (U8 *) buffer; } more_bytes: @@ -1821,104 +1821,104 @@ PP(pp_sysread) IN_ENCODING Is true) */ buffer = SvGROW(bufsv, (STRLEN)(length+offset+1)); if (offset > 0 && offset > (SSize_t)orig_size) { /* Zero any newly allocated space */ - Zero(buffer+orig_size, offset-orig_size, char); + Zero(buffer+orig_size, offset-orig_size, char); } buffer = buffer + offset; if (!buffer_utf8) { - read_target = bufsv; + read_target = bufsv; } else { - /* Best to read the bytes into a new SV, upgrade that to UTF8, then - concatenate it to the current buffer. */ + /* Best to read the bytes into a new SV, upgrade that to UTF8, then + concatenate it to the current buffer. */ - /* Truncate the existing buffer to the start of where we will be - reading to: */ - SvCUR_set(bufsv, offset); + /* Truncate the existing buffer to the start of where we will be + reading to: */ + SvCUR_set(bufsv, offset); - read_target = sv_newmortal(); - SvUPGRADE(read_target, SVt_PV); - buffer = SvGROW(read_target, (STRLEN)(length + 1)); + read_target = sv_newmortal(); + SvUPGRADE(read_target, SVt_PV); + buffer = SvGROW(read_target, (STRLEN)(length + 1)); } if (PL_op->op_type == OP_SYSREAD) { #ifdef PERL_SOCK_SYSREAD_IS_RECV - if (IoTYPE(io) == IoTYPE_SOCKET) { + if (IoTYPE(io) == IoTYPE_SOCKET) { if (fd < 0) { SETERRNO(EBADF,SS_IVCHAN); count = -1; } else count = PerlSock_recv(fd, buffer, length, 0); - } - else + } + else #endif - { + { if (fd < 0) { SETERRNO(EBADF,RMS_IFI); count = -1; } else count = PerlLIO_read(fd, buffer, length); - } + } } else { - count = PerlIO_read(IoIFP(io), buffer, length); - /* PerlIO_read() - like fread() returns 0 on both error and EOF */ - if (count == 0 && PerlIO_error(IoIFP(io))) - count = -1; + count = PerlIO_read(IoIFP(io), buffer, length); + /* PerlIO_read() - like fread() returns 0 on both error and EOF */ + if (count == 0 && PerlIO_error(IoIFP(io))) + count = -1; } if (count < 0) { - if (IoTYPE(io) == IoTYPE_WRONLY) - report_wrongway_fh(gv, '>'); - goto say_undef; + if (IoTYPE(io) == IoTYPE_WRONLY) + report_wrongway_fh(gv, '>'); + goto say_undef; } SvCUR_set(read_target, count+(buffer - SvPVX_const(read_target))); *SvEND(read_target) = '\0'; (void)SvPOK_only(read_target); if (fp_utf8 && !IN_BYTES) { - /* Look at utf8 we got back and count the characters */ - const char *bend = buffer + count; - while (buffer < bend) { - if (charstart) { - skip = UTF8SKIP(buffer); - charskip = 0; - } - if (buffer - charskip + skip > bend) { - /* partial character - try for rest of it */ - length = skip - (bend-buffer); - offset = bend - SvPVX_const(bufsv); - charstart = FALSE; - charskip += count; - goto more_bytes; - } - else { - got++; - buffer += skip; - charstart = TRUE; - charskip = 0; - } + /* Look at utf8 we got back and count the characters */ + const char *bend = buffer + count; + while (buffer < bend) { + if (charstart) { + skip = UTF8SKIP(buffer); + charskip = 0; + } + if (buffer - charskip + skip > bend) { + /* partial character - try for rest of it */ + length = skip - (bend-buffer); + offset = bend - SvPVX_const(bufsv); + charstart = FALSE; + charskip += count; + goto more_bytes; + } + else { + got++; + buffer += skip; + charstart = TRUE; + charskip = 0; + } + } + /* If we have not 'got' the number of _characters_ we 'wanted' get some more + provided amount read (count) was what was requested (length) + */ + if (got < wanted && count == length) { + length = wanted - got; + offset = bend - SvPVX_const(bufsv); + goto more_bytes; } - /* If we have not 'got' the number of _characters_ we 'wanted' get some more - provided amount read (count) was what was requested (length) - */ - if (got < wanted && count == length) { - length = wanted - got; - offset = bend - SvPVX_const(bufsv); - goto more_bytes; - } - /* return value is character count */ - count = got; - SvUTF8_on(bufsv); + /* return value is character count */ + count = got; + SvUTF8_on(bufsv); } else if (buffer_utf8) { - /* Let svcatsv upgrade the bytes we read in to utf8. - The buffer is a mortal so will be freed soon. */ - sv_catsv_nomg(bufsv, read_target); + /* Let svcatsv upgrade the bytes we read in to utf8. + The buffer is a mortal so will be freed soon. */ + sv_catsv_nomg(bufsv, read_target); } SvSETMAGIC(bufsv); /* This should not be marked tainted if the fp is marked clean */ if (!(IoFLAGS(io) & IOf_UNTAINT)) - SvTAINTED_on(bufsv); + SvTAINTED_on(bufsv); SP = ORIGMARK; PUSHi(count); RETURN; @@ -1946,33 +1946,33 @@ PP(pp_syswrite) int fd; if (op_type == OP_SYSWRITE && io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - if (MARK == SP - 1) { - SV *sv = *SP; - mXPUSHi(sv_len(sv)); - PUTBACK; - } - - return Perl_tied_method(aTHX_ SV_CONST(WRITE), mark - 1, MUTABLE_SV(io), mg, - G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, - sp - mark); - } + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + if (MARK == SP - 1) { + SV *sv = *SP; + mXPUSHi(sv_len(sv)); + PUTBACK; + } + + return Perl_tied_method(aTHX_ SV_CONST(WRITE), mark - 1, MUTABLE_SV(io), mg, + G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, + sp - mark); + } } if (!gv) - goto say_undef; + goto say_undef; bufsv = *++MARK; SETERRNO(0,0); if (!io || !IoIFP(io) || IoTYPE(io) == IoTYPE_RDONLY) { - retval = -1; - if (io && IoIFP(io)) - report_wrongway_fh(gv, '<'); - else - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - goto say_undef; + retval = -1; + if (io && IoIFP(io)) + report_wrongway_fh(gv, '<'); + else + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + goto say_undef; } fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) { @@ -1991,84 +1991,84 @@ PP(pp_syswrite) OP_DESC(PL_op)); } else if (doing_utf8) { - STRLEN tmplen = blen; - U8 * const result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8); - if (!doing_utf8) { - tmpbuf = result; - buffer = (char *) tmpbuf; - blen = tmplen; - } - else { - assert((char *)result == buffer); - Perl_croak(aTHX_ "Wide character in %s", OP_DESC(PL_op)); - } + STRLEN tmplen = blen; + U8 * const result = bytes_from_utf8((const U8*) buffer, &tmplen, &doing_utf8); + if (!doing_utf8) { + tmpbuf = result; + buffer = (char *) tmpbuf; + blen = tmplen; + } + else { + assert((char *)result == buffer); + Perl_croak(aTHX_ "Wide character in %s", OP_DESC(PL_op)); + } } #ifdef HAS_SOCKET if (op_type == OP_SEND) { - const int flags = SvIVx(*++MARK); - if (SP > MARK) { - STRLEN mlen; - char * const sockbuf = SvPVx(*++MARK, mlen); - retval = PerlSock_sendto(fd, buffer, blen, - flags, (struct sockaddr *)sockbuf, mlen); - } - else { - retval = PerlSock_send(fd, buffer, blen, flags); - } + const int flags = SvIVx(*++MARK); + if (SP > MARK) { + STRLEN mlen; + char * const sockbuf = SvPVx(*++MARK, mlen); + retval = PerlSock_sendto(fd, buffer, blen, + flags, (struct sockaddr *)sockbuf, mlen); + } + else { + retval = PerlSock_send(fd, buffer, blen, flags); + } } else #endif { - Size_t length = 0; /* This length is in characters. */ - IV offset; + Size_t length = 0; /* This length is in characters. */ + IV offset; - if (MARK >= SP) { - length = blen; - } else { + if (MARK >= SP) { + length = blen; + } else { #if Size_t_size > IVSIZE - length = (Size_t)SvNVx(*++MARK); + length = (Size_t)SvNVx(*++MARK); #else - length = (Size_t)SvIVx(*++MARK); -#endif - if ((SSize_t)length < 0) { - Safefree(tmpbuf); - DIE(aTHX_ "Negative length"); - } - } - - if (MARK < SP) { - offset = SvIVx(*++MARK); - if (offset < 0) { - if (-offset > (IV)blen) { - Safefree(tmpbuf); - DIE(aTHX_ "Offset outside string"); - } - offset += blen; - } else if (offset > (IV)blen) { - Safefree(tmpbuf); - DIE(aTHX_ "Offset outside string"); - } - } else - offset = 0; - if (length > blen - offset) - length = blen - offset; + length = (Size_t)SvIVx(*++MARK); +#endif + if ((SSize_t)length < 0) { + Safefree(tmpbuf); + DIE(aTHX_ "Negative length"); + } + } + + if (MARK < SP) { + offset = SvIVx(*++MARK); + if (offset < 0) { + if (-offset > (IV)blen) { + Safefree(tmpbuf); + DIE(aTHX_ "Offset outside string"); + } + offset += blen; + } else if (offset > (IV)blen) { + Safefree(tmpbuf); + DIE(aTHX_ "Offset outside string"); + } + } else + offset = 0; + if (length > blen - offset) + length = blen - offset; buffer = buffer+offset; #ifdef PERL_SOCK_SYSWRITE_IS_SEND - if (IoTYPE(io) == IoTYPE_SOCKET) { - retval = PerlSock_send(fd, buffer, length, 0); - } - else + if (IoTYPE(io) == IoTYPE_SOCKET) { + retval = PerlSock_send(fd, buffer, length, 0); + } + else #endif - { - /* See the note at doio.c:do_print about filesize limits. --jhi */ + { + /* See the note at doio.c:do_print about filesize limits. --jhi */ retval = PerlLIO_write(fd, buffer, length); - } + } } if (retval < 0) - goto say_undef; + goto say_undef; SP = ORIGMARK; Safefree(tmpbuf); @@ -2104,48 +2104,48 @@ PP(pp_eof) unsigned int which; if (MAXARG) { - gv = PL_last_in_gv = MUTABLE_GV(POPs); /* eof(FH) */ - which = 1; + gv = PL_last_in_gv = MUTABLE_GV(POPs); /* eof(FH) */ + which = 1; } else { - EXTEND(SP, 1); + EXTEND(SP, 1); - if (PL_op->op_flags & OPf_SPECIAL) { - gv = PL_last_in_gv = GvEGVx(PL_argvgv); /* eof() - ARGV magic */ - which = 2; - } - else { - gv = PL_last_in_gv; /* eof */ - which = 0; - } + if (PL_op->op_flags & OPf_SPECIAL) { + gv = PL_last_in_gv = GvEGVx(PL_argvgv); /* eof() - ARGV magic */ + which = 2; + } + else { + gv = PL_last_in_gv; /* eof */ + which = 0; + } } if (!gv) - RETPUSHYES; + RETPUSHYES; if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { - return tied_method1(SV_CONST(EOF), SP, MUTABLE_SV(io), mg, newSVuv(which)); + return tied_method1(SV_CONST(EOF), SP, MUTABLE_SV(io), mg, newSVuv(which)); } if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) { /* eof() */ - if (io && !IoIFP(io)) { - if ((IoFLAGS(io) & IOf_START) && av_count(GvAVn(gv)) == 0) { - SV ** svp; - IoLINES(io) = 0; - IoFLAGS(io) &= ~IOf_START; - do_open6(gv, "-", 1, NULL, NULL, 0); - svp = &GvSV(gv); - if (*svp) { - SV * sv = *svp; - sv_setpvs(sv, "-"); - SvSETMAGIC(sv); - } - else - *svp = newSVpvs("-"); - } - else if (!nextargv(gv, FALSE)) - RETPUSHYES; - } + if (io && !IoIFP(io)) { + if ((IoFLAGS(io) & IOf_START) && av_count(GvAVn(gv)) == 0) { + SV ** svp; + IoLINES(io) = 0; + IoFLAGS(io) &= ~IOf_START; + do_open6(gv, "-", 1, NULL, NULL, 0); + svp = &GvSV(gv); + if (*svp) { + SV * sv = *svp; + sv_setpvs(sv, "-"); + SvSETMAGIC(sv); + } + else + *svp = newSVpvs("-"); + } + else if (!nextargv(gv, FALSE)) + RETPUSHYES; + } } PUSHs(boolSV(do_eof(gv))); @@ -2159,23 +2159,23 @@ PP(pp_tell) IO *io; if (MAXARG != 0 && (TOPs || POPs)) - PL_last_in_gv = MUTABLE_GV(POPs); + PL_last_in_gv = MUTABLE_GV(POPs); else - EXTEND(SP, 1); + EXTEND(SP, 1); gv = PL_last_in_gv; io = GvIO(gv); if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { - return tied_method0(SV_CONST(TELL), SP, MUTABLE_SV(io), mg); - } + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { + return tied_method0(SV_CONST(TELL), SP, MUTABLE_SV(io), mg); + } } else if (!gv) { - if (!errno) - SETERRNO(EBADF,RMS_IFI); - PUSHi(-1); - RETURN; + if (!errno) + SETERRNO(EBADF,RMS_IFI); + PUSHi(-1); + RETURN; } #if LSEEKSIZE > IVSIZE @@ -2203,23 +2203,23 @@ PP(pp_sysseek) IO *const io = GvIO(gv); if (io) { - const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); - if (mg) { + const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); + if (mg) { #if LSEEKSIZE > IVSIZE - SV *const offset_sv = newSVnv((NV) offset); + SV *const offset_sv = newSVnv((NV) offset); #else - SV *const offset_sv = newSViv(offset); + SV *const offset_sv = newSViv(offset); #endif - return tied_method2(SV_CONST(SEEK), SP, MUTABLE_SV(io), mg, offset_sv, - newSViv(whence)); - } + return tied_method2(SV_CONST(SEEK), SP, MUTABLE_SV(io), mg, offset_sv, + newSViv(whence)); + } } if (PL_op->op_type == OP_SEEK) - PUSHs(boolSV(do_seek(gv, offset, whence))); + PUSHs(boolSV(do_seek(gv, offset, whence))); else { - const Off_t sought = do_sysseek(gv, offset, whence); + const Off_t sought = do_sysseek(gv, offset, whence); if (sought < 0) PUSHs(&PL_sv_undef); else { @@ -2256,25 +2256,25 @@ PP(pp_truncate) /* XXX Configure probe for the signedness of the length type of *truncate() needed? XXX */ SETERRNO(0,0); { - SV * const sv = POPs; - int result = 1; - GV *tmpgv; - IO *io; - - if (PL_op->op_flags & OPf_SPECIAL - ? (tmpgv = gv_fetchsv(sv, 0, SVt_PVIO), 1) - : !!(tmpgv = MAYBE_DEREF_GV(sv)) ) { - io = GvIO(tmpgv); - if (!io) - result = 0; - else { - PerlIO *fp; - do_ftruncate_io: - TAINT_PROPER("truncate"); - if (!(fp = IoIFP(io))) { - result = 0; - } - else { + SV * const sv = POPs; + int result = 1; + GV *tmpgv; + IO *io; + + if (PL_op->op_flags & OPf_SPECIAL + ? (tmpgv = gv_fetchsv(sv, 0, SVt_PVIO), 1) + : !!(tmpgv = MAYBE_DEREF_GV(sv)) ) { + io = GvIO(tmpgv); + if (!io) + result = 0; + else { + PerlIO *fp; + do_ftruncate_io: + TAINT_PROPER("truncate"); + if (!(fp = IoIFP(io))) { + result = 0; + } + else { int fd = PerlIO_fileno(fp); if (fd < 0) { SETERRNO(EBADF,RMS_IFI); @@ -2293,21 +2293,21 @@ PP(pp_truncate) result = 0; } } - } - } - } - else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { - io = MUTABLE_IO(SvRV(sv)); /* *main::FRED{IO} for example */ - goto do_ftruncate_io; - } - else { - const char * const name = SvPV_nomg_const_nolen(sv); - TAINT_PROPER("truncate"); + } + } + } + else if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + io = MUTABLE_IO(SvRV(sv)); /* *main::FRED{IO} for example */ + goto do_ftruncate_io; + } + else { + const char * const name = SvPV_nomg_const_nolen(sv); + TAINT_PROPER("truncate"); #ifdef HAS_TRUNCATE - if (truncate(name, len) < 0) - result = 0; + if (truncate(name, len) < 0) + result = 0; #else - { + { int mode = O_RDWR; int tmpfd; @@ -2323,22 +2323,22 @@ PP(pp_truncate) #endif tmpfd = PerlLIO_open_cloexec(name, mode); - if (tmpfd < 0) { - result = 0; - } else { - if (my_chsize(tmpfd, len) < 0) - result = 0; - PerlLIO_close(tmpfd); - } - } + if (tmpfd < 0) { + result = 0; + } else { + if (my_chsize(tmpfd, len) < 0) + result = 0; + PerlLIO_close(tmpfd); + } + } #endif - } + } - if (result) - RETPUSHYES; - if (!errno) - SETERRNO(EBADF,RMS_IFI); - RETPUSHUNDEF; + if (result) + RETPUSHYES; + if (!errno) + SETERRNO(EBADF,RMS_IFI); + RETPUSHUNDEF; } } @@ -2357,26 +2357,26 @@ PP(pp_ioctl) IV retval; if (!IoIFP(io)) { - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); /* well, sort of... */ - RETPUSHUNDEF; + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); /* well, sort of... */ + RETPUSHUNDEF; } if (SvPOK(argsv) || !SvNIOK(argsv)) { - STRLEN len; - STRLEN need; - s = SvPV_force(argsv, len); - need = IOCPARM_LEN(func); - if (len < need) { - s = Sv_Grow(argsv, need + 1); - SvCUR_set(argsv, need); - } + STRLEN len; + STRLEN need; + s = SvPV_force(argsv, len); + need = IOCPARM_LEN(func); + if (len < need) { + s = Sv_Grow(argsv, need + 1); + SvCUR_set(argsv, need); + } - s[SvCUR(argsv)] = 17; /* a little sanity check here */ + s[SvCUR(argsv)] = 17; /* a little sanity check here */ } else { - retval = SvIV(argsv); - s = INT2PTR(char*,retval); /* ouch */ + retval = SvIV(argsv); + s = INT2PTR(char*,retval); /* ouch */ } optype = PL_op->op_type; @@ -2384,35 +2384,35 @@ PP(pp_ioctl) if (optype == OP_IOCTL) #ifdef HAS_IOCTL - retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s); + retval = PerlLIO_ioctl(PerlIO_fileno(IoIFP(io)), func, s); #else - DIE(aTHX_ "ioctl is not implemented"); + DIE(aTHX_ "ioctl is not implemented"); #endif else #ifndef HAS_FCNTL DIE(aTHX_ "fcntl is not implemented"); #elif defined(OS2) && defined(__EMX__) - retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s); + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, (int)s); #else - retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s); + retval = fcntl(PerlIO_fileno(IoIFP(io)), func, s); #endif #if defined(HAS_IOCTL) || defined(HAS_FCNTL) if (SvPOK(argsv)) { - if (s[SvCUR(argsv)] != 17) - DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument", - OP_NAME(PL_op)); - s[SvCUR(argsv)] = 0; /* put our null back */ - SvSETMAGIC(argsv); /* Assume it has changed */ + if (s[SvCUR(argsv)] != 17) + DIE(aTHX_ "Possible memory corruption: %s overflowed 3rd argument", + OP_NAME(PL_op)); + s[SvCUR(argsv)] = 0; /* put our null back */ + SvSETMAGIC(argsv); /* Assume it has changed */ } if (retval == -1) - RETPUSHUNDEF; + RETPUSHUNDEF; if (retval != 0) { - PUSHi(retval); + PUSHi(retval); } else { - PUSHp(zero_but_true, ZBTLEN); + PUSHp(zero_but_true, ZBTLEN); } #endif RETURN; @@ -2430,13 +2430,13 @@ PP(pp_flock) /* XXX Looks to me like io is always NULL at this point */ if (fp) { - (void)PerlIO_flush(fp); - value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); + (void)PerlIO_flush(fp); + value = (I32)(PerlLIO_flock(PerlIO_fileno(fp), argtype) >= 0); } else { - report_evil_fh(gv); - value = 0; - SETERRNO(EBADF,RMS_IFI); + report_evil_fh(gv); + value = 0; + SETERRNO(EBADF,RMS_IFI); } PUSHi(value); RETURN; @@ -2460,21 +2460,21 @@ PP(pp_socket) int fd; if (IoIFP(io)) - do_close(gv, FALSE); + do_close(gv, FALSE); TAINT_PROPER("socket"); fd = PerlSock_socket_cloexec(domain, type, protocol); if (fd < 0) { - RETPUSHUNDEF; + RETPUSHUNDEF; } IoIFP(io) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); /* stdio gets confused about sockets */ IoOFP(io) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE); IoTYPE(io) = IoTYPE_SOCKET; if (!IoIFP(io) || !IoOFP(io)) { - if (IoIFP(io)) PerlIO_close(IoIFP(io)); - if (IoOFP(io)) PerlIO_close(IoOFP(io)); - if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); - RETPUSHUNDEF; + if (IoIFP(io)) PerlIO_close(IoIFP(io)); + if (IoOFP(io)) PerlIO_close(IoOFP(io)); + if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd); + RETPUSHUNDEF; } RETPUSHYES; @@ -2496,13 +2496,13 @@ PP(pp_sockpair) IO * const io1 = GvIOn(gv1); if (IoIFP(io1)) - do_close(gv1, FALSE); + do_close(gv1, FALSE); if (IoIFP(io2)) - do_close(gv2, FALSE); + do_close(gv2, FALSE); TAINT_PROPER("socketpair"); if (PerlSock_socketpair_cloexec(domain, type, protocol, fd) < 0) - RETPUSHUNDEF; + RETPUSHUNDEF; IoIFP(io1) = PerlIO_fdopen(fd[0], "r" SOCKET_OPEN_MODE); IoOFP(io1) = PerlIO_fdopen(fd[0], "w" SOCKET_OPEN_MODE); IoTYPE(io1) = IoTYPE_SOCKET; @@ -2510,13 +2510,13 @@ PP(pp_sockpair) IoOFP(io2) = PerlIO_fdopen(fd[1], "w" SOCKET_OPEN_MODE); IoTYPE(io2) = IoTYPE_SOCKET; if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) { - if (IoIFP(io1)) PerlIO_close(IoIFP(io1)); - if (IoOFP(io1)) PerlIO_close(IoOFP(io1)); - if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]); - if (IoIFP(io2)) PerlIO_close(IoIFP(io2)); - if (IoOFP(io2)) PerlIO_close(IoOFP(io2)); - if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); - RETPUSHUNDEF; + if (IoIFP(io1)) PerlIO_close(IoIFP(io1)); + if (IoOFP(io1)) PerlIO_close(IoOFP(io1)); + if (!IoIFP(io1) && !IoOFP(io1)) PerlLIO_close(fd[0]); + if (IoIFP(io2)) PerlIO_close(IoIFP(io2)); + if (IoOFP(io2)) PerlIO_close(IoOFP(io2)); + if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]); + RETPUSHUNDEF; } RETPUSHYES; @@ -2542,7 +2542,7 @@ PP(pp_bind) int fd; if (!IoIFP(io)) - goto nuts; + goto nuts; fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) goto nuts; @@ -2551,12 +2551,12 @@ PP(pp_bind) op_type = PL_op->op_type; TAINT_PROPER(PL_op_desc[op_type]); if ((op_type == OP_BIND - ? PerlSock_bind(fd, (struct sockaddr *)addr, len) - : PerlSock_connect(fd, (struct sockaddr *)addr, len)) - >= 0) - RETPUSHYES; + ? PerlSock_bind(fd, (struct sockaddr *)addr, len) + : PerlSock_connect(fd, (struct sockaddr *)addr, len)) + >= 0) + RETPUSHYES; else - RETPUSHUNDEF; + RETPUSHUNDEF; nuts: report_evil_fh(gv); @@ -2572,12 +2572,12 @@ PP(pp_listen) IO * const io = GvIOn(gv); if (!IoIFP(io)) - goto nuts; + goto nuts; if (PerlSock_listen(PerlIO_fileno(IoIFP(io)), backlog) >= 0) - RETPUSHYES; + RETPUSHYES; else - RETPUSHUNDEF; + RETPUSHUNDEF; nuts: report_evil_fh(gv); @@ -2601,33 +2601,33 @@ PP(pp_accept) IO * const gstio = GvIO(ggv); if (!gstio || !IoIFP(gstio)) - goto nuts; + goto nuts; nstio = GvIOn(ngv); fd = PerlSock_accept_cloexec(PerlIO_fileno(IoIFP(gstio)), (struct sockaddr *) namebuf, &len); #if defined(OEMVS) if (len == 0) { - /* Some platforms indicate zero length when an AF_UNIX client is - * not bound. Simulate a non-zero-length sockaddr structure in - * this case. */ - namebuf[0] = 0; /* sun_len */ - namebuf[1] = AF_UNIX; /* sun_family */ - len = 2; + /* Some platforms indicate zero length when an AF_UNIX client is + * not bound. Simulate a non-zero-length sockaddr structure in + * this case. */ + namebuf[0] = 0; /* sun_len */ + namebuf[1] = AF_UNIX; /* sun_family */ + len = 2; } #endif if (fd < 0) - goto badexit; + goto badexit; if (IoIFP(nstio)) - do_close(ngv, FALSE); + do_close(ngv, FALSE); IoIFP(nstio) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); IoOFP(nstio) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE); IoTYPE(nstio) = IoTYPE_SOCKET; if (!IoIFP(nstio) || !IoOFP(nstio)) { - if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio)); - if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio)); - if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); - goto badexit; + if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio)); + if (IoOFP(nstio)) PerlIO_close(IoOFP(nstio)); + if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd); + goto badexit; } #ifdef __SCO_VERSION__ @@ -2654,7 +2654,7 @@ PP(pp_shutdown) IO * const io = GvIOn(gv); if (!IoIFP(io)) - goto nuts; + goto nuts; PUSHi( PerlSock_shutdown(PerlIO_fileno(IoIFP(io)), how) >= 0 ); RETURN; @@ -2681,47 +2681,47 @@ PP(pp_ssockopt) Sock_size_t len; if (!IoIFP(io)) - goto nuts; + goto nuts; fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) goto nuts; switch (optype) { case OP_GSOCKOPT: - SvGROW(sv, 257); - (void)SvPOK_only(sv); - SvCUR_set(sv,256); - *SvEND(sv) ='\0'; - len = SvCUR(sv); - if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0) - goto nuts2; + SvGROW(sv, 257); + (void)SvPOK_only(sv); + SvCUR_set(sv,256); + *SvEND(sv) ='\0'; + len = SvCUR(sv); + if (PerlSock_getsockopt(fd, lvl, optname, SvPVX(sv), &len) < 0) + goto nuts2; #if defined(_AIX) /* XXX Configure test: does getsockopt set the length properly? */ if (len == 256) len = sizeof(int); #endif - SvCUR_set(sv, len); - *SvEND(sv) ='\0'; - PUSHs(sv); - break; + SvCUR_set(sv, len); + *SvEND(sv) ='\0'; + PUSHs(sv); + break; case OP_SSOCKOPT: { - const char *buf; - int aint; - if (SvPOKp(sv)) { - STRLEN l; - buf = SvPV_const(sv, l); - len = l; - } - else { - aint = (int)SvIV(sv); - buf = (const char *) &aint; - len = sizeof(int); - } - if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0) - goto nuts2; - PUSHs(&PL_sv_yes); - } - break; + const char *buf; + int aint; + if (SvPOKp(sv)) { + STRLEN l; + buf = SvPV_const(sv, l); + len = l; + } + else { + aint = (int)SvIV(sv); + buf = (const char *) &aint; + len = sizeof(int); + } + if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0) + goto nuts2; + PUSHs(&PL_sv_yes); + } + break; } RETURN; @@ -2747,7 +2747,7 @@ PP(pp_getpeername) int fd; if (!IoIFP(io)) - goto nuts; + goto nuts; #ifdef HAS_SOCKADDR_STORAGE len = sizeof(struct sockaddr_storage); @@ -2763,30 +2763,30 @@ PP(pp_getpeername) goto nuts; switch (optype) { case OP_GETSOCKNAME: - if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) - goto nuts2; - break; + if (PerlSock_getsockname(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) + goto nuts2; + break; case OP_GETPEERNAME: - if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) - goto nuts2; + if (PerlSock_getpeername(fd, (struct sockaddr *)SvPVX(sv), &len) < 0) + goto nuts2; #if defined(VMS_DO_SOCKETS) && defined (DECCRTL_SOCKETS) - { - static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; - /* If the call succeeded, make sure we don't have a zeroed port/addr */ - if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET && - !memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere, - sizeof(u_short) + sizeof(struct in_addr))) { - goto nuts2; - } - } -#endif - break; + { + static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0"; + /* If the call succeeded, make sure we don't have a zeroed port/addr */ + if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET && + !memcmp(SvPVX_const(sv) + sizeof(u_short), nowhere, + sizeof(u_short) + sizeof(struct in_addr))) { + goto nuts2; + } + } +#endif + break; } #ifdef BOGUS_GETNAME_RETURN /* Interactive Unix, getpeername() and getsockname() does not return valid namelen */ if (len == BOGUS_GETNAME_RETURN) - len = sizeof(struct sockaddr); + len = sizeof(struct sockaddr); #endif SvCUR_set(sv, len); *SvEND(sv) ='\0'; @@ -2817,36 +2817,36 @@ PP(pp_stat) if (PL_op->op_flags & OPf_REF ? (gv = cGVOP_gv, 1) : !!(sv=POPs, gv = MAYBE_DEREF_GV(sv))) { - if (PL_op->op_type == OP_LSTAT) { - if (gv != PL_defgv) { - do_fstat_warning_check: - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "lstat() on filehandle%s%" SVf, - gv ? " " : "", - SVfARG(gv + if (PL_op->op_type == OP_LSTAT) { + if (gv != PL_defgv) { + do_fstat_warning_check: + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "lstat() on filehandle%s%" SVf, + gv ? " " : "", + SVfARG(gv ? sv_2mortal(newSVhek(GvENAME_HEK(gv))) : &PL_sv_no)); - } else if (PL_laststype != OP_LSTAT) - /* diag_listed_as: The stat preceding %s wasn't an lstat */ - Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); - } - - if (gv == PL_defgv) { - if (PL_laststatval < 0) - SETERRNO(EBADF,RMS_IFI); - } else { + } else if (PL_laststype != OP_LSTAT) + /* diag_listed_as: The stat preceding %s wasn't an lstat */ + Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat"); + } + + if (gv == PL_defgv) { + if (PL_laststatval < 0) + SETERRNO(EBADF,RMS_IFI); + } else { do_fstat_have_io: - PL_laststype = OP_STAT; - PL_statgv = gv ? gv : (GV *)io; + PL_laststype = OP_STAT; + PL_statgv = gv ? gv : (GV *)io; SvPVCLEAR(PL_statname); if(gv) { io = GvIO(gv); - } + } if (io) { if (IoIFP(io)) { int fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) { - report_evil_fh(gv); + report_evil_fh(gv); PL_laststatval = -1; SETERRNO(EBADF,RMS_IFI); } else { @@ -2856,153 +2856,153 @@ PP(pp_stat) PL_laststatval = PerlLIO_fstat(my_dirfd(IoDIRP(io)), &PL_statcache); } else { - report_evil_fh(gv); + report_evil_fh(gv); PL_laststatval = -1; - SETERRNO(EBADF,RMS_IFI); + SETERRNO(EBADF,RMS_IFI); } } else { - report_evil_fh(gv); - PL_laststatval = -1; - SETERRNO(EBADF,RMS_IFI); - } + report_evil_fh(gv); + PL_laststatval = -1; + SETERRNO(EBADF,RMS_IFI); + } } - if (PL_laststatval < 0) { - max = 0; - } + if (PL_laststatval < 0) { + max = 0; + } } else { const char *file; const char *temp; STRLEN len; - if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { + if (SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVIO) { io = MUTABLE_IO(SvRV(sv)); if (PL_op->op_type == OP_LSTAT) goto do_fstat_warning_check; goto do_fstat_have_io; } - SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ + SvTAINTED_off(PL_statname); /* previous tainting irrelevant */ temp = SvPV_nomg_const(sv, len); - sv_setpv(PL_statname, temp); - PL_statgv = NULL; - PL_laststype = PL_op->op_type; + sv_setpv(PL_statname, temp); + PL_statgv = NULL; + PL_laststype = PL_op->op_type; file = SvPV_nolen_const(PL_statname); if (!IS_SAFE_PATHNAME(temp, len, OP_NAME(PL_op))) { PL_laststatval = -1; } - else if (PL_op->op_type == OP_LSTAT) - PL_laststatval = PerlLIO_lstat(file, &PL_statcache); - else - PL_laststatval = PerlLIO_stat(file, &PL_statcache); - if (PL_laststatval < 0) { - if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { + else if (PL_op->op_type == OP_LSTAT) + PL_laststatval = PerlLIO_lstat(file, &PL_statcache); + else + PL_laststatval = PerlLIO_stat(file, &PL_statcache); + if (PL_laststatval < 0) { + if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { /* PL_warn_nl is constant */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat"); GCC_DIAG_RESTORE_STMT; } - max = 0; - } + max = 0; + } } gimme = GIMME_V; if (gimme != G_ARRAY) { - if (gimme != G_VOID) - XPUSHs(boolSV(max)); - RETURN; + if (gimme != G_VOID) + XPUSHs(boolSV(max)); + RETURN; } if (max) { - EXTEND(SP, max); - EXTEND_MORTAL(max); - mPUSHi(PL_statcache.st_dev); - { - /* - * We try to represent st_ino as a native IV or UV where - * possible, but fall back to a decimal string where - * necessary. The code to generate these decimal strings - * is quite obtuse, because (a) we're portable to non-POSIX - * platforms where st_ino might be signed; (b) we didn't - * necessarily detect at Configure time whether st_ino is - * signed; (c) we're portable to non-POSIX platforms where - * ino_t isn't defined, so have no name for the type of - * st_ino; and (d) sprintf() doesn't necessarily support - * integers as large as st_ino. - */ - bool neg; - Stat_t s; - CLANG_DIAG_IGNORE_STMT(-Wtautological-compare); - GCC_DIAG_IGNORE_STMT(-Wtype-limits); - neg = PL_statcache.st_ino < 0; - GCC_DIAG_RESTORE_STMT; - CLANG_DIAG_RESTORE_STMT; - if (neg) { - s.st_ino = (IV)PL_statcache.st_ino; - if (LIKELY(s.st_ino == PL_statcache.st_ino)) { - mPUSHi(s.st_ino); - } else { - char buf[sizeof(s.st_ino)*3+1], *p; - s.st_ino = PL_statcache.st_ino; - for (p = buf + sizeof(buf); p != buf+1; ) { - Stat_t t; - t.st_ino = s.st_ino / 10; - *--p = '0' + (int)(t.st_ino*10 - s.st_ino); - s.st_ino = t.st_ino; - } - while (*p == '0') - p++; - *--p = '-'; - mPUSHp(p, buf+sizeof(buf) - p); - } - } else { - s.st_ino = (UV)PL_statcache.st_ino; - if (LIKELY(s.st_ino == PL_statcache.st_ino)) { - mPUSHu(s.st_ino); - } else { - char buf[sizeof(s.st_ino)*3], *p; - s.st_ino = PL_statcache.st_ino; - for (p = buf + sizeof(buf); p != buf; ) { - Stat_t t; - t.st_ino = s.st_ino / 10; - *--p = '0' + (int)(s.st_ino - t.st_ino*10); - s.st_ino = t.st_ino; - } - while (*p == '0') - p++; - mPUSHp(p, buf+sizeof(buf) - p); - } - } - } - mPUSHu(PL_statcache.st_mode); - mPUSHu(PL_statcache.st_nlink); - + EXTEND(SP, max); + EXTEND_MORTAL(max); + mPUSHi(PL_statcache.st_dev); + { + /* + * We try to represent st_ino as a native IV or UV where + * possible, but fall back to a decimal string where + * necessary. The code to generate these decimal strings + * is quite obtuse, because (a) we're portable to non-POSIX + * platforms where st_ino might be signed; (b) we didn't + * necessarily detect at Configure time whether st_ino is + * signed; (c) we're portable to non-POSIX platforms where + * ino_t isn't defined, so have no name for the type of + * st_ino; and (d) sprintf() doesn't necessarily support + * integers as large as st_ino. + */ + bool neg; + Stat_t s; + CLANG_DIAG_IGNORE_STMT(-Wtautological-compare); + GCC_DIAG_IGNORE_STMT(-Wtype-limits); + neg = PL_statcache.st_ino < 0; + GCC_DIAG_RESTORE_STMT; + CLANG_DIAG_RESTORE_STMT; + if (neg) { + s.st_ino = (IV)PL_statcache.st_ino; + if (LIKELY(s.st_ino == PL_statcache.st_ino)) { + mPUSHi(s.st_ino); + } else { + char buf[sizeof(s.st_ino)*3+1], *p; + s.st_ino = PL_statcache.st_ino; + for (p = buf + sizeof(buf); p != buf+1; ) { + Stat_t t; + t.st_ino = s.st_ino / 10; + *--p = '0' + (int)(t.st_ino*10 - s.st_ino); + s.st_ino = t.st_ino; + } + while (*p == '0') + p++; + *--p = '-'; + mPUSHp(p, buf+sizeof(buf) - p); + } + } else { + s.st_ino = (UV)PL_statcache.st_ino; + if (LIKELY(s.st_ino == PL_statcache.st_ino)) { + mPUSHu(s.st_ino); + } else { + char buf[sizeof(s.st_ino)*3], *p; + s.st_ino = PL_statcache.st_ino; + for (p = buf + sizeof(buf); p != buf; ) { + Stat_t t; + t.st_ino = s.st_ino / 10; + *--p = '0' + (int)(s.st_ino - t.st_ino*10); + s.st_ino = t.st_ino; + } + while (*p == '0') + p++; + mPUSHp(p, buf+sizeof(buf) - p); + } + } + } + mPUSHu(PL_statcache.st_mode); + mPUSHu(PL_statcache.st_nlink); + sv_setuid(PUSHmortal, PL_statcache.st_uid); sv_setgid(PUSHmortal, PL_statcache.st_gid); #ifdef USE_STAT_RDEV - mPUSHi(PL_statcache.st_rdev); + mPUSHi(PL_statcache.st_rdev); #else - PUSHs(newSVpvs_flags("", SVs_TEMP)); + PUSHs(newSVpvs_flags("", SVs_TEMP)); #endif #if Off_t_size > IVSIZE - mPUSHn(PL_statcache.st_size); + mPUSHn(PL_statcache.st_size); #else - mPUSHi(PL_statcache.st_size); + mPUSHi(PL_statcache.st_size); #endif #ifdef BIG_TIME - mPUSHn(PL_statcache.st_atime); - mPUSHn(PL_statcache.st_mtime); - mPUSHn(PL_statcache.st_ctime); + mPUSHn(PL_statcache.st_atime); + mPUSHn(PL_statcache.st_mtime); + mPUSHn(PL_statcache.st_ctime); #else - mPUSHi(PL_statcache.st_atime); - mPUSHi(PL_statcache.st_mtime); - mPUSHi(PL_statcache.st_ctime); + mPUSHi(PL_statcache.st_atime); + mPUSHi(PL_statcache.st_mtime); + mPUSHi(PL_statcache.st_ctime); #endif #ifdef USE_STAT_BLOCKS - mPUSHu(PL_statcache.st_blksize); - mPUSHu(PL_statcache.st_blocks); + mPUSHu(PL_statcache.st_blksize); + mPUSHu(PL_statcache.st_blocks); #else - PUSHs(newSVpvs_flags("", SVs_TEMP)); - PUSHs(newSVpvs_flags("", SVs_TEMP)); + PUSHs(newSVpvs_flags("", SVs_TEMP)); + PUSHs(newSVpvs_flags("", SVs_TEMP)); #endif } RETURN; @@ -3055,11 +3055,11 @@ S_ft_return_true(pTHX_ SV *ret) { #define FT_RETURNYES return S_ft_return_true(aTHX_ &PL_sv_yes) #define tryAMAGICftest_MG(chr) STMT_START { \ - if ( (SvFLAGS(*PL_stack_sp) & (SVf_ROK|SVs_GMG)) \ - && PL_op->op_flags & OPf_KIDS) { \ - OP *next = S_try_amagic_ftest(aTHX_ chr); \ - if (next) return next; \ - } \ + if ( (SvFLAGS(*PL_stack_sp) & (SVf_ROK|SVs_GMG)) \ + && PL_op->op_flags & OPf_KIDS) { \ + OP *next = S_try_amagic_ftest(aTHX_ chr); \ + if (next) return next; \ + } \ } STMT_END STATIC OP * @@ -3071,15 +3071,15 @@ S_try_amagic_ftest(pTHX_ char chr) { if (SvAMAGIC(arg)) { - const char tmpchr = chr; - SV * const tmpsv = amagic_call(arg, - newSVpvn_flags(&tmpchr, 1, SVs_TEMP), - ftest_amg, AMGf_unary); + const char tmpchr = chr; + SV * const tmpsv = amagic_call(arg, + newSVpvn_flags(&tmpchr, 1, SVs_TEMP), + ftest_amg, AMGf_unary); - if (!tmpsv) - return NULL; + if (!tmpsv) + return NULL; - return SvTRUE(tmpsv) + return SvTRUE(tmpsv) ? S_ft_return_true(aTHX_ tmpsv) : S_ft_return_false(aTHX_ tmpsv); } return NULL; @@ -3125,88 +3125,88 @@ PP(pp_ftrread) switch (PL_op->op_type) { case OP_FTRREAD: #if !(defined(HAS_ACCESS) && defined(R_OK)) - use_access = 0; + use_access = 0; #endif - break; + break; case OP_FTRWRITE: #if defined(HAS_ACCESS) && defined(W_OK) - access_mode = W_OK; + access_mode = W_OK; #else - use_access = 0; + use_access = 0; #endif - stat_mode = S_IWUSR; - break; + stat_mode = S_IWUSR; + break; case OP_FTREXEC: #if defined(HAS_ACCESS) && defined(X_OK) - access_mode = X_OK; + access_mode = X_OK; #else - use_access = 0; + use_access = 0; #endif - stat_mode = S_IXUSR; - break; + stat_mode = S_IXUSR; + break; case OP_FTEWRITE: #ifdef PERL_EFF_ACCESS - access_mode = W_OK; + access_mode = W_OK; #endif - stat_mode = S_IWUSR; - /* FALLTHROUGH */ + stat_mode = S_IWUSR; + /* FALLTHROUGH */ case OP_FTEREAD: #ifndef PERL_EFF_ACCESS - use_access = 0; + use_access = 0; #endif - effective = TRUE; - break; + effective = TRUE; + break; case OP_FTEEXEC: #ifdef PERL_EFF_ACCESS - access_mode = X_OK; + access_mode = X_OK; #else - use_access = 0; + use_access = 0; #endif - stat_mode = S_IXUSR; - effective = TRUE; - break; + stat_mode = S_IXUSR; + effective = TRUE; + break; } if (use_access) { #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS) STRLEN len; - const char *name = SvPV(*PL_stack_sp, len); + const char *name = SvPV(*PL_stack_sp, len); if (!IS_SAFE_PATHNAME(name, len, OP_NAME(PL_op))) { result = -1; } - else if (effective) { + else if (effective) { # ifdef PERL_EFF_ACCESS - result = PERL_EFF_ACCESS(name, access_mode); + result = PERL_EFF_ACCESS(name, access_mode); # else - DIE(aTHX_ "panic: attempt to call PERL_EFF_ACCESS in %s", - OP_NAME(PL_op)); + DIE(aTHX_ "panic: attempt to call PERL_EFF_ACCESS in %s", + OP_NAME(PL_op)); # endif - } - else { + } + else { # ifdef HAS_ACCESS - result = access(name, access_mode); + result = access(name, access_mode); # else - DIE(aTHX_ "panic: attempt to call access() in %s", OP_NAME(PL_op)); + DIE(aTHX_ "panic: attempt to call access() in %s", OP_NAME(PL_op)); # endif - } - if (result == 0) - FT_RETURNYES; - if (result < 0) - FT_RETURNUNDEF; - FT_RETURNNO; + } + if (result == 0) + FT_RETURNYES; + if (result < 0) + FT_RETURNUNDEF; + FT_RETURNNO; #endif } result = my_stat_flags(0); if (result < 0) - FT_RETURNUNDEF; + FT_RETURNUNDEF; if (cando(stat_mode, effective, &PL_statcache)) - FT_RETURNYES; + FT_RETURNYES; FT_RETURNNO; } @@ -3230,36 +3230,36 @@ PP(pp_ftis) result = my_stat_flags(0); if (result < 0) - FT_RETURNUNDEF; + FT_RETURNUNDEF; if (op_type == OP_FTIS) - FT_RETURNYES; + FT_RETURNYES; { - /* You can't dTARGET inside OP_FTIS, because you'll get - "panic: pad_sv po" - the op is not flagged to have a target. */ - dTARGET; - switch (op_type) { - case OP_FTSIZE: + /* You can't dTARGET inside OP_FTIS, because you'll get + "panic: pad_sv po" - the op is not flagged to have a target. */ + dTARGET; + switch (op_type) { + case OP_FTSIZE: #if Off_t_size > IVSIZE - sv_setnv(TARG, (NV)PL_statcache.st_size); + sv_setnv(TARG, (NV)PL_statcache.st_size); #else - sv_setiv(TARG, (IV)PL_statcache.st_size); -#endif - break; - case OP_FTMTIME: - sv_setnv(TARG, - ((NV)PL_basetime - PL_statcache.st_mtime) / 86400.0 ); - break; - case OP_FTATIME: - sv_setnv(TARG, - ((NV)PL_basetime - PL_statcache.st_atime) / 86400.0 ); - break; - case OP_FTCTIME: - sv_setnv(TARG, - ((NV)PL_basetime - PL_statcache.st_ctime) / 86400.0 ); - break; - } - SvSETMAGIC(TARG); - return SvTRUE_nomg_NN(TARG) + sv_setiv(TARG, (IV)PL_statcache.st_size); +#endif + break; + case OP_FTMTIME: + sv_setnv(TARG, + ((NV)PL_basetime - PL_statcache.st_mtime) / 86400.0 ); + break; + case OP_FTATIME: + sv_setnv(TARG, + ((NV)PL_basetime - PL_statcache.st_atime) / 86400.0 ); + break; + case OP_FTCTIME: + sv_setnv(TARG, + ((NV)PL_basetime - PL_statcache.st_ctime) / 86400.0 ); + break; + } + SvSETMAGIC(TARG); + return SvTRUE_nomg_NN(TARG) ? S_ft_return_true(aTHX_ TARG) : S_ft_return_false(aTHX_ TARG); } } @@ -3292,61 +3292,61 @@ PP(pp_ftrowned) result = my_stat_flags(0); if (result < 0) - FT_RETURNUNDEF; + FT_RETURNUNDEF; switch (PL_op->op_type) { case OP_FTROWNED: - if (PL_statcache.st_uid == PerlProc_getuid()) - FT_RETURNYES; - break; + if (PL_statcache.st_uid == PerlProc_getuid()) + FT_RETURNYES; + break; case OP_FTEOWNED: - if (PL_statcache.st_uid == PerlProc_geteuid()) - FT_RETURNYES; - break; + if (PL_statcache.st_uid == PerlProc_geteuid()) + FT_RETURNYES; + break; case OP_FTZERO: - if (PL_statcache.st_size == 0) - FT_RETURNYES; - break; + if (PL_statcache.st_size == 0) + FT_RETURNYES; + break; case OP_FTSOCK: - if (S_ISSOCK(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISSOCK(PL_statcache.st_mode)) + FT_RETURNYES; + break; case OP_FTCHR: - if (S_ISCHR(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISCHR(PL_statcache.st_mode)) + FT_RETURNYES; + break; case OP_FTBLK: - if (S_ISBLK(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISBLK(PL_statcache.st_mode)) + FT_RETURNYES; + break; case OP_FTFILE: - if (S_ISREG(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISREG(PL_statcache.st_mode)) + FT_RETURNYES; + break; case OP_FTDIR: - if (S_ISDIR(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISDIR(PL_statcache.st_mode)) + FT_RETURNYES; + break; case OP_FTPIPE: - if (S_ISFIFO(PL_statcache.st_mode)) - FT_RETURNYES; - break; + if (S_ISFIFO(PL_statcache.st_mode)) + FT_RETURNYES; + break; #ifdef S_ISUID case OP_FTSUID: - if (PL_statcache.st_mode & S_ISUID) - FT_RETURNYES; - break; + if (PL_statcache.st_mode & S_ISUID) + FT_RETURNYES; + break; #endif #ifdef S_ISGID case OP_FTSGID: - if (PL_statcache.st_mode & S_ISGID) - FT_RETURNYES; - break; + if (PL_statcache.st_mode & S_ISGID) + FT_RETURNYES; + break; #endif #ifdef S_ISVTX case OP_FTSVTX: - if (PL_statcache.st_mode & S_ISVTX) - FT_RETURNYES; - break; + if (PL_statcache.st_mode & S_ISVTX) + FT_RETURNYES; + break; #endif } FT_RETURNNO; @@ -3360,9 +3360,9 @@ PP(pp_ftlink) result = my_lstat_flags(0); if (result < 0) - FT_RETURNUNDEF; + FT_RETURNUNDEF; if (S_ISLNK(PL_statcache.st_mode)) - FT_RETURNYES; + FT_RETURNYES; FT_RETURNNO; } @@ -3377,27 +3377,27 @@ PP(pp_fttty) tryAMAGICftest_MG('t'); if (PL_op->op_flags & OPf_REF) - gv = cGVOP_gv; + gv = cGVOP_gv; else { SV *tmpsv = *PL_stack_sp; if (!(gv = MAYBE_DEREF_GV_nomg(tmpsv))) { - name = SvPV_nomg(tmpsv, namelen); - gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO); + name = SvPV_nomg(tmpsv, namelen); + gv = gv_fetchpvn_flags(name, namelen, SvUTF8(tmpsv), SVt_PVIO); } } if (GvIO(gv) && IoIFP(GvIOp(gv))) - fd = PerlIO_fileno(IoIFP(GvIOp(gv))); + fd = PerlIO_fileno(IoIFP(GvIOp(gv))); else if (name && isDIGIT(*name) && grok_atoUV(name, &uv, NULL) && uv <= PERL_INT_MAX) fd = (int)uv; else - fd = -1; + fd = -1; if (fd < 0) { SETERRNO(EBADF,RMS_IFI); - FT_RETURNUNDEF; + FT_RETURNUNDEF; } if (PerlLIO_isatty(fd)) - FT_RETURNYES; + FT_RETURNYES; FT_RETURNNO; } @@ -3420,70 +3420,70 @@ PP(pp_fttext) tryAMAGICftest_MG(PL_op->op_type == OP_FTTEXT ? 'T' : 'B'); if (PL_op->op_flags & OPf_REF) - gv = cGVOP_gv; + gv = cGVOP_gv; else if ((PL_op->op_private & (OPpFT_STACKED|OPpFT_AFTER_t)) - == OPpFT_STACKED) - gv = PL_defgv; + == OPpFT_STACKED) + gv = PL_defgv; else { - sv = *PL_stack_sp; - gv = MAYBE_DEREF_GV_nomg(sv); + sv = *PL_stack_sp; + gv = MAYBE_DEREF_GV_nomg(sv); } if (gv) { - if (gv == PL_defgv) { - if (PL_statgv) - io = SvTYPE(PL_statgv) == SVt_PVIO - ? (IO *)PL_statgv - : GvIO(PL_statgv); - else { - goto really_filename; - } - } - else { - PL_statgv = gv; + if (gv == PL_defgv) { + if (PL_statgv) + io = SvTYPE(PL_statgv) == SVt_PVIO + ? (IO *)PL_statgv + : GvIO(PL_statgv); + else { + goto really_filename; + } + } + else { + PL_statgv = gv; SvPVCLEAR(PL_statname); - io = GvIO(PL_statgv); - } - PL_laststatval = -1; - PL_laststype = OP_STAT; - if (io && IoIFP(io)) { - int fd; - if (! PerlIO_has_base(IoIFP(io))) - DIE(aTHX_ "-T and -B not implemented on filehandles"); - fd = PerlIO_fileno(IoIFP(io)); - if (fd < 0) { + io = GvIO(PL_statgv); + } + PL_laststatval = -1; + PL_laststype = OP_STAT; + if (io && IoIFP(io)) { + int fd; + if (! PerlIO_has_base(IoIFP(io))) + DIE(aTHX_ "-T and -B not implemented on filehandles"); + fd = PerlIO_fileno(IoIFP(io)); + if (fd < 0) { SETERRNO(EBADF,RMS_IFI); - FT_RETURNUNDEF; + FT_RETURNUNDEF; } - PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); - if (PL_laststatval < 0) - FT_RETURNUNDEF; - if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ - if (PL_op->op_type == OP_FTTEXT) - FT_RETURNNO; - else - FT_RETURNYES; + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + if (PL_laststatval < 0) + FT_RETURNUNDEF; + if (S_ISDIR(PL_statcache.st_mode)) { /* handle NFS glitch */ + if (PL_op->op_type == OP_FTTEXT) + FT_RETURNNO; + else + FT_RETURNYES; } - if (PerlIO_get_cnt(IoIFP(io)) <= 0) { - i = PerlIO_getc(IoIFP(io)); - if (i != EOF) - (void)PerlIO_ungetc(IoIFP(io),i); + if (PerlIO_get_cnt(IoIFP(io)) <= 0) { + i = PerlIO_getc(IoIFP(io)); + if (i != EOF) + (void)PerlIO_ungetc(IoIFP(io),i); else /* null file is anything */ FT_RETURNYES; - } - len = PerlIO_get_bufsiz(IoIFP(io)); - s = (STDCHAR *) PerlIO_get_base(IoIFP(io)); - /* sfio can have large buffers - limit to 512 */ - if (len > 512) - len = 512; - } - else { - SETERRNO(EBADF,RMS_IFI); - report_evil_fh(gv); - SETERRNO(EBADF,RMS_IFI); - FT_RETURNUNDEF; - } + } + len = PerlIO_get_bufsiz(IoIFP(io)); + s = (STDCHAR *) PerlIO_get_base(IoIFP(io)); + /* sfio can have large buffers - limit to 512 */ + if (len > 512) + len = 512; + } + else { + SETERRNO(EBADF,RMS_IFI); + report_evil_fh(gv); + SETERRNO(EBADF,RMS_IFI); + FT_RETURNUNDEF; + } } else { const char *file; @@ -3493,7 +3493,7 @@ PP(pp_fttext) assert(sv); temp = SvPV_nomg_const(sv, temp_len); - sv_setpv(PL_statname, temp); + sv_setpv(PL_statname, temp); if (!IS_SAFE_PATHNAME(temp, temp_len, OP_NAME(PL_op))) { PL_laststatval = -1; PL_laststype = OP_STAT; @@ -3501,43 +3501,43 @@ PP(pp_fttext) } really_filename: file = SvPVX_const(PL_statname); - PL_statgv = NULL; - if (!(fp = PerlIO_open(file, "r"))) { - if (!gv) { - PL_laststatval = -1; - PL_laststype = OP_STAT; - } - if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { + PL_statgv = NULL; + if (!(fp = PerlIO_open(file, "r"))) { + if (!gv) { + PL_laststatval = -1; + PL_laststype = OP_STAT; + } + if (ckWARN(WARN_NEWLINE) && should_warn_nl(file)) { /* PL_warn_nl is constant */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); + Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open"); GCC_DIAG_RESTORE_STMT; } - FT_RETURNUNDEF; - } - PL_laststype = OP_STAT; + FT_RETURNUNDEF; + } + PL_laststype = OP_STAT; fd = PerlIO_fileno(fp); if (fd < 0) { - (void)PerlIO_close(fp); + (void)PerlIO_close(fp); SETERRNO(EBADF,RMS_IFI); - FT_RETURNUNDEF; + FT_RETURNUNDEF; } - PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); - if (PL_laststatval < 0) { + PL_laststatval = PerlLIO_fstat(fd, &PL_statcache); + if (PL_laststatval < 0) { dSAVE_ERRNO; - (void)PerlIO_close(fp); + (void)PerlIO_close(fp); RESTORE_ERRNO; - FT_RETURNUNDEF; - } - PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); - len = PerlIO_read(fp, tbuf, sizeof(tbuf)); - (void)PerlIO_close(fp); - if (len <= 0) { - if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT) - FT_RETURNNO; /* special case NFS directories */ - FT_RETURNYES; /* null file is anything */ - } - s = tbuf; + FT_RETURNUNDEF; + } + PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL); + len = PerlIO_read(fp, tbuf, sizeof(tbuf)); + (void)PerlIO_close(fp); + if (len <= 0) { + if (S_ISDIR(PL_statcache.st_mode) && PL_op->op_type == OP_FTTEXT) + FT_RETURNNO; /* special case NFS directories */ + FT_RETURNYES; /* null file is anything */ + } + s = tbuf; } /* now scan s to look for textiness */ @@ -3545,7 +3545,7 @@ PP(pp_fttext) #if defined(DOSISH) || defined(USEMYBINMODE) /* ignore trailing ^Z on short files */ if (len && len < (I32)sizeof(tbuf) && tbuf[len-1] == 26) - --len; + --len; #endif assert(len); @@ -3570,14 +3570,14 @@ PP(pp_fttext) * things that wouldn't be in ASCII text or rich ASCII text. Count these * in 'odd' */ for (i = 0; i < len; i++, s++) { - if (!*s) { /* null never allowed in text */ - odd += len; - break; - } + if (!*s) { /* null never allowed in text */ + odd += len; + break; + } #ifdef USE_LOCALE_CTYPE if (IN_LC_RUNTIME(LC_CTYPE)) { if ( isPRINT_LC(*s) || isSPACE_LC(*s)) { - continue; + continue; } } else @@ -3597,9 +3597,9 @@ PP(pp_fttext) } if ((odd * 3 > len) == (PL_op->op_type == OP_FTTEXT)) /* allow 1/3 odd */ - FT_RETURNNO; + FT_RETURNNO; else - FT_RETURNYES; + FT_RETURNYES; } /* File calls. */ @@ -3611,9 +3611,9 @@ PP(pp_chdir) GV *gv = NULL; if( MAXARG == 1 ) { - SV * const sv = POPs; - if (PL_op->op_flags & OPf_SPECIAL) { - gv = gv_fetchsv(sv, 0, SVt_PVIO); + SV * const sv = POPs; + if (PL_op->op_flags & OPf_SPECIAL) { + gv = gv_fetchsv(sv, 0, SVt_PVIO); if (!gv) { if (ckWARN(WARN_UNOPENED)) { Perl_warner(aTHX_ packWARN(WARN_UNOPENED), @@ -3624,13 +3624,13 @@ PP(pp_chdir) TAINT_PROPER("chdir"); RETURN; } - } + } else if (!(gv = MAYBE_DEREF_GV(sv))) - tmps = SvPV_nomg_const_nolen(sv); + tmps = SvPV_nomg_const_nolen(sv); } else { - HV * const table = GvHVn(PL_envgv); - SV **svp; + HV * const table = GvHVn(PL_envgv); + SV **svp; EXTEND(SP, 1); if ( (svp = hv_fetchs(table, "HOME", FALSE)) @@ -3653,26 +3653,26 @@ PP(pp_chdir) TAINT_PROPER("chdir"); if (gv) { #ifdef HAS_FCHDIR - IO* const io = GvIO(gv); - if (io) { - if (IoDIRP(io)) { - PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); - } else if (IoIFP(io)) { + IO* const io = GvIO(gv); + if (io) { + if (IoDIRP(io)) { + PUSHi(fchdir(my_dirfd(IoDIRP(io))) >= 0); + } else if (IoIFP(io)) { int fd = PerlIO_fileno(IoIFP(io)); if (fd < 0) { goto nuts; } PUSHi(fchdir(fd) >= 0); - } - else { + } + else { goto nuts; - } + } } else { goto nuts; } #else - DIE(aTHX_ PL_no_func, "fchdir"); + DIE(aTHX_ PL_no_func, "fchdir"); #endif } else @@ -3733,14 +3733,14 @@ PP(pp_rename) anum = PerlLIO_rename(tmps, tmps2); #else if (!(anum = PerlLIO_stat(tmps, &statbuf))) { - if (same_dirent(tmps2, tmps)) /* can always rename to same name */ - anum = 1; - else { - if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) - (void)UNLINK(tmps2); - if (!(anum = link(tmps, tmps2))) - anum = UNLINK(tmps); - } + if (same_dirent(tmps2, tmps)) /* can always rename to same name */ + anum = 1; + else { + if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode)) + (void)UNLINK(tmps2); + if (!(anum = link(tmps, tmps2))) + anum = UNLINK(tmps); + } } #endif SETi( anum >= 0 ); @@ -3759,28 +3759,28 @@ PP(pp_link) # ifndef HAS_LINK if (op_type == OP_LINK) - DIE(aTHX_ PL_no_func, "link"); + DIE(aTHX_ PL_no_func, "link"); # endif # ifndef HAS_SYMLINK if (op_type == OP_SYMLINK) - DIE(aTHX_ PL_no_func, "symlink"); + DIE(aTHX_ PL_no_func, "symlink"); # endif { - const char * const tmps2 = POPpconstx; - const char * const tmps = SvPV_nolen_const(TOPs); - TAINT_PROPER(PL_op_desc[op_type]); - result = + const char * const tmps2 = POPpconstx; + const char * const tmps = SvPV_nolen_const(TOPs); + TAINT_PROPER(PL_op_desc[op_type]); + result = # if defined(HAS_LINK) && defined(HAS_SYMLINK) - /* Both present - need to choose which. */ - (op_type == OP_LINK) ? - PerlLIO_link(tmps, tmps2) : PerlLIO_symlink(tmps, tmps2); + /* Both present - need to choose which. */ + (op_type == OP_LINK) ? + PerlLIO_link(tmps, tmps2) : PerlLIO_symlink(tmps, tmps2); # elif defined(HAS_LINK) /* Only have link, so calls to pp_symlink will have DIE()d above. */ - PerlLIO_link(tmps, tmps2); + PerlLIO_link(tmps, tmps2); # elif defined(HAS_SYMLINK) /* Only have symlink, so calls to pp_link will have DIE()d above. */ - PerlLIO_symlink(tmps, tmps2); + PerlLIO_symlink(tmps, tmps2); # endif } @@ -3813,7 +3813,7 @@ PP(pp_readlink) * it is impossible to know whether the result was truncated. */ len = PerlLIO_readlink(tmps, buf, sizeof(buf) - 1); if (len < 0) - RETPUSHUNDEF; + RETPUSHUNDEF; buf[len] = '\0'; PUSHp(buf, len); RETURN; @@ -3840,72 +3840,72 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) my_strlcpy(cmdline, cmd, size); my_strlcat(cmdline, " ", size); for (s = cmdline + strlen(cmdline); *filename; ) { - *s++ = '\\'; - *s++ = *filename++; + *s++ = '\\'; + *s++ = *filename++; } if (s - cmdline < size) - my_strlcpy(s, " 2>&1", size - (s - cmdline)); + my_strlcpy(s, " 2>&1", size - (s - cmdline)); myfp = PerlProc_popen(cmdline, "r"); Safefree(cmdline); if (myfp) { - SV * const tmpsv = sv_newmortal(); - /* Need to save/restore 'PL_rs' ?? */ - s = sv_gets(tmpsv, myfp, 0); - (void)PerlProc_pclose(myfp); - if (s != NULL) { - int e; - for (e = 1; + SV * const tmpsv = sv_newmortal(); + /* Need to save/restore 'PL_rs' ?? */ + s = sv_gets(tmpsv, myfp, 0); + (void)PerlProc_pclose(myfp); + if (s != NULL) { + int e; + for (e = 1; #ifdef HAS_SYS_ERRLIST - e <= sys_nerr -#endif - ; e++) - { - /* you don't see this */ - const char * const errmsg = Strerror(e) ; - if (!errmsg) - break; - if (instr(s, errmsg)) { - SETERRNO(e,0); - return 0; - } - } - SETERRNO(0,0); + e <= sys_nerr +#endif + ; e++) + { + /* you don't see this */ + const char * const errmsg = Strerror(e) ; + if (!errmsg) + break; + if (instr(s, errmsg)) { + SETERRNO(e,0); + return 0; + } + } + SETERRNO(0,0); #ifndef EACCES #define EACCES EPERM #endif - if (instr(s, "cannot make")) - SETERRNO(EEXIST,RMS_FEX); - else if (instr(s, "existing file")) - SETERRNO(EEXIST,RMS_FEX); - else if (instr(s, "ile exists")) - SETERRNO(EEXIST,RMS_FEX); - else if (instr(s, "non-exist")) - SETERRNO(ENOENT,RMS_FNF); - else if (instr(s, "does not exist")) - SETERRNO(ENOENT,RMS_FNF); - else if (instr(s, "not empty")) - SETERRNO(EBUSY,SS_DEVOFFLINE); - else if (instr(s, "cannot access")) - SETERRNO(EACCES,RMS_PRV); - else - SETERRNO(EPERM,RMS_PRV); - return 0; - } - else { /* some mkdirs return no failure indication */ - Stat_t statbuf; - anum = (PerlLIO_stat(save_filename, &statbuf) >= 0); - if (PL_op->op_type == OP_RMDIR) - anum = !anum; - if (anum) - SETERRNO(0,0); - else - SETERRNO(EACCES,RMS_PRV); /* a guess */ - } - return anum; + if (instr(s, "cannot make")) + SETERRNO(EEXIST,RMS_FEX); + else if (instr(s, "existing file")) + SETERRNO(EEXIST,RMS_FEX); + else if (instr(s, "ile exists")) + SETERRNO(EEXIST,RMS_FEX); + else if (instr(s, "non-exist")) + SETERRNO(ENOENT,RMS_FNF); + else if (instr(s, "does not exist")) + SETERRNO(ENOENT,RMS_FNF); + else if (instr(s, "not empty")) + SETERRNO(EBUSY,SS_DEVOFFLINE); + else if (instr(s, "cannot access")) + SETERRNO(EACCES,RMS_PRV); + else + SETERRNO(EPERM,RMS_PRV); + return 0; + } + else { /* some mkdirs return no failure indication */ + Stat_t statbuf; + anum = (PerlLIO_stat(save_filename, &statbuf) >= 0); + if (PL_op->op_type == OP_RMDIR) + anum = !anum; + if (anum) + SETERRNO(0,0); + else + SETERRNO(EACCES,RMS_PRV); /* a guess */ + } + return anum; } else - return 0; + return 0; } #endif @@ -3922,11 +3922,11 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename) #define TRIMSLASHES(tmps,len,copy) (tmps) = SvPV_const(TOPs, (len)); \ if ((len) > 1 && (tmps)[(len)-1] == '/') { \ - do { \ - (len)--; \ - } while ((len) > 1 && (tmps)[(len)-1] == '/'); \ - (tmps) = savepvn((tmps), (len)); \ - (copy) = TRUE; \ + do { \ + (len)--; \ + } while ((len) > 1 && (tmps)[(len)-1] == '/'); \ + (tmps) = savepvn((tmps), (len)); \ + (copy) = TRUE; \ } PP(pp_mkdir) @@ -3952,7 +3952,7 @@ PP(pp_mkdir) } #endif if (copy) - Safefree(tmps); + Safefree(tmps); RETURN; } @@ -3971,7 +3971,7 @@ PP(pp_rmdir) SETi( dooneliner("rmdir", tmps) ); #endif if (copy) - Safefree(tmps); + Safefree(tmps); RETURN; } @@ -3986,17 +3986,17 @@ PP(pp_open_dir) IO * const io = GvIOn(gv); if ((IoIFP(io) || IoOFP(io))) - Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already open as a filehandle", - HEKfARG(GvENAME_HEK(gv))); + Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already open as a filehandle", + HEKfARG(GvENAME_HEK(gv))); if (IoDIRP(io)) - PerlDir_close(IoDIRP(io)); + PerlDir_close(IoDIRP(io)); if (!(IoDIRP(io) = PerlDir_open(dirname))) - goto nope; + goto nope; RETPUSHYES; nope: if (!errno) - SETERRNO(EBADF,RMS_DIR); + SETERRNO(EBADF,RMS_DIR); RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "opendir"); @@ -4020,8 +4020,8 @@ PP(pp_readdir) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "readdir() attempted on invalid dirhandle %" HEKf, + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "readdir() attempted on invalid dirhandle %" HEKf, HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -4047,11 +4047,11 @@ PP(pp_readdir) nope: if (!errno) - SETERRNO(EBADF,RMS_ISI); + SETERRNO(EBADF,RMS_ISI); if (gimme == G_ARRAY) - RETURN; + RETURN; else - RETPUSHUNDEF; + RETPUSHUNDEF; #endif } @@ -4070,8 +4070,8 @@ PP(pp_telldir) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "telldir() attempted on invalid dirhandle %" HEKf, + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "telldir() attempted on invalid dirhandle %" HEKf, HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -4080,7 +4080,7 @@ PP(pp_telldir) RETURN; nope: if (!errno) - SETERRNO(EBADF,RMS_ISI); + SETERRNO(EBADF,RMS_ISI); RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "telldir"); @@ -4096,8 +4096,8 @@ PP(pp_seekdir) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "seekdir() attempted on invalid dirhandle %" HEKf, + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "seekdir() attempted on invalid dirhandle %" HEKf, HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -4106,7 +4106,7 @@ PP(pp_seekdir) RETPUSHYES; nope: if (!errno) - SETERRNO(EBADF,RMS_ISI); + SETERRNO(EBADF,RMS_ISI); RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "seekdir"); @@ -4121,16 +4121,16 @@ PP(pp_rewinddir) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "rewinddir() attempted on invalid dirhandle %" HEKf, + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "rewinddir() attempted on invalid dirhandle %" HEKf, HEKfARG(GvENAME_HEK(gv))); - goto nope; + goto nope; } (void)PerlDir_rewind(IoDIRP(io)); RETPUSHYES; nope: if (!errno) - SETERRNO(EBADF,RMS_ISI); + SETERRNO(EBADF,RMS_ISI); RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "rewinddir"); @@ -4145,8 +4145,8 @@ PP(pp_closedir) IO * const io = GvIOn(gv); if (!IoDIRP(io)) { - Perl_ck_warner(aTHX_ packWARN(WARN_IO), - "closedir() attempted on invalid dirhandle %" HEKf, + Perl_ck_warner(aTHX_ packWARN(WARN_IO), + "closedir() attempted on invalid dirhandle %" HEKf, HEKfARG(GvENAME_HEK(gv))); goto nope; } @@ -4154,8 +4154,8 @@ PP(pp_closedir) PerlDir_close(IoDIRP(io)); #else if (PerlDir_close(IoDIRP(io)) < 0) { - IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */ - goto nope; + IoDIRP(io) = 0; /* Don't try to close again--coredumps on SysV */ + goto nope; } #endif IoDIRP(io) = 0; @@ -4163,7 +4163,7 @@ PP(pp_closedir) RETPUSHYES; nope: if (!errno) - SETERRNO(EBADF,RMS_IFI); + SETERRNO(EBADF,RMS_IFI); RETPUSHUNDEF; #else DIE(aTHX_ PL_no_dir_func, "closedir"); @@ -4189,24 +4189,24 @@ PP(pp_fork) #endif childpid = PerlProc_fork(); if (childpid == 0) { - int sig; - PL_sig_pending = 0; - if (PL_psig_pend) - for (sig = 1; sig < SIG_SIZE; sig++) - PL_psig_pend[sig] = 0; + int sig; + PL_sig_pending = 0; + if (PL_psig_pend) + for (sig = 1; sig < SIG_SIZE; sig++) + PL_psig_pend[sig] = 0; } #ifdef HAS_SIGPROCMASK { - dSAVE_ERRNO; - sigprocmask(SIG_SETMASK, &oldmask, NULL); - RESTORE_ERRNO; + dSAVE_ERRNO; + sigprocmask(SIG_SETMASK, &oldmask, NULL); + RESTORE_ERRNO; } #endif if (childpid < 0) - RETPUSHUNDEF; + RETPUSHUNDEF; if (!childpid) { #ifdef PERL_USES_PL_PIDSTATUS - hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */ + hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */ #endif } PUSHi(childpid); @@ -4219,7 +4219,7 @@ PP(pp_fork) PERL_FLUSHALL_FOR_CHILD; childpid = PerlProc_fork(); if (childpid == -1) - RETPUSHUNDEF; + RETPUSHUNDEF; PUSHi(childpid); RETURN; #else @@ -4238,9 +4238,9 @@ PP(pp_wait) childpid = wait4pid(-1, &argflags, 0); else { while ((childpid = wait4pid(-1, &argflags, 0)) == -1 && - errno == EINTR) { - PERL_ASYNC_CHECK(); - } + errno == EINTR) { + PERL_ASYNC_CHECK(); + } } # if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) /* 0 and -1 are both error returns (the former applies to WNOHANG case) */ @@ -4274,9 +4274,9 @@ PP(pp_waitpid) result = wait4pid(pid, &argflags, optype); else { while ((result = wait4pid(pid, &argflags, optype)) == -1 && - errno == EINTR) { - PERL_ASYNC_CHECK(); - } + errno == EINTR) { + PERL_ASYNC_CHECK(); + } } # if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS) /* 0 and -1 are both error returns (the former applies to WNOHANG case) */ @@ -4308,45 +4308,45 @@ PP(pp_system) # endif while (++MARK <= SP) { - SV *origsv = *MARK, *copysv; - STRLEN len; - char *pv; - SvGETMAGIC(origsv); + SV *origsv = *MARK, *copysv; + STRLEN len; + char *pv; + SvGETMAGIC(origsv); #if defined(WIN32) || defined(__VMS) - /* - * Because of a nasty platform-specific variation on the meaning - * of arguments to this op, we must preserve numeric arguments - * as numeric, not just retain the string value. - */ - if (SvNIOK(origsv) || SvNIOKp(origsv)) { - copysv = newSV_type(SVt_PVNV); - sv_2mortal(copysv); - if (SvPOK(origsv) || SvPOKp(origsv)) { - pv = SvPV_nomg(origsv, len); - sv_setpvn(copysv, pv, len); - SvPOK_off(copysv); - } - if (SvIOK(origsv) || SvIOKp(origsv)) - SvIV_set(copysv, SvIVX(origsv)); - if (SvNOK(origsv) || SvNOKp(origsv)) - SvNV_set(copysv, SvNVX(origsv)); - SvFLAGS(copysv) |= SvFLAGS(origsv) & - (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK| - SVf_UTF8|SVf_IVisUV); - } else -#endif - { - pv = SvPV_nomg(origsv, len); - copysv = newSVpvn_flags(pv, len, - (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP); - } - *MARK = copysv; + /* + * Because of a nasty platform-specific variation on the meaning + * of arguments to this op, we must preserve numeric arguments + * as numeric, not just retain the string value. + */ + if (SvNIOK(origsv) || SvNIOKp(origsv)) { + copysv = newSV_type(SVt_PVNV); + sv_2mortal(copysv); + if (SvPOK(origsv) || SvPOKp(origsv)) { + pv = SvPV_nomg(origsv, len); + sv_setpvn(copysv, pv, len); + SvPOK_off(copysv); + } + if (SvIOK(origsv) || SvIOKp(origsv)) + SvIV_set(copysv, SvIVX(origsv)); + if (SvNOK(origsv) || SvNOKp(origsv)) + SvNV_set(copysv, SvNVX(origsv)); + SvFLAGS(copysv) |= SvFLAGS(origsv) & + (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK| + SVf_UTF8|SVf_IVisUV); + } else +#endif + { + pv = SvPV_nomg(origsv, len); + copysv = newSVpvn_flags(pv, len, + (SvFLAGS(origsv) & SVf_UTF8) | SVs_TEMP); + } + *MARK = copysv; } MARK = ORIGMARK; if (TAINTING_get) { - TAINT_ENV(); - TAINT_PROPER("system"); + TAINT_ENV(); + TAINT_PROPER("system"); } PERL_FLUSHALL_FOR_CHILD; #if (defined(HAS_FORK) || defined(__amigaos4__)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO) @@ -4355,17 +4355,17 @@ PP(pp_system) struct UserData userdata; pthread_t proc; #else - Pid_t childpid; + Pid_t childpid; #endif - int pp[2]; - I32 did_pipes = 0; + int pp[2]; + I32 did_pipes = 0; bool child_success = FALSE; #ifdef HAS_SIGPROCMASK - sigset_t newset, oldset; + sigset_t newset, oldset; #endif - if (PerlProc_pipe_cloexec(pp) >= 0) - did_pipes = 1; + if (PerlProc_pipe_cloexec(pp) >= 0) + did_pipes = 1; #ifdef __amigaos4__ amigaos_fork_set_userdata(aTHX_ &userdata, @@ -4377,73 +4377,73 @@ PP(pp_system) child_success = proc > 0; #else #ifdef HAS_SIGPROCMASK - sigemptyset(&newset); - sigaddset(&newset, SIGCHLD); - sigprocmask(SIG_BLOCK, &newset, &oldset); -#endif - while ((childpid = PerlProc_fork()) == -1) { - if (errno != EAGAIN) { - value = -1; - SP = ORIGMARK; - XPUSHi(value); - if (did_pipes) { - PerlLIO_close(pp[0]); - PerlLIO_close(pp[1]); - } + sigemptyset(&newset); + sigaddset(&newset, SIGCHLD); + sigprocmask(SIG_BLOCK, &newset, &oldset); +#endif + while ((childpid = PerlProc_fork()) == -1) { + if (errno != EAGAIN) { + value = -1; + SP = ORIGMARK; + XPUSHi(value); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } #ifdef HAS_SIGPROCMASK - sigprocmask(SIG_SETMASK, &oldset, NULL); + sigprocmask(SIG_SETMASK, &oldset, NULL); #endif - RETURN; - } - sleep(5); - } + RETURN; + } + sleep(5); + } child_success = childpid > 0; #endif - if (child_success) { - Sigsave_t ihand,qhand; /* place to save signals during system() */ - int status; + if (child_success) { + Sigsave_t ihand,qhand; /* place to save signals during system() */ + int status; #ifndef __amigaos4__ - if (did_pipes) - PerlLIO_close(pp[1]); + if (did_pipes) + PerlLIO_close(pp[1]); #endif #ifndef PERL_MICRO - rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand); - rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand); + rsignal_save(SIGINT, (Sighandler_t) SIG_IGN, &ihand); + rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand); #endif #ifdef __amigaos4__ result = pthread_join(proc, (void **)&status); #else - do { - result = wait4pid(childpid, &status, 0); - } while (result == -1 && errno == EINTR); + do { + result = wait4pid(childpid, &status, 0); + } while (result == -1 && errno == EINTR); #endif #ifndef PERL_MICRO #ifdef HAS_SIGPROCMASK - sigprocmask(SIG_SETMASK, &oldset, NULL); + sigprocmask(SIG_SETMASK, &oldset, NULL); #endif - (void)rsignal_restore(SIGINT, &ihand); - (void)rsignal_restore(SIGQUIT, &qhand); + (void)rsignal_restore(SIGINT, &ihand); + (void)rsignal_restore(SIGQUIT, &qhand); #endif - STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status); - SP = ORIGMARK; - if (did_pipes) { - int errkid; - unsigned n = 0; + STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status); + SP = ORIGMARK; + if (did_pipes) { + int errkid; + unsigned n = 0; - while (n < sizeof(int)) { + while (n < sizeof(int)) { const SSize_t n1 = PerlLIO_read(pp[0], - (void*)(((char*)&errkid)+n), - (sizeof(int)) - n); - if (n1 <= 0) - break; - n += n1; - } - PerlLIO_close(pp[0]); - if (n) { /* Error */ - if (n != sizeof(int)) - DIE(aTHX_ "panic: kid popen errno read, n=%u", n); - errno = errkid; /* Propagate errno from kid */ + (void*)(((char*)&errkid)+n), + (sizeof(int)) - n); + if (n1 <= 0) + break; + n += n1; + } + PerlLIO_close(pp[0]); + if (n) { /* Error */ + if (n != sizeof(int)) + DIE(aTHX_ "panic: kid popen errno read, n=%u", n); + errno = errkid; /* Propagate errno from kid */ #ifdef __amigaos4__ /* The pipe always has something in it * so n alone is not enough. */ @@ -4452,52 +4452,52 @@ PP(pp_system) { STATUS_NATIVE_CHILD_SET(-1); } - } - } - XPUSHi(STATUS_CURRENT); - RETURN; - } + } + } + XPUSHi(STATUS_CURRENT); + RETURN; + } #ifndef __amigaos4__ #ifdef HAS_SIGPROCMASK - sigprocmask(SIG_SETMASK, &oldset, NULL); -#endif - if (did_pipes) - PerlLIO_close(pp[0]); - if (PL_op->op_flags & OPf_STACKED) { - SV * const really = *++MARK; - value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); - } - else if (SP - MARK != 1) - value = (I32)do_aexec5(NULL, MARK, SP, pp[1], did_pipes); - else { - value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes); - } + sigprocmask(SIG_SETMASK, &oldset, NULL); +#endif + if (did_pipes) + PerlLIO_close(pp[0]); + if (PL_op->op_flags & OPf_STACKED) { + SV * const really = *++MARK; + value = (I32)do_aexec5(really, MARK, SP, pp[1], did_pipes); + } + else if (SP - MARK != 1) + value = (I32)do_aexec5(NULL, MARK, SP, pp[1], did_pipes); + else { + value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes); + } #endif /* __amigaos4__ */ - PerlProc__exit(-1); + PerlProc__exit(-1); } #else /* ! FORK or VMS or OS/2 */ PL_statusvalue = 0; result = 0; if (PL_op->op_flags & OPf_STACKED) { - SV * const really = *++MARK; + SV * const really = *++MARK; # if defined(WIN32) || defined(OS2) || defined(__VMS) - value = (I32)do_aspawn(really, MARK, SP); + value = (I32)do_aspawn(really, MARK, SP); # else - value = (I32)do_aspawn(really, (void **)MARK, (void **)SP); + value = (I32)do_aspawn(really, (void **)MARK, (void **)SP); # endif } else if (SP - MARK != 1) { # if defined(WIN32) || defined(OS2) || defined(__VMS) - value = (I32)do_aspawn(NULL, MARK, SP); + value = (I32)do_aspawn(NULL, MARK, SP); # else - value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP); + value = (I32)do_aspawn(NULL, (void **)MARK, (void **)SP); # endif } else { - value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP))); + value = (I32)do_spawn(SvPVx_nolen(sv_mortalcopy(*SP))); } if (PL_statusvalue == -1) /* hint that value must be returned as is */ - result = 1; + result = 1; STATUS_NATIVE_CHILD_SET(value); SP = ORIGMARK; XPUSHi(result ? value : STATUS_CURRENT); @@ -4512,32 +4512,32 @@ PP(pp_exec) I32 value; if (TAINTING_get) { - TAINT_ENV(); - while (++MARK <= SP) { - (void)SvPV_nolen_const(*MARK); /* stringify for taint check */ - if (TAINT_get) - break; - } - MARK = ORIGMARK; - TAINT_PROPER("exec"); + TAINT_ENV(); + while (++MARK <= SP) { + (void)SvPV_nolen_const(*MARK); /* stringify for taint check */ + if (TAINT_get) + break; + } + MARK = ORIGMARK; + TAINT_PROPER("exec"); } PERL_FLUSHALL_FOR_CHILD; if (PL_op->op_flags & OPf_STACKED) { - SV * const really = *++MARK; - value = (I32)do_aexec(really, MARK, SP); + SV * const really = *++MARK; + value = (I32)do_aexec(really, MARK, SP); } else if (SP - MARK != 1) #ifdef VMS - value = (I32)vms_do_aexec(NULL, MARK, SP); + value = (I32)vms_do_aexec(NULL, MARK, SP); #else - value = (I32)do_aexec(NULL, MARK, SP); + value = (I32)do_aexec(NULL, MARK, SP); #endif else { #ifdef VMS - value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); + value = (I32)vms_do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); #else - value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); + value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP))); #endif } SP = ORIGMARK; @@ -4562,13 +4562,13 @@ PP(pp_getpgrp) dSP; dTARGET; Pid_t pgrp; const Pid_t pid = - (MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0); + (MAXARG < 1) ? 0 : TOPs ? SvIVx(POPs) : ((void)POPs, 0); #ifdef BSD_GETPGRP pgrp = (I32)BSD_GETPGRP(pid); #else if (pid != 0 && pid != PerlProc_getpid()) - DIE(aTHX_ "POSIX getpgrp can't take an argument"); + DIE(aTHX_ "POSIX getpgrp can't take an argument"); pgrp = getpgrp(); #endif XPUSHi(pgrp); @@ -4587,9 +4587,9 @@ PP(pp_setpgrp) pgrp = MAXARG == 2 && (TOPs||POPs) ? POPi : 0; if (MAXARG > 0) pid = TOPs ? TOPi : 0; else { - pid = 0; - EXTEND(SP,1); - SP++; + pid = 0; + EXTEND(SP,1); + SP++; } TAINT_PROPER("setpgrp"); @@ -4597,9 +4597,9 @@ PP(pp_setpgrp) SETi( BSD_SETPGRP(pid, pgrp) >= 0 ); #else if ((pgrp != 0 && pgrp != PerlProc_getpid()) - || (pid != 0 && pid != PerlProc_getpid())) + || (pid != 0 && pid != PerlProc_getpid())) { - DIE(aTHX_ "setpgrp can't take arguments"); + DIE(aTHX_ "setpgrp can't take arguments"); } SETi( setpgrp() >= 0 ); #endif /* USE_BSDPGRP */ @@ -4674,9 +4674,9 @@ PP(pp_tms) mPUSHn(((NV)timesbuf.tms_utime)/(NV)PL_clocktick); if (GIMME_V == G_ARRAY) { - mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick); - mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick); - mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick); + mPUSHn(((NV)timesbuf.tms_stime)/(NV)PL_clocktick); + mPUSHn(((NV)timesbuf.tms_cutime)/(NV)PL_clocktick); + mPUSHn(((NV)timesbuf.tms_cstime)/(NV)PL_clocktick); } RETURN; #elif defined(PERL_MICRO) @@ -4684,9 +4684,9 @@ PP(pp_tms) mPUSHn(0.0); EXTEND(SP, 4); if (GIMME_V == G_ARRAY) { - mPUSHn(0.0); - mPUSHn(0.0); - mPUSHn(0.0); + mPUSHn(0.0); + mPUSHn(0.0); + mPUSHn(0.0); } RETURN; #else @@ -4714,62 +4714,62 @@ PP(pp_gmtime) struct TM *err; const char *opname = PL_op->op_type == OP_LOCALTIME ? "localtime" : "gmtime"; static const char * const dayname[] = - {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; + {"Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"}; static const char * const monname[] = - {"Jan", "Feb", "Mar", "Apr", "May", "Jun", - "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + {"Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; if (MAXARG < 1 || (!TOPs && ((void)POPs, 1))) { - time_t now; - (void)time(&now); - when = (Time64_T)now; + time_t now; + (void)time(&now); + when = (Time64_T)now; } else { - NV input = Perl_floor(POPn); - const bool pl_isnan = Perl_isnan(input); - when = (Time64_T)input; - if (UNLIKELY(pl_isnan || when != input)) { - /* diag_listed_as: gmtime(%f) too large */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too large", opname, input); - if (pl_isnan) { - err = NULL; - goto failed; - } - } + NV input = Perl_floor(POPn); + const bool pl_isnan = Perl_isnan(input); + when = (Time64_T)input; + if (UNLIKELY(pl_isnan || when != input)) { + /* diag_listed_as: gmtime(%f) too large */ + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too large", opname, input); + if (pl_isnan) { + err = NULL; + goto failed; + } + } } if ( TIME_LOWER_BOUND > when ) { - /* diag_listed_as: gmtime(%f) too small */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too small", opname, when); - err = NULL; + /* diag_listed_as: gmtime(%f) too small */ + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too small", opname, when); + err = NULL; } else if( when > TIME_UPPER_BOUND ) { - /* diag_listed_as: gmtime(%f) too small */ - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") too large", opname, when); - err = NULL; + /* diag_listed_as: gmtime(%f) too small */ + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") too large", opname, when); + err = NULL; } else { - if (PL_op->op_type == OP_LOCALTIME) - err = Perl_localtime64_r(&when, &tmbuf); - else - err = Perl_gmtime64_r(&when, &tmbuf); + if (PL_op->op_type == OP_LOCALTIME) + err = Perl_localtime64_r(&when, &tmbuf); + else + err = Perl_gmtime64_r(&when, &tmbuf); } if (err == NULL) { - /* diag_listed_as: gmtime(%f) failed */ - /* XXX %lld broken for quads */ + /* diag_listed_as: gmtime(%f) failed */ + /* XXX %lld broken for quads */ failed: - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "%s(%.0" NVff ") failed", opname, when); + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "%s(%.0" NVff ") failed", opname, when); } if (GIMME_V != G_ARRAY) { /* scalar context */ EXTEND(SP, 1); - if (err == NULL) - RETPUSHUNDEF; + if (err == NULL) + RETPUSHUNDEF; else { dTARGET; PUSHs(TARG); @@ -4784,20 +4784,20 @@ PP(pp_gmtime) } } else { /* list context */ - if ( err == NULL ) - RETURN; + if ( err == NULL ) + RETURN; EXTEND(SP, 9); EXTEND_MORTAL(9); mPUSHi(tmbuf.tm_sec); - mPUSHi(tmbuf.tm_min); - mPUSHi(tmbuf.tm_hour); - mPUSHi(tmbuf.tm_mday); - mPUSHi(tmbuf.tm_mon); - mPUSHn(tmbuf.tm_year); - mPUSHi(tmbuf.tm_wday); - mPUSHi(tmbuf.tm_yday); - mPUSHi(tmbuf.tm_isdst); + mPUSHi(tmbuf.tm_min); + mPUSHi(tmbuf.tm_hour); + mPUSHi(tmbuf.tm_mday); + mPUSHi(tmbuf.tm_mon); + mPUSHn(tmbuf.tm_year); + mPUSHi(tmbuf.tm_wday); + mPUSHi(tmbuf.tm_yday); + mPUSHi(tmbuf.tm_isdst); } RETURN; } @@ -4843,7 +4843,7 @@ PP(pp_sleep) (void)time(&lasttime); if (MAXARG < 1 || (!TOPs && !POPs)) - PerlProc_pause(); + PerlProc_pause(); else { const I32 duration = POPi; if (duration < 0) { @@ -4876,17 +4876,17 @@ PP(pp_shmwrite) switch (op_type) { case OP_MSGSND: - value = (I32)(do_msgsnd(MARK, SP) >= 0); - break; + value = (I32)(do_msgsnd(MARK, SP) >= 0); + break; case OP_MSGRCV: - value = (I32)(do_msgrcv(MARK, SP) >= 0); - break; + value = (I32)(do_msgrcv(MARK, SP) >= 0); + break; case OP_SEMOP: - value = (I32)(do_semop(MARK, SP) >= 0); - break; + value = (I32)(do_semop(MARK, SP) >= 0); + break; default: - value = (I32)(do_shmio(op_type, MARK, SP) >= 0); - break; + value = (I32)(do_shmio(op_type, MARK, SP) >= 0); + break; } SP = MARK; @@ -4908,7 +4908,7 @@ PP(pp_semget) const int anum = do_ipcget(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) - RETPUSHUNDEF; + RETPUSHUNDEF; PUSHi(anum); RETURN; #else @@ -4925,12 +4925,12 @@ PP(pp_semctl) const int anum = do_ipcctl(PL_op->op_type, MARK, SP); SP = MARK; if (anum == -1) - RETPUSHUNDEF; + RETPUSHUNDEF; if (anum != 0) { - PUSHi(anum); + PUSHi(anum); } else { - PUSHp(zero_but_true, ZBTLEN); + PUSHp(zero_but_true, ZBTLEN); } RETURN; #else @@ -4946,15 +4946,15 @@ S_space_join_names_mortal(pTHX_ char *const *array) SV *target; if (array && *array) { - target = newSVpvs_flags("", SVs_TEMP); - while (1) { - sv_catpv(target, *array); - if (!*++array) - break; - sv_catpvs(target, " "); - } + target = newSVpvs_flags("", SVs_TEMP); + while (1) { + sv_catpv(target, *array); + if (!*++array) + break; + sv_catpvs(target, " "); + } } else { - target = sv_mortalcopy(&PL_sv_no); + target = sv_mortalcopy(&PL_sv_no); } return target; } @@ -4981,70 +4981,70 @@ PP(pp_ghostent) EXTEND(SP, 10); if (which == OP_GHBYNAME) { #ifdef HAS_GETHOSTBYNAME - const char* const name = POPpbytex; - hent = PerlSock_gethostbyname(name); + const char* const name = POPpbytex; + hent = PerlSock_gethostbyname(name); #else - DIE(aTHX_ PL_no_sock_func, "gethostbyname"); + DIE(aTHX_ PL_no_sock_func, "gethostbyname"); #endif } else if (which == OP_GHBYADDR) { #ifdef HAS_GETHOSTBYADDR - const int addrtype = POPi; - SV * const addrsv = POPs; - STRLEN addrlen; - const char *addr = (char *)SvPVbyte(addrsv, addrlen); + const int addrtype = POPi; + SV * const addrsv = POPs; + STRLEN addrlen; + const char *addr = (char *)SvPVbyte(addrsv, addrlen); - hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); + hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype); #else - DIE(aTHX_ PL_no_sock_func, "gethostbyaddr"); + DIE(aTHX_ PL_no_sock_func, "gethostbyaddr"); #endif } else #ifdef HAS_GETHOSTENT - hent = PerlSock_gethostent(); + hent = PerlSock_gethostent(); #else - DIE(aTHX_ PL_no_sock_func, "gethostent"); + DIE(aTHX_ PL_no_sock_func, "gethostent"); #endif #ifdef HOST_NOT_FOUND - if (!hent) { + if (!hent) { #ifdef USE_REENTRANT_API # ifdef USE_GETHOSTENT_ERRNO - h_errno = PL_reentrant_buffer->_gethostent_errno; + h_errno = PL_reentrant_buffer->_gethostent_errno; # endif #endif - STATUS_UNIX_SET(h_errno); - } + STATUS_UNIX_SET(h_errno); + } #endif if (GIMME_V != G_ARRAY) { - PUSHs(sv = sv_newmortal()); - if (hent) { - if (which == OP_GHBYNAME) { - if (hent->h_addr) - sv_setpvn(sv, hent->h_addr, hent->h_length); - } - else - sv_setpv(sv, (char*)hent->h_name); - } - RETURN; + PUSHs(sv = sv_newmortal()); + if (hent) { + if (which == OP_GHBYNAME) { + if (hent->h_addr) + sv_setpvn(sv, hent->h_addr, hent->h_length); + } + else + sv_setpv(sv, (char*)hent->h_name); + } + RETURN; } if (hent) { - mPUSHs(newSVpv((char*)hent->h_name, 0)); - PUSHs(space_join_names_mortal(hent->h_aliases)); - mPUSHi(hent->h_addrtype); - len = hent->h_length; - mPUSHi(len); + mPUSHs(newSVpv((char*)hent->h_name, 0)); + PUSHs(space_join_names_mortal(hent->h_aliases)); + mPUSHi(hent->h_addrtype); + len = hent->h_length; + mPUSHi(len); #ifdef h_addr - for (elem = hent->h_addr_list; elem && *elem; elem++) { - mXPUSHp(*elem, len); - } + for (elem = hent->h_addr_list; elem && *elem; elem++) { + mXPUSHp(*elem, len); + } #else - if (hent->h_addr) - mPUSHp(hent->h_addr, len); - else - PUSHs(sv_mortalcopy(&PL_sv_no)); + if (hent->h_addr) + mPUSHp(hent->h_addr, len); + else + PUSHs(sv_mortalcopy(&PL_sv_no)); #endif /* h_addr */ } RETURN; @@ -5070,56 +5070,56 @@ PP(pp_gnetent) if (which == OP_GNBYNAME){ #ifdef HAS_GETNETBYNAME - const char * const name = POPpbytex; - nent = PerlSock_getnetbyname(name); + const char * const name = POPpbytex; + nent = PerlSock_getnetbyname(name); #else DIE(aTHX_ PL_no_sock_func, "getnetbyname"); #endif } else if (which == OP_GNBYADDR) { #ifdef HAS_GETNETBYADDR - const int addrtype = POPi; - const Netdb_net_t addr = (Netdb_net_t) (U32)POPu; - nent = PerlSock_getnetbyaddr(addr, addrtype); + const int addrtype = POPi; + const Netdb_net_t addr = (Netdb_net_t) (U32)POPu; + nent = PerlSock_getnetbyaddr(addr, addrtype); #else - DIE(aTHX_ PL_no_sock_func, "getnetbyaddr"); + DIE(aTHX_ PL_no_sock_func, "getnetbyaddr"); #endif } else #ifdef HAS_GETNETENT - nent = PerlSock_getnetent(); + nent = PerlSock_getnetent(); #else DIE(aTHX_ PL_no_sock_func, "getnetent"); #endif #ifdef HOST_NOT_FOUND - if (!nent) { + if (!nent) { #ifdef USE_REENTRANT_API # ifdef USE_GETNETENT_ERRNO - h_errno = PL_reentrant_buffer->_getnetent_errno; + h_errno = PL_reentrant_buffer->_getnetent_errno; # endif #endif - STATUS_UNIX_SET(h_errno); - } + STATUS_UNIX_SET(h_errno); + } #endif EXTEND(SP, 4); if (GIMME_V != G_ARRAY) { - PUSHs(sv = sv_newmortal()); - if (nent) { - if (which == OP_GNBYNAME) - sv_setiv(sv, (IV)nent->n_net); - else - sv_setpv(sv, nent->n_name); - } - RETURN; + PUSHs(sv = sv_newmortal()); + if (nent) { + if (which == OP_GNBYNAME) + sv_setiv(sv, (IV)nent->n_net); + else + sv_setpv(sv, nent->n_name); + } + RETURN; } if (nent) { - mPUSHs(newSVpv(nent->n_name, 0)); - PUSHs(space_join_names_mortal(nent->n_aliases)); - mPUSHi(nent->n_addrtype); - mPUSHi(nent->n_net); + mPUSHs(newSVpv(nent->n_name, 0)); + PUSHs(space_join_names_mortal(nent->n_aliases)); + mPUSHi(nent->n_addrtype); + mPUSHi(nent->n_net); } RETURN; @@ -5146,43 +5146,43 @@ PP(pp_gprotoent) if (which == OP_GPBYNAME) { #ifdef HAS_GETPROTOBYNAME - const char* const name = POPpbytex; - pent = PerlSock_getprotobyname(name); + const char* const name = POPpbytex; + pent = PerlSock_getprotobyname(name); #else - DIE(aTHX_ PL_no_sock_func, "getprotobyname"); + DIE(aTHX_ PL_no_sock_func, "getprotobyname"); #endif } else if (which == OP_GPBYNUMBER) { #ifdef HAS_GETPROTOBYNUMBER - const int number = POPi; - pent = PerlSock_getprotobynumber(number); + const int number = POPi; + pent = PerlSock_getprotobynumber(number); #else - DIE(aTHX_ PL_no_sock_func, "getprotobynumber"); + DIE(aTHX_ PL_no_sock_func, "getprotobynumber"); #endif } else #ifdef HAS_GETPROTOENT - pent = PerlSock_getprotoent(); + pent = PerlSock_getprotoent(); #else - DIE(aTHX_ PL_no_sock_func, "getprotoent"); + DIE(aTHX_ PL_no_sock_func, "getprotoent"); #endif EXTEND(SP, 3); if (GIMME_V != G_ARRAY) { - PUSHs(sv = sv_newmortal()); - if (pent) { - if (which == OP_GPBYNAME) - sv_setiv(sv, (IV)pent->p_proto); - else - sv_setpv(sv, pent->p_name); - } - RETURN; + PUSHs(sv = sv_newmortal()); + if (pent) { + if (which == OP_GPBYNAME) + sv_setiv(sv, (IV)pent->p_proto); + else + sv_setpv(sv, pent->p_name); + } + RETURN; } if (pent) { - mPUSHs(newSVpv(pent->p_name, 0)); - PUSHs(space_join_names_mortal(pent->p_aliases)); - mPUSHi(pent->p_proto); + mPUSHs(newSVpv(pent->p_name, 0)); + PUSHs(space_join_names_mortal(pent->p_aliases)); + mPUSHi(pent->p_proto); } RETURN; @@ -5209,48 +5209,48 @@ PP(pp_gservent) if (which == OP_GSBYNAME) { #ifdef HAS_GETSERVBYNAME - const char * const proto = POPpbytex; - const char * const name = POPpbytex; - sent = PerlSock_getservbyname(name, (proto && !*proto) ? NULL : proto); + const char * const proto = POPpbytex; + const char * const name = POPpbytex; + sent = PerlSock_getservbyname(name, (proto && !*proto) ? NULL : proto); #else - DIE(aTHX_ PL_no_sock_func, "getservbyname"); + DIE(aTHX_ PL_no_sock_func, "getservbyname"); #endif } else if (which == OP_GSBYPORT) { #ifdef HAS_GETSERVBYPORT - const char * const proto = POPpbytex; - unsigned short port = (unsigned short)POPu; - port = PerlSock_htons(port); - sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto); + const char * const proto = POPpbytex; + unsigned short port = (unsigned short)POPu; + port = PerlSock_htons(port); + sent = PerlSock_getservbyport(port, (proto && !*proto) ? NULL : proto); #else - DIE(aTHX_ PL_no_sock_func, "getservbyport"); + DIE(aTHX_ PL_no_sock_func, "getservbyport"); #endif } else #ifdef HAS_GETSERVENT - sent = PerlSock_getservent(); + sent = PerlSock_getservent(); #else - DIE(aTHX_ PL_no_sock_func, "getservent"); + DIE(aTHX_ PL_no_sock_func, "getservent"); #endif EXTEND(SP, 4); if (GIMME_V != G_ARRAY) { - PUSHs(sv = sv_newmortal()); - if (sent) { - if (which == OP_GSBYNAME) { - sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); - } - else - sv_setpv(sv, sent->s_name); - } - RETURN; + PUSHs(sv = sv_newmortal()); + if (sent) { + if (which == OP_GSBYNAME) { + sv_setiv(sv, (IV)PerlSock_ntohs(sent->s_port)); + } + else + sv_setpv(sv, sent->s_name); + } + RETURN; } if (sent) { - mPUSHs(newSVpv(sent->s_name, 0)); - PUSHs(space_join_names_mortal(sent->s_aliases)); - mPUSHi(PerlSock_ntohs(sent->s_port)); - mPUSHs(newSVpv(sent->s_proto, 0)); + mPUSHs(newSVpv(sent->s_name, 0)); + PUSHs(space_join_names_mortal(sent->s_aliases)); + mPUSHi(PerlSock_ntohs(sent->s_port)); + mPUSHs(newSVpv(sent->s_proto, 0)); } RETURN; @@ -5269,32 +5269,32 @@ PP(pp_shostent) switch(PL_op->op_type) { case OP_SHOSTENT: #ifdef HAS_SETHOSTENT - PerlSock_sethostent(stayopen); + PerlSock_sethostent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_SNETENT: #ifdef HAS_SETNETENT - PerlSock_setnetent(stayopen); + PerlSock_setnetent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_SPROTOENT: #ifdef HAS_SETPROTOENT - PerlSock_setprotoent(stayopen); + PerlSock_setprotoent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_SSERVENT: #ifdef HAS_SETSERVENT - PerlSock_setservent(stayopen); + PerlSock_setservent(stayopen); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; } RETSETYES; } @@ -5309,60 +5309,60 @@ PP(pp_ehostent) switch(PL_op->op_type) { case OP_EHOSTENT: #ifdef HAS_ENDHOSTENT - PerlSock_endhostent(); + PerlSock_endhostent(); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_ENETENT: #ifdef HAS_ENDNETENT - PerlSock_endnetent(); + PerlSock_endnetent(); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_EPROTOENT: #ifdef HAS_ENDPROTOENT - PerlSock_endprotoent(); + PerlSock_endprotoent(); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_ESERVENT: #ifdef HAS_ENDSERVENT - PerlSock_endservent(); + PerlSock_endservent(); #else - DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_sock_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_SGRENT: #if defined(HAS_GROUP) && defined(HAS_SETGRENT) - setgrent(); + setgrent(); #else - DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_EGRENT: #if defined(HAS_GROUP) && defined(HAS_ENDGRENT) - endgrent(); + endgrent(); #else - DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_SPWENT: #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) - setpwent(); + setpwent(); #else - DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; case OP_EPWENT: #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT) - endpwent(); + endpwent(); #else - DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); + DIE(aTHX_ PL_no_func, PL_op_desc[PL_op->op_type]); #endif - break; + break; } EXTEND(SP,1); RETPUSHYES; @@ -5447,131 +5447,131 @@ PP(pp_gpwent) switch (which) { case OP_GPWNAM: { - const char* const name = POPpbytex; - pwent = getpwnam(name); + const char* const name = POPpbytex; + pwent = getpwnam(name); } break; case OP_GPWUID: { - Uid_t uid = POPi; - pwent = getpwuid(uid); + Uid_t uid = POPi; + pwent = getpwuid(uid); } - break; + break; case OP_GPWENT: # ifdef HAS_GETPWENT - pwent = getpwent(); + pwent = getpwent(); #ifdef POSIX_BC /* In some cases pw_passwd has invalid addresses */ - if (pwent) pwent = getpwnam(pwent->pw_name); + if (pwent) pwent = getpwnam(pwent->pw_name); #endif # else - DIE(aTHX_ PL_no_func, "getpwent"); + DIE(aTHX_ PL_no_func, "getpwent"); # endif - break; + break; } EXTEND(SP, 10); if (GIMME_V != G_ARRAY) { - PUSHs(sv = sv_newmortal()); - if (pwent) { - if (which == OP_GPWNAM) - sv_setuid(sv, pwent->pw_uid); - else - sv_setpv(sv, pwent->pw_name); - } - RETURN; + PUSHs(sv = sv_newmortal()); + if (pwent) { + if (which == OP_GPWNAM) + sv_setuid(sv, pwent->pw_uid); + else + sv_setpv(sv, pwent->pw_name); + } + RETURN; } if (pwent) { - mPUSHs(newSVpv(pwent->pw_name, 0)); - - sv = newSViv(0); - mPUSHs(sv); - /* If we have getspnam(), we try to dig up the shadow - * password. If we are underprivileged, the shadow - * interface will set the errno to EACCES or similar, - * and return a null pointer. If this happens, we will - * use the dummy password (usually "*" or "x") from the - * standard password database. - * - * In theory we could skip the shadow call completely - * if euid != 0 but in practice we cannot know which - * security measures are guarding the shadow databases - * on a random platform. - * - * Resist the urge to use additional shadow interfaces. - * Divert the urge to writing an extension instead. - * - * --jhi */ - /* Some AIX setups falsely(?) detect some getspnam(), which - * has a different API than the Solaris/IRIX one. */ + mPUSHs(newSVpv(pwent->pw_name, 0)); + + sv = newSViv(0); + mPUSHs(sv); + /* If we have getspnam(), we try to dig up the shadow + * password. If we are underprivileged, the shadow + * interface will set the errno to EACCES or similar, + * and return a null pointer. If this happens, we will + * use the dummy password (usually "*" or "x") from the + * standard password database. + * + * In theory we could skip the shadow call completely + * if euid != 0 but in practice we cannot know which + * security measures are guarding the shadow databases + * on a random platform. + * + * Resist the urge to use additional shadow interfaces. + * Divert the urge to writing an extension instead. + * + * --jhi */ + /* Some AIX setups falsely(?) detect some getspnam(), which + * has a different API than the Solaris/IRIX one. */ # if defined(HAS_GETSPNAM) && !defined(_AIX) - { - dSAVE_ERRNO; - const struct spwd * const spwent = getspnam(pwent->pw_name); - /* Save and restore errno so that - * underprivileged attempts seem - * to have never made the unsuccessful - * attempt to retrieve the shadow password. */ - RESTORE_ERRNO; - if (spwent && spwent->sp_pwdp) - sv_setpv(sv, spwent->sp_pwdp); - } + { + dSAVE_ERRNO; + const struct spwd * const spwent = getspnam(pwent->pw_name); + /* Save and restore errno so that + * underprivileged attempts seem + * to have never made the unsuccessful + * attempt to retrieve the shadow password. */ + RESTORE_ERRNO; + if (spwent && spwent->sp_pwdp) + sv_setpv(sv, spwent->sp_pwdp); + } # endif # ifdef PWPASSWD - if (!SvPOK(sv)) /* Use the standard password, then. */ - sv_setpv(sv, pwent->pw_passwd); + if (!SvPOK(sv)) /* Use the standard password, then. */ + sv_setpv(sv, pwent->pw_passwd); # endif - /* passwd is tainted because user himself can diddle with it. - * admittedly not much and in a very limited way, but nevertheless. */ - SvTAINTED_on(sv); + /* passwd is tainted because user himself can diddle with it. + * admittedly not much and in a very limited way, but nevertheless. */ + SvTAINTED_on(sv); sv_setuid(PUSHmortal, pwent->pw_uid); sv_setgid(PUSHmortal, pwent->pw_gid); - /* pw_change, pw_quota, and pw_age are mutually exclusive-- - * because of the poor interface of the Perl getpw*(), - * not because there's some standard/convention saying so. - * A better interface would have been to return a hash, - * but we are accursed by our history, alas. --jhi. */ + /* pw_change, pw_quota, and pw_age are mutually exclusive-- + * because of the poor interface of the Perl getpw*(), + * not because there's some standard/convention saying so. + * A better interface would have been to return a hash, + * but we are accursed by our history, alas. --jhi. */ # ifdef PWCHANGE - mPUSHi(pwent->pw_change); + mPUSHi(pwent->pw_change); # elif defined(PWQUOTA) - mPUSHi(pwent->pw_quota); + mPUSHi(pwent->pw_quota); # elif defined(PWAGE) - mPUSHs(newSVpv(pwent->pw_age, 0)); + mPUSHs(newSVpv(pwent->pw_age, 0)); # else - /* I think that you can never get this compiled, but just in case. */ - PUSHs(sv_mortalcopy(&PL_sv_no)); + /* I think that you can never get this compiled, but just in case. */ + PUSHs(sv_mortalcopy(&PL_sv_no)); # endif - /* pw_class and pw_comment are mutually exclusive--. - * see the above note for pw_change, pw_quota, and pw_age. */ + /* pw_class and pw_comment are mutually exclusive--. + * see the above note for pw_change, pw_quota, and pw_age. */ # ifdef PWCLASS - mPUSHs(newSVpv(pwent->pw_class, 0)); + mPUSHs(newSVpv(pwent->pw_class, 0)); # elif defined(PWCOMMENT) - mPUSHs(newSVpv(pwent->pw_comment, 0)); + mPUSHs(newSVpv(pwent->pw_comment, 0)); # else - /* I think that you can never get this compiled, but just in case. */ - PUSHs(sv_mortalcopy(&PL_sv_no)); + /* I think that you can never get this compiled, but just in case. */ + PUSHs(sv_mortalcopy(&PL_sv_no)); # endif # ifdef PWGECOS - PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0))); + PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_gecos, 0))); # else - PUSHs(sv = sv_mortalcopy(&PL_sv_no)); + PUSHs(sv = sv_mortalcopy(&PL_sv_no)); # endif - /* pw_gecos is tainted because user himself can diddle with it. */ - SvTAINTED_on(sv); + /* pw_gecos is tainted because user himself can diddle with it. */ + SvTAINTED_on(sv); - mPUSHs(newSVpv(pwent->pw_dir, 0)); + mPUSHs(newSVpv(pwent->pw_dir, 0)); - PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0))); - /* pw_shell is tainted because user himself can diddle with it. */ - SvTAINTED_on(sv); + PUSHs(sv = sv_2mortal(newSVpv(pwent->pw_shell, 0))); + /* pw_shell is tainted because user himself can diddle with it. */ + SvTAINTED_on(sv); # ifdef PWEXPIRE - mPUSHi(pwent->pw_expire); + mPUSHi(pwent->pw_expire); # endif } RETURN; @@ -5591,61 +5591,61 @@ PP(pp_ggrent) const struct group *grent; if (which == OP_GGRNAM) { - const char* const name = POPpbytex; - grent = (const struct group *)getgrnam(name); + const char* const name = POPpbytex; + grent = (const struct group *)getgrnam(name); } else if (which == OP_GGRGID) { #if Gid_t_sign == 1 - const Gid_t gid = POPu; + const Gid_t gid = POPu; #elif Gid_t_sign == -1 - const Gid_t gid = POPi; + const Gid_t gid = POPi; #else # error "Unexpected Gid_t_sign" #endif - grent = (const struct group *)getgrgid(gid); + grent = (const struct group *)getgrgid(gid); } else #ifdef HAS_GETGRENT - grent = (struct group *)getgrent(); + grent = (struct group *)getgrent(); #else DIE(aTHX_ PL_no_func, "getgrent"); #endif EXTEND(SP, 4); if (GIMME_V != G_ARRAY) { - SV * const sv = sv_newmortal(); + SV * const sv = sv_newmortal(); - PUSHs(sv); - if (grent) { - if (which == OP_GGRNAM) - sv_setgid(sv, grent->gr_gid); - else - sv_setpv(sv, grent->gr_name); - } - RETURN; + PUSHs(sv); + if (grent) { + if (which == OP_GGRNAM) + sv_setgid(sv, grent->gr_gid); + else + sv_setpv(sv, grent->gr_name); + } + RETURN; } if (grent) { - mPUSHs(newSVpv(grent->gr_name, 0)); + mPUSHs(newSVpv(grent->gr_name, 0)); #ifdef GRPASSWD - mPUSHs(newSVpv(grent->gr_passwd, 0)); + mPUSHs(newSVpv(grent->gr_passwd, 0)); #else - PUSHs(sv_mortalcopy(&PL_sv_no)); + PUSHs(sv_mortalcopy(&PL_sv_no)); #endif sv_setgid(PUSHmortal, grent->gr_gid); #if !(defined(_CRAYMPP) && defined(USE_REENTRANT_API)) - /* In UNICOS/mk (_CRAYMPP) the multithreading - * versions (getgrnam_r, getgrgid_r) - * seem to return an illegal pointer - * as the group members list, gr_mem. - * getgrent() doesn't even have a _r version - * but the gr_mem is poisonous anyway. - * So yes, you cannot get the list of group - * members if building multithreaded in UNICOS/mk. */ - PUSHs(space_join_names_mortal(grent->gr_mem)); + /* In UNICOS/mk (_CRAYMPP) the multithreading + * versions (getgrnam_r, getgrgid_r) + * seem to return an illegal pointer + * as the group members list, gr_mem. + * getgrent() doesn't even have a _r version + * but the gr_mem is poisonous anyway. + * So yes, you cannot get the list of group + * members if building multithreaded in UNICOS/mk. */ + PUSHs(space_join_names_mortal(grent->gr_mem)); #endif } @@ -5662,7 +5662,7 @@ PP(pp_getlogin) char *tmps; EXTEND(SP, 1); if (!(tmps = PerlProc_getlogin())) - RETPUSHUNDEF; + RETPUSHUNDEF; sv_setpv_mg(TARG, tmps); PUSHs(TARG); RETURN; @@ -5683,14 +5683,14 @@ PP(pp_syscall) IV retval = -1; if (TAINTING_get) { - while (++MARK <= SP) { - if (SvTAINTED(*MARK)) { - TAINT; - break; - } - } - MARK = ORIGMARK; - TAINT_PROPER("syscall"); + while (++MARK <= SP) { + if (SvTAINTED(*MARK)) { + TAINT; + break; + } + } + MARK = ORIGMARK; + TAINT_PROPER("syscall"); } /* This probably won't work on machines where sizeof(long) != sizeof(int) @@ -5698,44 +5698,44 @@ PP(pp_syscall) * not likely have syscall implemented either, so who cares? */ while (++MARK <= SP) { - if (SvNIOK(*MARK) || !i) - a[i++] = SvIV(*MARK); - else if (*MARK == &PL_sv_undef) - a[i++] = 0; - else - a[i++] = (unsigned long)SvPV_force_nolen(*MARK); - if (i > 15) - break; + if (SvNIOK(*MARK) || !i) + a[i++] = SvIV(*MARK); + else if (*MARK == &PL_sv_undef) + a[i++] = 0; + else + a[i++] = (unsigned long)SvPV_force_nolen(*MARK); + if (i > 15) + break; } switch (items) { default: - DIE(aTHX_ "Too many args to syscall"); + DIE(aTHX_ "Too many args to syscall"); case 0: - DIE(aTHX_ "Too few args to syscall"); + DIE(aTHX_ "Too few args to syscall"); case 1: - retval = syscall(a[0]); - break; + retval = syscall(a[0]); + break; case 2: - retval = syscall(a[0],a[1]); - break; + retval = syscall(a[0],a[1]); + break; case 3: - retval = syscall(a[0],a[1],a[2]); - break; + retval = syscall(a[0],a[1],a[2]); + break; case 4: - retval = syscall(a[0],a[1],a[2],a[3]); - break; + retval = syscall(a[0],a[1],a[2],a[3]); + break; case 5: - retval = syscall(a[0],a[1],a[2],a[3],a[4]); - break; + retval = syscall(a[0],a[1],a[2],a[3],a[4]); + break; case 6: - retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]); - break; + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5]); + break; case 7: - retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]); - break; + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6]); + break; case 8: - retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]); - break; + retval = syscall(a[0],a[1],a[2],a[3],a[4],a[5],a[6],a[7]); + break; } SP = ORIGMARK; PUSHi(retval); @@ -5759,24 +5759,24 @@ fcntl_emulate_flock(int fd, int operation) switch (operation & ~LOCK_NB) { case LOCK_SH: - flock.l_type = F_RDLCK; - break; + flock.l_type = F_RDLCK; + break; case LOCK_EX: - flock.l_type = F_WRLCK; - break; + flock.l_type = F_WRLCK; + break; case LOCK_UN: - flock.l_type = F_UNLCK; - break; + flock.l_type = F_UNLCK; + break; default: - errno = EINVAL; - return -1; + errno = EINVAL; + return -1; } flock.l_whence = SEEK_SET; flock.l_start = flock.l_len = (Off_t)0; res = fcntl(fd, (operation & LOCK_NB) ? F_SETLK : F_SETLKW, &flock); if (res == -1 && ((errno == EAGAIN) || (errno == EACCES))) - errno = EWOULDBLOCK; + errno = EWOULDBLOCK; return res; } @@ -5822,44 +5822,44 @@ lockf_emulate_flock(int fd, int operation) /* flock locks entire file so for lockf we need to do the same */ pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR); /* get pos to restore later */ if (pos > 0) /* is seekable and needs to be repositioned */ - if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0) - pos = -1; /* seek failed, so don't seek back afterwards */ + if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0) + pos = -1; /* seek failed, so don't seek back afterwards */ RESTORE_ERRNO; switch (operation) { - /* LOCK_SH - get a shared lock */ - case LOCK_SH: - /* LOCK_EX - get an exclusive lock */ - case LOCK_EX: - i = lockf (fd, F_LOCK, 0); - break; - - /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */ - case LOCK_SH|LOCK_NB: - /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */ - case LOCK_EX|LOCK_NB: - i = lockf (fd, F_TLOCK, 0); - if (i == -1) - if ((errno == EAGAIN) || (errno == EACCES)) - errno = EWOULDBLOCK; - break; - - /* LOCK_UN - unlock (non-blocking is a no-op) */ - case LOCK_UN: - case LOCK_UN|LOCK_NB: - i = lockf (fd, F_ULOCK, 0); - break; - - /* Default - can't decipher operation */ - default: - i = -1; - errno = EINVAL; - break; + /* LOCK_SH - get a shared lock */ + case LOCK_SH: + /* LOCK_EX - get an exclusive lock */ + case LOCK_EX: + i = lockf (fd, F_LOCK, 0); + break; + + /* LOCK_SH|LOCK_NB - get a non-blocking shared lock */ + case LOCK_SH|LOCK_NB: + /* LOCK_EX|LOCK_NB - get a non-blocking exclusive lock */ + case LOCK_EX|LOCK_NB: + i = lockf (fd, F_TLOCK, 0); + if (i == -1) + if ((errno == EAGAIN) || (errno == EACCES)) + errno = EWOULDBLOCK; + break; + + /* LOCK_UN - unlock (non-blocking is a no-op) */ + case LOCK_UN: + case LOCK_UN|LOCK_NB: + i = lockf (fd, F_ULOCK, 0); + break; + + /* Default - can't decipher operation */ + default: + i = -1; + errno = EINVAL; + break; } if (pos > 0) /* need to restore position of the handle */ - PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */ + PerlLIO_lseek(fd, pos, SEEK_SET); /* ignore error here */ return (i); } diff --git a/qnx/qnx.c b/qnx/qnx.c index 6c819e3209ba..a7a661b1e318 100644 --- a/qnx/qnx.c +++ b/qnx/qnx.c @@ -5,7 +5,7 @@ /* Return default value and print no error message */ int matherr( struct exception *err ) { - return 1; + return 1; } #endif diff --git a/regcomp.c b/regcomp.c index eb891a040207..bf9e2742ef6c 100644 --- a/regcomp.c +++ b/regcomp.c @@ -224,11 +224,11 @@ struct RExC_state_t { regnode *end_op; /* END node in program */ I32 utf8; /* whether the pattern is utf8 or not */ I32 orig_utf8; /* whether the pattern was originally in utf8 */ - /* XXX use this for future optimisation of case - * where pattern must be upgraded to utf8. */ + /* XXX use this for future optimisation of case + * where pattern must be upgraded to utf8. */ I32 uni_semantics; /* If a d charset modifier should use unicode - rules, even if the pattern is not in - utf8 */ + rules, even if the pattern is not in + utf8 */ I32 recurse_count; /* Number of recurse regops we have generated */ regnode **recurse; /* Recurse regops */ @@ -242,7 +242,7 @@ struct RExC_state_t { I32 in_multi_char_class; int code_index; /* next code_blocks[] slot */ struct reg_code_blocks *code_blocks;/* positions of literal (?{}) - within pattern */ + within pattern */ SSize_t maxlen; /* mininum possible number of chars in string to match */ scan_frame *frame_head; scan_frame *frame_last; @@ -801,23 +801,23 @@ static const scan_data_t zero_scan_data = { #define _FAIL(code) STMT_START { \ const char *ellipses = ""; \ IV len = RExC_precomp_end - RExC_precomp; \ - \ + \ PREPARE_TO_DIE; \ if (len > RegexLengthToShowInErrorMessages) { \ - /* chop 10 shorter than the max, to ensure meaning of "..." */ \ - len = RegexLengthToShowInErrorMessages - 10; \ - ellipses = "..."; \ + /* chop 10 shorter than the max, to ensure meaning of "..." */ \ + len = RegexLengthToShowInErrorMessages - 10; \ + ellipses = "..."; \ } \ code; \ } STMT_END #define FAIL(msg) _FAIL( \ Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \ - msg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) + msg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) #define FAIL2(msg,arg) _FAIL( \ Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ - arg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) + arg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) #define FAIL3(msg,arg1,arg2) _FAIL( \ Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ @@ -828,7 +828,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL(m) STMT_START { \ Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ - m, REPORT_LOCATION_ARGS(RExC_parse)); \ + m, REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END /* @@ -861,7 +861,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL3(m, a1, a2) STMT_START { \ S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ + REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END /* @@ -877,7 +877,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \ S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ + REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END #define vFAIL4(m,a1,a2,a3) STMT_START { \ @@ -968,7 +968,7 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + REPORT_LOCATION_ARGS(loc))) #define vWARN(loc, m) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ @@ -980,26 +980,26 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \ m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + REPORT_LOCATION_ARGS(loc))) #define ckWARNdep(loc,m) \ _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))) #define ckWARNregdep(loc,m) \ _WARN_HELPER(loc, packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \ WARN_REGEXP), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))) #define ckWARN2reg_d(loc,m, a1) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + a1, REPORT_LOCATION_ARGS(loc))) #define ckWARN2reg(loc, m, a1) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ @@ -1011,34 +1011,34 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, REPORT_LOCATION_ARGS(loc))) + a1, a2, REPORT_LOCATION_ARGS(loc))) #define ckWARN3reg(loc, m, a1, a2) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, \ + a1, a2, \ REPORT_LOCATION_ARGS(loc))) #define vWARN4(loc, m, a1, a2, a3) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) #define ckWARN4reg(loc, m, a1, a2, a3) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) #define vWARN5(loc, m, a1, a2, a3, a4) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, a4, \ + a1, a2, a3, a4, \ REPORT_LOCATION_ARGS(loc))) #define ckWARNexperimental(loc, class, m) \ @@ -1080,14 +1080,14 @@ static const scan_data_t zero_scan_data = { #define ProgLen(ri) ri->u.offsets[0] #define SetProgLen(ri,x) ri->u.offsets[0] = x #define Set_Node_Offset_To_R(offset,byte) STMT_START { \ - MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \ - __LINE__, (int)(offset), (int)(byte))); \ - if((offset) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Offset macro", \ + MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \ + __LINE__, (int)(offset), (int)(byte))); \ + if((offset) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Offset macro", \ (int)(offset)); \ - } else { \ + } else { \ RExC_offsets[2*(offset)-1] = (byte); \ - } \ + } \ } STMT_END #define Set_Node_Offset(node,byte) \ @@ -1095,14 +1095,14 @@ static const scan_data_t zero_scan_data = { #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse) #define Set_Node_Length_To_R(node,len) STMT_START { \ - MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \ - __LINE__, (int)(node), (int)(len))); \ - if((node) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Length macro", \ + MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \ + __LINE__, (int)(node), (int)(len))); \ + if((node) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Length macro", \ (int)(node)); \ - } else { \ - RExC_offsets[2*(node)] = (len); \ - } \ + } else { \ + RExC_offsets[2*(node)] = (len); \ + } \ } STMT_END #define Set_Node_Length(node,len) \ @@ -1476,13 +1476,13 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) { const U8 i = data->cur_is_floating; - SvSetMagicSV(longest_sv, data->last_found); + SvSetMagicSV(longest_sv, data->last_found); data->substrs[i].min_offset = l ? data->last_start_min : data->pos_min; - if (!i) /* fixed */ - data->substrs[0].max_offset = data->substrs[0].min_offset; - else { /* float */ - data->substrs[1].max_offset = + if (!i) /* fixed */ + data->substrs[0].max_offset = data->substrs[0].min_offset; + else { /* float */ + data->substrs[1].max_offset = (is_inf) ? OPTIMIZE_INFTY : (l @@ -1490,8 +1490,8 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, /* temporary underflow guard for 5.32 */ : data->pos_delta < 0 ? OPTIMIZE_INFTY : (data->pos_delta > OPTIMIZE_INFTY - data->pos_min - ? OPTIMIZE_INFTY - : data->pos_min + data->pos_delta)); + ? OPTIMIZE_INFTY + : data->pos_min + data->pos_delta)); } data->substrs[i].flags &= ~SF_BEFORE_EOL; @@ -1502,12 +1502,12 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, SvCUR_set(data->last_found, 0); { - SV * const sv = data->last_found; - if (SvUTF8(sv) && SvMAGICAL(sv)) { - MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8); - if (mg) - mg->mg_len = 0; - } + SV * const sv = data->last_found; + if (SvUTF8(sv) && SvMAGICAL(sv)) { + MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8); + if (mg) + mg->mg_len = 0; + } } data->last_end = -1; data->flags &= ~SF_BEFORE_EOL; @@ -1596,10 +1596,10 @@ S_ssc_init(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc) * test cases for locale, many parts of it may not work properly, it is * safest to avoid locale unless necessary. */ if (RExC_contains_locale) { - ANYOF_POSIXL_SETALL(ssc); + ANYOF_POSIXL_SETALL(ssc); } else { - ANYOF_POSIXL_ZERO(ssc); + ANYOF_POSIXL_ZERO(ssc); } } @@ -2254,7 +2254,7 @@ S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc) STATIC void S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, - AV *revcharmap, U32 depth) + AV *revcharmap, U32 depth) { U32 state; SV *sv=sv_newmortal(); @@ -2268,14 +2268,14 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, depth+1, "Match","Base","Ofs" ); for( state = 0 ; state < trie->uniquecharcount ; state++ ) { - SV ** const tmp = av_fetch( revcharmap, state, 0); + SV ** const tmp = av_fetch( revcharmap, state, 0); if ( tmp ) { Perl_re_printf( aTHX_ "%*s", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); } @@ -2288,7 +2288,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, Perl_re_printf( aTHX_ "\n"); for( state = 1 ; state < trie->statecount ; state++ ) { - const U32 base = trie->states[ state ].trans.base; + const U32 base = trie->states[ state ].trans.base; Perl_re_indentf( aTHX_ "#%4" UVXf "|", depth+1, (UV)state); @@ -2335,8 +2335,8 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, depth); for (word=1; word <= trie->wordcount; word++) { Perl_re_printf( aTHX_ " %d:(%d,%d)", - (int)word, (int)(trie->wordinfo[word].prev), - (int)(trie->wordinfo[word].len)); + (int)word, (int)(trie->wordinfo[word].prev), + (int)(trie->wordinfo[word].len)); } Perl_re_printf( aTHX_ "\n" ); } @@ -2348,8 +2348,8 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, */ STATIC void S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, - HV *widecharmap, AV *revcharmap, U32 next_alloc, - U32 depth) + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; SV *sv=sv_newmortal(); @@ -2377,9 +2377,9 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, ); } for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { - SV ** const tmp = av_fetch( revcharmap, + SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state, charid).forid, 0); - if ( tmp ) { + if ( tmp ) { Perl_re_printf( aTHX_ "%*s:%3X=%4" UVXf " | ", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), @@ -2408,8 +2408,8 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, */ STATIC void S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, - HV *widecharmap, AV *revcharmap, U32 next_alloc, - U32 depth) + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; U16 charid; @@ -2427,14 +2427,14 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, Perl_re_indentf( aTHX_ "Char : ", depth+1 ); for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { - SV ** const tmp = av_fetch( revcharmap, charid, 0); + SV ** const tmp = av_fetch( revcharmap, charid, 0); if ( tmp ) { Perl_re_printf( aTHX_ "%*s", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); } @@ -2479,9 +2479,9 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, /* make_trie(startbranch,first,last,tail,word_count,flags,depth) startbranch: the first branch in the whole branch sequence first : start branch of sequence of branch-exact nodes. - May be the same as startbranch + May be the same as startbranch last : Thing following the last branch. - May be the same as tail. + May be the same as tail. tail : item following the branch sequence count : words in the sequence flags : currently the OP() type we will be building one of /EXACT(|F|FA|FU|FU_SS|L|FLU8)/ @@ -2557,10 +2557,10 @@ and should turn into: 1: CURLYM[1] {1,32767}(18) 5: TRIE(16) - [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1] - - - + [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1] + + + 16: SUCCEED(0) 17: NOTHING(18) 18: END(0) @@ -2580,8 +2580,8 @@ and would end up looking like: 1: TRIE(8) [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1] - - + + 7: TAIL(8) 8: EXACT (10) 10: END(0) @@ -2595,19 +2595,19 @@ is the recommended Unicode-aware way of saying #define TRIE_STORE_REVCHAR(val) \ STMT_START { \ - if (UTF) { \ + if (UTF) { \ SV *zlopp = newSV(UTF8_MAXBYTES); \ - unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \ + unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \ unsigned char *const kapow = uvchr_to_utf8(flrbbbbb, val); \ *kapow = '\0'; \ - SvCUR_set(zlopp, kapow - flrbbbbb); \ - SvPOK_on(zlopp); \ - SvUTF8_on(zlopp); \ - av_push(revcharmap, zlopp); \ - } else { \ + SvCUR_set(zlopp, kapow - flrbbbbb); \ + SvPOK_on(zlopp); \ + SvUTF8_on(zlopp); \ + av_push(revcharmap, zlopp); \ + } else { \ char ooooff = (char)val; \ - av_push(revcharmap, newSVpvn(&ooooff, 1)); \ - } \ + av_push(revcharmap, newSVpvn(&ooooff, 1)); \ + } \ } STMT_END /* This gets the next character from the input, folding it if not already @@ -2638,8 +2638,8 @@ is the recommended Unicode-aware way of saying #define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \ if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \ - U32 ging = TRIE_LIST_LEN( state ) * 2; \ - Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \ + U32 ging = TRIE_LIST_LEN( state ) * 2; \ + Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \ TRIE_LIST_LEN( state ) = ging; \ } \ TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \ @@ -2649,7 +2649,7 @@ is the recommended Unicode-aware way of saying #define TRIE_LIST_NEW(state) STMT_START { \ Newx( trie->states[ state ].trans.list, \ - 4, reg_trie_trans_le ); \ + 4, reg_trie_trans_le ); \ TRIE_LIST_CUR( state ) = 1; \ TRIE_LIST_LEN( state ) = 4; \ } STMT_END @@ -2688,8 +2688,8 @@ is the recommended Unicode-aware way of saying /* It's a dupe. Pre-insert into the wordinfo[].prev */\ /* chain, so that when the bits of chain are later */\ /* linked together, the dups appear in the chain */\ - trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \ - trie->wordinfo[dupe].prev = curword; \ + trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \ + trie->wordinfo[dupe].prev = curword; \ } else { \ /* we haven't inserted this word yet. */ \ trie->states[ state ].wordnum = curword; \ @@ -2769,11 +2769,11 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, switch (flags) { case EXACT: case EXACT_REQ8: case EXACTL: break; - case EXACTFAA: + case EXACTFAA: case EXACTFUP: - case EXACTFU: - case EXACTFLU8: folder = PL_fold_latin1; break; - case EXACTF: folder = PL_fold; break; + case EXACTFU: + case EXACTFLU8: folder = PL_fold_latin1; break; + case EXACTF: folder = PL_fold; break; default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] ); } @@ -2784,7 +2784,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, RExC_rxi->data->data[ data_slot ] = (void*)trie; trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) ); if (flags == EXACT || flags == EXACT_REQ8 || flags == EXACTL) - trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 ); + trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 ); trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc( trie->wordcount+1, sizeof(reg_trie_wordinfo)); @@ -2964,8 +2964,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, TRIE_STORE_REVCHAR( uvc ); } if ( set_bit ) { - /* store the codepoint in the bitmap, and its folded - * equivalent. */ + /* store the codepoint in the bitmap, and its folded + * equivalent. */ TRIE_BITMAP_SET_FOLDED(trie, uvc, folder); set_bit = 0; /* We've done our bit :-) */ } @@ -3010,8 +3010,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, "TRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n", depth+1, ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count, - (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, - (int)trie->minlen, (int)trie->maxlen ) + (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, + (int)trie->minlen, (int)trie->maxlen ) ); /* @@ -3059,17 +3059,17 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using list compiler\n", depth+1)); - trie->states = (reg_trie_state *) - PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, - sizeof(reg_trie_state) ); + trie->states = (reg_trie_state *) + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); TRIE_LIST_NEW(1); next_alloc = 2; for ( cur = first ; cur < last ; cur = regnext( cur ) ) { regnode *noper = NEXTOPER( cur ); - U32 state = 1; /* required init */ - U16 charid = 0; /* sanity init */ + U32 state = 1; /* required init */ + U16 charid = 0; /* sanity init */ U32 wordlen = 0; /* required init */ if (OP(noper) == NOTHING) { @@ -3096,7 +3096,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( uvc < 256 ) { charid = trie->charmap[ uvc ]; - } else { + } else { SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), @@ -3106,7 +3106,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } else { charid=(U16)SvIV( *svpp ); } - } + } /* charid is now 0 if we dont know the char read, or * nonzero if we do */ if ( charid ) { @@ -3117,7 +3117,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, charid--; if ( !trie->states[ state ].trans.list ) { TRIE_LIST_NEW( state ); - } + } for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) @@ -3131,15 +3131,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } if ( ! newstate ) { newstate = next_alloc++; - prev_states[newstate] = state; + prev_states[newstate] = state; TRIE_LIST_PUSH( state, charid, newstate ); transcount++; } state = newstate; } else { Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc ); - } - } + } + } } else { /* If we end up here it is because we skipped past a NOTHING, but did not end up * on a trieable type. So we need to reset noper back to point at the first regop @@ -3154,18 +3154,18 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, /* next alloc is the NEXT state to be allocated */ trie->statecount = next_alloc; trie->states = (reg_trie_state *) - PerlMemShared_realloc( trie->states, - next_alloc - * sizeof(reg_trie_state) ); + PerlMemShared_realloc( trie->states, + next_alloc + * sizeof(reg_trie_state) ); /* and now dump it out before we compress it */ DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap, - revcharmap, next_alloc, - depth+1) + revcharmap, next_alloc, + depth+1) ); trie->trans = (reg_trie_trans *) - PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) ); + PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) ); { U32 state; U32 tp = 0; @@ -3184,22 +3184,22 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if (trie->states[state].trans.list) { U16 minid=TRIE_LIST_ITEM( state, 1).forid; U16 maxid=minid; - U16 idx; + U16 idx; for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) { - const U16 forid = TRIE_LIST_ITEM( state, idx).forid; - if ( forid < minid ) { - minid=forid; - } else if ( forid > maxid ) { - maxid=forid; - } + const U16 forid = TRIE_LIST_ITEM( state, idx).forid; + if ( forid < minid ) { + minid=forid; + } else if ( forid > maxid ) { + maxid=forid; + } } if ( transcount < tp + maxid - minid + 1) { transcount *= 2; - trie->trans = (reg_trie_trans *) - PerlMemShared_realloc( trie->trans, - transcount - * sizeof(reg_trie_trans) ); + trie->trans = (reg_trie_trans *) + PerlMemShared_realloc( trie->trans, + transcount + * sizeof(reg_trie_trans) ); Zero( trie->trans + (transcount / 2), transcount / 2, reg_trie_trans ); @@ -3285,13 +3285,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using table compiler\n", depth+1)); - trie->trans = (reg_trie_trans *) - PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 ) - * trie->uniquecharcount + 1, - sizeof(reg_trie_trans) ); + trie->trans = (reg_trie_trans *) + PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 ) + * trie->uniquecharcount + 1, + sizeof(reg_trie_trans) ); trie->states = (reg_trie_state *) - PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, - sizeof(reg_trie_state) ); + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); next_alloc = trie->uniquecharcount + 1; @@ -3342,8 +3342,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( !trie->trans[ state + charid ].next ) { trie->trans[ state + charid ].next = next_alloc; trie->trans[ state ].check++; - prev_states[TRIE_NODENUM(next_alloc)] - = TRIE_NODENUM(state); + prev_states[TRIE_NODENUM(next_alloc)] + = TRIE_NODENUM(state); next_alloc += trie->uniquecharcount; } state = trie->trans[ state + charid ].next; @@ -3367,8 +3367,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, /* and now dump it out before we compress it */ DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap, - revcharmap, - next_alloc, depth+1)); + revcharmap, + next_alloc, depth+1)); { /* @@ -3433,15 +3433,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, demq */ const U32 laststate = TRIE_NODENUM( next_alloc ); - U32 state, charid; + U32 state, charid; U32 pos = 0, zp=0; trie->statecount = laststate; for ( state = 1 ; state < laststate ; state++ ) { U8 flag = 0; - const U32 stateidx = TRIE_NODEIDX( state ); - const U32 o_used = trie->trans[ stateidx ].check; - U32 used = trie->trans[ stateidx ].check; + const U32 stateidx = TRIE_NODEIDX( state ); + const U32 o_used = trie->trans[ stateidx ].check; + U32 used = trie->trans[ stateidx ].check; trie->trans[ stateidx ].check = 0; for ( charid = 0; @@ -3484,8 +3484,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } trie->lasttrans = pos + 1; trie->states = (reg_trie_state *) - PerlMemShared_realloc( trie->states, laststate - * sizeof(reg_trie_state) ); + PerlMemShared_realloc( trie->states, laststate + * sizeof(reg_trie_state) ); DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Alloc: %d Orig: %" IVdf " elements, Final:%" IVdf ". Savings of %%%5.2f\n", depth+1, @@ -3506,8 +3506,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, ); /* resize the trans array to remove unused space */ trie->trans = (reg_trie_trans *) - PerlMemShared_realloc( trie->trans, trie->lasttrans - * sizeof(reg_trie_trans) ); + PerlMemShared_realloc( trie->trans, trie->lasttrans + * sizeof(reg_trie_trans) ); { /* Modify the program and insert the new TRIE node */ U8 nodetype =(U8)(flags & 0xFF); @@ -3602,20 +3602,20 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, (UV)state)); if (first_ofs >= 0) { SV ** const tmp = av_fetch( revcharmap, first_ofs, 0); - const U8 * const ch = (U8*)SvPV_nolen_const( *tmp ); + const U8 * const ch = (U8*)SvPV_nolen_const( *tmp ); TRIE_BITMAP_SET_FOLDED(trie,*ch, folder); DEBUG_OPTIMISE_r( Perl_re_printf( aTHX_ "%s", (char*)ch) ); - } - } + } + } /* store the current firstchar in the bitmap */ TRIE_BITMAP_SET_FOLDED(trie,*ch, folder); DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "%s", ch)); - } + } first_ofs = ofs; - } + } } if ( count == 1 ) { /* This state has only one transition, its transition is part @@ -3630,9 +3630,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, depth+1, (UV)state, (UV)first_ofs, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); }); @@ -3645,15 +3645,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, setSTR_LEN(convert, (U8)(STR_LEN(convert) + len)); while (len--) *str++ = *ch++; - } else { + } else { #ifdef DEBUGGING - if (state>1) + if (state>1) DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "]\n")); #endif - break; - } - } - trie->prefixlen = (state-1); + break; + } + } + trie->prefixlen = (state-1); if (str) { regnode *n = convert+NODE_SZ_STR(convert); assert( NODE_SZ_STR(convert) <= U16_MAX ); @@ -3694,7 +3694,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, #endif if (trie->maxlen) { convert = n; - } else { + } else { NEXT_OFF(convert) = (U16)(tail - convert); DEBUG_r(optimize= n); } @@ -3703,23 +3703,23 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if (!jumper) jumper = last; if ( trie->maxlen ) { - NEXT_OFF( convert ) = (U16)(tail - convert); - ARG_SET( convert, data_slot ); - /* Store the offset to the first unabsorbed branch in - jump[0], which is otherwise unused by the jump logic. - We use this when dumping a trie and during optimisation. */ - if (trie->jump) - trie->jump[0] = (U16)(nextbranch - convert); + NEXT_OFF( convert ) = (U16)(tail - convert); + ARG_SET( convert, data_slot ); + /* Store the offset to the first unabsorbed branch in + jump[0], which is otherwise unused by the jump logic. + We use this when dumping a trie and during optimisation. */ + if (trie->jump) + trie->jump[0] = (U16)(nextbranch - convert); /* If the start state is not accepting (meaning there is no empty string/NOTHING) - * and there is a bitmap - * and the first "jump target" node we found leaves enough room - * then convert the TRIE node into a TRIEC node, with the bitmap - * embedded inline in the opcode - this is hypothetically faster. - */ + * and there is a bitmap + * and the first "jump target" node we found leaves enough room + * then convert the TRIE node into a TRIEC node, with the bitmap + * embedded inline in the opcode - this is hypothetically faster. + */ if ( !trie->states[trie->startstate].wordnum - && trie->bitmap - && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) ) + && trie->bitmap + && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) ) { OP( convert ) = TRIEC; Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char); @@ -3768,26 +3768,26 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, * already linked up earlier. */ { - U16 word; - U32 state; - U16 prev; - - for (word=1; word <= trie->wordcount; word++) { - prev = 0; - if (trie->wordinfo[word].prev) - continue; - state = trie->wordinfo[word].accept; - while (state) { - state = prev_states[state]; - if (!state) - break; - prev = trie->states[state].wordnum; - if (prev) - break; - } - trie->wordinfo[word].prev = prev; - } - Safefree(prev_states); + U16 word; + U32 state; + U16 prev; + + for (word=1; word <= trie->wordcount; word++) { + prev = 0; + if (trie->wordinfo[word].prev) + continue; + state = trie->wordinfo[word].accept; + while (state) { + state = prev_states[state]; + if (!state) + break; + prev = trie->states[state].wordnum; + if (prev) + break; + } + trie->wordinfo[word].prev = prev; + } + Safefree(prev_states); } @@ -3884,20 +3884,20 @@ S_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *sour fail[ 0 ] = fail[ 1 ] = 1; for ( charid = 0; charid < ucharcount ; charid++ ) { - const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 ); - if ( newstate ) { + const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 ); + if ( newstate ) { q[ q_write ] = newstate; /* set to point at the root */ fail[ q[ q_write++ ] ]=1; } } while ( q_read < q_write) { - const U32 cur = q[ q_read++ % numstates ]; + const U32 cur = q[ q_read++ % numstates ]; base = trie->states[ cur ].trans.base; for ( charid = 0 ; charid < ucharcount ; charid++ ) { - const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 ); - if (ch_state) { + const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 ); + if (ch_state) { U32 fail_state = cur; U32 fail_base; do { @@ -4259,16 +4259,16 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, } #ifdef EXPERIMENTAL_INPLACESCAN - if (flags && !NEXT_OFF(n)) { - DEBUG_PEEP("atch", val, depth, 0); - if (reg_off_by_arg[OP(n)]) { - ARG_SET(n, val - n); - } - else { - NEXT_OFF(n) = val - n; - } - stopnow = 1; - } + if (flags && !NEXT_OFF(n)) { + DEBUG_PEEP("atch", val, depth, 0); + if (reg_off_by_arg[OP(n)]) { + ARG_SET(n, val - n); + } + else { + NEXT_OFF(n) = val - n; + } + stopnow = 1; + } #endif } @@ -4294,11 +4294,11 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, int total_count_delta = 0; /* Total delta number of characters that multi-char folds expand to */ - /* One pass is made over the node's string looking for all the - * possibilities. To avoid some tests in the loop, there are two main - * cases, for UTF-8 patterns (which can't have EXACTF nodes) and - * non-UTF-8 */ - if (UTF) { + /* One pass is made over the node's string looking for all the + * possibilities. To avoid some tests in the loop, there are two main + * cases, for UTF-8 patterns (which can't have EXACTF nodes) and + * non-UTF-8 */ + if (UTF) { U8* folded = NULL; if (OP(scan) == EXACTFL) { @@ -4355,7 +4355,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * executed */ while (s < s_end - 1) /* Can stop 1 before the end, as minimum length sequence we are looking for is 2 */ - { + { int count = 0; /* How many characters in a multi-char fold */ int len = is_MULTI_CHAR_FOLD_utf8_safe(s, s_end); if (! len) { /* Not a multi-char fold: get next char */ @@ -4391,7 +4391,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * the character that folds to the sequence is) */ total_count_delta += count - 1; next_iteration: ; - } + } /* We created a temporary folded copy of the string in EXACTFL * nodes. Therefore we need to be sure it doesn't go below zero, @@ -4406,8 +4406,8 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, *min_subtract += total_count_delta; Safefree(folded); - } - else if (OP(scan) == EXACTFAA) { + } + else if (OP(scan) == EXACTFAA) { /* Non-UTF-8 pattern, EXACTFAA node. There can't be a multi-char * fold to the ASCII range (and there are no existing ones in the @@ -4418,7 +4418,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, #if UNICODE_MAJOR_VERSION > 3 /* no multifolds in early Unicode */ \ || (UNICODE_MAJOR_VERSION == 3 && ( UNICODE_DOT_VERSION > 0) \ || UNICODE_DOT_DOT_VERSION > 0) - while (s < s_end) { + while (s < s_end) { if (*s == LATIN_SMALL_LETTER_SHARP_S) { OP(scan) = EXACTFAA_NO_TRIE; *unfolded_multi_char = TRUE; @@ -4427,7 +4427,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, s++; } } - else if (OP(scan) != EXACTFAA_NO_TRIE) { + else if (OP(scan) != EXACTFAA_NO_TRIE) { /* Non-UTF-8 pattern, not EXACTFAA node. Look for the multi-char * folds that are all Latin1. As explained in the comments @@ -4435,11 +4435,11 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * and EXACTFL nodes; it can be in the final position. Otherwise * we can stop looking 1 byte earlier because have to find at least * two characters for a multi-fold */ - const U8* upper = (OP(scan) == EXACTF || OP(scan) == EXACTFL) + const U8* upper = (OP(scan) == EXACTF || OP(scan) == EXACTFL) ? s_end : s_end -1; - while (s < upper) { + while (s < upper) { int len = is_MULTI_CHAR_FOLD_latin1_safe(s, s_end); if (! len) { /* Not a multi-char fold. */ if (*s == LATIN_SMALL_LETTER_SHARP_S @@ -4465,13 +4465,13 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, if (OP(scan) != EXACTF && OP(scan) != EXACTFL) { OP(scan) = EXACTFUP; } - } + } *min_subtract += len - 1; s += len; - } + } #endif - } + } } #ifdef DEBUGGING @@ -4479,9 +4479,9 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * ops and/or strings with fake optimized ops */ n = scan + NODE_SZ_STR(scan); while (n <= stop) { - OP(n) = OPTIMIZED; - FLAGS(n) = 0; - NEXT_OFF(n) = 0; + OP(n) = OPTIMIZED; + FLAGS(n) = 0; + NEXT_OFF(n) = 0; n++; } #endif @@ -4552,19 +4552,19 @@ S_rck_elide_nothing(pTHX_ regnode *node) STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, - regnode *last, - scan_data_t *data, - I32 stopparen, + regnode *last, + scan_data_t *data, + I32 stopparen, U32 recursed_depth, - regnode_ssc *and_withp, - U32 flags, U32 depth, bool was_mutate_ok) - /* scanp: Start here (read-write). */ - /* deltap: Write maxlen-minlen here. */ - /* last: Stop before this one. */ - /* data: string data about the pattern */ - /* stopparen: treat close N as END */ - /* recursed: which subroutines have we recursed into */ - /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */ + regnode_ssc *and_withp, + U32 flags, U32 depth, bool was_mutate_ok) + /* scanp: Start here (read-write). */ + /* deltap: Write maxlen-minlen here. */ + /* last: Stop before this one. */ + /* data: string data about the pattern */ + /* stopparen: treat close N as END */ + /* recursed: which subroutines have we recursed into */ + /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */ { SSize_t final_minlen; /* There must be at least this number of characters to match */ @@ -4627,12 +4627,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, UV min_subtract = 0; /* How mmany chars to subtract from the minimum node length to get a real minimum (because the folded version may be shorter) */ - bool unfolded_multi_char = FALSE; + bool unfolded_multi_char = FALSE; /* avoid mutating ops if we are anywhere within the recursed or * enframed handling for a GOSUB: the outermost level will handle it. */ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub); - /* Peephole optimizer: */ + /* Peephole optimizer: */ DEBUG_STUDYDATA("Peep", data, depth, is_inf); DEBUG_PEEP("Peep", scan, depth, flags); @@ -4690,21 +4690,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, OP(scan) == BRANCHJ || OP(scan) == IFTHEN ) { - next = regnext(scan); - code = OP(scan); + next = regnext(scan); + code = OP(scan); /* The op(next)==code check below is to see if we * have "BRANCH-BRANCH", "BRANCHJ-BRANCHJ", "IFTHEN-IFTHEN" * IFTHEN is special as it might not appear in pairs. * Not sure whether BRANCH-BRANCHJ is possible, regardless * we dont handle it cleanly. */ - if (OP(next) == code || code == IFTHEN) { + if (OP(next) == code || code == IFTHEN) { /* NOTE - There is similar code to this block below for * handling TRIE nodes on a re-study. If you change stuff here * check there too. */ - SSize_t max1 = 0, min1 = OPTIMIZE_INFTY, num = 0; - regnode_ssc accum; - regnode * const startbranch=scan; + SSize_t max1 = 0, min1 = OPTIMIZE_INFTY, num = 0; + regnode_ssc accum; + regnode * const startbranch=scan; if (flags & SCF_DO_SUBSTR) { /* Cannot merge strings after this. */ @@ -4712,164 +4712,164 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } if (flags & SCF_DO_STCLASS) - ssc_init_zero(pRExC_state, &accum); + ssc_init_zero(pRExC_state, &accum); - while (OP(scan) == code) { - SSize_t deltanext, minnext, fake; - I32 f = 0; - regnode_ssc this_class; + while (OP(scan) == code) { + SSize_t deltanext, minnext, fake; + I32 f = 0; + regnode_ssc this_class; DEBUG_PEEP("Branch", scan, depth, flags); - num++; + num++; StructCopy(&zero_scan_data, &data_fake, scan_data_t); - if (data) { - data_fake.whilem_c = data->whilem_c; - data_fake.last_closep = data->last_closep; - } - else - data_fake.last_closep = &fake; + if (data) { + data_fake.whilem_c = data->whilem_c; + data_fake.last_closep = data->last_closep; + } + else + data_fake.last_closep = &fake; - data_fake.pos_delta = delta; - next = regnext(scan); + data_fake.pos_delta = delta; + next = regnext(scan); scan = NEXTOPER(scan); /* everything */ if (code != BRANCH) /* everything but BRANCH */ - scan = NEXTOPER(scan); + scan = NEXTOPER(scan); - if (flags & SCF_DO_STCLASS) { - ssc_init(pRExC_state, &this_class); - data_fake.start_class = &this_class; - f = SCF_DO_STCLASS_AND; - } - if (flags & SCF_WHILEM_VISITED_POS) - f |= SCF_WHILEM_VISITED_POS; + if (flags & SCF_DO_STCLASS) { + ssc_init(pRExC_state, &this_class); + data_fake.start_class = &this_class; + f = SCF_DO_STCLASS_AND; + } + if (flags & SCF_WHILEM_VISITED_POS) + f |= SCF_WHILEM_VISITED_POS; - /* we suppose the run is continuous, last=next...*/ + /* we suppose the run is continuous, last=next...*/ /* recurse study_chunk() for each BRANCH in an alternation */ - minnext = study_chunk(pRExC_state, &scan, minlenp, + minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, next, &data_fake, stopparen, recursed_depth, NULL, f, depth+1, mutate_ok); - if (min1 > minnext) - min1 = minnext; - if (deltanext == OPTIMIZE_INFTY) { - is_inf = is_inf_internal = 1; - max1 = OPTIMIZE_INFTY; - } else if (max1 < minnext + deltanext) - max1 = minnext + deltanext; - scan = next; - if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) - pars++; - if (data_fake.flags & SCF_SEEN_ACCEPT) { - if ( stopmin > minnext) - stopmin = min + min1; - flags &= ~SCF_DO_SUBSTR; - if (data) - data->flags |= SCF_SEEN_ACCEPT; - } - if (data) { - if (data_fake.flags & SF_HAS_EVAL) - data->flags |= SF_HAS_EVAL; - data->whilem_c = data_fake.whilem_c; - } - if (flags & SCF_DO_STCLASS) - ssc_or(pRExC_state, &accum, (regnode_charclass*)&this_class); - } - if (code == IFTHEN && num < 2) /* Empty ELSE branch */ - min1 = 0; - if (flags & SCF_DO_SUBSTR) { - data->pos_min += min1; - if (data->pos_delta >= OPTIMIZE_INFTY - (max1 - min1)) - data->pos_delta = OPTIMIZE_INFTY; - else - data->pos_delta += max1 - min1; - if (max1 != min1 || is_inf) - data->cur_is_floating = 1; - } - min += min1; - if (delta == OPTIMIZE_INFTY - || OPTIMIZE_INFTY - delta - (max1 - min1) < 0) - delta = OPTIMIZE_INFTY; - else - delta += max1 - min1; - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass*) &accum); - if (min1) { - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - flags &= ~SCF_DO_STCLASS; - } - } - else if (flags & SCF_DO_STCLASS_AND) { - if (min1) { - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &accum); - flags &= ~SCF_DO_STCLASS; - } - else { - /* Switch to OR mode: cache the old value of - * data->start_class */ - INIT_AND_WITHP; - StructCopy(data->start_class, and_withp, regnode_ssc); - flags &= ~SCF_DO_STCLASS_AND; - StructCopy(&accum, data->start_class, regnode_ssc); - flags |= SCF_DO_STCLASS_OR; - } - } + if (min1 > minnext) + min1 = minnext; + if (deltanext == OPTIMIZE_INFTY) { + is_inf = is_inf_internal = 1; + max1 = OPTIMIZE_INFTY; + } else if (max1 < minnext + deltanext) + max1 = minnext + deltanext; + scan = next; + if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (data_fake.flags & SCF_SEEN_ACCEPT) { + if ( stopmin > minnext) + stopmin = min + min1; + flags &= ~SCF_DO_SUBSTR; + if (data) + data->flags |= SCF_SEEN_ACCEPT; + } + if (data) { + if (data_fake.flags & SF_HAS_EVAL) + data->flags |= SF_HAS_EVAL; + data->whilem_c = data_fake.whilem_c; + } + if (flags & SCF_DO_STCLASS) + ssc_or(pRExC_state, &accum, (regnode_charclass*)&this_class); + } + if (code == IFTHEN && num < 2) /* Empty ELSE branch */ + min1 = 0; + if (flags & SCF_DO_SUBSTR) { + data->pos_min += min1; + if (data->pos_delta >= OPTIMIZE_INFTY - (max1 - min1)) + data->pos_delta = OPTIMIZE_INFTY; + else + data->pos_delta += max1 - min1; + if (max1 != min1 || is_inf) + data->cur_is_floating = 1; + } + min += min1; + if (delta == OPTIMIZE_INFTY + || OPTIMIZE_INFTY - delta - (max1 - min1) < 0) + delta = OPTIMIZE_INFTY; + else + delta += max1 - min1; + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass*) &accum); + if (min1) { + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + flags &= ~SCF_DO_STCLASS; + } + } + else if (flags & SCF_DO_STCLASS_AND) { + if (min1) { + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &accum); + flags &= ~SCF_DO_STCLASS; + } + else { + /* Switch to OR mode: cache the old value of + * data->start_class */ + INIT_AND_WITHP; + StructCopy(data->start_class, and_withp, regnode_ssc); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&accum, data->start_class, regnode_ssc); + flags |= SCF_DO_STCLASS_OR; + } + } if (PERL_ENABLE_TRIE_OPTIMISATION && OP(startbranch) == BRANCH && mutate_ok ) { - /* demq. + /* demq. Assuming this was/is a branch we are dealing with: 'scan' now points at the item that follows the branch sequence, whatever it is. We now start at the beginning of the sequence and look for subsequences of - BRANCH->EXACT=>x1 - BRANCH->EXACT=>x2 - tail + BRANCH->EXACT=>x1 + BRANCH->EXACT=>x2 + tail which would be constructed from a pattern like /A|LIST|OF|WORDS/ - If we can find such a subsequence we need to turn the first - element into a trie and then add the subsequent branch exact - strings to the trie. + If we can find such a subsequence we need to turn the first + element into a trie and then add the subsequent branch exact + strings to the trie. - We have two cases + We have two cases 1. patterns where the whole set of branches can be converted. - 2. patterns where only a subset can be converted. + 2. patterns where only a subset can be converted. - In case 1 we can replace the whole set with a single regop - for the trie. In case 2 we need to keep the start and end - branches so + In case 1 we can replace the whole set with a single regop + for the trie. In case 2 we need to keep the start and end + branches so - 'BRANCH EXACT; BRANCH EXACT; BRANCH X' - becomes BRANCH TRIE; BRANCH X; + 'BRANCH EXACT; BRANCH EXACT; BRANCH X' + becomes BRANCH TRIE; BRANCH X; - There is an additional case, that being where there is a - common prefix, which gets split out into an EXACT like node - preceding the TRIE node. + There is an additional case, that being where there is a + common prefix, which gets split out into an EXACT like node + preceding the TRIE node. - If x(1..n)==tail then we can do a simple trie, if not we make - a "jump" trie, such that when we match the appropriate word - we "jump" to the appropriate tail node. Essentially we turn - a nested if into a case structure of sorts. + If x(1..n)==tail then we can do a simple trie, if not we make + a "jump" trie, such that when we match the appropriate word + we "jump" to the appropriate tail node. Essentially we turn + a nested if into a case structure of sorts. - */ + */ - int made=0; - if (!re_trie_maxbuff) { - re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1); - if (!SvIOK(re_trie_maxbuff)) - sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT); - } + int made=0; + if (!re_trie_maxbuff) { + re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1); + if (!SvIOK(re_trie_maxbuff)) + sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT); + } if ( SvIV(re_trie_maxbuff)>=0 ) { regnode *cur; regnode *first = (regnode *)NULL; @@ -5005,8 +5005,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } Perl_re_printf( aTHX_ "(First==%d,Last==%d,Cur==%d,tt==%s,ntt==%s,nntt==%s)\n", REG_NODE_NUM(first), REG_NODE_NUM(prev), REG_NODE_NUM(cur), - PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype] - ); + PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype] + ); }); /* Is noper a trieable nodetype that can be merged @@ -5029,15 +5029,15 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, * otherwise we update the end pointer. */ if ( !first ) { first = cur; - if ( noper_trietype == NOTHING ) { + if ( noper_trietype == NOTHING ) { #if !defined(DEBUGGING) && !defined(NOJUMPTRIE) - regnode * const noper_next = regnext( noper ); + regnode * const noper_next = regnext( noper ); U8 noper_next_type = (noper_next && noper_next < tail) ? OP(noper_next) : 0; - U8 noper_next_trietype = noper_next_type ? TRIE_TYPE( noper_next_type ) :0; + U8 noper_next_trietype = noper_next_type ? TRIE_TYPE( noper_next_type ) :0; #endif if ( noper_next_trietype ) { - trietype = noper_next_trietype; + trietype = noper_next_trietype; } else if (noper_next_type) { /* a NOTHING regop is 1 regop wide. * We need at least two for a trie @@ -5052,8 +5052,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, trietype = noper_trietype; prev = cur; } - if (first) - count++; + if (first) + count++; } /* end handle mergable triable node */ else { /* handle unmergable node - @@ -5156,12 +5156,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } /* TRIE_MAXBUF is non zero */ } /* do trie */ - } - else if ( code == BRANCHJ ) { /* single branch is optimized. */ - scan = NEXTOPER(NEXTOPER(scan)); - } else /* single branch is optimized. */ - scan = NEXTOPER(scan); - continue; + } + else if ( code == BRANCHJ ) { /* single branch is optimized. */ + scan = NEXTOPER(NEXTOPER(scan)); + } else /* single branch is optimized. */ + scan = NEXTOPER(scan); + continue; } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB) { I32 paren = 0; regnode *start = NULL; @@ -5249,12 +5249,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, flags &= ~SCF_DO_STCLASS; start= NULL; /* reset start so we dont recurse later on. */ - } + } } else { - paren = stopparen; + paren = stopparen; start = scan + 2; - end = regnext(scan); - } + end = regnext(scan); + } if (start) { scan_frame *newframe; assert(end); @@ -5285,73 +5285,73 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, DEBUG_STUDYDATA("frame-new", data, depth, is_inf); DEBUG_PEEP("fnew", scan, depth, flags); - frame = newframe; - scan = start; - stopparen = paren; - last = end; + frame = newframe; + scan = start; + stopparen = paren; + last = end; depth = depth + 1; recursed_depth= my_recursed_depth; - continue; - } - } - else if (PL_regkind[OP(scan)] == EXACT && ! isEXACTFish(OP(scan))) { - SSize_t bytelen = STR_LEN(scan), charlen; - UV uc; + continue; + } + } + else if (PL_regkind[OP(scan)] == EXACT && ! isEXACTFish(OP(scan))) { + SSize_t bytelen = STR_LEN(scan), charlen; + UV uc; assert(bytelen); - if (UTF) { - const U8 * const s = (U8*)STRING(scan); - uc = utf8_to_uvchr_buf(s, s + bytelen, NULL); - charlen = utf8_length(s, s + bytelen); - } else { - uc = *((U8*)STRING(scan)); + if (UTF) { + const U8 * const s = (U8*)STRING(scan); + uc = utf8_to_uvchr_buf(s, s + bytelen, NULL); + charlen = utf8_length(s, s + bytelen); + } else { + uc = *((U8*)STRING(scan)); charlen = bytelen; - } - min += charlen; - if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ - /* The code below prefers earlier match for fixed - offset, later match for variable offset. */ - if (data->last_end == -1) { /* Update the start info. */ - data->last_start_min = data->pos_min; + } + min += charlen; + if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ + /* The code below prefers earlier match for fixed + offset, later match for variable offset. */ + if (data->last_end == -1) { /* Update the start info. */ + data->last_start_min = data->pos_min; data->last_start_max = is_inf ? OPTIMIZE_INFTY : (data->pos_delta > OPTIMIZE_INFTY - data->pos_min) ? OPTIMIZE_INFTY : data->pos_min + data->pos_delta; - } - sv_catpvn(data->last_found, STRING(scan), bytelen); - if (UTF) - SvUTF8_on(data->last_found); - { - SV * const sv = data->last_found; - MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - if (mg && mg->mg_len >= 0) - mg->mg_len += charlen; - } - data->last_end = data->pos_min + charlen; - data->pos_min += charlen; /* As in the first entry. */ - data->flags &= ~SF_BEFORE_EOL; - } + } + sv_catpvn(data->last_found, STRING(scan), bytelen); + if (UTF) + SvUTF8_on(data->last_found); + { + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + if (mg && mg->mg_len >= 0) + mg->mg_len += charlen; + } + data->last_end = data->pos_min + charlen; + data->pos_min += charlen; /* As in the first entry. */ + data->flags &= ~SF_BEFORE_EOL; + } /* ANDing the code point leaves at most it, and not in locale, and * can't match null string */ - if (flags & SCF_DO_STCLASS_AND) { + if (flags & SCF_DO_STCLASS_AND) { ssc_cp_and(data->start_class, uc); ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; ssc_clear_locale(data->start_class); - } - else if (flags & SCF_DO_STCLASS_OR) { + } + else if (flags & SCF_DO_STCLASS_OR) { ssc_add_cp(data->start_class, uc); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; - } - flags &= ~SCF_DO_STCLASS; - } + } + flags &= ~SCF_DO_STCLASS; + } else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT!, so is EXACTFish */ - SSize_t bytelen = STR_LEN(scan), charlen; + SSize_t bytelen = STR_LEN(scan), charlen; const U8 * s = (U8*)STRING(scan); /* Replace a length 1 ASCII fold pair node with an ANYOFM node, @@ -5374,28 +5374,28 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, continue; } - /* Search for fixed substrings supports EXACT only. */ - if (flags & SCF_DO_SUBSTR) { - assert(data); + /* Search for fixed substrings supports EXACT only. */ + if (flags & SCF_DO_SUBSTR) { + assert(data); scan_commit(pRExC_state, data, minlenp, is_inf); - } + } charlen = UTF ? (SSize_t) utf8_length(s, s + bytelen) : bytelen; - if (unfolded_multi_char) { + if (unfolded_multi_char) { RExC_seen |= REG_UNFOLDED_MULTI_SEEN; - } - min += charlen - min_subtract; + } + min += charlen - min_subtract; assert (min >= 0); delta += min_subtract; - if (flags & SCF_DO_SUBSTR) { - data->pos_min += charlen - min_subtract; - if (data->pos_min < 0) { + if (flags & SCF_DO_SUBSTR) { + data->pos_min += charlen - min_subtract; + if (data->pos_min < 0) { data->pos_min = 0; } data->pos_delta += min_subtract; - if (min_subtract) { - data->cur_is_floating = 1; /* float */ - } - } + if (min_subtract) { + data->cur_is_floating = 1; /* float */ + } + } if (flags & SCF_DO_STCLASS) { SV* EXACTF_invlist = make_exactf_invlist(pRExC_state, scan); @@ -5418,41 +5418,41 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, flags &= ~SCF_DO_STCLASS; SvREFCNT_dec(EXACTF_invlist); } - } - else if (REGNODE_VARIES(OP(scan))) { - SSize_t mincount, maxcount, minnext, deltanext, pos_before = 0; - I32 fl = 0, f = flags; - regnode * const oscan = scan; - regnode_ssc this_class; - regnode_ssc *oclass = NULL; - I32 next_is_eval = 0; - - switch (PL_regkind[OP(scan)]) { - case WHILEM: /* End of (?:...)* . */ - scan = NEXTOPER(scan); - goto finish; - case PLUS: - if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { - next = NEXTOPER(scan); - if ( ( PL_regkind[OP(next)] == EXACT + } + else if (REGNODE_VARIES(OP(scan))) { + SSize_t mincount, maxcount, minnext, deltanext, pos_before = 0; + I32 fl = 0, f = flags; + regnode * const oscan = scan; + regnode_ssc this_class; + regnode_ssc *oclass = NULL; + I32 next_is_eval = 0; + + switch (PL_regkind[OP(scan)]) { + case WHILEM: /* End of (?:...)* . */ + scan = NEXTOPER(scan); + goto finish; + case PLUS: + if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { + next = NEXTOPER(scan); + if ( ( PL_regkind[OP(next)] == EXACT && ! isEXACTFish(OP(next))) || (flags & SCF_DO_STCLASS)) { - mincount = 1; - maxcount = REG_INFTY; - next = regnext(scan); - scan = NEXTOPER(scan); - goto do_curly; - } - } - if (flags & SCF_DO_SUBSTR) - data->pos_min++; + mincount = 1; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } + } + if (flags & SCF_DO_SUBSTR) + data->pos_min++; /* This will bypass the formal 'min += minnext * mincount' * calculation in the do_curly path, so assumes min width * of the PLUS payload is exactly one. */ - min++; - /* FALLTHROUGH */ - case STAR: + min++; + /* FALLTHROUGH */ + case STAR: next = NEXTOPER(scan); /* This temporary node can now be turned into EXACTFU, and @@ -5483,121 +5483,121 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, FLAGS(next) = mask; } - if (flags & SCF_DO_STCLASS) { - mincount = 0; - maxcount = REG_INFTY; - next = regnext(scan); - scan = NEXTOPER(scan); - goto do_curly; - } - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_STCLASS) { + mincount = 0; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); /* Cannot extend fixed substrings */ - data->cur_is_floating = 1; /* float */ - } + data->cur_is_floating = 1; /* float */ + } is_inf = is_inf_internal = 1; scan = regnext(scan); - goto optimize_curly_tail; - case CURLY: - if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM) - && (scan->flags == stopparen)) - { - mincount = 1; - maxcount = 1; - } else { - mincount = ARG1(scan); - maxcount = ARG2(scan); - } - next = regnext(scan); - if (OP(scan) == CURLYX) { - I32 lp = (data ? *(data->last_closep) : 0); - scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX); - } - scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; - next_is_eval = (OP(scan) == EVAL); - do_curly: - if (flags & SCF_DO_SUBSTR) { + goto optimize_curly_tail; + case CURLY: + if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM) + && (scan->flags == stopparen)) + { + mincount = 1; + maxcount = 1; + } else { + mincount = ARG1(scan); + maxcount = ARG2(scan); + } + next = regnext(scan); + if (OP(scan) == CURLYX) { + I32 lp = (data ? *(data->last_closep) : 0); + scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX); + } + scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; + next_is_eval = (OP(scan) == EVAL); + do_curly: + if (flags & SCF_DO_SUBSTR) { if (mincount == 0) scan_commit(pRExC_state, data, minlenp, is_inf); /* Cannot extend fixed substrings */ - pos_before = data->pos_min; - } - if (data) { - fl = data->flags; - data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL); - if (is_inf) - data->flags |= SF_IS_INF; - } - if (flags & SCF_DO_STCLASS) { - ssc_init(pRExC_state, &this_class); - oclass = data->start_class; - data->start_class = &this_class; - f |= SCF_DO_STCLASS_AND; - f &= ~SCF_DO_STCLASS_OR; - } - /* Exclude from super-linear cache processing any {n,m} - regops for which the combination of input pos and regex - pos is not enough information to determine if a match - will be possible. - - For example, in the regex /foo(bar\s*){4,8}baz/ with the - regex pos at the \s*, the prospects for a match depend not - only on the input position but also on how many (bar\s*) - repeats into the {4,8} we are. */ + pos_before = data->pos_min; + } + if (data) { + fl = data->flags; + data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL); + if (is_inf) + data->flags |= SF_IS_INF; + } + if (flags & SCF_DO_STCLASS) { + ssc_init(pRExC_state, &this_class); + oclass = data->start_class; + data->start_class = &this_class; + f |= SCF_DO_STCLASS_AND; + f &= ~SCF_DO_STCLASS_OR; + } + /* Exclude from super-linear cache processing any {n,m} + regops for which the combination of input pos and regex + pos is not enough information to determine if a match + will be possible. + + For example, in the regex /foo(bar\s*){4,8}baz/ with the + regex pos at the \s*, the prospects for a match depend not + only on the input position but also on how many (bar\s*) + repeats into the {4,8} we are. */ if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY)) - f &= ~SCF_WHILEM_VISITED_POS; + f &= ~SCF_WHILEM_VISITED_POS; - /* This will finish on WHILEM, setting scan, or on NULL: */ + /* This will finish on WHILEM, setting scan, or on NULL: */ /* recurse study_chunk() on loop bodies */ - minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, + minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, last, data, stopparen, recursed_depth, NULL, (mincount == 0 ? (f & ~SCF_DO_SUBSTR) : f) , depth+1, mutate_ok); - if (flags & SCF_DO_STCLASS) - data->start_class = oclass; - if (mincount == 0 || minnext == 0) { - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - } - else if (flags & SCF_DO_STCLASS_AND) { - /* Switch to OR mode: cache the old value of - * data->start_class */ - INIT_AND_WITHP; - StructCopy(data->start_class, and_withp, regnode_ssc); - flags &= ~SCF_DO_STCLASS_AND; - StructCopy(&this_class, data->start_class, regnode_ssc); - flags |= SCF_DO_STCLASS_OR; + if (flags & SCF_DO_STCLASS) + data->start_class = oclass; + if (mincount == 0 || minnext == 0) { + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + } + else if (flags & SCF_DO_STCLASS_AND) { + /* Switch to OR mode: cache the old value of + * data->start_class */ + INIT_AND_WITHP; + StructCopy(data->start_class, and_withp, regnode_ssc); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&this_class, data->start_class, regnode_ssc); + flags |= SCF_DO_STCLASS_OR; ANYOF_FLAGS(data->start_class) |= SSC_MATCHES_EMPTY_STRING; - } - } else { /* Non-zero len */ - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - } - else if (flags & SCF_DO_STCLASS_AND) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - flags &= ~SCF_DO_STCLASS; - } - if (!scan) /* It was not CURLYX, but CURLY. */ - scan = next; - if (((flags & (SCF_TRIE_DOING_RESTUDY|SCF_DO_SUBSTR))==SCF_DO_SUBSTR) - /* ? quantifier ok, except for (?{ ... }) */ - && (next_is_eval || !(mincount == 0 && maxcount == 1)) - && (minnext == 0) && (deltanext == 0) - && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) + } + } else { /* Non-zero len */ + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + } + else if (flags & SCF_DO_STCLASS_AND) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + flags &= ~SCF_DO_STCLASS; + } + if (!scan) /* It was not CURLYX, but CURLY. */ + scan = next; + if (((flags & (SCF_TRIE_DOING_RESTUDY|SCF_DO_SUBSTR))==SCF_DO_SUBSTR) + /* ? quantifier ok, except for (?{ ... }) */ + && (next_is_eval || !(mincount == 0 && maxcount == 1)) + && (minnext == 0) && (deltanext == 0) + && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) && maxcount <= REG_INFTY/3) /* Complement check for big count */ - { - _WARN_HELPER(RExC_precomp_end, packWARN(WARN_REGEXP), + { + _WARN_HELPER(RExC_precomp_end, packWARN(WARN_REGEXP), Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Quantifier unexpected on zero-length expression " "in regex m/%" UTF8f "/", - UTF8fARG(UTF, RExC_precomp_end - RExC_precomp, - RExC_precomp))); + UTF8fARG(UTF, RExC_precomp_end - RExC_precomp, + RExC_precomp))); } if ( ( minnext > 0 && mincount >= SSize_t_MAX / minnext ) @@ -5606,146 +5606,146 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, FAIL("Regexp out of space"); } - min += minnext * mincount; - is_inf_internal |= deltanext == OPTIMIZE_INFTY + min += minnext * mincount; + is_inf_internal |= deltanext == OPTIMIZE_INFTY || (maxcount == REG_INFTY && minnext + deltanext > 0); - is_inf |= is_inf_internal; + is_inf |= is_inf_internal; if (is_inf) { - delta = OPTIMIZE_INFTY; + delta = OPTIMIZE_INFTY; } else { - delta += (minnext + deltanext) * maxcount + delta += (minnext + deltanext) * maxcount - minnext * mincount; } - /* Try powerful optimization CURLYX => CURLYN. */ - if ( OP(oscan) == CURLYX && data - && data->flags & SF_IN_PAR - && !(data->flags & SF_HAS_EVAL) - && !deltanext && minnext == 1 + /* Try powerful optimization CURLYX => CURLYN. */ + if ( OP(oscan) == CURLYX && data + && data->flags & SF_IN_PAR + && !(data->flags & SF_HAS_EVAL) + && !deltanext && minnext == 1 && mutate_ok ) { - /* Try to optimize to CURLYN. */ - regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; - regnode * const nxt1 = nxt; + /* Try to optimize to CURLYN. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; + regnode * const nxt1 = nxt; #ifdef DEBUGGING - regnode *nxt2; + regnode *nxt2; #endif - /* Skip open. */ - nxt = regnext(nxt); - if (!REGNODE_SIMPLE(OP(nxt)) - && !(PL_regkind[OP(nxt)] == EXACT - && STR_LEN(nxt) == 1)) - goto nogo; + /* Skip open. */ + nxt = regnext(nxt); + if (!REGNODE_SIMPLE(OP(nxt)) + && !(PL_regkind[OP(nxt)] == EXACT + && STR_LEN(nxt) == 1)) + goto nogo; #ifdef DEBUGGING - nxt2 = nxt; + nxt2 = nxt; #endif - nxt = regnext(nxt); - if (OP(nxt) != CLOSE) - goto nogo; - if (RExC_open_parens) { + nxt = regnext(nxt); + if (OP(nxt) != CLOSE) + goto nogo; + if (RExC_open_parens) { /*open->CURLYM*/ RExC_open_parens[ARG(nxt1)] = REGNODE_OFFSET(oscan); /*close->while*/ RExC_close_parens[ARG(nxt1)] = REGNODE_OFFSET(nxt) + 2; - } - /* Now we know that nxt2 is the only contents: */ - oscan->flags = (U8)ARG(nxt); - OP(oscan) = CURLYN; - OP(nxt1) = NOTHING; /* was OPEN. */ + } + /* Now we know that nxt2 is the only contents: */ + oscan->flags = (U8)ARG(nxt); + OP(oscan) = CURLYN; + OP(nxt1) = NOTHING; /* was OPEN. */ #ifdef DEBUGGING - OP(nxt1 + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */ - NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */ - OP(nxt) = OPTIMIZED; /* was CLOSE. */ - OP(nxt + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */ + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */ + NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */ #endif - } - nogo: - - /* Try optimization CURLYX => CURLYM. */ - if ( OP(oscan) == CURLYX && data - && !(data->flags & SF_HAS_PAR) - && !(data->flags & SF_HAS_EVAL) - && !deltanext /* atom is fixed width */ - && minnext != 0 /* CURLYM can't handle zero width */ + } + nogo: + + /* Try optimization CURLYX => CURLYM. */ + if ( OP(oscan) == CURLYX && data + && !(data->flags & SF_HAS_PAR) + && !(data->flags & SF_HAS_EVAL) + && !deltanext /* atom is fixed width */ + && minnext != 0 /* CURLYM can't handle zero width */ /* Nor characters whose fold at run-time may be * multi-character */ && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN) && mutate_ok - ) { - /* XXXX How to optimize if data == 0? */ - /* Optimize to a simpler form. */ - regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */ - regnode *nxt2; - - OP(oscan) = CURLYM; - while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ - && (OP(nxt2) != WHILEM)) - nxt = nxt2; - OP(nxt2) = SUCCEED; /* Whas WHILEM */ - /* Need to optimize away parenths. */ - if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) { - /* Set the parenth number. */ - regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ - - oscan->flags = (U8)ARG(nxt); - if (RExC_open_parens) { + ) { + /* XXXX How to optimize if data == 0? */ + /* Optimize to a simpler form. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */ + regnode *nxt2; + + OP(oscan) = CURLYM; + while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ + && (OP(nxt2) != WHILEM)) + nxt = nxt2; + OP(nxt2) = SUCCEED; /* Whas WHILEM */ + /* Need to optimize away parenths. */ + if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) { + /* Set the parenth number. */ + regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ + + oscan->flags = (U8)ARG(nxt); + if (RExC_open_parens) { /*open->CURLYM*/ RExC_open_parens[ARG(nxt1)] = REGNODE_OFFSET(oscan); /*close->NOTHING*/ RExC_close_parens[ARG(nxt1)] = REGNODE_OFFSET(nxt2) + 1; - } - OP(nxt1) = OPTIMIZED; /* was OPEN. */ - OP(nxt) = OPTIMIZED; /* was CLOSE. */ + } + OP(nxt1) = OPTIMIZED; /* was OPEN. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ #ifdef DEBUGGING - OP(nxt1 + 1) = OPTIMIZED; /* was count. */ - OP(nxt + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */ - NEXT_OFF(nxt + 1) = 0; /* just for consistency. */ + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */ + NEXT_OFF(nxt + 1) = 0; /* just for consistency. */ #endif #if 0 - while ( nxt1 && (OP(nxt1) != WHILEM)) { - regnode *nnxt = regnext(nxt1); - if (nnxt == nxt) { - if (reg_off_by_arg[OP(nxt1)]) - ARG_SET(nxt1, nxt2 - nxt1); - else if (nxt2 - nxt1 < U16_MAX) - NEXT_OFF(nxt1) = nxt2 - nxt1; - else - OP(nxt) = NOTHING; /* Cannot beautify */ - } - nxt1 = nnxt; - } + while ( nxt1 && (OP(nxt1) != WHILEM)) { + regnode *nnxt = regnext(nxt1); + if (nnxt == nxt) { + if (reg_off_by_arg[OP(nxt1)]) + ARG_SET(nxt1, nxt2 - nxt1); + else if (nxt2 - nxt1 < U16_MAX) + NEXT_OFF(nxt1) = nxt2 - nxt1; + else + OP(nxt) = NOTHING; /* Cannot beautify */ + } + nxt1 = nnxt; + } #endif - /* Optimize again: */ + /* Optimize again: */ /* recurse study_chunk() on optimised CURLYX => CURLYM */ - study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, + study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, NULL, stopparen, recursed_depth, NULL, 0, depth+1, mutate_ok); - } - else - oscan->flags = 0; - } - else if ((OP(oscan) == CURLYX) - && (flags & SCF_WHILEM_VISITED_POS) - /* See the comment on a similar expression above. - However, this time it's not a subexpression - we care about, but the expression itself. */ - && (maxcount == REG_INFTY) - && data) { - /* This stays as CURLYX, we can put the count/of pair. */ - /* Find WHILEM (as in regexec.c) */ - regnode *nxt = oscan + NEXT_OFF(oscan); - - if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */ - nxt += ARG(nxt); + } + else + oscan->flags = 0; + } + else if ((OP(oscan) == CURLYX) + && (flags & SCF_WHILEM_VISITED_POS) + /* See the comment on a similar expression above. + However, this time it's not a subexpression + we care about, but the expression itself. */ + && (maxcount == REG_INFTY) + && data) { + /* This stays as CURLYX, we can put the count/of pair. */ + /* Find WHILEM (as in regexec.c) */ + regnode *nxt = oscan + NEXT_OFF(oscan); + + if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */ + nxt += ARG(nxt); nxt = PREVOPER(nxt); if (nxt->flags & 0xf) { /* we've already set whilem count on this node */ @@ -5754,68 +5754,68 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, nxt->flags = (U8)(data->whilem_c | (RExC_whilem_seen << 4)); /* On WHILEM */ } - } - if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) - pars++; - if (flags & SCF_DO_SUBSTR) { - SV *last_str = NULL; + } + if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (flags & SCF_DO_SUBSTR) { + SV *last_str = NULL; STRLEN last_chrs = 0; - int counted = mincount != 0; + int counted = mincount != 0; if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */ - SSize_t b = pos_before >= data->last_start_min - ? pos_before : data->last_start_min; - STRLEN l; - const char * const s = SvPV_const(data->last_found, l); - SSize_t old = b - data->last_start_min; + SSize_t b = pos_before >= data->last_start_min + ? pos_before : data->last_start_min; + STRLEN l; + const char * const s = SvPV_const(data->last_found, l); + SSize_t old = b - data->last_start_min; assert(old >= 0); - if (UTF) - old = utf8_hop_forward((U8*)s, old, + if (UTF) + old = utf8_hop_forward((U8*)s, old, (U8 *) SvEND(data->last_found)) - (U8*)s; - l -= old; - /* Get the added string: */ - last_str = newSVpvn_utf8(s + old, l, UTF); + l -= old; + /* Get the added string: */ + last_str = newSVpvn_utf8(s + old, l, UTF); last_chrs = UTF ? utf8_length((U8*)(s + old), (U8*)(s + old + l)) : l; - if (deltanext == 0 && pos_before == b) { - /* What was added is a constant string */ - if (mincount > 1) { + if (deltanext == 0 && pos_before == b) { + /* What was added is a constant string */ + if (mincount > 1) { - SvGROW(last_str, (mincount * l) + 1); - repeatcpy(SvPVX(last_str) + l, - SvPVX_const(last_str), l, + SvGROW(last_str, (mincount * l) + 1); + repeatcpy(SvPVX(last_str) + l, + SvPVX_const(last_str), l, mincount - 1); - SvCUR_set(last_str, SvCUR(last_str) * mincount); - /* Add additional parts. */ - SvCUR_set(data->last_found, - SvCUR(data->last_found) - l); - sv_catsv(data->last_found, last_str); - { - SV * sv = data->last_found; - MAGIC *mg = - SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - if (mg && mg->mg_len >= 0) - mg->mg_len += last_chrs * (mincount-1); - } + SvCUR_set(last_str, SvCUR(last_str) * mincount); + /* Add additional parts. */ + SvCUR_set(data->last_found, + SvCUR(data->last_found) - l); + sv_catsv(data->last_found, last_str); + { + SV * sv = data->last_found; + MAGIC *mg = + SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + if (mg && mg->mg_len >= 0) + mg->mg_len += last_chrs * (mincount-1); + } last_chrs *= mincount; - data->last_end += l * (mincount - 1); - } - } else { - /* start offset must point into the last copy */ - data->last_start_min += minnext * (mincount - 1); - data->last_start_max = + data->last_end += l * (mincount - 1); + } + } else { + /* start offset must point into the last copy */ + data->last_start_min += minnext * (mincount - 1); + data->last_start_max = is_inf ? OPTIMIZE_INFTY - : data->last_start_max + + : data->last_start_max + (maxcount - 1) * (minnext + data->pos_delta); - } - } - /* It is counted once already... */ - data->pos_min += minnext * (mincount - counted); + } + } + /* It is counted once already... */ + data->pos_min += minnext * (mincount - counted); #if 0 Perl_re_printf( aTHX_ "counted=%" UVuf " deltanext=%" UVuf " OPTIMIZE_INFTY=%" UVuf " minnext=%" UVuf @@ -5827,52 +5827,52 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", (UV)(-counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount), (UV)(OPTIMIZE_INFTY - data->pos_delta)); #endif - if (deltanext == OPTIMIZE_INFTY + if (deltanext == OPTIMIZE_INFTY || -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= OPTIMIZE_INFTY - data->pos_delta) - data->pos_delta = OPTIMIZE_INFTY; - else - data->pos_delta += - counted * deltanext + - (minnext + deltanext) * maxcount - minnext * mincount; - if (mincount != maxcount) { - /* Cannot extend fixed substrings found inside - the group. */ + data->pos_delta = OPTIMIZE_INFTY; + else + data->pos_delta += - counted * deltanext + + (minnext + deltanext) * maxcount - minnext * mincount; + if (mincount != maxcount) { + /* Cannot extend fixed substrings found inside + the group. */ scan_commit(pRExC_state, data, minlenp, is_inf); - if (mincount && last_str) { - SV * const sv = data->last_found; - MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - - if (mg) - mg->mg_len = -1; - sv_setsv(sv, last_str); - data->last_end = data->pos_min; - data->last_start_min = data->pos_min - last_chrs; - data->last_start_max = is_inf - ? OPTIMIZE_INFTY - : data->pos_min + data->pos_delta - last_chrs; - } - data->cur_is_floating = 1; /* float */ - } - SvREFCNT_dec(last_str); - } - if (data && (fl & SF_HAS_EVAL)) - data->flags |= SF_HAS_EVAL; - optimize_curly_tail: - rck_elide_nothing(oscan); - continue; - - default: + if (mincount && last_str) { + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + + if (mg) + mg->mg_len = -1; + sv_setsv(sv, last_str); + data->last_end = data->pos_min; + data->last_start_min = data->pos_min - last_chrs; + data->last_start_max = is_inf + ? OPTIMIZE_INFTY + : data->pos_min + data->pos_delta - last_chrs; + } + data->cur_is_floating = 1; /* float */ + } + SvREFCNT_dec(last_str); + } + if (data && (fl & SF_HAS_EVAL)) + data->flags |= SF_HAS_EVAL; + optimize_curly_tail: + rck_elide_nothing(oscan); + continue; + + default: Perl_croak(aTHX_ "panic: unexpected varying REx opcode %d", OP(scan)); case REF: case CLUMP: - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_SUBSTR) { /* Cannot expect anything... */ scan_commit(pRExC_state, data, minlenp, is_inf); - data->cur_is_floating = 1; /* float */ - } - is_inf = is_inf_internal = 1; - if (flags & SCF_DO_STCLASS_OR) { + data->cur_is_floating = 1; /* float */ + } + is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) { if (OP(scan) == CLUMP) { /* Actually is any start char, but very few code points * aren't start characters */ @@ -5882,13 +5882,13 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_anything(data->start_class); } } - flags &= ~SCF_DO_STCLASS; - break; - } - } - else if (OP(scan) == LNBREAK) { - if (flags & SCF_DO_STCLASS) { - if (flags & SCF_DO_STCLASS_AND) { + flags &= ~SCF_DO_STCLASS; + break; + } + } + else if (OP(scan) == LNBREAK) { + if (flags & SCF_DO_STCLASS) { + if (flags & SCF_DO_STCLASS_AND) { ssc_intersection(data->start_class, PL_XPosix_ptrs[_CC_VERTSPACE], FALSE); ssc_clear_locale(data->start_class); @@ -5899,36 +5899,36 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_union(data->start_class, PL_XPosix_ptrs[_CC_VERTSPACE], FALSE); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); /* See commit msg for * 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; } - flags &= ~SCF_DO_STCLASS; + flags &= ~SCF_DO_STCLASS; } - min++; + min++; if (delta != OPTIMIZE_INFTY) delta++; /* Because of the 2 char string cr-lf */ if (flags & SCF_DO_SUBSTR) { /* Cannot expect anything... */ scan_commit(pRExC_state, data, minlenp, is_inf); - data->pos_min += 1; + data->pos_min += 1; if (data->pos_delta != OPTIMIZE_INFTY) { data->pos_delta += 1; } - data->cur_is_floating = 1; /* float */ - } - } - else if (REGNODE_SIMPLE(OP(scan))) { + data->cur_is_floating = 1; /* float */ + } + } + else if (REGNODE_SIMPLE(OP(scan))) { - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - data->pos_min++; - } - min++; - if (flags & SCF_DO_STCLASS) { + data->pos_min++; + } + min++; + if (flags & SCF_DO_STCLASS) { bool invert = 0; SV* my_invlist = NULL; U8 namedclass; @@ -5936,21 +5936,21 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; - /* Some of the logic below assumes that switching - locale on will only add false positives. */ - switch (OP(scan)) { + /* Some of the logic below assumes that switching + locale on will only add false positives. */ + switch (OP(scan)) { - default: + default: #ifdef DEBUGGING Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); #endif - case SANY: - if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ - ssc_match_all_cp(data->start_class); - break; + case SANY: + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + ssc_match_all_cp(data->start_class); + break; - case REG_ANY: + case REG_ANY: { SV* REG_ANY_invlist = _new_invlist(2); REG_ANY_invlist = add_cp_to_invlist(REG_ANY_invlist, @@ -5970,8 +5970,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_clear_locale(data->start_class); } SvREFCNT_dec_NN(REG_ANY_invlist); - } - break; + } + break; case ANYOFD: case ANYOFL: @@ -5981,13 +5981,13 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", case ANYOFHr: case ANYOFHs: case ANYOF: - if (flags & SCF_DO_STCLASS_AND) - ssc_and(pRExC_state, data->start_class, + if (flags & SCF_DO_STCLASS_AND) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) scan); - else - ssc_or(pRExC_state, data->start_class, + else + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) scan); - break; + break; case NANYOFM: /* NANYOFM already contains the inversion of the input ANYOF data, so, unlike things like @@ -6028,11 +6028,11 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", break; } - case NPOSIXL: + case NPOSIXL: invert = 1; /* FALLTHROUGH */ - case POSIXL: + case POSIXL: namedclass = classnum_to_namedclass(FLAGS(scan)) + invert; if (flags & SCF_DO_STCLASS_AND) { bool was_there = cBOOL( @@ -6072,16 +6072,16 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", what's matched */ invert = 1; /* FALLTHROUGH */ - case POSIXA: + case POSIXA: my_invlist = invlist_clone(PL_Posix_ptrs[FLAGS(scan)], NULL); goto join_posix_and_ascii; - case NPOSIXD: - case NPOSIXU: + case NPOSIXD: + case NPOSIXU: invert = 1; /* FALLTHROUGH */ - case POSIXD: - case POSIXU: + case POSIXD: + case POSIXU: my_invlist = invlist_clone(PL_XPosix_ptrs[FLAGS(scan)], NULL); /* NPOSIXD matches all upper Latin1 code points unless the @@ -6105,23 +6105,23 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_union(data->start_class, my_invlist, invert); } SvREFCNT_dec(my_invlist); - } - if (flags & SCF_DO_STCLASS_OR) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - flags &= ~SCF_DO_STCLASS; - } - } - else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { - data->flags |= (OP(scan) == MEOL - ? SF_BEFORE_MEOL - : SF_BEFORE_SEOL); + } + if (flags & SCF_DO_STCLASS_OR) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + flags &= ~SCF_DO_STCLASS; + } + } + else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { + data->flags |= (OP(scan) == MEOL + ? SF_BEFORE_MEOL + : SF_BEFORE_SEOL); scan_commit(pRExC_state, data, minlenp, is_inf); - } - else if ( PL_regkind[OP(scan)] == BRANCHJ - /* Lookbehind, or need to calculate parens/evals/stclass: */ - && (scan->flags || data || (flags & SCF_DO_STCLASS)) - && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) + } + else if ( PL_regkind[OP(scan)] == BRANCHJ + /* Lookbehind, or need to calculate parens/evals/stclass: */ + && (scan->flags || data || (flags & SCF_DO_STCLASS)) + && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) { if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY || OP(scan) == UNLESSM ) @@ -6139,16 +6139,16 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", if (data) { data_fake.whilem_c = data->whilem_c; data_fake.last_closep = data->last_closep; - } + } else data_fake.last_closep = &fake; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if ( flags & SCF_DO_STCLASS && !scan->flags && OP(scan) == IFMATCH ) { /* Lookahead */ ssc_init(pRExC_state, &intrnl); data_fake.start_class = &intrnl; f |= SCF_DO_STCLASS_AND; - } + } if (flags & SCF_WHILEM_VISITED_POS) f |= SCF_WHILEM_VISITED_POS; next = regnext(scan); @@ -6165,7 +6165,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", || minnext > (I32)U8_MAX || minnext + deltanext > (I32)U8_MAX) { - FAIL2("Lookbehind longer than %" UVuf " not implemented", + FAIL2("Lookbehind longer than %" UVuf " not implemented", (UV)U8_MAX); } @@ -6190,24 +6190,24 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", data->whilem_c = data_fake.whilem_c; } if (f & SCF_DO_STCLASS_AND) { - if (flags & SCF_DO_STCLASS_OR) { - /* OR before, AND after: ideally we would recurse with - * data_fake to get the AND applied by study of the - * remainder of the pattern, and then derecurse; - * *** HACK *** for now just treat as "no information". - * See [perl #56690]. - */ - ssc_init(pRExC_state, data->start_class); - } else { + if (flags & SCF_DO_STCLASS_OR) { + /* OR before, AND after: ideally we would recurse with + * data_fake to get the AND applied by study of the + * remainder of the pattern, and then derecurse; + * *** HACK *** for now just treat as "no information". + * See [perl #56690]. + */ + ssc_init(pRExC_state, data->start_class); + } else { /* AND before and after: combine and continue. These * assertions are zero-length, so can match an EMPTY * string */ - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl); ANYOF_FLAGS(data->start_class) |= SSC_MATCHES_EMPTY_STRING; - } + } } - } + } #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY else { /* Positive Lookahead/lookbehind @@ -6245,9 +6245,9 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", data_fake.flags = 0; data_fake.substrs[0].flags = 0; data_fake.substrs[1].flags = 0; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if (is_inf) - data_fake.flags |= SF_IS_INF; + data_fake.flags |= SF_IS_INF; if ( flags & SCF_DO_STCLASS && !scan->flags && OP(scan) == IFMATCH ) { /* Lookahead */ ssc_init(pRExC_state, &intrnl); @@ -6272,7 +6272,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", || *minnextp > (I32)U8_MAX || *minnextp + deltanext > (I32)U8_MAX) { - FAIL2("Lookbehind longer than %" UVuf " not implemented", + FAIL2("Lookbehind longer than %" UVuf " not implemented", (UV)U8_MAX); } @@ -6314,65 +6314,65 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", } } } - } + } #endif - } - else if (OP(scan) == OPEN) { - if (stopparen != (I32)ARG(scan)) - pars++; - } - else if (OP(scan) == CLOSE) { - if (stopparen == (I32)ARG(scan)) { - break; - } - if ((I32)ARG(scan) == is_par) { - next = regnext(scan); - - if ( next && (OP(next) != WHILEM) && next < last) - is_par = 0; /* Disable optimization */ - } - if (data) - *(data->last_closep) = ARG(scan); - } - else if (OP(scan) == EVAL) { - if (data) - data->flags |= SF_HAS_EVAL; - } - else if ( PL_regkind[OP(scan)] == ENDLIKE ) { - if (flags & SCF_DO_SUBSTR) { + } + else if (OP(scan) == OPEN) { + if (stopparen != (I32)ARG(scan)) + pars++; + } + else if (OP(scan) == CLOSE) { + if (stopparen == (I32)ARG(scan)) { + break; + } + if ((I32)ARG(scan) == is_par) { + next = regnext(scan); + + if ( next && (OP(next) != WHILEM) && next < last) + is_par = 0; /* Disable optimization */ + } + if (data) + *(data->last_closep) = ARG(scan); + } + else if (OP(scan) == EVAL) { + if (data) + data->flags |= SF_HAS_EVAL; + } + else if ( PL_regkind[OP(scan)] == ENDLIKE ) { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - flags &= ~SCF_DO_SUBSTR; - } - if (data && OP(scan)==ACCEPT) { - data->flags |= SCF_SEEN_ACCEPT; - if (stopmin > min) - stopmin = min; - } - } - else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */ - { - if (flags & SCF_DO_SUBSTR) { + flags &= ~SCF_DO_SUBSTR; + } + if (data && OP(scan)==ACCEPT) { + data->flags |= SCF_SEEN_ACCEPT; + if (stopmin > min) + stopmin = min; + } + } + else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */ + { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - data->cur_is_floating = 1; /* float */ - } - is_inf = is_inf_internal = 1; - if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ - ssc_anything(data->start_class); - flags &= ~SCF_DO_STCLASS; - } - else if (OP(scan) == GPOS) { + data->cur_is_floating = 1; /* float */ + } + is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + ssc_anything(data->start_class); + flags &= ~SCF_DO_STCLASS; + } + else if (OP(scan) == GPOS) { if (!(RExC_rx->intflags & PREGf_GPOS_FLOAT) && - !(delta || is_inf || (data && data->pos_delta))) - { + !(delta || is_inf || (data && data->pos_delta))) + { if (!(RExC_rx->intflags & PREGf_ANCH) && (flags & SCF_DO_SUBSTR)) RExC_rx->intflags |= PREGf_ANCH_GPOS; - if (RExC_rx->gofs < (STRLEN)min) - RExC_rx->gofs = min; + if (RExC_rx->gofs < (STRLEN)min) + RExC_rx->gofs = min; } else { RExC_rx->intflags |= PREGf_GPOS_FLOAT; RExC_rx->gofs = 0; } - } + } #ifdef TRIE_STUDY_OPT #ifdef FULL_TRIE_STUDY else if (PL_regkind[OP(scan)] == TRIE) { @@ -6411,7 +6411,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", } else data_fake.last_closep = &fake; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if (flags & SCF_DO_STCLASS) { ssc_init(pRExC_state, &this_class); data_fake.start_class = &this_class; @@ -6448,11 +6448,11 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", pars++; if (data_fake.flags & SCF_SEEN_ACCEPT) { if ( stopmin > min + min1) - stopmin = min + min1; - flags &= ~SCF_DO_SUBSTR; - if (data) - data->flags |= SCF_SEEN_ACCEPT; - } + stopmin = min + min1; + flags &= ~SCF_DO_SUBSTR; + if (data) + data->flags |= SCF_SEEN_ACCEPT; + } if (data) { if (data_fake.flags & SF_HAS_EVAL) data->flags |= SF_HAS_EVAL; @@ -6490,7 +6490,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", else { /* Switch to OR mode: cache the old value of * data->start_class */ - INIT_AND_WITHP; + INIT_AND_WITHP; StructCopy(data->start_class, and_withp, regnode_ssc); flags &= ~SCF_DO_STCLASS_AND; StructCopy(&accum, data->start_class, regnode_ssc); @@ -6501,24 +6501,24 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", continue; } #else - else if (PL_regkind[OP(scan)] == TRIE) { - reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ]; - U8*bang=NULL; + else if (PL_regkind[OP(scan)] == TRIE) { + reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ]; + U8*bang=NULL; - min += trie->minlen; - delta += (trie->maxlen - trie->minlen); - flags &= ~SCF_DO_STCLASS; /* xxx */ + min += trie->minlen; + delta += (trie->maxlen - trie->minlen); + flags &= ~SCF_DO_STCLASS; /* xxx */ if (flags & SCF_DO_SUBSTR) { /* Cannot expect anything... */ scan_commit(pRExC_state, data, minlenp, is_inf); - data->pos_min += trie->minlen; - data->pos_delta += (trie->maxlen - trie->minlen); - if (trie->maxlen != trie->minlen) - data->cur_is_floating = 1; /* float */ - } - if (trie->jump) /* no more substrings -- for now /grr*/ + data->pos_min += trie->minlen; + data->pos_delta += (trie->maxlen - trie->minlen); + if (trie->maxlen != trie->minlen) + data->cur_is_floating = 1; /* float */ + } + if (trie->jump) /* no more substrings -- for now /grr*/ flags &= ~SCF_DO_SUBSTR; - } + } else if (OP(scan) == REGEX_SET) { Perl_croak(aTHX_ "panic: %s regnode should be resolved" " before optimization", reg_name[REGEX_SET]); @@ -6527,8 +6527,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", #endif /* old or new */ #endif /* TRIE_STUDY_OPT */ - /* Else: zero-length, ignore. */ - scan = regnext(scan); + /* Else: zero-length, ignore. */ + scan = regnext(scan); } finish: @@ -6557,19 +6557,19 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", *deltap = is_inf_internal ? OPTIMIZE_INFTY : delta; if (flags & SCF_DO_SUBSTR && is_inf) - data->pos_delta = OPTIMIZE_INFTY - data->pos_min; + data->pos_delta = OPTIMIZE_INFTY - data->pos_min; if (is_par > (I32)U8_MAX) - is_par = 0; + is_par = 0; if (is_par && pars==1 && data) { - data->flags |= SF_IN_PAR; - data->flags &= ~SF_HAS_PAR; + data->flags |= SF_IN_PAR; + data->flags &= ~SF_HAS_PAR; } else if (pars && data) { - data->flags |= SF_HAS_PAR; - data->flags &= ~SF_IN_PAR; + data->flags |= SF_HAS_PAR; + data->flags &= ~SF_IN_PAR; } if (flags & SCF_DO_STCLASS_OR) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); if (flags & SCF_TRIE_RESTUDY) data->flags |= SCF_TRIE_RESTUDY; @@ -6595,12 +6595,12 @@ S_add_data(RExC_state_t* const pRExC_state, const char* const s, const U32 n) PERL_ARGS_ASSERT_ADD_DATA; Renewc(RExC_rxi->data, - sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), - char, struct reg_data); + sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), + char, struct reg_data); if(count) - Renew(RExC_rxi->data->what, count + n, U8); + Renew(RExC_rxi->data->what, count + n, U8); else - Newx(RExC_rxi->data->what, n, U8); + Newx(RExC_rxi->data->what, n, U8); RExC_rxi->data->count = count + n; Copy(s, RExC_rxi->data->what + count, n, U8); return count; @@ -6614,22 +6614,22 @@ Perl_reginitcolors(pTHX) { const char * const s = PerlEnv_getenv("PERL_RE_COLORS"); if (s) { - char *t = savepv(s); - int i = 0; - PL_colors[0] = t; - while (++i < 6) { - t = strchr(t, '\t'); - if (t) { - *t = '\0'; - PL_colors[i] = ++t; - } - else - PL_colors[i] = t = (char *)""; - } + char *t = savepv(s); + int i = 0; + PL_colors[0] = t; + while (++i < 6) { + t = strchr(t, '\t'); + if (t) { + *t = '\0'; + PL_colors[i] = ++t; + } + else + PL_colors[i] = t = (char *)""; + } } else { - int i = 0; - while (i < 6) - PL_colors[i++] = (char *)""; + int i = 0; + while (i < 6) + PL_colors[i++] = (char *)""; } PL_colorset = 1; } @@ -6666,24 +6666,24 @@ regexp_engine const * Perl_current_re_engine(pTHX) { if (IN_PERL_COMPILETIME) { - HV * const table = GvHV(PL_hintgv); - SV **ptr; + HV * const table = GvHV(PL_hintgv); + SV **ptr; - if (!table || !(PL_hints & HINT_LOCALIZE_HH)) - return &PL_core_reg_engine; - ptr = hv_fetchs(table, "regcomp", FALSE); - if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr))) - return &PL_core_reg_engine; - return INT2PTR(regexp_engine*, SvIV(*ptr)); + if (!table || !(PL_hints & HINT_LOCALIZE_HH)) + return &PL_core_reg_engine; + ptr = hv_fetchs(table, "regcomp", FALSE); + if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr))) + return &PL_core_reg_engine; + return INT2PTR(regexp_engine*, SvIV(*ptr)); } else { - SV *ptr; - if (!PL_curcop->cop_hints_hash) - return &PL_core_reg_engine; - ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0); - if ( !(ptr && SvIOK(ptr) && SvIV(ptr))) - return &PL_core_reg_engine; - return INT2PTR(regexp_engine*, SvIV(ptr)); + SV *ptr; + if (!PL_curcop->cop_hints_hash) + return &PL_core_reg_engine; + ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0); + if ( !(ptr && SvIOK(ptr) && SvIV(ptr))) + return &PL_core_reg_engine; + return INT2PTR(regexp_engine*, SvIV(ptr)); } } @@ -6699,7 +6699,7 @@ Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags) /* Dispatch a request to compile a regexp to correct regexp engine. */ DEBUG_COMPILE_r({ Perl_re_printf( aTHX_ "Using engine %" UVxf "\n", - PTR2UV(eng)); + PTR2UV(eng)); }); return CALLREGCOMP_ENG(eng, pattern, flags); } @@ -6770,7 +6770,7 @@ S_alloc_code_blocks(pTHX_ int ncode) static void S_pat_upgrade_to_utf8(pTHX_ RExC_state_t * const pRExC_state, - char **pat_p, STRLEN *plen_p, int num_code_blocks) + char **pat_p, STRLEN *plen_p, int num_code_blocks) { U8 *const src = (U8*)*pat_p; U8 *dst, *d; @@ -6929,7 +6929,7 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state, oplist = OpSIBLING(oplist);; } - /* apply magic and QR overloading to arg */ + /* apply magic and QR overloading to arg */ SvGETMAGIC(msv); if (SvROK(msv) && SvAMAGIC(msv)) { @@ -7061,7 +7061,7 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state, static bool S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, - char *pat, STRLEN plen) + char *pat, STRLEN plen) { int n = 0; STRLEN s; @@ -7069,21 +7069,21 @@ S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, PERL_UNUSED_CONTEXT; for (s = 0; s < plen; s++) { - if ( pRExC_state->code_blocks + if ( pRExC_state->code_blocks && n < pRExC_state->code_blocks->count - && s == pRExC_state->code_blocks->cb[n].start) - { - s = pRExC_state->code_blocks->cb[n].end; - n++; - continue; - } - /* TODO ideally should handle [..], (#..), /#.../x to reduce false - * positives here */ - if (pat[s] == '(' && s+2 <= plen && pat[s+1] == '?' && - (pat[s+2] == '{' + && s == pRExC_state->code_blocks->cb[n].start) + { + s = pRExC_state->code_blocks->cb[n].end; + n++; + continue; + } + /* TODO ideally should handle [..], (#..), /#.../x to reduce false + * positives here */ + if (pat[s] == '(' && s+2 <= plen && pat[s+1] == '?' && + (pat[s+2] == '{' || (s + 2 <= plen && pat[s+2] == '?' && pat[s+3] == '{')) - ) - return 1; + ) + return 1; } return 0; } @@ -7120,39 +7120,39 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, DECLARE_AND_GET_RE_DEBUG_FLAGS; if (pRExC_state->runtime_code_qr) { - /* this is the second time we've been called; this should - * only happen if the main pattern got upgraded to utf8 - * during compilation; re-use the qr we compiled first time - * round (which should be utf8 too) - */ - qr = pRExC_state->runtime_code_qr; - pRExC_state->runtime_code_qr = NULL; - assert(RExC_utf8 && SvUTF8(qr)); + /* this is the second time we've been called; this should + * only happen if the main pattern got upgraded to utf8 + * during compilation; re-use the qr we compiled first time + * round (which should be utf8 too) + */ + qr = pRExC_state->runtime_code_qr; + pRExC_state->runtime_code_qr = NULL; + assert(RExC_utf8 && SvUTF8(qr)); } else { - int n = 0; - STRLEN s; - char *p, *newpat; - int newlen = plen + 7; /* allow for "qr''xx\0" extra chars */ - SV *sv, *qr_ref; - dSP; - - /* determine how many extra chars we need for ' and \ escaping */ - for (s = 0; s < plen; s++) { - if (pat[s] == '\'' || pat[s] == '\\') - newlen++; - } - - Newx(newpat, newlen, char); - p = newpat; - *p++ = 'q'; *p++ = 'r'; *p++ = '\''; - - for (s = 0; s < plen; s++) { - if ( pRExC_state->code_blocks - && n < pRExC_state->code_blocks->count - && s == pRExC_state->code_blocks->cb[n].start) - { - /* blank out literal code block so that they aren't + int n = 0; + STRLEN s; + char *p, *newpat; + int newlen = plen + 7; /* allow for "qr''xx\0" extra chars */ + SV *sv, *qr_ref; + dSP; + + /* determine how many extra chars we need for ' and \ escaping */ + for (s = 0; s < plen; s++) { + if (pat[s] == '\'' || pat[s] == '\\') + newlen++; + } + + Newx(newpat, newlen, char); + p = newpat; + *p++ = 'q'; *p++ = 'r'; *p++ = '\''; + + for (s = 0; s < plen; s++) { + if ( pRExC_state->code_blocks + && n < pRExC_state->code_blocks->count + && s == pRExC_state->code_blocks->cb[n].start) + { + /* blank out literal code block so that they aren't * recompiled: eg change from/to: * /(?{xyz})/ * /(?=====)/ @@ -7163,76 +7163,76 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, * /(?(?{xyz}))/ * /(?(?=====))/ */ - assert(pat[s] == '('); - assert(pat[s+1] == '?'); + assert(pat[s] == '('); + assert(pat[s+1] == '?'); *p++ = '('; *p++ = '?'; s += 2; - while (s < pRExC_state->code_blocks->cb[n].end) { - *p++ = '='; - s++; - } + while (s < pRExC_state->code_blocks->cb[n].end) { + *p++ = '='; + s++; + } *p++ = ')'; - n++; - continue; - } - if (pat[s] == '\'' || pat[s] == '\\') - *p++ = '\\'; - *p++ = pat[s]; - } - *p++ = '\''; - if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) { - *p++ = 'x'; + n++; + continue; + } + if (pat[s] == '\'' || pat[s] == '\\') + *p++ = '\\'; + *p++ = pat[s]; + } + *p++ = '\''; + if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) { + *p++ = 'x'; if (pRExC_state->pm_flags & RXf_PMf_EXTENDED_MORE) { *p++ = 'x'; } } - *p++ = '\0'; - DEBUG_COMPILE_r({ + *p++ = '\0'; + DEBUG_COMPILE_r({ Perl_re_printf( aTHX_ - "%sre-parsing pattern for runtime code:%s %s\n", - PL_colors[4], PL_colors[5], newpat); - }); + "%sre-parsing pattern for runtime code:%s %s\n", + PL_colors[4], PL_colors[5], newpat); + }); - sv = newSVpvn_flags(newpat, p-newpat-1, RExC_utf8 ? SVf_UTF8 : 0); - Safefree(newpat); + sv = newSVpvn_flags(newpat, p-newpat-1, RExC_utf8 ? SVf_UTF8 : 0); + Safefree(newpat); - ENTER; - SAVETMPS; - save_re_context(); - PUSHSTACKi(PERLSI_REQUIRE); + ENTER; + SAVETMPS; + save_re_context(); + PUSHSTACKi(PERLSI_REQUIRE); /* G_RE_REPARSING causes the toker to collapse \\ into \ when * parsing qr''; normally only q'' does this. It also alters * hints handling */ - eval_sv(sv, G_SCALAR|G_RE_REPARSING); - SvREFCNT_dec_NN(sv); - SPAGAIN; - qr_ref = POPs; - PUTBACK; - { - SV * const errsv = ERRSV; - if (SvTRUE_NN(errsv)) + eval_sv(sv, G_SCALAR|G_RE_REPARSING); + SvREFCNT_dec_NN(sv); + SPAGAIN; + qr_ref = POPs; + PUTBACK; + { + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) /* use croak_sv ? */ - Perl_croak_nocontext("%" SVf, SVfARG(errsv)); - } - assert(SvROK(qr_ref)); - qr = SvRV(qr_ref); - assert(SvTYPE(qr) == SVt_REGEXP && RX_ENGINE((REGEXP*)qr)->op_comp); - /* the leaving below frees the tmp qr_ref. - * Give qr a life of its own */ - SvREFCNT_inc(qr); - POPSTACK; - FREETMPS; - LEAVE; + Perl_croak_nocontext("%" SVf, SVfARG(errsv)); + } + assert(SvROK(qr_ref)); + qr = SvRV(qr_ref); + assert(SvTYPE(qr) == SVt_REGEXP && RX_ENGINE((REGEXP*)qr)->op_comp); + /* the leaving below frees the tmp qr_ref. + * Give qr a life of its own */ + SvREFCNT_inc(qr); + POPSTACK; + FREETMPS; + LEAVE; } if (!RExC_utf8 && SvUTF8(qr)) { - /* first time through; the pattern got upgraded; save the - * qr for the next time through */ - assert(!pRExC_state->runtime_code_qr); - pRExC_state->runtime_code_qr = qr; - return 0; + /* first time through; the pattern got upgraded; save the + * qr for the next time through */ + assert(!pRExC_state->runtime_code_qr); + pRExC_state->runtime_code_qr = qr; + return 0; } @@ -7241,17 +7241,17 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, /* merge the main (r1) and run-time (r2) code blocks into one */ { - RXi_GET_DECL(ReANY((REGEXP *)qr), r2); - struct reg_code_block *new_block, *dst; - RExC_state_t * const r1 = pRExC_state; /* convenient alias */ - int i1 = 0, i2 = 0; + RXi_GET_DECL(ReANY((REGEXP *)qr), r2); + struct reg_code_block *new_block, *dst; + RExC_state_t * const r1 = pRExC_state; /* convenient alias */ + int i1 = 0, i2 = 0; int r1c, r2c; - if (!r2->code_blocks || !r2->code_blocks->count) /* we guessed wrong */ - { - SvREFCNT_dec_NN(qr); - return 1; - } + if (!r2->code_blocks || !r2->code_blocks->count) /* we guessed wrong */ + { + SvREFCNT_dec_NN(qr); + return 1; + } if (!r1->code_blocks) r1->code_blocks = S_alloc_code_blocks(aTHX_ 0); @@ -7259,46 +7259,46 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, r1c = r1->code_blocks->count; r2c = r2->code_blocks->count; - Newx(new_block, r1c + r2c, struct reg_code_block); - - dst = new_block; - - while (i1 < r1c || i2 < r2c) { - struct reg_code_block *src; - bool is_qr = 0; - - if (i1 == r1c) { - src = &r2->code_blocks->cb[i2++]; - is_qr = 1; - } - else if (i2 == r2c) - src = &r1->code_blocks->cb[i1++]; - else if ( r1->code_blocks->cb[i1].start - < r2->code_blocks->cb[i2].start) - { - src = &r1->code_blocks->cb[i1++]; - assert(src->end < r2->code_blocks->cb[i2].start); - } - else { - assert( r1->code_blocks->cb[i1].start - > r2->code_blocks->cb[i2].start); - src = &r2->code_blocks->cb[i2++]; - is_qr = 1; - assert(src->end < r1->code_blocks->cb[i1].start); - } - - assert(pat[src->start] == '('); - assert(pat[src->end] == ')'); - dst->start = src->start; - dst->end = src->end; - dst->block = src->block; - dst->src_regex = is_qr ? (REGEXP*) SvREFCNT_inc( (SV*) qr) - : src->src_regex; - dst++; - } - r1->code_blocks->count += r2c; - Safefree(r1->code_blocks->cb); - r1->code_blocks->cb = new_block; + Newx(new_block, r1c + r2c, struct reg_code_block); + + dst = new_block; + + while (i1 < r1c || i2 < r2c) { + struct reg_code_block *src; + bool is_qr = 0; + + if (i1 == r1c) { + src = &r2->code_blocks->cb[i2++]; + is_qr = 1; + } + else if (i2 == r2c) + src = &r1->code_blocks->cb[i1++]; + else if ( r1->code_blocks->cb[i1].start + < r2->code_blocks->cb[i2].start) + { + src = &r1->code_blocks->cb[i1++]; + assert(src->end < r2->code_blocks->cb[i2].start); + } + else { + assert( r1->code_blocks->cb[i1].start + > r2->code_blocks->cb[i2].start); + src = &r2->code_blocks->cb[i2++]; + is_qr = 1; + assert(src->end < r1->code_blocks->cb[i1].start); + } + + assert(pat[src->start] == '('); + assert(pat[src->end] == ')'); + dst->start = src->start; + dst->end = src->end; + dst->block = src->block; + dst->src_regex = is_qr ? (REGEXP*) SvREFCNT_inc( (SV*) qr) + : src->src_regex; + dst++; + } + r1->code_blocks->count += r2c; + Safefree(r1->code_blocks->cb); + r1->code_blocks->cb = new_block; } SvREFCNT_dec_NN(qr); @@ -7506,8 +7506,8 @@ S_set_regex_pv(pTHX_ RExC_state_t *pRExC_state, REGEXP *Rx) REGEXP * Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, - OP *expr, const regexp_engine* eng, REGEXP *old_re, - bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags) + OP *expr, const regexp_engine* eng, REGEXP *old_re, + bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags) { REGEXP *Rx; /* Capital 'R' means points to a REGEXP */ STRLEN plen; @@ -7548,19 +7548,19 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, pRExC_state->code_blocks = NULL; if (is_bare_re) - *is_bare_re = FALSE; + *is_bare_re = FALSE; if (expr && (expr->op_type == OP_LIST || - (expr->op_type == OP_NULL && expr->op_targ == OP_LIST))) { - /* allocate code_blocks if needed */ - OP *o; - int ncode = 0; + (expr->op_type == OP_NULL && expr->op_targ == OP_LIST))) { + /* allocate code_blocks if needed */ + OP *o; + int ncode = 0; - for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) - if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) - ncode++; /* count of DO blocks */ + for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) + if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) + ncode++; /* count of DO blocks */ - if (ncode) + if (ncode) pRExC_state->code_blocks = S_alloc_code_blocks(aTHX_ ncode); } @@ -7638,15 +7638,15 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, exp = SvPV_nomg(pat, plen); if (!eng->op_comp) { - if ((SvUTF8(pat) && IN_BYTES) - || SvGMAGICAL(pat) || SvAMAGIC(pat)) - { - /* make a temporary copy; either to convert to bytes, - * or to avoid repeating get-magic / overloaded stringify */ - pat = newSVpvn_flags(exp, plen, SVs_TEMP | - (IN_BYTES ? 0 : SvUTF8(pat))); - } - return CALLREGCOMP_ENG(eng, pat, orig_rx_flags); + if ((SvUTF8(pat) && IN_BYTES) + || SvGMAGICAL(pat) || SvAMAGIC(pat)) + { + /* make a temporary copy; either to convert to bytes, + * or to avoid repeating get-magic / overloaded stringify */ + pat = newSVpvn_flags(exp, plen, SVs_TEMP | + (IN_BYTES ? 0 : SvUTF8(pat))); + } + return CALLREGCOMP_ENG(eng, pat, orig_rx_flags); } /* ignore the utf8ness if the pattern is 0 length */ @@ -7690,11 +7690,11 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, * to utf8 */ if ((pm_flags & PMf_USE_RE_EVAL) - /* this second condition covers the non-regex literal case, - * i.e. $foo =~ '(?{})'. */ - || (IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) + /* this second condition covers the non-regex literal case, + * i.e. $foo =~ '(?{})'. */ + || (IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) ) - runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen); + runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen); redo_parse: /* return old regex if pattern hasn't changed */ @@ -7708,10 +7708,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, && !recompile && !!RX_UTF8(old_re) == !!RExC_utf8 && ( RX_COMPFLAGS(old_re) == ( orig_rx_flags & RXf_PMf_FLAGCOPYMASK ) ) - && RX_PRECOMP(old_re) - && RX_PRELEN(old_re) == plen + && RX_PRECOMP(old_re) + && RX_PRELEN(old_re) == plen && memEQ(RX_PRECOMP(old_re), exp, plen) - && !runtime_code /* with runtime code, always recompile */ ) + && !runtime_code /* with runtime code, always recompile */ ) { DEBUG_COMPILE_r({ SV *dsv= sv_newmortal(); @@ -7734,9 +7734,9 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, && initial_charset == REGEX_DEPENDS_CHARSET) { - /* Set to use unicode semantics if the pattern is in utf8 and has the - * 'depends' charset specified, as it means unicode when utf8 */ - set_regex_charset(&rx_flags, REGEX_UNICODE_CHARSET); + /* Set to use unicode semantics if the pattern is in utf8 and has the + * 'depends' charset specified, as it means unicode when utf8 */ + set_regex_charset(&rx_flags, REGEX_UNICODE_CHARSET); RExC_uni_semantics = 1; } @@ -7744,16 +7744,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if (runtime_code) { assert(TAINTING_get || !TAINT_get); - if (TAINT_get) - Perl_croak(aTHX_ "Eval-group in insecure regular expression"); + if (TAINT_get) + Perl_croak(aTHX_ "Eval-group in insecure regular expression"); - if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) { - /* whoops, we have a non-utf8 pattern, whilst run-time code - * got compiled as utf8. Try again with a utf8 pattern */ + if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) { + /* whoops, we have a non-utf8 pattern, whilst run-time code + * got compiled as utf8. Try again with a utf8 pattern */ S_pat_upgrade_to_utf8(aTHX_ pRExC_state, &exp, &plen, pRExC_state->code_blocks ? pRExC_state->code_blocks->count : 0); goto redo_parse; - } + } } assert(!pRExC_state->runtime_code_qr); @@ -7828,7 +7828,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RXp_COMPFLAGS(RExC_rx) = orig_rx_flags & RXf_PMf_FLAGCOPYMASK; if (pm_flags & PMf_IS_QR) { - RExC_rxi->code_blocks = pRExC_state->code_blocks; + RExC_rxi->code_blocks = pRExC_state->code_blocks; if (RExC_rxi->code_blocks) { RExC_rxi->code_blocks->refcnt++; } @@ -7870,7 +7870,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_total_parens = RExC_npar; } else if (! MUST_RESTART(flags)) { - ReREFCNT_dec(Rx); + ReREFCNT_dec(Rx); Perl_croak(aTHX_ "panic: reg returned failure to re_op_compile, flags=%#" UVxf, (UV) flags); } @@ -8032,7 +8032,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN; else RExC_seen &= ~REG_TOP_LEVEL_BRANCHES_SEEN; - StructCopy(&zero_scan_data, &data, scan_data_t); + StructCopy(&zero_scan_data, &data, scan_data_t); } #else StructCopy(&zero_scan_data, &data, scan_data_t); @@ -8043,171 +8043,171 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, /*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */ if (UTF) - SvUTF8_on(Rx); /* Unicode in it? */ + SvUTF8_on(Rx); /* Unicode in it? */ RExC_rxi->regstclass = NULL; if (RExC_naughty >= TOO_NAUGHTY) /* Probably an expensive pattern. */ - RExC_rx->intflags |= PREGf_NAUGHTY; + RExC_rx->intflags |= PREGf_NAUGHTY; scan = RExC_rxi->program + 1; /* First BRANCH. */ /* testing for BRANCH here tells us whether there is "must appear" data in the pattern. If there is then we can use it for optimisations */ if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN)) { /* Only one top-level choice. */ - SSize_t fake; - STRLEN longest_length[2]; - regnode_ssc ch_class; /* pointed to by data */ - int stclass_flag; - SSize_t last_close = 0; /* pointed to by data */ + SSize_t fake; + STRLEN longest_length[2]; + regnode_ssc ch_class; /* pointed to by data */ + int stclass_flag; + SSize_t last_close = 0; /* pointed to by data */ regnode *first= scan; regnode *first_next= regnext(first); int i; - /* - * Skip introductions and multiplicators >= 1 - * so that we can extract the 'meat' of the pattern that must - * match in the large if() sequence following. - * NOTE that EXACT is NOT covered here, as it is normally - * picked up by the optimiser separately. - * - * This is unfortunate as the optimiser isnt handling lookahead - * properly currently. - * - */ - while ((OP(first) == OPEN && (sawopen = 1)) || - /* An OR of *one* alternative - should not happen now. */ - (OP(first) == BRANCH && OP(first_next) != BRANCH) || - /* for now we can't handle lookbehind IFMATCH*/ - (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) || - (OP(first) == PLUS) || - (OP(first) == MINMOD) || - /* An {n,m} with n>0 */ - (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) || - (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END )) - { - /* - * the only op that could be a regnode is PLUS, all the rest - * will be regnode_1 or regnode_2. - * + /* + * Skip introductions and multiplicators >= 1 + * so that we can extract the 'meat' of the pattern that must + * match in the large if() sequence following. + * NOTE that EXACT is NOT covered here, as it is normally + * picked up by the optimiser separately. + * + * This is unfortunate as the optimiser isnt handling lookahead + * properly currently. + * + */ + while ((OP(first) == OPEN && (sawopen = 1)) || + /* An OR of *one* alternative - should not happen now. */ + (OP(first) == BRANCH && OP(first_next) != BRANCH) || + /* for now we can't handle lookbehind IFMATCH*/ + (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) || + (OP(first) == PLUS) || + (OP(first) == MINMOD) || + /* An {n,m} with n>0 */ + (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) || + (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END )) + { + /* + * the only op that could be a regnode is PLUS, all the rest + * will be regnode_1 or regnode_2. + * * (yves doesn't think this is true) - */ - if (OP(first) == PLUS) - sawplus = 1; + */ + if (OP(first) == PLUS) + sawplus = 1; else { if (OP(first) == MINMOD) sawminmod = 1; - first += regarglen[OP(first)]; + first += regarglen[OP(first)]; } - first = NEXTOPER(first); - first_next= regnext(first); - } + first = NEXTOPER(first); + first_next= regnext(first); + } - /* Starting-point info. */ + /* Starting-point info. */ again: DEBUG_PEEP("first:", first, 0, 0); /* Ignore EXACT as we deal with it later. */ - if (PL_regkind[OP(first)] == EXACT) { - if (! isEXACTFish(OP(first))) { - NOOP; /* Empty, get anchored substr later. */ + if (PL_regkind[OP(first)] == EXACT) { + if (! isEXACTFish(OP(first))) { + NOOP; /* Empty, get anchored substr later. */ } - else - RExC_rxi->regstclass = first; - } + else + RExC_rxi->regstclass = first; + } #ifdef TRIE_STCLASS - else if (PL_regkind[OP(first)] == TRIE && - ((reg_trie_data *)RExC_rxi->data->data[ ARG(first) ])->minlen>0) - { + else if (PL_regkind[OP(first)] == TRIE && + ((reg_trie_data *)RExC_rxi->data->data[ ARG(first) ])->minlen>0) + { /* this can happen only on restudy */ RExC_rxi->regstclass = construct_ahocorasick_from_trie(pRExC_state, (regnode *)first, 0); - } + } #endif - else if (REGNODE_SIMPLE(OP(first))) - RExC_rxi->regstclass = first; - else if (PL_regkind[OP(first)] == BOUND || - PL_regkind[OP(first)] == NBOUND) - RExC_rxi->regstclass = first; - else if (PL_regkind[OP(first)] == BOL) { + else if (REGNODE_SIMPLE(OP(first))) + RExC_rxi->regstclass = first; + else if (PL_regkind[OP(first)] == BOUND || + PL_regkind[OP(first)] == NBOUND) + RExC_rxi->regstclass = first; + else if (PL_regkind[OP(first)] == BOL) { RExC_rx->intflags |= (OP(first) == MBOL ? PREGf_ANCH_MBOL : PREGf_ANCH_SBOL); - first = NEXTOPER(first); - goto again; - } - else if (OP(first) == GPOS) { + first = NEXTOPER(first); + goto again; + } + else if (OP(first) == GPOS) { RExC_rx->intflags |= PREGf_ANCH_GPOS; - first = NEXTOPER(first); - goto again; - } - else if ((!sawopen || !RExC_sawback) && + first = NEXTOPER(first); + goto again; + } + else if ((!sawopen || !RExC_sawback) && !sawlookahead && - (OP(first) == STAR && - PL_regkind[OP(NEXTOPER(first))] == REG_ANY) && + (OP(first) == STAR && + PL_regkind[OP(NEXTOPER(first))] == REG_ANY) && !(RExC_rx->intflags & PREGf_ANCH) && !pRExC_state->code_blocks) - { - /* turn .* into ^.* with an implied $*=1 */ - const int type = - (OP(NEXTOPER(first)) == REG_ANY) + { + /* turn .* into ^.* with an implied $*=1 */ + const int type = + (OP(NEXTOPER(first)) == REG_ANY) ? PREGf_ANCH_MBOL : PREGf_ANCH_SBOL; RExC_rx->intflags |= (type | PREGf_IMPLICIT); - first = NEXTOPER(first); - goto again; - } + first = NEXTOPER(first); + goto again; + } if (sawplus && !sawminmod && !sawlookahead && (!sawopen || !RExC_sawback) - && !pRExC_state->code_blocks) /* May examine pos and $& */ - /* x+ must match at the 1st pos of run of x's */ - RExC_rx->intflags |= PREGf_SKIP; + && !pRExC_state->code_blocks) /* May examine pos and $& */ + /* x+ must match at the 1st pos of run of x's */ + RExC_rx->intflags |= PREGf_SKIP; - /* Scan is after the zeroth branch, first is atomic matcher. */ + /* Scan is after the zeroth branch, first is atomic matcher. */ #ifdef TRIE_STUDY_OPT - DEBUG_PARSE_r( - if (!restudied) + DEBUG_PARSE_r( + if (!restudied) Perl_re_printf( aTHX_ "first at %" IVdf "\n", - (IV)(first - scan + 1)) + (IV)(first - scan + 1)) ); #else - DEBUG_PARSE_r( + DEBUG_PARSE_r( Perl_re_printf( aTHX_ "first at %" IVdf "\n", - (IV)(first - scan + 1)) + (IV)(first - scan + 1)) ); #endif - /* - * If there's something expensive in the r.e., find the - * longest literal string that must appear and make it the - * regmust. Resolve ties in favor of later strings, since - * the regstart check works with the beginning of the r.e. - * and avoiding duplication strengthens checking. Not a - * strong reason, but sufficient in the absence of others. - * [Now we resolve ties in favor of the earlier string if - * it happens that c_offset_min has been invalidated, since the - * earlier string may buy us something the later one won't.] - */ - - data.substrs[0].str = newSVpvs(""); - data.substrs[1].str = newSVpvs(""); - data.last_found = newSVpvs(""); - data.cur_is_floating = 0; /* initially any found substring is fixed */ - ENTER_with_name("study_chunk"); - SAVEFREESV(data.substrs[0].str); - SAVEFREESV(data.substrs[1].str); - SAVEFREESV(data.last_found); - first = scan; - if (!RExC_rxi->regstclass) { - ssc_init(pRExC_state, &ch_class); - data.start_class = &ch_class; - stclass_flag = SCF_DO_STCLASS_AND; - } else /* XXXX Check for BOUND? */ - stclass_flag = 0; - data.last_closep = &last_close; + /* + * If there's something expensive in the r.e., find the + * longest literal string that must appear and make it the + * regmust. Resolve ties in favor of later strings, since + * the regstart check works with the beginning of the r.e. + * and avoiding duplication strengthens checking. Not a + * strong reason, but sufficient in the absence of others. + * [Now we resolve ties in favor of the earlier string if + * it happens that c_offset_min has been invalidated, since the + * earlier string may buy us something the later one won't.] + */ + + data.substrs[0].str = newSVpvs(""); + data.substrs[1].str = newSVpvs(""); + data.last_found = newSVpvs(""); + data.cur_is_floating = 0; /* initially any found substring is fixed */ + ENTER_with_name("study_chunk"); + SAVEFREESV(data.substrs[0].str); + SAVEFREESV(data.substrs[1].str); + SAVEFREESV(data.last_found); + first = scan; + if (!RExC_rxi->regstclass) { + ssc_init(pRExC_state, &ch_class); + data.start_class = &ch_class; + stclass_flag = SCF_DO_STCLASS_AND; + } else /* XXXX Check for BOUND? */ + stclass_flag = 0; + data.last_closep = &last_close; DEBUG_RExC_seen(); /* * MAIN ENTRY FOR study_chunk() FOR m/PATTERN/ * (NO top level branches) */ - minlen = study_chunk(pRExC_state, &first, &minlen, &fake, + minlen = study_chunk(pRExC_state, &first, &minlen, &fake, scan + RExC_size, /* Up to end */ &data, -1, 0, NULL, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag @@ -8218,15 +8218,15 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk")); - if ( RExC_total_parens == 1 && !data.cur_is_floating - && data.last_start_min == 0 && data.last_end > 0 - && !RExC_seen_zerolen + if ( RExC_total_parens == 1 && !data.cur_is_floating + && data.last_start_min == 0 && data.last_end > 0 + && !RExC_seen_zerolen && !(RExC_seen & REG_VERBARG_SEEN) && !(RExC_seen & REG_GPOS_SEEN) ){ - RExC_rx->extflags |= RXf_CHECK_ALL; + RExC_rx->extflags |= RXf_CHECK_ALL; } - scan_commit(pRExC_state, &data,&minlen, 0); + scan_commit(pRExC_state, &data,&minlen, 0); /* XXX this is done in reverse order because that's the way the @@ -8263,39 +8263,39 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, } } - LEAVE_with_name("study_chunk"); + LEAVE_with_name("study_chunk"); - if (RExC_rxi->regstclass - && (OP(RExC_rxi->regstclass) == REG_ANY || OP(RExC_rxi->regstclass) == SANY)) - RExC_rxi->regstclass = NULL; + if (RExC_rxi->regstclass + && (OP(RExC_rxi->regstclass) == REG_ANY || OP(RExC_rxi->regstclass) == SANY)) + RExC_rxi->regstclass = NULL; - if ((!(RExC_rx->substrs->data[0].substr || RExC_rx->substrs->data[0].utf8_substr) + if ((!(RExC_rx->substrs->data[0].substr || RExC_rx->substrs->data[0].utf8_substr) || RExC_rx->substrs->data[0].min_offset) - && stclass_flag + && stclass_flag && ! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING) - && is_ssc_worth_it(pRExC_state, data.start_class)) - { - const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); + && is_ssc_worth_it(pRExC_state, data.start_class)) + { + const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); ssc_finalize(pRExC_state, data.start_class); - Newx(RExC_rxi->data->data[n], 1, regnode_ssc); - StructCopy(data.start_class, - (regnode_ssc*)RExC_rxi->data->data[n], - regnode_ssc); - RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; - RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ - DEBUG_COMPILE_r({ SV *sv = sv_newmortal(); + Newx(RExC_rxi->data->data[n], 1, regnode_ssc); + StructCopy(data.start_class, + (regnode_ssc*)RExC_rxi->data->data[n], + regnode_ssc); + RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; + RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ + DEBUG_COMPILE_r({ SV *sv = sv_newmortal(); regprop(RExC_rx, sv, (regnode*)data.start_class, NULL, pRExC_state); Perl_re_printf( aTHX_ - "synthetic stclass \"%s\".\n", - SvPVX_const(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); data.start_class = NULL; - } + } /* A temporary algorithm prefers floated substr to fixed one of * same length to dig more info. */ - i = (longest_length[0] <= longest_length[1]); + i = (longest_length[0] <= longest_length[1]); RExC_rx->substrs->check_ix = i; RExC_rx->check_end_shift = RExC_rx->substrs->data[i].end_shift; RExC_rx->check_substr = RExC_rx->substrs->data[i].substr; @@ -8305,38 +8305,38 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if (!i && (RExC_rx->intflags & (PREGf_ANCH_SBOL|PREGf_ANCH_GPOS))) RExC_rx->intflags |= PREGf_NOSCAN; - if ((RExC_rx->check_substr || RExC_rx->check_utf8) ) { - RExC_rx->extflags |= RXf_USE_INTUIT; - if (SvTAIL(RExC_rx->check_substr ? RExC_rx->check_substr : RExC_rx->check_utf8)) - RExC_rx->extflags |= RXf_INTUIT_TAIL; - } + if ((RExC_rx->check_substr || RExC_rx->check_utf8) ) { + RExC_rx->extflags |= RXf_USE_INTUIT; + if (SvTAIL(RExC_rx->check_substr ? RExC_rx->check_substr : RExC_rx->check_utf8)) + RExC_rx->extflags |= RXf_INTUIT_TAIL; + } - /* XXX Unneeded? dmq (shouldn't as this is handled elsewhere) - if ( (STRLEN)minlen < longest_length[1] ) + /* XXX Unneeded? dmq (shouldn't as this is handled elsewhere) + if ( (STRLEN)minlen < longest_length[1] ) minlen= longest_length[1]; if ( (STRLEN)minlen < longest_length[0] ) minlen= longest_length[0]; */ } else { - /* Several toplevels. Best we can is to set minlen. */ - SSize_t fake; - regnode_ssc ch_class; - SSize_t last_close = 0; + /* Several toplevels. Best we can is to set minlen. */ + SSize_t fake; + regnode_ssc ch_class; + SSize_t last_close = 0; DEBUG_PARSE_r(Perl_re_printf( aTHX_ "\nMulti Top Level\n")); - scan = RExC_rxi->program + 1; - ssc_init(pRExC_state, &ch_class); - data.start_class = &ch_class; - data.last_closep = &last_close; + scan = RExC_rxi->program + 1; + ssc_init(pRExC_state, &ch_class); + data.start_class = &ch_class; + data.last_closep = &last_close; DEBUG_RExC_seen(); /* * MAIN ENTRY FOR study_chunk() FOR m/P1|P2|.../ * (patterns WITH top level branches) */ - minlen = study_chunk(pRExC_state, + minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size, &data, -1, 0, NULL, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied ? SCF_TRIE_DOING_RESTUDY @@ -8345,7 +8345,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, CHECK_RESTUDY_GOTO_butfirst(NOOP); - RExC_rx->check_substr = NULL; + RExC_rx->check_substr = NULL; RExC_rx->check_utf8 = NULL; RExC_rx->substrs->data[0].substr = NULL; RExC_rx->substrs->data[0].utf8_substr = NULL; @@ -8353,25 +8353,25 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_rx->substrs->data[1].utf8_substr = NULL; if (! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING) - && is_ssc_worth_it(pRExC_state, data.start_class)) + && is_ssc_worth_it(pRExC_state, data.start_class)) { - const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); + const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); ssc_finalize(pRExC_state, data.start_class); - Newx(RExC_rxi->data->data[n], 1, regnode_ssc); - StructCopy(data.start_class, - (regnode_ssc*)RExC_rxi->data->data[n], - regnode_ssc); - RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; - RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ - DEBUG_COMPILE_r({ SV* sv = sv_newmortal(); + Newx(RExC_rxi->data->data[n], 1, regnode_ssc); + StructCopy(data.start_class, + (regnode_ssc*)RExC_rxi->data->data[n], + regnode_ssc); + RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; + RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ + DEBUG_COMPILE_r({ SV* sv = sv_newmortal(); regprop(RExC_rx, sv, (regnode*)data.start_class, NULL, pRExC_state); Perl_re_printf( aTHX_ - "synthetic stclass \"%s\".\n", - SvPVX_const(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); data.start_class = NULL; - } + } } if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) { @@ -8402,16 +8402,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_rx->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the lookbehind */ if (pRExC_state->code_blocks) - RExC_rx->extflags |= RXf_EVAL_SEEN; + RExC_rx->extflags |= RXf_EVAL_SEEN; if (RExC_seen & REG_VERBARG_SEEN) { - RExC_rx->intflags |= PREGf_VERBARG_SEEN; + RExC_rx->intflags |= PREGf_VERBARG_SEEN; RExC_rx->extflags |= RXf_NO_INPLACE_SUBST; /* don't understand this! Yves */ } if (RExC_seen & REG_CUTGROUP_SEEN) - RExC_rx->intflags |= PREGf_CUTGROUP_SEEN; + RExC_rx->intflags |= PREGf_CUTGROUP_SEEN; if (pm_flags & PMf_USE_RE_EVAL) - RExC_rx->intflags |= PREGf_USE_RE_EVAL; + RExC_rx->intflags |= PREGf_USE_RE_EVAL; if (RExC_paren_names) RXp_PAREN_NAMES(RExC_rx) = MUTABLE_HV(SvREFCNT_inc(RExC_paren_names)); else @@ -8567,7 +8567,7 @@ Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey, SV* Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv, - const U32 flags) + const U32 flags) { SV *ret; struct regexp *const rx = ReANY(r); @@ -8616,9 +8616,9 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, if (flags & RXapif_ALL) { return hv_exists_ent(RXp_PAREN_NAMES(rx), key, 0); } else { - SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); + SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); if (sv) { - SvREFCNT_dec_NN(sv); + SvREFCNT_dec_NN(sv); return TRUE; } else { return FALSE; @@ -8637,11 +8637,11 @@ Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags) PERL_ARGS_ASSERT_REG_NAMED_BUFF_FIRSTKEY; if ( rx && RXp_PAREN_NAMES(rx) ) { - (void)hv_iterinit(RXp_PAREN_NAMES(rx)); + (void)hv_iterinit(RXp_PAREN_NAMES(rx)); - return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY); + return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY); } else { - return FALSE; + return FALSE; } } @@ -8671,7 +8671,7 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags) } } if (parno || flags & RXapif_ALL) { - return newSVhek(HeKEY_hek(temphe)); + return newSVhek(HeKEY_hek(temphe)); } } } @@ -8695,7 +8695,7 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES)); av = MUTABLE_AV(SvRV(ret)); length = av_count(av); - SvREFCNT_dec_NN(ret); + SvREFCNT_dec_NN(ret); return newSViv(length); } else { Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", @@ -8743,7 +8743,7 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags) void Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, - SV * const sv) + SV * const sv) { struct regexp *const rx = ReANY(r); char *s = NULL; @@ -8782,16 +8782,16 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, && rx->offs[0].start != -1) { /* $`, ${^PREMATCH} */ - i = rx->offs[0].start; - s = rx->subbeg; + i = rx->offs[0].start; + s = rx->subbeg; } else if ((n == RX_BUFF_IDX_POSTMATCH || n == RX_BUFF_IDX_CARET_POSTMATCH) && rx->offs[0].end != -1) { /* $', ${^POSTMATCH} */ - s = rx->subbeg - rx->suboffset + rx->offs[0].end; - i = rx->sublen + rx->suboffset - rx->offs[0].end; + s = rx->subbeg - rx->suboffset + rx->offs[0].end; + i = rx->sublen + rx->suboffset - rx->offs[0].end; } else if (inRANGE(n, 0, (I32)rx->nparens) && @@ -8848,7 +8848,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, void Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, - SV const * const value) + SV const * const value) { PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_STORE; @@ -8893,32 +8893,32 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv, case RX_BUFF_IDX_CARET_PREMATCH: /* ${^PREMATCH} */ case RX_BUFF_IDX_PREMATCH: /* $` */ if (rx->offs[0].start != -1) { - i = rx->offs[0].start; - if (i > 0) { - s1 = 0; - t1 = i; - goto getlen; - } - } + i = rx->offs[0].start; + if (i > 0) { + s1 = 0; + t1 = i; + goto getlen; + } + } return 0; case RX_BUFF_IDX_CARET_POSTMATCH: /* ${^POSTMATCH} */ case RX_BUFF_IDX_POSTMATCH: /* $' */ - if (rx->offs[0].end != -1) { - i = rx->sublen - rx->offs[0].end; - if (i > 0) { - s1 = rx->offs[0].end; - t1 = rx->sublen; - goto getlen; - } - } + if (rx->offs[0].end != -1) { + i = rx->sublen - rx->offs[0].end; + if (i > 0) { + s1 = rx->offs[0].end; + t1 = rx->sublen; + goto getlen; + } + } return 0; default: /* $& / ${^MATCH}, $1, $2, ... */ - if (paren <= (I32)rx->nparens && + if (paren <= (I32)rx->nparens && (s1 = rx->offs[paren].start) != -1 && (t1 = rx->offs[paren].end) != -1) - { + { i = t1 - s1; goto getlen; } else { @@ -8945,11 +8945,11 @@ SV* Perl_reg_qr_package(pTHX_ REGEXP * const rx) { PERL_ARGS_ASSERT_REG_QR_PACKAGE; - PERL_UNUSED_ARG(rx); - if (0) - return NULL; - else - return newSVpvs("Regexp"); + PERL_UNUSED_ARG(rx); + if (0) + return NULL; + else + return newSVpvs("Regexp"); } /* Scans the name of a named buffer from the pattern. @@ -8977,22 +8977,22 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) else if (isIDFIRST_lazy_if_safe(RExC_parse, RExC_end, UTF)) { /* Note that the code here assumes well-formed UTF-8. Skip IDFIRST by * using do...while */ - if (UTF) - do { - RExC_parse += UTF8SKIP(RExC_parse); - } while ( RExC_parse < RExC_end + if (UTF) + do { + RExC_parse += UTF8SKIP(RExC_parse); + } while ( RExC_parse < RExC_end && isWORDCHAR_utf8_safe((U8*)RExC_parse, (U8*) RExC_end)); - else - do { - RExC_parse++; - } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse)); + else + do { + RExC_parse++; + } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse)); } else { RExC_parse++; /* so the <- from the vFAIL is after the offending character */ vFAIL("Group name must start with a non-digit word character"); } sv_name = newSVpvn_flags(name_start, (int)(RExC_parse - name_start), - SVs_TEMP | (UTF ? SVf_UTF8 : 0)); + SVs_TEMP | (UTF ? SVf_UTF8 : 0)); if ( flags == REG_RSN_RETURN_NAME) return sv_name; else if (flags==REG_RSN_RETURN_DATA) { @@ -9312,7 +9312,7 @@ Perl__new_invlist(pTHX_ IV initial_size) SV* new_list; if (initial_size < 0) { - initial_size = 10; + initial_size = 10; } new_list = newSV_type(SVt_INVLIST); @@ -9358,7 +9358,7 @@ Perl__new_invlist_C_array(pTHX_ const UV* const list) SvPV_set(invlist, (char *) (list + HEADER_LENGTH)); SvLEN_set(invlist, 0); /* Means we own the contents, and the system - shouldn't touch it */ + shouldn't touch it */ *(get_invlist_offset_addr(invlist)) = offset; @@ -9398,39 +9398,39 @@ S__append_range_to_invlist(pTHX_ SV* const invlist, array = _invlist_array_init(invlist, ! offset); } else { - /* Here, the existing list is non-empty. The current max entry in the - * list is generally the first value not in the set, except when the - * set extends to the end of permissible values, in which case it is - * the first entry in that final set, and so this call is an attempt to - * append out-of-order */ - - UV final_element = len - 1; - array = invlist_array(invlist); - if ( array[final_element] > start - || ELEMENT_RANGE_MATCHES_INVLIST(final_element)) - { - Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%" UVuf ", start=%" UVuf ", match=%c", - array[final_element], start, - ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f'); - } + /* Here, the existing list is non-empty. The current max entry in the + * list is generally the first value not in the set, except when the + * set extends to the end of permissible values, in which case it is + * the first entry in that final set, and so this call is an attempt to + * append out-of-order */ + + UV final_element = len - 1; + array = invlist_array(invlist); + if ( array[final_element] > start + || ELEMENT_RANGE_MATCHES_INVLIST(final_element)) + { + Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%" UVuf ", start=%" UVuf ", match=%c", + array[final_element], start, + ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f'); + } /* Here, it is a legal append. If the new range begins 1 above the end * of the range below it, it is extending the range below it, so the * new first value not in the set is one greater than the newly * extended range. */ offset = *get_invlist_offset_addr(invlist); - if (array[final_element] == start) { - if (end != UV_MAX) { - array[final_element] = end + 1; - } - else { - /* But if the end is the maximum representable on the machine, + if (array[final_element] == start) { + if (end != UV_MAX) { + array[final_element] = end + 1; + } + else { + /* But if the end is the maximum representable on the machine, * assume that infinity was actually what was meant. Just let * the range that this would extend to have no end */ - invlist_set_len(invlist, len - 1, offset); - } - return; - } + invlist_set_len(invlist, len - 1, offset); + } + return; + } } /* Here the new range doesn't extend any existing set. Add it */ @@ -9440,27 +9440,27 @@ S__append_range_to_invlist(pTHX_ SV* const invlist, /* If wll overflow the existing space, extend, which may cause the array to * be moved */ if (max < len) { - invlist_extend(invlist, len); + invlist_extend(invlist, len); /* Have to set len here to avoid assert failure in invlist_array() */ invlist_set_len(invlist, len, offset); - array = invlist_array(invlist); + array = invlist_array(invlist); } else { - invlist_set_len(invlist, len, offset); + invlist_set_len(invlist, len, offset); } /* The next item on the list starts the range, the one after that is * one past the new range. */ array[len - 2] = start; if (end != UV_MAX) { - array[len - 1] = end + 1; + array[len - 1] = end + 1; } else { - /* But if the end is the maximum representable on the machine, just let - * the range have no end */ - invlist_set_len(invlist, len - 1, offset); + /* But if the end is the maximum representable on the machine, just let + * the range have no end */ + invlist_set_len(invlist, len - 1, offset); } } @@ -9484,7 +9484,7 @@ Perl__invlist_search(SV* const invlist, const UV cp) /* If list is empty, return failure. */ if (high == 0) { - return -1; + return -1; } /* (We can't get the array unless we know the list is non-empty) */ @@ -9535,20 +9535,20 @@ Perl__invlist_search(SV* const invlist, const UV cp) * The loop below converges on the i+1. Note that there may not be an * (i+1)th element in the array, and things work nonetheless */ while (low < high) { - mid = (low + high) / 2; + mid = (low + high) / 2; assert(mid <= highest_element); - if (array[mid] <= cp) { /* cp >= array[mid] */ - low = mid + 1; + if (array[mid] <= cp) { /* cp >= array[mid] */ + low = mid + 1; - /* We could do this extra test to exit the loop early. - if (cp < array[low]) { - return mid; - } - */ - } - else { /* cp < array[mid] */ - high = mid; - } + /* We could do this extra test to exit the loop early. + if (cp < array[low]) { + return mid; + } + */ + } + else { /* cp < array[mid] */ + high = mid; + } } found_entry: @@ -9681,7 +9681,7 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, SvREFCNT_dec_NN(u); } - return; + return; } /* Here both lists exist and are non-empty */ @@ -9692,8 +9692,8 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * up so are looking at b's complement. */ if (complement_b) { - /* To complement, we invert: if the first element is 0, remove it. To - * do this, we just pretend the array starts one later */ + /* To complement, we invert: if the first element is 0, remove it. To + * do this, we just pretend the array starts one later */ if (array_b[0] == 0) { array_b++; len_b--; @@ -9718,11 +9718,11 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* Go through each input list item by item, stopping when have exhausted * one of them */ while (i_a < len_a && i_b < len_b) { - UV cp; /* The element to potentially add to the union's array */ - bool cp_in_set; /* is it in the input list's set or not */ + UV cp; /* The element to potentially add to the union's array */ + bool cp_in_set; /* is it in the input list's set or not */ - /* We need to take one or the other of the two inputs for the union. - * Since we are merging two sorted lists, we take the smaller of the + /* We need to take one or the other of the two inputs for the union. + * Since we are merging two sorted lists, we take the smaller of the * next items. In case of a tie, we take first the one that is in its * set. If we first took the one not in its set, it would decrement * the count, possibly to 0 which would cause it to be output as ending @@ -9732,33 +9732,33 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * momentarily decremented to 0, and thus the two adjoining ranges will * be seamlessly merged. (In a tie and both are in the set or both not * in the set, it doesn't matter which we take first.) */ - if ( array_a[i_a] < array_b[i_b] - || ( array_a[i_a] == array_b[i_b] - && ELEMENT_RANGE_MATCHES_INVLIST(i_a))) - { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); - cp = array_a[i_a++]; - } - else { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); - cp = array_b[i_b++]; - } - - /* Here, have chosen which of the two inputs to look at. Only output - * if the running count changes to/from 0, which marks the - * beginning/end of a range that's in the set */ - if (cp_in_set) { - if (count == 0) { - array_u[i_u++] = cp; - } - count++; - } - else { - count--; - if (count == 0) { - array_u[i_u++] = cp; - } - } + if ( array_a[i_a] < array_b[i_b] + || ( array_a[i_a] == array_b[i_b] + && ELEMENT_RANGE_MATCHES_INVLIST(i_a))) + { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); + cp = array_a[i_a++]; + } + else { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); + cp = array_b[i_b++]; + } + + /* Here, have chosen which of the two inputs to look at. Only output + * if the running count changes to/from 0, which marks the + * beginning/end of a range that's in the set */ + if (cp_in_set) { + if (count == 0) { + array_u[i_u++] = cp; + } + count++; + } + else { + count--; + if (count == 0) { + array_u[i_u++] = cp; + } + } } @@ -9769,9 +9769,9 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * that list is in its set. (i_a and i_b each currently index the element * beyond the one we care about.) */ if ( (i_a != len_a && PREV_RANGE_MATCHES_INVLIST(i_a)) - || (i_b != len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) + || (i_b != len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) { - count--; + count--; } /* Above we decremented 'count' if the list that had unexamined elements in @@ -9801,11 +9801,11 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, else { IV copy_count = len_a - i_a; if (copy_count > 0) { /* The non-exhausted input is 'a' */ - Copy(array_a + i_a, array_u + i_u, copy_count, UV); + Copy(array_a + i_a, array_u + i_u, copy_count, UV); } else { /* The non-exhausted input is b */ copy_count = len_b - i_b; - Copy(array_b + i_b, array_u + i_u, copy_count, UV); + Copy(array_b + i_b, array_u + i_u, copy_count, UV); } len_u = i_u + copy_count; } @@ -9814,9 +9814,9 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * array_u, so re-find it. (Note that it is unlikely that this will * change, as we are shrinking the space, not enlarging it) */ if (len_u != _invlist_len(u)) { - invlist_set_len(u, len_u, *get_invlist_offset_addr(u)); - invlist_trim(u); - array_u = invlist_array(u); + invlist_set_len(u, len_u, *get_invlist_offset_addr(u)); + invlist_trim(u); + array_u = invlist_array(u); } if (*output == NULL) { /* Simply return the new inversion list */ @@ -9914,7 +9914,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, } invlist_clear(*i); - return; + return; } /* Here both lists exist and are non-empty */ @@ -9925,8 +9925,8 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * up so are looking at b's complement. */ if (complement_b) { - /* To complement, we invert: if the first element is 0, remove it. To - * do this, we just pretend the array starts one later */ + /* To complement, we invert: if the first element is 0, remove it. To + * do this, we just pretend the array starts one later */ if (array_b[0] == 0) { array_b++; len_b--; @@ -9951,12 +9951,12 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* Go through each list item by item, stopping when have exhausted one of * them */ while (i_a < len_a && i_b < len_b) { - UV cp; /* The element to potentially add to the intersection's - array */ - bool cp_in_set; /* Is it in the input list's set or not */ + UV cp; /* The element to potentially add to the intersection's + array */ + bool cp_in_set; /* Is it in the input list's set or not */ - /* We need to take one or the other of the two inputs for the - * intersection. Since we are merging two sorted lists, we take the + /* We need to take one or the other of the two inputs for the + * intersection. Since we are merging two sorted lists, we take the * smaller of the next items. In case of a tie, we take first the one * that is not in its set (a difference from the union algorithm). If * we first took the one in its set, it would increment the count, @@ -9966,33 +9966,33 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * opposite of this, there is no possibility that the count will be * momentarily incremented to 2. (In a tie and both are in the set or * both not in the set, it doesn't matter which we take first.) */ - if ( array_a[i_a] < array_b[i_b] - || ( array_a[i_a] == array_b[i_b] - && ! ELEMENT_RANGE_MATCHES_INVLIST(i_a))) - { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); - cp = array_a[i_a++]; - } - else { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); - cp= array_b[i_b++]; - } - - /* Here, have chosen which of the two inputs to look at. Only output - * if the running count changes to/from 2, which marks the - * beginning/end of a range that's in the intersection */ - if (cp_in_set) { - count++; - if (count == 2) { - array_r[i_r++] = cp; - } - } - else { - if (count == 2) { - array_r[i_r++] = cp; - } - count--; - } + if ( array_a[i_a] < array_b[i_b] + || ( array_a[i_a] == array_b[i_b] + && ! ELEMENT_RANGE_MATCHES_INVLIST(i_a))) + { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); + cp = array_a[i_a++]; + } + else { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); + cp= array_b[i_b++]; + } + + /* Here, have chosen which of the two inputs to look at. Only output + * if the running count changes to/from 2, which marks the + * beginning/end of a range that's in the intersection */ + if (cp_in_set) { + count++; + if (count == 2) { + array_r[i_r++] = cp; + } + } + else { + if (count == 2) { + array_r[i_r++] = cp; + } + count--; + } } @@ -10005,7 +10005,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, if ( (i_a == len_a && PREV_RANGE_MATCHES_INVLIST(i_a)) || (i_b == len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) { - count++; + count++; } /* Above we incremented 'count' if the exhausted list was in its set. This @@ -10035,11 +10035,11 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, else { /* copy the non-exhausted list, unchanged. */ IV copy_count = len_a - i_a; if (copy_count > 0) { /* a is the one with stuff left */ - Copy(array_a + i_a, array_r + i_r, copy_count, UV); + Copy(array_a + i_a, array_r + i_r, copy_count, UV); } else { /* b is the one with stuff left */ copy_count = len_b - i_b; - Copy(array_b + i_b, array_r + i_r, copy_count, UV); + Copy(array_b + i_b, array_r + i_r, copy_count, UV); } len_r = i_r + copy_count; } @@ -10048,9 +10048,9 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * array_r, so re-find it. (Note that it is unlikely that this will * change, as we are shrinking the space, not enlarging it) */ if (len_r != _invlist_len(r)) { - invlist_set_len(r, len_r, *get_invlist_offset_addr(r)); - invlist_trim(r); - array_r = invlist_array(r); + invlist_set_len(r, len_r, *get_invlist_offset_addr(r)); + invlist_trim(r); + array_r = invlist_array(r); } if (*i == NULL) { /* Simply return the calculated intersection */ @@ -10099,7 +10099,7 @@ Perl__add_range_to_invlist(pTHX_ SV* invlist, UV start, UV end) /* This range becomes the whole inversion list if none already existed */ if (invlist == NULL) { - invlist = _new_invlist(2); + invlist = _new_invlist(2); _append_range_to_invlist(invlist, start, end); return invlist; } @@ -10378,8 +10378,8 @@ Perl__invlist_invert(pTHX_ SV* const invlist) /* The inverse of matching nothing is matching everything */ if (_invlist_len(invlist) == 0) { - _append_range_to_invlist(invlist, 0, UV_MAX); - return; + _append_range_to_invlist(invlist, 0, UV_MAX); + return; } *get_invlist_offset_addr(invlist) = ! *get_invlist_offset_addr(invlist); @@ -10463,21 +10463,21 @@ S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style) invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { - if (end == UV_MAX) { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%cINFTY%c", + if (end == UV_MAX) { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%cINFTY%c", start, intra_range_delimiter, inter_range_delimiter); - } - else if (end != start) { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c%04" UVXf "%c", - start, + } + else if (end != start) { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c%04" UVXf "%c", + start, intra_range_delimiter, end, inter_range_delimiter); - } - else { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c", + } + else { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c", start, inter_range_delimiter); - } + } } if (SvCUR(output) && ! traditional_style) {/* Get rid of trailing blank */ @@ -10520,20 +10520,20 @@ Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { - if (end == UV_MAX) { - Perl_dump_indent(aTHX_ level, file, + if (end == UV_MAX) { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf " .. INFTY\n", indent, (UV)count, start); - } - else if (end != start) { - Perl_dump_indent(aTHX_ level, file, + } + else if (end != start) { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf " .. 0x%04" UVXf "\n", - indent, (UV)count, start, end); - } - else { - Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf "\n", + indent, (UV)count, start, end); + } + else { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf "\n", indent, (UV)count, start); - } + } count += 2; } } @@ -10939,7 +10939,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) : WASTED_G; if (! (wastedflags & wflagbit) ) { wastedflags |= wflagbit; - /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ vWARN5( RExC_parse + 1, "Useless (%s%c) - %suse /%c modifier", @@ -10959,7 +10959,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) if (ckWARN(WARN_REGEXP)) { if (! (wastedflags & WASTED_C) ) { wastedflags |= WASTED_GC; - /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ vWARN3( RExC_parse + 1, "Useless (%sc) - %suse /gc modifier", @@ -11020,7 +11020,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) default: fail_modifiers: RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); - /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f("Sequence (%" UTF8f "...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); NOT_REACHED; /*NOTREACHED*/ @@ -11171,7 +11171,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) && *(RExC_parse - 1) != '('; if (RExC_parse >= RExC_end) { - vFAIL("Unmatched ("); + vFAIL("Unmatched ("); } if (paren == 'r') { /* Atomic script run */ @@ -11179,10 +11179,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) goto parse_rest; } else if ( *RExC_parse == '*') { /* (*VERB:ARG), (*construct:...) */ - char *start_verb = RExC_parse + 1; - STRLEN verb_len; - char *start_arg = NULL; - unsigned char op = 0; + char *start_verb = RExC_parse + 1; + STRLEN verb_len; + char *start_arg = NULL; + unsigned char op = 0; int arg_required = 0; int internal_argval = -1; /* if >-1 we are not allowed an argument*/ bool has_upper = FALSE; @@ -11199,11 +11199,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("In '(*...)', the '(' and '*' must be adjacent"); } } - while (RExC_parse < RExC_end && *RExC_parse != ')' ) { - if ( *RExC_parse == ':' ) { - start_arg = RExC_parse + 1; - break; - } + while (RExC_parse < RExC_end && *RExC_parse != ')' ) { + if ( *RExC_parse == ':' ) { + start_arg = RExC_parse + 1; + break; + } else if (! UTF) { if (isUPPER(*RExC_parse)) { has_upper = TRUE; @@ -11213,18 +11213,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) else { RExC_parse += UTF8SKIP(RExC_parse); } - } - verb_len = RExC_parse - start_verb; - if ( start_arg ) { + } + verb_len = RExC_parse - start_verb; + if ( start_arg ) { if (RExC_parse >= RExC_end) { goto unterminated_verb_pattern; } - RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; - while ( RExC_parse < RExC_end && *RExC_parse != ')' ) { + RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; + while ( RExC_parse < RExC_end && *RExC_parse != ')' ) { RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; } - if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { + if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { unterminated_verb_pattern: if (has_upper) { vFAIL("Unterminated verb pattern argument"); @@ -11233,8 +11233,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("Unterminated '(*...' argument"); } } - } else { - if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { + } else { + if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { if (has_upper) { vFAIL("Unterminated verb pattern"); } @@ -11242,29 +11242,29 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("Unterminated '(*...' construct"); } } - } + } /* Here, we know that RExC_parse < RExC_end */ - switch ( *start_verb ) { + switch ( *start_verb ) { case 'A': /* (*ACCEPT) */ if ( memEQs(start_verb, verb_len,"ACCEPT") ) { - op = ACCEPT; - internal_argval = RExC_nestroot; - } - break; + op = ACCEPT; + internal_argval = RExC_nestroot; + } + break; case 'C': /* (*COMMIT) */ if ( memEQs(start_verb, verb_len,"COMMIT") ) op = COMMIT; break; case 'F': /* (*FAIL) */ if ( verb_len==1 || memEQs(start_verb, verb_len,"FAIL") ) { - op = OPFAIL; - } - break; + op = OPFAIL; + } + break; case ':': /* (*:NAME) */ - case 'M': /* (*MARK:NAME) */ - if ( verb_len==0 || memEQs(start_verb, verb_len,"MARK") ) { + case 'M': /* (*MARK:NAME) */ + if ( verb_len==0 || memEQs(start_verb, verb_len,"MARK") ) { op = MARKPOINT; arg_required = 1; } @@ -11421,7 +11421,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret=reganode(pRExC_state, OPFAIL, 0); nextchar(pRExC_state); return ret; - } + } RExC_parse = start_arg; goto parse_rest; @@ -11430,11 +11430,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL2utf8f( "'(*%" UTF8f "' requires a terminating ':'", UTF8fARG(UTF, verb_len, start_verb)); - NOT_REACHED; /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ - } /* End of switch */ - if ( ! op ) { - RExC_parse += UTF + } /* End of switch */ + if ( ! op ) { + RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; if (has_upper || verb_len == 0) { @@ -11447,7 +11447,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) "Unknown '(*...)' construct '%" UTF8f "'", UTF8fARG(UTF, verb_len, start_verb)); } - } + } if ( RExC_parse == start_arg ) { start_arg = NULL; } @@ -11473,12 +11473,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } if ( internal_argval != -1 ) ARG2L_SET(REGNODE_p(ret), internal_argval); - nextchar(pRExC_state); - return ret; + nextchar(pRExC_state); + return ret; } else if (*RExC_parse == '?') { /* (?...) */ - bool is_logical = 0; - const char * const seqstart = RExC_parse; + bool is_logical = 0; + const char * const seqstart = RExC_parse; const char * endptr; const char non_existent_group_msg[] = "Reference to nonexistent group"; @@ -11489,24 +11489,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("In '(?...)', the '(' and '?' must be adjacent"); } - RExC_parse++; /* past the '?' */ + RExC_parse++; /* past the '?' */ paren = *RExC_parse; /* might be a trailing NUL, if not well-formed */ RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; if (RExC_parse > RExC_end) { paren = '\0'; } - ret = 0; /* For look-ahead/behind. */ - switch (paren) { + ret = 0; /* For look-ahead/behind. */ + switch (paren) { - case 'P': /* (?P...) variants for those used to PCRE/Python */ - paren = *RExC_parse; - if ( paren == '<') { /* (?P<...>) named capture */ + case 'P': /* (?P...) variants for those used to PCRE/Python */ + paren = *RExC_parse; + if ( paren == '<') { /* (?P<...>) named capture */ RExC_parse++; if (RExC_parse >= RExC_end) { vFAIL("Sequence (?P<... not terminated"); } - goto named_capture; + goto named_capture; } else if (paren == '>') { /* (?P>name) named recursion */ RExC_parse++; @@ -11522,33 +11522,33 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ - vFAIL3("Sequence (%.*s...) not recognized", + vFAIL3("Sequence (%.*s...) not recognized", (int) (RExC_parse - seqstart), seqstart); - NOT_REACHED; /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ case '<': /* (?<...) */ /* If you want to support (?<*...), first reconcile with GH #17363 */ - if (*RExC_parse == '!') - paren = ','; - else if (*RExC_parse != '=') + if (*RExC_parse == '!') + paren = ','; + else if (*RExC_parse != '=') named_capture: - { /* (?<...>) */ - char *name_start; - SV *svname; - paren= '>'; + { /* (?<...>) */ + char *name_start; + SV *svname; + paren= '>'; /* FALLTHROUGH */ case '\'': /* (?'...') */ name_start = RExC_parse; svname = reg_scan_name(pRExC_state, REG_RSN_RETURN_NAME); - if ( RExC_parse == name_start + if ( RExC_parse == name_start || RExC_parse >= RExC_end || *RExC_parse != paren) { - vFAIL2("Sequence (?%c... not terminated", - paren=='>' ? '<' : (char) paren); + vFAIL2("Sequence (?%c... not terminated", + paren=='>' ? '<' : (char) paren); } - { - HE *he_str; - SV *sv_dat = NULL; + { + HE *he_str; + SV *sv_dat = NULL; if (!svname) /* shouldn't happen */ Perl_croak(aTHX_ "panic: reg_scan_name returned NULL"); @@ -11607,56 +11607,56 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) /*sv_dump(sv_dat);*/ } nextchar(pRExC_state); - paren = 1; - goto capturing_parens; - } + paren = 1; + goto capturing_parens; + } RExC_seen |= REG_LOOKBEHIND_SEEN; - RExC_in_lookaround++; - RExC_parse++; + RExC_in_lookaround++; + RExC_parse++; if (RExC_parse >= RExC_end) { vFAIL("Sequence (?... not terminated"); } RExC_seen_zerolen++; break; - case '=': /* (?=...) */ - RExC_seen_zerolen++; + case '=': /* (?=...) */ + RExC_seen_zerolen++; RExC_in_lookaround++; break; - case '!': /* (?!...) */ - RExC_seen_zerolen++; - /* check if we're really just a "FAIL" assertion */ + case '!': /* (?!...) */ + RExC_seen_zerolen++; + /* check if we're really just a "FAIL" assertion */ skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); - if (*RExC_parse == ')') { + if (*RExC_parse == ')') { ret=reganode(pRExC_state, OPFAIL, 0); - nextchar(pRExC_state); - return ret; - } + nextchar(pRExC_state); + return ret; + } RExC_in_lookaround++; - break; - case '|': /* (?|...) */ - /* branch reset, behave like a (?:...) except that - buffers in alternations share the same numbers */ - paren = ':'; - after_freeze = freeze_paren = RExC_npar; + break; + case '|': /* (?|...) */ + /* branch reset, behave like a (?:...) except that + buffers in alternations share the same numbers */ + paren = ':'; + after_freeze = freeze_paren = RExC_npar; /* XXX This construct currently requires an extra pass. * Investigation would be required to see if that could be * changed */ REQUIRE_PARENS_PASS; - break; - case ':': /* (?:...) */ - case '>': /* (?>...) */ - break; - case '$': /* (?$...) */ - case '@': /* (?@...) */ - vFAIL2("Sequence (?%c...) not implemented", (int)paren); - break; - case '0' : /* (?0) */ - case 'R' : /* (?R) */ + break; + case ':': /* (?:...) */ + case '>': /* (?>...) */ + break; + case '$': /* (?$...) */ + case '@': /* (?@...) */ + vFAIL2("Sequence (?%c...) not implemented", (int)paren); + break; + case '0' : /* (?0) */ + case 'R' : /* (?R) */ if (RExC_parse == RExC_end || *RExC_parse != ')') - FAIL("Sequence (?R) not terminated"); + FAIL("Sequence (?R) not terminated"); num = 0; RExC_seen |= REG_RECURSE_SEEN; @@ -11664,9 +11664,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) * It probably could be changed */ REQUIRE_PARENS_PASS; - *flagp |= POSTPONED; + *flagp |= POSTPONED; goto gen_recurse_regop; - /*notreached*/ + /*notreached*/ /* named and numeric backreferences */ case '&': /* (?&NAME) */ parse_start = RExC_parse - 1; @@ -11694,8 +11694,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '1': case '2': case '3': case '4': /* (?1) */ - case '5': case '6': case '7': case '8': case '9': - RExC_parse = (char *) seqstart + 1; /* Point to the digit */ + case '5': case '6': case '7': case '8': case '9': + RExC_parse = (char *) seqstart + 1; /* Point to the digit */ parse_recursion: { bool is_neg = FALSE; @@ -11725,8 +11725,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) num = -num; } } - if (*RExC_parse!=')') - vFAIL("Expecting close bracket"); + if (*RExC_parse!=')') + vFAIL("Expecting close bracket"); gen_recurse_regop: if (paren == '-' || paren == '+') { @@ -11801,7 +11801,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), 1 + regarglen[OP(REGNODE_p(ret))]); /* MJD */ - Set_Node_Offset(REGNODE_p(ret), parse_start); /* MJD */ + Set_Node_Offset(REGNODE_p(ret), parse_start); /* MJD */ *flagp |= POSTPONED; assert(*RExC_parse == ')'); @@ -11810,43 +11810,43 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) /* NOTREACHED */ - case '?': /* (??...) */ - is_logical = 1; - if (*RExC_parse != '{') { + case '?': /* (??...) */ + is_logical = 1; + if (*RExC_parse != '{') { RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f( "Sequence (%" UTF8f "...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); - NOT_REACHED; /*NOTREACHED*/ - } - *flagp |= POSTPONED; - paren = '{'; + NOT_REACHED; /*NOTREACHED*/ + } + *flagp |= POSTPONED; + paren = '{'; RExC_parse++; - /* FALLTHROUGH */ - case '{': /* (?{...}) */ - { - U32 n = 0; - struct reg_code_block *cb; + /* FALLTHROUGH */ + case '{': /* (?{...}) */ + { + U32 n = 0; + struct reg_code_block *cb; OP * o; - RExC_seen_zerolen++; + RExC_seen_zerolen++; - if ( !pRExC_state->code_blocks - || pRExC_state->code_index + if ( !pRExC_state->code_blocks + || pRExC_state->code_index >= pRExC_state->code_blocks->count - || pRExC_state->code_blocks->cb[pRExC_state->code_index].start - != (STRLEN)((RExC_parse -3 - (is_logical ? 1 : 0)) - - RExC_start) - ) { - if (RExC_pm_flags & PMf_USE_RE_EVAL) - FAIL("panic: Sequence (?{...}): no code block found\n"); - FAIL("Eval-group not allowed at runtime, use re 'eval'"); - } - /* this is a pre-compiled code block (?{...}) */ - cb = &pRExC_state->code_blocks->cb[pRExC_state->code_index]; - RExC_parse = RExC_start + cb->end; - o = cb->block; + || pRExC_state->code_blocks->cb[pRExC_state->code_index].start + != (STRLEN)((RExC_parse -3 - (is_logical ? 1 : 0)) + - RExC_start) + ) { + if (RExC_pm_flags & PMf_USE_RE_EVAL) + FAIL("panic: Sequence (?{...}): no code block found\n"); + FAIL("Eval-group not allowed at runtime, use re 'eval'"); + } + /* this is a pre-compiled code block (?{...}) */ + cb = &pRExC_state->code_blocks->cb[pRExC_state->code_index]; + RExC_parse = RExC_start + cb->end; + o = cb->block; if (cb->src_regex) { n = add_data(pRExC_state, STR_WITH_LEN("rl")); RExC_rxi->data->data[n] = @@ -11858,12 +11858,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) (RExC_pm_flags & PMf_HAS_CV) ? "L" : "l", 1); RExC_rxi->data->data[n] = (void*)o; } - pRExC_state->code_index++; - nextchar(pRExC_state); + pRExC_state->code_index++; + nextchar(pRExC_state); - if (is_logical) { + if (is_logical) { regnode_offset eval; - ret = reg_node(pRExC_state, LOGICAL); + ret = reg_node(pRExC_state, LOGICAL); eval = reg2Lanode(pRExC_state, EVAL, n, @@ -11877,24 +11877,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) REQUIRE_BRANCHJ(flagp, 0); } /* deal with the length of this later - MJD */ - return ret; - } - ret = reg2Lanode(pRExC_state, EVAL, n, 0); - Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); - Set_Node_Offset(REGNODE_p(ret), parse_start); - return ret; - } - case '(': /* (?(?{...})...) and (?(?=...)...) */ - { - int is_define= 0; + return ret; + } + ret = reg2Lanode(pRExC_state, EVAL, n, 0); + Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); + Set_Node_Offset(REGNODE_p(ret), parse_start); + return ret; + } + case '(': /* (?(?{...})...) and (?(?=...)...) */ + { + int is_define= 0; const int DEFINE_len = sizeof("DEFINE") - 1; - if ( RExC_parse < RExC_end - 1 + if ( RExC_parse < RExC_end - 1 && ( ( RExC_parse[0] == '?' /* (?(?...)) */ && ( RExC_parse[1] == '=' || RExC_parse[1] == '!' || RExC_parse[1] == '<' || RExC_parse[1] == '{')) - || ( RExC_parse[0] == '*' /* (?(*...)) */ + || ( RExC_parse[0] == '*' /* (?(*...)) */ && ( memBEGINs(RExC_parse + 1, (Size_t) (RExC_end - (RExC_parse + 1)), "pla:") @@ -11933,14 +11933,14 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } goto insert_if; } - else if ( RExC_parse[0] == '<' /* (?()...) */ - || RExC_parse[0] == '\'' ) /* (?('NAME')...) */ - { - char ch = RExC_parse[0] == '<' ? '>' : '\''; - char *name_start= RExC_parse++; - U32 num = 0; - SV *sv_dat=reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); - if ( RExC_parse == name_start + else if ( RExC_parse[0] == '<' /* (?()...) */ + || RExC_parse[0] == '\'' ) /* (?('NAME')...) */ + { + char ch = RExC_parse[0] == '<' ? '>' : '\''; + char *name_start= RExC_parse++; + U32 num = 0; + SV *sv_dat=reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); + if ( RExC_parse == name_start || RExC_parse >= RExC_end || *RExC_parse != ch) { @@ -11955,23 +11955,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } ret = reganode(pRExC_state, GROUPPN, num); goto insert_if_check_paren; - } - else if (memBEGINs(RExC_parse, + } + else if (memBEGINs(RExC_parse, (STRLEN) (RExC_end - RExC_parse), "DEFINE")) { - ret = reganode(pRExC_state, DEFINEP, 0); - RExC_parse += DEFINE_len; - is_define = 1; - goto insert_if_check_paren; - } - else if (RExC_parse[0] == 'R') { - RExC_parse++; + ret = reganode(pRExC_state, DEFINEP, 0); + RExC_parse += DEFINE_len; + is_define = 1; + goto insert_if_check_paren; + } + else if (RExC_parse[0] == 'R') { + RExC_parse++; /* parno == 0 => /(?(R)YES|NO)/ "in any form of recursion OR eval" * parno == 1 => /(?(R0)YES|NO)/ "in GOSUB (?0) / (?R)" * parno == 2 => /(?(R1)YES|NO)/ "in GOSUB (?1) (parno-1)" */ - parno = 0; + parno = 0; if (RExC_parse[0] == '0') { parno = 1; RExC_parse++; @@ -11986,20 +11986,20 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) RExC_parse = (char*)endptr; } /* else "Switch condition not recognized" below */ - } else if (RExC_parse[0] == '&') { - SV *sv_dat; - RExC_parse++; - sv_dat = reg_scan_name(pRExC_state, + } else if (RExC_parse[0] == '&') { + SV *sv_dat; + RExC_parse++; + sv_dat = reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); if (sv_dat) parno = 1 + *((I32 *)SvPVX(sv_dat)); - } - ret = reganode(pRExC_state, INSUBP, parno); - goto insert_if_check_paren; - } + } + ret = reganode(pRExC_state, INSUBP, parno); + goto insert_if_check_paren; + } else if (inRANGE(RExC_parse[0], '1', '9')) { /* (?(1)...) */ - char c; + char c; UV uv; endptr = RExC_end; if (grok_atoUV(RExC_parse, &uv, &endptr) @@ -12014,21 +12014,21 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret = reganode(pRExC_state, GROUPP, parno); insert_if_check_paren: - if (UCHARAT(RExC_parse) != ')') { + if (UCHARAT(RExC_parse) != ')') { RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; - vFAIL("Switch condition not recognized"); - } - nextchar(pRExC_state); - insert_if: + vFAIL("Switch condition not recognized"); + } + nextchar(pRExC_state); + insert_if: if (! REGTAIL(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0))) { REQUIRE_BRANCHJ(flagp, 0); } br = regbranch(pRExC_state, &flags, 1, depth+1); - if (br == 0) { + if (br == 0) { RETURN_FAIL_ON_RESTART(flags,flagp); FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); @@ -12038,13 +12038,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) { REQUIRE_BRANCHJ(flagp, 0); } - c = UCHARAT(RExC_parse); + c = UCHARAT(RExC_parse); nextchar(pRExC_state); - if (flags&HASWIDTH) - *flagp |= HASWIDTH; - if (c == '|') { - if (is_define) - vFAIL("(?(DEFINE)....) does not allow branches"); + if (flags&HASWIDTH) + *flagp |= HASWIDTH; + if (c == '|') { + if (is_define) + vFAIL("(?(DEFINE)....) does not allow branches"); /* Fake one for optimizer. */ lastbr = reganode(pRExC_state, IFTHEN, 0); @@ -12057,24 +12057,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) if (! REGTAIL(pRExC_state, ret, lastbr)) { REQUIRE_BRANCHJ(flagp, 0); } - if (flags&HASWIDTH) - *flagp |= HASWIDTH; + if (flags&HASWIDTH) + *flagp |= HASWIDTH; c = UCHARAT(RExC_parse); nextchar(pRExC_state); - } - else - lastbr = 0; + } + else + lastbr = 0; if (c != ')') { if (RExC_parse >= RExC_end) vFAIL("Switch (?(condition)... not terminated"); else vFAIL("Switch (?(condition)... contains too many branches"); } - ender = reg_node(pRExC_state, TAIL); + ender = reg_node(pRExC_state, TAIL); if (! REGTAIL(pRExC_state, br, ender)) { REQUIRE_BRANCHJ(flagp, 0); } - if (lastbr) { + if (lastbr) { if (! REGTAIL(pRExC_state, lastbr, ender)) { REQUIRE_BRANCHJ(flagp, 0); } @@ -12086,8 +12086,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) { REQUIRE_BRANCHJ(flagp, 0); } - } - else + } + else if (! REGTAIL(pRExC_state, ret, ender)) { REQUIRE_BRANCHJ(flagp, 0); } @@ -12096,18 +12096,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) For large programs it seems to be required but I can't figure out why. -- dmq*/ #endif - return ret; - } + return ret; + } RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; vFAIL("Unknown switch condition (?(...))"); - } - case '[': /* (?[ ... ]) */ + } + case '[': /* (?[ ... ]) */ return handle_regex_sets(pRExC_state, NULL, flagp, depth+1, oregcomp_parse); case 0: /* A NUL */ - RExC_parse--; /* for vFAIL to print correctly */ + RExC_parse--; /* for vFAIL to print correctly */ vFAIL("Sequence (? incomplete"); break; @@ -12117,11 +12117,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '*': /* If you want to support (?*...), first reconcile with GH #17363 */ - /* FALLTHROUGH */ - default: /* e.g., (?i) */ - RExC_parse = (char *) seqstart + 1; + /* FALLTHROUGH */ + default: /* e.g., (?i) */ + RExC_parse = (char *) seqstart + 1; parse_flags: - parse_lparen_question_flags(pRExC_state); + parse_lparen_question_flags(pRExC_state); if (UCHARAT(RExC_parse) != ':') { if (RExC_parse < RExC_end) nextchar(pRExC_state); @@ -12133,11 +12133,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret = 0; goto parse_rest; } /* end switch */ - } + } else if (!(RExC_flags & RXf_PMf_NOCAPTURE)) { /* (...) */ - capturing_parens: - parno = RExC_npar; - RExC_npar++; + capturing_parens: + parno = RExC_npar; + RExC_npar++; if (! ALL_PARENS_COUNTED) { /* If we are in our first pass through (and maybe only pass), * we need to allocate memory for the capturing parentheses @@ -12182,7 +12182,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } } - ret = reganode(pRExC_state, OPEN, parno); + ret = reganode(pRExC_state, OPEN, parno); if (!RExC_nestroot) RExC_nestroot = parno; if (RExC_open_parens && !RExC_open_parens[parno]) @@ -12196,15 +12196,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ Set_Node_Offset(REGNODE_p(ret), RExC_parse); /* MJD */ - is_open = 1; - } else { + is_open = 1; + } else { /* with RXf_PMf_NOCAPTURE treat (...) as (?:...) */ paren = ':'; - ret = 0; + ret = 0; } } else /* ! paren */ - ret = 0; + ret = 0; parse_rest: /* Pick up the branches, linking them together. */ @@ -12218,18 +12218,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); } if (*RExC_parse == '|') { - if (RExC_use_BRANCHJ) { - reginsert(pRExC_state, BRANCHJ, br, depth+1); - } - else { /* MJD */ - reginsert(pRExC_state, BRANCH, br, depth+1); + if (RExC_use_BRANCHJ) { + reginsert(pRExC_state, BRANCHJ, br, depth+1); + } + else { /* MJD */ + reginsert(pRExC_state, BRANCH, br, depth+1); Set_Node_Length(REGNODE_p(br), paren != 0); Set_Node_Offset_To_R(br, parse_start-RExC_start); } - have_branch = 1; + have_branch = 1; } else if (paren == ':') { - *flagp |= flags&SIMPLE; + *flagp |= flags&SIMPLE; } if (is_open) { /* Starts with OPEN. */ if (! REGTAIL(pRExC_state, ret, br)) { /* OPEN -> first. */ @@ -12237,82 +12237,82 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } } else if (paren != '?') /* Not Conditional */ - ret = br; + ret = br; *flagp |= flags & (HASWIDTH | POSTPONED); lastbr = br; while (*RExC_parse == '|') { - if (RExC_use_BRANCHJ) { + if (RExC_use_BRANCHJ) { bool shut_gcc_up; - ender = reganode(pRExC_state, LONGJMP, 0); + ender = reganode(pRExC_state, LONGJMP, 0); /* Append to the previous. */ shut_gcc_up = REGTAIL(pRExC_state, REGNODE_OFFSET(NEXTOPER(NEXTOPER(REGNODE_p(lastbr)))), ender); PERL_UNUSED_VAR(shut_gcc_up); - } - nextchar(pRExC_state); - if (freeze_paren) { - if (RExC_npar > after_freeze) - after_freeze = RExC_npar; + } + nextchar(pRExC_state); + if (freeze_paren) { + if (RExC_npar > after_freeze) + after_freeze = RExC_npar; RExC_npar = freeze_paren; } br = regbranch(pRExC_state, &flags, 0, depth+1); - if (br == 0) { + if (br == 0) { RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); } if (! REGTAIL(pRExC_state, lastbr, br)) { /* BRANCH -> BRANCH. */ REQUIRE_BRANCHJ(flagp, 0); } - lastbr = br; - *flagp |= flags & (HASWIDTH | POSTPONED); + lastbr = br; + *flagp |= flags & (HASWIDTH | POSTPONED); } if (have_branch || paren != ':') { regnode * br; - /* Make a closing node, and hook it on the end. */ - switch (paren) { - case ':': - ender = reg_node(pRExC_state, TAIL); - break; - case 1: case 2: - ender = reganode(pRExC_state, CLOSE, parno); + /* Make a closing node, and hook it on the end. */ + switch (paren) { + case ':': + ender = reg_node(pRExC_state, TAIL); + break; + case 1: case 2: + ender = reganode(pRExC_state, CLOSE, parno); if ( RExC_close_parens ) { DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_ "%*s%*s Setting close paren #%" IVdf " to %zu\n", 22, "| |", (int)(depth * 2 + 1), "", (IV)parno, ender)); RExC_close_parens[parno]= ender; - if (RExC_nestroot == parno) - RExC_nestroot = 0; - } + if (RExC_nestroot == parno) + RExC_nestroot = 0; + } Set_Node_Offset(REGNODE_p(ender), RExC_parse+1); /* MJD */ Set_Node_Length(REGNODE_p(ender), 1); /* MJD */ - break; - case 's': - ender = reg_node(pRExC_state, SRCLOSE); + break; + case 's': + ender = reg_node(pRExC_state, SRCLOSE); RExC_in_script_run = 0; - break; - case '<': + break; + case '<': case 'a': case 'A': case 'b': case 'B': - case ',': - case '=': - case '!': - *flagp &= ~HASWIDTH; - /* FALLTHROUGH */ + case ',': + case '=': + case '!': + *flagp &= ~HASWIDTH; + /* FALLTHROUGH */ case 't': /* aTomic */ - case '>': - ender = reg_node(pRExC_state, SUCCEED); - break; - case 0: - ender = reg_node(pRExC_state, END); + case '>': + ender = reg_node(pRExC_state, SUCCEED); + break; + case 0: + ender = reg_node(pRExC_state, END); assert(!RExC_end_op); /* there can only be one! */ RExC_end_op = REGNODE_p(ender); if (RExC_close_parens) { @@ -12323,8 +12323,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) RExC_close_parens[0]= ender; } - break; - } + break; + } DEBUG_PARSE_r({ DEBUG_PARSE_MSG("lsbr"); regprop(RExC_rx, RExC_mysv1, REGNODE_p(lastbr), NULL, pRExC_state); @@ -12341,15 +12341,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) REQUIRE_BRANCHJ(flagp, 0); } - if (have_branch) { + if (have_branch) { char is_nothing= 1; - if (depth==1) + if (depth==1) RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN; - /* Hook the tails of the branches to the closing node. */ - for (br = REGNODE_p(ret); br; br = regnext(br)) { - const U8 op = PL_regkind[OP(br)]; - if (op == BRANCH) { + /* Hook the tails of the branches to the closing node. */ + for (br = REGNODE_p(ret); br; br = regnext(br)) { + const U8 op = PL_regkind[OP(br)]; + if (op == BRANCH) { if (! REGTAIL_STUDY(pRExC_state, REGNODE_OFFSET(NEXTOPER(br)), ender)) @@ -12359,8 +12359,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) if ( OP(NEXTOPER(br)) != NOTHING || regnext(NEXTOPER(br)) != REGNODE_p(ender)) is_nothing= 0; - } - else if (op == BRANCHJ) { + } + else if (op == BRANCHJ) { bool shut_gcc_up = REGTAIL_STUDY(pRExC_state, REGNODE_OFFSET(NEXTOPER(NEXTOPER(br))), ender); @@ -12370,8 +12370,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) || regnext(NEXTOPER(NEXTOPER(br))) != REGNODE_p(ender)) */ is_nothing= 0; - } - } + } + } if (is_nothing) { regnode * ret_as_regnode = REGNODE_p(ret); br= PL_regkind[OP(ret_as_regnode)] != BRANCH @@ -12402,7 +12402,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) NEXT_OFF(br)= REGNODE_p(ender) - br; } } - } + } } { @@ -12411,47 +12411,47 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) static const char parens[] = "=!aA<,>Bbt"; /* flag below is set to 0 up through 'A'; 1 for larger */ - if (paren && (p = strchr(parens, paren))) { - U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH; - int flag = (p - parens) > 3; + if (paren && (p = strchr(parens, paren))) { + U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH; + int flag = (p - parens) > 3; - if (paren == '>' || paren == 't') { - node = SUSPEND, flag = 0; + if (paren == '>' || paren == 't') { + node = SUSPEND, flag = 0; } - reginsert(pRExC_state, node, ret, depth+1); + reginsert(pRExC_state, node, ret, depth+1); Set_Node_Cur_Length(REGNODE_p(ret), parse_start); - Set_Node_Offset(REGNODE_p(ret), parse_start + 1); - FLAGS(REGNODE_p(ret)) = flag; + Set_Node_Offset(REGNODE_p(ret), parse_start + 1); + FLAGS(REGNODE_p(ret)) = flag; if (! REGTAIL_STUDY(pRExC_state, ret, reg_node(pRExC_state, TAIL))) { REQUIRE_BRANCHJ(flagp, 0); } - } + } } /* Check for proper termination. */ if (paren) { /* restore original flags, but keep (?p) and, if we've encountered * something in the parse that changes /d rules into /u, keep the /u */ - RExC_flags = oregflags | (RExC_flags & RXf_PMf_KEEPCOPY); + RExC_flags = oregflags | (RExC_flags & RXf_PMf_KEEPCOPY); if (DEPENDS_SEMANTICS && toUSE_UNI_CHARSET_NOT_DEPENDS) { set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); } - if (RExC_parse >= RExC_end || UCHARAT(RExC_parse) != ')') { - RExC_parse = oregcomp_parse; - vFAIL("Unmatched ("); - } - nextchar(pRExC_state); + if (RExC_parse >= RExC_end || UCHARAT(RExC_parse) != ')') { + RExC_parse = oregcomp_parse; + vFAIL("Unmatched ("); + } + nextchar(pRExC_state); } else if (!paren && RExC_parse < RExC_end) { - if (*RExC_parse == ')') { - RExC_parse++; - vFAIL("Unmatched )"); - } - else - FAIL("Junk on end of regexp"); /* "Can't happen". */ - NOT_REACHED; /* NOTREACHED */ + if (*RExC_parse == ')') { + RExC_parse++; + vFAIL("Unmatched )"); + } + else + FAIL("Junk on end of regexp"); /* "Can't happen". */ + NOT_REACHED; /* NOTREACHED */ } if (after_freeze > RExC_npar) @@ -12488,12 +12488,12 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) DEBUG_PARSE("brnc"); if (first) - ret = 0; + ret = 0; else { - if (RExC_use_BRANCHJ) - ret = reganode(pRExC_state, BRANCHJ, 0); - else { - ret = reg_node(pRExC_state, BRANCH); + if (RExC_use_BRANCHJ) + ret = reganode(pRExC_state, BRANCHJ, 0); + else { + ret = reg_node(pRExC_state, BRANCH); Set_Node_Length(REGNODE_p(ret), 1); } } @@ -12503,38 +12503,38 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') { - flags &= ~TRYAGAIN; + flags &= ~TRYAGAIN; latest = regpiece(pRExC_state, &flags, depth+1); - if (latest == 0) { - if (flags & TRYAGAIN) - continue; + if (latest == 0) { + if (flags & TRYAGAIN) + continue; RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: regpiece returned failure, flags=%#" UVxf, (UV) flags); - } - else if (ret == 0) + } + else if (ret == 0) ret = latest; - *flagp |= flags&(HASWIDTH|POSTPONED); - if (chain != 0) { - /* FIXME adding one for every branch after the first is probably - * excessive now we have TRIE support. (hv) */ - MARK_NAUGHTY(1); + *flagp |= flags&(HASWIDTH|POSTPONED); + if (chain != 0) { + /* FIXME adding one for every branch after the first is probably + * excessive now we have TRIE support. (hv) */ + MARK_NAUGHTY(1); if (! REGTAIL(pRExC_state, chain, latest)) { /* XXX We could just redo this branch, but figuring out what * bookkeeping needs to be reset is a pain, and it's likely * that other branches that goto END will also be too large */ REQUIRE_BRANCHJ(flagp, 0); } - } - chain = latest; - c++; + } + chain = latest; + c++; } if (chain == 0) { /* Loop ran zero times. */ - chain = reg_node(pRExC_state, NOTHING); - if (ret == 0) - ret = chain; + chain = reg_node(pRExC_state, NOTHING); + if (ret == 0) + ret = chain; } if (c == 1) { - *flagp |= flags&SIMPLE; + *flagp |= flags&SIMPLE; } return ret; @@ -12551,15 +12551,15 @@ Perl_regcurly(const char *s) PERL_ARGS_ASSERT_REGCURLY; if (*s++ != '{') - return FALSE; + return FALSE; if (!isDIGIT(*s)) - return FALSE; + return FALSE; while (isDIGIT(*s)) - s++; + s++; if (*s == ',') { - s++; - while (isDIGIT(*s)) - s++; + s++; + while (isDIGIT(*s)) + s++; } return *s == '}'; @@ -13351,7 +13351,7 @@ S_new_regcurly(const char *s, const char *e) PERL_ARGS_ASSERT_NEW_REGCURLY; if (s >= e || *s++ != '{') - return FALSE; + return FALSE; while (s < e && isSPACE(*s)) { s++; @@ -13365,7 +13365,7 @@ S_new_regcurly(const char *s, const char *e) } if (*s == ',') { - s++; + s++; while (s < e && isSPACE(*s)) { s++; } @@ -13423,36 +13423,36 @@ S_backref_value(char *p, char *e) A summary of the code structure is: switch (first_byte) { - cases for each special: - handle this special; - break; - case '\\': - switch (2nd byte) { - cases for each unambiguous special: - handle this special; - break; - cases for each ambigous special/literal: - disambiguate; - if (special) handle here - else goto defchar; - default: // unambiguously literal: - goto defchar; - } - default: // is a literal char - // FALL THROUGH - defchar: - create EXACTish node for literal; - while (more input and node isn't full) { - switch (input_byte) { - cases for each special; + cases for each special: + handle this special; + break; + case '\\': + switch (2nd byte) { + cases for each unambiguous special: + handle this special; + break; + cases for each ambigous special/literal: + disambiguate; + if (special) handle here + else goto defchar; + default: // unambiguously literal: + goto defchar; + } + default: // is a literal char + // FALL THROUGH + defchar: + create EXACTish node for literal; + while (more input and node isn't full) { + switch (input_byte) { + cases for each special; make sure parse pointer is set so that the next call to regatom will see this special first goto loopdone; // EXACTish node terminated by prev. char - default: - append char to EXACTISH node; - } - get next input byte; - } + default: + append char to EXACTISH node; + } + get next input byte; + } loopdone: } return the generated node; @@ -13486,37 +13486,37 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) assert(RExC_parse < RExC_end); switch ((U8)*RExC_parse) { case '^': - RExC_seen_zerolen++; - nextchar(pRExC_state); - if (RExC_flags & RXf_PMf_MULTILINE) - ret = reg_node(pRExC_state, MBOL); - else - ret = reg_node(pRExC_state, SBOL); + RExC_seen_zerolen++; + nextchar(pRExC_state); + if (RExC_flags & RXf_PMf_MULTILINE) + ret = reg_node(pRExC_state, MBOL); + else + ret = reg_node(pRExC_state, SBOL); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '$': - nextchar(pRExC_state); - if (*RExC_parse) - RExC_seen_zerolen++; - if (RExC_flags & RXf_PMf_MULTILINE) - ret = reg_node(pRExC_state, MEOL); - else - ret = reg_node(pRExC_state, SEOL); + nextchar(pRExC_state); + if (*RExC_parse) + RExC_seen_zerolen++; + if (RExC_flags & RXf_PMf_MULTILINE) + ret = reg_node(pRExC_state, MEOL); + else + ret = reg_node(pRExC_state, SEOL); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '.': - nextchar(pRExC_state); - if (RExC_flags & RXf_PMf_SINGLELINE) - ret = reg_node(pRExC_state, SANY); - else - ret = reg_node(pRExC_state, REG_ANY); - *flagp |= HASWIDTH|SIMPLE; - MARK_NAUGHTY(1); + nextchar(pRExC_state); + if (RExC_flags & RXf_PMf_SINGLELINE) + ret = reg_node(pRExC_state, SANY); + else + ret = reg_node(pRExC_state, REG_ANY); + *flagp |= HASWIDTH|SIMPLE; + MARK_NAUGHTY(1); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '[': { - char * const oregcomp_parse = ++RExC_parse; + char * const oregcomp_parse = ++RExC_parse; ret = regclass(pRExC_state, flagp, depth+1, FALSE, /* means parse the whole char class */ TRUE, /* allow multi-char folds */ @@ -13529,65 +13529,65 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) FAIL2("panic: regclass returned failure to regatom, flags=%#" UVxf, (UV) *flagp); } - if (*RExC_parse != ']') { - RExC_parse = oregcomp_parse; - vFAIL("Unmatched ["); - } - nextchar(pRExC_state); + if (*RExC_parse != ']') { + RExC_parse = oregcomp_parse; + vFAIL("Unmatched ["); + } + nextchar(pRExC_state); Set_Node_Length(REGNODE_p(ret), RExC_parse - oregcomp_parse + 1); /* MJD */ - break; + break; } case '(': - nextchar(pRExC_state); + nextchar(pRExC_state); ret = reg(pRExC_state, 2, &flags, depth+1); - if (ret == 0) { - if (flags & TRYAGAIN) { - if (RExC_parse >= RExC_end) { - /* Make parent create an empty node if needed. */ - *flagp |= TRYAGAIN; - return(0); - } - goto tryagain; - } + if (ret == 0) { + if (flags & TRYAGAIN) { + if (RExC_parse >= RExC_end) { + /* Make parent create an empty node if needed. */ + *flagp |= TRYAGAIN; + return(0); + } + goto tryagain; + } RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: reg returned failure to regatom, flags=%#" UVxf, (UV) flags); - } - *flagp |= flags&(HASWIDTH|SIMPLE|POSTPONED); - break; + } + *flagp |= flags&(HASWIDTH|SIMPLE|POSTPONED); + break; case '|': case ')': - if (flags & TRYAGAIN) { - *flagp |= TRYAGAIN; - return 0; - } - vFAIL("Internal urp"); - /* Supposed to be caught earlier. */ - break; + if (flags & TRYAGAIN) { + *flagp |= TRYAGAIN; + return 0; + } + vFAIL("Internal urp"); + /* Supposed to be caught earlier. */ + break; case '?': case '+': case '*': - RExC_parse++; - vFAIL("Quantifier follows nothing"); - break; + RExC_parse++; + vFAIL("Quantifier follows nothing"); + break; case '\\': - /* Special Escapes - - This switch handles escape sequences that resolve to some kind - of special regop and not to literal text. Escape sequences that - resolve to literal text are handled below in the switch marked - "Literal Escapes". - - Every entry in this switch *must* have a corresponding entry - in the literal escape switch. However, the opposite is not - required, as the default for this switch is to jump to the - literal text handling code. - */ - RExC_parse++; - switch ((U8)*RExC_parse) { - /* Special Escapes */ - case 'A': - RExC_seen_zerolen++; + /* Special Escapes + + This switch handles escape sequences that resolve to some kind + of special regop and not to literal text. Escape sequences that + resolve to literal text are handled below in the switch marked + "Literal Escapes". + + Every entry in this switch *must* have a corresponding entry + in the literal escape switch. However, the opposite is not + required, as the default for this switch is to jump to the + literal text handling code. + */ + RExC_parse++; + switch ((U8)*RExC_parse) { + /* Special Escapes */ + case 'A': + RExC_seen_zerolen++; /* Under wildcards, this is changed to match \n; should be * invisible to the user, as they have to compile under /m */ if (RExC_pm_flags & PMf_WILDCARD) { @@ -13599,8 +13599,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * /\A/ from /^/ in split. */ FLAGS(REGNODE_p(ret)) = 1; } - goto finish_meta_pat; - case 'G': + goto finish_meta_pat; + case 'G': if (RExC_pm_flags & PMf_WILDCARD) { RExC_parse++; /* diag_listed_as: Use of %s is not allowed in Unicode property @@ -13609,10 +13609,10 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL("Use of '\\G' is not allowed in Unicode property" " wildcard subpatterns"); } - ret = reg_node(pRExC_state, GPOS); + ret = reg_node(pRExC_state, GPOS); RExC_seen |= REG_GPOS_SEEN; - goto finish_meta_pat; - case 'K': + goto finish_meta_pat; + case 'K': if (!RExC_in_lookaround) { RExC_seen_zerolen++; ret = reg_node(pRExC_state, KEEPS); @@ -13627,7 +13627,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ++RExC_parse; /* advance past the 'K' */ vFAIL("\\K not permitted in lookahead/lookbehind"); } - case 'Z': + case 'Z': if (RExC_pm_flags & PMf_WILDCARD) { /* See comment under \A above */ ret = reg_node(pRExC_state, MEOL); @@ -13635,9 +13635,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { ret = reg_node(pRExC_state, SEOL); } - RExC_seen_zerolen++; /* Do not optimize RE away */ - goto finish_meta_pat; - case 'z': + RExC_seen_zerolen++; /* Do not optimize RE away */ + goto finish_meta_pat; + case 'z': if (RExC_pm_flags & PMf_WILDCARD) { /* See comment under \A above */ ret = reg_node(pRExC_state, MEOL); @@ -13645,28 +13645,28 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { ret = reg_node(pRExC_state, EOS); } - RExC_seen_zerolen++; /* Do not optimize RE away */ - goto finish_meta_pat; - case 'C': - vFAIL("\\C no longer supported"); - case 'X': - ret = reg_node(pRExC_state, CLUMP); - *flagp |= HASWIDTH; - goto finish_meta_pat; + RExC_seen_zerolen++; /* Do not optimize RE away */ + goto finish_meta_pat; + case 'C': + vFAIL("\\C no longer supported"); + case 'X': + ret = reg_node(pRExC_state, CLUMP); + *flagp |= HASWIDTH; + goto finish_meta_pat; - case 'B': + case 'B': invert = 1; /* FALLTHROUGH */ - case 'b': + case 'b': { U8 flags = 0; - regex_charset charset = get_regex_charset(RExC_flags); + regex_charset charset = get_regex_charset(RExC_flags); - RExC_seen_zerolen++; + RExC_seen_zerolen++; RExC_seen |= REG_LOOKBEHIND_SEEN; - op = BOUND + charset; + op = BOUND + charset; - if (RExC_parse >= RExC_end || *(RExC_parse + 1) != '{') { + if (RExC_parse >= RExC_end || *(RExC_parse + 1) != '{') { flags = TRADITIONAL_BOUND; if (op > BOUNDA) { /* /aa is same as /a */ op = BOUNDA; @@ -13726,9 +13726,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) default: bad_bound_type: RExC_parse = endbrace; - vFAIL2utf8f( + vFAIL2utf8f( "'%" UTF8f "' is an unknown bound type", - UTF8fARG(UTF, length, endbrace - length)); + UTF8fARG(UTF, length, endbrace - length)); NOT_REACHED; /*NOTREACHED*/ } RExC_parse = endbrace; @@ -13751,7 +13751,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ? ASCII_RESTRICT_PAT_MODS : ASCII_MORE_RESTRICT_PAT_MODS); } - } + } if (op == BOUND) { RExC_seen_d_op = TRUE; @@ -13764,29 +13764,29 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) op += NBOUND - BOUND; } - ret = reg_node(pRExC_state, op); + ret = reg_node(pRExC_state, op); FLAGS(REGNODE_p(ret)) = flags; - goto finish_meta_pat; + goto finish_meta_pat; } - case 'R': - ret = reg_node(pRExC_state, LNBREAK); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; - - case 'd': - case 'D': - case 'h': - case 'H': - case 'p': - case 'P': - case 's': - case 'S': - case 'v': - case 'V': - case 'w': - case 'W': + case 'R': + ret = reg_node(pRExC_state, LNBREAK); + *flagp |= HASWIDTH|SIMPLE; + goto finish_meta_pat; + + case 'd': + case 'D': + case 'h': + case 'H': + case 'p': + case 'P': + case 's': + case 'S': + case 'v': + case 'V': + case 'w': + case 'W': /* These all have the same meaning inside [brackets], and it knows * how to do the best optimizations for them. So, pretend we found * these within brackets, and let it do the work */ @@ -13824,7 +13824,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Offset(REGNODE_p(ret), parse_start); Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); /* MJD */ nextchar(pRExC_state); - break; + break; case 'N': /* Handle \N, \N{} and \N{NAMED SEQUENCE} (the latter meaning the * \N{...} evaluates to a sequence of more than one code points). @@ -13857,7 +13857,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) RExC_parse = parse_start; goto defchar; - case 'k': /* Handle \k and \k'NAME' */ + case 'k': /* Handle \k and \k'NAME' */ parse_named_seq: { char ch; @@ -13866,11 +13866,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) && ch != '\'' && ch != '{')) { - RExC_parse++; - /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */ - vFAIL2("Sequence %.2s... not terminated", parse_start); - } else { - RExC_parse += 2; + RExC_parse++; + /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */ + vFAIL2("Sequence %.2s... not terminated", parse_start); + } else { + RExC_parse += 2; ret = handle_named_backref(pRExC_state, flagp, parse_start, @@ -13881,30 +13881,30 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) : '\''); } break; - } - case 'g': - case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - { - I32 num; - bool hasbrace = 0; - - if (*RExC_parse == 'g') { + } + case 'g': + case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + { + I32 num; + bool hasbrace = 0; + + if (*RExC_parse == 'g') { bool isrel = 0; - RExC_parse++; - if (*RExC_parse == '{') { - RExC_parse++; - hasbrace = 1; - } - if (*RExC_parse == '-') { - RExC_parse++; - isrel = 1; - } - if (hasbrace && !isDIGIT(*RExC_parse)) { - if (isrel) RExC_parse--; + RExC_parse++; + if (*RExC_parse == '{') { + RExC_parse++; + hasbrace = 1; + } + if (*RExC_parse == '-') { + RExC_parse++; + isrel = 1; + } + if (hasbrace && !isDIGIT(*RExC_parse)) { + if (isrel) RExC_parse--; RExC_parse -= 2; - goto parse_named_seq; + goto parse_named_seq; } if (RExC_parse >= RExC_end) { @@ -13915,7 +13915,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL("Reference to invalid group 0"); else if (num == I32_MAX) { if (isDIGIT(*RExC_parse)) - vFAIL("Reference to nonexistent group"); + vFAIL("Reference to nonexistent group"); else unterminated_g: vFAIL("Unterminated \\g... pattern"); @@ -14001,48 +14001,48 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Cur_Length(REGNODE_p(ret), parse_start-1); skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); - } - break; - case '\0': - if (RExC_parse >= RExC_end) - FAIL("Trailing \\"); - /* FALLTHROUGH */ - default: - /* Do not generate "unrecognized" warnings here, we fall - back into the quick-grab loop below */ + } + break; + case '\0': + if (RExC_parse >= RExC_end) + FAIL("Trailing \\"); + /* FALLTHROUGH */ + default: + /* Do not generate "unrecognized" warnings here, we fall + back into the quick-grab loop below */ RExC_parse = parse_start; - goto defchar; - } /* end of switch on a \foo sequence */ - break; + goto defchar; + } /* end of switch on a \foo sequence */ + break; case '#': /* '#' comments should have been spaced over before this function was * called */ assert((RExC_flags & RXf_PMf_EXTENDED) == 0); - /* + /* if (RExC_flags & RXf_PMf_EXTENDED) { - RExC_parse = reg_skipcomment( pRExC_state, RExC_parse ); - if (RExC_parse < RExC_end) - goto tryagain; - } + RExC_parse = reg_skipcomment( pRExC_state, RExC_parse ); + if (RExC_parse < RExC_end) + goto tryagain; + } */ - /* FALLTHROUGH */ + /* FALLTHROUGH */ default: - defchar: { + defchar: { /* Here, we have determined that the next thing is probably a * literal character. RExC_parse points to the first byte of its * definition. (It still may be an escape sequence that evaluates * to a single character) */ - STRLEN len = 0; - UV ender = 0; - char *p; - char *s, *old_s = NULL, *old_old_s = NULL; - char *s0; + STRLEN len = 0; + UV ender = 0; + char *p; + char *s, *old_s = NULL, *old_old_s = NULL; + char *s0; U32 max_string_len = 255; /* We may have to reparse the node, artificially stopping filling @@ -14116,11 +14116,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) FILL_NODE(ret, node_type); RExC_emit++; - s = STRING(REGNODE_p(ret)); + s = STRING(REGNODE_p(ret)); s0 = s; - reparse: + reparse: p = RExC_parse; len = 0; @@ -14162,7 +14162,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * The exceptions override this */ Size_t added_len = 1; - oldp = p; + oldp = p; old_old_s = old_s; old_s = s; @@ -14170,62 +14170,62 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) assert( (RExC_flags & RXf_PMf_EXTENDED) == 0 || ! is_PATWS_safe((p), RExC_end, UTF)); - switch ((U8)*p) { + switch ((U8)*p) { const char* message; U32 packed_warn; U8 grok_c_char; - case '^': - case '$': - case '.': - case '[': - case '(': - case ')': - case '|': - goto loopdone; - case '\\': - /* Literal Escapes Switch - - This switch is meant to handle escape sequences that - resolve to a literal character. - - Every escape sequence that represents something - else, like an assertion or a char class, is handled - in the switch marked 'Special Escapes' above in this - routine, but also has an entry here as anything that - isn't explicitly mentioned here will be treated as - an unescaped equivalent literal. - */ - - switch ((U8)*++p) { - - /* These are all the special escapes. */ - case 'A': /* Start assertion */ - case 'b': case 'B': /* Word-boundary assertion*/ - case 'C': /* Single char !DANGEROUS! */ - case 'd': case 'D': /* digit class */ - case 'g': case 'G': /* generic-backref, pos assertion */ - case 'h': case 'H': /* HORIZWS */ - case 'k': case 'K': /* named backref, keep marker */ - case 'p': case 'P': /* Unicode property */ - case 'R': /* LNBREAK */ - case 's': case 'S': /* space class */ - case 'v': case 'V': /* VERTWS */ - case 'w': case 'W': /* word class */ + case '^': + case '$': + case '.': + case '[': + case '(': + case ')': + case '|': + goto loopdone; + case '\\': + /* Literal Escapes Switch + + This switch is meant to handle escape sequences that + resolve to a literal character. + + Every escape sequence that represents something + else, like an assertion or a char class, is handled + in the switch marked 'Special Escapes' above in this + routine, but also has an entry here as anything that + isn't explicitly mentioned here will be treated as + an unescaped equivalent literal. + */ + + switch ((U8)*++p) { + + /* These are all the special escapes. */ + case 'A': /* Start assertion */ + case 'b': case 'B': /* Word-boundary assertion*/ + case 'C': /* Single char !DANGEROUS! */ + case 'd': case 'D': /* digit class */ + case 'g': case 'G': /* generic-backref, pos assertion */ + case 'h': case 'H': /* HORIZWS */ + case 'k': case 'K': /* named backref, keep marker */ + case 'p': case 'P': /* Unicode property */ + case 'R': /* LNBREAK */ + case 's': case 'S': /* space class */ + case 'v': case 'V': /* VERTWS */ + case 'w': case 'W': /* word class */ case 'X': /* eXtended Unicode "combining character sequence" */ - case 'z': case 'Z': /* End of line/string assertion */ - --p; - goto loopdone; - - /* Anything after here is an escape that resolves to a - literal. (Except digits, which may or may not) - */ - case 'n': - ender = '\n'; - p++; - break; - case 'N': /* Handle a single-code point named character. */ + case 'z': case 'Z': /* End of line/string assertion */ + --p; + goto loopdone; + + /* Anything after here is an escape that resolves to a + literal. (Except digits, which may or may not) + */ + case 'n': + ender = '\n'; + p++; + break; + case 'N': /* Handle a single-code point named character. */ RExC_parse = p + 1; if (! grok_bslash_N(pRExC_state, NULL, /* Fail if evaluates to @@ -14269,27 +14269,27 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } break; - case 'r': - ender = '\r'; - p++; - break; - case 't': - ender = '\t'; - p++; - break; - case 'f': - ender = '\f'; - p++; - break; - case 'e': - ender = ESC_NATIVE; - p++; - break; - case 'a': - ender = '\a'; - p++; - break; - case 'o': + case 'r': + ender = '\r'; + p++; + break; + case 't': + ender = '\t'; + p++; + break; + case 'f': + ender = '\f'; + p++; + break; + case 'e': + ender = ESC_NATIVE; + p++; + break; + case 'a': + ender = '\a'; + p++; + break; + case 'o': if (! grok_bslash_o(&p, RExC_end, &ender, @@ -14308,7 +14308,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) warn_non_literal_string(p, packed_warn, message); } break; - case 'x': + case 'x': if (! grok_bslash_x(&p, RExC_end, &ender, @@ -14335,7 +14335,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } #endif break; - case 'c': + case 'c': p++; if (! grok_bslash_c(*p, &grok_c_char, &message, &packed_warn)) @@ -14354,7 +14354,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) warn_non_literal_string(p, packed_warn, message); } - break; + break; case '8': case '9': /* must be a backreference */ --p; /* we have an escape like \8 which cannot be an octal escape @@ -14362,7 +14362,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * escape which may or may not be a legitimate backref. */ goto loopdone; case '1': case '2': case '3':case '4': - case '5': case '6': case '7': + case '5': case '6': case '7': /* When we parse backslash escapes there is ambiguity * between backreferences and octal escapes. Any escape * from \1 - \9 is a backreference, any multi-digit @@ -14387,29 +14387,29 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '0': - { - I32 flags = PERL_SCAN_SILENT_ILLDIGIT + { + I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_NOTIFY_ILLDIGIT; - STRLEN numlen = 3; - ender = grok_oct(p, &numlen, &flags, NULL); - p += numlen; + STRLEN numlen = 3; + ender = grok_oct(p, &numlen, &flags, NULL); + p += numlen; if ( (flags & PERL_SCAN_NOTIFY_ILLDIGIT) && isDIGIT(*p) /* like \08, \178 */ && ckWARN(WARN_REGEXP)) { - reg_warn_non_literal_string( + reg_warn_non_literal_string( p + 1, form_alien_digit_msg(8, numlen, p, RExC_end, UTF, FALSE)); } - } - break; - case '\0': - if (p >= RExC_end) - FAIL("Trailing \\"); - /* FALLTHROUGH */ - default: - if (isALPHANUMERIC(*p)) { + } + break; + case '\0': + if (p >= RExC_end) + FAIL("Trailing \\"); + /* FALLTHROUGH */ + default: + if (isALPHANUMERIC(*p)) { /* An alpha followed by '{' is going to fail next * iteration, so don't output this warning in that * case */ @@ -14417,11 +14417,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ckWARN2reg(p + 1, "Unrecognized escape \\%.1s" " passed through", p); } - } - goto normal_default; - } /* End of switch on '\' */ - break; - case '{': + } + goto normal_default; + } /* End of switch on '\' */ + break; + case '{': /* Trying to gain new uses for '{' without breaking too * much existing code is hard. The solution currently * adopted is: @@ -14437,7 +14437,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * misspelled the quantifier. Without this warning, * the quantifier would silently be taken as a literal * string of characters instead of a meta construct */ - if (len || (p > RExC_start && isALPHA_A(*(p - 1)))) { + if (len || (p > RExC_start && isALPHA_A(*(p - 1)))) { if ( RExC_strict || ( p > parse_start + 1 && isALPHA_A(*(p - 1)) @@ -14450,28 +14450,28 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } ckWARNreg(p + 1, "Unescaped left brace in regex is" " passed through"); - } - goto normal_default; + } + goto normal_default; case '}': case ']': if (p > RExC_parse && RExC_strict) { ckWARN2reg(p + 1, "Unescaped literal '%c'", *p); } - /*FALLTHROUGH*/ - default: /* A literal character */ - normal_default: - if (! UTF8_IS_INVARIANT(*p) && UTF) { - STRLEN numlen; - ender = utf8n_to_uvchr((U8*)p, RExC_end - p, - &numlen, UTF8_ALLOW_DEFAULT); - p += numlen; - } - else - ender = (U8) *p++; - break; - } /* End of switch on the literal */ - - /* Here, have looked at the literal character, and + /*FALLTHROUGH*/ + default: /* A literal character */ + normal_default: + if (! UTF8_IS_INVARIANT(*p) && UTF) { + STRLEN numlen; + ender = utf8n_to_uvchr((U8*)p, RExC_end - p, + &numlen, UTF8_ALLOW_DEFAULT); + p += numlen; + } + else + ender = (U8) *p++; + break; + } /* End of switch on the literal */ + + /* Here, have looked at the literal character, and * contains its ordinal;

points to the character after it. * */ @@ -14733,20 +14733,20 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * requires UTF-8 to represent. */ : (char) toLOWER_L1(ender); } - } /* End of adding current character to the node */ + } /* End of adding current character to the node */ done_with_this_char: len += added_len; - if (next_is_quantifier) { + if (next_is_quantifier) { /* Here, the next input is a quantifier, and to get here, * the current character is the only one in the node. */ goto loopdone; - } + } - } /* End of loop through literal characters */ + } /* End of loop through literal characters */ /* Here we have either exhausted the input or run out of room in * the node. If the former, we are done. (If we encountered a @@ -15236,7 +15236,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Safefree(locfold_buf); Safefree(loc_correspondence); } - } /* End of verifying node ends with an appropriate char */ + } /* End of verifying node ends with an appropriate char */ /* We need to start the next node at the character that didn't fit * in this one */ @@ -15360,15 +15360,15 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), p - parse_start - 1); RExC_parse = p; - { - /* len is STRLEN which is unsigned, need to copy to signed */ - IV iv = len; - if (iv < 0) - vFAIL("Internal disaster"); - } + { + /* len is STRLEN which is unsigned, need to copy to signed */ + IV iv = len; + if (iv < 0) + vFAIL("Internal disaster"); + } - } /* End of label 'defchar:' */ - break; + } /* End of label 'defchar:' */ + break; } /* End of giant switch on input character */ /* Position parse to next real character */ @@ -15408,53 +15408,53 @@ S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr) ANYOF_BITMAP_ZERO(node); if (*invlist_ptr) { - /* This gets set if we actually need to modify things */ - bool change_invlist = FALSE; + /* This gets set if we actually need to modify things */ + bool change_invlist = FALSE; - UV start, end; + UV start, end; - /* Start looking through *invlist_ptr */ - invlist_iterinit(*invlist_ptr); - while (invlist_iternext(*invlist_ptr, &start, &end)) { - UV high; - int i; + /* Start looking through *invlist_ptr */ + invlist_iterinit(*invlist_ptr); + while (invlist_iternext(*invlist_ptr, &start, &end)) { + UV high; + int i; if (end == UV_MAX && start <= NUM_ANYOF_CODE_POINTS) { ANYOF_FLAGS(node) |= ANYOF_MATCHES_ALL_ABOVE_BITMAP; } - /* Quit if are above what we should change */ - if (start >= NUM_ANYOF_CODE_POINTS) { - break; - } + /* Quit if are above what we should change */ + if (start >= NUM_ANYOF_CODE_POINTS) { + break; + } - change_invlist = TRUE; + change_invlist = TRUE; - /* Set all the bits in the range, up to the max that we are doing */ - high = (end < NUM_ANYOF_CODE_POINTS - 1) + /* Set all the bits in the range, up to the max that we are doing */ + high = (end < NUM_ANYOF_CODE_POINTS - 1) ? end : NUM_ANYOF_CODE_POINTS - 1; - for (i = start; i <= (int) high; i++) { + for (i = start; i <= (int) high; i++) { ANYOF_BITMAP_SET(node, i); - } - } - invlist_iterfinish(*invlist_ptr); + } + } + invlist_iterfinish(*invlist_ptr); /* Done with loop; remove any code points that are in the bitmap from * *invlist_ptr; similarly for code points above the bitmap if we have * a flag to match all of them anyways */ - if (change_invlist) { - _invlist_subtract(*invlist_ptr, PL_InBitmap, invlist_ptr); - } + if (change_invlist) { + _invlist_subtract(*invlist_ptr, PL_InBitmap, invlist_ptr); + } if (ANYOF_FLAGS(node) & ANYOF_MATCHES_ALL_ABOVE_BITMAP) { - _invlist_intersection(*invlist_ptr, PL_InBitmap, invlist_ptr); - } + _invlist_intersection(*invlist_ptr, PL_InBitmap, invlist_ptr); + } - /* If have completely emptied it, remove it completely */ - if (_invlist_len(*invlist_ptr) == 0) { - SvREFCNT_dec_NN(*invlist_ptr); - *invlist_ptr = NULL; - } + /* If have completely emptied it, remove it completely */ + if (_invlist_len(*invlist_ptr) == 0) { + SvREFCNT_dec_NN(*invlist_ptr); + *invlist_ptr = NULL; + } } } @@ -16495,7 +16495,7 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, RExC_parse++; RExC_sets_depth++; - node = reg(pRExC_state, 2, flagp, depth+1); + node = reg(pRExC_state, 2, flagp, depth+1); RETURN_FAIL_ON_RESTART(*flagp, flagp); if ( OP(REGNODE_p(node)) != REGEX_SET @@ -17316,7 +17316,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, SV *listsv = NULL; /* List of \p{user-defined} whose definitions aren't available at the time this was called */ STRLEN initial_listsv_len = 0; /* Kind of a kludge to see if it is more - than just initialized. */ + than just initialized. */ SV* properties = NULL; /* Code points that match \p{} \P{} */ SV* posixes = NULL; /* Code points that match classes like [:word:], extended beyond the Latin1 range. These have to @@ -17333,7 +17333,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, leading to less compilation and execution work */ UV element_count = 0; /* Number of distinct elements in the class. - Optimizations may be possible if this is tiny */ + Optimizations may be possible if this is tiny */ AV * multi_char_matches = NULL; /* Code points that fold to more than one character; used under /i */ UV n; @@ -17436,7 +17436,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, assert(RExC_parse <= RExC_end); if (UCHARAT(RExC_parse) == '^') { /* Complement the class */ - RExC_parse++; + RExC_parse++; invert = TRUE; allow_mutiple_chars = FALSE; MARK_NAUGHTY(1); @@ -17471,7 +17471,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* allow 1st char to be ']' (allowing it to be '-' is dealt with later) */ if (UCHARAT(RExC_parse) == ']') - goto charclassloop; + goto charclassloop; while (1) { @@ -17499,23 +17499,23 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, charclassloop: - namedclass = OOB_NAMEDCLASS; /* initialize as illegal */ + namedclass = OOB_NAMEDCLASS; /* initialize as illegal */ save_value = value; save_prevvalue = prevvalue; - if (!range) { - rangebegin = RExC_parse; - element_count++; + if (!range) { + rangebegin = RExC_parse; + element_count++; non_portable_endpoint = 0; - } - if (UTF && ! UTF8_IS_INVARIANT(* RExC_parse)) { - value = utf8n_to_uvchr((U8*)RExC_parse, - RExC_end - RExC_parse, - &numlen, UTF8_ALLOW_DEFAULT); - RExC_parse += numlen; - } - else - value = UCHARAT(RExC_parse++); + } + if (UTF && ! UTF8_IS_INVARIANT(* RExC_parse)) { + value = utf8n_to_uvchr((U8*)RExC_parse, + RExC_end - RExC_parse, + &numlen, UTF8_ALLOW_DEFAULT); + RExC_parse += numlen; + } + else + value = UCHARAT(RExC_parse++); if (value == '[') { char * posix_class_end; @@ -17570,20 +17570,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, vFAIL("Unmatched ["); } - if (UTF && ! UTF8_IS_INVARIANT(UCHARAT(RExC_parse))) { - value = utf8n_to_uvchr((U8*)RExC_parse, - RExC_end - RExC_parse, - &numlen, UTF8_ALLOW_DEFAULT); - RExC_parse += numlen; - } - else - value = UCHARAT(RExC_parse++); + if (UTF && ! UTF8_IS_INVARIANT(UCHARAT(RExC_parse))) { + value = utf8n_to_uvchr((U8*)RExC_parse, + RExC_end - RExC_parse, + &numlen, UTF8_ALLOW_DEFAULT); + RExC_parse += numlen; + } + else + value = UCHARAT(RExC_parse++); - /* Some compilers cannot handle switching on 64-bit integer - * values, therefore value cannot be an UV. Yes, this will - * be a problem later if we want switch on Unicode. - * A similar issue a little bit later when switching on - * namedclass. --jhi */ + /* Some compilers cannot handle switching on 64-bit integer + * values, therefore value cannot be an UV. Yes, this will + * be a problem later if we want switch on Unicode. + * A similar issue a little bit later when switching on + * namedclass. --jhi */ /* If the \ is escaping white space when white space is being * skipped, it means that that white space is wanted literally, and @@ -17594,16 +17594,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, U32 packed_warn; U8 grok_c_char; - case 'w': namedclass = ANYOF_WORDCHAR; break; - case 'W': namedclass = ANYOF_NWORDCHAR; break; - case 's': namedclass = ANYOF_SPACE; break; - case 'S': namedclass = ANYOF_NSPACE; break; - case 'd': namedclass = ANYOF_DIGIT; break; - case 'D': namedclass = ANYOF_NDIGIT; break; - case 'v': namedclass = ANYOF_VERTWS; break; - case 'V': namedclass = ANYOF_NVERTWS; break; - case 'h': namedclass = ANYOF_HORIZWS; break; - case 'H': namedclass = ANYOF_NHORIZWS; break; + case 'w': namedclass = ANYOF_WORDCHAR; break; + case 'W': namedclass = ANYOF_NWORDCHAR; break; + case 's': namedclass = ANYOF_SPACE; break; + case 'S': namedclass = ANYOF_NSPACE; break; + case 'd': namedclass = ANYOF_DIGIT; break; + case 'D': namedclass = ANYOF_NDIGIT; break; + case 'v': namedclass = ANYOF_VERTWS; break; + case 'V': namedclass = ANYOF_NVERTWS; break; + case 'h': namedclass = ANYOF_HORIZWS; break; + case 'H': namedclass = ANYOF_NHORIZWS; break; case 'N': /* Handle \N{NAME} in class */ { const char * const backslash_N_beg = RExC_parse - 2; @@ -17670,10 +17670,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, unicode_range = TRUE; /* \N{} are Unicode */ } break; - case 'p': - case 'P': - { - char *e; + case 'p': + case 'P': + { + char *e; if (RExC_pm_flags & PMf_WILDCARD) { RExC_parse++; @@ -17684,14 +17684,14 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, " wildcard subpatterns", (char) value, *(RExC_parse - 1)); } - /* \p means they want Unicode semantics */ - REQUIRE_UNI_RULES(flagp, 0); + /* \p means they want Unicode semantics */ + REQUIRE_UNI_RULES(flagp, 0); - if (RExC_parse >= RExC_end) - vFAIL2("Empty \\%c", (U8)value); - if (*RExC_parse == '{') { - const U8 c = (U8)value; - e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); + if (RExC_parse >= RExC_end) + vFAIL2("Empty \\%c", (U8)value); + if (*RExC_parse == '{') { + const U8 c = (U8)value; + e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); if (!e) { RExC_parse++; vFAIL2("Missing right brace on \\%c{}", c); @@ -17703,9 +17703,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * any '^', even when not under /x */ while (isSPACE(*RExC_parse)) { RExC_parse++; - } + } - if (UCHARAT(RExC_parse) == '^') { + if (UCHARAT(RExC_parse) == '^') { /* toggle. (The rhs xor gets the single bit that * differs between P and p; the other xor inverts just @@ -17721,12 +17721,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (e == RExC_parse) vFAIL2("Empty \\%c{}", c); - n = e - RExC_parse; - while (isSPACE(*(RExC_parse + n - 1))) - n--; + n = e - RExC_parse; + while (isSPACE(*(RExC_parse + n - 1))) + n--; - } /* The \p isn't immediately followed by a '{' */ - else if (! isALPHA(*RExC_parse)) { + } /* The \p isn't immediately followed by a '{' */ + else if (! isALPHA(*RExC_parse)) { RExC_parse += (UTF) ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; @@ -17735,10 +17735,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, (U8) value); } else { - e = RExC_parse; - n = 1; - } - { + e = RExC_parse; + n = 1; + } + { char* name = RExC_parse; /* Any message returned about expanding the definition */ @@ -17771,7 +17771,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, mojibake */ RExC_utf8 = TRUE; } - /* diag_listed_as: Can't find Unicode property definition "%s" in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Can't find Unicode property definition "%s" in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f("%" UTF8f, UTF8fARG(SvUTF8(msg), SvCUR(msg), SvPVX(msg))); } @@ -17889,30 +17889,30 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* Invert if asking for the complement */ if (value == 'P') { - _invlist_union_complement_2nd(properties, + _invlist_union_complement_2nd(properties, prop_definition, &properties); } else { _invlist_union(properties, prop_definition, &properties); - } + } } } - RExC_parse = e + 1; + RExC_parse = e + 1; namedclass = ANYOF_UNIPROP; /* no official name, but it's named */ - } - break; - case 'n': value = '\n'; break; - case 'r': value = '\r'; break; - case 't': value = '\t'; break; - case 'f': value = '\f'; break; - case 'b': value = '\b'; break; - case 'e': value = ESC_NATIVE; break; - case 'a': value = '\a'; break; - case 'o': - RExC_parse--; /* function expects to be pointed at the 'o' */ + } + break; + case 'n': value = '\n'; break; + case 'r': value = '\r'; break; + case 't': value = '\t'; break; + case 'f': value = '\f'; break; + case 'b': value = '\b'; break; + case 'e': value = ESC_NATIVE; break; + case 'a': value = '\a'; break; + case 'o': + RExC_parse--; /* function expects to be pointed at the 'o' */ if (! grok_bslash_o(&RExC_parse, RExC_end, &value, @@ -17932,9 +17932,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - case 'x': - RExC_parse--; /* function expects to be pointed at the 'x' */ + break; + case 'x': + RExC_parse--; /* function expects to be pointed at the 'x' */ if (! grok_bslash_x(&RExC_parse, RExC_end, &value, @@ -17954,8 +17954,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - case 'c': + break; + case 'c': if (! grok_bslash_c(*RExC_parse, &grok_c_char, &message, &packed_warn)) { @@ -17974,16 +17974,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } non_portable_endpoint++; - break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - { - /* Take 1-3 octal digits */ - I32 flags = PERL_SCAN_SILENT_ILLDIGIT + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': + { + /* Take 1-3 octal digits */ + I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_NOTIFY_ILLDIGIT; numlen = (strict) ? 4 : 3; value = grok_oct(--RExC_parse, &numlen, &flags, NULL); - RExC_parse += numlen; + RExC_parse += numlen; if (numlen != 3) { if (strict) { RExC_parse += (UTF) @@ -18005,11 +18005,11 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - } - default: - /* Allow \_ to not give an error */ - if (isWORDCHAR(value) && value != '_') { + break; + } + default: + /* Allow \_ to not give an error */ + if (isWORDCHAR(value) && value != '_') { if (strict) { vFAIL2("Unrecognized escape \\%c in character class", (int)value); @@ -18019,20 +18019,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, "Unrecognized escape \\%c in character class passed through", (int)value); } - } - break; - } /* End of switch on char following backslash */ - } /* end of handling backslash escape sequences */ + } + break; + } /* End of switch on char following backslash */ + } /* end of handling backslash escape sequences */ /* Here, we have the current token in 'value' */ - if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */ + if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */ U8 classnum; - /* a bad range like a-\d, a-[:digit:]. The '-' is taken as a - * literal, as is the character that began the false range, i.e. - * the 'a' in the examples */ - if (range) { + /* a bad range like a-\d, a-[:digit:]. The '-' is taken as a + * literal, as is the character that began the false range, i.e. + * the 'a' in the examples */ + if (range) { const int w = (RExC_parse >= rangebegin) ? RExC_parse - rangebegin : 0; @@ -18050,13 +18050,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, prevvalue); } - range = 0; /* this was not a true range */ + range = 0; /* this was not a true range */ element_count += 2; /* So counts for three values */ - } + } classnum = namedclass_to_classnum(namedclass); - if (LOC && namedclass < ANYOF_POSIXL_MAX + if (LOC && namedclass < ANYOF_POSIXL_MAX #ifndef HAS_ISASCII && classnum != _CC_ASCII #endif @@ -18178,8 +18178,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, namedclass % 2 != 0, posixes_ptr); } - } - } /* end of namedclass \blah */ + } + } /* end of namedclass \blah */ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end); @@ -18192,20 +18192,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * the next real character to be processed is the range indicator--the * minus sign */ - if (range) { + if (range) { #ifdef EBCDIC /* For unicode ranges, we have to test that the Unicode as opposed * to the native values are not decreasing. (Above 255, there is * no difference between native and Unicode) */ - if (unicode_range && prevvalue < 255 && value < 255) { + if (unicode_range && prevvalue < 255 && value < 255) { if (NATIVE_TO_LATIN1(prevvalue) > NATIVE_TO_LATIN1(value)) { goto backwards_range; } } else #endif - if (prevvalue > value) /* b-a */ { - int w; + if (prevvalue > value) /* b-a */ { + int w; #ifdef EBCDIC backwards_range: #endif @@ -18214,9 +18214,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, "Invalid [] range \"%" UTF8f "\"", UTF8fARG(UTF, w, rangebegin)); NOT_REACHED; /* NOTREACHED */ - } - } - else { + } + } + else { prevvalue = value; /* save the beginning of the potential range */ if (! stop_at_1 /* Can't be a range if parsing just one thing */ && *RExC_parse == '-') @@ -18253,8 +18253,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, range = 1; /* yeah, it's a range! */ continue; /* but do it the next time */ } - } - } + } + } if (namedclass > OOB_NAMEDCLASS) { continue; @@ -18264,8 +18264,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * is the beginning of the range, if any; or if * not. */ - /* non-Latin1 code point implies unicode semantics. */ - if (value > 255) { + /* non-Latin1 code point implies unicode semantics. */ + if (value > 255) { if (value > MAX_LEGAL_CP && ( value != UV_MAX || prevvalue > MAX_LEGAL_CP)) { @@ -18281,7 +18281,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, PL_extended_cp_format, value); } - } + } /* Ready to process either the single value, or the completed range. * For single-valued non-inverted ranges, we consider the possibility @@ -18518,7 +18518,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } #endif - range = 0; /* this range (if it was one) is done now */ + range = 0; /* this range (if it was one) is done now */ } /* End of loop through all the text within the brackets */ if ( posix_warnings && av_tindex_skip_len_mg(posix_warnings) >= 0) { @@ -18529,12 +18529,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * deal with them by building up a substitute parse string, and recursively * calling reg() on it, instead of proceeding */ if (multi_char_matches) { - SV * substitute_parse = newSVpvn_flags("?:", 2, SVs_TEMP); + SV * substitute_parse = newSVpvn_flags("?:", 2, SVs_TEMP); I32 cp_count; - STRLEN len; - char *save_end = RExC_end; - char *save_parse = RExC_parse; - char *save_start = RExC_start; + STRLEN len; + char *save_end = RExC_end; + char *save_parse = RExC_parse; + char *save_start = RExC_start; Size_t constructed_prefix_len = 0; /* This gives the length of the constructed portion of the substitute parse. */ @@ -18612,20 +18612,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * reported. See the comments at the definition of * REPORT_LOCATION_ARGS for details */ RExC_copy_start_in_input = (char *) orig_parse; - RExC_start = RExC_parse = SvPV(substitute_parse, len); + RExC_start = RExC_parse = SvPV(substitute_parse, len); RExC_copy_start_in_constructed = RExC_start + constructed_prefix_len; - RExC_end = RExC_parse + len; + RExC_end = RExC_parse + len; RExC_in_multi_char_class = 1; - ret = reg(pRExC_state, 1, ®_flags, depth+1); + ret = reg(pRExC_state, 1, ®_flags, depth+1); *flagp |= reg_flags & (HASWIDTH|SIMPLE|POSTPONED|RESTART_PARSE|NEED_UTF8); /* And restore so can parse the rest of the pattern */ RExC_parse = save_parse; - RExC_start = RExC_copy_start_in_constructed = RExC_copy_start_in_input = save_start; - RExC_end = save_end; - RExC_in_multi_char_class = 0; + RExC_start = RExC_copy_start_in_constructed = RExC_copy_start_in_input = save_start; + RExC_end = save_end; + RExC_in_multi_char_class = 0; SvREFCNT_dec_NN(multi_char_matches); return ret; } @@ -18771,7 +18771,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* Now that we have finished adding all the folds, there is no reason * to keep the foldable list separate */ _invlist_union(cp_list, cp_foldable_list, &cp_list); - SvREFCNT_dec_NN(cp_foldable_list); + SvREFCNT_dec_NN(cp_foldable_list); } /* And combine the result (if any) with any inversion lists from posix @@ -19007,8 +19007,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, { _invlist_invert(cp_list); - /* Clear the invert flag since have just done it here */ - invert = FALSE; + /* Clear the invert flag since have just done it here */ + invert = FALSE; } /* All possible optimizations below still have these characteristics. @@ -19954,15 +19954,15 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * when the target string is UTF-8 (). * */ if (upper_latin1_only_utf8_matches) { - if (cp_list) { - _invlist_union(cp_list, + if (cp_list) { + _invlist_union(cp_list, upper_latin1_only_utf8_matches, &cp_list); - SvREFCNT_dec_NN(upper_latin1_only_utf8_matches); - } - else { - cp_list = upper_latin1_only_utf8_matches; - } + SvREFCNT_dec_NN(upper_latin1_only_utf8_matches); + } + else { + cp_list = upper_latin1_only_utf8_matches; + } ANYOF_FLAGS(REGNODE_p(ret)) |= ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP; } @@ -20017,11 +20017,11 @@ S_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state, if (! cp_list && ! runtime_defns && ! only_utf8_locale_list) { assert(! (ANYOF_FLAGS(node) & ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)); - ARG_SET(node, ANYOF_ONLY_HAS_BITMAP); + ARG_SET(node, ANYOF_ONLY_HAS_BITMAP); } else { - AV * const av = newAV(); - SV *rv; + AV * const av = newAV(); + SV *rv; if (cp_list) { av_store(av, INVLIST_INDEX, SvREFCNT_inc_NN(cp_list)); @@ -20040,10 +20040,10 @@ S_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state, SvREFCNT_inc_NN(runtime_defns)); } - rv = newRV_noinc(MUTABLE_SV(av)); - n = add_data(pRExC_state, STR_WITH_LEN("s")); - RExC_rxi->data->data[n] = (void*)rv; - ARG_SET(node, n); + rv = newRV_noinc(MUTABLE_SV(av)); + n = add_data(pRExC_state, STR_WITH_LEN("s")); + RExC_rxi->data->data[n] = (void*)rv; + ARG_SET(node, n); } } @@ -20097,12 +20097,12 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, assert(! output_invlist || listsvp); if (data && data->count) { - const U32 n = ARG(node); + const U32 n = ARG(node); - if (data->what[n] == 's') { - SV * const rv = MUTABLE_SV(data->data[n]); - AV * const av = MUTABLE_AV(SvRV(rv)); - SV **const ary = AvARRAY(av); + if (data->what[n] == 's') { + SV * const rv = MUTABLE_SV(data->data[n]); + AV * const av = MUTABLE_AV(SvRV(rv)); + SV **const ary = AvARRAY(av); invlist = ary[INVLIST_INDEX]; @@ -20114,7 +20114,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, si = ary[DEFERRED_USER_DEFINED_INDEX]; } - if (doinit && (si || invlist)) { + if (doinit && (si || invlist)) { if (si) { bool user_defined; SV * msg = newSVpvs_flags("", SVs_TEMP); @@ -20156,20 +20156,20 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, : INVLIST_INDEX); si = NULL; } - } - } + } + } } /* If requested, return a printable version of what this ANYOF node matches * */ if (listsvp) { - SV* matches_string = NULL; + SV* matches_string = NULL; /* This function can be called at compile-time, before everything gets * resolved, in which case we return the currently best available * information, which is the string that will eventually be used to do * that resolving, 'si' */ - if (si) { + if (si) { /* Here, we only have 'si' (and possibly some passed-in data in * 'invlist', which is handled below) If the caller only wants * 'si', use that. */ @@ -20268,7 +20268,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, SvCUR_set(matches_string, SvCUR(matches_string) - 1); } } /* end of has an 'si' */ - } + } /* Add the stuff that's already known */ if (invlist) { @@ -20291,7 +20291,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, } } - *listsvp = matches_string; + *listsvp = matches_string; } return invlist; @@ -20347,21 +20347,21 @@ S_skip_to_be_ignored_text(pTHX_ RExC_state_t *pRExC_state, assert( ! UTF || UTF8_IS_INVARIANT(**p) || UTF8_IS_START(**p)); for (;;) { - if (RExC_end - (*p) >= 3 - && *(*p) == '(' - && *(*p + 1) == '?' - && *(*p + 2) == '#') - { - while (*(*p) != ')') { - if ((*p) == RExC_end) - FAIL("Sequence (?#... not terminated"); - (*p)++; - } - (*p)++; - continue; - } - - if (use_xmod) { + if (RExC_end - (*p) >= 3 + && *(*p) == '(' + && *(*p + 1) == '?' + && *(*p + 2) == '#') + { + while (*(*p) != ')') { + if ((*p) == RExC_end) + FAIL("Sequence (?#... not terminated"); + (*p)++; + } + (*p)++; + continue; + } + + if (use_xmod) { const char * save_p = *p; while ((*p) < RExC_end) { STRLEN len; @@ -20378,7 +20378,7 @@ S_skip_to_be_ignored_text(pTHX_ RExC_state_t *pRExC_state, if (*p != save_p) { continue; } - } + } break; } @@ -20432,7 +20432,7 @@ S_change_engine_size(pTHX_ RExC_state_t *pRExC_state, const Ptrdiff_t size) char, regexp_internal); if ( RExC_rxi == NULL ) - FAIL("Regexp out of space"); + FAIL("Regexp out of space"); RXi_SET(RExC_rx, RExC_rxi); RExC_emit_start = RExC_rxi->program; @@ -20473,16 +20473,16 @@ S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STRLEN extra_ assert(extra_size >= regarglen[op] || PL_regkind[op] == ANYOF); if (RExC_offsets) { /* MJD */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s:%d: (op %s) %s %" UVuf " (len %" UVuf ") (max %" UVuf ").\n", name, __LINE__, PL_reg_name[op], (UV)(RExC_emit) > RExC_offsets[0] - ? "Overwriting end of array!\n" : "OK", + ? "Overwriting end of array!\n" : "OK", (UV)(RExC_emit), (UV)(RExC_parse - RExC_start), (UV)RExC_offsets[0])); - Set_Node_Offset(REGNODE_p(RExC_emit), RExC_parse + (op == END)); + Set_Node_Offset(REGNODE_p(RExC_emit), RExC_parse + (op == END)); } #endif return(ret); @@ -20627,21 +20627,21 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, const U8 op, RExC_end_op += size; while (src > REGNODE_p(operand)) { - StructCopy(--src, --dst, regnode); + StructCopy(--src, --dst, regnode); #ifdef RE_TRACK_PATTERN_OFFSETS if (RExC_offsets) { /* MJD 20010112 */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s(%d): (op %s) %s copy %" UVuf " -> %" UVuf " (max %" UVuf ").\n", "reginsert", - __LINE__, - PL_reg_name[op], + __LINE__, + PL_reg_name[op], (UV)(REGNODE_OFFSET(dst)) > RExC_offsets[0] - ? "Overwriting end of array!\n" : "OK", + ? "Overwriting end of array!\n" : "OK", (UV)REGNODE_OFFSET(src), (UV)REGNODE_OFFSET(dst), (UV)RExC_offsets[0])); - Set_Node_Offset_To_R(REGNODE_OFFSET(dst), Node_Offset(src)); - Set_Node_Length_To_R(REGNODE_OFFSET(dst), Node_Length(src)); + Set_Node_Offset_To_R(REGNODE_OFFSET(dst), Node_Offset(src)); + Set_Node_Length_To_R(REGNODE_OFFSET(dst), Node_Length(src)); } #endif } @@ -20649,18 +20649,18 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, const U8 op, place = REGNODE_p(operand); /* Op node, where operand used to be. */ #ifdef RE_TRACK_PATTERN_OFFSETS if (RExC_offsets) { /* MJD */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s(%d): (op %s) %s %" UVuf " <- %" UVuf " (max %" UVuf ").\n", "reginsert", - __LINE__, - PL_reg_name[op], + __LINE__, + PL_reg_name[op], (UV)REGNODE_OFFSET(place) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)REGNODE_OFFSET(place), (UV)(RExC_parse - RExC_start), (UV)RExC_offsets[0])); - Set_Node_Offset(place, RExC_parse); - Set_Node_Length(place, 1); + Set_Node_Offset(place, RExC_parse); + Set_Node_Length(place, 1); } #endif src = NEXTOPER(place); @@ -20696,7 +20696,7 @@ S_regtail(pTHX_ RExC_state_t * pRExC_state, * */ scan = (regnode_offset) p; for (;;) { - regnode * const temp = regnext(REGNODE_p(scan)); + regnode * const temp = regnext(REGNODE_p(scan)); DEBUG_PARSE_r({ DEBUG_PARSE_MSG((scan==p ? "tail" : "")); regprop(RExC_rx, RExC_mysv, REGNODE_p(scan), NULL, pRExC_state); @@ -20773,11 +20773,11 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, regnode * const temp = regnext(REGNODE_p(scan)); #ifdef EXPERIMENTAL_INPLACESCAN if (PL_regkind[OP(REGNODE_p(scan))] == EXACT) { - bool unfolded_multi_char; /* Unexamined in this routine */ + bool unfolded_multi_char; /* Unexamined in this routine */ if (join_exact(pRExC_state, scan, &min, &unfolded_multi_char, 1, REGNODE_p(val), depth+1)) return TRUE; /* Was return EXACT */ - } + } #endif if ( exact ) { if (PL_regkind[OP(REGNODE_p(scan))] == EXACT) { @@ -20798,23 +20798,23 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, scan, PL_reg_name[exact]); }); - if (temp == NULL) - break; - scan = REGNODE_OFFSET(temp); + if (temp == NULL) + break; + scan = REGNODE_OFFSET(temp); } DEBUG_PARSE_r({ DEBUG_PARSE_MSG(""); regprop(RExC_rx, RExC_mysv, REGNODE_p(val), NULL, pRExC_state); Perl_re_printf( aTHX_ "~ attach to %s (%" IVdf ") offset to %" IVdf "\n", - SvPV_nolen_const(RExC_mysv), - (IV)val, - (IV)(val - scan) + SvPV_nolen_const(RExC_mysv), + (IV)val, + (IV)(val - scan) ); }); if (reg_off_by_arg[OP(REGNODE_p(scan))]) { assert((UV) (val - scan) <= U32_MAX); - ARG_SET(REGNODE_p(scan), val - scan); + ARG_SET(REGNODE_p(scan), val - scan); } else { if (val - scan > U16_MAX) { @@ -20824,7 +20824,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, NEXT_OFF(REGNODE_p(scan)) = U16_MAX; return FALSE; } - NEXT_OFF(REGNODE_p(scan)) = val - scan; + NEXT_OFF(REGNODE_p(scan)) = val - scan; } return TRUE; /* Was 'return exact' */ @@ -20903,9 +20903,9 @@ S_regdump_extflags(pTHX_ const char *lead, const U32 flags) for (bit=0; bitcheck_substr || r->check_utf8) Perl_re_printf( aTHX_ - (const char *) - ( r->check_substr == r->substrs->data[1].substr - && r->check_utf8 == r->substrs->data[1].utf8_substr - ? "(checking floating" : "(checking anchored")); + (const char *) + ( r->check_substr == r->substrs->data[1].substr + && r->check_utf8 == r->substrs->data[1].utf8_substr + ? "(checking floating" : "(checking anchored")); if (r->intflags & PREGf_NOSCAN) Perl_re_printf( aTHX_ " noscan"); if (r->extflags & RXf_CHECK_ALL) @@ -21112,29 +21112,29 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ k = PL_regkind[OP(o)]; if (k == EXACT) { - sv_catpvs(sv, " "); - /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) - * is a crude hack but it may be the best for now since - * we have no flag "this EXACTish node was UTF-8" - * --jhi */ - pv_pretty(sv, STRING(o), STR_LEN(o), PL_dump_re_max_len, + sv_catpvs(sv, " "); + /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) + * is a crude hack but it may be the best for now since + * we have no flag "this EXACTish node was UTF-8" + * --jhi */ + pv_pretty(sv, STRING(o), STR_LEN(o), PL_dump_re_max_len, PL_colors[0], PL_colors[1], - PERL_PV_ESCAPE_UNI_DETECT | - PERL_PV_ESCAPE_NONASCII | - PERL_PV_PRETTY_ELLIPSES | - PERL_PV_PRETTY_LTGT | - PERL_PV_PRETTY_NOCLEAR - ); + PERL_PV_ESCAPE_UNI_DETECT | + PERL_PV_ESCAPE_NONASCII | + PERL_PV_PRETTY_ELLIPSES | + PERL_PV_PRETTY_LTGT | + PERL_PV_PRETTY_NOCLEAR + ); } else if (k == TRIE) { - /* print the details of the trie in dumpuntil instead, as - * progi->data isn't available here */ + /* print the details of the trie in dumpuntil instead, as + * progi->data isn't available here */ const char op = OP(o); const U32 n = ARG(o); const reg_ac_data * const ac = IS_TRIE_AC(op) ? (reg_ac_data *)progi->data->data[n] : NULL; const reg_trie_data * const trie - = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; + = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; Perl_sv_catpvf(aTHX_ sv, "-%s", PL_reg_name[o->flags]); DEBUG_TRIE_COMPILE_r({ @@ -21167,8 +21167,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } } else if (k == CURLY) { U32 lo = ARG1(o), hi = ARG2(o); - if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX) - Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */ + if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX) + Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */ Perl_sv_catpvf(aTHX_ sv, "{%u,", (unsigned) lo); if (hi == REG_INFTY) sv_catpvs(sv, "INFTY"); @@ -21177,14 +21177,14 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ sv_catpvs(sv, "}"); } else if (k == WHILEM && o->flags) /* Ordinal/of */ - Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4); + Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4); else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP || OP(o)==ACCEPT) { AV *name_list= NULL; U32 parno= OP(o) == ACCEPT ? (U32)ARG2L(o) : ARG(o); Perl_sv_catpvf(aTHX_ sv, "%" UVuf, (UV)parno); /* Parenth number */ - if ( RXp_PAREN_NAMES(prog) ) { + if ( RXp_PAREN_NAMES(prog) ) { name_list= MUTABLE_AV(progi->data->data[progi->name_list_idx]); } else if ( pRExC_state ) { name_list= RExC_paren_name_list; @@ -21192,8 +21192,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ if (name_list) { if ( k != REF || (OP(o) < REFN)) { SV **name= av_fetch(name_list, parno, 0 ); - if (name) - Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name)); + if (name) + Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name)); } else { SV *sv_dat= MUTABLE_SV(progi->data->data[ parno ]); @@ -21203,7 +21203,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ if (name) { for ( n=0; nflags); + Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); else if (k == ANYOF || k == ANYOFR) { U8 flags; char * bitmap; @@ -21274,7 +21274,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ arg = ARG(o); } - if (OP(o) == ANYOFL || OP(o) == ANYOFPOSIXL) { + if (OP(o) == ANYOFL || OP(o) == ANYOFPOSIXL) { if (ANYOFL_UTF8_LOCALE_REQD(flags)) { sv_catpvs(sv, "{utf8-locale-reqd}"); } @@ -21328,7 +21328,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } /* Ready to start outputting. First, the initial left bracket */ - Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); + Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); /* ANYOFH by definition doesn't have anything that will fit inside the * bitmap; ANYOFR may or may not. */ @@ -21433,7 +21433,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } /* And finally the matching, closing ']' */ - Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); + Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); if (OP(o) == ANYOFHs) { Perl_sv_catpvf(aTHX_ sv, " (Leading UTF-8 bytes=%s", _byte_dump_string((U8 *) ((struct regnode_anyofhs *) o)->string, FLAGS(o), 1)); @@ -21464,13 +21464,13 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ else if (k == ANYOFM) { SV * cp_list = get_ANYOFM_contents(o); - Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); + Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); if (OP(o) == NANYOFM) { _invlist_invert(cp_list); } put_charclass_bitmap_innards(sv, NULL, cp_list, NULL, NULL, 0, TRUE); - Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); + Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); SvREFCNT_dec(cp_list); } @@ -21502,11 +21502,11 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ sv_catpv(sv, bounds[FLAGS(o)]); } else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH)) { - Perl_sv_catpvf(aTHX_ sv, "[%d", -(o->flags)); + Perl_sv_catpvf(aTHX_ sv, "[%d", -(o->flags)); if (o->next_off) { Perl_sv_catpvf(aTHX_ sv, "..-%d", o->flags - o->next_off); } - Perl_sv_catpvf(aTHX_ sv, "]"); + Perl_sv_catpvf(aTHX_ sv, "]"); } else if (OP(o) == SBOL) Perl_sv_catpvf(aTHX_ sv, " /%s/", o->flags ? "\\A" : "^"); @@ -21546,22 +21546,22 @@ Perl_re_intuit_string(pTHX_ REGEXP * const r) PERL_UNUSED_CONTEXT; DEBUG_COMPILE_r( - { + { if (prog->maxlen > 0) { const char * const s = SvPV_nolen_const(RX_UTF8(r) - ? prog->check_utf8 : prog->check_substr); + ? prog->check_utf8 : prog->check_substr); if (!PL_colorset) reginitcolors(); Perl_re_printf( aTHX_ - "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", - PL_colors[4], - RX_UTF8(r) ? "utf8 " : "", - PL_colors[5], PL_colors[0], - s, - PL_colors[1], - (strlen(s) > PL_dump_re_max_len ? "..." : "")); + "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", + PL_colors[4], + RX_UTF8(r) ? "utf8 " : "", + PL_colors[5], PL_colors[0], + s, + PL_colors[1], + (strlen(s) > PL_dump_re_max_len ? "..." : "")); } - } ); + } ); /* use UTF8 check substring if regexp pattern itself is in UTF8 */ return RX_UTF8(r) ? prog->check_utf8 : prog->check_substr; @@ -21609,7 +21609,7 @@ Perl_pregfree2(pTHX_ REGEXP *rx) SvREFCNT_dec(r->substrs->data[i].substr); SvREFCNT_dec(r->substrs->data[i].utf8_substr); } - Safefree(r->substrs); + Safefree(r->substrs); } RX_MATCH_COPY_FREE(rx); #ifdef PERL_ANY_COW @@ -21656,7 +21656,7 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) PERL_ARGS_ASSERT_REG_TEMP_COPY; if (!dsv) - dsv = (REGEXP*) newSV_type(SVt_REGEXP); + dsv = (REGEXP*) newSV_type(SVt_REGEXP); else { assert(SvTYPE(dsv) == SVt_REGEXP || (SvTYPE(dsv) == SVt_PVLV)); @@ -21673,22 +21673,22 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) } SvLEN_set(dsv, 0); SvCUR_set(dsv, 0); - SvOK_off((SV *)dsv); + SvOK_off((SV *)dsv); - if (islv) { - /* For PVLVs, the head (sv_any) points to an XPVLV, while + if (islv) { + /* For PVLVs, the head (sv_any) points to an XPVLV, while * the LV's xpvlenu_rx will point to a regexp body, which * we allocate here */ - REGEXP *temp = (REGEXP *)newSV_type(SVt_REGEXP); - assert(!SvPVX(dsv)); + REGEXP *temp = (REGEXP *)newSV_type(SVt_REGEXP); + assert(!SvPVX(dsv)); ((XPV*)SvANY(dsv))->xpv_len_u.xpvlenu_rx = temp->sv_any; - temp->sv_any = NULL; - SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; - SvREFCNT_dec_NN(temp); - /* SvCUR still resides in the xpvlv struct, so the regexp copy- - ing below will not set it. */ - SvCUR_set(dsv, SvCUR(ssv)); - } + temp->sv_any = NULL; + SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; + SvREFCNT_dec_NN(temp); + /* SvCUR still resides in the xpvlv struct, so the regexp copy- + ing below will not set it. */ + SvCUR_set(dsv, SvCUR(ssv)); + } } /* This ensures that SvTHINKFIRST(sv) is true, and hence that sv_force_normal(sv) is called. */ @@ -21702,7 +21702,7 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) The string pointer is copied here, being part of the regexp struct. */ memcpy(&(drx->xpv_cur), &(srx->xpv_cur), - sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur)); + sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur)); if (!islv) SvLEN_set(dsv, 0); if (srx->offs) { @@ -21713,15 +21713,15 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) if (srx->substrs) { int i; Newx(drx->substrs, 1, struct reg_substr_data); - StructCopy(srx->substrs, drx->substrs, struct reg_substr_data); + StructCopy(srx->substrs, drx->substrs, struct reg_substr_data); for (i = 0; i < 2; i++) { SvREFCNT_inc_void(drx->substrs->data[i].substr); SvREFCNT_inc_void(drx->substrs->data[i].utf8_substr); } - /* check_substr and check_utf8, if non-NULL, point to either their - anchored or float namesakes, and don't hold a second reference. */ + /* check_substr and check_utf8, if non-NULL, point to either their + anchored or float namesakes, and don't hold a second reference. */ } RX_MATCH_COPIED_off(dsv); #ifdef PERL_ANY_COW @@ -21763,10 +21763,10 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) } DEBUG_COMPILE_r({ - if (!PL_colorset) - reginitcolors(); - { - SV *dsv= sv_newmortal(); + if (!PL_colorset) + reginitcolors(); + { + SV *dsv= sv_newmortal(); RE_PV_QUOTED_DECL(s, RX_UTF8(rx), dsv, RX_PRECOMP(rx), RX_PRELEN(rx), PL_dump_re_max_len); Perl_re_printf( aTHX_ "%sFreeing REx:%s %s\n", @@ -21782,24 +21782,24 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) S_free_codeblocks(aTHX_ ri->code_blocks); if (ri->data) { - int n = ri->data->count; + int n = ri->data->count; - while (--n >= 0) { + while (--n >= 0) { /* If you add a ->what type here, update the comment in regcomp.h */ - switch (ri->data->what[n]) { - case 'a': - case 'r': - case 's': - case 'S': - case 'u': - SvREFCNT_dec(MUTABLE_SV(ri->data->data[n])); - break; - case 'f': - Safefree(ri->data->data[n]); - break; - case 'l': - case 'L': - break; + switch (ri->data->what[n]) { + case 'a': + case 'r': + case 's': + case 'S': + case 'u': + SvREFCNT_dec(MUTABLE_SV(ri->data->data[n])); + break; + case 'f': + Safefree(ri->data->data[n]); + break; + case 'l': + case 'L': + break; case 'T': { /* Aho Corasick add-on structure for a trie node. Used in stclass optimization only */ @@ -21811,7 +21811,7 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) if ( !refcount ) { PerlMemShared_free(aho->states); PerlMemShared_free(aho->fail); - /* do this last!!!! */ + /* do this last!!!! */ PerlMemShared_free(ri->data->data[n]); /* we should only ever get called once, so * assert as much, and also guard the free @@ -21826,11 +21826,11 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) } } break; - case 't': - { - /* trie structure. */ - U32 refcount; - reg_trie_data *trie=(reg_trie_data*)ri->data->data[n]; + case 't': + { + /* trie structure. */ + U32 refcount; + reg_trie_data *trie=(reg_trie_data*)ri->data->data[n]; OP_REFCNT_LOCK; refcount = --trie->refcount; OP_REFCNT_UNLOCK; @@ -21842,19 +21842,19 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) PerlMemShared_free(trie->bitmap); if (trie->jump) PerlMemShared_free(trie->jump); - PerlMemShared_free(trie->wordinfo); + PerlMemShared_free(trie->wordinfo); /* do this last!!!! */ PerlMemShared_free(ri->data->data[n]); - } - } - break; - default: - Perl_croak(aTHX_ "panic: regfree data code '%c'", + } + } + break; + default: + Perl_croak(aTHX_ "panic: regfree data code '%c'", ri->data->what[n]); - } - } - Safefree(ri->data->what); - Safefree(ri->data); + } + } + Safefree(ri->data->what); + Safefree(ri->data); } Safefree(ri); @@ -21896,15 +21896,15 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) Copy(r->offs, ret->offs, npar, regexp_paren_pair); if (ret->substrs) { - /* Do it this way to avoid reading from *r after the StructCopy(). - That way, if any of the sv_dup_inc()s dislodge *r from the L1 - cache, it doesn't matter. */ + /* Do it this way to avoid reading from *r after the StructCopy(). + That way, if any of the sv_dup_inc()s dislodge *r from the L1 + cache, it doesn't matter. */ int i; - const bool anchored = r->check_substr - ? r->check_substr == r->substrs->data[0].substr - : r->check_utf8 == r->substrs->data[0].utf8_substr; + const bool anchored = r->check_substr + ? r->check_substr == r->substrs->data[0].substr + : r->check_utf8 == r->substrs->data[0].utf8_substr; Newx(ret->substrs, 1, struct reg_substr_data); - StructCopy(r->substrs, ret->substrs, struct reg_substr_data); + StructCopy(r->substrs, ret->substrs, struct reg_substr_data); for (i = 0; i < 2; i++) { ret->substrs->data[i].substr = @@ -21913,29 +21913,29 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) sv_dup_inc(ret->substrs->data[i].utf8_substr, param); } - /* check_substr and check_utf8, if non-NULL, point to either their - anchored or float namesakes, and don't hold a second reference. */ + /* check_substr and check_utf8, if non-NULL, point to either their + anchored or float namesakes, and don't hold a second reference. */ - if (ret->check_substr) { - if (anchored) { - assert(r->check_utf8 == r->substrs->data[0].utf8_substr); + if (ret->check_substr) { + if (anchored) { + assert(r->check_utf8 == r->substrs->data[0].utf8_substr); - ret->check_substr = ret->substrs->data[0].substr; - ret->check_utf8 = ret->substrs->data[0].utf8_substr; - } else { - assert(r->check_substr == r->substrs->data[1].substr); - assert(r->check_utf8 == r->substrs->data[1].utf8_substr); + ret->check_substr = ret->substrs->data[0].substr; + ret->check_utf8 = ret->substrs->data[0].utf8_substr; + } else { + assert(r->check_substr == r->substrs->data[1].substr); + assert(r->check_utf8 == r->substrs->data[1].utf8_substr); - ret->check_substr = ret->substrs->data[1].substr; - ret->check_utf8 = ret->substrs->data[1].utf8_substr; - } - } else if (ret->check_utf8) { - if (anchored) { - ret->check_utf8 = ret->substrs->data[0].utf8_substr; - } else { - ret->check_utf8 = ret->substrs->data[1].utf8_substr; - } - } + ret->check_substr = ret->substrs->data[1].substr; + ret->check_utf8 = ret->substrs->data[1].utf8_substr; + } + } else if (ret->check_utf8) { + if (anchored) { + ret->check_utf8 = ret->substrs->data[0].utf8_substr; + } else { + ret->check_utf8 = ret->substrs->data[1].utf8_substr; + } + } } RXp_PAREN_NAMES(ret) = hv_dup_inc(RXp_PAREN_NAMES(ret), param); @@ -21944,12 +21944,12 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) Newx(ret->recurse_locinput, r->nparens + 1, char *); if (ret->pprivate) - RXi_SET(ret, CALLREGDUPE_PVT(dstr, param)); + RXi_SET(ret, CALLREGDUPE_PVT(dstr, param)); if (RX_MATCH_COPIED(dstr)) - ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); + ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); else - ret->subbeg = NULL; + ret->subbeg = NULL; #ifdef PERL_ANY_COW ret->saved_copy = NULL; #endif @@ -21957,9 +21957,9 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) /* Whether mother_re be set or no, we need to copy the string. We cannot refrain from copying it when the storage points directly to our mother regexp, because that's - 1: a buffer in a different thread - 2: something we no longer hold a reference on - so we need to copy it locally. */ + 1: a buffer in a different thread + 2: something we no longer hold a reference on + so we need to copy it locally. */ RX_WRAPPED(dstr) = SAVEPVN(RX_WRAPPED_const(sstr), SvCUR(sstr)+1); /* set malloced length to a non-zero value so it will be freed * (otherwise in combination with SVf_FAKE it looks like an alien @@ -22002,37 +22002,37 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) if (ri->code_blocks) { - int n; - Newx(reti->code_blocks, 1, struct reg_code_blocks); - Newx(reti->code_blocks->cb, ri->code_blocks->count, + int n; + Newx(reti->code_blocks, 1, struct reg_code_blocks); + Newx(reti->code_blocks->cb, ri->code_blocks->count, struct reg_code_block); - Copy(ri->code_blocks->cb, reti->code_blocks->cb, + Copy(ri->code_blocks->cb, reti->code_blocks->cb, ri->code_blocks->count, struct reg_code_block); - for (n = 0; n < ri->code_blocks->count; n++) - reti->code_blocks->cb[n].src_regex = (REGEXP*) - sv_dup_inc((SV*)(ri->code_blocks->cb[n].src_regex), param); + for (n = 0; n < ri->code_blocks->count; n++) + reti->code_blocks->cb[n].src_regex = (REGEXP*) + sv_dup_inc((SV*)(ri->code_blocks->cb[n].src_regex), param); reti->code_blocks->count = ri->code_blocks->count; reti->code_blocks->refcnt = 1; } else - reti->code_blocks = NULL; + reti->code_blocks = NULL; reti->regstclass = NULL; if (ri->data) { - struct reg_data *d; + struct reg_data *d; const int count = ri->data->count; - int i; + int i; - Newxc(d, sizeof(struct reg_data) + count*sizeof(void *), - char, struct reg_data); - Newx(d->what, count, U8); + Newxc(d, sizeof(struct reg_data) + count*sizeof(void *), + char, struct reg_data); + Newx(d->what, count, U8); - d->count = count; - for (i = 0; i < count; i++) { - d->what[i] = ri->data->what[i]; - switch (d->what[i]) { - /* see also regcomp.h and regfree_internal() */ + d->count = count; + for (i = 0; i < count; i++) { + d->what[i] = ri->data->what[i]; + switch (d->what[i]) { + /* see also regcomp.h and regfree_internal() */ case 'a': /* actually an AV, but the dup function is identical. values seem to be "plain sv's" generally. */ case 'r': /* a compiled regex (but still just another SV) */ @@ -22042,9 +22042,9 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) case 'S': /* actually an SV, but the dup function is identical. */ case 'u': /* actually an HV, but the dup function is identical. values are "plain sv's" */ - d->data[i] = sv_dup_inc((const SV *)ri->data->data[i], param); - break; - case 'f': + d->data[i] = sv_dup_inc((const SV *)ri->data->data[i], param); + break; + case 'f': /* Synthetic Start Class - "Fake" charclass we generate to optimize * patterns which could start with several different things. Pre-TRIE * this was more important than it is now, however this still helps @@ -22052,40 +22052,40 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) * to [xa]. This is used by Perl_re_intuit_start() and S_find_byclass() * in regexec.c */ - /* This is cheating. */ - Newx(d->data[i], 1, regnode_ssc); - StructCopy(ri->data->data[i], d->data[i], regnode_ssc); - reti->regstclass = (regnode*)d->data[i]; - break; - case 'T': + /* This is cheating. */ + Newx(d->data[i], 1, regnode_ssc); + StructCopy(ri->data->data[i], d->data[i], regnode_ssc); + reti->regstclass = (regnode*)d->data[i]; + break; + case 'T': /* AHO-CORASICK fail table */ /* Trie stclasses are readonly and can thus be shared - * without duplication. We free the stclass in pregfree - * when the corresponding reg_ac_data struct is freed. - */ - reti->regstclass= ri->regstclass; - /* FALLTHROUGH */ - case 't': + * without duplication. We free the stclass in pregfree + * when the corresponding reg_ac_data struct is freed. + */ + reti->regstclass= ri->regstclass; + /* FALLTHROUGH */ + case 't': /* TRIE transition table */ - OP_REFCNT_LOCK; - ((reg_trie_data*)ri->data->data[i])->refcount++; - OP_REFCNT_UNLOCK; - /* FALLTHROUGH */ + OP_REFCNT_LOCK; + ((reg_trie_data*)ri->data->data[i])->refcount++; + OP_REFCNT_UNLOCK; + /* FALLTHROUGH */ case 'l': /* (?{...}) or (??{ ... }) code (cb->block) */ case 'L': /* same when RExC_pm_flags & PMf_HAS_CV and code is not from another regexp */ - d->data[i] = ri->data->data[i]; - break; + d->data[i] = ri->data->data[i]; + break; default: Perl_croak(aTHX_ "panic: re_dup_guts unknown data code '%c'", ri->data->what[i]); - } - } + } + } - reti->data = d; + reti->data = d; } else - reti->data = NULL; + reti->data = NULL; reti->name_list_idx = ri->name_list_idx; @@ -22114,16 +22114,16 @@ Perl_regnext(pTHX_ regnode *p) I32 offset; if (!p) - return(NULL); + return(NULL); if (OP(p) > REGNODE_MAX) { /* regnode.type is unsigned */ - Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", + Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(p), (int)REGNODE_MAX); } offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p)); if (offset == 0) - return(NULL); + return(NULL); return(p+offset); } @@ -22142,7 +22142,7 @@ S_re_croak(pTHX_ bool utf8, const char* pat,...) PERL_ARGS_ASSERT_RE_CROAK; if (len > 510) - len = 510; + len = 510; Copy(pat, buf, len , char); buf[len] = '\n'; buf[len + 1] = '\0'; @@ -22151,7 +22151,7 @@ S_re_croak(pTHX_ bool utf8, const char* pat,...) va_end(args); message = SvPV_const(msv, len); if (len > 512) - len = 512; + len = 512; Copy(message, buf, len , char); /* len-1 to avoid \n */ Perl_croak(aTHX_ "%" UTF8f, UTF8fARG(utf8, len-1, buf)); @@ -22169,8 +22169,8 @@ Perl_save_re_context(pTHX) /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */ if (PL_curpm) { - const REGEXP * const rx = PM_GETRE(PL_curpm); - if (rx) + const REGEXP * const rx = PM_GETRE(PL_curpm); + if (rx) nparens = RX_NPARENS(rx); } @@ -22209,13 +22209,13 @@ S_put_code_point(pTHX_ SV *sv, UV c) Perl_sv_catpvf(aTHX_ sv, "\\x{%04" UVXf "}", c); } else if (isPRINT(c)) { - const char string = (char) c; + const char string = (char) c; /* We use {phrase} as metanotation in the class, so also escape literal * braces */ - if (isBACKSLASHED_PUNCT(c) || c == '{' || c == '}') - sv_catpvs(sv, "\\"); - sv_catpvn(sv, &string, 1); + if (isBACKSLASHED_PUNCT(c) || c == '{' || c == '}') + sv_catpvs(sv, "\\"); + sv_catpvn(sv, &string, 1); } else if (isMNEMONIC_CNTRL(c)) { Perl_sv_catpvf(aTHX_ sv, "%s", cntrl_to_mnemonic((U8) c)); @@ -22782,10 +22782,10 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv, || ( SvCUR(inverted_display) + inverted_bias < SvCUR(as_is_display) + as_is_bias))) { - sv_catsv(sv, inverted_display); + sv_catsv(sv, inverted_display); } else if (as_is_display) { - sv_catsv(sv, as_is_display); + sv_catsv(sv, as_is_display); } SvREFCNT_dec(as_is_display); @@ -22814,8 +22814,8 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv, STATIC const regnode * S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, - const regnode *last, const regnode *plast, - SV* sv, I32 indent, U32 depth) + const regnode *last, const regnode *plast, + SV* sv, I32 indent, U32 depth) { U8 op = PSEUDO; /* Arbitrary non-END op. */ const regnode *next; @@ -22836,25 +22836,25 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, while (PL_regkind[op] != END && (!last || node < last)) { assert(node); - /* While that wasn't END last time... */ - NODE_ALIGN(node); - op = OP(node); - if (op == CLOSE || op == SRCLOSE || op == WHILEM) - indent--; - next = regnext((regnode *)node); - - /* Where, what. */ - if (OP(node) == OPTIMIZED) { - if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) - optstart = node; - else - goto after_print; - } else - CLEAR_OPTSTART; + /* While that wasn't END last time... */ + NODE_ALIGN(node); + op = OP(node); + if (op == CLOSE || op == SRCLOSE || op == WHILEM) + indent--; + next = regnext((regnode *)node); + + /* Where, what. */ + if (OP(node) == OPTIMIZED) { + if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) + optstart = node; + else + goto after_print; + } else + CLEAR_OPTSTART; regprop(r, sv, node, NULL, NULL); Perl_re_printf( aTHX_ "%4" IVdf ":%*s%s", (IV)(node - start), - (int)(2*indent + 1), "", SvPVX_const(sv)); + (int)(2*indent + 1), "", SvPVX_const(sv)); if (OP(node) != OPTIMIZED) { if (next == NULL) /* Next ptr. */ @@ -22868,39 +22868,39 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, } after_print: - if (PL_regkind[(U8)op] == BRANCHJ) { - assert(next); - { + if (PL_regkind[(U8)op] == BRANCHJ) { + assert(next); + { const regnode *nnode = (OP(next) == LONGJMP ? regnext((regnode *)next) : next); if (last && nnode > last) nnode = last; DUMPUNTIL(NEXTOPER(NEXTOPER(node)), nnode); - } - } - else if (PL_regkind[(U8)op] == BRANCH) { - assert(next); - DUMPUNTIL(NEXTOPER(node), next); - } - else if ( PL_regkind[(U8)op] == TRIE ) { - const regnode *this_trie = node; - const char op = OP(node); + } + } + else if (PL_regkind[(U8)op] == BRANCH) { + assert(next); + DUMPUNTIL(NEXTOPER(node), next); + } + else if ( PL_regkind[(U8)op] == TRIE ) { + const regnode *this_trie = node; + const char op = OP(node); const U32 n = ARG(node); - const reg_ac_data * const ac = op>=AHOCORASICK ? + const reg_ac_data * const ac = op>=AHOCORASICK ? (reg_ac_data *)ri->data->data[n] : NULL; - const reg_trie_data * const trie = - (reg_trie_data*)ri->data->data[optrie]; + const reg_trie_data * const trie = + (reg_trie_data*)ri->data->data[optrie]; #ifdef DEBUGGING - AV *const trie_words + AV *const trie_words = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]); #endif - const regnode *nextbranch= NULL; - I32 word_idx; + const regnode *nextbranch= NULL; + I32 word_idx; SvPVCLEAR(sv); - for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { - SV ** const elem_ptr = av_fetch(trie_words, word_idx, 0); + for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { + SV ** const elem_ptr = av_fetch(trie_words, word_idx, 0); Perl_re_indentf( aTHX_ "%s ", indent+3, @@ -22923,41 +22923,41 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, if (dist) { if (!nextbranch) nextbranch= this_trie + trie->jump[0]; - DUMPUNTIL(this_trie + dist, nextbranch); + DUMPUNTIL(this_trie + dist, nextbranch); } if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH) nextbranch= regnext((regnode *)nextbranch); } else { Perl_re_printf( aTHX_ "\n"); - } - } - if (last && next > last) - node= last; - else - node= next; - } - else if ( op == CURLY ) { /* "next" might be very big: optimizer */ - DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, + } + } + if (last && next > last) + node= last; + else + node= next; + } + else if ( op == CURLY ) { /* "next" might be very big: optimizer */ + DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, NEXTOPER(node) + EXTRA_STEP_2ARGS + 1); - } - else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { - assert(next); - DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, next); - } - else if ( op == PLUS || op == STAR) { - DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1); - } - else if (PL_regkind[(U8)op] == EXACT || op == ANYOFHs) { + } + else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { + assert(next); + DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, next); + } + else if ( op == PLUS || op == STAR) { + DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1); + } + else if (PL_regkind[(U8)op] == EXACT || op == ANYOFHs) { /* Literal string, where present. */ - node += NODE_SZ_STR(node) - 1; - node = NEXTOPER(node); - } - else { - node = NEXTOPER(node); - node += regarglen[(U8)op]; - } - if (op == CURLYX || op == OPEN || op == SROPEN) - indent++; + node += NODE_SZ_STR(node) - 1; + node = NEXTOPER(node); + } + else { + node = NEXTOPER(node); + node += regarglen[(U8)op]; + } + if (op == CURLYX || op == OPEN || op == SROPEN) + indent++; } CLEAR_OPTSTART; #ifdef DEBUG_DUMPUNTIL @@ -23218,7 +23218,7 @@ S_compile_wildcard(pTHX_ const char * subpattern, const STRLEN len, STATIC I32 S_execute_wildcard(pTHX_ REGEXP * const prog, char* stringarg, char *strend, - char *strbeg, SSize_t minend, SV *screamer, U32 nosave) + char *strbeg, SSize_t minend, SV *screamer, U32 nosave) { I32 result; DECLARE_AND_GET_RE_DEBUG_FLAGS; @@ -24912,7 +24912,7 @@ S_parse_uniprop_string(pTHX_ COPHH * hinthash = (IN_PERL_COMPILETIME) ? CopHINTHASH_get(&PL_compiling) : CopHINTHASH_get(PL_curcop); - SV * pu_overrides = cophh_fetch_pv(hinthash, "private_use", 0, 0); + SV * pu_overrides = cophh_fetch_pv(hinthash, "private_use", 0, 0); if (UNLIKELY(pu_overrides && SvPOK(pu_overrides))) { diff --git a/regcomp.h b/regcomp.h index 6791b1c5bee7..4c2e53583814 100644 --- a/regcomp.h +++ b/regcomp.h @@ -67,7 +67,7 @@ typedef struct regexp_internal { union { - U32 *offsets; /* offset annotations 20001228 MJD + U32 *offsets; /* offset annotations 20001228 MJD data about mapping the program to the string - offsets[0] is proglen when this is used @@ -81,9 +81,9 @@ Used to make it easier to clone and free arbitrary data that the regops need. Often the ARG field of a regop is an index into this structure */ - struct reg_code_blocks *code_blocks;/* positions of literal (?{}) */ + struct reg_code_blocks *code_blocks;/* positions of literal (?{}) */ int name_list_idx; /* Optional data index of an array of paren names */ - regnode program[1]; /* Unwarranted chumminess with compiler. */ + regnode program[1]; /* Unwarranted chumminess with compiler. */ } regexp_internal; #define RXi_SET(x,y) (x)->pprivate = (void*)(y) @@ -256,7 +256,7 @@ struct regnode_ssc { ((1<<32)-1), while on the Cray T90, sizeof(short)==8 and U16_MAX is ((1<<64)-1). To limit stack growth to reasonable sizes, supply a smaller default. - --Andy Dougherty 11 June 1998 + --Andy Dougherty 11 June 1998 */ #if SHORTSIZE > 2 # ifndef REG_INFTY @@ -311,8 +311,8 @@ struct regnode_ssc { #define OP(p) ((p)->type) #define FLAGS(p) ((p)->flags) /* Caution: Doesn't apply to all \ - regnode types. For some, it's the \ - character set of the regnode */ + regnode types. For some, it's the \ + character set of the regnode */ #define STR_LENs(p) (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ ((struct regnode_string *)p)->str_len) #define STRINGs(p) (__ASSERT_(OP(p) != LEXACT && OP(p) != LEXACT_REQ8) \ @@ -703,7 +703,7 @@ struct regnode_ssc { #define ANYOF_POSIXL_TEST_ANY_SET(p) \ ((ANYOF_FLAGS(p) & ANYOF_MATCHES_POSIXL) \ - && (((regnode_charclass_posixl*)(p))->classflags)) + && (((regnode_charclass_posixl*)(p))->classflags)) #define ANYOF_CLASS_TEST_ANY_SET(p) ANYOF_POSIXL_TEST_ANY_SET(p) /* Since an SSC always has this field, we don't have to test for that; nor do @@ -732,9 +732,9 @@ struct regnode_ssc { #define ANYOF_BITMAP_TEST(p, c) cBOOL(ANYOF_BITMAP_BYTE(p, c) & ANYOF_BIT(c)) #define ANYOF_BITMAP_SETALL(p) \ - memset (ANYOF_BITMAP(p), 255, ANYOF_BITMAP_SIZE) + memset (ANYOF_BITMAP(p), 255, ANYOF_BITMAP_SIZE) #define ANYOF_BITMAP_CLEARALL(p) \ - Zero (ANYOF_BITMAP(p), ANYOF_BITMAP_SIZE) + Zero (ANYOF_BITMAP(p), ANYOF_BITMAP_SIZE) /* * Utility definitions. @@ -884,9 +884,9 @@ struct _reg_trie_state { /* info per word; indexed by wordnum */ typedef struct { U16 prev; /* previous word in acceptance chain; eg in - * zzz|abc|ab/ after matching the chars abc, the - * accepted word is #2, and the previous accepted - * word is #3 */ + * zzz|abc|ab/ after matching the chars abc, the + * accepted word is #2, and the previous accepted + * word is #3 */ U32 len; /* how many chars long is this word? */ U32 accept; /* accept state for this word */ } reg_trie_wordinfo; @@ -1176,11 +1176,11 @@ re.pm, especially to the documentation. #define FIRST_NON_ASCII_DECIMAL_DIGIT 0x660 /* ARABIC_INDIC_DIGIT_ZERO */ typedef enum { - TRADITIONAL_BOUND = _CC_WORDCHAR, - GCB_BOUND, - LB_BOUND, - SB_BOUND, - WB_BOUND + TRADITIONAL_BOUND = _CC_WORDCHAR, + GCB_BOUND, + LB_BOUND, + SB_BOUND, + WB_BOUND } bound_type; /* This unpacks the FLAGS field of ANYOF[HR]x nodes. The value it contains diff --git a/regen.pl b/regen.pl index 71a6eda60a86..b4a6eb54c6d7 100644 --- a/regen.pl +++ b/regen.pl @@ -15,7 +15,7 @@ my $tap = $ARGV[0] && $ARGV[0] eq '--tap' ? '# ' : ''; foreach my $pl (map {chomp; "regen/$_"} ) { - my @command = ($^X, '-I.', $pl, @ARGV); + my @command = ($^X, '-I.', '-Ilib', $pl, @ARGV); print "$tap@command\n"; system @command and die "@command failed: $?" diff --git a/scope.c b/scope.c index 19281d12a70c..acbc8e987949 100644 --- a/scope.c +++ b/scope.c @@ -110,11 +110,11 @@ Perl_push_scope(pTHX) { if (UNLIKELY(PL_scopestack_ix == PL_scopestack_max)) { const IV new_max = GROW(PL_scopestack_max); - Renew(PL_scopestack, new_max, I32); + Renew(PL_scopestack, new_max, I32); #ifdef DEBUGGING - Renew(PL_scopestack_name, new_max, const char*); + Renew(PL_scopestack_name, new_max, const char*); #endif - PL_scopestack_max = new_max; + PL_scopestack_max = new_max; } #ifdef DEBUGGING PL_scopestack_name[PL_scopestack_ix] = "unknown"; @@ -195,7 +195,7 @@ Perl_tmps_grow_p(pTHX_ SSize_t ix) SSize_t extend_to = ix; #ifndef STRESS_REALLOC if (ix - PL_tmps_max < 128) - extend_to += (PL_tmps_max < 512) ? 128 : 512; + extend_to += (PL_tmps_max < 512) ? 128 : 512; #endif Renew(PL_tmps_stack, extend_to + 1, SV*); PL_tmps_max = extend_to + 1; @@ -209,14 +209,14 @@ Perl_free_tmps(pTHX) /* XXX should tmps_floor live in cxstack? */ const SSize_t myfloor = PL_tmps_floor; while (PL_tmps_ix > myfloor) { /* clean up after last statement */ - SV* const sv = PL_tmps_stack[PL_tmps_ix--]; + SV* const sv = PL_tmps_stack[PL_tmps_ix--]; #ifdef PERL_POISON - PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB); + PoisonWith(PL_tmps_stack + PL_tmps_ix + 1, 1, SV *, 0xAB); #endif - if (LIKELY(sv)) { - SvTEMP_off(sv); - SvREFCNT_dec_NN(sv); /* note, can modify tmps_ix!!! */ - } + if (LIKELY(sv)) { + SvTEMP_off(sv); + SvREFCNT_dec_NN(sv); /* note, can modify tmps_ix!!! */ + } } } @@ -349,27 +349,27 @@ Perl_save_gp(pTHX_ GV *gv, I32 empty) save_pushptrptr(SvREFCNT_inc(gv), GvGP(gv), SAVEt_GP); if (empty) { - GP *gp = Perl_newGP(aTHX_ gv); - HV * const stash = GvSTASH(gv); - bool isa_changed = 0; - - if (stash && HvENAME(stash)) { - if (memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA")) - isa_changed = TRUE; - else if (GvCVu(gv)) - /* taking a method out of circulation ("local")*/ + GP *gp = Perl_newGP(aTHX_ gv); + HV * const stash = GvSTASH(gv); + bool isa_changed = 0; + + if (stash && HvENAME(stash)) { + if (memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA")) + isa_changed = TRUE; + else if (GvCVu(gv)) + /* taking a method out of circulation ("local")*/ mro_method_changed_in(stash); - } - if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { - gp->gp_io = newIO(); - IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; - } - GvGP_set(gv,gp); - if (isa_changed) mro_isa_changed_in(stash); + } + if (GvIOp(gv) && (IoFLAGS(GvIOp(gv)) & IOf_ARGV)) { + gp->gp_io = newIO(); + IoFLAGS(gp->gp_io) |= IOf_ARGV|IOf_START; + } + GvGP_set(gv,gp); + if (isa_changed) mro_isa_changed_in(stash); } else { - gp_ref(GvGP(gv)); - GvINTRO_on(gv); + gp_ref(GvGP(gv)); + GvINTRO_on(gv); } } @@ -382,13 +382,13 @@ Perl_save_ary(pTHX_ GV *gv) PERL_ARGS_ASSERT_SAVE_ARY; if (UNLIKELY(!AvREAL(oav) && AvREIFY(oav))) - av_reify(oav); + av_reify(oav); save_pushptrptr(SvREFCNT_inc_simple_NN(gv), oav, SAVEt_AV); GvAV(gv) = NULL; av = GvAVn(gv); if (UNLIKELY(SvMAGIC(oav))) - mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE); + mg_localize(MUTABLE_SV(oav), MUTABLE_SV(av), TRUE); return av; } @@ -400,13 +400,13 @@ Perl_save_hash(pTHX_ GV *gv) PERL_ARGS_ASSERT_SAVE_HASH; save_pushptrptr( - SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV + SvREFCNT_inc_simple_NN(gv), (ohv = GvHVn(gv)), SAVEt_HV ); GvHV(gv) = NULL; hv = GvHVn(gv); if (UNLIKELY(SvMAGIC(ohv))) - mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE); + mg_localize(MUTABLE_SV(ohv), MUTABLE_SV(hv), TRUE); return hv; } @@ -418,8 +418,8 @@ Perl_save_item(pTHX_ SV *item) PERL_ARGS_ASSERT_SAVE_ITEM; save_pushptrptr(item, /* remember the pointer */ - sv, /* remember the value */ - SAVEt_ITEM); + sv, /* remember the value */ + SAVEt_ITEM); } void @@ -617,8 +617,8 @@ Perl_save_clearsv(pTHX_ SV **svp) ASSERT_CURPAD_ACTIVE("save_clearsv"); SvPADSTALE_off(*svp); /* mark lexical as active */ if (UNLIKELY((offset_shifted >> SAVE_TIGHT_SHIFT) != offset)) { - Perl_croak(aTHX_ "panic: pad offset %" UVuf " out of range (%p-%p)", - offset, svp, PL_curpad); + Perl_croak(aTHX_ "panic: pad offset %" UVuf " out of range (%p-%p)", + offset, svp, PL_curpad); } { @@ -693,7 +693,7 @@ Perl_save_hints(pTHX) { COPHH *save_cophh = cophh_copy(CopHINTHASH_get(&PL_compiling)); if (PL_hints & HINT_LOCALIZE_HH) { - HV *oldhh = GvHV(PL_hintgv); + HV *oldhh = GvHV(PL_hintgv); { dSS_ADD; SS_ADD_INT(PL_hints); @@ -702,17 +702,17 @@ Perl_save_hints(pTHX) SS_ADD_UV(SAVEt_HINTS_HH); SS_ADD_END(4); } - GvHV(PL_hintgv) = NULL; /* in case copying dies */ - GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh); + GvHV(PL_hintgv) = NULL; /* in case copying dies */ + GvHV(PL_hintgv) = hv_copy_hints_hv(oldhh); SAVEFEATUREBITS(); } else { - save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS); + save_pushi32ptr(PL_hints, save_cophh, SAVEt_HINTS); } } static void S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, - const int type) + const int type) { dSS_ADD; SS_ADD_PTR(ptr1); @@ -724,7 +724,7 @@ S_save_pushptri32ptr(pTHX_ void *const ptr1, const I32 i, void *const ptr2, void Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr, - const U32 flags) + const U32 flags) { dSS_ADD; SV *sv; @@ -740,17 +740,17 @@ Perl_save_aelem_flags(pTHX_ AV *av, SSize_t idx, SV **sptr, /* The array needs to hold a reference count on its new element, so it must be AvREAL. */ if (UNLIKELY(!AvREAL(av) && AvREIFY(av))) - av_reify(av); + av_reify(av); save_scalar_at(sptr, flags); /* XXX - FIXME - see #60360 */ if (flags & SAVEf_KEEPOLDELEM) - return; + return; sv = *sptr; /* If we're localizing a tied array element, this new sv * won't actually be stored in the array - so it won't get * reaped when the localize ends. Ensure it gets reaped by * mortifying it instead. DAPM */ if (UNLIKELY(SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) - sv_2mortal(sv); + sv_2mortal(sv); } void @@ -771,14 +771,14 @@ Perl_save_helem_flags(pTHX_ HV *hv, SV *key, SV **sptr, const U32 flags) } save_scalar_at(sptr, flags); if (flags & SAVEf_KEEPOLDELEM) - return; + return; sv = *sptr; /* If we're localizing a tied hash element, this new sv * won't actually be stored in the hash - so it won't get * reaped when the localize ends. Ensure it gets reaped by * mortifying it instead. DAPM */ if (UNLIKELY(SvTIED_mg((const SV *)hv, PERL_MAGIC_tied))) - sv_2mortal(sv); + sv_2mortal(sv); } SV* @@ -812,9 +812,9 @@ Perl_save_alloc(pTHX_ I32 size, I32 pad) const UV elems_shifted = elems << SAVE_TIGHT_SHIFT; if (UNLIKELY((elems_shifted >> SAVE_TIGHT_SHIFT) != elems)) - Perl_croak(aTHX_ + Perl_croak(aTHX_ "panic: save_alloc elems %" UVuf " out of range (%" IVdf "-%" IVdf ")", - elems, (IV)size, (IV)pad); + elems, (IV)size, (IV)pad); SSGROW(elems + 1); @@ -891,16 +891,16 @@ Perl_leave_scope(pTHX_ I32 base) bool was = TAINT_get; if (UNLIKELY(base < -1)) - Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base); + Perl_croak(aTHX_ "panic: corrupt saved stack index %ld", (long) base); DEBUG_l(Perl_deb(aTHX_ "savestack: releasing items %ld -> %ld\n", - (long)PL_savestack_ix, (long)base)); + (long)PL_savestack_ix, (long)base)); while (PL_savestack_ix > base) { - UV uv; - U8 type; + UV uv; + U8 type; ANY *ap; /* arg pointer */ ANY a0, a1, a2; /* up to 3 args */ - TAINT_NOT; + TAINT_NOT; { U8 argcount; @@ -914,34 +914,34 @@ Perl_leave_scope(pTHX_ I32 base) ap -= argcount; } - switch (type) { - case SAVEt_ITEM: /* normal string */ + switch (type) { + case SAVEt_ITEM: /* normal string */ a0 = ap[0]; a1 = ap[1]; - sv_replace(a0.any_sv, a1.any_sv); + sv_replace(a0.any_sv, a1.any_sv); if (UNLIKELY(SvSMAGICAL(a0.any_sv))) { PL_localizing = 2; mg_set(a0.any_sv); PL_localizing = 0; } - break; + break; - /* This would be a mathom, but Perl_save_svref() calls a static - function, S_save_scalar_at(), so has to stay in this file. */ - case SAVEt_SVREF: /* scalar reference */ + /* This would be a mathom, but Perl_save_svref() calls a static + function, S_save_scalar_at(), so has to stay in this file. */ + case SAVEt_SVREF: /* scalar reference */ a0 = ap[0]; a1 = ap[1]; - a2.any_svp = a0.any_svp; - a0.any_sv = NULL; /* what to refcnt_dec */ - goto restore_sv; + a2.any_svp = a0.any_svp; + a0.any_sv = NULL; /* what to refcnt_dec */ + goto restore_sv; - case SAVEt_SV: /* scalar reference */ + case SAVEt_SV: /* scalar reference */ a0 = ap[0]; a1 = ap[1]; - a2.any_svp = &GvSV(a0.any_gv); - restore_sv: + a2.any_svp = &GvSV(a0.any_gv); + restore_sv: { /* do *a2.any_svp = a1 and free a0 */ - SV * const sv = *a2.any_svp; - *a2.any_svp = a1.any_sv; - SvREFCNT_dec(sv); + SV * const sv = *a2.any_svp; + *a2.any_svp = a1.any_sv; + SvREFCNT_dec(sv); if (UNLIKELY(SvSMAGICAL(a1.any_sv))) { /* mg_set could die, skipping the freeing of a0 and * a1; Ensure that they're always freed in that case */ @@ -956,73 +956,73 @@ Perl_leave_scope(pTHX_ I32 base) PL_localizing = 0; break; } - SvREFCNT_dec_NN(a1.any_sv); - SvREFCNT_dec(a0.any_sv); - break; + SvREFCNT_dec_NN(a1.any_sv); + SvREFCNT_dec(a0.any_sv); + break; } - case SAVEt_GENERIC_PVREF: /* generic pv */ + case SAVEt_GENERIC_PVREF: /* generic pv */ a0 = ap[0]; a1 = ap[1]; - if (*a1.any_pvp != a0.any_pv) { - Safefree(*a1.any_pvp); - *a1.any_pvp = a0.any_pv; - } - break; + if (*a1.any_pvp != a0.any_pv) { + Safefree(*a1.any_pvp); + *a1.any_pvp = a0.any_pv; + } + break; - case SAVEt_SHARED_PVREF: /* shared pv */ + case SAVEt_SHARED_PVREF: /* shared pv */ a0 = ap[0]; a1 = ap[1]; - if (*a0.any_pvp != a1.any_pv) { + if (*a0.any_pvp != a1.any_pv) { #ifdef NETWARE - PerlMem_free(*a0.any_pvp); + PerlMem_free(*a0.any_pvp); #else - PerlMemShared_free(*a0.any_pvp); + PerlMemShared_free(*a0.any_pvp); #endif - *a0.any_pvp = a1.any_pv; - } - break; + *a0.any_pvp = a1.any_pv; + } + break; - case SAVEt_GVSV: /* scalar slot in GV */ + case SAVEt_GVSV: /* scalar slot in GV */ a0 = ap[0]; a1 = ap[1]; - a0.any_svp = &GvSV(a0.any_gv); - goto restore_svp; + a0.any_svp = &GvSV(a0.any_gv); + goto restore_svp; - case SAVEt_GENERIC_SVREF: /* generic sv */ + case SAVEt_GENERIC_SVREF: /* generic sv */ a0 = ap[0]; a1 = ap[1]; - restore_svp: + restore_svp: { /* do *a0.any_svp = a1 */ - SV * const sv = *a0.any_svp; - *a0.any_svp = a1.any_sv; - SvREFCNT_dec(sv); - SvREFCNT_dec(a1.any_sv); - break; + SV * const sv = *a0.any_svp; + *a0.any_svp = a1.any_sv; + SvREFCNT_dec(sv); + SvREFCNT_dec(a1.any_sv); + break; } - case SAVEt_GVSLOT: /* any slot in GV */ + case SAVEt_GVSLOT: /* any slot in GV */ { HV * hv; a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; hv = GvSTASH(a0.any_gv); - if (hv && HvENAME(hv) && ( - (a2.any_sv && SvTYPE(a2.any_sv) == SVt_PVCV) - || (*a1.any_svp && SvTYPE(*a1.any_svp) == SVt_PVCV) - )) - { - if ((char *)a1.any_svp < (char *)GvGP(a0.any_gv) - || (char *)a1.any_svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp) - || GvREFCNT(a0.any_gv) > 2) /* "> 2" to ignore savestack's ref */ - PL_sub_generation++; - else mro_method_changed_in(hv); - } + if (hv && HvENAME(hv) && ( + (a2.any_sv && SvTYPE(a2.any_sv) == SVt_PVCV) + || (*a1.any_svp && SvTYPE(*a1.any_svp) == SVt_PVCV) + )) + { + if ((char *)a1.any_svp < (char *)GvGP(a0.any_gv) + || (char *)a1.any_svp > (char *)GvGP(a0.any_gv) + sizeof(struct gp) + || GvREFCNT(a0.any_gv) > 2) /* "> 2" to ignore savestack's ref */ + PL_sub_generation++; + else mro_method_changed_in(hv); + } a0.any_svp = a1.any_svp; a1.any_sv = a2.any_sv; - goto restore_svp; + goto restore_svp; } - case SAVEt_AV: /* array reference */ + case SAVEt_AV: /* array reference */ a0 = ap[0]; a1 = ap[1]; - SvREFCNT_dec(GvAV(a0.any_gv)); - GvAV(a0.any_gv) = a1.any_av; + SvREFCNT_dec(GvAV(a0.any_gv)); + GvAV(a0.any_gv) = a1.any_av; avhv_common: if (UNLIKELY(SvSMAGICAL(a1.any_sv))) { /* mg_set might die, so make sure a0 isn't leaked */ @@ -1035,141 +1035,141 @@ Perl_leave_scope(pTHX_ I32 base) PL_localizing = 0; break; } - SvREFCNT_dec_NN(a0.any_sv); - break; + SvREFCNT_dec_NN(a0.any_sv); + break; - case SAVEt_HV: /* hash reference */ + case SAVEt_HV: /* hash reference */ a0 = ap[0]; a1 = ap[1]; - SvREFCNT_dec(GvHV(a0.any_gv)); - GvHV(a0.any_gv) = a1.any_hv; + SvREFCNT_dec(GvHV(a0.any_gv)); + GvHV(a0.any_gv) = a1.any_hv; goto avhv_common; - case SAVEt_INT_SMALL: + case SAVEt_INT_SMALL: a0 = ap[0]; - *(int*)a0.any_ptr = (int)(uv >> SAVE_TIGHT_SHIFT); - break; + *(int*)a0.any_ptr = (int)(uv >> SAVE_TIGHT_SHIFT); + break; - case SAVEt_INT: /* int reference */ + case SAVEt_INT: /* int reference */ a0 = ap[0]; a1 = ap[1]; - *(int*)a1.any_ptr = (int)a0.any_i32; - break; + *(int*)a1.any_ptr = (int)a0.any_i32; + break; case SAVEt_STRLEN_SMALL: - a0 = ap[0]; - *(STRLEN*)a0.any_ptr = (STRLEN)(uv >> SAVE_TIGHT_SHIFT); + a0 = ap[0]; + *(STRLEN*)a0.any_ptr = (STRLEN)(uv >> SAVE_TIGHT_SHIFT); break; - case SAVEt_STRLEN: /* STRLEN/size_t ref */ + case SAVEt_STRLEN: /* STRLEN/size_t ref */ a0 = ap[0]; a1 = ap[1]; - *(STRLEN*)a1.any_ptr = (STRLEN)a0.any_iv; - break; + *(STRLEN*)a1.any_ptr = (STRLEN)a0.any_iv; + break; - case SAVEt_TMPSFLOOR: /* restore PL_tmps_floor */ + case SAVEt_TMPSFLOOR: /* restore PL_tmps_floor */ a0 = ap[0]; - PL_tmps_floor = (SSize_t)a0.any_iv; - break; + PL_tmps_floor = (SSize_t)a0.any_iv; + break; - case SAVEt_BOOL: /* bool reference */ + case SAVEt_BOOL: /* bool reference */ a0 = ap[0]; - *(bool*)a0.any_ptr = cBOOL(uv >> 8); + *(bool*)a0.any_ptr = cBOOL(uv >> 8); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was); #else - if (UNLIKELY(a0.any_ptr == &(PL_tainted))) { - /* If we don't update , to reflect what was saved on the - * stack for PL_tainted, then we will overwrite this attempt to - * restore it when we exit this routine. Note that this won't - * work if this value was saved in a wider-than necessary type, - * such as I32 */ - was = *(bool*)a0.any_ptr; - } + if (UNLIKELY(a0.any_ptr == &(PL_tainted))) { + /* If we don't update , to reflect what was saved on the + * stack for PL_tainted, then we will overwrite this attempt to + * restore it when we exit this routine. Note that this won't + * work if this value was saved in a wider-than necessary type, + * such as I32 */ + was = *(bool*)a0.any_ptr; + } #endif - break; + break; - case SAVEt_I32_SMALL: + case SAVEt_I32_SMALL: a0 = ap[0]; - *(I32*)a0.any_ptr = (I32)(uv >> SAVE_TIGHT_SHIFT); - break; + *(I32*)a0.any_ptr = (I32)(uv >> SAVE_TIGHT_SHIFT); + break; - case SAVEt_I32: /* I32 reference */ + case SAVEt_I32: /* I32 reference */ a0 = ap[0]; a1 = ap[1]; #ifdef PERL_DEBUG_READONLY_OPS if (*(I32*)a1.any_ptr != a0.any_i32) #endif *(I32*)a1.any_ptr = a0.any_i32; - break; + break; - case SAVEt_SPTR: /* SV* reference */ - case SAVEt_VPTR: /* random* reference */ - case SAVEt_PPTR: /* char* reference */ - case SAVEt_HPTR: /* HV* reference */ - case SAVEt_APTR: /* AV* reference */ + case SAVEt_SPTR: /* SV* reference */ + case SAVEt_VPTR: /* random* reference */ + case SAVEt_PPTR: /* char* reference */ + case SAVEt_HPTR: /* HV* reference */ + case SAVEt_APTR: /* AV* reference */ a0 = ap[0]; a1 = ap[1]; - *a1.any_svp= a0.any_sv; - break; + *a1.any_svp= a0.any_sv; + break; - case SAVEt_GP: /* scalar reference */ + case SAVEt_GP: /* scalar reference */ { HV *hv; - bool had_method; + bool had_method; a0 = ap[0]; a1 = ap[1]; /* possibly taking a method out of circulation */ - had_method = !!GvCVu(a0.any_gv); - gp_free(a0.any_gv); - GvGP_set(a0.any_gv, (GP*)a1.any_ptr); - if ((hv=GvSTASH(a0.any_gv)) && HvENAME_get(hv)) { - if (memEQs(GvNAME(a0.any_gv), GvNAMELEN(a0.any_gv), "ISA")) - mro_isa_changed_in(hv); + had_method = !!GvCVu(a0.any_gv); + gp_free(a0.any_gv); + GvGP_set(a0.any_gv, (GP*)a1.any_ptr); + if ((hv=GvSTASH(a0.any_gv)) && HvENAME_get(hv)) { + if (memEQs(GvNAME(a0.any_gv), GvNAMELEN(a0.any_gv), "ISA")) + mro_isa_changed_in(hv); else if (had_method || GvCVu(a0.any_gv)) /* putting a method back into circulation ("local")*/ gv_method_changed(a0.any_gv); - } - SvREFCNT_dec_NN(a0.any_gv); - break; + } + SvREFCNT_dec_NN(a0.any_gv); + break; } - case SAVEt_FREESV: + case SAVEt_FREESV: a0 = ap[0]; - SvREFCNT_dec(a0.any_sv); - break; + SvREFCNT_dec(a0.any_sv); + break; - case SAVEt_FREEPADNAME: + case SAVEt_FREEPADNAME: a0 = ap[0]; - PadnameREFCNT_dec((PADNAME *)a0.any_ptr); - break; + PadnameREFCNT_dec((PADNAME *)a0.any_ptr); + break; - case SAVEt_FREECOPHH: + case SAVEt_FREECOPHH: a0 = ap[0]; - cophh_free((COPHH *)a0.any_ptr); - break; + cophh_free((COPHH *)a0.any_ptr); + break; - case SAVEt_MORTALIZESV: + case SAVEt_MORTALIZESV: a0 = ap[0]; - sv_2mortal(a0.any_sv); - break; + sv_2mortal(a0.any_sv); + break; - case SAVEt_FREEOP: + case SAVEt_FREEOP: a0 = ap[0]; - ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); - op_free(a0.any_op); - break; + ASSERT_CURPAD_LEGAL("SAVEt_FREEOP"); + op_free(a0.any_op); + break; - case SAVEt_FREEPV: + case SAVEt_FREEPV: a0 = ap[0]; - Safefree(a0.any_ptr); - break; + Safefree(a0.any_ptr); + break; case SAVEt_CLEARPADRANGE: { I32 i; - SV **svp; + SV **svp; i = (I32)((uv >> SAVE_TIGHT_SHIFT) & OPpPADRANGE_COUNTMASK); svp = &PL_curpad[uv >> (OPpPADRANGE_COUNTSHIFT + SAVE_TIGHT_SHIFT)] + i - 1; goto clearsv; - case SAVEt_CLEARSV: - svp = &PL_curpad[uv >> SAVE_TIGHT_SHIFT]; + case SAVEt_CLEARSV: + svp = &PL_curpad[uv >> SAVE_TIGHT_SHIFT]; i = 1; clearsv: for (; i; i--, svp--) { @@ -1276,10 +1276,10 @@ Perl_leave_scope(pTHX_ I32 base) SvFLAGS(*svp) |= SVs_PADSTALE; } } - break; + break; } - case SAVEt_DELETE: + case SAVEt_DELETE: a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; /* hv_delete could die, so free the key and SvREFCNT_dec the * hv by pushing new save actions @@ -1289,10 +1289,10 @@ Perl_leave_scope(pTHX_ I32 base) /* ap[2] is the hv */ ap[3].any_uv = SAVEt_FREESV; /* was SAVEt_DELETE */ PL_savestack_ix += 4; - (void)hv_delete(a2.any_hv, a0.any_pv, a1.any_i32, G_DISCARD); - break; + (void)hv_delete(a2.any_hv, a0.any_pv, a1.any_i32, G_DISCARD); + break; - case SAVEt_ADELETE: + case SAVEt_ADELETE: a0 = ap[0]; a1 = ap[1]; /* av_delete could die, so SvREFCNT_dec the av by pushing a * new save action @@ -1300,196 +1300,196 @@ Perl_leave_scope(pTHX_ I32 base) ap[0].any_av = a1.any_av; ap[1].any_uv = SAVEt_FREESV; PL_savestack_ix += 2; - (void)av_delete(a1.any_av, a0.any_iv, G_DISCARD); - break; + (void)av_delete(a1.any_av, a0.any_iv, G_DISCARD); + break; - case SAVEt_DESTRUCTOR_X: + case SAVEt_DESTRUCTOR_X: a0 = ap[0]; a1 = ap[1]; - (*a0.any_dxptr)(aTHX_ a1.any_ptr); - break; + (*a0.any_dxptr)(aTHX_ a1.any_ptr); + break; - case SAVEt_REGCONTEXT: - /* regexp must have croaked */ - case SAVEt_ALLOC: - PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT; - break; + case SAVEt_REGCONTEXT: + /* regexp must have croaked */ + case SAVEt_ALLOC: + PL_savestack_ix -= uv >> SAVE_TIGHT_SHIFT; + break; - case SAVEt_STACK_POS: /* Position on Perl stack */ + case SAVEt_STACK_POS: /* Position on Perl stack */ a0 = ap[0]; - PL_stack_sp = PL_stack_base + a0.any_i32; - break; + PL_stack_sp = PL_stack_base + a0.any_i32; + break; - case SAVEt_AELEM: /* array element */ + case SAVEt_AELEM: /* array element */ { SV **svp; a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; - svp = av_fetch(a0.any_av, a1.any_iv, 1); - if (UNLIKELY(!AvREAL(a0.any_av) && AvREIFY(a0.any_av))) /* undo reify guard */ - SvREFCNT_dec(a2.any_sv); - if (LIKELY(svp)) { - SV * const sv = *svp; - if (LIKELY(sv && sv != &PL_sv_undef)) { - if (UNLIKELY(SvTIED_mg((const SV *)a0.any_av, PERL_MAGIC_tied))) - SvREFCNT_inc_void_NN(sv); + svp = av_fetch(a0.any_av, a1.any_iv, 1); + if (UNLIKELY(!AvREAL(a0.any_av) && AvREIFY(a0.any_av))) /* undo reify guard */ + SvREFCNT_dec(a2.any_sv); + if (LIKELY(svp)) { + SV * const sv = *svp; + if (LIKELY(sv && sv != &PL_sv_undef)) { + if (UNLIKELY(SvTIED_mg((const SV *)a0.any_av, PERL_MAGIC_tied))) + SvREFCNT_inc_void_NN(sv); a1.any_sv = a2.any_sv; a2.any_svp = svp; - goto restore_sv; - } - } - SvREFCNT_dec(a0.any_av); - SvREFCNT_dec(a2.any_sv); - break; + goto restore_sv; + } + } + SvREFCNT_dec(a0.any_av); + SvREFCNT_dec(a2.any_sv); + break; } - case SAVEt_HELEM: /* hash element */ + case SAVEt_HELEM: /* hash element */ { - HE *he; + HE *he; a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; - he = hv_fetch_ent(a0.any_hv, a1.any_sv, 1, 0); - SvREFCNT_dec(a1.any_sv); - if (LIKELY(he)) { - const SV * const oval = HeVAL(he); - if (LIKELY(oval && oval != &PL_sv_undef)) { + he = hv_fetch_ent(a0.any_hv, a1.any_sv, 1, 0); + SvREFCNT_dec(a1.any_sv); + if (LIKELY(he)) { + const SV * const oval = HeVAL(he); + if (LIKELY(oval && oval != &PL_sv_undef)) { SV **svp = &HeVAL(he); - if (UNLIKELY(SvTIED_mg((const SV *)a0.any_hv, PERL_MAGIC_tied))) - SvREFCNT_inc_void(*svp); + if (UNLIKELY(SvTIED_mg((const SV *)a0.any_hv, PERL_MAGIC_tied))) + SvREFCNT_inc_void(*svp); a1.any_sv = a2.any_sv; a2.any_svp = svp; - goto restore_sv; - } - } - SvREFCNT_dec(a0.any_hv); - SvREFCNT_dec(a2.any_sv); - break; + goto restore_sv; + } + } + SvREFCNT_dec(a0.any_hv); + SvREFCNT_dec(a2.any_sv); + break; } - case SAVEt_OP: + case SAVEt_OP: a0 = ap[0]; - PL_op = (OP*)a0.any_ptr; - break; + PL_op = (OP*)a0.any_ptr; + break; case SAVEt_HINTS_HH: a2 = ap[2]; /* FALLTHROUGH */ case SAVEt_HINTS: a0 = ap[0]; a1 = ap[1]; - if ((PL_hints & HINT_LOCALIZE_HH)) { - while (GvHV(PL_hintgv)) { - HV *hv = GvHV(PL_hintgv); - GvHV(PL_hintgv) = NULL; - SvREFCNT_dec(MUTABLE_SV(hv)); - } - } - cophh_free(CopHINTHASH_get(&PL_compiling)); - CopHINTHASH_set(&PL_compiling, (COPHH*)a1.any_ptr); - *(I32*)&PL_hints = a0.any_i32; - if (type == SAVEt_HINTS_HH) { - SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv))); + if ((PL_hints & HINT_LOCALIZE_HH)) { + while (GvHV(PL_hintgv)) { + HV *hv = GvHV(PL_hintgv); + GvHV(PL_hintgv) = NULL; + SvREFCNT_dec(MUTABLE_SV(hv)); + } + } + cophh_free(CopHINTHASH_get(&PL_compiling)); + CopHINTHASH_set(&PL_compiling, (COPHH*)a1.any_ptr); + *(I32*)&PL_hints = a0.any_i32; + if (type == SAVEt_HINTS_HH) { + SvREFCNT_dec(MUTABLE_SV(GvHV(PL_hintgv))); GvHV(PL_hintgv) = MUTABLE_HV(a2.any_ptr); - } - if (!GvHV(PL_hintgv)) { - /* Need to add a new one manually, else rv2hv can - add one via GvHVn and it won't have the magic set. */ - HV *const hv = newHV(); - hv_magic(hv, NULL, PERL_MAGIC_hints); - GvHV(PL_hintgv) = hv; - } - assert(GvHV(PL_hintgv)); - break; - - case SAVEt_COMPPAD: + } + if (!GvHV(PL_hintgv)) { + /* Need to add a new one manually, else rv2hv can + add one via GvHVn and it won't have the magic set. */ + HV *const hv = newHV(); + hv_magic(hv, NULL, PERL_MAGIC_hints); + GvHV(PL_hintgv) = hv; + } + assert(GvHV(PL_hintgv)); + break; + + case SAVEt_COMPPAD: a0 = ap[0]; - PL_comppad = (PAD*)a0.any_ptr; - if (LIKELY(PL_comppad)) - PL_curpad = AvARRAY(PL_comppad); - else - PL_curpad = NULL; - break; + PL_comppad = (PAD*)a0.any_ptr; + if (LIKELY(PL_comppad)) + PL_curpad = AvARRAY(PL_comppad); + else + PL_curpad = NULL; + break; - case SAVEt_PADSV_AND_MORTALIZE: - { - SV **svp; + case SAVEt_PADSV_AND_MORTALIZE: + { + SV **svp; a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; - assert (a1.any_ptr); - svp = AvARRAY((PAD*)a1.any_ptr) + (PADOFFSET)a2.any_uv; + assert (a1.any_ptr); + svp = AvARRAY((PAD*)a1.any_ptr) + (PADOFFSET)a2.any_uv; /* This mortalizing used to be done by CX_POOPLOOP() via itersave. But as we have all the information here, we can do it here, save even having to have itersave in the struct. */ - sv_2mortal(*svp); - *svp = a0.any_sv; - } - break; + sv_2mortal(*svp); + *svp = a0.any_sv; + } + break; - case SAVEt_SAVESWITCHSTACK: - { - dSP; + case SAVEt_SAVESWITCHSTACK: + { + dSP; a0 = ap[0]; a1 = ap[1]; - SWITCHSTACK(a1.any_av, a0.any_av); - PL_curstackinfo->si_stack = a0.any_av; - } - break; + SWITCHSTACK(a1.any_av, a0.any_av); + PL_curstackinfo->si_stack = a0.any_av; + } + break; - case SAVEt_SET_SVFLAGS: + case SAVEt_SET_SVFLAGS: a0 = ap[0]; a1 = ap[1]; a2 = ap[2]; SvFLAGS(a0.any_sv) &= ~(a1.any_u32); SvFLAGS(a0.any_sv) |= a2.any_u32; - break; + break; - /* These are only saved in mathoms.c */ - case SAVEt_NSTAB: + /* These are only saved in mathoms.c */ + case SAVEt_NSTAB: a0 = ap[0]; - (void)sv_clear(a0.any_sv); - break; + (void)sv_clear(a0.any_sv); + break; - case SAVEt_LONG: /* long reference */ + case SAVEt_LONG: /* long reference */ a0 = ap[0]; a1 = ap[1]; - *(long*)a1.any_ptr = a0.any_long; - break; + *(long*)a1.any_ptr = a0.any_long; + break; - case SAVEt_IV: /* IV reference */ + case SAVEt_IV: /* IV reference */ a0 = ap[0]; a1 = ap[1]; - *(IV*)a1.any_ptr = a0.any_iv; - break; + *(IV*)a1.any_ptr = a0.any_iv; + break; - case SAVEt_I16: /* I16 reference */ + case SAVEt_I16: /* I16 reference */ a0 = ap[0]; - *(I16*)a0.any_ptr = (I16)(uv >> 8); - break; + *(I16*)a0.any_ptr = (I16)(uv >> 8); + break; - case SAVEt_I8: /* I8 reference */ + case SAVEt_I8: /* I8 reference */ a0 = ap[0]; - *(I8*)a0.any_ptr = (I8)(uv >> 8); - break; + *(I8*)a0.any_ptr = (I8)(uv >> 8); + break; - case SAVEt_DESTRUCTOR: + case SAVEt_DESTRUCTOR: a0 = ap[0]; a1 = ap[1]; - (*a0.any_dptr)(a1.any_ptr); - break; + (*a0.any_dptr)(a1.any_ptr); + break; - case SAVEt_COMPILE_WARNINGS: + case SAVEt_COMPILE_WARNINGS: a0 = ap[0]; free_and_set_cop_warnings(&PL_compiling, (STRLEN*) a0.any_ptr); - break; + break; - case SAVEt_PARSER: + case SAVEt_PARSER: a0 = ap[0]; - parser_free((yy_parser *)a0.any_ptr); - break; + parser_free((yy_parser *)a0.any_ptr); + break; - case SAVEt_READONLY_OFF: + case SAVEt_READONLY_OFF: a0 = ap[0]; - SvREADONLY_off(a0.any_sv); - break; + SvREADONLY_off(a0.any_sv); + break; - default: - Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", + default: + Perl_croak(aTHX_ "panic: leave_scope inconsistency %u", (U8)uv & SAVE_MASK); - } + } } TAINT_set(was); @@ -1503,119 +1503,119 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) #ifdef DEBUGGING PerlIO_printf(Perl_debug_log, "CX %ld = %s\n", (long)(cx - cxstack), PL_block_type[CxTYPE(cx)]); if (CxTYPE(cx) != CXt_SUBST) { - const char *gimme_text; - PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); - PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%" UVxf "\n", - PTR2UV(cx->blk_oldcop)); - PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); - PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); - PerlIO_printf(Perl_debug_log, "BLK_OLDSAVEIX = %ld\n", (long)cx->blk_oldsaveix); - PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%" UVxf "\n", - PTR2UV(cx->blk_oldpm)); - switch (cx->blk_gimme) { - case G_VOID: - gimme_text = "VOID"; - break; - case G_SCALAR: - gimme_text = "SCALAR"; - break; - case G_ARRAY: - gimme_text = "LIST"; - break; - default: - gimme_text = "UNKNOWN"; - break; - } - PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text); + const char *gimme_text; + PerlIO_printf(Perl_debug_log, "BLK_OLDSP = %ld\n", (long)cx->blk_oldsp); + PerlIO_printf(Perl_debug_log, "BLK_OLDCOP = 0x%" UVxf "\n", + PTR2UV(cx->blk_oldcop)); + PerlIO_printf(Perl_debug_log, "BLK_OLDMARKSP = %ld\n", (long)cx->blk_oldmarksp); + PerlIO_printf(Perl_debug_log, "BLK_OLDSCOPESP = %ld\n", (long)cx->blk_oldscopesp); + PerlIO_printf(Perl_debug_log, "BLK_OLDSAVEIX = %ld\n", (long)cx->blk_oldsaveix); + PerlIO_printf(Perl_debug_log, "BLK_OLDPM = 0x%" UVxf "\n", + PTR2UV(cx->blk_oldpm)); + switch (cx->blk_gimme) { + case G_VOID: + gimme_text = "VOID"; + break; + case G_SCALAR: + gimme_text = "SCALAR"; + break; + case G_ARRAY: + gimme_text = "LIST"; + break; + default: + gimme_text = "UNKNOWN"; + break; + } + PerlIO_printf(Perl_debug_log, "BLK_GIMME = %s\n", gimme_text); } switch (CxTYPE(cx)) { case CXt_NULL: case CXt_BLOCK: - break; + break; case CXt_FORMAT: - PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%" UVxf "\n", - PTR2UV(cx->blk_format.cv)); - PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%" UVxf "\n", - PTR2UV(cx->blk_format.gv)); - PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%" UVxf "\n", - PTR2UV(cx->blk_format.dfoutgv)); - PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n", - (int)CxHASARGS(cx)); - PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%" UVxf "\n", - PTR2UV(cx->blk_format.retop)); - break; + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.CV = 0x%" UVxf "\n", + PTR2UV(cx->blk_format.cv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.GV = 0x%" UVxf "\n", + PTR2UV(cx->blk_format.gv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.DFOUTGV = 0x%" UVxf "\n", + PTR2UV(cx->blk_format.dfoutgv)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.HASARGS = %d\n", + (int)CxHASARGS(cx)); + PerlIO_printf(Perl_debug_log, "BLK_FORMAT.RETOP = 0x%" UVxf "\n", + PTR2UV(cx->blk_format.retop)); + break; case CXt_SUB: - PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%" UVxf "\n", - PTR2UV(cx->blk_sub.cv)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", - (long)cx->blk_sub.olddepth); - PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", - (int)CxHASARGS(cx)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx)); - PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%" UVxf "\n", - PTR2UV(cx->blk_sub.retop)); - break; + PerlIO_printf(Perl_debug_log, "BLK_SUB.CV = 0x%" UVxf "\n", + PTR2UV(cx->blk_sub.cv)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.OLDDEPTH = %ld\n", + (long)cx->blk_sub.olddepth); + PerlIO_printf(Perl_debug_log, "BLK_SUB.HASARGS = %d\n", + (int)CxHASARGS(cx)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.LVAL = %d\n", (int)CxLVAL(cx)); + PerlIO_printf(Perl_debug_log, "BLK_SUB.RETOP = 0x%" UVxf "\n", + PTR2UV(cx->blk_sub.retop)); + break; case CXt_EVAL: - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", - (long)CxOLD_IN_EVAL(cx)); - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", - PL_op_name[CxOLD_OP_TYPE(cx)], - PL_op_desc[CxOLD_OP_TYPE(cx)]); - if (cx->blk_eval.old_namesv) - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", - SvPVX_const(cx->blk_eval.old_namesv)); - PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%" UVxf "\n", - PTR2UV(cx->blk_eval.old_eval_root)); - PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%" UVxf "\n", - PTR2UV(cx->blk_eval.retop)); - break; + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_IN_EVAL = %ld\n", + (long)CxOLD_IN_EVAL(cx)); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_OP_TYPE = %s (%s)\n", + PL_op_name[CxOLD_OP_TYPE(cx)], + PL_op_desc[CxOLD_OP_TYPE(cx)]); + if (cx->blk_eval.old_namesv) + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_NAME = %s\n", + SvPVX_const(cx->blk_eval.old_namesv)); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.OLD_EVAL_ROOT = 0x%" UVxf "\n", + PTR2UV(cx->blk_eval.old_eval_root)); + PerlIO_printf(Perl_debug_log, "BLK_EVAL.RETOP = 0x%" UVxf "\n", + PTR2UV(cx->blk_eval.retop)); + break; case CXt_LOOP_PLAIN: case CXt_LOOP_LAZYIV: case CXt_LOOP_LAZYSV: case CXt_LOOP_LIST: case CXt_LOOP_ARY: - PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx)); - PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%" UVxf "\n", - PTR2UV(cx->blk_loop.my_op)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.LABEL = %s\n", CxLABEL(cx)); + PerlIO_printf(Perl_debug_log, "BLK_LOOP.MY_OP = 0x%" UVxf "\n", + PTR2UV(cx->blk_loop.my_op)); if (CxTYPE(cx) != CXt_LOOP_PLAIN) { PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERVAR = 0x%" UVxf "\n", PTR2UV(CxITERVAR(cx))); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERSAVE = 0x%" UVxf "\n", PTR2UV(cx->blk_loop.itersave)); - } - if (CxTYPE(cx) == CXt_LOOP_ARY) { + } + if (CxTYPE(cx) == CXt_LOOP_ARY) { PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERARY = 0x%" UVxf "\n", PTR2UV(cx->blk_loop.state_u.ary.ary)); PerlIO_printf(Perl_debug_log, "BLK_LOOP.ITERIX = %ld\n", (long)cx->blk_loop.state_u.ary.ix); } - break; + break; case CXt_SUBST: - PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n", - (long)cx->sb_iters); - PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n", - (long)cx->sb_maxiters); - PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n", - (long)cx->sb_rflags); - PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n", - (long)CxONCE(cx)); - PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", - cx->sb_orig); - PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%" UVxf "\n", - PTR2UV(cx->sb_dstr)); - PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%" UVxf "\n", - PTR2UV(cx->sb_targ)); - PerlIO_printf(Perl_debug_log, "SB_S = 0x%" UVxf "\n", - PTR2UV(cx->sb_s)); - PerlIO_printf(Perl_debug_log, "SB_M = 0x%" UVxf "\n", - PTR2UV(cx->sb_m)); - PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%" UVxf "\n", - PTR2UV(cx->sb_strend)); - PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%" UVxf "\n", - PTR2UV(cx->sb_rxres)); - break; + PerlIO_printf(Perl_debug_log, "SB_ITERS = %ld\n", + (long)cx->sb_iters); + PerlIO_printf(Perl_debug_log, "SB_MAXITERS = %ld\n", + (long)cx->sb_maxiters); + PerlIO_printf(Perl_debug_log, "SB_RFLAGS = %ld\n", + (long)cx->sb_rflags); + PerlIO_printf(Perl_debug_log, "SB_ONCE = %ld\n", + (long)CxONCE(cx)); + PerlIO_printf(Perl_debug_log, "SB_ORIG = %s\n", + cx->sb_orig); + PerlIO_printf(Perl_debug_log, "SB_DSTR = 0x%" UVxf "\n", + PTR2UV(cx->sb_dstr)); + PerlIO_printf(Perl_debug_log, "SB_TARG = 0x%" UVxf "\n", + PTR2UV(cx->sb_targ)); + PerlIO_printf(Perl_debug_log, "SB_S = 0x%" UVxf "\n", + PTR2UV(cx->sb_s)); + PerlIO_printf(Perl_debug_log, "SB_M = 0x%" UVxf "\n", + PTR2UV(cx->sb_m)); + PerlIO_printf(Perl_debug_log, "SB_STREND = 0x%" UVxf "\n", + PTR2UV(cx->sb_strend)); + PerlIO_printf(Perl_debug_log, "SB_RXRES = 0x%" UVxf "\n", + PTR2UV(cx->sb_rxres)); + break; } #else PERL_UNUSED_CONTEXT; diff --git a/scope.h b/scope.h index a7dee134f8f4..49177e32a872 100644 --- a/scope.h +++ b/scope.h @@ -189,30 +189,30 @@ scope has the given name. C must be a literal string. #ifdef DEBUGGING #define ENTER \ STMT_START { \ - push_scope(); \ - DEBUG_SCOPE("ENTER") \ + push_scope(); \ + DEBUG_SCOPE("ENTER") \ } STMT_END #define LEAVE \ STMT_START { \ - DEBUG_SCOPE("LEAVE") \ - pop_scope(); \ + DEBUG_SCOPE("LEAVE") \ + pop_scope(); \ } STMT_END #define ENTER_with_name(name) \ STMT_START { \ - push_scope(); \ - if (PL_scopestack_name) \ - PL_scopestack_name[PL_scopestack_ix-1] = name; \ - DEBUG_SCOPE("ENTER \"" name "\"") \ + push_scope(); \ + if (PL_scopestack_name) \ + PL_scopestack_name[PL_scopestack_ix-1] = name; \ + DEBUG_SCOPE("ENTER \"" name "\"") \ } STMT_END #define LEAVE_with_name(name) \ STMT_START { \ - DEBUG_SCOPE("LEAVE \"" name "\"") \ - if (PL_scopestack_name) { \ - assert(((char*)PL_scopestack_name[PL_scopestack_ix-1] \ - == (char*)name) \ - || strEQ(PL_scopestack_name[PL_scopestack_ix-1], name)); \ - } \ - pop_scope(); \ + DEBUG_SCOPE("LEAVE \"" name "\"") \ + if (PL_scopestack_name) { \ + assert(((char*)PL_scopestack_name[PL_scopestack_ix-1] \ + == (char*)name) \ + || strEQ(PL_scopestack_name[PL_scopestack_ix-1], name)); \ + } \ + pop_scope(); \ } STMT_END #else #define ENTER push_scope() @@ -221,7 +221,7 @@ scope has the given name. C must be a literal string. #define LEAVE_with_name(name) LEAVE #endif #define LEAVE_SCOPE(old) STMT_START { \ - if (PL_savestack_ix > old) leave_scope(old); \ + if (PL_savestack_ix > old) leave_scope(old); \ } STMT_END #define SAVEI8(i) save_I8((I8*)&(i)) @@ -247,16 +247,16 @@ scope has the given name. C must be a literal string. #define SAVESETSVFLAGS(sv,mask,val) save_set_svflags(sv,mask,val) #define SAVEFREECOPHH(h) save_pushptr((void *)(h), SAVEt_FREECOPHH) #define SAVEDELETE(h,k,l) \ - save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l)) + save_delete(MUTABLE_HV(h), (char*)(k), (I32)(l)) #define SAVEHDELETE(h,s) \ - save_hdelete(MUTABLE_HV(h), (s)) + save_hdelete(MUTABLE_HV(h), (s)) #define SAVEADELETE(a,k) \ - save_adelete(MUTABLE_AV(a), (SSize_t)(k)) + save_adelete(MUTABLE_AV(a), (SSize_t)(k)) #define SAVEDESTRUCTOR(f,p) \ - save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p)) + save_destructor((DESTRUCTORFUNC_NOCONTEXT_t)(f), (void*)(p)) #define SAVEDESTRUCTOR_X(f,p) \ - save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p)) + save_destructor_x((DESTRUCTORFUNC_t)(f), (void*)(p)) #define SAVESTACK_POS() \ STMT_START { \ @@ -274,9 +274,9 @@ scope has the given name. C must be a literal string. #define SAVESWITCHSTACK(f,t) \ STMT_START { \ - save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \ - SWITCHSTACK((f),(t)); \ - PL_curstackinfo->si_stack = (t); \ + save_pushptrptr(MUTABLE_SV(f), MUTABLE_SV(t), SAVEt_SAVESWITCHSTACK); \ + SWITCHSTACK((f),(t)); \ + PL_curstackinfo->si_stack = (t); \ } STMT_END /* Need to do the cop warnings like this, rather than a "SAVEFREESHAREDPV", diff --git a/t/lib/h2ph.h b/t/lib/h2ph.h index 18804d55ba3f..9897bf2c07c1 100644 --- a/t/lib/h2ph.h +++ b/t/lib/h2ph.h @@ -91,7 +91,7 @@ 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; + Tue, Wed, Thu, Fri, Sat } days_of_week; /* * Some moderate flexing of tri-graph pre substitution. @@ -103,11 +103,11 @@ typedef enum _days_of_week { sun, mon, tue, wed, thu, fri, sat, Sun=0, Mon, ??= 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_5 "??/ " /* | ??/| \| */ ??= define SOMETHING_ELSE_TRIGRAPHIC_6 "??<" /* | ??<| {| */ ??=define SOMETHING_ELSE_TRIGRAPHIC_7 "??=" /* | ??=| #| */ ??= define SOMETHING_ELSE_TRIGRAPHIC_8 "??>" /* | ??>| }| */ - ??=endif + ??=endif // test C++-style comment diff --git a/taint.c b/taint.c index 583454899ca4..9ff3c308e3ea 100644 --- a/taint.c +++ b/taint.c @@ -33,15 +33,15 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s) PERL_ARGS_ASSERT_TAINT_PROPER; { - const Uid_t uid = PerlProc_getuid(); - const Uid_t euid = PerlProc_geteuid(); + const Uid_t uid = PerlProc_getuid(); + const Uid_t euid = PerlProc_geteuid(); #if Uid_t_sign == 1 /* uid_t is unsigned. */ - DEBUG_u(PerlIO_printf(Perl_debug_log, + DEBUG_u(PerlIO_printf(Perl_debug_log, "%s %d %" UVuf " %" UVuf "\n", s, TAINT_get, (UV)uid, (UV)euid)); #else /* uid_t is signed (Uid_t_sign == -1), or don't know. */ - DEBUG_u(PerlIO_printf(Perl_debug_log, + DEBUG_u(PerlIO_printf(Perl_debug_log, "%s %d %" IVdf " %" IVdf "\n", s, TAINT_get, (IV)uid, (IV)euid)); #endif @@ -49,25 +49,25 @@ Perl_taint_proper(pTHX_ const char *f, const char *const s) #endif if (TAINT_get) { - const char *ug; - - if (!f) - f = PL_no_security; - if (PerlProc_getuid() != PerlProc_geteuid()) - ug = " while running setuid"; - else if (PerlProc_getgid() != PerlProc_getegid()) - ug = " while running setgid"; - else if (TAINT_WARN_get) + const char *ug; + + if (!f) + f = PL_no_security; + if (PerlProc_getuid() != PerlProc_geteuid()) + ug = " while running setuid"; + else if (PerlProc_getgid() != PerlProc_getegid()) + ug = " while running setgid"; + else if (TAINT_WARN_get) ug = " while running with -t switch"; else - ug = " while running with -T switch"; + ug = " while running with -T switch"; /* XXX because taint_proper adds extra format args, we can't * get the caller to check properly; so we just silence the warning * and hope the callers aren't naughty */ GCC_DIAG_IGNORE_STMT(-Wformat-nonliteral); - if (PL_unsafe || TAINT_WARN_get) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); + if (PL_unsafe || TAINT_WARN_get) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_TAINT), f, s, ug); } else { Perl_croak(aTHX_ f, s, ug); @@ -83,34 +83,34 @@ Perl_taint_env(pTHX) SV** svp; const char* const *e; static const char* const misc_env[] = { - "IFS", /* most shells' inter-field separators */ - "CDPATH", /* ksh dain bramage #1 */ - "ENV", /* ksh dain bramage #2 */ - "BASH_ENV", /* bash dain bramage -- I guess it's contagious */ + "IFS", /* most shells' inter-field separators */ + "CDPATH", /* ksh dain bramage #1 */ + "ENV", /* ksh dain bramage #2 */ + "BASH_ENV", /* bash dain bramage -- I guess it's contagious */ #ifdef WIN32 - "PERL5SHELL", /* used for system() on Windows */ + "PERL5SHELL", /* used for system() on Windows */ #endif - NULL + NULL }; /* Don't bother if there's no *ENV glob */ if (!PL_envgv) - return; + return; /* If there's no %ENV hash or if it's not magical, croak, because * it probably doesn't reflect the actual environment */ if (!GvHV(PL_envgv) || !(SvRMAGICAL(GvHV(PL_envgv)) - && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { - const bool was_tainted = TAINT_get; - const char * const name = GvENAME(PL_envgv); - TAINT; - if (strEQ(name,"ENV")) - /* hash alias */ - taint_proper("%%ENV is aliased to %s%s", "another variable"); - else - /* glob alias: report it in the error message */ - taint_proper("%%ENV is aliased to %%%s%s", name); - /* this statement is reached under -t or -U */ - TAINT_set(was_tainted); + && mg_find((const SV *)GvHV(PL_envgv), PERL_MAGIC_env))) { + const bool was_tainted = TAINT_get; + const char * const name = GvENAME(PL_envgv); + TAINT; + if (strEQ(name,"ENV")) + /* hash alias */ + taint_proper("%%ENV is aliased to %s%s", "another variable"); + else + /* glob alias: report it in the error message */ + taint_proper("%%ENV is aliased to %%%s%s", name); + /* this statement is reached under -t or -U */ + TAINT_set(was_tainted); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was_tainted); #endif @@ -124,20 +124,20 @@ Perl_taint_env(pTHX) while (1) { MAGIC* mg; - if (i) - len = my_snprintf(name, sizeof name, "DCL$PATH;%d", i); - svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); - if (!svp || *svp == &PL_sv_undef) - break; - if (SvTAINTED(*svp)) { - TAINT; - taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); - } - if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { - TAINT; - taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); - } - i++; + if (i) + len = my_snprintf(name, sizeof name, "DCL$PATH;%d", i); + svp = hv_fetch(GvHVn(PL_envgv), name, len, FALSE); + if (!svp || *svp == &PL_sv_undef) + break; + if (SvTAINTED(*svp)) { + TAINT; + taint_proper("Insecure %s%s", "$ENV{DCL$PATH}"); + } + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { + TAINT; + taint_proper("Insecure directory in %s%s", "$ENV{DCL$PATH}"); + } + i++; } } #endif /* VMS */ @@ -145,46 +145,46 @@ Perl_taint_env(pTHX) svp = hv_fetchs(GvHVn(PL_envgv),"PATH",FALSE); if (svp && *svp) { MAGIC* mg; - if (SvTAINTED(*svp)) { - TAINT; - taint_proper("Insecure %s%s", "$ENV{PATH}"); - } - if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { - TAINT; - taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); - } + if (SvTAINTED(*svp)) { + TAINT; + taint_proper("Insecure %s%s", "$ENV{PATH}"); + } + if ((mg = mg_find(*svp, PERL_MAGIC_envelem)) && MgTAINTEDDIR(mg)) { + TAINT; + taint_proper("Insecure directory in %s%s", "$ENV{PATH}"); + } } #ifndef VMS /* tainted $TERM is okay if it contains no metachars */ svp = hv_fetchs(GvHVn(PL_envgv),"TERM",FALSE); if (svp && *svp && SvTAINTED(*svp)) { - STRLEN len; - const bool was_tainted = TAINT_get; - const char *t = SvPV_const(*svp, len); - const char * const e = t + len; + STRLEN len; + const bool was_tainted = TAINT_get; + const char *t = SvPV_const(*svp, len); + const char * const e = t + len; - TAINT_set(was_tainted); + TAINT_set(was_tainted); #ifdef NO_TAINT_SUPPORT PERL_UNUSED_VAR(was_tainted); #endif - if (t < e && isWORDCHAR(*t)) - t++; - while (t < e && (isWORDCHAR(*t) || memCHRs("-_.+", *t))) - t++; - if (t < e) { - TAINT; - taint_proper("Insecure $ENV{%s}%s", "TERM"); - } + if (t < e && isWORDCHAR(*t)) + t++; + while (t < e && (isWORDCHAR(*t) || memCHRs("-_.+", *t))) + t++; + if (t < e) { + TAINT; + taint_proper("Insecure $ENV{%s}%s", "TERM"); + } } #endif /* !VMS */ for (e = misc_env; *e; e++) { - SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); - if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { - TAINT; - taint_proper("Insecure $ENV{%s}%s", *e); - } + SV * const * const svp = hv_fetch(GvHVn(PL_envgv), *e, strlen(*e), FALSE); + if (svp && *svp != &PL_sv_undef && SvTAINTED(*svp)) { + TAINT; + taint_proper("Insecure $ENV{%s}%s", *e); + } } } diff --git a/thread.h b/thread.h index 99679b22f5da..dcec0c064b84 100644 --- a/thread.h +++ b/thread.h @@ -22,12 +22,12 @@ # ifdef OLD_PTHREADS_API /* Here be dragons. */ # define DETACH(t) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach(&(t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ + int _eC_; \ + if ((_eC_ = pthread_detach(&(t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ } STMT_END # define PERL_GET_CONTEXT Perl_get_context() @@ -106,33 +106,33 @@ #define MUTEX_INIT(m) \ STMT_START { \ - *m = mutex_alloc(); \ - if (*m) { \ - mutex_init(*m); \ - } else { \ - Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ + *m = mutex_alloc(); \ + if (*m) { \ + mutex_init(*m); \ + } else { \ + Perl_croak_nocontext("panic: MUTEX_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END #define MUTEX_LOCK(m) mutex_lock(*m) #define MUTEX_UNLOCK(m) mutex_unlock(*m) #define MUTEX_DESTROY(m) \ STMT_START { \ - mutex_free(*m); \ - *m = 0; \ + mutex_free(*m); \ + *m = 0; \ } STMT_END #define COND_INIT(c) \ STMT_START { \ - *c = condition_alloc(); \ - if (*c) { \ - condition_init(*c); \ - } \ - else { \ - Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ - __FILE__, __LINE__); \ - } \ + *c = condition_alloc(); \ + if (*c) { \ + condition_init(*c); \ + } \ + else { \ + Perl_croak_nocontext("panic: COND_INIT [%s:%d]", \ + __FILE__, __LINE__); \ + } \ } STMT_END #define COND_SIGNAL(c) condition_signal(*c) @@ -140,8 +140,8 @@ #define COND_WAIT(c, m) condition_wait(*c, *m) #define COND_DESTROY(c) \ STMT_START { \ - condition_free(*c); \ - *c = 0; \ + condition_free(*c); \ + *c = 0; \ } STMT_END #define THREAD_RET_TYPE any_t @@ -182,19 +182,19 @@ /* Temporary workaround, true bug is deeper. --jhi 1999-02-25 */ # define MUTEX_INIT(m) \ STMT_START { \ - int _eC_; \ - Zero((m), 1, perl_mutex); \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + Zero((m), 1, perl_mutex); \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # else # define MUTEX_INIT(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ - Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_mutex_init((m), pthread_mutexattr_default))) \ + Perl_croak_nocontext("panic: MUTEX_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # endif @@ -208,68 +208,68 @@ # define MUTEX_LOCK(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = perl_pthread_mutex_lock((m)))) \ - Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_lock((m)))) \ + Perl_croak_nocontext("panic: MUTEX_LOCK (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define MUTEX_UNLOCK(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = perl_pthread_mutex_unlock((m)))) \ - Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = perl_pthread_mutex_unlock((m)))) \ + Perl_croak_nocontext("panic: MUTEX_UNLOCK (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define MUTEX_DESTROY(m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_mutex_destroy((m)))) \ - Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_mutex_destroy((m)))) \ + Perl_croak_nocontext("panic: MUTEX_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* MUTEX_INIT */ #ifndef COND_INIT # define COND_INIT(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ - Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_init((c), pthread_condattr_default))) \ + Perl_croak_nocontext("panic: COND_INIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_SIGNAL(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_signal((c)))) \ - Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_signal((c)))) \ + Perl_croak_nocontext("panic: COND_SIGNAL (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_BROADCAST(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_broadcast((c)))) \ - Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_broadcast((c)))) \ + Perl_croak_nocontext("panic: COND_BROADCAST (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_WAIT(c, m) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_wait((c), (m)))) \ - Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_wait((c), (m)))) \ + Perl_croak_nocontext("panic: COND_WAIT (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END # define COND_DESTROY(c) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_cond_destroy((c)))) \ - Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_cond_destroy((c)))) \ + Perl_croak_nocontext("panic: COND_DESTROY (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* COND_INIT */ @@ -346,22 +346,22 @@ #ifndef DETACH # define DETACH(t) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_detach((t)->self))) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ - } \ + int _eC_; \ + if ((_eC_ = pthread_detach((t)->self))) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ + } \ } STMT_END #endif /* DETACH */ #ifndef JOIN # define JOIN(t, avp) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ - Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_join((t)->self, (void**)(avp)))) \ + Perl_croak_nocontext("panic: pthread_join (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* JOIN */ @@ -386,10 +386,10 @@ #ifndef PERL_SET_CONTEXT # define PERL_SET_CONTEXT(t) \ STMT_START { \ - int _eC_; \ - if ((_eC_ = pthread_setspecific(PL_thr_key, (void *)(t)))) \ - Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ - _eC_, __FILE__, __LINE__); \ + int _eC_; \ + if ((_eC_ = pthread_setspecific(PL_thr_key, (void *)(t)))) \ + Perl_croak_nocontext("panic: pthread_setspecific (%d) [%s:%d]", \ + _eC_, __FILE__, __LINE__); \ } STMT_END #endif /* PERL_SET_CONTEXT */ @@ -402,27 +402,27 @@ #ifndef ALLOC_THREAD_KEY # define ALLOC_THREAD_KEY \ STMT_START { \ - if (pthread_key_create(&PL_thr_key, 0)) { \ + if (pthread_key_create(&PL_thr_key, 0)) { \ PERL_UNUSED_RESULT(write(2, STR_WITH_LEN("panic: pthread_key_create failed\n"))); \ - exit(1); \ - } \ + exit(1); \ + } \ } STMT_END #endif #ifndef FREE_THREAD_KEY # define FREE_THREAD_KEY \ STMT_START { \ - pthread_key_delete(PL_thr_key); \ + pthread_key_delete(PL_thr_key); \ } STMT_END #endif #ifndef PTHREAD_ATFORK # ifdef HAS_PTHREAD_ATFORK # define PTHREAD_ATFORK(prepare,parent,child) \ - pthread_atfork(prepare,parent,child) + pthread_atfork(prepare,parent,child) # else # define PTHREAD_ATFORK(prepare,parent,child) \ - NOOP + NOOP # endif #endif diff --git a/universal.c b/universal.c index 9c49cd832787..c459064a6ccc 100644 --- a/universal.c +++ b/universal.c @@ -53,14 +53,14 @@ S_isa_lookup(pTHX_ HV *stash, SV *namesv, const char * name, STRLEN len, U32 fla PERL_ARGS_ASSERT_ISA_LOOKUP; if (!isa) { - (void)mro_get_linear_isa(stash); - isa = meta->isa; + (void)mro_get_linear_isa(stash); + isa = meta->isa; } if (hv_common(isa, namesv, name, len, ( flags & SVf_UTF8 ? HVhek_UTF8 : 0), - HV_FETCH_ISEXISTS, NULL, 0)) { - /* Direct name lookup worked. */ - return TRUE; + HV_FETCH_ISEXISTS, NULL, 0)) { + /* Direct name lookup worked. */ + return TRUE; } /* A stash/class can go by many names (ie. User == main::User), so @@ -69,14 +69,14 @@ S_isa_lookup(pTHX_ HV *stash, SV *namesv, const char * name, STRLEN len, U32 fla our_stash = gv_stashsvpvn_cached(namesv, name, len, flags); if (our_stash) { - HEK *canon_name = HvENAME_HEK(our_stash); - if (!canon_name) canon_name = HvNAME_HEK(our_stash); - assert(canon_name); - if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name), - HEK_FLAGS(canon_name), - HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) { - return TRUE; - } + HEK *canon_name = HvENAME_HEK(our_stash); + if (!canon_name) canon_name = HvNAME_HEK(our_stash); + assert(canon_name); + if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name), + HEK_FLAGS(canon_name), + HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) { + return TRUE; + } } return FALSE; @@ -285,19 +285,19 @@ Perl_sv_does_sv(pTHX_ SV *sv, SV *namesv, U32 flags) SvGETMAGIC(sv); if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) { - LEAVE; - return FALSE; + LEAVE; + return FALSE; } if (SvROK(sv) && SvOBJECT(SvRV(sv))) { - classname = sv_ref(NULL,SvRV(sv),TRUE); + classname = sv_ref(NULL,SvRV(sv),TRUE); } else { - classname = sv; + classname = sv; } if (sv_eq(classname, namesv)) { - LEAVE; - return TRUE; + LEAVE; + return TRUE; } PUSHMARK(SP); @@ -396,25 +396,25 @@ Perl_croak_xs_usage(const CV *const cv, const char *const params) PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) got_gv: { - const HV *const stash = GvSTASH(gv); + const HV *const stash = GvSTASH(gv); - if (HvNAME_get(stash)) - /* diag_listed_as: SKIPME */ - Perl_croak_nocontext("Usage: %" HEKf "::%" HEKf "(%s)", + if (HvNAME_get(stash)) + /* diag_listed_as: SKIPME */ + Perl_croak_nocontext("Usage: %" HEKf "::%" HEKf "(%s)", HEKfARG(HvNAME_HEK(stash)), HEKfARG(GvNAME_HEK(gv)), params); - else - /* diag_listed_as: SKIPME */ - Perl_croak_nocontext("Usage: %" HEKf "(%s)", + else + /* diag_listed_as: SKIPME */ + Perl_croak_nocontext("Usage: %" HEKf "(%s)", HEKfARG(GvNAME_HEK(gv)), params); } else { dTHX; if ((gv = CvGV(cv))) goto got_gv; - /* Pants. I don't think that it should be possible to get here. */ - /* diag_listed_as: SKIPME */ - Perl_croak(aTHX_ "Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); + /* Pants. I don't think that it should be possible to get here. */ + /* diag_listed_as: SKIPME */ + Perl_croak(aTHX_ "Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); } } @@ -424,17 +424,17 @@ XS(XS_UNIVERSAL_isa) dXSARGS; if (items != 2) - croak_xs_usage(cv, "reference, kind"); + croak_xs_usage(cv, "reference, kind"); else { - SV * const sv = ST(0); + SV * const sv = ST(0); - SvGETMAGIC(sv); + SvGETMAGIC(sv); - if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) - XSRETURN_UNDEF; + if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv)))) + XSRETURN_UNDEF; - ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0)); - XSRETURN(1); + ST(0) = boolSV(sv_derived_from_sv(sv, ST(1), 0)); + XSRETURN(1); } } @@ -448,7 +448,7 @@ XS(XS_UNIVERSAL_can) GV *iogv; if (items != 2) - croak_xs_usage(cv, "object-ref, method"); + croak_xs_usage(cv, "object-ref, method"); sv = ST(0); @@ -458,7 +458,7 @@ XS(XS_UNIVERSAL_can) precedence here over the numeric form, as (!1)->foo treats the invocant as the empty string, though it is a dualvar. */ if (!SvOK(sv) || (SvPOK(sv) && !SvCUR(sv))) - XSRETURN_UNDEF; + XSRETURN_UNDEF; rv = &PL_sv_undef; @@ -467,7 +467,7 @@ XS(XS_UNIVERSAL_can) if (SvOBJECT(sv)) pkg = SvSTASH(sv); else if (isGV_with_GP(sv) && GvIO(sv)) - pkg = SvSTASH(GvIO(sv)); + pkg = SvSTASH(GvIO(sv)); } else if (isGV_with_GP(sv) && GvIO(sv)) pkg = SvSTASH(GvIO(sv)); @@ -480,9 +480,9 @@ XS(XS_UNIVERSAL_can) } if (pkg) { - GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0); + GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0); if (gv && isGV(gv)) - rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv)))); + rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv)))); } ST(0) = rv; @@ -496,13 +496,13 @@ XS(XS_UNIVERSAL_DOES) PERL_UNUSED_ARG(cv); if (items != 2) - Perl_croak(aTHX_ "Usage: invocant->DOES(kind)"); + Perl_croak(aTHX_ "Usage: invocant->DOES(kind)"); else { - SV * const sv = ST(0); - if (sv_does_sv( sv, ST(1), 0 )) - XSRETURN_YES; + SV * const sv = ST(0); + if (sv_does_sv( sv, ST(1), 0 )) + XSRETURN_YES; - XSRETURN_NO; + XSRETURN_NO; } } @@ -511,14 +511,14 @@ XS(XS_utf8_is_utf8) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - SvGETMAGIC(sv); - if (SvUTF8(sv)) - XSRETURN_YES; - else - XSRETURN_NO; + SV * const sv = ST(0); + SvGETMAGIC(sv); + if (SvUTF8(sv)) + XSRETURN_YES; + else + XSRETURN_NO; } XSRETURN_EMPTY; } @@ -528,15 +528,15 @@ XS(XS_utf8_valid) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - STRLEN len; - const char * const s = SvPV_const(sv,len); - if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len)) - XSRETURN_YES; - else - XSRETURN_NO; + SV * const sv = ST(0); + STRLEN len; + const char * const s = SvPV_const(sv,len); + if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len)) + XSRETURN_YES; + else + XSRETURN_NO; } XSRETURN_EMPTY; } @@ -546,7 +546,7 @@ XS(XS_utf8_encode) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); sv_utf8_encode(ST(0)); SvSETMAGIC(ST(0)); XSRETURN_EMPTY; @@ -557,14 +557,14 @@ XS(XS_utf8_decode) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - bool RETVAL; - SvPV_force_nolen(sv); - RETVAL = sv_utf8_decode(sv); - SvSETMAGIC(sv); - ST(0) = boolSV(RETVAL); + SV * const sv = ST(0); + bool RETVAL; + SvPV_force_nolen(sv); + RETVAL = sv_utf8_decode(sv); + SvSETMAGIC(sv); + ST(0) = boolSV(RETVAL); } XSRETURN(1); } @@ -574,14 +574,14 @@ XS(XS_utf8_upgrade) { dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); else { - SV * const sv = ST(0); - STRLEN RETVAL; - dXSTARG; + SV * const sv = ST(0); + STRLEN RETVAL; + dXSTARG; - RETVAL = sv_utf8_upgrade(sv); - XSprePUSH; PUSHi((IV)RETVAL); + RETVAL = sv_utf8_upgrade(sv); + XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } @@ -591,14 +591,14 @@ XS(XS_utf8_downgrade) { dXSARGS; if (items < 1 || items > 2) - croak_xs_usage(cv, "sv, failok=0"); + croak_xs_usage(cv, "sv, failok=0"); else { - SV * const sv0 = ST(0); - SV * const sv1 = ST(1); + SV * const sv0 = ST(0); + SV * const sv1 = ST(1); const bool failok = (items < 2) ? 0 : SvTRUE_NN(sv1) ? 1 : 0; const bool RETVAL = sv_utf8_downgrade(sv0, failok); - ST(0) = boolSV(RETVAL); + ST(0) = boolSV(RETVAL); } XSRETURN(1); } @@ -643,22 +643,22 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */ sv = SvRV(svz); if (items == 1) { - if (SvREADONLY(sv)) - XSRETURN_YES; - else - XSRETURN_NO; + if (SvREADONLY(sv)) + XSRETURN_YES; + else + XSRETURN_NO; } else if (items == 2) { SV *sv1 = ST(1); - if (SvTRUE_NN(sv1)) { - SvFLAGS(sv) |= SVf_READONLY; - XSRETURN_YES; - } - else { - /* I hope you really know what you are doing. */ - SvFLAGS(sv) &=~ SVf_READONLY; - XSRETURN_NO; - } + if (SvTRUE_NN(sv1)) { + SvFLAGS(sv) |= SVf_READONLY; + XSRETURN_YES; + } + else { + /* I hope you really know what you are doing. */ + SvFLAGS(sv) &=~ SVf_READONLY; + XSRETURN_NO; + } } XSRETURN_UNDEF; /* Can't happen. */ } @@ -678,13 +678,13 @@ XS(XS_constant__make_const) /* This is dangerous stuff. */ SvREADONLY_on(sv); if (SvTYPE(sv) == SVt_PVAV && AvFILLp(sv) != -1) { - /* for constant.pm; nobody else should be calling this - on arrays anyway. */ - SV **svp; - for (svp = AvARRAY(sv) + AvFILLp(sv) - ; svp >= AvARRAY(sv) - ; --svp) - if (*svp) SvPADTMP_on(*svp); + /* for constant.pm; nobody else should be calling this + on arrays anyway. */ + SV **svp; + for (svp = AvARRAY(sv) + AvFILLp(sv) + ; svp >= AvARRAY(sv) + ; --svp) + if (*svp) SvPADTMP_on(*svp); } XSRETURN(0); } @@ -719,11 +719,11 @@ XS(XS_Internals_hv_clear_placehold) dXSARGS; if (items != 1 || !SvROK(ST(0))) - croak_xs_usage(cv, "hv"); + croak_xs_usage(cv, "hv"); else { - HV * const hv = MUTABLE_HV(SvRV(ST(0))); - hv_clear_placeholders(hv); - XSRETURN(0); + HV * const hv = MUTABLE_HV(SvRV(ST(0))); + hv_clear_placeholders(hv); + XSRETURN(0); } } @@ -732,120 +732,120 @@ XS(XS_PerlIO_get_layers) { dXSARGS; if (items < 1 || items % 2 == 0) - croak_xs_usage(cv, "filehandle[,args]"); + croak_xs_usage(cv, "filehandle[,args]"); #if defined(USE_PERLIO) { - SV * sv; - GV * gv; - IO * io; - bool input = TRUE; - bool details = FALSE; - - if (items > 1) { - SV * const *svp; - for (svp = MARK + 2; svp <= SP; svp += 2) { - SV * const * const varp = svp; - SV * const * const valp = svp + 1; - STRLEN klen; - const char * const key = SvPV_const(*varp, klen); - - switch (*key) { - case 'i': + SV * sv; + GV * gv; + IO * io; + bool input = TRUE; + bool details = FALSE; + + if (items > 1) { + SV * const *svp; + for (svp = MARK + 2; svp <= SP; svp += 2) { + SV * const * const varp = svp; + SV * const * const valp = svp + 1; + STRLEN klen; + const char * const key = SvPV_const(*varp, klen); + + switch (*key) { + case 'i': if (memEQs(key, klen, "input")) { - input = SvTRUE(*valp); - break; - } - goto fail; - case 'o': + input = SvTRUE(*valp); + break; + } + goto fail; + case 'o': if (memEQs(key, klen, "output")) { - input = !SvTRUE(*valp); - break; - } - goto fail; - case 'd': + input = !SvTRUE(*valp); + break; + } + goto fail; + case 'd': if (memEQs(key, klen, "details")) { - details = SvTRUE(*valp); - break; - } - goto fail; - default: - fail: - Perl_croak(aTHX_ - "get_layers: unknown argument '%s'", - key); - } - } - - SP -= (items - 1); - } - - sv = POPs; - gv = MAYBE_DEREF_GV(sv); - - if (!gv && !SvROK(sv)) - gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO); - - if (gv && (io = GvIO(gv))) { - AV* const av = PerlIO_get_layers(aTHX_ input ? - IoIFP(io) : IoOFP(io)); - SSize_t i; - const SSize_t last = av_top_index(av); - SSize_t nitem = 0; - - for (i = last; i >= 0; i -= 3) { - SV * const * const namsvp = av_fetch(av, i - 2, FALSE); - SV * const * const argsvp = av_fetch(av, i - 1, FALSE); - SV * const * const flgsvp = av_fetch(av, i, FALSE); - - const bool namok = namsvp && *namsvp && SvPOK(*namsvp); - const bool argok = argsvp && *argsvp && SvPOK(*argsvp); - const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp); - - EXTEND(SP, 3); /* Three is the max in all branches: better check just once */ - if (details) { - /* Indents of 5? Yuck. */ - /* We know that PerlIO_get_layers creates a new SV for - the name and flags, so we can just take a reference - and "steal" it when we free the AV below. */ - PUSHs(namok - ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)) - : &PL_sv_undef); - PUSHs(argok - ? newSVpvn_flags(SvPVX_const(*argsvp), - SvCUR(*argsvp), - (SvUTF8(*argsvp) ? SVf_UTF8 : 0) - | SVs_TEMP) - : &PL_sv_undef); - PUSHs(flgok - ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp)) - : &PL_sv_undef); - nitem += 3; - } - else { - if (namok && argok) - PUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%" SVf "(%" SVf ")", - SVfARG(*namsvp), - SVfARG(*argsvp)))); - else if (namok) - PUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))); - else - PUSHs(&PL_sv_undef); - nitem++; - if (flgok) { - const IV flags = SvIVX(*flgsvp); - - if (flags & PERLIO_F_UTF8) { - PUSHs(newSVpvs_flags("utf8", SVs_TEMP)); - nitem++; - } - } - } - } - - SvREFCNT_dec(av); - - XSRETURN(nitem); - } + details = SvTRUE(*valp); + break; + } + goto fail; + default: + fail: + Perl_croak(aTHX_ + "get_layers: unknown argument '%s'", + key); + } + } + + SP -= (items - 1); + } + + sv = POPs; + gv = MAYBE_DEREF_GV(sv); + + if (!gv && !SvROK(sv)) + gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO); + + if (gv && (io = GvIO(gv))) { + AV* const av = PerlIO_get_layers(aTHX_ input ? + IoIFP(io) : IoOFP(io)); + SSize_t i; + const SSize_t last = av_top_index(av); + SSize_t nitem = 0; + + for (i = last; i >= 0; i -= 3) { + SV * const * const namsvp = av_fetch(av, i - 2, FALSE); + SV * const * const argsvp = av_fetch(av, i - 1, FALSE); + SV * const * const flgsvp = av_fetch(av, i, FALSE); + + const bool namok = namsvp && *namsvp && SvPOK(*namsvp); + const bool argok = argsvp && *argsvp && SvPOK(*argsvp); + const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp); + + EXTEND(SP, 3); /* Three is the max in all branches: better check just once */ + if (details) { + /* Indents of 5? Yuck. */ + /* We know that PerlIO_get_layers creates a new SV for + the name and flags, so we can just take a reference + and "steal" it when we free the AV below. */ + PUSHs(namok + ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)) + : &PL_sv_undef); + PUSHs(argok + ? newSVpvn_flags(SvPVX_const(*argsvp), + SvCUR(*argsvp), + (SvUTF8(*argsvp) ? SVf_UTF8 : 0) + | SVs_TEMP) + : &PL_sv_undef); + PUSHs(flgok + ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp)) + : &PL_sv_undef); + nitem += 3; + } + else { + if (namok && argok) + PUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%" SVf "(%" SVf ")", + SVfARG(*namsvp), + SVfARG(*argsvp)))); + else if (namok) + PUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))); + else + PUSHs(&PL_sv_undef); + nitem++; + if (flgok) { + const IV flags = SvIVX(*flgsvp); + + if (flags & PERLIO_F_UTF8) { + PUSHs(newSVpvs_flags("utf8", SVs_TEMP)); + nitem++; + } + } + } + } + + SvREFCNT_dec(av); + + XSRETURN(nitem); + } } #endif @@ -858,7 +858,7 @@ XS(XS_re_is_regexp) dXSARGS; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); if (SvRXOK(ST(0))) { XSRETURN_YES; @@ -875,7 +875,7 @@ XS(XS_re_regnames_count) dXSARGS; if (items != 0) - croak_xs_usage(cv, ""); + croak_xs_usage(cv, ""); if (!rx) XSRETURN_UNDEF; @@ -896,7 +896,7 @@ XS(XS_re_regname) SV * ret; if (items < 1 || items > 2) - croak_xs_usage(cv, "name[, all ]"); + croak_xs_usage(cv, "name[, all ]"); SP -= items; PUTBACK; @@ -932,7 +932,7 @@ XS(XS_re_regnames) SV **entry; if (items > 1) - croak_xs_usage(cv, "[all]"); + croak_xs_usage(cv, "[all]"); rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; @@ -984,7 +984,7 @@ XS(XS_re_regexp_pattern) EXTEND(SP, 2); SP -= items; if (items != 1) - croak_xs_usage(cv, "sv"); + croak_xs_usage(cv, "sv"); /* Checks if a reference is a regex or not. If the parameter is @@ -1003,8 +1003,8 @@ XS(XS_re_regexp_pattern) SV *pattern; if ( gimme == G_ARRAY ) { - STRLEN left = 0; - char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH]; + STRLEN left = 0; + char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH]; const char *fptr; char ch; U16 match_flags; @@ -1015,13 +1015,13 @@ XS(XS_re_regexp_pattern) modifiers" in this scenario, and the default character set */ - if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) { - STRLEN len; - const char* const name = get_regex_charset_name(RX_EXTFLAGS(re), - &len); - Copy(name, reflags + left, len, char); - left += len; - } + if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) { + STRLEN len; + const char* const name = get_regex_charset_name(RX_EXTFLAGS(re), + &len); + Copy(name, reflags + left, len, char); + left += len; + } fptr = INT_PAT_MODS; match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME) >> RXf_PMf_STD_PMMOD_SHIFT); @@ -1034,7 +1034,7 @@ XS(XS_re_regexp_pattern) } pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re), - (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP); + (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP); /* return the pattern and the modifiers */ PUSHs(pattern); @@ -1121,18 +1121,18 @@ XS(XS_NamedCapture_TIEHASH) if (items < 1) croak_xs_usage(cv, "package, ..."); { - const char * package = (const char *)SvPV_nolen(ST(0)); - UV flag = RXapif_ONE; - mark += 2; - while(mark < sp) { - STRLEN len; - const char *p = SvPV_const(*mark, len); - if(memEQs(p, len, "all")) - flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE; - mark += 2; - } - ST(0) = sv_2mortal(newSV_type(SVt_IV)); - sv_setuv(newSVrv(ST(0), package), flag); + const char * package = (const char *)SvPV_nolen(ST(0)); + UV flag = RXapif_ONE; + mark += 2; + while(mark < sp) { + STRLEN len; + const char *p = SvPV_const(*mark, len); + if(memEQs(p, len, "all")) + flag = SvTRUE(mark[1]) ? RXapif_ALL : RXapif_ONE; + mark += 2; + } + ST(0) = sv_2mortal(newSV_type(SVt_IV)); + sv_setuv(newSVrv(ST(0), package), flag); } XSRETURN(1); } @@ -1158,39 +1158,39 @@ XS(XS_NamedCapture_FETCH) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; - U32 flags; - SV *ret; - const U32 action = ix & ACTION_MASK; - const int expect = ix >> EXPECT_SHIFT; - if (items != expect) - croak_xs_usage(cv, expect == 2 ? "$key" - : (expect == 3 ? "$key, $value" - : "")); - - if (!rx || !SvROK(ST(0))) { - if (ix & UNDEF_FATAL) - Perl_croak_no_modify(); - else - XSRETURN_UNDEF; - } - - flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - - PUTBACK; - ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL, - expect >= 3 ? ST(2) : NULL, flags | action); - SPAGAIN; - - if (ix & DISCARD) { - /* Called with G_DISCARD, so our return stack state is thrown away. - Hence if we were returned anything, free it immediately. */ - SvREFCNT_dec(ret); - } else { - PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); - } - PUTBACK; - return; + REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; + U32 flags; + SV *ret; + const U32 action = ix & ACTION_MASK; + const int expect = ix >> EXPECT_SHIFT; + if (items != expect) + croak_xs_usage(cv, expect == 2 ? "$key" + : (expect == 3 ? "$key, $value" + : "")); + + if (!rx || !SvROK(ST(0))) { + if (ix & UNDEF_FATAL) + Perl_croak_no_modify(); + else + XSRETURN_UNDEF; + } + + flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); + + PUTBACK; + ret = RX_ENGINE(rx)->named_buff(aTHX_ (rx), expect >= 2 ? ST(1) : NULL, + expect >= 3 ? ST(2) : NULL, flags | action); + SPAGAIN; + + if (ix & DISCARD) { + /* Called with G_DISCARD, so our return stack state is thrown away. + Hence if we were returned anything, free it immediately. */ + SvREFCNT_dec(ret); + } else { + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + } + PUTBACK; + return; } } @@ -1203,28 +1203,28 @@ XS(XS_NamedCapture_FIRSTKEY) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; - U32 flags; - SV *ret; - const int expect = ix ? 2 : 1; - const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY; - if (items != expect) - croak_xs_usage(cv, expect == 2 ? "$lastkey" : ""); - - if (!rx || !SvROK(ST(0))) - XSRETURN_UNDEF; - - flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); - - PUTBACK; - ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), - expect >= 2 ? ST(1) : NULL, - flags | action); - SPAGAIN; - - PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); - PUTBACK; - return; + REGEXP *const rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL; + U32 flags; + SV *ret; + const int expect = ix ? 2 : 1; + const U32 action = ix ? RXapif_NEXTKEY : RXapif_FIRSTKEY; + if (items != expect) + croak_xs_usage(cv, expect == 2 ? "$lastkey" : ""); + + if (!rx || !SvROK(ST(0))) + XSRETURN_UNDEF; + + flags = (U32)SvUV(SvRV(MUTABLE_SV(ST(0)))); + + PUTBACK; + ret = RX_ENGINE(rx)->named_buff_iter(aTHX_ (rx), + expect >= 2 ? ST(1) : NULL, + flags | action); + SPAGAIN; + + PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef); + PUTBACK; + return; } } @@ -1236,11 +1236,11 @@ XS(XS_NamedCapture_flags) PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { - EXTEND(SP, 2); - mPUSHu(RXapif_ONE); - mPUSHu(RXapif_ALL); - PUTBACK; - return; + EXTEND(SP, 2); + mPUSHu(RXapif_ONE); + mPUSHu(RXapif_ALL); + PUTBACK; + return; } } @@ -1374,13 +1374,13 @@ Perl_boot_core_UNIVERSAL(pTHX) /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */ { - CV * const cv = - newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL); - char ** cvfile = &CvFILE(cv); - char * oldfile = *cvfile; - CvDYNFILE_off(cv); - *cvfile = (char *)file; - Safefree(oldfile); + CV * const cv = + newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL); + char ** cvfile = &CvFILE(cv); + char * oldfile = *cvfile; + CvDYNFILE_off(cv); + *cvfile = (char *)file; + Safefree(oldfile); } } diff --git a/unixish.h b/unixish.h index 5bf5b93690b5..eafc6f1e8b88 100644 --- a/unixish.h +++ b/unixish.h @@ -137,7 +137,7 @@ int afstat(int fd, struct stat *statb); #if defined(__amigaos4__) # define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT; amigaos4_init_fork_array(); amigaos4_init_environ_sema(); + MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT; amigaos4_init_fork_array(); amigaos4_init_environ_sema(); # define PERL_SYS_TERM_BODY() \ HINTS_REFCNT_TERM; KEYWORD_PLUGIN_MUTEX_TERM; \ OP_CHECK_MUTEX_TERM; OP_REFCNT_TERM; PERLIO_TERM; \ @@ -148,7 +148,7 @@ int afstat(int fd, struct stat *statb); #ifndef PERL_SYS_INIT_BODY # define PERL_SYS_INIT_BODY(c,v) \ - MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT + MALLOC_CHECK_TAINT2(*c,*v) PERL_FPU_INIT; PERLIO_INIT; MALLOC_INIT #endif #ifndef PERL_SYS_TERM_BODY diff --git a/utf8.c b/utf8.c index add8c093aad1..72d3ac2b7af4 100644 --- a/utf8.c +++ b/utf8.c @@ -99,7 +99,7 @@ Perl__force_out_malformed_utf8_message(pTHX_ LEAVE; if (! errors) { - Perl_croak(aTHX_ "panic: _force_out_malformed_utf8_message should" + Perl_croak(aTHX_ "panic: _force_out_malformed_utf8_message should" " be called only when there are errors found"); } @@ -264,8 +264,8 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) } if (OFFUNI_IS_INVARIANT(uv)) { - *d++ = LATIN1_TO_NATIVE(uv); - return d; + *d++ = LATIN1_TO_NATIVE(uv); + return d; } if (uv <= MAX_UTF8_TWO_BYTE) { @@ -281,9 +281,9 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) * on ASCII; so 3 bytes covers the range 0x400-0x3FFF on EBCDIC; * 0x800-0xFFFF on ASCII */ if (uv < (16 * (1U << (2 * SHIFT)))) { - *d++ = I8_TO_NATIVE_UTF8(( uv >> ((3 - 1) * SHIFT)) | UTF_START_MARK(3)); - *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) | MARK); - *d++ = I8_TO_NATIVE_UTF8(( uv /* (1 - 1) */ & MASK) | MARK); + *d++ = I8_TO_NATIVE_UTF8(( uv >> ((3 - 1) * SHIFT)) | UTF_START_MARK(3)); + *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) | MARK); + *d++ = I8_TO_NATIVE_UTF8(( uv /* (1 - 1) */ & MASK) | MARK); #ifndef EBCDIC /* These problematic code points are 4 bytes on EBCDIC, so aren't tested here */ @@ -300,7 +300,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) } } #endif - return d; + return d; } /* Not 3-byte; that means the code point is at least 0x1_0000 on ASCII @@ -364,10 +364,10 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) * ASCII, so 4 bytes covers the range 0x4000-0x3_FFFF on EBCDIC; * 0x1_0000-0x1F_FFFF on ASCII */ if (uv < (8 * (1U << (3 * SHIFT)))) { - *d++ = I8_TO_NATIVE_UTF8(( uv >> ((4 - 1) * SHIFT)) | UTF_START_MARK(4)); - *d++ = I8_TO_NATIVE_UTF8(((uv >> ((3 - 1) * SHIFT)) & MASK) | MARK); - *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) | MARK); - *d++ = I8_TO_NATIVE_UTF8(( uv /* (1 - 1) */ & MASK) | MARK); + *d++ = I8_TO_NATIVE_UTF8(( uv >> ((4 - 1) * SHIFT)) | UTF_START_MARK(4)); + *d++ = I8_TO_NATIVE_UTF8(((uv >> ((3 - 1) * SHIFT)) & MASK) | MARK); + *d++ = I8_TO_NATIVE_UTF8(((uv >> ((2 - 1) * SHIFT)) & MASK) | MARK); + *d++ = I8_TO_NATIVE_UTF8(( uv /* (1 - 1) */ & MASK) | MARK); #ifdef EBCDIC /* These were handled on ASCII platforms in the code for 3-byte characters. The end-plane non-characters for EBCDIC were @@ -380,7 +380,7 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) } #endif - return d; + return d; } /* Not 4-byte; that means the code point is at least 0x20_0000 on ASCII @@ -391,14 +391,14 @@ Perl_uvoffuni_to_utf8_flags_msgs(pTHX_ U8 *d, UV uv, const UV flags, HV** msgs) * khw believes that less code outweighs slight performance gains. */ { - STRLEN len = OFFUNISKIP(uv); - U8 *p = d+len-1; - while (p > d) { - *p-- = I8_TO_NATIVE_UTF8((uv & MASK) | MARK); - uv >>= SHIFT; - } - *p = I8_TO_NATIVE_UTF8((uv & UTF_START_MASK(len)) | UTF_START_MARK(len)); - return d+len; + STRLEN len = OFFUNISKIP(uv); + U8 *p = d+len-1; + while (p > d) { + *p-- = I8_TO_NATIVE_UTF8((uv & MASK) | MARK); + uv >>= SHIFT; + } + *p = I8_TO_NATIVE_UTF8((uv & UTF_START_MASK(len)) | UTF_START_MARK(len)); + return d+len; } } @@ -1659,7 +1659,7 @@ Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, possible_problems |= UTF8_GOT_EMPTY; curlen = 0; uv = UNICODE_REPLACEMENT; - goto ready_to_handle_errors; + goto ready_to_handle_errors; } expectlen = UTF8SKIP(s); @@ -1669,15 +1669,15 @@ Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, * things up here to return it. It will be overriden only in those rare * cases where a malformation is found */ if (retlen) { - *retlen = expectlen; + *retlen = expectlen; } /* A continuation character can't start a valid sequence */ if (UNLIKELY(UTF8_IS_CONTINUATION(uv))) { - possible_problems |= UTF8_GOT_CONTINUATION; + possible_problems |= UTF8_GOT_CONTINUATION; curlen = 1; uv = UNICODE_REPLACEMENT; - goto ready_to_handle_errors; + goto ready_to_handle_errors; } /* Here is not a continuation byte, nor an invariant. The only thing left @@ -1703,8 +1703,8 @@ Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, /* Now, loop through the remaining bytes in the character's sequence, * accumulating each into the working value as we go. */ for (s = s0 + 1; s < send; s++) { - if (LIKELY(UTF8_IS_CONTINUATION(*s))) { - uv = UTF8_ACCUMULATE(uv, *s); + if (LIKELY(UTF8_IS_CONTINUATION(*s))) { + uv = UTF8_ACCUMULATE(uv, *s); continue; } @@ -1808,11 +1808,11 @@ Perl__utf8n_to_uvchr_msgs_helper(const U8 *s, && LIKELY(! (possible_problems & UTF8_GOT_OVERFLOW)) && ( isUTF8_POSSIBLY_PROBLEMATIC(*adjusted_s0) || UNLIKELY(isUTF8_PERL_EXTENDED(s0))))) - && ((flags & ( UTF8_DISALLOW_NONCHAR + && ((flags & ( UTF8_DISALLOW_NONCHAR |UTF8_DISALLOW_SURROGATE |UTF8_DISALLOW_SUPER |UTF8_DISALLOW_PERL_EXTENDED - |UTF8_WARN_NONCHAR + |UTF8_WARN_NONCHAR |UTF8_WARN_SURROGATE |UTF8_WARN_SUPER |UTF8_WARN_PERL_EXTENDED)))) @@ -2373,20 +2373,20 @@ Perl_utf8_length(pTHX_ const U8 *s, const U8 *e) * In other words: in Perl UTF-8 is not just for Unicode. */ if (UNLIKELY(e < s)) - goto warn_and_return; + goto warn_and_return; while (s < e) { s += UTF8SKIP(s); - len++; + len++; } if (UNLIKELY(e != s)) { - len--; + len--; warn_and_return: - if (PL_op) - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); - else - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees); + if (PL_op) + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "%s in %s", unees, OP_DESC(PL_op)); + else + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees); } return len; @@ -2419,41 +2419,41 @@ Perl_bytes_cmp_utf8(pTHX_ const U8 *b, STRLEN blen, const U8 *u, STRLEN ulen) while (b < bend && u < uend) { U8 c = *u++; - if (!UTF8_IS_INVARIANT(c)) { - if (UTF8_IS_DOWNGRADEABLE_START(c)) { - if (u < uend) { - U8 c1 = *u++; - if (UTF8_IS_CONTINUATION(c1)) { - c = EIGHT_BIT_UTF8_TO_NATIVE(c, c1); - } else { + if (!UTF8_IS_INVARIANT(c)) { + if (UTF8_IS_DOWNGRADEABLE_START(c)) { + if (u < uend) { + U8 c1 = *u++; + if (UTF8_IS_CONTINUATION(c1)) { + c = EIGHT_BIT_UTF8_TO_NATIVE(c, c1); + } else { /* diag_listed_as: Malformed UTF-8 character%s */ - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s %s%s", unexpected_non_continuation_text(u - 2, 2, 1, 2), PL_op ? " in " : "", PL_op ? OP_DESC(PL_op) : ""); - return -2; - } - } else { - if (PL_op) - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, OP_DESC(PL_op)); - else - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees); - return -2; /* Really want to return undef :-) */ - } - } else { - return -2; - } - } - if (*b != c) { - return *b < c ? -2 : +2; - } - ++b; + return -2; + } + } else { + if (PL_op) + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "%s in %s", unees, OP_DESC(PL_op)); + else + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), "%s", unees); + return -2; /* Really want to return undef :-) */ + } + } else { + return -2; + } + } + if (*b != c) { + return *b < c ? -2 : +2; + } + ++b; } if (b == bend && u == uend) - return 0; + return 0; return b < bend ? +1 : -1; } @@ -2737,23 +2737,23 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, Size_t bytelen, Size_t *newlen) PERL_ARGS_ASSERT_UTF16_TO_UTF8; if (bytelen & 1) - Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %" UVuf, + Perl_croak(aTHX_ "panic: utf16_to_utf8: odd bytelen %" UVuf, (UV)bytelen); pend = p + bytelen; while (p < pend) { - UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */ - p += 2; - if (OFFUNI_IS_INVARIANT(uv)) { - *d++ = LATIN1_TO_NATIVE((U8) uv); - continue; - } - if (uv <= MAX_UTF8_TWO_BYTE) { - *d++ = UTF8_TWO_BYTE_HI(UNI_TO_NATIVE(uv)); - *d++ = UTF8_TWO_BYTE_LO(UNI_TO_NATIVE(uv)); - continue; - } + UV uv = (p[0] << 8) + p[1]; /* UTF-16BE */ + p += 2; + if (OFFUNI_IS_INVARIANT(uv)) { + *d++ = LATIN1_TO_NATIVE((U8) uv); + continue; + } + if (uv <= MAX_UTF8_TWO_BYTE) { + *d++ = UTF8_TWO_BYTE_HI(UNI_TO_NATIVE(uv)); + *d++ = UTF8_TWO_BYTE_LO(UNI_TO_NATIVE(uv)); + continue; + } #define FIRST_HIGH_SURROGATE UNICODE_SURROGATE_FIRST #define LAST_HIGH_SURROGATE 0xDBFF @@ -2763,40 +2763,40 @@ Perl_utf16_to_utf8(pTHX_ U8* p, U8* d, Size_t bytelen, Size_t *newlen) /* This assumes that most uses will be in the first Unicode plane, not * needing surrogates */ - if (UNLIKELY(inRANGE(uv, UNICODE_SURROGATE_FIRST, + if (UNLIKELY(inRANGE(uv, UNICODE_SURROGATE_FIRST, UNICODE_SURROGATE_LAST))) { if (UNLIKELY(p >= pend) || UNLIKELY(uv > LAST_HIGH_SURROGATE)) { Perl_croak(aTHX_ "Malformed UTF-16 surrogate"); } - else { - UV low = (p[0] << 8) + p[1]; - if (UNLIKELY(! inRANGE(low, FIRST_LOW_SURROGATE, + else { + UV low = (p[0] << 8) + p[1]; + if (UNLIKELY(! inRANGE(low, FIRST_LOW_SURROGATE, LAST_LOW_SURROGATE))) { - Perl_croak(aTHX_ "Malformed UTF-16 surrogate"); + Perl_croak(aTHX_ "Malformed UTF-16 surrogate"); } - p += 2; - uv = ((uv - FIRST_HIGH_SURROGATE) << 10) + p += 2; + uv = ((uv - FIRST_HIGH_SURROGATE) << 10) + (low - FIRST_LOW_SURROGATE) + FIRST_IN_PLANE1; - } - } + } + } #ifdef EBCDIC d = uvoffuni_to_utf8_flags(d, uv, 0); #else - if (uv < FIRST_IN_PLANE1) { - *d++ = (U8)(( uv >> 12) | 0xe0); - *d++ = (U8)(((uv >> 6) & 0x3f) | 0x80); - *d++ = (U8)(( uv & 0x3f) | 0x80); - continue; - } - else { - *d++ = (U8)(( uv >> 18) | 0xf0); - *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80); - *d++ = (U8)(((uv >> 6) & 0x3f) | 0x80); - *d++ = (U8)(( uv & 0x3f) | 0x80); - continue; - } + if (uv < FIRST_IN_PLANE1) { + *d++ = (U8)(( uv >> 12) | 0xe0); + *d++ = (U8)(((uv >> 6) & 0x3f) | 0x80); + *d++ = (U8)(( uv & 0x3f) | 0x80); + continue; + } + else { + *d++ = (U8)(( uv >> 18) | 0xf0); + *d++ = (U8)(((uv >> 12) & 0x3f) | 0x80); + *d++ = (U8)(((uv >> 6) & 0x3f) | 0x80); + *d++ = (U8)(( uv & 0x3f) | 0x80); + continue; + } #endif } *newlen = d - dstart; @@ -2814,14 +2814,14 @@ Perl_utf16_to_utf8_reversed(pTHX_ U8* p, U8* d, Size_t bytelen, Size_t *newlen) PERL_ARGS_ASSERT_UTF16_TO_UTF8_REVERSED; if (bytelen & 1) - Perl_croak(aTHX_ "panic: utf16_to_utf8_reversed: odd bytelen %" UVuf, - (UV)bytelen); + Perl_croak(aTHX_ "panic: utf16_to_utf8_reversed: odd bytelen %" UVuf, + (UV)bytelen); while (s < send) { - const U8 tmp = s[0]; - s[0] = s[1]; - s[1] = tmp; - s += 2; + const U8 tmp = s[0]; + s[0] = s[1]; + s[1] = tmp; + s += 2; } return utf16_to_utf8(p, d, bytelen, newlen); } @@ -2861,38 +2861,38 @@ Perl__to_upper_title_latin1(pTHX_ const U8 c, U8* p, STRLEN *lenp, assert(S_or_s == 'S' || S_or_s == 's'); if (UVCHR_IS_INVARIANT(converted)) { /* No difference between the two for - characters in this range */ - *p = (U8) converted; - *lenp = 1; - return converted; + characters in this range */ + *p = (U8) converted; + *lenp = 1; + return converted; } /* toUPPER_LATIN1_MOD gives the correct results except for three outliers, * which it maps to one of them, so as to only have to have one check for * it in the main case */ if (UNLIKELY(converted == LATIN_SMALL_LETTER_Y_WITH_DIAERESIS)) { - switch (c) { - case LATIN_SMALL_LETTER_Y_WITH_DIAERESIS: - converted = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS; - break; - case MICRO_SIGN: - converted = GREEK_CAPITAL_LETTER_MU; - break; + switch (c) { + case LATIN_SMALL_LETTER_Y_WITH_DIAERESIS: + converted = LATIN_CAPITAL_LETTER_Y_WITH_DIAERESIS; + break; + case MICRO_SIGN: + converted = GREEK_CAPITAL_LETTER_MU; + break; #if UNICODE_MAJOR_VERSION > 2 \ || (UNICODE_MAJOR_VERSION == 2 && UNICODE_DOT_VERSION >= 1 \ && UNICODE_DOT_DOT_VERSION >= 8) - case LATIN_SMALL_LETTER_SHARP_S: - *(p)++ = 'S'; - *p = S_or_s; - *lenp = 2; - return 'S'; + case LATIN_SMALL_LETTER_SHARP_S: + *(p)++ = 'S'; + *p = S_or_s; + *lenp = 2; + return 'S'; #endif - default: - Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect" + default: + Perl_croak(aTHX_ "panic: to_upper_title_latin1 did not expect" " '%c' to map to '%c'", c, LATIN_SMALL_LETTER_Y_WITH_DIAERESIS); - NOT_REACHED; /* NOTREACHED */ - } + NOT_REACHED; /* NOTREACHED */ + } } *(p)++ = UTF8_TWO_BYTE_HI(converted); @@ -2983,7 +2983,7 @@ Perl_to_uni_upper(pTHX_ UV c, U8* p, STRLEN *lenp) PERL_ARGS_ASSERT_TO_UNI_UPPER; if (c < 256) { - return _to_upper_title_latin1((U8) c, p, lenp, 'S'); + return _to_upper_title_latin1((U8) c, p, lenp, 'S'); } return CALL_UPPER_CASE(c, NULL, p, lenp); @@ -2995,7 +2995,7 @@ Perl_to_uni_title(pTHX_ UV c, U8* p, STRLEN *lenp) PERL_ARGS_ASSERT_TO_UNI_TITLE; if (c < 256) { - return _to_upper_title_latin1((U8) c, p, lenp, 's'); + return _to_upper_title_latin1((U8) c, p, lenp, 's'); } return CALL_TITLE_CASE(c, NULL, p, lenp); @@ -3013,17 +3013,17 @@ S_to_lower_latin1(const U8 c, U8* p, STRLEN *lenp, const char dummy) PERL_UNUSED_ARG(dummy); if (p != NULL) { - if (NATIVE_BYTE_IS_INVARIANT(converted)) { - *p = converted; - *lenp = 1; - } - else { + if (NATIVE_BYTE_IS_INVARIANT(converted)) { + *p = converted; + *lenp = 1; + } + else { /* Result is known to always be < 256, so can use the EIGHT_BIT * macros */ - *p = UTF8_EIGHT_BIT_HI(converted); - *(p+1) = UTF8_EIGHT_BIT_LO(converted); - *lenp = 2; - } + *p = UTF8_EIGHT_BIT_HI(converted); + *(p+1) = UTF8_EIGHT_BIT_LO(converted); + *lenp = 2; + } } return converted; } @@ -3034,7 +3034,7 @@ Perl_to_uni_lower(pTHX_ UV c, U8* p, STRLEN *lenp) PERL_ARGS_ASSERT_TO_UNI_LOWER; if (c < 256) { - return to_lower_latin1((U8) c, p, lenp, 0 /* 0 is a dummy arg */ ); + return to_lower_latin1((U8) c, p, lenp, 0 /* 0 is a dummy arg */ ); } return CALL_LOWER_CASE(c, NULL, p, lenp); @@ -3057,7 +3057,7 @@ Perl__to_fold_latin1(const U8 c, U8* p, STRLEN *lenp, const unsigned int flags) assert (! (flags & FOLD_FLAGS_LOCALE)); if (UNLIKELY(c == MICRO_SIGN)) { - converted = GREEK_SMALL_LETTER_MU; + converted = GREEK_SMALL_LETTER_MU; } #if UNICODE_MAJOR_VERSION > 3 /* no multifolds in early Unicode */ \ || (UNICODE_MAJOR_VERSION == 3 && ( UNICODE_DOT_VERSION > 0) \ @@ -3084,17 +3084,17 @@ Perl__to_fold_latin1(const U8 c, U8* p, STRLEN *lenp, const unsigned int flags) #endif else { /* In this range the fold of all other characters is their lower case */ - converted = toLOWER_LATIN1(c); + converted = toLOWER_LATIN1(c); } if (UVCHR_IS_INVARIANT(converted)) { - *p = (U8) converted; - *lenp = 1; + *p = (U8) converted; + *lenp = 1; } else { - *(p)++ = UTF8_TWO_BYTE_HI(converted); - *p = UTF8_TWO_BYTE_LO(converted); - *lenp = 2; + *(p)++ = UTF8_TWO_BYTE_HI(converted); + *p = UTF8_TWO_BYTE_LO(converted); + *lenp = 2; } return converted; @@ -3128,20 +3128,20 @@ Perl__to_uni_fold_flags(pTHX_ UV c, U8* p, STRLEN *lenp, U8 flags) if (c < 256) { return _to_fold_latin1((U8) c, p, lenp, - flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII)); + flags & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII)); } /* Here, above 255. If no special needs, just use the macro */ if ( ! (flags & (FOLD_FLAGS_LOCALE|FOLD_FLAGS_NOMIX_ASCII))) { - return CALL_FOLD_CASE(c, NULL, p, lenp, flags & FOLD_FLAGS_FULL); + return CALL_FOLD_CASE(c, NULL, p, lenp, flags & FOLD_FLAGS_FULL); } else { /* Otherwise, _toFOLD_utf8_flags has the intelligence to deal with - the special flags. */ - U8 utf8_c[UTF8_MAXBYTES + 1]; + the special flags. */ + U8 utf8_c[UTF8_MAXBYTES + 1]; needs_full_generality: - uvchr_to_utf8(utf8_c, c); - return _toFOLD_utf8_flags(utf8_c, utf8_c + sizeof(utf8_c), + uvchr_to_utf8(utf8_c, c); + return _toFOLD_utf8_flags(utf8_c, utf8_c + sizeof(utf8_c), p, lenp, flags); } } @@ -3184,14 +3184,14 @@ S_warn_on_first_deprecated_use(pTHX_ const char * const name, if (ckWARN_d(WARN_DEPRECATED)) { key = Perl_form(aTHX_ "%s;%d;%s;%d", name, use_locale, file, line); - if (! hv_fetch(PL_seen_deprecated_macro, key, strlen(key), 0)) { + if (! hv_fetch(PL_seen_deprecated_macro, key, strlen(key), 0)) { if (! PL_seen_deprecated_macro) { PL_seen_deprecated_macro = newHV(); } if (! hv_store(PL_seen_deprecated_macro, key, strlen(key), &PL_sv_undef, 0)) { - Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed"); + Perl_croak(aTHX_ "panic: hv_store() unexpectedly failed"); } if (instr(file, "mathoms.c")) { @@ -3344,7 +3344,7 @@ S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, } } - /* Note that non-characters are perfectly legal, so no warning should + /* Note that non-characters are perfectly legal, so no warning should * be given. */ } @@ -3401,7 +3401,7 @@ S__to_utf8_case(pTHX_ const UV uv1, const U8 *p, *lenp = len; } else { - *lenp = uvchr_to_utf8(ustrp, uv1) - ustrp; + *lenp = uvchr_to_utf8(ustrp, uv1) - ustrp; } return uv1; @@ -3503,20 +3503,20 @@ S_check_locale_boundary_crossing(pTHX_ const U8* const p, const UV result, * boundary, so can skip testing */ if (result > 255) { - /* Look at every character in the result; if any cross the - * boundary, the whole thing is disallowed */ - U8* s = ustrp + UTF8SKIP(ustrp); - U8* e = ustrp + *lenp; - while (s < e) { - if (! UTF8_IS_ABOVE_LATIN1(*s)) { - goto bad_crossing; - } - s += UTF8SKIP(s); - } + /* Look at every character in the result; if any cross the + * boundary, the whole thing is disallowed */ + U8* s = ustrp + UTF8SKIP(ustrp); + U8* e = ustrp + *lenp; + while (s < e) { + if (! UTF8_IS_ABOVE_LATIN1(*s)) { + goto bad_crossing; + } + s += UTF8SKIP(s); + } /* Here, no characters crossed, result is ok as-is, but we warn. */ _CHECK_AND_OUTPUT_WIDE_LOCALE_UTF8_MSG(p, p + UTF8SKIP(p)); - return result; + return result; } bad_crossing: @@ -3838,9 +3838,9 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, ((flags) & (FOLD_FLAGS_FULL | FOLD_FLAGS_NOMIX_ASCII)), turkic_fc); - result = CALL_FOLD_CASE(result, p, ustrp, lenp, flags & FOLD_FLAGS_FULL); + result = CALL_FOLD_CASE(result, p, ustrp, lenp, flags & FOLD_FLAGS_FULL); - if (flags & FOLD_FLAGS_LOCALE) { + if (flags & FOLD_FLAGS_LOCALE) { # define LONG_S_T LATIN_SMALL_LIGATURE_LONG_S_T_UTF8 # ifdef LATIN_CAPITAL_LETTER_SHARP_S_UTF8 @@ -3886,26 +3886,26 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, } #endif - return check_locale_boundary_crossing(p, result, ustrp, lenp); - } - else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) { - return result; - } - else { - /* This is called when changing the case of a UTF-8-encoded + return check_locale_boundary_crossing(p, result, ustrp, lenp); + } + else if (! (flags & FOLD_FLAGS_NOMIX_ASCII)) { + return result; + } + else { + /* This is called when changing the case of a UTF-8-encoded * character above the ASCII range, and the result should not * contain an ASCII character. */ - UV original; /* To store the first code point of

*/ + UV original; /* To store the first code point of

*/ - /* Look at every character in the result; if any cross the - * boundary, the whole thing is disallowed */ - U8* s = ustrp; - U8* send = ustrp + *lenp; - while (s < send) { - if (isASCII(*s)) { - /* Crossed, have to return the original */ - original = valid_utf8_to_uvchr(p, lenp); + /* Look at every character in the result; if any cross the + * boundary, the whole thing is disallowed */ + U8* s = ustrp; + U8* send = ustrp + *lenp; + while (s < send) { + if (isASCII(*s)) { + /* Crossed, have to return the original */ + original = valid_utf8_to_uvchr(p, lenp); /* But in these instances, there is an alternative we can * return that is valid */ @@ -3927,26 +3927,26 @@ Perl__to_utf8_fold_flags(pTHX_ const U8 *p, goto return_dotless_i; } #endif - Copy(p, ustrp, *lenp, char); - return original; - } - s += UTF8SKIP(s); - } - - /* Here, no characters crossed, result is ok as-is */ - return result; - } + Copy(p, ustrp, *lenp, char); + return original; + } + s += UTF8SKIP(s); + } + + /* Here, no characters crossed, result is ok as-is */ + return result; + } } /* Here, used locale rules. Convert back to UTF-8 */ if (UTF8_IS_INVARIANT(result)) { - *ustrp = (U8) result; - *lenp = 1; + *ustrp = (U8) result; + *lenp = 1; } else { - *ustrp = UTF8_EIGHT_BIT_HI((U8) result); - *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); - *lenp = 2; + *ustrp = UTF8_EIGHT_BIT_HI((U8) result); + *(ustrp + 1) = UTF8_EIGHT_BIT_LO((U8) result); + *lenp = 2; } return result; @@ -3999,13 +3999,13 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len) PERL_ARGS_ASSERT_CHECK_UTF8_PRINT; while (s < e) { - if (UTF8SKIP(s) > len) { - Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), - "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print"); - return FALSE; - } - if (UNLIKELY(isUTF8_POSSIBLY_PROBLEMATIC(*s))) { - if (UNLIKELY(UTF8_IS_SUPER(s, e))) { + if (UTF8SKIP(s) > len) { + Perl_ck_warner_d(aTHX_ packWARN(WARN_UTF8), + "%s in %s", unees, PL_op ? OP_DESC(PL_op) : "print"); + return FALSE; + } + if (UNLIKELY(isUTF8_POSSIBLY_PROBLEMATIC(*s))) { + if (UNLIKELY(UTF8_IS_SUPER(s, e))) { if ( ckWARN_d(WARN_NON_UNICODE) || UNLIKELY(0 < does_utf8_overflow(s, s + len, 0 /* Don't consider overlongs */ @@ -4015,28 +4015,28 @@ Perl_check_utf8_print(pTHX_ const U8* s, const STRLEN len) (void) utf8n_to_uvchr(s, e - s, NULL, UTF8_WARN_SUPER); ok = FALSE; } - } - else if (UNLIKELY(UTF8_IS_SURROGATE(s, e))) { - if (ckWARN_d(WARN_SURROGATE)) { + } + else if (UNLIKELY(UTF8_IS_SURROGATE(s, e))) { + if (ckWARN_d(WARN_SURROGATE)) { /* This has a different warning than the one the called * function would output, so can't just call it, unlike we * do for the non-chars and above-unicodes */ - UV uv = utf8_to_uvchr_buf(s, e, NULL); - Perl_warner(aTHX_ packWARN(WARN_SURROGATE), - "Unicode surrogate U+%04" UVXf " is illegal in UTF-8", + UV uv = utf8_to_uvchr_buf(s, e, NULL); + Perl_warner(aTHX_ packWARN(WARN_SURROGATE), + "Unicode surrogate U+%04" UVXf " is illegal in UTF-8", uv); - ok = FALSE; - } - } - else if ( UNLIKELY(UTF8_IS_NONCHAR(s, e)) + ok = FALSE; + } + } + else if ( UNLIKELY(UTF8_IS_NONCHAR(s, e)) && (ckWARN_d(WARN_NONCHAR))) { /* A side effect of this function will be to warn */ (void) utf8n_to_uvchr(s, e - s, NULL, UTF8_WARN_NONCHAR); - ok = FALSE; - } - } - s += UTF8SKIP(s); + ok = FALSE; + } + } + s += UTF8SKIP(s); } return ok; @@ -4082,17 +4082,17 @@ Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, SvPVCLEAR(dsv); SvUTF8_off(dsv); for (s = (const char *)spv, e = s + len; s < e; s += UTF8SKIP(s)) { - UV u; - bool ok = 0; - - if (pvlim && SvCUR(dsv) >= pvlim) { - truncated++; - break; - } - u = utf8_to_uvchr_buf((U8*)s, (U8*)e, 0); - if (u < 256) { - const unsigned char c = (unsigned char)u & 0xFF; - if (flags & UNI_DISPLAY_BACKSLASH) { + UV u; + bool ok = 0; + + if (pvlim && SvCUR(dsv) >= pvlim) { + truncated++; + break; + } + u = utf8_to_uvchr_buf((U8*)s, (U8*)e, 0); + if (u < 256) { + const unsigned char c = (unsigned char)u & 0xFF; + if (flags & UNI_DISPLAY_BACKSLASH) { if ( isMNEMONIC_CNTRL(c) && ( c != '\b' || (flags & UNI_DISPLAY_BACKSPACE))) @@ -4106,18 +4106,18 @@ Perl_pv_uni_display(pTHX_ SV *dsv, const U8 *spv, STRLEN len, STRLEN pvlim, ok = 1; } } - /* isPRINT() is the locale-blind version. */ - if (!ok && (flags & UNI_DISPLAY_ISPRINT) && isPRINT(c)) { - const char string = c; - sv_catpvn(dsv, &string, 1); - ok = 1; - } - } - if (!ok) - Perl_sv_catpvf(aTHX_ dsv, "\\x{%" UVxf "}", u); + /* isPRINT() is the locale-blind version. */ + if (!ok && (flags & UNI_DISPLAY_ISPRINT) && isPRINT(c)) { + const char string = c; + sv_catpvn(dsv, &string, 1); + ok = 1; + } + } + if (!ok) + Perl_sv_catpvf(aTHX_ dsv, "\\x{%" UVxf "}", u); } if (truncated) - sv_catpvs(dsv, "..."); + sv_catpvs(dsv, "..."); return SvPVX(dsv); } @@ -4144,7 +4144,7 @@ Perl_sv_uni_display(pTHX_ SV *dsv, SV *ssv, STRLEN pvlim, UV flags) PERL_ARGS_ASSERT_SV_UNI_DISPLAY; return Perl_pv_uni_display(aTHX_ dsv, (const U8*)ptr, - SvCUR(ssv), pvlim, flags); + SvCUR(ssv), pvlim, flags); } /* @@ -4202,7 +4202,7 @@ L (Case Mappings). * externally documented. Currently it is: * 0 for as-documented above * FOLDEQ_UTF8_NOMIX_ASCII meaning that if a non-ASCII character folds to an - ASCII one, to not match + ASCII one, to not match * FOLDEQ_LOCALE is set iff the rules from the current underlying * locale are to be used. * FOLDEQ_S1_ALREADY_FOLDED s1 has already been folded before calling this @@ -4308,7 +4308,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, e1 = g1; } else { - assert(e1); /* Must have an end for looking at s1 */ + assert(e1); /* Must have an end for looking at s1 */ } /* Same for goal for s2 */ @@ -4317,7 +4317,7 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, e2 = g2; } else { - assert(e2); + assert(e2); } /* If both operands are already folded, we could just do a memEQ on the @@ -4328,14 +4328,14 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, while (p1 < e1 && p2 < e2) { /* If at the beginning of a new character in s1, get its fold to use - * and the length of the fold. */ + * and the length of the fold. */ if (n1 == 0) { - if (flags & FOLDEQ_S1_ALREADY_FOLDED) { - f1 = (U8 *) p1; + if (flags & FOLDEQ_S1_ALREADY_FOLDED) { + f1 = (U8 *) p1; assert(u1); - n1 = UTF8SKIP(f1); - } - else { + n1 = UTF8SKIP(f1); + } + else { if (isASCII(*p1) && ! (flags & FOLDEQ_LOCALE)) { /* We have to forbid mixing ASCII with non-ASCII if the @@ -4361,11 +4361,11 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, } if (n2 == 0) { /* Same for s2 */ - if (flags & FOLDEQ_S2_ALREADY_FOLDED) { + if (flags & FOLDEQ_S2_ALREADY_FOLDED) { /* Point to the already-folded character. But for non-UTF-8 * variants, convert to UTF-8 for the algorithm below */ - if (UTF8_IS_INVARIANT(*p2)) { + if (UTF8_IS_INVARIANT(*p2)) { f2 = (U8 *) p2; n2 = 1; } @@ -4379,8 +4379,8 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, f2 = foldbuf2; n2 = 2; } - } - else { + } + else { if (isASCII(*p2) && ! (flags & FOLDEQ_LOCALE)) { if ((flags & FOLDEQ_UTF8_NOMIX_ASCII) && ! isASCII(*p1)) { return 0; @@ -4395,12 +4395,12 @@ Perl_foldEQ_utf8_flags(pTHX_ const char *s1, char **pe1, UV l1, bool u1, _to_uni_fold_flags(*p2, foldbuf2, &n2, flags_for_folder); } f2 = foldbuf2; - } + } } - /* Here f1 and f2 point to the beginning of the strings to compare. - * These strings are the folds of the next character from each input - * string, stored in UTF-8. */ + /* Here f1 and f2 point to the beginning of the strings to compare. + * These strings are the folds of the next character from each input + * string, stored in UTF-8. */ /* While there is more to look for in both folds, see if they * continue to match */ diff --git a/utf8.h b/utf8.h index f52317b69b1b..3bec01989f94 100644 --- a/utf8.h +++ b/utf8.h @@ -70,7 +70,7 @@ the string is invariant. #define to_uni_fold(c, p, lenp) _to_uni_fold_flags(c, p, lenp, FOLD_FLAGS_FULL) #define foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ - foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) + foldEQ_utf8_flags(s1, pe1, l1, u1, s2, pe2, l2, u2, 0) #define FOLDEQ_UTF8_NOMIX_ASCII (1 << 0) #define FOLDEQ_LOCALE (1 << 1) #define FOLDEQ_S1_ALREADY_FOLDED (1 << 2) @@ -720,7 +720,7 @@ case any call to string overloading updates the internal UTF-8 encoding flag. * within 'use bytes'. UTF-8 locales are not tested for here, but perhaps * could be */ #define IN_UNI_8_BIT \ - (( ( (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT)) \ + (( ( (CopHINTS_get(PL_curcop) & HINT_UNI_8_BIT)) \ || ( CopHINTS_get(PL_curcop) & HINT_LOCALE_PARTIAL \ /* -1 below is for :not_characters */ \ && _is_in_locale_category(FALSE, -1))) \ diff --git a/utfebcdic.h b/utfebcdic.h index 97b8f7001a57..ce9981b427b8 100644 --- a/utfebcdic.h +++ b/utfebcdic.h @@ -242,7 +242,7 @@ explicitly forbidden, and the shortest possible encoding should always be used #if '^' == 95 /* CP 1047 */ /* UTF8_CHAR: Matches legal UTF-EBCDIC variant code points up through 0x1FFFFFF - 0xA0 - 0x1FFFFF + 0xA0 - 0x1FFFFF */ /*** GENERATED CODE ***/ @@ -264,11 +264,11 @@ explicitly forbidden, and the shortest possible encoding should always be used /*** GENERATED CODE ***/ #define is_STRICT_UTF8_CHAR_utf8_no_length_checks_part0(s) \ ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x72 ) ) ?\ - ( LIKELY( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ + ( LIKELY( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ : ( 0x73 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ - ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ - : LIKELY( ( 0x73 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ) ? 4 : 0 )\ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ + ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ + : LIKELY( ( 0x73 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ) ? 4 : 0 )\ : 0 ) @@ -276,27 +276,27 @@ explicitly forbidden, and the shortest possible encoding should always be used #define is_STRICT_UTF8_CHAR_utf8_no_length_checks_part1(s) \ ( ( 0xED == ((const U8*)s)[0] ) ? \ ( ( ( ( ((const U8*)s)[1] & 0xEF ) == 0x49 ) || ( ( ((const U8*)s)[1] & 0xF9 ) == 0x51 ) || ((const U8*)s)[1] == 0x63 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x65 ) || ((const U8*)s)[1] == 0x69 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x70 ) ) ?\ - ( LIKELY( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ + ( LIKELY( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ : ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x62 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x68 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x71 ) ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ - ( LIKELY( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ - : ( 0x73 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ?\ - ( LIKELY( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ? 5 : 0 )\ - : LIKELY( ( 0x73 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFE ) == 0x70 ) ) ? 5 : 0 )\ - : 0 ) \ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ + ( LIKELY( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ + : ( 0x73 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ?\ + ( LIKELY( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ? 5 : 0 )\ + : LIKELY( ( 0x73 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFE ) == 0x70 ) ) ? 5 : 0 )\ + : 0 ) \ : 0 ) \ : ( 0xEE == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( LIKELY( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ + ( LIKELY( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ - ( LIKELY( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ - : ( 0x73 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ?\ - ( LIKELY( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ? 5 : 0 )\ - : LIKELY( ( 0x73 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFE ) == 0x70 ) ) ? 5 : 0 )\ - : 0 ) \ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ + ( LIKELY( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ) ? 5 : 0 )\ + : ( 0x73 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ?\ + ( LIKELY( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFC ) == 0x70 ) ? 5 : 0 )\ + : LIKELY( ( 0x73 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( ((const U8*)s)[4] & 0xFE ) == 0x70 ) ) ? 5 : 0 )\ + : 0 ) \ : 0 ) \ : 0 ) @@ -311,15 +311,15 @@ explicitly forbidden, and the shortest possible encoding should always be used ( LIKELY( ( ( ( 0x57 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( ((const U8*)s)[1] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ : ( 0xDD == ((const U8*)s)[0] ) ? \ ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x64 ) || ( 0x67 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x72 ) ) ?\ - ( LIKELY( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ + ( LIKELY( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ : ( 0x73 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x54 ) || ( 0x57 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ - ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ - : ( 0x55 == ((const U8*)s)[2] ) ? \ - ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ - : ( 0x56 == ((const U8*)s)[2] ) ? \ - ( LIKELY( ( 0x57 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ - : LIKELY( ( 0x73 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ) ? 4 : 0 )\ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x54 ) || ( 0x57 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ?\ + ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ + : ( 0x55 == ((const U8*)s)[2] ) ? \ + ( LIKELY( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ + : ( 0x56 == ((const U8*)s)[2] ) ? \ + ( LIKELY( ( 0x57 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ? 4 : 0 )\ + : LIKELY( ( 0x73 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDE == ((const U8*)s)[0] || 0xE1 == ((const U8*)s)[0] || 0xEB == ((const U8*)s)[0] ) ? \ ( LIKELY( ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( ((const U8*)s)[1] & 0xFC ) == 0x70 ) && ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFC ) == 0x70 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFC ) == 0x70 ) ) ? 4 : 0 )\ @@ -327,8 +327,8 @@ explicitly forbidden, and the shortest possible encoding should always be used /* C9_STRICT_UTF8_CHAR: Matches legal Unicode UTF-8 variant code points including non-character code points, no surrogates - 0x00A0 - 0xD7FF - 0xE000 - 0x10FFFF + 0x00A0 - 0xD7FF + 0xE000 - 0x10FFFF */ /*** GENERATED CODE ***/ #define is_C9_STRICT_UTF8_CHAR_utf8_no_length_checks(s) \ @@ -368,15 +368,15 @@ explicitly forbidden, and the shortest possible encoding should always be used /*** GENERATED CODE ***/ #define is_STRICT_UTF8_CHAR_utf8_no_length_checks_part0(s) \ ( ( ( ( ((const U8*)s)[1] & 0xEF ) == 0x49 ) || ( ( ((const U8*)s)[1] & 0xF9 ) == 0x51 ) || ((const U8*)s)[1] == 0x62 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x64 ) || ( ( ((const U8*)s)[1] & 0xFD ) == 0x68 ) || ((const U8*)s)[1] == 0x71 ) ?\ - ( ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ + ( ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ : ( ((const U8*)s)[1] == 0x4A || ((const U8*)s)[1] == 0x52 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x54 ) || ((const U8*)s)[1] == 0x58 || ((const U8*)s)[1] == 0x5F || ((const U8*)s)[1] == 0x63 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x65 ) || ((const U8*)s)[1] == 0x69 || ( ( ((const U8*)s)[1] & 0xFD ) == 0x70 ) ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ - ( ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ - : ( 0x72 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ? 5 : 0 )\ - : ( ( 0x72 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || 0x70 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : 0 ) \ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ + ( ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ + : ( 0x72 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ?\ + ( ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ? 5 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || 0x70 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : 0 ) \ : 0 ) @@ -384,15 +384,15 @@ explicitly forbidden, and the shortest possible encoding should always be used #define is_STRICT_UTF8_CHAR_utf8_no_length_checks_part1(s) \ ( ( 0xEE == ((const U8*)s)[0] ) ? \ ( ( 0x41 == ((const U8*)s)[1] ) ? \ - ( ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ + ( ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ : ( 0x42 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ - ( ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ - : ( 0x72 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ? 5 : 0 )\ - : ( ( 0x72 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || 0x70 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ - : 0 ) \ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ + ( ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ) ? 5 : 0 )\ + : ( 0x72 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( ((const U8*)s)[3] & 0xFE ) == 0x70 ) ?\ + ( ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x72 ) ) ? 5 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[3] ) && ( ( 0x41 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x59 ) || 0x5F == ((const U8*)s)[4] || ( 0x62 <= ((const U8*)s)[4] && ((const U8*)s)[4] <= 0x6A ) || 0x70 == ((const U8*)s)[4] ) ) ? 5 : 0 )\ + : 0 ) \ : 0 ) \ : 0 ) @@ -406,25 +406,25 @@ explicitly forbidden, and the shortest possible encoding should always be used #define is_STRICT_UTF8_CHAR_utf8_no_length_checks_part3(s) \ ( ( 0xDD == ((const U8*)s)[0] ) ? \ ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || 0x5F == ((const U8*)s)[1] || ( ((const U8*)s)[1] & 0xFE ) == 0x62 || ( 0x66 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( ((const U8*)s)[1] & 0xFE ) == 0x70 ) ?\ - ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) ? 4 : 0 )\ + ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) ? 4 : 0 )\ : ( 0x72 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x54 ) || ( 0x57 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ - : ( 0x55 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ - : ( 0x56 == ((const U8*)s)[2] ) ? \ - ( ( ( 0x57 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ - : ( ( 0x72 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || 0x70 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x54 ) || ( 0x57 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ + : ( 0x55 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x56 ) ) ? 4 : 0 )\ + : ( 0x56 == ((const U8*)s)[2] ) ? \ + ( ( ( 0x57 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || 0x70 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xDE == ((const U8*)s)[0] || 0xE1 == ((const U8*)s)[0] || 0xEB == ((const U8*)s)[0] ) ?\ ( ( ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || 0x5F == ((const U8*)s)[1] || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) ? 4 : 0 )\ : ( 0xDF == ((const U8*)s)[0] || 0xEA == ((const U8*)s)[0] || 0xEC == ((const U8*)s)[0] ) ?\ ( ( ( 0x41 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x59 ) || 0x5F == ((const U8*)s)[1] || ( 0x62 <= ((const U8*)s)[1] && ((const U8*)s)[1] <= 0x6A ) || ( ((const U8*)s)[1] & 0xFE ) == 0x70 ) ?\ - ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) ? 4 : 0 )\ + ( ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x72 ) ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ) ? 4 : 0 )\ : ( 0x72 == ((const U8*)s)[1] ) ? \ - ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ - ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ - : ( ( 0x72 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || 0x70 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ + ( ( ( 0x41 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x59 ) || 0x5F == ((const U8*)s)[2] || ( 0x62 <= ((const U8*)s)[2] && ((const U8*)s)[2] <= 0x6A ) || ( ((const U8*)s)[2] & 0xFE ) == 0x70 ) ?\ + ( ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || ( 0x70 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x72 ) ) ? 4 : 0 )\ + : ( ( 0x72 == ((const U8*)s)[2] ) && ( ( 0x41 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x4A ) || ( 0x51 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x59 ) || 0x5F == ((const U8*)s)[3] || ( 0x62 <= ((const U8*)s)[3] && ((const U8*)s)[3] <= 0x6A ) || 0x70 == ((const U8*)s)[3] ) ) ? 4 : 0 )\ : 0 ) \ : ( 0xED == ((const U8*)s)[0] ) ? is_STRICT_UTF8_CHAR_utf8_no_length_checks_part0(s) : is_STRICT_UTF8_CHAR_utf8_no_length_checks_part1(s) ) @@ -439,8 +439,8 @@ explicitly forbidden, and the shortest possible encoding should always be used /* C9_STRICT_UTF8_CHAR: Matches legal Unicode UTF-8 variant code points including non-character code points, no surrogates - 0x00A0 - 0xD7FF - 0xE000 - 0x10FFFF + 0x00A0 - 0xD7FF + 0xE000 - 0x10FFFF */ /*** GENERATED CODE ***/ #define is_C9_STRICT_UTF8_CHAR_utf8_no_length_checks_part0(s) \ diff --git a/util.c b/util.c index dd971f5ebfed..825c33fd90e5 100644 --- a/util.c +++ b/util.c @@ -95,8 +95,8 @@ S_maybe_protect_rw(pTHX_ struct perl_memory_debug_header *header) { if (header->readonly && mprotect(header, header->size, PROT_READ|PROT_WRITE)) - Perl_warn(aTHX_ "mprotect for COW string %p %lu failed with %d", - header, header->size, errno); + Perl_warn(aTHX_ "mprotect for COW string %p %lu failed with %d", + header, header->size, errno); } static void @@ -104,8 +104,8 @@ S_maybe_protect_ro(pTHX_ struct perl_memory_debug_header *header) { if (header->readonly && mprotect(header, header->size, PROT_READ)) - Perl_warn(aTHX_ "mprotect RW for COW string %p %lu failed with %d", - header, header->size, errno); + Perl_warn(aTHX_ "mprotect RW for COW string %p %lu failed with %d", + header, header->size, errno); } # define maybe_protect_rw(foo) S_maybe_protect_rw(aTHX_ foo) # define maybe_protect_ro(foo) S_maybe_protect_ro(aTHX_ foo) @@ -147,15 +147,15 @@ Perl_safesysmalloc(MEM_SIZE size) #endif #ifdef DEBUGGING if ((SSize_t)size < 0) - Perl_croak_nocontext("panic: malloc, size=%" UVuf, (UV) size); + Perl_croak_nocontext("panic: malloc, size=%" UVuf, (UV) size); #endif if (!size) size = 1; /* malloc(0) is NASTY on our system */ SAVE_ERRNO; #ifdef PERL_DEBUG_READONLY_COW if ((ptr = mmap(0, size, PROT_READ|PROT_WRITE, - MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { - perror("mmap failed"); - abort(); + MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { + perror("mmap failed"); + abort(); } #else ptr = (Malloc_t)PerlMem_malloc(size); @@ -163,37 +163,37 @@ Perl_safesysmalloc(MEM_SIZE size) PERL_ALLOC_CHECK(ptr); if (ptr != NULL) { #ifdef USE_MDH - struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)ptr; + struct perl_memory_debug_header *const header + = (struct perl_memory_debug_header *)ptr; #endif #ifdef PERL_POISON - PoisonNew(((char *)ptr), size, char); + PoisonNew(((char *)ptr), size, char); #endif #ifdef PERL_TRACK_MEMPOOL - header->interpreter = aTHX; - /* Link us into the list. */ - header->prev = &PL_memory_debug_header; - header->next = PL_memory_debug_header.next; - PL_memory_debug_header.next = header; - maybe_protect_rw(header->next); - header->next->prev = header; - maybe_protect_ro(header->next); + header->interpreter = aTHX; + /* Link us into the list. */ + header->prev = &PL_memory_debug_header; + header->next = PL_memory_debug_header.next; + PL_memory_debug_header.next = header; + maybe_protect_rw(header->next); + header->next->prev = header; + maybe_protect_ro(header->next); # ifdef PERL_DEBUG_READONLY_COW - header->readonly = 0; + header->readonly = 0; # endif #endif #ifdef MDH_HAS_SIZE - header->size = size; + header->size = size; #endif - ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); + ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) malloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); /* malloc() can modify errno() even on success, but since someone - writing perl code doesn't have any control over when perl calls - malloc() we need to hide that. - */ + writing perl code doesn't have any control over when perl calls + malloc() we need to hide that. + */ RESTORE_ERRNO; } else { @@ -229,107 +229,107 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) Malloc_t ptr; #ifdef PERL_DEBUG_READONLY_COW const MEM_SIZE oldsize = where - ? ((struct perl_memory_debug_header *)((char *)where - PERL_MEMORY_DEBUG_HEADER_SIZE))->size - : 0; + ? ((struct perl_memory_debug_header *)((char *)where - PERL_MEMORY_DEBUG_HEADER_SIZE))->size + : 0; #endif if (!size) { - safesysfree(where); - ptr = NULL; + safesysfree(where); + ptr = NULL; } else if (!where) { - ptr = safesysmalloc(size); + ptr = safesysmalloc(size); } else { dSAVE_ERRNO; #ifdef USE_MDH - where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); + where = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); if (size + PERL_MEMORY_DEBUG_HEADER_SIZE < size) goto out_of_memory; - size += PERL_MEMORY_DEBUG_HEADER_SIZE; - { - struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)where; + size += PERL_MEMORY_DEBUG_HEADER_SIZE; + { + struct perl_memory_debug_header *const header + = (struct perl_memory_debug_header *)where; # ifdef PERL_TRACK_MEMPOOL - if (header->interpreter != aTHX) { - Perl_croak_nocontext("panic: realloc from wrong pool, %p!=%p", - header->interpreter, aTHX); - } - assert(header->next->prev == header); - assert(header->prev->next == header); + if (header->interpreter != aTHX) { + Perl_croak_nocontext("panic: realloc from wrong pool, %p!=%p", + header->interpreter, aTHX); + } + assert(header->next->prev == header); + assert(header->prev->next == header); # ifdef PERL_POISON - if (header->size > size) { - const MEM_SIZE freed_up = header->size - size; - char *start_of_freed = ((char *)where) + size; - PoisonFree(start_of_freed, freed_up, char); - } + if (header->size > size) { + const MEM_SIZE freed_up = header->size - size; + char *start_of_freed = ((char *)where) + size; + PoisonFree(start_of_freed, freed_up, char); + } # endif # endif # ifdef MDH_HAS_SIZE - header->size = size; + header->size = size; # endif - } + } #endif #ifdef DEBUGGING - if ((SSize_t)size < 0) - Perl_croak_nocontext("panic: realloc, size=%" UVuf, (UV)size); + if ((SSize_t)size < 0) + Perl_croak_nocontext("panic: realloc, size=%" UVuf, (UV)size); #endif #ifdef PERL_DEBUG_READONLY_COW - if ((ptr = mmap(0, size, PROT_READ|PROT_WRITE, - MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { - perror("mmap failed"); - abort(); - } - Copy(where,ptr,oldsize < size ? oldsize : size,char); - if (munmap(where, oldsize)) { - perror("munmap failed"); - abort(); - } + if ((ptr = mmap(0, size, PROT_READ|PROT_WRITE, + MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { + perror("mmap failed"); + abort(); + } + Copy(where,ptr,oldsize < size ? oldsize : size,char); + if (munmap(where, oldsize)) { + perror("munmap failed"); + abort(); + } #else - ptr = (Malloc_t)PerlMem_realloc(where,size); + ptr = (Malloc_t)PerlMem_realloc(where,size); #endif - PERL_ALLOC_CHECK(ptr); + PERL_ALLOC_CHECK(ptr); /* MUST do this fixup first, before doing ANYTHING else, as anything else might allocate memory/free/move memory, and until we do the fixup, it may well be chasing (and writing to) free memory. */ - if (ptr != NULL) { + if (ptr != NULL) { #ifdef PERL_TRACK_MEMPOOL - struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)ptr; + struct perl_memory_debug_header *const header + = (struct perl_memory_debug_header *)ptr; # ifdef PERL_POISON - if (header->size < size) { - const MEM_SIZE fresh = size - header->size; - char *start_of_fresh = ((char *)ptr) + size; - PoisonNew(start_of_fresh, fresh, char); - } + if (header->size < size) { + const MEM_SIZE fresh = size - header->size; + char *start_of_fresh = ((char *)ptr) + size; + PoisonNew(start_of_fresh, fresh, char); + } # endif - maybe_protect_rw(header->next); - header->next->prev = header; - maybe_protect_ro(header->next); - maybe_protect_rw(header->prev); - header->prev->next = header; - maybe_protect_ro(header->prev); + maybe_protect_rw(header->next); + header->next->prev = header; + maybe_protect_ro(header->next); + maybe_protect_rw(header->prev); + header->prev->next = header; + maybe_protect_ro(header->prev); #endif - ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); + ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); - /* realloc() can modify errno() even on success, but since someone - writing perl code doesn't have any control over when perl calls - realloc() we need to hide that. - */ - RESTORE_ERRNO; - } + /* realloc() can modify errno() even on success, but since someone + writing perl code doesn't have any control over when perl calls + realloc() we need to hide that. + */ + RESTORE_ERRNO; + } /* In particular, must do that fixup above before logging anything via *printf(), as it can reallocate memory, which can cause SEGVs. */ - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); - DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) rfree\n",PTR2UV(where),(long)PL_an++)); + DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) realloc %ld bytes\n",PTR2UV(ptr),(long)PL_an++,(long)size)); - if (ptr == NULL) { + if (ptr == NULL) { #ifdef USE_MDH out_of_memory: #endif @@ -342,7 +342,7 @@ Perl_safesysrealloc(Malloc_t where,MEM_SIZE size) else croak_no_mem(); } - } + } } return ptr; } @@ -363,56 +363,56 @@ Perl_safesysfree(Malloc_t where) DEBUG_m( PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) free\n",PTR2UV(where),(long)PL_an++)); if (where) { #ifdef USE_MDH - Malloc_t where_intrn = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); - { - struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)where_intrn; + Malloc_t where_intrn = (Malloc_t)((char*)where-PERL_MEMORY_DEBUG_HEADER_SIZE); + { + struct perl_memory_debug_header *const header + = (struct perl_memory_debug_header *)where_intrn; # ifdef MDH_HAS_SIZE - const MEM_SIZE size = header->size; + const MEM_SIZE size = header->size; # endif # ifdef PERL_TRACK_MEMPOOL - if (header->interpreter != aTHX) { - Perl_croak_nocontext("panic: free from wrong pool, %p!=%p", - header->interpreter, aTHX); - } - if (!header->prev) { - Perl_croak_nocontext("panic: duplicate free"); - } - if (!(header->next)) - Perl_croak_nocontext("panic: bad free, header->next==NULL"); - if (header->next->prev != header || header->prev->next != header) { - Perl_croak_nocontext("panic: bad free, ->next->prev=%p, " - "header=%p, ->prev->next=%p", - header->next->prev, header, - header->prev->next); - } - /* Unlink us from the chain. */ - maybe_protect_rw(header->next); - header->next->prev = header->prev; - maybe_protect_ro(header->next); - maybe_protect_rw(header->prev); - header->prev->next = header->next; - maybe_protect_ro(header->prev); - maybe_protect_rw(header); + if (header->interpreter != aTHX) { + Perl_croak_nocontext("panic: free from wrong pool, %p!=%p", + header->interpreter, aTHX); + } + if (!header->prev) { + Perl_croak_nocontext("panic: duplicate free"); + } + if (!(header->next)) + Perl_croak_nocontext("panic: bad free, header->next==NULL"); + if (header->next->prev != header || header->prev->next != header) { + Perl_croak_nocontext("panic: bad free, ->next->prev=%p, " + "header=%p, ->prev->next=%p", + header->next->prev, header, + header->prev->next); + } + /* Unlink us from the chain. */ + maybe_protect_rw(header->next); + header->next->prev = header->prev; + maybe_protect_ro(header->next); + maybe_protect_rw(header->prev); + header->prev->next = header->next; + maybe_protect_ro(header->prev); + maybe_protect_rw(header); # ifdef PERL_POISON - PoisonNew(where_intrn, size, char); + PoisonNew(where_intrn, size, char); # endif - /* Trigger the duplicate free warning. */ - header->next = NULL; + /* Trigger the duplicate free warning. */ + header->next = NULL; # endif # ifdef PERL_DEBUG_READONLY_COW - if (munmap(where_intrn, size)) { - perror("munmap failed"); - abort(); - } + if (munmap(where_intrn, size)) { + perror("munmap failed"); + abort(); + } # endif - } + } #else - Malloc_t where_intrn = where; + Malloc_t where_intrn = where; #endif /* USE_MDH */ #ifndef PERL_DEBUG_READONLY_COW - PerlMem_free(where_intrn); + PerlMem_free(where_intrn); #endif } } @@ -438,27 +438,27 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) /* Even though calloc() for zero bytes is strange, be robust. */ if (size && (count <= MEM_SIZE_MAX / size)) { #if defined(USE_MDH) || defined(DEBUGGING) - total_size = size * count; + total_size = size * count; #endif } else - croak_memory_wrap(); + croak_memory_wrap(); #ifdef USE_MDH if (PERL_MEMORY_DEBUG_HEADER_SIZE <= MEM_SIZE_MAX - (MEM_SIZE)total_size) - total_size += PERL_MEMORY_DEBUG_HEADER_SIZE; + total_size += PERL_MEMORY_DEBUG_HEADER_SIZE; else - croak_memory_wrap(); + croak_memory_wrap(); #endif #ifdef DEBUGGING if ((SSize_t)size < 0 || (SSize_t)count < 0) - Perl_croak_nocontext("panic: calloc, size=%" UVuf ", count=%" UVuf, - (UV)size, (UV)count); + Perl_croak_nocontext("panic: calloc, size=%" UVuf ", count=%" UVuf, + (UV)size, (UV)count); #endif #ifdef PERL_DEBUG_READONLY_COW if ((ptr = mmap(0, total_size ? total_size : 1, PROT_READ|PROT_WRITE, - MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { - perror("mmap failed"); - abort(); + MAP_ANON|MAP_PRIVATE, -1, 0)) == MAP_FAILED) { + perror("mmap failed"); + abort(); } #elif defined(PERL_TRACK_MEMPOOL) /* Have to use malloc() because we've added some space for our tracking @@ -469,49 +469,49 @@ Perl_safesyscalloc(MEM_SIZE count, MEM_SIZE size) /* Use calloc() because it might save a memset() if the memory is fresh and clean from the OS. */ if (count && size) - ptr = (Malloc_t)PerlMem_calloc(count, size); + ptr = (Malloc_t)PerlMem_calloc(count, size); else /* calloc(0) is non-portable. */ - ptr = (Malloc_t)PerlMem_calloc(count ? count : 1, size ? size : 1); + ptr = (Malloc_t)PerlMem_calloc(count ? count : 1, size ? size : 1); #endif PERL_ALLOC_CHECK(ptr); DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) calloc %zu x %zu = %zu bytes\n",PTR2UV(ptr),(long)PL_an++, count, size, total_size)); if (ptr != NULL) { #ifdef USE_MDH - { - struct perl_memory_debug_header *const header - = (struct perl_memory_debug_header *)ptr; + { + struct perl_memory_debug_header *const header + = (struct perl_memory_debug_header *)ptr; # ifndef PERL_DEBUG_READONLY_COW - memset((void*)ptr, 0, total_size); + memset((void*)ptr, 0, total_size); # endif # ifdef PERL_TRACK_MEMPOOL - header->interpreter = aTHX; - /* Link us into the list. */ - header->prev = &PL_memory_debug_header; - header->next = PL_memory_debug_header.next; - PL_memory_debug_header.next = header; - maybe_protect_rw(header->next); - header->next->prev = header; - maybe_protect_ro(header->next); + header->interpreter = aTHX; + /* Link us into the list. */ + header->prev = &PL_memory_debug_header; + header->next = PL_memory_debug_header.next; + PL_memory_debug_header.next = header; + maybe_protect_rw(header->next); + header->next->prev = header; + maybe_protect_ro(header->next); # ifdef PERL_DEBUG_READONLY_COW - header->readonly = 0; + header->readonly = 0; # endif # endif # ifdef MDH_HAS_SIZE - header->size = total_size; + header->size = total_size; # endif - ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); - } + ptr = (Malloc_t)((char*)ptr+PERL_MEMORY_DEBUG_HEADER_SIZE); + } #endif - return ptr; + return ptr; } else { #ifndef ALWAYS_NEED_THX - dTHX; + dTHX; #endif - if (PL_nomemok) - return NULL; - croak_no_mem(); + if (PL_nomemok) + return NULL; + croak_no_mem(); } } @@ -886,7 +886,7 @@ Perl_rninstr(const char *big, const char *bigend, const char *little, const char /* A non-existent needle trivially matches the rightmost possible position * in the haystack */ if (UNLIKELY(little_len <= 0)) { - return (char*)bigend; + return (char*)bigend; } /* If the needle is larger than the haystack, the needle can't possibly fit @@ -996,22 +996,22 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) PERL_ARGS_ASSERT_FBM_COMPILE; if (isGV_with_GP(sv) || SvROK(sv)) - return; + return; if (SvVALID(sv)) - return; + return; if (flags & FBMcf_TAIL) { - MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; - sv_catpvs(sv, "\n"); /* Taken into account in fbm_instr() */ - if (mg && mg->mg_len >= 0) - mg->mg_len++; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL; + sv_catpvs(sv, "\n"); /* Taken into account in fbm_instr() */ + if (mg && mg->mg_len >= 0) + mg->mg_len++; } if (!SvPOK(sv) || SvNIOKp(sv)) - s = (U8*)SvPV_force_mutable(sv, len); + s = (U8*)SvPV_force_mutable(sv, len); else s = (U8 *)SvPV_mutable(sv, len); if (len == 0) /* TAIL might be on a zero-length string. */ - return; + return; SvUPGRADE(sv, SVt_PVMG); SvIOK_off(sv); SvNOK_off(sv); @@ -1023,24 +1023,24 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags) assert(mg); if (len > 2) { - /* Shorter strings are special-cased in Perl_fbm_instr(), and don't use - the BM table. */ - const U8 mlen = (len>255) ? 255 : (U8)len; - const unsigned char *const sb = s + len - mlen; /* first char (maybe) */ - U8 *table; - - Newx(table, 256, U8); - memset((void*)table, mlen, 256); - mg->mg_ptr = (char *)table; - mg->mg_len = 256; - - s += len - 1; /* last char */ - i = 0; - while (s >= sb) { - if (table[*s] == mlen) - table[*s] = (U8)i; - s--, i++; - } + /* Shorter strings are special-cased in Perl_fbm_instr(), and don't use + the BM table. */ + const U8 mlen = (len>255) ? 255 : (U8)len; + const unsigned char *const sb = s + len - mlen; /* first char (maybe) */ + U8 *table; + + Newx(table, 256, U8); + memset((void*)table, mlen, 256); + mg->mg_ptr = (char *)table; + mg->mg_len = 256; + + s += len - 1; /* last char */ + i = 0; + while (s >= sb) { + if (table[*s] == mlen) + table[*s] = (U8)i; + s--, i++; + } } BmUSEFUL(sv) = 100; /* Initial value */ @@ -1094,44 +1094,44 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U assert(bigend >= big); if ((STRLEN)(bigend - big) < littlelen) { - if ( tail - && ((STRLEN)(bigend - big) == littlelen - 1) - && (littlelen == 1 - || (*big == *little && - memEQ((char *)big, (char *)little, littlelen - 1)))) - return (char*)big; - return NULL; + if ( tail + && ((STRLEN)(bigend - big) == littlelen - 1) + && (littlelen == 1 + || (*big == *little && + memEQ((char *)big, (char *)little, littlelen - 1)))) + return (char*)big; + return NULL; } switch (littlelen) { /* Special cases for 0, 1 and 2 */ case 0: - return (char*)big; /* Cannot be SvTAIL! */ + return (char*)big; /* Cannot be SvTAIL! */ case 1: - if (tail && !multiline) /* Anchor only! */ - /* [-1] is safe because we know that bigend != big. */ - return (char *) (bigend - (bigend[-1] == '\n')); + if (tail && !multiline) /* Anchor only! */ + /* [-1] is safe because we know that bigend != big. */ + return (char *) (bigend - (bigend[-1] == '\n')); - s = (unsigned char *)memchr((void*)big, *little, bigend-big); + s = (unsigned char *)memchr((void*)big, *little, bigend-big); if (s) return (char *)s; - if (tail) - return (char *) bigend; - return NULL; + if (tail) + return (char *) bigend; + return NULL; case 2: - if (tail && !multiline) { + if (tail && !multiline) { /* a littlestr with SvTAIL must be of the form "X\n" (where X * is a single char). It is anchored, and can only match * "....X\n" or "....X" */ if (bigend[-2] == *little && bigend[-1] == '\n') - return (char*)bigend - 2; - if (bigend[-1] == *little) - return (char*)bigend - 1; - return NULL; - } + return (char*)bigend - 2; + if (bigend[-1] == *little) + return (char*)bigend - 1; + return NULL; + } - { + { /* memchr() is likely to be very fast, possibly using whatever * hardware support is available, such as checking a whole * cache line in one instruction. @@ -1141,14 +1141,14 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U * only needed to read every 2nd char, which was good back in * the day, but no longer. */ - unsigned char c1 = little[0]; - unsigned char c2 = little[1]; + unsigned char c1 = little[0]; + unsigned char c2 = little[1]; /* *** for all this case, bigend points to the last char, * not the trailing \0: this makes the conditions slightly * simpler */ bigend--; - s = big; + s = big; if (c1 != c2) { while (s < bigend) { /* do a quick test for c1 before calling memchr(); @@ -1204,59 +1204,59 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U } default: - break; /* Only lengths 0 1 and 2 have special-case code. */ + break; /* Only lengths 0 1 and 2 have special-case code. */ } if (tail && !multiline) { /* tail anchored? */ - s = bigend - littlelen; - if (s >= big && bigend[-1] == '\n' && *s == *little - /* Automatically of length > 2 */ - && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2)) - { - return (char*)s; /* how sweet it is */ - } - if (s[1] == *little - && memEQ((char*)s + 2, (char*)little + 1, littlelen - 2)) - { - return (char*)s + 1; /* how sweet it is */ - } - return NULL; + s = bigend - littlelen; + if (s >= big && bigend[-1] == '\n' && *s == *little + /* Automatically of length > 2 */ + && memEQ((char*)s + 1, (char*)little + 1, littlelen - 2)) + { + return (char*)s; /* how sweet it is */ + } + if (s[1] == *little + && memEQ((char*)s + 2, (char*)little + 1, littlelen - 2)) + { + return (char*)s + 1; /* how sweet it is */ + } + return NULL; } if (!valid) { /* not compiled; use Perl_ninstr() instead */ - char * const b = ninstr((char*)big,(char*)bigend, - (char*)little, (char*)little + littlelen); + char * const b = ninstr((char*)big,(char*)bigend, + (char*)little, (char*)little + littlelen); assert(!tail); /* valid => FBM; tail only set on SvVALID SVs */ - return b; + return b; } /* Do actual FBM. */ if (littlelen > (STRLEN)(bigend - big)) - return NULL; + return NULL; { - const MAGIC *const mg = mg_find(littlestr, PERL_MAGIC_bm); - const unsigned char *oldlittle; + const MAGIC *const mg = mg_find(littlestr, PERL_MAGIC_bm); + const unsigned char *oldlittle; - assert(mg); + assert(mg); - --littlelen; /* Last char found by table lookup */ + --littlelen; /* Last char found by table lookup */ - s = big + littlelen; - little += littlelen; /* last char */ - oldlittle = little; - if (s < bigend) { - const unsigned char * const table = (const unsigned char *) mg->mg_ptr; + s = big + littlelen; + little += littlelen; /* last char */ + oldlittle = little; + if (s < bigend) { + const unsigned char * const table = (const unsigned char *) mg->mg_ptr; const unsigned char lastc = *little; - I32 tmp; + I32 tmp; - top2: - if ((tmp = table[*s])) { + top2: + if ((tmp = table[*s])) { /* *s != lastc; earliest position it could match now is * tmp slots further on */ - if ((s += tmp) >= bigend) + if ((s += tmp) >= bigend) goto check_end; if (LIKELY(*s != lastc)) { s++; @@ -1267,35 +1267,35 @@ Perl_fbm_instr(pTHX_ unsigned char *big, unsigned char *bigend, SV *littlestr, U } goto top2; } - } + } /* hand-rolled strncmp(): less expensive than calling the * real function (maybe???) */ - { - unsigned char * const olds = s; - - tmp = littlelen; - - while (tmp--) { - if (*--s == *--little) - continue; - s = olds + 1; /* here we pay the price for failure */ - little = oldlittle; - if (s < bigend) /* fake up continue to outer loop */ - goto top2; - goto check_end; - } - return (char *)s; - } - } + { + unsigned char * const olds = s; + + tmp = littlelen; + + while (tmp--) { + if (*--s == *--little) + continue; + s = olds + 1; /* here we pay the price for failure */ + little = oldlittle; + if (s < bigend) /* fake up continue to outer loop */ + goto top2; + goto check_end; + } + return (char *)s; + } + } check_end: - if ( s == bigend - && tail - && memEQ((char *)(bigend - littlelen), - (char *)(oldlittle - littlelen), littlelen) ) - return (char*)bigend - littlelen; - return NULL; + if ( s == bigend + && tail + && memEQ((char *)(bigend - littlelen), + (char *)(oldlittle - littlelen), littlelen) ) + return (char*)bigend - littlelen; + return NULL; } } @@ -1345,12 +1345,12 @@ Perl_savepv(pTHX_ const char *pv) { PERL_UNUSED_CONTEXT; if (!pv) - return NULL; + return NULL; else { - char *newaddr; - const STRLEN pvlen = strlen(pv)+1; - Newx(newaddr, pvlen, char); - return (char*)memcpy(newaddr, pv, pvlen); + char *newaddr; + const STRLEN pvlen = strlen(pv)+1; + Newx(newaddr, pvlen, char); + return (char*)memcpy(newaddr, pv, pvlen); } } @@ -1381,12 +1381,12 @@ Perl_savepvn(pTHX_ const char *pv, Size_t len) Newx(newaddr,len+1,char); /* Give a meaning to NULL pointer mainly for the use in sv_magic() */ if (pv) { - /* might not be null terminated */ - newaddr[len] = '\0'; - return (char *) CopyD(pv,newaddr,len,char); + /* might not be null terminated */ + newaddr[len] = '\0'; + return (char *) CopyD(pv,newaddr,len,char); } else { - return (char *) ZeroD(newaddr,len+1,char); + return (char *) ZeroD(newaddr,len+1,char); } } @@ -1407,12 +1407,12 @@ Perl_savesharedpv(pTHX_ const char *pv) PERL_UNUSED_CONTEXT; if (!pv) - return NULL; + return NULL; pvlen = strlen(pv)+1; newaddr = (char*)PerlMemShared_malloc(pvlen); if (!newaddr) { - croak_no_mem(); + croak_no_mem(); } return (char*)memcpy(newaddr, pv, pvlen); } @@ -1435,7 +1435,7 @@ Perl_savesharedpvn(pTHX_ const char *const pv, const STRLEN len) /* PERL_ARGS_ASSERT_SAVESHAREDPVN; */ if (!newaddr) { - croak_no_mem(); + croak_no_mem(); } newaddr[len] = '\0'; return (char*)memcpy(newaddr, pv, len); @@ -1497,10 +1497,10 @@ S_mess_alloc(pTHX) XPVMG *any; if (PL_phase != PERL_PHASE_DESTRUCT) - return newSVpvs_flags("", SVs_TEMP); + return newSVpvs_flags("", SVs_TEMP); if (PL_mess_sv) - return PL_mess_sv; + return PL_mess_sv; /* Create as PVMG now, to avoid any upgrading later */ Newx(sv, 1, SV); @@ -1626,7 +1626,7 @@ Perl_mess(pTHX_ const char *pat, ...) const COP* Perl_closest_cop(pTHX_ const COP *cop, const OP *o, const OP *curop, - bool opnext) + bool opnext) { /* Look for curop starting from o. cop is the last COP we've seen. */ /* opnext means that curop is actually the ->op_next of the op we are @@ -1635,27 +1635,27 @@ Perl_closest_cop(pTHX_ const COP *cop, const OP *o, const OP *curop, PERL_ARGS_ASSERT_CLOSEST_COP; if (!o || !curop || ( - opnext ? o->op_next == curop && o->op_type != OP_SCOPE : o == curop + opnext ? o->op_next == curop && o->op_type != OP_SCOPE : o == curop )) - return cop; + return cop; if (o->op_flags & OPf_KIDS) { - const OP *kid; - for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { - const COP *new_cop; + const OP *kid; + for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid)) { + const COP *new_cop; - /* If the OP_NEXTSTATE has been optimised away we can still use it - * the get the file and line number. */ + /* If the OP_NEXTSTATE has been optimised away we can still use it + * the get the file and line number. */ - if (kid->op_type == OP_NULL && kid->op_targ == OP_NEXTSTATE) - cop = (const COP *)kid; + if (kid->op_type == OP_NULL && kid->op_targ == OP_NEXTSTATE) + cop = (const COP *)kid; - /* Keep searching, and return when we've found something. */ + /* Keep searching, and return when we've found something. */ - new_cop = closest_cop(cop, kid, curop, opnext); - if (new_cop) - return new_cop; - } + new_cop = closest_cop(cop, kid, curop, opnext); + if (new_cop) + return new_cop; + } } /* Nothing found. */ @@ -1709,31 +1709,31 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume) PERL_ARGS_ASSERT_MESS_SV; if (SvROK(basemsg)) { - if (consume) { - sv = basemsg; - } - else { - sv = mess_alloc(); - sv_setsv(sv, basemsg); - } - return sv; + if (consume) { + sv = basemsg; + } + else { + sv = mess_alloc(); + sv_setsv(sv, basemsg); + } + return sv; } if (SvPOK(basemsg) && consume) { - sv = basemsg; + sv = basemsg; } else { - sv = mess_alloc(); - sv_copypv(sv, basemsg); + sv = mess_alloc(); + sv_copypv(sv, basemsg); } if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') { - /* - * Try and find the file and line for PL_op. This will usually be - * PL_curcop, but it might be a cop that has been optimised away. We - * can try to find such a cop by searching through the optree starting - * from the sibling of PL_curcop. - */ + /* + * Try and find the file and line for PL_op. This will usually be + * PL_curcop, but it might be a cop that has been optimised away. We + * can try to find such a cop by searching through the optree starting + * from the sibling of PL_curcop. + */ if (PL_curcop) { const COP *cop = @@ -1746,23 +1746,23 @@ Perl_mess_sv(pTHX_ SV *basemsg, bool consume) OutCopFILE(cop), (IV)CopLINE(cop)); } - /* Seems that GvIO() can be untrustworthy during global destruction. */ - if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO) - && IoLINES(GvIOp(PL_last_in_gv))) - { - STRLEN l; - const bool line_mode = (RsSIMPLE(PL_rs) && - *SvPV_const(PL_rs,l) == '\n' && l == 1); - Perl_sv_catpvf(aTHX_ sv, ", <%" SVf "> %s %" IVdf, - SVfARG(PL_last_in_gv == PL_argvgv + /* Seems that GvIO() can be untrustworthy during global destruction. */ + if (GvIO(PL_last_in_gv) && (SvTYPE(GvIOp(PL_last_in_gv)) == SVt_PVIO) + && IoLINES(GvIOp(PL_last_in_gv))) + { + STRLEN l; + const bool line_mode = (RsSIMPLE(PL_rs) && + *SvPV_const(PL_rs,l) == '\n' && l == 1); + Perl_sv_catpvf(aTHX_ sv, ", <%" SVf "> %s %" IVdf, + SVfARG(PL_last_in_gv == PL_argvgv ? &PL_sv_no : sv_2mortal(newSVhek(GvNAME_HEK(PL_last_in_gv)))), - line_mode ? "line" : "chunk", - (IV)IoLINES(GvIOp(PL_last_in_gv))); - } - if (PL_phase == PERL_PHASE_DESTRUCT) - sv_catpvs(sv, " during global destruction"); - sv_catpvs(sv, ".\n"); + line_mode ? "line" : "chunk", + (IV)IoLINES(GvIOp(PL_last_in_gv))); + } + if (PL_phase == PERL_PHASE_DESTRUCT) + sv_catpvs(sv, " during global destruction"); + sv_catpvs(sv, ".\n"); } return sv; } @@ -1804,15 +1804,15 @@ Perl_write_to_stderr(pTHX_ SV* msv) PERL_ARGS_ASSERT_WRITE_TO_STDERR; if (PL_stderrgv && SvREFCNT(PL_stderrgv) - && (io = GvIO(PL_stderrgv)) - && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) - Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT), - G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv); + && (io = GvIO(PL_stderrgv)) + && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) + Perl_magic_methcall(aTHX_ MUTABLE_SV(io), mg, SV_CONST(PRINT), + G_SCALAR | G_DISCARD | G_WRITING_TO_STDERR, 1, msv); else { - PerlIO * const serr = Perl_error_log; + PerlIO * const serr = Perl_error_log; - do_print(msv, serr); - (void)PerlIO_flush(serr); + do_print(msv, serr); + (void)PerlIO_flush(serr); } } @@ -1827,9 +1827,9 @@ S_with_queued_errors(pTHX_ SV *ex) { PERL_ARGS_ASSERT_WITH_QUEUED_ERRORS; if (PL_errors && SvCUR(PL_errors) && !SvROK(ex)) { - sv_catsv(PL_errors, ex); - ex = sv_mortalcopy(PL_errors); - SvCUR_set(PL_errors, 0); + sv_catsv(PL_errors, ex); + ex = sv_mortalcopy(PL_errors); + SvCUR_set(PL_errors, 0); } return ex; } @@ -1845,7 +1845,7 @@ S_invoke_exception_hook(pTHX_ SV *ex, bool warn) SV * const oldhook = *hook; if (!oldhook || oldhook == PERL_WARNHOOK_FATAL) - return FALSE; + return FALSE; ENTER; SAVESPTR(*hook); @@ -1853,27 +1853,27 @@ S_invoke_exception_hook(pTHX_ SV *ex, bool warn) cv = sv_2cv(oldhook, &stash, &gv, 0); LEAVE; if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) { - dSP; - SV *exarg; - - ENTER; - save_re_context(); - if (warn) { - SAVESPTR(*hook); - *hook = NULL; - } - exarg = newSVsv(ex); - SvREADONLY_on(exarg); - SAVEFREESV(exarg); - - PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK); - PUSHMARK(SP); - XPUSHs(exarg); - PUTBACK; - call_sv(MUTABLE_SV(cv), G_DISCARD); - POPSTACK; - LEAVE; - return TRUE; + dSP; + SV *exarg; + + ENTER; + save_re_context(); + if (warn) { + SAVESPTR(*hook); + *hook = NULL; + } + exarg = newSVsv(ex); + SvREADONLY_on(exarg); + SAVEFREESV(exarg); + + PUSHSTACKi(warn ? PERLSI_WARNHOOK : PERLSI_DIEHOOK); + PUSHMARK(SP); + XPUSHs(exarg); + PUTBACK; + call_sv(MUTABLE_SV(cv), G_DISCARD); + POPSTACK; + LEAVE; + return TRUE; } return FALSE; } @@ -2144,7 +2144,7 @@ Perl_warn_sv(pTHX_ SV *baseex) SV *ex = mess_sv(baseex, 0); PERL_ARGS_ASSERT_WARN_SV; if (!invoke_exception_hook(ex, TRUE)) - write_to_stderr(ex); + write_to_stderr(ex); } /* @@ -2166,7 +2166,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) SV *ex = vmess(pat, args); PERL_ARGS_ASSERT_VWARN; if (!invoke_exception_hook(ex, TRUE)) - write_to_stderr(ex); + write_to_stderr(ex); } /* @@ -2283,10 +2283,10 @@ Perl_ck_warner_d(pTHX_ U32 err, const char* pat, ...) PERL_ARGS_ASSERT_CK_WARNER_D; if (Perl_ckwarn_d(aTHX_ err)) { - va_list args; - va_start(args, pat); - vwarner(err, pat, &args); - va_end(args); + va_list args; + va_start(args, pat); + vwarner(err, pat, &args); + va_end(args); } } @@ -2296,10 +2296,10 @@ Perl_ck_warner(pTHX_ U32 err, const char* pat, ...) PERL_ARGS_ASSERT_CK_WARNER; if (Perl_ckwarn(aTHX_ err)) { - va_list args; - va_start(args, pat); - vwarner(err, pat, &args); - va_end(args); + va_list args; + va_start(args, pat); + vwarner(err, pat, &args); + va_end(args); } } @@ -2321,18 +2321,18 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) (PL_warnhook == PERL_WARNHOOK_FATAL || ckDEAD(err)) && !(PL_in_eval & EVAL_KEEPERR) ) { - SV * const msv = vmess(pat, args); + SV * const msv = vmess(pat, args); - if (PL_parser && PL_parser->error_count) { - qerror(msv); - } - else { - invoke_exception_hook(msv, FALSE); - die_unwind(msv); - } + if (PL_parser && PL_parser->error_count) { + qerror(msv); + } + else { + invoke_exception_hook(msv, FALSE); + die_unwind(msv); + } } else { - Perl_vwarn(aTHX_ pat, args); + Perl_vwarn(aTHX_ pat, args); } } @@ -2343,7 +2343,7 @@ Perl_ckwarn(pTHX_ U32 w) { /* If lexical warnings have not been set, use $^W. */ if (isLEXWARN_off) - return PL_dowarn & G_WARN_ON; + return PL_dowarn & G_WARN_ON; return ckwarn_common(w); } @@ -2355,7 +2355,7 @@ Perl_ckwarn_d(pTHX_ U32 w) { /* If lexical warnings have not been set then default classes warn. */ if (isLEXWARN_off) - return TRUE; + return TRUE; return ckwarn_common(w); } @@ -2364,10 +2364,10 @@ static bool S_ckwarn_common(pTHX_ U32 w) { if (PL_curcop->cop_warnings == pWARN_ALL) - return TRUE; + return TRUE; if (PL_curcop->cop_warnings == pWARN_NONE) - return FALSE; + return FALSE; /* Check the assumption that at least the first slot is non-zero. */ assert(unpackWARN1(w)); @@ -2375,17 +2375,17 @@ S_ckwarn_common(pTHX_ U32 w) /* Check the assumption that it is valid to stop as soon as a zero slot is seen. */ if (!unpackWARN2(w)) { - assert(!unpackWARN3(w)); - assert(!unpackWARN4(w)); + assert(!unpackWARN3(w)); + assert(!unpackWARN4(w)); } else if (!unpackWARN3(w)) { - assert(!unpackWARN4(w)); + assert(!unpackWARN4(w)); } - + /* Right, dealt with all the special cases, which are implemented as non- pointers, so there is a pointer to a real warnings mask. */ do { - if (isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))) - return TRUE; + if (isWARN_on(PL_curcop->cop_warnings, unpackWARN1(w))) + return TRUE; } while (w >>= WARNshift); return FALSE; @@ -2394,20 +2394,20 @@ S_ckwarn_common(pTHX_ U32 w) /* Set buffer=NULL to get a new one. */ STRLEN * Perl_new_warnings_bitfield(pTHX_ STRLEN *buffer, const char *const bits, - STRLEN size) { + STRLEN size) { const MEM_SIZE len_wanted = - sizeof(STRLEN) + (size > WARNsize ? size : WARNsize); + sizeof(STRLEN) + (size > WARNsize ? size : WARNsize); PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_NEW_WARNINGS_BITFIELD; buffer = (STRLEN*) - (specialWARN(buffer) ? - PerlMemShared_malloc(len_wanted) : - PerlMemShared_realloc(buffer, len_wanted)); + (specialWARN(buffer) ? + PerlMemShared_malloc(len_wanted) : + PerlMemShared_realloc(buffer, len_wanted)); buffer[0] = size; Copy(bits, (buffer + 1), size, char); if (size < WARNsize) - Zero((char *)(buffer + 1) + size, WARNsize - size, char); + Zero((char *)(buffer + 1) + size, WARNsize - size, char); return buffer; } @@ -2572,9 +2572,9 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) if (environ) /* old glibc can crash with null environ */ (void)unsetenv(nam); } else { - const Size_t nlen = strlen(nam); - const Size_t vlen = strlen(val); - char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); + const Size_t nlen = strlen(nam); + const Size_t vlen = strlen(val); + char * const new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); my_setenv_format(new_env, nam, nlen, val, vlen); (void)putenv(new_env); } @@ -2582,10 +2582,10 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val) # else /* ! HAS_UNSETENV */ char *new_env; - const Size_t nlen = strlen(nam); - Size_t vlen; + const Size_t nlen = strlen(nam); + Size_t vlen; if (!val) { - val = ""; + val = ""; } vlen = strlen(val); new_env = S_env_alloc(NULL, nlen, vlen, 2, 1); @@ -2641,7 +2641,7 @@ Perl_unlnk(pTHX_ const char *f) /* unlink all versions of a file */ PERL_ARGS_ASSERT_UNLNK; while (PerlLIO_unlink(f) >= 0) - retries++; + retries++; return retries ? 0 : -1; } #endif @@ -2663,77 +2663,77 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) This = (*mode == 'w'); that = !This; if (TAINTING_get) { - taint_env(); - taint_proper("Insecure %s%s", "EXEC"); + taint_env(); + taint_proper("Insecure %s%s", "EXEC"); } if (PerlProc_pipe_cloexec(p) < 0) - return NULL; + return NULL; /* Try for another pipe pair for error return */ if (PerlProc_pipe_cloexec(pp) >= 0) - did_pipes = 1; + did_pipes = 1; while ((pid = PerlProc_fork()) < 0) { - if (errno != EAGAIN) { - PerlLIO_close(p[This]); - PerlLIO_close(p[that]); - if (did_pipes) { - PerlLIO_close(pp[0]); - PerlLIO_close(pp[1]); - } - return NULL; - } - Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); - sleep(5); + if (errno != EAGAIN) { + PerlLIO_close(p[This]); + PerlLIO_close(p[that]); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } + return NULL; + } + Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); + sleep(5); } if (pid == 0) { - /* Child */ + /* Child */ #undef THIS #undef THAT #define THIS that #define THAT This - /* Close parent's end of error status pipe (if any) */ - if (did_pipes) - PerlLIO_close(pp[0]); - /* Now dup our end of _the_ pipe to right position */ - if (p[THIS] != (*mode == 'r')) { - PerlLIO_dup2(p[THIS], *mode == 'r'); - PerlLIO_close(p[THIS]); - if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ - PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ - } - else { - setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); - PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ + /* Close parent's end of error status pipe (if any) */ + if (did_pipes) + PerlLIO_close(pp[0]); + /* Now dup our end of _the_ pipe to right position */ + if (p[THIS] != (*mode == 'r')) { + PerlLIO_dup2(p[THIS], *mode == 'r'); + PerlLIO_close(p[THIS]); + if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ + PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ + } + else { + setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); + PerlLIO_close(p[THAT]); /* close parent's end of _the_ pipe */ } #if !defined(HAS_FCNTL) || !defined(F_SETFD) - /* No automatic close - do it by hand */ + /* No automatic close - do it by hand */ # ifndef NOFILE # define NOFILE 20 # endif - { - int fd; + { + int fd; - for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { - if (fd != pp[1]) - PerlLIO_close(fd); - } - } + for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) { + if (fd != pp[1]) + PerlLIO_close(fd); + } + } #endif - do_aexec5(NULL, args-1, args-1+n, pp[1], did_pipes); - PerlProc__exit(1); + do_aexec5(NULL, args-1, args-1+n, pp[1], did_pipes); + PerlProc__exit(1); #undef THIS #undef THAT } /* Parent */ if (did_pipes) - PerlLIO_close(pp[1]); + PerlLIO_close(pp[1]); /* Keep the lower of the two fd numbers */ if (p[that] < p[This]) { - PerlLIO_dup2_cloexec(p[This], p[that]); - PerlLIO_close(p[This]); - p[This] = p[that]; + PerlLIO_dup2_cloexec(p[This], p[that]); + PerlLIO_close(p[This]); + p[This] = p[that]; } else - PerlLIO_close(p[that]); /* close child's end of pipe */ + PerlLIO_close(p[that]); /* close child's end of pipe */ sv = *av_fetch(PL_fdpid,p[This],TRUE); SvUPGRADE(sv,SVt_IV); @@ -2741,33 +2741,33 @@ Perl_my_popen_list(pTHX_ const char *mode, int n, SV **args) PL_forkprocess = pid; /* If we managed to get status pipe check for exec fail */ if (did_pipes && pid > 0) { - int errkid; - unsigned read_total = 0; + int errkid; + unsigned read_total = 0; - while (read_total < sizeof(int)) { + while (read_total < sizeof(int)) { const SSize_t n1 = PerlLIO_read(pp[0], - (void*)(((char*)&errkid)+read_total), - (sizeof(int)) - read_total); - if (n1 <= 0) - break; - read_total += n1; - } - PerlLIO_close(pp[0]); - did_pipes = 0; - if (read_total) { /* Error */ - int pid2, status; - PerlLIO_close(p[This]); - if (read_total != sizeof(int)) - Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", read_total); - do { - pid2 = wait4pid(pid, &status, 0); - } while (pid2 == -1 && errno == EINTR); - errno = errkid; /* Propagate errno from kid */ - return NULL; - } + (void*)(((char*)&errkid)+read_total), + (sizeof(int)) - read_total); + if (n1 <= 0) + break; + read_total += n1; + } + PerlLIO_close(pp[0]); + did_pipes = 0; + if (read_total) { /* Error */ + int pid2, status; + PerlLIO_close(p[This]); + if (read_total != sizeof(int)) + Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", read_total); + do { + pid2 = wait4pid(pid, &status, 0); + } while (pid2 == -1 && errno == EINTR); + errno = errkid; /* Propagate errno from kid */ + return NULL; + } } if (did_pipes) - PerlLIO_close(pp[0]); + PerlLIO_close(pp[0]); return PerlIO_fdopen(p[This], mode); #else # if defined(OS2) /* Same, without fork()ing and all extra overhead... */ @@ -2799,33 +2799,33 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) PERL_FLUSHALL_FOR_CHILD; #ifdef OS2 if (doexec) { - return my_syspopen(aTHX_ cmd,mode); + return my_syspopen(aTHX_ cmd,mode); } #endif This = (*mode == 'w'); that = !This; if (doexec && TAINTING_get) { - taint_env(); - taint_proper("Insecure %s%s", "EXEC"); + taint_env(); + taint_proper("Insecure %s%s", "EXEC"); } if (PerlProc_pipe_cloexec(p) < 0) - return NULL; + return NULL; if (doexec && PerlProc_pipe_cloexec(pp) >= 0) - did_pipes = 1; + did_pipes = 1; while ((pid = PerlProc_fork()) < 0) { - if (errno != EAGAIN) { - PerlLIO_close(p[This]); - PerlLIO_close(p[that]); - if (did_pipes) { - PerlLIO_close(pp[0]); - PerlLIO_close(pp[1]); - } - if (!doexec) - Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno)); - return NULL; - } - Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); - sleep(5); + if (errno != EAGAIN) { + PerlLIO_close(p[This]); + PerlLIO_close(p[that]); + if (did_pipes) { + PerlLIO_close(pp[0]); + PerlLIO_close(pp[1]); + } + if (!doexec) + Perl_croak(aTHX_ "Can't fork: %s", Strerror(errno)); + return NULL; + } + Perl_ck_warner(aTHX_ packWARN(WARN_PIPE), "Can't fork, trying again in 5 seconds"); + sleep(5); } if (pid == 0) { @@ -2833,36 +2833,36 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) #undef THAT #define THIS that #define THAT This - if (did_pipes) - PerlLIO_close(pp[0]); - if (p[THIS] != (*mode == 'r')) { - PerlLIO_dup2(p[THIS], *mode == 'r'); - PerlLIO_close(p[THIS]); - if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ - PerlLIO_close(p[THAT]); - } - else { - setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); - PerlLIO_close(p[THAT]); - } + if (did_pipes) + PerlLIO_close(pp[0]); + if (p[THIS] != (*mode == 'r')) { + PerlLIO_dup2(p[THIS], *mode == 'r'); + PerlLIO_close(p[THIS]); + if (p[THAT] != (*mode == 'r')) /* if dup2() didn't close it */ + PerlLIO_close(p[THAT]); + } + else { + setfd_cloexec_or_inhexec_by_sysfdness(p[THIS]); + PerlLIO_close(p[THAT]); + } #ifndef OS2 - if (doexec) { + if (doexec) { #if !defined(HAS_FCNTL) || !defined(F_SETFD) #ifndef NOFILE #define NOFILE 20 #endif - { - int fd; + { + int fd; - for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) - if (fd != pp[1]) - PerlLIO_close(fd); - } + for (fd = PL_maxsysfd + 1; fd < NOFILE; fd++) + if (fd != pp[1]) + PerlLIO_close(fd); + } #endif - /* may or may not use the shell */ - do_exec3(cmd, pp[1], did_pipes); - PerlProc__exit(1); - } + /* may or may not use the shell */ + do_exec3(cmd, pp[1], did_pipes); + PerlProc__exit(1); + } #endif /* defined OS2 */ #ifdef PERLIO_USING_CRLF @@ -2871,56 +2871,56 @@ Perl_my_popen(pTHX_ const char *cmd, const char *mode) default, binary, low-level mode; see PerlIOBuf_open(). */ PerlLIO_setmode((*mode == 'r'), O_BINARY); #endif - PL_forkprocess = 0; + PL_forkprocess = 0; #ifdef PERL_USES_PL_PIDSTATUS - hv_clear(PL_pidstatus); /* we have no children */ + hv_clear(PL_pidstatus); /* we have no children */ #endif - return NULL; + return NULL; #undef THIS #undef THAT } if (did_pipes) - PerlLIO_close(pp[1]); + PerlLIO_close(pp[1]); if (p[that] < p[This]) { - PerlLIO_dup2_cloexec(p[This], p[that]); - PerlLIO_close(p[This]); - p[This] = p[that]; + PerlLIO_dup2_cloexec(p[This], p[that]); + PerlLIO_close(p[This]); + p[This] = p[that]; } else - PerlLIO_close(p[that]); + PerlLIO_close(p[that]); sv = *av_fetch(PL_fdpid,p[This],TRUE); SvUPGRADE(sv,SVt_IV); SvIV_set(sv, pid); PL_forkprocess = pid; if (did_pipes && pid > 0) { - int errkid; - unsigned n = 0; + int errkid; + unsigned n = 0; - while (n < sizeof(int)) { + while (n < sizeof(int)) { const SSize_t n1 = PerlLIO_read(pp[0], - (void*)(((char*)&errkid)+n), - (sizeof(int)) - n); - if (n1 <= 0) - break; - n += n1; - } - PerlLIO_close(pp[0]); - did_pipes = 0; - if (n) { /* Error */ - int pid2, status; - PerlLIO_close(p[This]); - if (n != sizeof(int)) - Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", n); - do { - pid2 = wait4pid(pid, &status, 0); - } while (pid2 == -1 && errno == EINTR); - errno = errkid; /* Propagate errno from kid */ - return NULL; - } + (void*)(((char*)&errkid)+n), + (sizeof(int)) - n); + if (n1 <= 0) + break; + n += n1; + } + PerlLIO_close(pp[0]); + did_pipes = 0; + if (n) { /* Error */ + int pid2, status; + PerlLIO_close(p[This]); + if (n != sizeof(int)) + Perl_croak(aTHX_ "panic: kid popen errno read, n=%u", n); + do { + pid2 = wait4pid(pid, &status, 0); + } while (pid2 == -1 && errno == EINTR); + errno = errkid; /* Propagate errno from kid */ + return NULL; + } } if (did_pipes) - PerlLIO_close(pp[0]); + PerlLIO_close(pp[0]); return PerlIO_fdopen(p[This], mode); } #elif defined(DJGPP) @@ -3024,7 +3024,7 @@ dup2(int oldfd, int newfd) { #if defined(HAS_FCNTL) && defined(F_DUPFD) if (oldfd == newfd) - return oldfd; + return oldfd; PerlLIO_close(newfd); return fcntl(oldfd, F_DUPFD, newfd); #else @@ -3034,19 +3034,19 @@ dup2(int oldfd, int newfd) int fd; if (oldfd == newfd) - return oldfd; + return oldfd; PerlLIO_close(newfd); /* good enough for low fd's... */ while ((fd = PerlLIO_dup(oldfd)) != newfd && fd >= 0) { - if (fdx >= DUP2_MAX_FDS) { - PerlLIO_close(fd); - fd = -1; - break; - } - fdtmp[fdx++] = fd; + if (fdx >= DUP2_MAX_FDS) { + PerlLIO_close(fd); + fd = -1; + break; + } + fdtmp[fdx++] = fd; } while (fdx > 0) - PerlLIO_close(fdtmp[--fdx]); + PerlLIO_close(fdtmp[--fdx]); return fd; #endif } @@ -3073,7 +3073,7 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler) #ifdef USE_ITHREADS /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return (Sighandler_t) SIG_ERR; + return (Sighandler_t) SIG_ERR; #endif act.sa_handler = handler; @@ -3085,12 +3085,12 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler) #endif #if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */ if (signo == SIGCHLD && handler == (Sighandler_t) SIG_IGN) - act.sa_flags |= SA_NOCLDWAIT; + act.sa_flags |= SA_NOCLDWAIT; #endif if (sigaction(signo, &act, &oact) == -1) - return (Sighandler_t) SIG_ERR; + return (Sighandler_t) SIG_ERR; else - return (Sighandler_t) oact.sa_handler; + return (Sighandler_t) oact.sa_handler; } Sighandler_t @@ -3100,9 +3100,9 @@ Perl_rsignal_state(pTHX_ int signo) PERL_UNUSED_CONTEXT; if (sigaction(signo, (struct sigaction *)NULL, &oact) == -1) - return (Sighandler_t) SIG_ERR; + return (Sighandler_t) SIG_ERR; else - return (Sighandler_t) oact.sa_handler; + return (Sighandler_t) oact.sa_handler; } int @@ -3115,7 +3115,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save) #ifdef USE_ITHREADS /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return -1; + return -1; #endif act.sa_handler = handler; @@ -3127,7 +3127,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save) #endif #if defined(SA_NOCLDWAIT) && !defined(BSDish) /* See [perl #18849] */ if (signo == SIGCHLD && handler == (Sighandler_t) SIG_IGN) - act.sa_flags |= SA_NOCLDWAIT; + act.sa_flags |= SA_NOCLDWAIT; #endif return sigaction(signo, &act, save); } @@ -3139,7 +3139,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #ifdef USE_ITHREADS /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return -1; + return -1; #endif return sigaction(signo, save, (struct sigaction *)NULL); @@ -3153,7 +3153,7 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler) #if defined(USE_ITHREADS) && !defined(WIN32) /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return (Sighandler_t) SIG_ERR; + return (Sighandler_t) SIG_ERR; #endif return PerlProc_signal(signo, handler); @@ -3173,14 +3173,14 @@ Perl_rsignal_state(pTHX_ int signo) #if defined(USE_ITHREADS) && !defined(WIN32) /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return (Sighandler_t) SIG_ERR; + return (Sighandler_t) SIG_ERR; #endif PL_sig_trapped = 0; oldsig = PerlProc_signal(signo, sig_trap); PerlProc_signal(signo, oldsig); if (PL_sig_trapped) - PerlProc_kill(PerlProc_getpid(), signo); + PerlProc_kill(PerlProc_getpid(), signo); return oldsig; } @@ -3190,7 +3190,7 @@ Perl_rsignal_save(pTHX_ int signo, Sighandler_t handler, Sigsave_t *save) #if defined(USE_ITHREADS) && !defined(WIN32) /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return -1; + return -1; #endif *save = PerlProc_signal(signo, handler); return (*save == (Sighandler_t) SIG_ERR) ? -1 : 0; @@ -3202,7 +3202,7 @@ Perl_rsignal_restore(pTHX_ int signo, Sigsave_t *save) #if defined(USE_ITHREADS) && !defined(WIN32) /* only "parent" interpreter can diddle signals */ if (PL_curinterp != aTHX) - return -1; + return -1; #endif return (PerlProc_signal(signo, *save) == (Sighandler_t) SIG_ERR) ? -1 : 0; } @@ -3239,17 +3239,17 @@ Perl_my_pclose(pTHX_ PerlIO *ptr) #ifdef OS2 if (pid == -1) { /* Opened by popen. */ - return my_syspclose(ptr); + return my_syspclose(ptr); } #endif close_failed = (PerlIO_close(ptr) == EOF); SAVE_ERRNO; if (should_wait) do { - pid2 = wait4pid(pid, &status, 0); + pid2 = wait4pid(pid, &status, 0); } while (pid2 == -1 && errno == EINTR); if (close_failed) { - RESTORE_ERRNO; - return -1; + RESTORE_ERRNO; + return -1; } return( should_wait @@ -3282,46 +3282,46 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) return -1; } { - if (pid > 0) { - /* The keys in PL_pidstatus are now the raw 4 (or 8) bytes of the - pid, rather than a string form. */ - SV * const * const svp = hv_fetch(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),FALSE); - if (svp && *svp != &PL_sv_undef) { - *statusp = SvIVX(*svp); - (void)hv_delete(PL_pidstatus,(const char*) &pid,sizeof(Pid_t), - G_DISCARD); - return pid; - } - } - else { - HE *entry; - - hv_iterinit(PL_pidstatus); - if ((entry = hv_iternext(PL_pidstatus))) { - SV * const sv = hv_iterval(PL_pidstatus,entry); - I32 len; - const char * const spid = hv_iterkey(entry,&len); - - assert (len == sizeof(Pid_t)); - memcpy((char *)&pid, spid, len); - *statusp = SvIVX(sv); - /* The hash iterator is currently on this entry, so simply - calling hv_delete would trigger the lazy delete, which on - aggregate does more work, because next call to hv_iterinit() - would spot the flag, and have to call the delete routine, - while in the meantime any new entries can't re-use that - memory. */ - hv_iterinit(PL_pidstatus); - (void)hv_delete(PL_pidstatus,spid,len,G_DISCARD); - return pid; - } - } + if (pid > 0) { + /* The keys in PL_pidstatus are now the raw 4 (or 8) bytes of the + pid, rather than a string form. */ + SV * const * const svp = hv_fetch(PL_pidstatus,(const char*) &pid,sizeof(Pid_t),FALSE); + if (svp && *svp != &PL_sv_undef) { + *statusp = SvIVX(*svp); + (void)hv_delete(PL_pidstatus,(const char*) &pid,sizeof(Pid_t), + G_DISCARD); + return pid; + } + } + else { + HE *entry; + + hv_iterinit(PL_pidstatus); + if ((entry = hv_iternext(PL_pidstatus))) { + SV * const sv = hv_iterval(PL_pidstatus,entry); + I32 len; + const char * const spid = hv_iterkey(entry,&len); + + assert (len == sizeof(Pid_t)); + memcpy((char *)&pid, spid, len); + *statusp = SvIVX(sv); + /* The hash iterator is currently on this entry, so simply + calling hv_delete would trigger the lazy delete, which on + aggregate does more work, because next call to hv_iterinit() + would spot the flag, and have to call the delete routine, + while in the meantime any new entries can't re-use that + memory. */ + hv_iterinit(PL_pidstatus); + (void)hv_delete(PL_pidstatus,spid,len,G_DISCARD); + return pid; + } + } } #endif #ifdef HAS_WAITPID # ifdef HAS_WAITPID_RUNTIME if (!HAS_WAITPID_RUNTIME) - goto hard_way; + goto hard_way; # endif result = PerlProc_waitpid(pid,statusp,flags); goto finish; @@ -3335,22 +3335,22 @@ Perl_wait4pid(pTHX_ Pid_t pid, int *statusp, int flags) hard_way: #endif { - if (flags) - Perl_croak(aTHX_ "Can't do waitpid with flags"); - else { - while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0) - pidgone(result,*statusp); - if (result < 0) - *statusp = -1; - } + if (flags) + Perl_croak(aTHX_ "Can't do waitpid with flags"); + else { + while ((result = PerlProc_wait(statusp)) != pid && pid > 0 && result >= 0) + pidgone(result,*statusp); + if (result < 0) + *statusp = -1; + } } #endif #if defined(HAS_WAITPID) || defined(HAS_WAIT4) finish: #endif if (result < 0 && errno == EINTR) { - PERL_ASYNC_CHECK(); - errno = EINTR; /* reset in case a signal handler changed $! */ + PERL_ASYNC_CHECK(); + errno = EINTR; /* reset in case a signal handler changed $! */ } return result; } @@ -3373,7 +3373,7 @@ S_pidgone(pTHX_ Pid_t pid, int status) int pclose(); #ifdef HAS_FORK int /* Cannot prototype with I32 - in os2ish.h. */ + in os2ish.h. */ my_syspclose(PerlIO *ptr) #else I32 @@ -3411,32 +3411,32 @@ Perl_repeatcpy(char *to, const char *from, I32 len, IV count) assert(len >= 0); if (count < 0) - croak_memory_wrap(); + croak_memory_wrap(); if (len == 1) - memset(to, *from, count); + memset(to, *from, count); else if (count) { - char *p = to; - IV items, linear, half; - - linear = count < PERL_REPEATCPY_LINEAR ? count : PERL_REPEATCPY_LINEAR; - for (items = 0; items < linear; ++items) { - const char *q = from; - IV todo; - for (todo = len; todo > 0; todo--) - *p++ = *q++; + char *p = to; + IV items, linear, half; + + linear = count < PERL_REPEATCPY_LINEAR ? count : PERL_REPEATCPY_LINEAR; + for (items = 0; items < linear; ++items) { + const char *q = from; + IV todo; + for (todo = len; todo > 0; todo--) + *p++ = *q++; } - half = count / 2; - while (items <= half) { - IV size = items * len; - memcpy(p, to, size); - p += size; - items *= 2; - } + half = count / 2; + while (items <= half) { + IV size = items * len; + memcpy(p, to, size); + p += size; + items *= 2; + } - if (count > items) - memcpy(p, to, (count - items) * len); + if (count > items) + memcpy(p, to, (count - items) * len); } } @@ -3453,35 +3453,35 @@ Perl_same_dirent(pTHX_ const char *a, const char *b) PERL_ARGS_ASSERT_SAME_DIRENT; if (fa) - fa++; + fa++; else - fa = a; + fa = a; if (fb) - fb++; + fb++; else - fb = b; + fb = b; if (strNE(a,b)) - return FALSE; + return FALSE; if (fa == a) - sv_setpvs(tmpsv, "."); + sv_setpvs(tmpsv, "."); else - sv_setpvn(tmpsv, a, fa - a); + sv_setpvn(tmpsv, a, fa - a); if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf1) < 0) - return FALSE; + return FALSE; if (fb == b) - sv_setpvs(tmpsv, "."); + sv_setpvs(tmpsv, "."); else - sv_setpvn(tmpsv, b, fb - b); + sv_setpvn(tmpsv, b, fb - b); if (PerlLIO_stat(SvPVX_const(tmpsv), &tmpstatbuf2) < 0) - return FALSE; + return FALSE; return tmpstatbuf1.st_dev == tmpstatbuf2.st_dev && - tmpstatbuf1.st_ino == tmpstatbuf2.st_ino; + tmpstatbuf1.st_ino == tmpstatbuf2.st_ino; } #endif /* !HAS_RENAME */ char* Perl_find_script(pTHX_ const char *scriptname, bool dosearch, - const char *const *const search_ext, I32 flags) + const char *const *const search_ext, I32 flags) { const char *xfound = NULL; char *xfailed = NULL; @@ -3539,169 +3539,169 @@ Perl_find_script(pTHX_ const char *scriptname, bool dosearch, # ifdef ALWAYS_DEFTYPES len = strlen(scriptname); if (!(len == 1 && *scriptname == '-') && scriptname[len-1] != ':') { - int idx = 0, deftypes = 1; - bool seen_dot = 1; + int idx = 0, deftypes = 1; + bool seen_dot = 1; - const int hasdir = !dosearch || (strpbrk(scriptname,":[= sizeof tmpbuf) - continue; /* don't search dir with too-long name */ - my_strlcat(tmpbuf, scriptname, sizeof(tmpbuf)); + /* The first time through, just add SEARCH_EXTS to whatever we + * already have, so we can check for default file types. */ + while (deftypes || + (!hasdir && my_trnlnm("DCL$PATH",tmpbuf,idx++)) ) + { + Stat_t statbuf; + if (deftypes) { + deftypes = 0; + *tmpbuf = '\0'; + } + if ((strlen(tmpbuf) + strlen(scriptname) + + MAX_EXT_LEN) >= sizeof tmpbuf) + continue; /* don't search dir with too-long name */ + my_strlcat(tmpbuf, scriptname, sizeof(tmpbuf)); #else /* !VMS */ #ifdef DOSISH if (strEQ(scriptname, "-")) - dosearch = 0; + dosearch = 0; if (dosearch) { /* Look in '.' first. */ - const char *cur = scriptname; + const char *cur = scriptname; #ifdef SEARCH_EXTS - if ((curext = strrchr(scriptname,'.'))) /* possible current ext */ - while (ext[i]) - if (strEQ(ext[i++],curext)) { - extidx = -1; /* already has an ext */ - break; - } - do { -#endif - DEBUG_p(PerlIO_printf(Perl_debug_log, - "Looking for %s\n",cur)); - { - Stat_t statbuf; - if (PerlLIO_stat(cur,&statbuf) >= 0 - && !S_ISDIR(statbuf.st_mode)) { - dosearch = 0; - scriptname = cur; + if ((curext = strrchr(scriptname,'.'))) /* possible current ext */ + while (ext[i]) + if (strEQ(ext[i++],curext)) { + extidx = -1; /* already has an ext */ + break; + } + do { +#endif + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Looking for %s\n",cur)); + { + Stat_t statbuf; + if (PerlLIO_stat(cur,&statbuf) >= 0 + && !S_ISDIR(statbuf.st_mode)) { + dosearch = 0; + scriptname = cur; #ifdef SEARCH_EXTS - break; + break; #endif - } - } + } + } #ifdef SEARCH_EXTS - if (cur == scriptname) { - len = strlen(scriptname); - if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf)) - break; - my_strlcpy(tmpbuf, scriptname, sizeof(tmpbuf)); - cur = tmpbuf; - } - } while (extidx >= 0 && ext[extidx] /* try an extension? */ - && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len)); + if (cur == scriptname) { + len = strlen(scriptname); + if (len+MAX_EXT_LEN+1 >= sizeof(tmpbuf)) + break; + my_strlcpy(tmpbuf, scriptname, sizeof(tmpbuf)); + cur = tmpbuf; + } + } while (extidx >= 0 && ext[extidx] /* try an extension? */ + && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len)); #endif } #endif if (dosearch && !strchr(scriptname, '/') #ifdef DOSISH - && !strchr(scriptname, '\\') + && !strchr(scriptname, '\\') #endif - && (s = PerlEnv_getenv("PATH"))) + && (s = PerlEnv_getenv("PATH"))) { - bool seen_dot = 0; + bool seen_dot = 0; - bufend = s + strlen(s); - while (s < bufend) { - Stat_t statbuf; + bufend = s + strlen(s); + while (s < bufend) { + Stat_t statbuf; # ifdef DOSISH - for (len = 0; *s - && *s != ';'; len++, s++) { - if (len < sizeof tmpbuf) - tmpbuf[len] = *s; - } - if (len < sizeof tmpbuf) - tmpbuf[len] = '\0'; + for (len = 0; *s + && *s != ';'; len++, s++) { + if (len < sizeof tmpbuf) + tmpbuf[len] = *s; + } + if (len < sizeof tmpbuf) + tmpbuf[len] = '\0'; # else - s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend, + s = delimcpy_no_escape(tmpbuf, tmpbuf + sizeof tmpbuf, s, bufend, ':', &len); # endif - if (s < bufend) - s++; - if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) - continue; /* don't search dir with too-long name */ - if (len + if (s < bufend) + s++; + if (len + 1 + strlen(scriptname) + MAX_EXT_LEN >= sizeof tmpbuf) + continue; /* don't search dir with too-long name */ + if (len # ifdef DOSISH - && tmpbuf[len - 1] != '/' - && tmpbuf[len - 1] != '\\' + && tmpbuf[len - 1] != '/' + && tmpbuf[len - 1] != '\\' # endif - ) - tmpbuf[len++] = '/'; - if (len == 2 && tmpbuf[0] == '.') - seen_dot = 1; - (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len); + ) + tmpbuf[len++] = '/'; + if (len == 2 && tmpbuf[0] == '.') + seen_dot = 1; + (void)my_strlcpy(tmpbuf + len, scriptname, sizeof(tmpbuf) - len); #endif /* !VMS */ #ifdef SEARCH_EXTS - len = strlen(tmpbuf); - if (extidx > 0) /* reset after previous loop */ - extidx = 0; - do { -#endif - DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf)); - retval = PerlLIO_stat(tmpbuf,&statbuf); - if (S_ISDIR(statbuf.st_mode)) { - retval = -1; - } + len = strlen(tmpbuf); + if (extidx > 0) /* reset after previous loop */ + extidx = 0; + do { +#endif + DEBUG_p(PerlIO_printf(Perl_debug_log, "Looking for %s\n",tmpbuf)); + retval = PerlLIO_stat(tmpbuf,&statbuf); + if (S_ISDIR(statbuf.st_mode)) { + retval = -1; + } #ifdef SEARCH_EXTS - } while ( retval < 0 /* not there */ - && extidx>=0 && ext[extidx] /* try an extension? */ - && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len) - ); -#endif - if (retval < 0) - continue; - if (S_ISREG(statbuf.st_mode) - && cando(S_IRUSR,TRUE,&statbuf) + } while ( retval < 0 /* not there */ + && extidx>=0 && ext[extidx] /* try an extension? */ + && my_strlcpy(tmpbuf+len, ext[extidx++], sizeof(tmpbuf) - len) + ); +#endif + if (retval < 0) + continue; + if (S_ISREG(statbuf.st_mode) + && cando(S_IRUSR,TRUE,&statbuf) #if !defined(DOSISH) - && cando(S_IXUSR,TRUE,&statbuf) -#endif - ) - { - xfound = tmpbuf; /* bingo! */ - break; - } - if (!xfailed) - xfailed = savepv(tmpbuf); - } + && cando(S_IXUSR,TRUE,&statbuf) +#endif + ) + { + xfound = tmpbuf; /* bingo! */ + break; + } + if (!xfailed) + xfailed = savepv(tmpbuf); + } #ifndef DOSISH - { - Stat_t statbuf; - if (!xfound && !seen_dot && !xfailed && - (PerlLIO_stat(scriptname,&statbuf) < 0 - || S_ISDIR(statbuf.st_mode))) + { + Stat_t statbuf; + if (!xfound && !seen_dot && !xfailed && + (PerlLIO_stat(scriptname,&statbuf) < 0 + || S_ISDIR(statbuf.st_mode))) #endif - seen_dot = 1; /* Disable message. */ + seen_dot = 1; /* Disable message. */ #ifndef DOSISH - } -#endif - if (!xfound) { - if (flags & 1) { /* do or die? */ - /* diag_listed_as: Can't execute %s */ - Perl_croak(aTHX_ "Can't %s %s%s%s", - (xfailed ? "execute" : "find"), - (xfailed ? xfailed : scriptname), - (xfailed ? "" : " on PATH"), - (xfailed || seen_dot) ? "" : ", '.' not in PATH"); - } - scriptname = NULL; - } - Safefree(xfailed); - scriptname = xfound; + } +#endif + if (!xfound) { + if (flags & 1) { /* do or die? */ + /* diag_listed_as: Can't execute %s */ + Perl_croak(aTHX_ "Can't %s %s%s%s", + (xfailed ? "execute" : "find"), + (xfailed ? xfailed : scriptname), + (xfailed ? "" : " on PATH"), + (xfailed || seen_dot) ? "" : ", '.' not in PATH"); + } + scriptname = NULL; + } + Safefree(xfailed); + scriptname = xfound; } return (scriptname ? savepv(scriptname) : NULL); } @@ -3716,7 +3716,7 @@ Perl_get_context(void) pthread_addr_t t; int error = pthread_getspecific(PL_thr_key, &t); if (error) - Perl_croak_nocontext("panic: pthread_getspecific, error=%d", error); + Perl_croak_nocontext("panic: pthread_getspecific, error=%d", error); return (void*)t; # elif defined(I_MACH_CTHREADS) return (void*)cthread_data(cthread_self()); @@ -3739,9 +3739,9 @@ Perl_set_context(void *t) cthread_set_data(cthread_self(), t); # else { - const int error = pthread_setspecific(PL_thr_key, t); - if (error) - Perl_croak_nocontext("panic: pthread_setspecific, error=%d", error); + const int error = pthread_setspecific(PL_thr_key, t); + if (error) + Perl_croak_nocontext("panic: pthread_setspecific, error=%d", error); } # endif #else @@ -3794,7 +3794,7 @@ Perl_getenv_len(pTHX_ const char *env_elem, unsigned long *len) PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_GETENV_LEN; if (env_trans) - *len = strlen(env_trans); + *len = strlen(env_trans); return env_trans; } #endif @@ -3806,7 +3806,7 @@ Perl_get_vtbl(pTHX_ int vtbl_id) PERL_UNUSED_CONTEXT; return (vtbl_id < 0 || vtbl_id >= magic_vtable_max) - ? NULL : (MGVTBL*)PL_magic_vtables + vtbl_id; + ? NULL : (MGVTBL*)PL_magic_vtables + vtbl_id; } I32 @@ -3838,10 +3838,10 @@ Perl_my_fflush_all(pTHX) if (open_max > 0) { long i; for (i = 0; i < open_max; i++) - if (STDIO_STREAM_ARRAY[i]._file >= 0 && - STDIO_STREAM_ARRAY[i]._file < open_max && - STDIO_STREAM_ARRAY[i]._flag) - PerlIO_flush(&STDIO_STREAM_ARRAY[i]); + if (STDIO_STREAM_ARRAY[i]._file >= 0 && + STDIO_STREAM_ARRAY[i]._file < open_max && + STDIO_STREAM_ARRAY[i]._flag) + PerlIO_flush(&STDIO_STREAM_ARRAY[i]); return 0; } # endif @@ -3859,15 +3859,15 @@ Perl_report_wrongway_fh(pTHX_ const GV *gv, const char have) = gv && (isGV_with_GP(gv)) ? GvENAME_HEK((gv)) : NULL; - const char * const direction = have == '>' ? "out" : "in"; + const char * const direction = have == '>' ? "out" : "in"; - if (name && HEK_LEN(name)) - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle %" HEKf " opened only for %sput", - HEKfARG(name), direction); - else - Perl_warner(aTHX_ packWARN(WARN_IO), - "Filehandle opened only for %sput", direction); + if (name && HEK_LEN(name)) + Perl_warner(aTHX_ packWARN(WARN_IO), + "Filehandle %" HEKf " opened only for %sput", + HEKfARG(name), direction); + else + Perl_warner(aTHX_ packWARN(WARN_IO), + "Filehandle opened only for %sput", direction); } } @@ -3880,42 +3880,42 @@ Perl_report_evil_fh(pTHX_ const GV *gv) I32 warn_type; if (io && IoTYPE(io) == IoTYPE_CLOSED) { - vile = "closed"; - warn_type = WARN_CLOSED; + vile = "closed"; + warn_type = WARN_CLOSED; } else { - vile = "unopened"; - warn_type = WARN_UNOPENED; + vile = "unopened"; + warn_type = WARN_UNOPENED; } if (ckWARN(warn_type)) { SV * const name = gv && isGV_with_GP(gv) && GvENAMELEN(gv) ? sv_2mortal(newSVhek(GvENAME_HEK(gv))) : NULL; - const char * const pars = - (const char *)(OP_IS_FILETEST(op) ? "" : "()"); - const char * const func = - (const char *) - (op == OP_READLINE || op == OP_RCATLINE - ? "readline" : /* "" not nice */ - op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */ - PL_op_desc[op]); - const char * const type = - (const char *) - (OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) - ? "socket" : "filehandle"); - const bool have_name = name && SvCUR(name); - Perl_warner(aTHX_ packWARN(warn_type), - "%s%s on %s %s%s%" SVf, func, pars, vile, type, - have_name ? " " : "", - SVfARG(have_name ? name : &PL_sv_no)); - if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP)) - Perl_warner( - aTHX_ packWARN(warn_type), - "\t(Are you trying to call %s%s on dirhandle%s%" SVf "?)\n", - func, pars, have_name ? " " : "", - SVfARG(have_name ? name : &PL_sv_no) - ); + const char * const pars = + (const char *)(OP_IS_FILETEST(op) ? "" : "()"); + const char * const func = + (const char *) + (op == OP_READLINE || op == OP_RCATLINE + ? "readline" : /* "" not nice */ + op == OP_LEAVEWRITE ? "write" : /* "write exit" not nice */ + PL_op_desc[op]); + const char * const type = + (const char *) + (OP_IS_SOCKET(op) || (io && IoTYPE(io) == IoTYPE_SOCKET) + ? "socket" : "filehandle"); + const bool have_name = name && SvCUR(name); + Perl_warner(aTHX_ packWARN(warn_type), + "%s%s on %s %s%s%" SVf, func, pars, vile, type, + have_name ? " " : "", + SVfARG(have_name ? name : &PL_sv_no)); + if (io && IoDIRP(io) && !(IoFLAGS(io) & IOf_FAKE_DIRP)) + Perl_warner( + aTHX_ packWARN(warn_type), + "\t(Are you trying to call %s%s on dirhandle%s%" SVf "?)\n", + func, pars, have_name ? " " : "", + SVfARG(have_name ? name : &PL_sv_no) + ); } } @@ -4061,9 +4061,9 @@ Perl_mini_mktime(struct tm *ptm) mday = ptm->tm_mday; jday = 0; if (month >= 2) - month+=2; + month+=2; else - month+=14, year--; + month+=14, year--; yearday = DAYS_PER_YEAR * year + year/4 - year/100 + year/400; yearday += month*MONTH_TO_DAYS + mday + jday; /* @@ -4073,29 +4073,29 @@ Perl_mini_mktime(struct tm *ptm) * be rationalised, however. */ if ((unsigned) ptm->tm_sec <= 60) { - secs = 0; + secs = 0; } else { - secs = ptm->tm_sec; - ptm->tm_sec = 0; + secs = ptm->tm_sec; + ptm->tm_sec = 0; } secs += 60 * ptm->tm_min; secs += SECS_PER_HOUR * ptm->tm_hour; if (secs < 0) { - if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) { - /* got negative remainder, but need positive time */ - /* back off an extra day to compensate */ - yearday += (secs/SECS_PER_DAY)-1; - secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1); - } - else { - yearday += (secs/SECS_PER_DAY); - secs -= SECS_PER_DAY * (secs/SECS_PER_DAY); - } + if (secs-(secs/SECS_PER_DAY*SECS_PER_DAY) < 0) { + /* got negative remainder, but need positive time */ + /* back off an extra day to compensate */ + yearday += (secs/SECS_PER_DAY)-1; + secs -= SECS_PER_DAY * (secs/SECS_PER_DAY - 1); + } + else { + yearday += (secs/SECS_PER_DAY); + secs -= SECS_PER_DAY * (secs/SECS_PER_DAY); + } } else if (secs >= SECS_PER_DAY) { - yearday += (secs/SECS_PER_DAY); - secs %= SECS_PER_DAY; + yearday += (secs/SECS_PER_DAY); + secs %= SECS_PER_DAY; } ptm->tm_hour = secs/SECS_PER_HOUR; secs %= SECS_PER_HOUR; @@ -4124,21 +4124,21 @@ Perl_mini_mktime(struct tm *ptm) year += odd_year; yearday %= DAYS_PER_YEAR; if (!yearday && (odd_cent==4 || odd_year==4)) { /* catch Feb 29 */ - month = 1; - yearday = 29; + month = 1; + yearday = 29; } else { - yearday += YEAR_ADJUST; /* recover March 1st crock */ - month = yearday*DAYS_TO_MONTH; - yearday -= month*MONTH_TO_DAYS; - /* recover other leap-year adjustment */ - if (month > 13) { - month-=14; - year++; - } - else { - month-=2; - } + yearday += YEAR_ADJUST; /* recover March 1st crock */ + month = yearday*DAYS_TO_MONTH; + yearday -= month*MONTH_TO_DAYS; + /* recover other leap-year adjustment */ + if (month > 13) { + month-=14; + year++; + } + else { + month-=2; + } } ptm->tm_year = year - 1900; if (yearday) { @@ -4247,12 +4247,12 @@ giving localized results. GCC_DIAG_RESTORE_STMT; if (inRANGE(buflen, 1, bufsize - 1)) - break; + break; /* heuristic to prevent out-of-memory errors */ if (bufsize > 100*fmtlen) { - Safefree(buf); - buf = NULL; - break; + Safefree(buf); + buf = NULL; + break; } bufsize *= 2; Renew(buf, bufsize, char); @@ -4272,7 +4272,7 @@ giving localized results. #define SV_CWD_ISDOT(dp) \ (dp->d_name[0] == '.' && (dp->d_name[1] == '\0' || \ - (dp->d_name[1] == '.' && dp->d_name[2] == '\0'))) + (dp->d_name[1] == '.' && dp->d_name[2] == '\0'))) /* =for apidoc_section $utility @@ -4302,18 +4302,18 @@ Perl_getcwd_sv(pTHX_ SV *sv) #ifdef HAS_GETCWD { - char buf[MAXPATHLEN]; - - /* Some getcwd()s automatically allocate a buffer of the given - * size from the heap if they are given a NULL buffer pointer. - * The problem is that this behaviour is not portable. */ - if (getcwd(buf, sizeof(buf) - 1)) { - sv_setpv(sv, buf); - return TRUE; - } - else { - SV_CWD_RETURN_UNDEF; - } + char buf[MAXPATHLEN]; + + /* Some getcwd()s automatically allocate a buffer of the given + * size from the heap if they are given a NULL buffer pointer. + * The problem is that this behaviour is not portable. */ + if (getcwd(buf, sizeof(buf) - 1)) { + sv_setpv(sv, buf); + return TRUE; + } + else { + SV_CWD_RETURN_UNDEF; + } } #else @@ -4326,7 +4326,7 @@ Perl_getcwd_sv(pTHX_ SV *sv) SvUPGRADE(sv, SVt_PV); if (PerlLIO_lstat(".", &statbuf) < 0) { - SV_CWD_RETURN_UNDEF; + SV_CWD_RETURN_UNDEF; } orig_cdev = statbuf.st_dev; @@ -4335,98 +4335,98 @@ Perl_getcwd_sv(pTHX_ SV *sv) cino = orig_cino; for (;;) { - DIR *dir; - int namelen; - odev = cdev; - oino = cino; - - if (PerlDir_chdir("..") < 0) { - SV_CWD_RETURN_UNDEF; - } - if (PerlLIO_stat(".", &statbuf) < 0) { - SV_CWD_RETURN_UNDEF; - } - - cdev = statbuf.st_dev; - cino = statbuf.st_ino; - - if (odev == cdev && oino == cino) { - break; - } - if (!(dir = PerlDir_open("."))) { - SV_CWD_RETURN_UNDEF; - } - - while ((dp = PerlDir_read(dir)) != NULL) { + DIR *dir; + int namelen; + odev = cdev; + oino = cino; + + if (PerlDir_chdir("..") < 0) { + SV_CWD_RETURN_UNDEF; + } + if (PerlLIO_stat(".", &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } + + cdev = statbuf.st_dev; + cino = statbuf.st_ino; + + if (odev == cdev && oino == cino) { + break; + } + if (!(dir = PerlDir_open("."))) { + SV_CWD_RETURN_UNDEF; + } + + while ((dp = PerlDir_read(dir)) != NULL) { #ifdef DIRNAMLEN - namelen = dp->d_namlen; + namelen = dp->d_namlen; #else - namelen = strlen(dp->d_name); + namelen = strlen(dp->d_name); #endif - /* skip . and .. */ - if (SV_CWD_ISDOT(dp)) { - continue; - } + /* skip . and .. */ + if (SV_CWD_ISDOT(dp)) { + continue; + } - if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { - SV_CWD_RETURN_UNDEF; - } + if (PerlLIO_lstat(dp->d_name, &statbuf) < 0) { + SV_CWD_RETURN_UNDEF; + } - tdev = statbuf.st_dev; - tino = statbuf.st_ino; - if (tino == oino && tdev == odev) { - break; - } - } + tdev = statbuf.st_dev; + tino = statbuf.st_ino; + if (tino == oino && tdev == odev) { + break; + } + } - if (!dp) { - SV_CWD_RETURN_UNDEF; - } + if (!dp) { + SV_CWD_RETURN_UNDEF; + } - if (pathlen + namelen + 1 >= MAXPATHLEN) { - SV_CWD_RETURN_UNDEF; - } + if (pathlen + namelen + 1 >= MAXPATHLEN) { + SV_CWD_RETURN_UNDEF; + } - SvGROW(sv, pathlen + namelen + 1); + SvGROW(sv, pathlen + namelen + 1); - if (pathlen) { - /* shift down */ - Move(SvPVX_const(sv), SvPVX(sv) + namelen + 1, pathlen, char); - } + if (pathlen) { + /* shift down */ + Move(SvPVX_const(sv), SvPVX(sv) + namelen + 1, pathlen, char); + } - /* prepend current directory to the front */ - *SvPVX(sv) = '/'; - Move(dp->d_name, SvPVX(sv)+1, namelen, char); - pathlen += (namelen + 1); + /* prepend current directory to the front */ + *SvPVX(sv) = '/'; + Move(dp->d_name, SvPVX(sv)+1, namelen, char); + pathlen += (namelen + 1); #ifdef VOID_CLOSEDIR - PerlDir_close(dir); + PerlDir_close(dir); #else - if (PerlDir_close(dir) < 0) { - SV_CWD_RETURN_UNDEF; - } + if (PerlDir_close(dir) < 0) { + SV_CWD_RETURN_UNDEF; + } #endif } if (pathlen) { - SvCUR_set(sv, pathlen); - *SvEND(sv) = '\0'; - SvPOK_only(sv); + SvCUR_set(sv, pathlen); + *SvEND(sv) = '\0'; + SvPOK_only(sv); - if (PerlDir_chdir(SvPVX_const(sv)) < 0) { - SV_CWD_RETURN_UNDEF; - } + if (PerlDir_chdir(SvPVX_const(sv)) < 0) { + SV_CWD_RETURN_UNDEF; + } } if (PerlLIO_stat(".", &statbuf) < 0) { - SV_CWD_RETURN_UNDEF; + SV_CWD_RETURN_UNDEF; } cdev = statbuf.st_dev; cino = statbuf.st_ino; if (cdev != orig_cdev || cino != orig_cino) { - Perl_croak(aTHX_ "Unstable directory path, " - "current directory changed unexpectedly"); + Perl_croak(aTHX_ "Unstable directory path, " + "current directory changed unexpectedly"); } return TRUE; @@ -4458,31 +4458,31 @@ S_socketpair_udp (int fd[2]) { memset(&addresses, 0, sizeof(addresses)); i = 1; do { - sockets[i] = PerlSock_socket(AF_INET, SOCK_DGRAM, PF_INET); - if (sockets[i] == -1) - goto tidy_up_and_fail; - - addresses[i].sin_family = AF_INET; - addresses[i].sin_addr.s_addr = htonl(INADDR_LOOPBACK); - addresses[i].sin_port = 0; /* kernel choses port. */ - if (PerlSock_bind(sockets[i], (struct sockaddr *) &addresses[i], - sizeof(struct sockaddr_in)) == -1) - goto tidy_up_and_fail; + sockets[i] = PerlSock_socket(AF_INET, SOCK_DGRAM, PF_INET); + if (sockets[i] == -1) + goto tidy_up_and_fail; + + addresses[i].sin_family = AF_INET; + addresses[i].sin_addr.s_addr = htonl(INADDR_LOOPBACK); + addresses[i].sin_port = 0; /* kernel choses port. */ + if (PerlSock_bind(sockets[i], (struct sockaddr *) &addresses[i], + sizeof(struct sockaddr_in)) == -1) + goto tidy_up_and_fail; } while (i--); /* Now have 2 UDP sockets. Find out which port each is connected to, and for each connect the other socket to it. */ i = 1; do { - if (PerlSock_getsockname(sockets[i], (struct sockaddr *) &addresses[i], - &size) == -1) - goto tidy_up_and_fail; - if (size != sizeof(struct sockaddr_in)) - goto abort_tidy_up_and_fail; - /* !1 is 0, !0 is 1 */ - if (PerlSock_connect(sockets[!i], (struct sockaddr *) &addresses[i], - sizeof(struct sockaddr_in)) == -1) - goto tidy_up_and_fail; + if (PerlSock_getsockname(sockets[i], (struct sockaddr *) &addresses[i], + &size) == -1) + goto tidy_up_and_fail; + if (size != sizeof(struct sockaddr_in)) + goto abort_tidy_up_and_fail; + /* !1 is 0, !0 is 1 */ + if (PerlSock_connect(sockets[!i], (struct sockaddr *) &addresses[i], + sizeof(struct sockaddr_in)) == -1) + goto tidy_up_and_fail; } while (i--); /* Now we have 2 sockets connected to each other. I don't trust some other @@ -4490,16 +4490,16 @@ S_socketpair_udp (int fd[2]) { a packet from each to the other. */ i = 1; do { - /* I'm going to send my own port number. As a short. - (Who knows if someone somewhere has sin_port as a bitfield and needs - this routine. (I'm assuming crays have socketpair)) */ - port = addresses[i].sin_port; - got = PerlLIO_write(sockets[i], &port, sizeof(port)); - if (got != sizeof(port)) { - if (got == -1) - goto tidy_up_and_fail; - goto abort_tidy_up_and_fail; - } + /* I'm going to send my own port number. As a short. + (Who knows if someone somewhere has sin_port as a bitfield and needs + this routine. (I'm assuming crays have socketpair)) */ + port = addresses[i].sin_port; + got = PerlLIO_write(sockets[i], &port, sizeof(port)); + if (got != sizeof(port)) { + if (got == -1) + goto tidy_up_and_fail; + goto abort_tidy_up_and_fail; + } } while (i--); /* Packets sent. I don't trust them to have arrived though. @@ -4513,54 +4513,54 @@ S_socketpair_udp (int fd[2]) { */ { - struct timeval waitfor = {0, 100000}; /* You have 0.1 seconds */ - int max = sockets[1] > sockets[0] ? sockets[1] : sockets[0]; - fd_set rset; - - FD_ZERO(&rset); - FD_SET((unsigned int)sockets[0], &rset); - FD_SET((unsigned int)sockets[1], &rset); - - got = PerlSock_select(max + 1, &rset, NULL, NULL, &waitfor); - if (got != 2 || !FD_ISSET(sockets[0], &rset) - || !FD_ISSET(sockets[1], &rset)) { - /* I hope this is portable and appropriate. */ - if (got == -1) - goto tidy_up_and_fail; - goto abort_tidy_up_and_fail; - } + struct timeval waitfor = {0, 100000}; /* You have 0.1 seconds */ + int max = sockets[1] > sockets[0] ? sockets[1] : sockets[0]; + fd_set rset; + + FD_ZERO(&rset); + FD_SET((unsigned int)sockets[0], &rset); + FD_SET((unsigned int)sockets[1], &rset); + + got = PerlSock_select(max + 1, &rset, NULL, NULL, &waitfor); + if (got != 2 || !FD_ISSET(sockets[0], &rset) + || !FD_ISSET(sockets[1], &rset)) { + /* I hope this is portable and appropriate. */ + if (got == -1) + goto tidy_up_and_fail; + goto abort_tidy_up_and_fail; + } } /* And the paranoia department even now doesn't trust it to have arrive (hence MSG_DONTWAIT). Or that what arrives was sent by us. */ { - struct sockaddr_in readfrom; - unsigned short buffer[2]; + struct sockaddr_in readfrom; + unsigned short buffer[2]; - i = 1; - do { + i = 1; + do { #ifdef MSG_DONTWAIT - got = PerlSock_recvfrom(sockets[i], (char *) &buffer, - sizeof(buffer), MSG_DONTWAIT, - (struct sockaddr *) &readfrom, &size); + got = PerlSock_recvfrom(sockets[i], (char *) &buffer, + sizeof(buffer), MSG_DONTWAIT, + (struct sockaddr *) &readfrom, &size); #else - got = PerlSock_recvfrom(sockets[i], (char *) &buffer, - sizeof(buffer), 0, - (struct sockaddr *) &readfrom, &size); -#endif - - if (got == -1) - goto tidy_up_and_fail; - if (got != sizeof(port) - || size != sizeof(struct sockaddr_in) - /* Check other socket sent us its port. */ - || buffer[0] != (unsigned short) addresses[!i].sin_port - /* Check kernel says we got the datagram from that socket */ - || readfrom.sin_family != addresses[!i].sin_family - || readfrom.sin_addr.s_addr != addresses[!i].sin_addr.s_addr - || readfrom.sin_port != addresses[!i].sin_port) - goto abort_tidy_up_and_fail; - } while (i--); + got = PerlSock_recvfrom(sockets[i], (char *) &buffer, + sizeof(buffer), 0, + (struct sockaddr *) &readfrom, &size); +#endif + + if (got == -1) + goto tidy_up_and_fail; + if (got != sizeof(port) + || size != sizeof(struct sockaddr_in) + /* Check other socket sent us its port. */ + || buffer[0] != (unsigned short) addresses[!i].sin_port + /* Check kernel says we got the datagram from that socket */ + || readfrom.sin_family != addresses[!i].sin_family + || readfrom.sin_addr.s_addr != addresses[!i].sin_addr.s_addr + || readfrom.sin_port != addresses[!i].sin_port) + goto abort_tidy_up_and_fail; + } while (i--); } /* My caller (my_socketpair) has validated that this is non-NULL */ fd[0] = sockets[0]; @@ -4573,13 +4573,13 @@ S_socketpair_udp (int fd[2]) { errno = ECONNABORTED; tidy_up_and_fail: { - dSAVE_ERRNO; - if (sockets[0] != -1) - PerlLIO_close(sockets[0]); - if (sockets[1] != -1) - PerlLIO_close(sockets[1]); - RESTORE_ERRNO; - return -1; + dSAVE_ERRNO; + if (sockets[0] != -1) + PerlLIO_close(sockets[0]); + if (sockets[1] != -1) + PerlLIO_close(sockets[1]); + RESTORE_ERRNO; + return -1; } } #endif /* EMULATE_SOCKETPAIR_UDP */ @@ -4599,15 +4599,15 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { if (protocol #ifdef AF_UNIX - || family != AF_UNIX + || family != AF_UNIX #endif ) { - errno = EAFNOSUPPORT; - return -1; + errno = EAFNOSUPPORT; + return -1; } if (!fd) { - errno = EINVAL; - return -1; + errno = EINVAL; + return -1; } #ifdef SOCK_CLOEXEC @@ -4616,55 +4616,55 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { #ifdef EMULATE_SOCKETPAIR_UDP if (type == SOCK_DGRAM) - return S_socketpair_udp(fd); + return S_socketpair_udp(fd); #endif aTHXa(PERL_GET_THX); listener = PerlSock_socket(AF_INET, type, 0); if (listener == -1) - return -1; + return -1; memset(&listen_addr, 0, sizeof(listen_addr)); listen_addr.sin_family = AF_INET; listen_addr.sin_addr.s_addr = htonl(INADDR_LOOPBACK); listen_addr.sin_port = 0; /* kernel choses port. */ if (PerlSock_bind(listener, (struct sockaddr *) &listen_addr, - sizeof(listen_addr)) == -1) - goto tidy_up_and_fail; + sizeof(listen_addr)) == -1) + goto tidy_up_and_fail; if (PerlSock_listen(listener, 1) == -1) - goto tidy_up_and_fail; + goto tidy_up_and_fail; connector = PerlSock_socket(AF_INET, type, 0); if (connector == -1) - goto tidy_up_and_fail; + goto tidy_up_and_fail; /* We want to find out the port number to connect to. */ size = sizeof(connect_addr); if (PerlSock_getsockname(listener, (struct sockaddr *) &connect_addr, - &size) == -1) - goto tidy_up_and_fail; + &size) == -1) + goto tidy_up_and_fail; if (size != sizeof(connect_addr)) - goto abort_tidy_up_and_fail; + goto abort_tidy_up_and_fail; if (PerlSock_connect(connector, (struct sockaddr *) &connect_addr, - sizeof(connect_addr)) == -1) - goto tidy_up_and_fail; + sizeof(connect_addr)) == -1) + goto tidy_up_and_fail; size = sizeof(listen_addr); acceptor = PerlSock_accept(listener, (struct sockaddr *) &listen_addr, - &size); + &size); if (acceptor == -1) - goto tidy_up_and_fail; + goto tidy_up_and_fail; if (size != sizeof(listen_addr)) - goto abort_tidy_up_and_fail; + goto abort_tidy_up_and_fail; PerlLIO_close(listener); /* Now check we are talking to ourself by matching port and host on the two sockets. */ if (PerlSock_getsockname(connector, (struct sockaddr *) &connect_addr, - &size) == -1) - goto tidy_up_and_fail; + &size) == -1) + goto tidy_up_and_fail; if (size != sizeof(connect_addr) - || listen_addr.sin_family != connect_addr.sin_family - || listen_addr.sin_addr.s_addr != connect_addr.sin_addr.s_addr - || listen_addr.sin_port != connect_addr.sin_port) { - goto abort_tidy_up_and_fail; + || listen_addr.sin_family != connect_addr.sin_family + || listen_addr.sin_addr.s_addr != connect_addr.sin_addr.s_addr + || listen_addr.sin_port != connect_addr.sin_port) { + goto abort_tidy_up_and_fail; } fd[0] = connector; fd[1] = acceptor; @@ -4680,15 +4680,15 @@ Perl_my_socketpair (int family, int type, int protocol, int fd[2]) { #endif tidy_up_and_fail: { - dSAVE_ERRNO; - if (listener != -1) - PerlLIO_close(listener); - if (connector != -1) - PerlLIO_close(connector); - if (acceptor != -1) - PerlLIO_close(acceptor); - RESTORE_ERRNO; - return -1; + dSAVE_ERRNO; + if (listener != -1) + PerlLIO_close(listener); + if (connector != -1) + PerlLIO_close(connector); + if (acceptor != -1) + PerlLIO_close(acceptor); + RESTORE_ERRNO; + return -1; } } #else @@ -4771,37 +4771,37 @@ Perl_parse_unicode_opts(pTHX_ const char **popt) } } else { - for (; *p; p++) { - switch (*p) { - case PERL_UNICODE_STDIN: - opt |= PERL_UNICODE_STDIN_FLAG; break; - case PERL_UNICODE_STDOUT: - opt |= PERL_UNICODE_STDOUT_FLAG; break; - case PERL_UNICODE_STDERR: - opt |= PERL_UNICODE_STDERR_FLAG; break; - case PERL_UNICODE_STD: - opt |= PERL_UNICODE_STD_FLAG; break; - case PERL_UNICODE_IN: - opt |= PERL_UNICODE_IN_FLAG; break; - case PERL_UNICODE_OUT: - opt |= PERL_UNICODE_OUT_FLAG; break; - case PERL_UNICODE_INOUT: - opt |= PERL_UNICODE_INOUT_FLAG; break; - case PERL_UNICODE_LOCALE: - opt |= PERL_UNICODE_LOCALE_FLAG; break; - case PERL_UNICODE_ARGV: - opt |= PERL_UNICODE_ARGV_FLAG; break; - case PERL_UNICODE_UTF8CACHEASSERT: - opt |= PERL_UNICODE_UTF8CACHEASSERT_FLAG; break; - default: - if (*p != '\n' && *p != '\r') { - if(isSPACE(*p)) goto the_end_of_the_opts_parser; - else - Perl_croak(aTHX_ - "Unknown Unicode option letter '%c'", *p); - } - } - } + for (; *p; p++) { + switch (*p) { + case PERL_UNICODE_STDIN: + opt |= PERL_UNICODE_STDIN_FLAG; break; + case PERL_UNICODE_STDOUT: + opt |= PERL_UNICODE_STDOUT_FLAG; break; + case PERL_UNICODE_STDERR: + opt |= PERL_UNICODE_STDERR_FLAG; break; + case PERL_UNICODE_STD: + opt |= PERL_UNICODE_STD_FLAG; break; + case PERL_UNICODE_IN: + opt |= PERL_UNICODE_IN_FLAG; break; + case PERL_UNICODE_OUT: + opt |= PERL_UNICODE_OUT_FLAG; break; + case PERL_UNICODE_INOUT: + opt |= PERL_UNICODE_INOUT_FLAG; break; + case PERL_UNICODE_LOCALE: + opt |= PERL_UNICODE_LOCALE_FLAG; break; + case PERL_UNICODE_ARGV: + opt |= PERL_UNICODE_ARGV_FLAG; break; + case PERL_UNICODE_UTF8CACHEASSERT: + opt |= PERL_UNICODE_UTF8CACHEASSERT_FLAG; break; + default: + if (*p != '\n' && *p != '\r') { + if(isSPACE(*p)) goto the_end_of_the_opts_parser; + else + Perl_croak(aTHX_ + "Unknown Unicode option letter '%c'", *p); + } + } + } } } else @@ -4811,7 +4811,7 @@ Perl_parse_unicode_opts(pTHX_ const char **popt) if (opt & ~PERL_UNICODE_ALL_FLAGS) Perl_croak(aTHX_ "Unknown Unicode option value %" UVuf, - (UV) (opt & ~PERL_UNICODE_ALL_FLAGS)); + (UV) (opt & ~PERL_UNICODE_ALL_FLAGS)); *popt = p; @@ -4872,11 +4872,11 @@ Perl_seed(pTHX) #endif fd = PerlLIO_open_cloexec(PERL_RANDOM_DEVICE, 0); if (fd != -1) { - if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u) - u = 0; - PerlLIO_close(fd); - if (u) - return u; + if (PerlLIO_read(fd, (void*)&u, sizeof u) != sizeof u) + u = 0; + PerlLIO_close(fd); + if (u) + return u; } #endif @@ -5019,10 +5019,10 @@ Perl_get_hash_seed(pTHX_ unsigned char * const seed_buffer) static void S_mem_log_common(enum mem_log_type mlt, const UV n, - const UV typesize, const char *type_name, const SV *sv, - Malloc_t oldalloc, Malloc_t newalloc, - const char *filename, const int linenumber, - const char *funcname) + const UV typesize, const char *type_name, const SV *sv, + Malloc_t oldalloc, Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) { const char *pmlenv; dTHX; @@ -5033,81 +5033,81 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, pmlenv = PerlEnv_getenv("PERL_MEM_LOG"); PL_mem_log[0] &= ~0x2; if (!pmlenv) - return; + return; if (mlt < MLT_NEW_SV ? strchr(pmlenv,'m') : strchr(pmlenv,'s')) { - /* We can't use SVs or PerlIO for obvious reasons, - * so we'll use stdio and low-level IO instead. */ - char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE]; + /* We can't use SVs or PerlIO for obvious reasons, + * so we'll use stdio and low-level IO instead. */ + char buf[PERL_MEM_LOG_SPRINTF_BUF_SIZE]; # ifdef HAS_GETTIMEOFDAY # define MEM_LOG_TIME_FMT "%10d.%06d: " # define MEM_LOG_TIME_ARG (int)tv.tv_sec, (int)tv.tv_usec - struct timeval tv; - gettimeofday(&tv, 0); + struct timeval tv; + gettimeofday(&tv, 0); # else # define MEM_LOG_TIME_FMT "%10d: " # define MEM_LOG_TIME_ARG (int)when Time_t when; (void)time(&when); # endif - /* If there are other OS specific ways of hires time than - * gettimeofday() (see dist/Time-HiRes), the easiest way is - * probably that they would be used to fill in the struct - * timeval. */ - { - STRLEN len; + /* If there are other OS specific ways of hires time than + * gettimeofday() (see dist/Time-HiRes), the easiest way is + * probably that they would be used to fill in the struct + * timeval. */ + { + STRLEN len; const char* endptr = pmlenv + strlen(pmlenv); - int fd; + int fd; UV uv; if (grok_atoUV(pmlenv, &uv, &endptr) /* Ignore endptr. */ && uv && uv <= PERL_INT_MAX ) { fd = (int)uv; } else { - fd = PERL_MEM_LOG_FD; + fd = PERL_MEM_LOG_FD; } - if (strchr(pmlenv, 't')) { - len = my_snprintf(buf, sizeof(buf), - MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG); - PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len)); - } - switch (mlt) { - case MLT_ALLOC: - len = my_snprintf(buf, sizeof(buf), - "alloc: %s:%d:%s: %" IVdf " %" UVuf - " %s = %" IVdf ": %" UVxf "\n", - filename, linenumber, funcname, n, typesize, - type_name, n * typesize, PTR2UV(newalloc)); - break; - case MLT_REALLOC: - len = my_snprintf(buf, sizeof(buf), - "realloc: %s:%d:%s: %" IVdf " %" UVuf - " %s = %" IVdf ": %" UVxf " -> %" UVxf "\n", - filename, linenumber, funcname, n, typesize, - type_name, n * typesize, PTR2UV(oldalloc), - PTR2UV(newalloc)); - break; - case MLT_FREE: - len = my_snprintf(buf, sizeof(buf), - "free: %s:%d:%s: %" UVxf "\n", - filename, linenumber, funcname, - PTR2UV(oldalloc)); - break; - case MLT_NEW_SV: - case MLT_DEL_SV: - len = my_snprintf(buf, sizeof(buf), - "%s_SV: %s:%d:%s: %" UVxf SV_LOG_SERIAL_FMT "\n", - mlt == MLT_NEW_SV ? "new" : "del", - filename, linenumber, funcname, - PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv)); - break; - default: - len = 0; - } - PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len)); - } + if (strchr(pmlenv, 't')) { + len = my_snprintf(buf, sizeof(buf), + MEM_LOG_TIME_FMT, MEM_LOG_TIME_ARG); + PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len)); + } + switch (mlt) { + case MLT_ALLOC: + len = my_snprintf(buf, sizeof(buf), + "alloc: %s:%d:%s: %" IVdf " %" UVuf + " %s = %" IVdf ": %" UVxf "\n", + filename, linenumber, funcname, n, typesize, + type_name, n * typesize, PTR2UV(newalloc)); + break; + case MLT_REALLOC: + len = my_snprintf(buf, sizeof(buf), + "realloc: %s:%d:%s: %" IVdf " %" UVuf + " %s = %" IVdf ": %" UVxf " -> %" UVxf "\n", + filename, linenumber, funcname, n, typesize, + type_name, n * typesize, PTR2UV(oldalloc), + PTR2UV(newalloc)); + break; + case MLT_FREE: + len = my_snprintf(buf, sizeof(buf), + "free: %s:%d:%s: %" UVxf "\n", + filename, linenumber, funcname, + PTR2UV(oldalloc)); + break; + case MLT_NEW_SV: + case MLT_DEL_SV: + len = my_snprintf(buf, sizeof(buf), + "%s_SV: %s:%d:%s: %" UVxf SV_LOG_SERIAL_FMT "\n", + mlt == MLT_NEW_SV ? "new" : "del", + filename, linenumber, funcname, + PTR2UV(sv) _SV_LOG_SERIAL_ARG(sv)); + break; + default: + len = 0; + } + PERL_UNUSED_RESULT(PerlLIO_write(fd, buf, len)); + } } } #endif /* !PERL_MEM_LOG_NOIMPL */ @@ -5127,60 +5127,60 @@ S_mem_log_common(enum mem_log_type mlt, const UV n, Malloc_t Perl_mem_log_alloc(const UV n, const UV typesize, const char *type_name, - Malloc_t newalloc, - const char *filename, const int linenumber, - const char *funcname) + Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) { PERL_ARGS_ASSERT_MEM_LOG_ALLOC; mem_log_common_if(MLT_ALLOC, n, typesize, type_name, - NULL, NULL, newalloc, - filename, linenumber, funcname); + NULL, NULL, newalloc, + filename, linenumber, funcname); return newalloc; } Malloc_t Perl_mem_log_realloc(const UV n, const UV typesize, const char *type_name, - Malloc_t oldalloc, Malloc_t newalloc, - const char *filename, const int linenumber, - const char *funcname) + Malloc_t oldalloc, Malloc_t newalloc, + const char *filename, const int linenumber, + const char *funcname) { PERL_ARGS_ASSERT_MEM_LOG_REALLOC; mem_log_common_if(MLT_REALLOC, n, typesize, type_name, - NULL, oldalloc, newalloc, - filename, linenumber, funcname); + NULL, oldalloc, newalloc, + filename, linenumber, funcname); return newalloc; } Malloc_t Perl_mem_log_free(Malloc_t oldalloc, - const char *filename, const int linenumber, - const char *funcname) + const char *filename, const int linenumber, + const char *funcname) { PERL_ARGS_ASSERT_MEM_LOG_FREE; mem_log_common_if(MLT_FREE, 0, 0, "", NULL, oldalloc, NULL, - filename, linenumber, funcname); + filename, linenumber, funcname); return oldalloc; } void Perl_mem_log_new_sv(const SV *sv, - const char *filename, const int linenumber, - const char *funcname) + const char *filename, const int linenumber, + const char *funcname) { mem_log_common_if(MLT_NEW_SV, 0, 0, "", sv, NULL, NULL, - filename, linenumber, funcname); + filename, linenumber, funcname); } void Perl_mem_log_del_sv(const SV *sv, - const char *filename, const int linenumber, - const char *funcname) + const char *filename, const int linenumber, + const char *funcname) { mem_log_common_if(MLT_DEL_SV, 0, 0, "", sv, NULL, NULL, - filename, linenumber, funcname); + filename, linenumber, funcname); } #endif /* PERL_MEM_LOG */ @@ -5355,7 +5355,7 @@ Perl_my_snprintf(char *buffer, const Size_t len, const char *format, ...) (len > 0 && (Size_t)retval >= len) #endif ) - Perl_croak_nocontext("panic: my_snprintf buffer overflow"); + Perl_croak_nocontext("panic: my_snprintf buffer overflow"); return retval; } @@ -5411,7 +5411,7 @@ Perl_my_vsnprintf(char *buffer, const Size_t len, const char *format, va_list ap (len > 0 && (Size_t)retval >= len) #endif ) - Perl_croak_nocontext("panic: my_vsnprintf buffer overflow"); + Perl_croak_nocontext("panic: my_vsnprintf buffer overflow"); return retval; #endif } @@ -5494,29 +5494,29 @@ Perl_my_cxt_init(pTHX_ int *indexp, size_t size) * other: already allocated by another thread */ if (index == -1) { - MUTEX_LOCK(&PL_my_ctx_mutex); + MUTEX_LOCK(&PL_my_ctx_mutex); /*now a stricter check with locking */ index = *indexp; if (index == -1) /* this module hasn't been allocated an index yet */ *indexp = PL_my_cxt_index++; index = *indexp; - MUTEX_UNLOCK(&PL_my_ctx_mutex); + MUTEX_UNLOCK(&PL_my_ctx_mutex); } /* make sure the array is big enough */ if (PL_my_cxt_size <= index) { - if (PL_my_cxt_size) { + if (PL_my_cxt_size) { IV new_size = PL_my_cxt_size; - while (new_size <= index) - new_size *= 2; - Renew(PL_my_cxt_list, new_size, void *); + while (new_size <= index) + new_size *= 2; + Renew(PL_my_cxt_list, new_size, void *); PL_my_cxt_size = new_size; - } - else { - PL_my_cxt_size = 16; - Newx(PL_my_cxt_list, PL_my_cxt_size, void *); - } + } + else { + PL_my_cxt_size = 16; + Newx(PL_my_cxt_list, PL_my_cxt_size, void *); + } } /* newSV() allocates one more than needed */ p = (void*)SvPVX(newSV(size-1)); @@ -5584,7 +5584,7 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) got = INT2PTR(void*, (UV)(key & HSm_KEY_MATCH)); need = (void *)(HS_KEY(FALSE, FALSE, "", "") & HSm_KEY_MATCH); if (UNLIKELY(got != need)) - goto bad_handshake; + goto bad_handshake; /* try to catch where a 2nd threaded perl interp DLL is loaded into a process by a XS DLL compiled against the wrong interl DLL b/c of bad @INC, and the 2nd threaded perl interp DLL never initialized its TLS/PERL_SYS_INIT3 so @@ -5608,52 +5608,52 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) need = &PL_stack_sp; #endif if(UNLIKELY(got != need)) { - bad_handshake:/* recycle branch and string from above */ - if(got != (void *)HSf_NOCHK) - noperl_die("%s: loadable library and perl binaries are mismatched" + bad_handshake:/* recycle branch and string from above */ + if(got != (void *)HSf_NOCHK) + noperl_die("%s: loadable library and perl binaries are mismatched" " (got handshake key %p, needed %p)\n", - file, got, need); + file, got, need); } if(key & HSf_SETXSUBFN) { /* this might be called from a module bootstrap */ - SAVEPPTR(PL_xsubfilename);/* which was require'd from a XSUB BEGIN */ - PL_xsubfilename = file; /* so the old name must be restored for - additional XSUBs to register themselves */ - /* XSUBs can't be perl lang/perl5db.pl debugged - if (PERLDB_LINE_OR_SAVESRC) - (void)gv_fetchfile(file); */ + SAVEPPTR(PL_xsubfilename);/* which was require'd from a XSUB BEGIN */ + PL_xsubfilename = file; /* so the old name must be restored for + additional XSUBs to register themselves */ + /* XSUBs can't be perl lang/perl5db.pl debugged + if (PERLDB_LINE_OR_SAVESRC) + (void)gv_fetchfile(file); */ } if(key & HSf_POPMARK) { - ax = POPMARK; - { SV **mark = PL_stack_base + ax++; - { dSP; - items = (I32)(SP - MARK); - } - } + ax = POPMARK; + { SV **mark = PL_stack_base + ax++; + { dSP; + items = (I32)(SP - MARK); + } + } } else { - items = va_arg(args, U32); - ax = va_arg(args, U32); + items = va_arg(args, U32); + ax = va_arg(args, U32); } { - U32 apiverlen; - assert(HS_GETAPIVERLEN(key) <= UCHAR_MAX); - if((apiverlen = HS_GETAPIVERLEN(key))) { - char * api_p = va_arg(args, char*); - if(apiverlen != sizeof("v" PERL_API_VERSION_STRING)-1 - || memNE(api_p, "v" PERL_API_VERSION_STRING, - sizeof("v" PERL_API_VERSION_STRING)-1)) - Perl_croak_nocontext("Perl API version %s of %" SVf " does not match %s", - api_p, SVfARG(PL_stack_base[ax + 0]), - "v" PERL_API_VERSION_STRING); - } + U32 apiverlen; + assert(HS_GETAPIVERLEN(key) <= UCHAR_MAX); + if((apiverlen = HS_GETAPIVERLEN(key))) { + char * api_p = va_arg(args, char*); + if(apiverlen != sizeof("v" PERL_API_VERSION_STRING)-1 + || memNE(api_p, "v" PERL_API_VERSION_STRING, + sizeof("v" PERL_API_VERSION_STRING)-1)) + Perl_croak_nocontext("Perl API version %s of %" SVf " does not match %s", + api_p, SVfARG(PL_stack_base[ax + 0]), + "v" PERL_API_VERSION_STRING); + } } { - U32 xsverlen; - assert(HS_GETXSVERLEN(key) <= UCHAR_MAX && HS_GETXSVERLEN(key) <= HS_APIVERLEN_MAX); - if((xsverlen = HS_GETXSVERLEN(key))) - S_xs_version_bootcheck(aTHX_ - items, ax, va_arg(args, char*), xsverlen); + U32 xsverlen; + assert(HS_GETXSVERLEN(key) <= UCHAR_MAX && HS_GETXSVERLEN(key) <= HS_APIVERLEN_MAX); + if((xsverlen = HS_GETXSVERLEN(key))) + S_xs_version_bootcheck(aTHX_ + items, ax, va_arg(args, char*), xsverlen); } va_end(args); return ax; @@ -5662,7 +5662,7 @@ Perl_xs_handshake(const U32 key, void * v_my_perl, const char * file, ...) STATIC void S_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, - STRLEN xs_len) + STRLEN xs_len) { SV *sv; const char *vn = NULL; @@ -5671,40 +5671,40 @@ S_xs_version_bootcheck(pTHX_ U32 items, U32 ax, const char *xs_p, PERL_ARGS_ASSERT_XS_VERSION_BOOTCHECK; if (items >= 2) /* version supplied as bootstrap arg */ - sv = PL_stack_base[ax + 1]; + sv = PL_stack_base[ax + 1]; else { - /* XXX GV_ADDWARN */ - vn = "XS_VERSION"; - sv = get_sv(Perl_form(aTHX_ "%" SVf "::%s", SVfARG(module), vn), 0); - if (!sv || !SvOK(sv)) { - vn = "VERSION"; - sv = get_sv(Perl_form(aTHX_ "%" SVf "::%s", SVfARG(module), vn), 0); - } + /* XXX GV_ADDWARN */ + vn = "XS_VERSION"; + sv = get_sv(Perl_form(aTHX_ "%" SVf "::%s", SVfARG(module), vn), 0); + if (!sv || !SvOK(sv)) { + vn = "VERSION"; + sv = get_sv(Perl_form(aTHX_ "%" SVf "::%s", SVfARG(module), vn), 0); + } } if (sv) { - SV *xssv = Perl_newSVpvn_flags(aTHX_ xs_p, xs_len, SVs_TEMP); - SV *pmsv = sv_isobject(sv) && sv_derived_from(sv, "version") - ? sv : sv_2mortal(new_version(sv)); - xssv = upg_version(xssv, 0); - if ( vcmp(pmsv,xssv) ) { - SV *string = vstringify(xssv); - SV *xpt = Perl_newSVpvf(aTHX_ "%" SVf " object version %" SVf - " does not match ", SVfARG(module), SVfARG(string)); - - SvREFCNT_dec(string); - string = vstringify(pmsv); - - if (vn) { - Perl_sv_catpvf(aTHX_ xpt, "$%" SVf "::%s %" SVf, SVfARG(module), vn, - SVfARG(string)); - } else { - Perl_sv_catpvf(aTHX_ xpt, "bootstrap parameter %" SVf, SVfARG(string)); - } - SvREFCNT_dec(string); + SV *xssv = Perl_newSVpvn_flags(aTHX_ xs_p, xs_len, SVs_TEMP); + SV *pmsv = sv_isobject(sv) && sv_derived_from(sv, "version") + ? sv : sv_2mortal(new_version(sv)); + xssv = upg_version(xssv, 0); + if ( vcmp(pmsv,xssv) ) { + SV *string = vstringify(xssv); + SV *xpt = Perl_newSVpvf(aTHX_ "%" SVf " object version %" SVf + " does not match ", SVfARG(module), SVfARG(string)); + + SvREFCNT_dec(string); + string = vstringify(pmsv); + + if (vn) { + Perl_sv_catpvf(aTHX_ xpt, "$%" SVf "::%s %" SVf, SVfARG(module), vn, + SVfARG(string)); + } else { + Perl_sv_catpvf(aTHX_ xpt, "bootstrap parameter %" SVf, SVfARG(string)); + } + SvREFCNT_dec(string); - Perl_sv_2mortal(aTHX_ xpt); - Perl_croak_sv(aTHX_ xpt); - } + Perl_sv_2mortal(aTHX_ xpt); + Perl_croak_sv(aTHX_ xpt); + } } } @@ -5793,11 +5793,11 @@ S_gv_has_usable_name(pTHX_ GV *gv) { GV **gvp; return GvSTASH(gv) - && HvENAME(GvSTASH(gv)) - && (gvp = (GV **)hv_fetchhek( - GvSTASH(gv), GvNAME_HEK(gv), 0 - )) - && *gvp == gv; + && HvENAME(GvSTASH(gv)) + && (gvp = (GV **)hv_fetchhek( + GvSTASH(gv), GvNAME_HEK(gv), 0 + )) + && *gvp == gv; } void @@ -5816,40 +5816,40 @@ Perl_get_db_sub(pTHX_ SV **svp, CV *cv) TAINT_set(FALSE); save_item(dbsv); if (!PERLDB_SUB_NN) { - GV *gv = CvGV(cv); - - if (!svp && !CvLEXICAL(cv)) { - gv_efullname3(dbsv, gv, NULL); - } - else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || CvLEXICAL(cv) - || strEQ(GvNAME(gv), "END") - || ( /* Could be imported, and old sub redefined. */ - (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv)) - && - !( (SvTYPE(*svp) == SVt_PVGV) - && (GvCV((const GV *)*svp) == cv) - /* Use GV from the stack as a fallback. */ - && S_gv_has_usable_name(aTHX_ gv = (GV *)*svp) - ) - ) - ) { - /* GV is potentially non-unique, or contain different CV. */ - SV * const tmp = newRV(MUTABLE_SV(cv)); - sv_setsv(dbsv, tmp); - SvREFCNT_dec(tmp); - } - else { - sv_sethek(dbsv, HvENAME_HEK(GvSTASH(gv))); - sv_catpvs(dbsv, "::"); - sv_cathek(dbsv, GvNAME_HEK(gv)); - } + GV *gv = CvGV(cv); + + if (!svp && !CvLEXICAL(cv)) { + gv_efullname3(dbsv, gv, NULL); + } + else if ( (CvFLAGS(cv) & (CVf_ANON | CVf_CLONED)) || CvLEXICAL(cv) + || strEQ(GvNAME(gv), "END") + || ( /* Could be imported, and old sub redefined. */ + (GvCV(gv) != cv || !S_gv_has_usable_name(aTHX_ gv)) + && + !( (SvTYPE(*svp) == SVt_PVGV) + && (GvCV((const GV *)*svp) == cv) + /* Use GV from the stack as a fallback. */ + && S_gv_has_usable_name(aTHX_ gv = (GV *)*svp) + ) + ) + ) { + /* GV is potentially non-unique, or contain different CV. */ + SV * const tmp = newRV(MUTABLE_SV(cv)); + sv_setsv(dbsv, tmp); + SvREFCNT_dec(tmp); + } + else { + sv_sethek(dbsv, HvENAME_HEK(GvSTASH(gv))); + sv_catpvs(dbsv, "::"); + sv_cathek(dbsv, GvNAME_HEK(gv)); + } } else { - const int type = SvTYPE(dbsv); - if (type < SVt_PVIV && type != SVt_IV) - sv_upgrade(dbsv, SVt_PVIV); - (void)SvIOK_on(dbsv); - SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */ + const int type = SvTYPE(dbsv); + if (type < SVt_PVIV && type != SVt_IV) + sv_upgrade(dbsv, SVt_PVIV); + (void)SvIOK_on(dbsv); + SvIV_set(dbsv, PTR2IV(cv)); /* Do it the quickest way */ } SvSETMAGIC(dbsv); TAINT_IF(save_taint); @@ -5945,7 +5945,7 @@ Perl_get_re_arg(pTHX_ SV *sv) { if (SvMAGICAL(sv)) mg_get(sv); if (SvROK(sv)) - sv = MUTABLE_SV(SvRV(sv)); + sv = MUTABLE_SV(SvRV(sv)); if (SvTYPE(sv) == SVt_REGEXP) return (REGEXP*) sv; } @@ -6792,10 +6792,10 @@ Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading) PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD; if (is_loading) { - PERL_LOADING_FILE(name); + PERL_LOADING_FILE(name); } else { - PERL_LOADED_FILE(name); + PERL_LOADED_FILE(name); } } diff --git a/util.h b/util.h index 3edcec64efb5..b2e0b7797b50 100644 --- a/util.h +++ b/util.h @@ -14,24 +14,24 @@ #ifdef VMS # define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' \ - || (strchr(f,':') \ - || ((*(f) == '[' || *(f) == '<') \ - && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1]))))) + (*(f) == '/' \ + || (strchr(f,':') \ + || ((*(f) == '[' || *(f) == '<') \ + && (isWORDCHAR((f)[1]) || memCHRs("$-_]>",(f)[1]))))) #elif defined(WIN32) || defined(__CYGWIN__) # define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ - || ((f)[0] && (f)[1] == ':')) /* drive name */ + (*(f) == '/' || *(f) == '\\' /* UNC/rooted path */ \ + || ((f)[0] && (f)[1] == ':')) /* drive name */ #elif defined(NETWARE) # define PERL_FILE_IS_ABSOLUTE(f) \ - (((f)[0] && (f)[1] == ':') /* drive name */ \ - || ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \ - || ((f)[3] == ':')) /* volume name, currently only sys */ + (((f)[0] && (f)[1] == ':') /* drive name */ \ + || ((f)[0] == '\\' && (f)[1] == '\\') /* UNC path */ \ + || ((f)[3] == ':')) /* volume name, currently only sys */ #elif defined(DOSISH) # define PERL_FILE_IS_ABSOLUTE(f) \ - (*(f) == '/' \ - || ((f)[0] && (f)[1] == ':')) /* drive name */ + (*(f) == '/' \ + || ((f)[0] && (f)[1] == ':')) /* drive name */ #else /* NOT DOSISH */ # define PERL_FILE_IS_ABSOLUTE(f) (*(f) == '/') #endif @@ -56,7 +56,7 @@ This is a synonym for S> #define ibcmp(s1, s2, len) cBOOL(! foldEQ(s1, s2, len)) #define ibcmp_locale(s1, s2, len) cBOOL(! foldEQ_locale(s1, s2, len)) #define ibcmp_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2) \ - cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2)) + cBOOL(! foldEQ_utf8(s1, pe1, l1, u1, s2, pe2, l2, u2)) /* outside the core, perl.h undefs HAS_QUAD if IV isn't 64-bit We can't swap this to HAS_QUAD, because the logic here affects the type of diff --git a/vms/munchconfig.c b/vms/munchconfig.c index 8f20417f6685..fdd5afde4d34 100644 --- a/vms/munchconfig.c +++ b/vms/munchconfig.c @@ -253,7 +253,7 @@ main(int argc, char *argv[]) /* Did we find one? */ if ('$' != LineBuffer[LineBufferLoop]) { /* Nope, spit out the value */ - OutBuf[OutBufPos++] = LineBuffer[LineBufferLoop]; + OutBuf[OutBufPos++] = LineBuffer[LineBufferLoop]; } else { /* Yes, we did. Is it escaped? */ if ((LineBufferLoop > 0) && ('\\' == LineBuffer[LineBufferLoop - @@ -289,8 +289,8 @@ main(int argc, char *argv[]) ConfigSubLoop++) { if (!strcmp(TokenBuffer, ConfigSub[ConfigSubLoop].Tag)) { char *cp = ConfigSub[ConfigSubLoop].Value; - GotIt = 1; - while (*cp) OutBuf[OutBufPos++] = *(cp++); + GotIt = 1; + while (*cp) OutBuf[OutBufPos++] = *(cp++); break; } } @@ -298,9 +298,9 @@ main(int argc, char *argv[]) /* Did we find something? If not, spit out what was in our */ /* buffer */ if (!GotIt) { - char *cp = TokenBuffer; - OutBuf[OutBufPos++] = '$'; - while (*cp) OutBuf[OutBufPos++] = *(cp++); + char *cp = TokenBuffer; + OutBuf[OutBufPos++] = '$'; + while (*cp) OutBuf[OutBufPos++] = *(cp++); } } else { @@ -322,17 +322,17 @@ main(int argc, char *argv[]) LineBufferLoop = 0; OutBuf[OutBufPos] = '\0'; for (i = 0; i <= 1; i++) { - while (!isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); - while ( isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); + while (!isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); + while ( isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); } while (*cp) { - while (isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); - if (!incomment && *cp == '/' && *(cp+1) == '*') incomment = 1; - while (*cp && !isspace(*cp)) { - if (incomment) LineBuffer[LineBufferLoop++] = *cp; - cp++; - } - if (incomment && *cp == '*' && *(cp+1) == '/') incomment = 0; + while (isspace(*cp)) LineBuffer[LineBufferLoop++] = *(cp++); + if (!incomment && *cp == '/' && *(cp+1) == '*') incomment = 1; + while (*cp && !isspace(*cp)) { + if (incomment) LineBuffer[LineBufferLoop++] = *cp; + cp++; + } + if (incomment && *cp == '*' && *(cp+1) == '/') incomment = 0; } LineBuffer[LineBufferLoop] = '\0'; puts(LineBuffer); diff --git a/vms/vms.c b/vms/vms.c index 5635450e957e..08cb52e463ea 100644 --- a/vms/vms.c +++ b/vms/vms.c @@ -62,10 +62,10 @@ #pragma member_alignment save #pragma nomember_alignment longword struct item_list_3 { - unsigned short len; - unsigned short code; - void * bufadr; - unsigned short * retadr; + unsigned short len; + unsigned short code; + void * bufadr; + unsigned short * retadr; }; #pragma member_alignment restore @@ -279,9 +279,9 @@ simple_trnlnm(const char * logname, char * value, int value_len) if ($VMS_STATUS_SUCCESS(status)) { - /* Null terminate and return the string */ - /*--------------------------------------*/ - value[result] = 0; + /* Null terminate and return the string */ + /*--------------------------------------*/ + value[result] = 0; return result; } @@ -305,17 +305,17 @@ is_unix_filespec(const char *path) ret_val = 0; if (! strBEGINs(path,"\"^UP^")) { - pch1 = strchr(path, '/'); - if (pch1 != NULL) - ret_val = 1; - else { - - /* If the user wants UNIX files, "." needs to be treated as in UNIX */ - if (DECC_FILENAME_UNIX_REPORT || DECC_FILENAME_UNIX_ONLY) { - if (strEQ(path,".")) - ret_val = 1; - } - } + pch1 = strchr(path, '/'); + if (pch1 != NULL) + ret_val = 1; + else { + + /* If the user wants UNIX files, "." needs to be treated as in UNIX */ + if (DECC_FILENAME_UNIX_REPORT || DECC_FILENAME_UNIX_ONLY) { + if (strEQ(path,".")) + ret_val = 1; + } + } } return ret_val; } @@ -335,25 +335,25 @@ ucs2_to_vtf7(char *outspec, unsigned long ucs2_char, int * output_cnt) outspec[1] = 'U'; hex = (ucs_ptr[1] >> 4) & 0xf; if (hex < 0xA) - outspec[2] = hex + '0'; + outspec[2] = hex + '0'; else - outspec[2] = (hex - 9) + 'A'; + outspec[2] = (hex - 9) + 'A'; hex = ucs_ptr[1] & 0xF; if (hex < 0xA) - outspec[3] = hex + '0'; + outspec[3] = hex + '0'; else { - outspec[3] = (hex - 9) + 'A'; + outspec[3] = (hex - 9) + 'A'; } hex = (ucs_ptr[0] >> 4) & 0xf; if (hex < 0xA) - outspec[4] = hex + '0'; + outspec[4] = hex + '0'; else - outspec[4] = (hex - 9) + 'A'; + outspec[4] = (hex - 9) + 'A'; hex = ucs_ptr[1] & 0xF; if (hex < 0xA) - outspec[5] = hex + '0'; + outspec[5] = hex + '0'; else { - outspec[5] = (hex - 9) + 'A'; + outspec[5] = (hex - 9) + 'A'; } *output_cnt = 6; } @@ -381,80 +381,80 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_ count = 0; *output_cnt = 0; if (*inspec >= 0x80) { - if (utf8_fl && vms_vtf7_filenames) { - unsigned long ucs_char; - - ucs_char = 0; - - if ((*inspec & 0xE0) == 0xC0) { - /* 2 byte Unicode */ - ucs_char = ((inspec[0] & 0x1F) << 6) + (inspec[1] & 0x3f); - if (ucs_char >= 0x80) { - ucs2_to_vtf7(outspec, ucs_char, output_cnt); - return 2; - } - } else if ((*inspec & 0xF0) == 0xE0) { - /* 3 byte Unicode */ - ucs_char = ((inspec[0] & 0xF) << 12) + - ((inspec[1] & 0x3f) << 6) + - (inspec[2] & 0x3f); - if (ucs_char >= 0x800) { - ucs2_to_vtf7(outspec, ucs_char, output_cnt); - return 3; - } + if (utf8_fl && vms_vtf7_filenames) { + unsigned long ucs_char; + + ucs_char = 0; + + if ((*inspec & 0xE0) == 0xC0) { + /* 2 byte Unicode */ + ucs_char = ((inspec[0] & 0x1F) << 6) + (inspec[1] & 0x3f); + if (ucs_char >= 0x80) { + ucs2_to_vtf7(outspec, ucs_char, output_cnt); + return 2; + } + } else if ((*inspec & 0xF0) == 0xE0) { + /* 3 byte Unicode */ + ucs_char = ((inspec[0] & 0xF) << 12) + + ((inspec[1] & 0x3f) << 6) + + (inspec[2] & 0x3f); + if (ucs_char >= 0x800) { + ucs2_to_vtf7(outspec, ucs_char, output_cnt); + return 3; + } #if 0 /* I do not see longer sequences supported by OpenVMS */ /* Maybe some one can fix this later */ - } else if ((*inspec & 0xF8) == 0xF0) { - /* 4 byte Unicode */ - /* UCS-4 to UCS-2 */ - } else if ((*inspec & 0xFC) == 0xF8) { - /* 5 byte Unicode */ - /* UCS-4 to UCS-2 */ - } else if ((*inspec & 0xFE) == 0xFC) { - /* 6 byte Unicode */ - /* UCS-4 to UCS-2 */ + } else if ((*inspec & 0xF8) == 0xF0) { + /* 4 byte Unicode */ + /* UCS-4 to UCS-2 */ + } else if ((*inspec & 0xFC) == 0xF8) { + /* 5 byte Unicode */ + /* UCS-4 to UCS-2 */ + } else if ((*inspec & 0xFE) == 0xFC) { + /* 6 byte Unicode */ + /* UCS-4 to UCS-2 */ #endif - } - } - - /* High bit set, but not a Unicode character! */ - - /* Non printing DECMCS or ISO Latin-1 character? */ - if ((unsigned char)*inspec <= 0x9F) { - int hex; - outspec[0] = '^'; - outspec++; - hex = (*inspec >> 4) & 0xF; - if (hex < 0xA) - outspec[1] = hex + '0'; - else { - outspec[1] = (hex - 9) + 'A'; - } - hex = *inspec & 0xF; - if (hex < 0xA) - outspec[2] = hex + '0'; - else { - outspec[2] = (hex - 9) + 'A'; - } - *output_cnt = 3; - return 1; - } else if ((unsigned char)*inspec == 0xA0) { - outspec[0] = '^'; - outspec[1] = 'A'; - outspec[2] = '0'; - *output_cnt = 3; - return 1; - } else if ((unsigned char)*inspec == 0xFF) { - outspec[0] = '^'; - outspec[1] = 'F'; - outspec[2] = 'F'; - *output_cnt = 3; - return 1; - } - *outspec = *inspec; - *output_cnt = 1; - return 1; + } + } + + /* High bit set, but not a Unicode character! */ + + /* Non printing DECMCS or ISO Latin-1 character? */ + if ((unsigned char)*inspec <= 0x9F) { + int hex; + outspec[0] = '^'; + outspec++; + hex = (*inspec >> 4) & 0xF; + if (hex < 0xA) + outspec[1] = hex + '0'; + else { + outspec[1] = (hex - 9) + 'A'; + } + hex = *inspec & 0xF; + if (hex < 0xA) + outspec[2] = hex + '0'; + else { + outspec[2] = (hex - 9) + 'A'; + } + *output_cnt = 3; + return 1; + } else if ((unsigned char)*inspec == 0xA0) { + outspec[0] = '^'; + outspec[1] = 'A'; + outspec[2] = '0'; + *output_cnt = 3; + return 1; + } else if ((unsigned char)*inspec == 0xFF) { + outspec[0] = '^'; + outspec[1] = 'F'; + outspec[2] = 'F'; + *output_cnt = 3; + return 1; + } + *outspec = *inspec; + *output_cnt = 1; + return 1; } /* Is this a macro that needs to be passed through? @@ -465,42 +465,42 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_ if ((inspec[0] == '$') && (inspec[1] == '(')) { int tcnt; - if (isALPHA_L1(inspec[2]) || (inspec[2] == '.') || (inspec[2] == '_')) { - tcnt = 3; - outspec[0] = inspec[0]; - outspec[1] = inspec[1]; - outspec[2] = inspec[2]; - - while(isALPHA_L1(inspec[tcnt]) || - (inspec[2] == '.') || (inspec[2] == '_')) { - outspec[tcnt] = inspec[tcnt]; - tcnt++; - } - if (inspec[tcnt] == ')') { - outspec[tcnt] = inspec[tcnt]; - tcnt++; - *output_cnt = tcnt; - return tcnt; - } - } + if (isALPHA_L1(inspec[2]) || (inspec[2] == '.') || (inspec[2] == '_')) { + tcnt = 3; + outspec[0] = inspec[0]; + outspec[1] = inspec[1]; + outspec[2] = inspec[2]; + + while(isALPHA_L1(inspec[tcnt]) || + (inspec[2] == '.') || (inspec[2] == '_')) { + outspec[tcnt] = inspec[tcnt]; + tcnt++; + } + if (inspec[tcnt] == ')') { + outspec[tcnt] = inspec[tcnt]; + tcnt++; + *output_cnt = tcnt; + return tcnt; + } + } } switch (*inspec) { case 0x7f: - outspec[0] = '^'; - outspec[1] = '7'; - outspec[2] = 'F'; - *output_cnt = 3; - return 1; - break; + outspec[0] = '^'; + outspec[1] = '7'; + outspec[2] = 'F'; + *output_cnt = 3; + return 1; + break; case '?': - if (!DECC_EFS_CHARSET) - outspec[0] = '%'; - else - outspec[0] = '?'; - *output_cnt = 1; - return 1; - break; + if (!DECC_EFS_CHARSET) + outspec[0] = '%'; + else + outspec[0] = '?'; + *output_cnt = 1; + return 1; + break; case '.': case '!': case '#': @@ -524,31 +524,31 @@ copy_expand_unix_filename_escape(char *outspec, const char *inspec, int *output_ * already something we escape. */ if (memCHRs(".!#&\'`()+@{},;[]%^=_\\", *(inspec+1))) { - *outspec = *inspec; - *output_cnt = 1; - return 1; - break; + *outspec = *inspec; + *output_cnt = 1; + return 1; + break; } /* But otherwise fall through and escape it. */ case '=': - /* Assume that this is to be escaped */ - outspec[0] = '^'; - outspec[1] = *inspec; - *output_cnt = 2; - return 1; - break; + /* Assume that this is to be escaped */ + outspec[0] = '^'; + outspec[1] = *inspec; + *output_cnt = 2; + return 1; + break; case ' ': /* space */ - /* Assume that this is to be escaped */ - outspec[0] = '^'; - outspec[1] = '_'; - *output_cnt = 2; - return 1; - break; + /* Assume that this is to be escaped */ + outspec[0] = '^'; + outspec[1] = '_'; + *output_cnt = 2; + return 1; + break; default: - *outspec = *inspec; - *output_cnt = 1; - return 1; - break; + *outspec = *inspec; + *output_cnt = 1; + return 1; + break; } return 0; } @@ -572,75 +572,75 @@ copy_expand_vms_filename_escape(char *outspec, const char *inspec, int *output_c count = 0; *output_cnt = 0; if (*inspec == '^') { - inspec++; - switch (*inspec) { + inspec++; + switch (*inspec) { /* Spaces and non-trailing dots should just be passed through, * but eat the escape character. */ - case '.': - *outspec = *inspec; - count += 2; - (*output_cnt)++; - break; - case '_': /* space */ - *outspec = ' '; - count += 2; - (*output_cnt)++; - break; - case '^': + case '.': + *outspec = *inspec; + count += 2; + (*output_cnt)++; + break; + case '_': /* space */ + *outspec = ' '; + count += 2; + (*output_cnt)++; + break; + case '^': /* Hmm. Better leave the escape escaped. */ outspec[0] = '^'; outspec[1] = '^'; - count += 2; - (*output_cnt) += 2; - break; - case 'U': /* Unicode - FIX-ME this is wrong. */ - inspec++; - count++; - scnt = strspn(inspec, "0123456789ABCDEFabcdef"); - if (scnt == 4) { - unsigned int c1, c2; - scnt = sscanf(inspec, "%2x%2x", &c1, &c2); - outspec[0] = c1 & 0xff; - outspec[1] = c2 & 0xff; - if (scnt > 1) { - (*output_cnt) += 2; - count += 4; - } - } - else { - /* Error - do best we can to continue */ - *outspec = 'U'; - outspec++; - (*output_cnt++); - *outspec = *inspec; - count++; - (*output_cnt++); - } - break; - default: - scnt = strspn(inspec, "0123456789ABCDEFabcdef"); - if (scnt == 2) { - /* Hex encoded */ - unsigned int c1; - scnt = sscanf(inspec, "%2x", &c1); - outspec[0] = c1 & 0xff; - if (scnt > 0) { - (*output_cnt++); - count += 2; - } - } - else { - *outspec = *inspec; - count++; - (*output_cnt++); - } - } + count += 2; + (*output_cnt) += 2; + break; + case 'U': /* Unicode - FIX-ME this is wrong. */ + inspec++; + count++; + scnt = strspn(inspec, "0123456789ABCDEFabcdef"); + if (scnt == 4) { + unsigned int c1, c2; + scnt = sscanf(inspec, "%2x%2x", &c1, &c2); + outspec[0] = c1 & 0xff; + outspec[1] = c2 & 0xff; + if (scnt > 1) { + (*output_cnt) += 2; + count += 4; + } + } + else { + /* Error - do best we can to continue */ + *outspec = 'U'; + outspec++; + (*output_cnt++); + *outspec = *inspec; + count++; + (*output_cnt++); + } + break; + default: + scnt = strspn(inspec, "0123456789ABCDEFabcdef"); + if (scnt == 2) { + /* Hex encoded */ + unsigned int c1; + scnt = sscanf(inspec, "%2x", &c1); + outspec[0] = c1 & 0xff; + if (scnt > 0) { + (*output_cnt++); + count += 2; + } + } + else { + *outspec = *inspec; + count++; + (*output_cnt++); + } + } } else { - *outspec = *inspec; - count++; - (*output_cnt)++; + *outspec = *inspec; + count++; + (*output_cnt)++; } return count; } @@ -740,24 +740,24 @@ vms_split_path(const char * path, char * * volume, int * vol_len, char * * root, status = sys$filescan ((const struct dsc$descriptor_s *)&path_desc, item_list, - &flags, NULL, NULL); + &flags, NULL, NULL); _ckvmssts_noperl(status); /* All failure status values indicate a coding error */ /* If we parsed it successfully these two lengths should be the same */ if (path_desc.dsc$w_length != item_list[filespec].length) - return ret_stat; + return ret_stat; /* If we got here, then it is a VMS file specification */ ret_stat = 0; /* set the volume name */ if (item_list[nodespec].length > 0) { - *volume = item_list[nodespec].component; - *vol_len = item_list[nodespec].length + item_list[devspec].length; + *volume = item_list[nodespec].component; + *vol_len = item_list[nodespec].length + item_list[devspec].length; } else { - *volume = item_list[devspec].component; - *vol_len = item_list[devspec].length; + *volume = item_list[devspec].component; + *vol_len = item_list[devspec].length; } *root = item_list[rootspec].component; @@ -771,22 +771,22 @@ vms_split_path(const char * path, char * * volume, int * vol_len, char * * root, * delimiter or a part of the file specification. */ if ((DECC_EFS_CHARSET) && - (item_list[verspec].length > 0) && - (item_list[verspec].component[0] == '.')) { - *name = item_list[namespec].component; - *name_len = item_list[namespec].length + item_list[typespec].length; - *ext = item_list[verspec].component; - *ext_len = item_list[verspec].length; - *version = NULL; - *ver_len = 0; + (item_list[verspec].length > 0) && + (item_list[verspec].component[0] == '.')) { + *name = item_list[namespec].component; + *name_len = item_list[namespec].length + item_list[typespec].length; + *ext = item_list[verspec].component; + *ext_len = item_list[verspec].length; + *version = NULL; + *ver_len = 0; } else { - *name = item_list[namespec].component; - *name_len = item_list[namespec].length; - *ext = item_list[typespec].component; - *ext_len = item_list[typespec].length; - *version = item_list[verspec].component; - *ver_len = item_list[verspec].length; + *name = item_list[namespec].component; + *name_len = item_list[namespec].length; + *ext = item_list[typespec].component; + *ext_len = item_list[typespec].length; + *version = item_list[verspec].component; + *ver_len = item_list[verspec].length; } return ret_stat; } @@ -964,19 +964,19 @@ Perl_vmstrnenv(const char *lnm, char *eqv, unsigned long int idx, if (eqvlen > MAX_DCL_SYMBOL) { set_errno(EVMSERR); set_vaxc_errno(LIB$_STRTRU); eqvlen = MAX_DCL_SYMBOL; - /* Special hack--we might be called before the interpreter's */ - /* fully initialized, in which case either thr or PL_curcop */ - /* might be bogus. We have to check, since ckWARN needs them */ - /* both to be valid if running threaded */ + /* Special hack--we might be called before the interpreter's */ + /* fully initialized, in which case either thr or PL_curcop */ + /* might be bogus. We have to check, since ckWARN needs them */ + /* both to be valid if running threaded */ #if defined(PERL_IMPLICIT_CONTEXT) if (aTHX == NULL) { fprintf(stderr, "Value of CLI symbol \"%s\" too long",lnm); } else #endif - if (ckWARN(WARN_MISC)) { - Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm); - } + if (ckWARN(WARN_MISC)) { + Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of CLI symbol \"%s\" too long",lnm); + } } strncpy(eqv,eqvdsc.dsc$a_pointer,eqvlen); } @@ -1106,14 +1106,14 @@ Perl_my_getenv(pTHX_ const char *lnm, bool sys) /* Get rid of "000000/ in rooted filespecs */ if (len > 7) { char * zeros; - zeros = strstr(eqv, "/000000/"); - if (zeros != NULL) { - int mlen; - mlen = len - (zeros - eqv) - 7; - memmove(zeros, &zeros[7], mlen); - len = len - 7; - eqv[len] = '\0'; - } + zeros = strstr(eqv, "/000000/"); + if (zeros != NULL) { + int mlen; + mlen = len - (zeros - eqv) - 7; + memmove(zeros, &zeros[7], mlen); + len = len - 7; + eqv[len] = '\0'; + } } return eqv; } @@ -1203,12 +1203,12 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) if (*len > 7) { zeros = strstr(buf, "/000000/"); if (zeros != NULL) { - int mlen; - mlen = *len - (zeros - buf) - 7; - memmove(zeros, &zeros[7], mlen); - *len = *len - 7; - buf[*len] = '\0'; - } + int mlen; + mlen = *len - (zeros - buf) - 7; + memmove(zeros, &zeros[7], mlen); + *len = *len - 7; + buf[*len] = '\0'; + } } return buf; } @@ -1242,15 +1242,15 @@ Perl_my_getenv_len(pTHX_ const char *lnm, unsigned long *len, bool sys) /* Get rid of "000000/ in rooted filespecs */ if (*len > 7) { - char * zeros; - zeros = strstr(buf, "/000000/"); - if (zeros != NULL) { - int mlen; - mlen = *len - (zeros - buf) - 7; - memmove(zeros, &zeros[7], mlen); - *len = *len - 7; - buf[*len] = '\0'; - } + char * zeros; + zeros = strstr(buf, "/000000/"); + if (zeros != NULL) { + int mlen; + mlen = *len - (zeros - buf) - 7; + memmove(zeros, &zeros[7], mlen); + *len = *len - 7; + buf[*len] = '\0'; + } } return *len ? buf : NULL; @@ -1572,22 +1572,22 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * } else { if (!*eqv) eqvdsc.dsc$w_length = 1; - if (eqvdsc.dsc$w_length > LNM$C_NAMLENGTH) { + if (eqvdsc.dsc$w_length > LNM$C_NAMLENGTH) { nseg = (eqvdsc.dsc$w_length + LNM$C_NAMLENGTH - 1) / LNM$C_NAMLENGTH; if (nseg > PERL_LNM_MAX_ALLOWED_INDEX + 1) { - Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes", + Perl_warner(aTHX_ packWARN(WARN_MISC),"Value of logical \"%s\" too long. Truncating to %i bytes", lnm, LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1)); eqvdsc.dsc$w_length = LNM$C_NAMLENGTH * (PERL_LNM_MAX_ALLOWED_INDEX+1); nseg = PERL_LNM_MAX_ALLOWED_INDEX + 1; - } + } Newx(ilist,nseg+1,struct itmlst_3); ile = ilist; if (!ile) { - set_errno(ENOMEM); set_vaxc_errno(SS$_INSFMEM); + set_errno(ENOMEM); set_vaxc_errno(SS$_INSFMEM); return SS$_INSFMEM; - } + } memset(ilist, 0, (sizeof(struct itmlst_3) * (nseg+1))); for (j = 0, c = eqvdsc.dsc$a_pointer; j < nseg; j++, ile++, c += LNM$C_NAMLENGTH) { @@ -1605,10 +1605,10 @@ Perl_vmssetenv(pTHX_ const char *lnm, const char *eqv, struct dsc$descriptor_s * retsts = lib$set_logical(&lnmdsc,0,tabvec[0],0,ilist); Safefree (ilist); - } + } else { retsts = lib$set_logical(&lnmdsc,&eqvdsc,tabvec[0],0,0); - } + } } } } @@ -1810,7 +1810,7 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag) rslt = int_rmsexpand_tovms(name, vmsname, PERL_RMSEXPAND_M_SYMLINK); if (rslt == NULL) { PerlMem_free(vmsname); - return -1; + return -1; } /* Erase the file */ @@ -1818,8 +1818,8 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag) /* Did it succeed */ if ($VMS_STATUS_SUCCESS(rmsts)) { - PerlMem_free(vmsname); - return 0; + PerlMem_free(vmsname); + return 0; } /* If not, can changing protections help? */ @@ -1868,10 +1868,10 @@ mp_do_kill_file(pTHX_ const char *name, int dirflag) rmsts = rms_erase(vmsname); if ($VMS_STATUS_SUCCESS(rmsts)) { - rmsts = 0; - } - else { - rmsts = -1; + rmsts = 0; + } + else { + rmsts = -1; /* We blew it - dir with files in it, no write priv for * parent directory, etc. Put things back the way they were. */ if (!((aclsts = sys$change_acl(0,&type,&fildsc,dellst,0,0,0)) & 1)) @@ -1937,8 +1937,8 @@ Perl_do_rmdir(pTHX_ const char *name) } if (!S_ISDIR(st.st_mode)) { - errno = ENOTDIR; - retval = -1; + errno = ENOTDIR; + retval = -1; } else { dirfile = st.st_devnam; @@ -1951,7 +1951,7 @@ Perl_do_rmdir(pTHX_ const char *name) return -1; } - retval = mp_do_kill_file(aTHX_ dirfile, 1); + retval = mp_do_kill_file(aTHX_ dirfile, 1); } return retval; @@ -2186,8 +2186,8 @@ Perl_my_sigaction (pTHX_ int sig, const struct sigaction* act, struct sigaction* oact) { if (sig == SIGKILL || sig == SIGSTOP || sig == SIGCONT) { - SETERRNO(EINVAL, SS$_INVARG); - return -1; + SETERRNO(EINVAL, SS$_INVARG); + return -1; } return sigaction(sig, act, oact); } @@ -2284,7 +2284,7 @@ Perl_sig_to_vmscondition(int sig) { #ifdef SS$_DEBUG if (vms_debug_on_exception != 0) - lib$signal(SS$_DEBUG); + lib$signal(SS$_DEBUG); #endif return Perl_sig_to_vmscondition_int(sig); } @@ -2311,32 +2311,32 @@ Perl_my_kill(int pid, int sig) /* sig 0 means validate the PID */ /*------------------------------*/ if (sig == 0) { - const unsigned long int jpicode = JPI$_PID; - pid_t ret_pid; - int status; + const unsigned long int jpicode = JPI$_PID; + pid_t ret_pid; + int status; status = lib$getjpi(&jpicode, &pid, NULL, &ret_pid, NULL, NULL); - if ($VMS_STATUS_SUCCESS(status)) - return 0; - switch (status) { + if ($VMS_STATUS_SUCCESS(status)) + return 0; + switch (status) { case SS$_NOSUCHNODE: case SS$_UNREACHABLE: - case SS$_NONEXPR: - errno = ESRCH; - break; - case SS$_NOPRIV: - errno = EPERM; - break; - default: - errno = EVMSERR; - } - vaxc$errno=status; - return -1; + case SS$_NONEXPR: + errno = ESRCH; + break; + case SS$_NOPRIV: + errno = EPERM; + break; + default: + errno = EVMSERR; + } + vaxc$errno=status; + return -1; } code = Perl_sig_to_vmscondition_int(sig); if (!code) { - SETERRNO(EINVAL, SS$_BADPARAM); + SETERRNO(EINVAL, SS$_BADPARAM); return -1; } @@ -2351,7 +2351,7 @@ Perl_my_kill(int pid, int sig) */ if (pid <= 0) { - return killpg(-pid, sig); + return killpg(-pid, sig); } iss = sys$sigprc((unsigned int *)&pid,0,code); @@ -2572,17 +2572,17 @@ Perl_vms_status_to_unix(int vms_status, int child_flag) if (((facility == 0) || (fac_sp == 0)) && (child_flag == 0)) { switch(msg_no) { case SS$_NORMAL: - unix_status = 0; - break; + unix_status = 0; + break; case SS$_ACCVIO: - unix_status = EFAULT; - break; + unix_status = EFAULT; + break; case SS$_DEVOFFLINE: - unix_status = EBUSY; - break; + unix_status = EBUSY; + break; case SS$_CLEARED: - unix_status = ENOTCONN; - break; + unix_status = ENOTCONN; + break; case SS$_IVCHAN: case SS$_IVLOGNAM: case SS$_BADPARAM: @@ -2593,133 +2593,133 @@ Perl_vms_status_to_unix(int vms_status, int child_flag) case SS$_INVARG: case SS$_NOSUCHID: case SS$_IVIDENT: - unix_status = EINVAL; - break; + unix_status = EINVAL; + break; case SS$_UNSUPPORTED: - unix_status = ENOTSUP; - break; + unix_status = ENOTSUP; + break; case SS$_FILACCERR: case SS$_NOGRPPRV: case SS$_NOSYSPRV: - unix_status = EACCES; - break; + unix_status = EACCES; + break; case SS$_DEVICEFULL: - unix_status = ENOSPC; - break; + unix_status = ENOSPC; + break; case SS$_NOSUCHDEV: - unix_status = ENODEV; - break; + unix_status = ENODEV; + break; case SS$_NOSUCHFILE: case SS$_NOSUCHOBJECT: - unix_status = ENOENT; - break; + unix_status = ENOENT; + break; case SS$_ABORT: /* Fatal case */ case ((SS$_ABORT & STS$M_COND_ID) | STS$K_ERROR): /* Error case */ case ((SS$_ABORT & STS$M_COND_ID) | STS$K_WARNING): /* Warning case */ - unix_status = EINTR; - break; + unix_status = EINTR; + break; case SS$_BUFFEROVF: - unix_status = E2BIG; - break; + unix_status = E2BIG; + break; case SS$_INSFMEM: - unix_status = ENOMEM; - break; + unix_status = ENOMEM; + break; case SS$_NOPRIV: - unix_status = EPERM; - break; + unix_status = EPERM; + break; case SS$_NOSUCHNODE: case SS$_UNREACHABLE: - unix_status = ESRCH; - break; + unix_status = ESRCH; + break; case SS$_NONEXPR: - unix_status = ECHILD; - break; + unix_status = ECHILD; + break; default: - if ((facility == 0) && (msg_no < 8)) { - /* These are not real VMS status codes so assume that they are + if ((facility == 0) && (msg_no < 8)) { + /* These are not real VMS status codes so assume that they are ** already UNIX status codes - */ - unix_status = msg_no; - break; - } + */ + unix_status = msg_no; + break; + } } } else { /* Translate a POSIX exit code to a UNIX exit code */ if ((facility == C_FACILITY_NO) && ((msg_no & 0xA000) == 0xA000)) { - unix_status = (msg_no & 0x07F8) >> 3; + unix_status = (msg_no & 0x07F8) >> 3; } else { - /* Documented traditional behavior for handling VMS child exits */ - /*--------------------------------------------------------------*/ - if (child_flag != 0) { - - /* Success / Informational return 0 */ - /*----------------------------------*/ - if (msg_no & STS$K_SUCCESS) - return 0; - - /* Warning returns 1 */ - /*-------------------*/ - if ((msg_no & (STS$K_ERROR | STS$K_SEVERE)) == 0) - return 1; - - /* Everything else pass through the severity bits */ - /*------------------------------------------------*/ - return (msg_no & STS$M_SEVERITY); - } - - /* Normal VMS status to ERRNO mapping attempt */ - /*--------------------------------------------*/ - switch(msg_status) { - /* case RMS$_EOF: */ /* End of File */ - case RMS$_FNF: /* File Not Found */ - case RMS$_DNF: /* Dir Not Found */ - unix_status = ENOENT; - break; - case RMS$_RNF: /* Record Not Found */ - unix_status = ESRCH; - break; - case RMS$_DIR: - unix_status = ENOTDIR; - break; - case RMS$_DEV: - unix_status = ENODEV; - break; - case RMS$_IFI: - case RMS$_FAC: - case RMS$_ISI: - unix_status = EBADF; - break; - case RMS$_FEX: - unix_status = EEXIST; - break; - case RMS$_SYN: - case RMS$_FNM: - case LIB$_INVSTRDES: - case LIB$_INVARG: - case LIB$_NOSUCHSYM: - case LIB$_INVSYMNAM: - case DCL_IVVERB: - unix_status = EINVAL; - break; - case CLI$_BUFOVF: - case RMS$_RTB: - case CLI$_TKNOVF: - case CLI$_RSLOVF: - unix_status = E2BIG; - break; - case RMS$_PRV: /* No privilege */ - case RMS$_ACC: /* ACP file access failed */ - case RMS$_WLK: /* Device write locked */ - unix_status = EACCES; - break; - case RMS$_MKD: /* Failed to mark for delete */ - unix_status = EPERM; - break; - /* case RMS$_NMF: */ /* No more files */ - } + /* Documented traditional behavior for handling VMS child exits */ + /*--------------------------------------------------------------*/ + if (child_flag != 0) { + + /* Success / Informational return 0 */ + /*----------------------------------*/ + if (msg_no & STS$K_SUCCESS) + return 0; + + /* Warning returns 1 */ + /*-------------------*/ + if ((msg_no & (STS$K_ERROR | STS$K_SEVERE)) == 0) + return 1; + + /* Everything else pass through the severity bits */ + /*------------------------------------------------*/ + return (msg_no & STS$M_SEVERITY); + } + + /* Normal VMS status to ERRNO mapping attempt */ + /*--------------------------------------------*/ + switch(msg_status) { + /* case RMS$_EOF: */ /* End of File */ + case RMS$_FNF: /* File Not Found */ + case RMS$_DNF: /* Dir Not Found */ + unix_status = ENOENT; + break; + case RMS$_RNF: /* Record Not Found */ + unix_status = ESRCH; + break; + case RMS$_DIR: + unix_status = ENOTDIR; + break; + case RMS$_DEV: + unix_status = ENODEV; + break; + case RMS$_IFI: + case RMS$_FAC: + case RMS$_ISI: + unix_status = EBADF; + break; + case RMS$_FEX: + unix_status = EEXIST; + break; + case RMS$_SYN: + case RMS$_FNM: + case LIB$_INVSTRDES: + case LIB$_INVARG: + case LIB$_NOSUCHSYM: + case LIB$_INVSYMNAM: + case DCL_IVVERB: + unix_status = EINVAL; + break; + case CLI$_BUFOVF: + case RMS$_RTB: + case CLI$_TKNOVF: + case CLI$_RSLOVF: + unix_status = E2BIG; + break; + case RMS$_PRV: /* No privilege */ + case RMS$_ACC: /* ACP file access failed */ + case RMS$_WLK: /* Device write locked */ + unix_status = EACCES; + break; + case RMS$_MKD: /* Failed to mark for delete */ + unix_status = EPERM; + break; + /* case RMS$_NMF: */ /* No more files */ + } } } @@ -2739,23 +2739,23 @@ Perl_unix_status_to_vms(int unix_status) /* Trivial cases first */ /*---------------------*/ if (unix_status == EVMSERR) - return vaxc$errno; + return vaxc$errno; /* Is vaxc$errno sane? */ /*---------------------*/ test_unix_status = Perl_vms_status_to_unix(vaxc$errno, 0); if (test_unix_status == unix_status) - return vaxc$errno; + return vaxc$errno; /* If way out of range, must be VMS code already */ /*-----------------------------------------------*/ if (unix_status > EVMSERR) - return unix_status; + return unix_status; /* If out of range, punt */ /*-----------------------*/ if (unix_status > __ERRNO_MAX) - return SS$_ABORT; + return SS$_ABORT; /* Ok, now we have to do it the hard way. */ @@ -2843,7 +2843,7 @@ Perl_unix_status_to_vms(int unix_status) /* case EFAIL */ /* case EINPROG */ case ENOTSUP: - return SS$_UNSUPPORTED; + return SS$_UNSUPPORTED; /* case EDEADLK */ /* case ENWAIT */ /* case EILSEQ */ @@ -2851,7 +2851,7 @@ Perl_unix_status_to_vms(int unix_status) /* case EBADMSG */ /* case EABANDONED */ default: - return SS$_ABORT; /* punt */ + return SS$_ABORT; /* punt */ } } @@ -3542,43 +3542,43 @@ pipe_mbxtofd_setup(pTHX_ int fd, char *out) /* things like terminals and mbx's don't need this filter */ if (fd && fstat(fd,&s) == 0) { unsigned long devchar; - char device[65]; - unsigned short dev_len; - struct dsc$descriptor_s d_dev; - char * cptr; - struct item_list_3 items[3]; - int status; - unsigned short dvi_iosb[4]; - - cptr = getname(fd, out, 1); - if (cptr == NULL) _ckvmssts_noperl(SS$_NOSUCHDEV); - d_dev.dsc$a_pointer = out; - d_dev.dsc$w_length = strlen(out); - d_dev.dsc$b_dtype = DSC$K_DTYPE_T; - d_dev.dsc$b_class = DSC$K_CLASS_S; - - items[0].len = 4; - items[0].code = DVI$_DEVCHAR; - items[0].bufadr = &devchar; - items[0].retadr = NULL; - items[1].len = 64; - items[1].code = DVI$_FULLDEVNAM; - items[1].bufadr = device; - items[1].retadr = &dev_len; - items[2].len = 0; - items[2].code = 0; - - status = sys$getdviw - (NO_EFN, 0, &d_dev, items, dvi_iosb, NULL, NULL, NULL); - _ckvmssts_noperl(status); - if ($VMS_STATUS_SUCCESS(dvi_iosb[0])) { - device[dev_len] = 0; - - if (!(devchar & DEV$M_DIR)) { - strcpy(out, device); - return 0; - } - } + char device[65]; + unsigned short dev_len; + struct dsc$descriptor_s d_dev; + char * cptr; + struct item_list_3 items[3]; + int status; + unsigned short dvi_iosb[4]; + + cptr = getname(fd, out, 1); + if (cptr == NULL) _ckvmssts_noperl(SS$_NOSUCHDEV); + d_dev.dsc$a_pointer = out; + d_dev.dsc$w_length = strlen(out); + d_dev.dsc$b_dtype = DSC$K_DTYPE_T; + d_dev.dsc$b_class = DSC$K_CLASS_S; + + items[0].len = 4; + items[0].code = DVI$_DEVCHAR; + items[0].bufadr = &devchar; + items[0].retadr = NULL; + items[1].len = 64; + items[1].code = DVI$_FULLDEVNAM; + items[1].bufadr = device; + items[1].retadr = &dev_len; + items[2].len = 0; + items[2].code = 0; + + status = sys$getdviw + (NO_EFN, 0, &d_dev, items, dvi_iosb, NULL, NULL, NULL); + _ckvmssts_noperl(status); + if ($VMS_STATUS_SUCCESS(dvi_iosb[0])) { + device[dev_len] = 0; + + if (!(devchar & DEV$M_DIR)) { + strcpy(out, device); + return 0; + } + } } _ckvmssts_noperl(lib$get_vm(&n, &p)); @@ -3703,28 +3703,28 @@ store_pipelocs(pTHX) #endif my_strlcpy(temp, PL_origargv[0], sizeof(temp)); x = strrchr(temp,']'); - if (x == NULL) { - x = strrchr(temp,'>'); - if (x == NULL) { - /* It could be a UNIX path */ - x = strrchr(temp,'/'); - } - } - if (x) - x[1] = '\0'; - else { - /* Got a bare name, so use default directory */ - temp[0] = '.'; - temp[1] = '\0'; - } + if (x == NULL) { + x = strrchr(temp,'>'); + if (x == NULL) { + /* It could be a UNIX path */ + x = strrchr(temp,'/'); + } + } + if (x) + x[1] = '\0'; + else { + /* Got a bare name, so use default directory */ + temp[0] = '.'; + temp[1] = '\0'; + } if ((tounixpath_utf8(temp, unixdir, NULL)) != NULL) { p = (pPLOC) PerlMem_malloc(sizeof(PLOC)); - if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM); + if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM); p->next = head_PLOC; head_PLOC = p; my_strlcpy(p->dir, unixdir, sizeof(p->dir)); - } + } } /* reverse order of @INC entries, skip "." since entered above */ @@ -3754,7 +3754,7 @@ store_pipelocs(pTHX) #ifdef ARCHLIB_EXP if ((tounixpath_utf8(ARCHLIB_EXP, unixdir, NULL)) != NULL) { p = (pPLOC) PerlMem_malloc(sizeof(PLOC)); - if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM); + if (p == NULL) _ckvmssts_noperl(SS$_INSFMEM); p->next = head_PLOC; head_PLOC = p; my_strlcpy(p->dir, unixdir, sizeof(p->dir)); @@ -3782,7 +3782,7 @@ find_vmspipe(pTHX) if (vmspipe_file_status == 1) { if (cando_by_name_int(S_IRUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN) && cando_by_name_int - (S_IXUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN)) { + (S_IXUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN)) { return vmspipe_file; } vmspipe_file_status = 0; @@ -3795,9 +3795,9 @@ find_vmspipe(pTHX) pPLOC p = head_PLOC; while (p) { - char * exp_res; - int dirlen; - dirlen = my_strlcpy(file, p->dir, sizeof(file)); + char * exp_res; + int dirlen; + dirlen = my_strlcpy(file, p->dir, sizeof(file)); my_strlcat(file, "vmspipe.com", sizeof(file)); p = p->next; @@ -3805,9 +3805,9 @@ find_vmspipe(pTHX) if (!exp_res) continue; if (cando_by_name_int - (S_IRUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN) + (S_IRUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN) && cando_by_name_int - (S_IXUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN)) { + (S_IXUSR, 0, vmspipe_file, PERL_RMSEXPAND_M_VMS_IN)) { vmspipe_file_status = 1; return vmspipe_file; } @@ -3849,19 +3849,19 @@ vmspipe_tempfile(pTHX) if (!fp) { sprintf(file,"sys$disk:[]perlpipe_%08.8x_%d.com",mypid,index); fp = fopen(file,"w"); - } + } } } else { sprintf(file,"/tmp/perlpipe_%08.8x_%d.com",mypid,index); fp = fopen(file,"w"); if (!fp) { - sprintf(file,"/sys$login/perlpipe_%08.8x_%d.com",mypid,index); - fp = fopen(file,"w"); - if (!fp) { - sprintf(file,"./perlpipe_%08.8x_%d.com",mypid,index); - fp = fopen(file,"w"); - } + sprintf(file,"/sys$login/perlpipe_%08.8x_%d.com",mypid,index); + fp = fopen(file,"w"); + if (!fp) { + sprintf(file,"./perlpipe_%08.8x_%d.com",mypid,index); + fp = fopen(file,"w"); + } } } if (!fp) return 0; /* we're hosed */ @@ -3896,7 +3896,7 @@ vmspipe_tempfile(pTHX) fclose(fp); if (DECC_FILENAME_UNIX_ONLY) - int_tounixspec(file, file, NULL); + int_tounixspec(file, file, NULL); fp = fopen(file,"r","shr=get"); if (!fp) return 0; fstat(fileno(fp), &s1.crtl_stat); @@ -3936,7 +3936,7 @@ vms_is_syscommand_xterm(void) items[1].code = 0; status = sys$getdviw - (NO_EFN, 0, &decwdisplay_dsc, items, dvi_iosb, NULL, NULL, NULL); + (NO_EFN, 0, &decwdisplay_dsc, items, dvi_iosb, NULL, NULL, NULL); if ($VMS_STATUS_SUCCESS(status)) { status = dvi_iosb[0]; @@ -3944,7 +3944,7 @@ vms_is_syscommand_xterm(void) if (!$VMS_STATUS_SUCCESS(status)) { SETERRNO(EVMSERR, status); - return -1; + return -1; } /* If it does, then for now assume that we are on a workstation */ @@ -3959,7 +3959,7 @@ vms_is_syscommand_xterm(void) items[1].code = 0; status = sys$getdviw - (NO_EFN, 0, &syscommand_dsc, items, dvi_iosb, NULL, NULL, NULL); + (NO_EFN, 0, &syscommand_dsc, items, dvi_iosb, NULL, NULL, NULL); if ($VMS_STATUS_SUCCESS(status)) { status = dvi_iosb[0]; @@ -3967,12 +3967,12 @@ vms_is_syscommand_xterm(void) if (!$VMS_STATUS_SUCCESS(status)) { SETERRNO(EVMSERR, status); - return -1; + return -1; } else { - if (devclass == DC$_TERM) { - return 0; - } + if (devclass == DC$_TERM) { + return 0; + } } return -1; } @@ -4009,75 +4009,75 @@ create_forked_xterm(pTHX_ const char *cmd, const char *mode) /* Make sure that this is from the Perl debugger */ ret_char = strstr(cmd," xterm "); if (ret_char == NULL) - return NULL; + return NULL; cptr = ret_char + 7; ret_char = strstr(cmd,"tty"); if (ret_char == NULL) - return NULL; + return NULL; ret_char = strstr(cmd,"sleep"); if (ret_char == NULL) - return NULL; + return NULL; if (decw_term_port == 0) { - $DESCRIPTOR(filename1_dsc, "DECW$TERMINALSHR12"); - $DESCRIPTOR(filename2_dsc, "DECW$TERMINALSHR"); - $DESCRIPTOR(decw_term_port_dsc, "DECW$TERM_PORT"); + $DESCRIPTOR(filename1_dsc, "DECW$TERMINALSHR12"); + $DESCRIPTOR(filename2_dsc, "DECW$TERMINALSHR"); + $DESCRIPTOR(decw_term_port_dsc, "DECW$TERM_PORT"); status = lib$find_image_symbol - (&filename1_dsc, - &decw_term_port_dsc, - (void *)&decw_term_port, - NULL, - 0); + (&filename1_dsc, + &decw_term_port_dsc, + (void *)&decw_term_port, + NULL, + 0); - /* Try again with the other image name */ - if (!$VMS_STATUS_SUCCESS(status)) { + /* Try again with the other image name */ + if (!$VMS_STATUS_SUCCESS(status)) { status = lib$find_image_symbol - (&filename2_dsc, - &decw_term_port_dsc, - (void *)&decw_term_port, - NULL, - 0); + (&filename2_dsc, + &decw_term_port_dsc, + (void *)&decw_term_port, + NULL, + 0); - } + } } /* No decw$term_port, give it up */ if (!$VMS_STATUS_SUCCESS(status)) - return NULL; + return NULL; /* Are we on a workstation? */ /* to do: capture the rows / columns and pass their properties */ ret_stat = vms_is_syscommand_xterm(); if (ret_stat < 0) - return NULL; + return NULL; /* Make the title: */ ret_char = strstr(cptr,"-title"); if (ret_char != NULL) { - while ((*cptr != 0) && (*cptr != '\"')) { - cptr++; - } - if (*cptr == '\"') - cptr++; - n = 0; - while ((*cptr != 0) && (*cptr != '\"')) { - title[n] = *cptr; - n++; - if (n == 39) { - title[39] = 0; - break; - } - cptr++; - } - title[n] = 0; + while ((*cptr != 0) && (*cptr != '\"')) { + cptr++; + } + if (*cptr == '\"') + cptr++; + n = 0; + while ((*cptr != 0) && (*cptr != '\"')) { + title[n] = *cptr; + n++; + if (n == 39) { + title[39] = 0; + break; + } + cptr++; + } + title[n] = 0; } else { - /* Default title */ - strcpy(title,"Perl Debug DECTerm"); + /* Default title */ + strcpy(title,"Perl Debug DECTerm"); } sprintf(customization, cust_str, title); @@ -4096,16 +4096,16 @@ create_forked_xterm(pTHX_ const char *cmd, const char *mode) /* Try to create the window */ status = (*decw_term_port) (NULL, - NULL, - &customization_dsc, - &device_name_dsc, - &device_name_len, - NULL, - NULL, - NULL); + NULL, + &customization_dsc, + &device_name_dsc, + &device_name_len, + NULL, + NULL, + NULL); if (!$VMS_STATUS_SUCCESS(status)) { SETERRNO(EVMSERR, status); - return NULL; + return NULL; } device_name[device_name_len] = '\0'; @@ -4141,7 +4141,7 @@ create_forked_xterm(pTHX_ const char *cmd, const char *mode) status = sys$assign(&device_name_dsc,&info->xchan,0,0); if (!$VMS_STATUS_SUCCESS(status)) { SETERRNO(EVMSERR, status); - return NULL; + return NULL; } info->xchan_valid = 1; @@ -4155,7 +4155,7 @@ create_forked_xterm(pTHX_ const char *cmd, const char *mode) if (!$VMS_STATUS_SUCCESS(status)) { SETERRNO(EVMSERR, status); - return NULL; + return NULL; } info->fp = PerlIO_open(mbx1, mode); @@ -4165,9 +4165,9 @@ create_forked_xterm(pTHX_ const char *cmd, const char *mode) /* If any errors, then clean up */ if (!info->fp) { - n = sizeof(Info); - _ckvmssts_noperl(lib$free_vm(&n, &info)); - return NULL; + n = sizeof(Info); + _ckvmssts_noperl(lib$free_vm(&n, &info)); + return NULL; } /* All done */ @@ -4218,9 +4218,9 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) xterm_fd = NULL; if (aTHX != NULL) #endif - xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode); - if (xterm_fd != NULL) - return xterm_fd; + xterm_fd = create_forked_xterm(aTHX_ cmd, in_mode); + if (xterm_fd != NULL) + return xterm_fd; } if (!head_PLOC) store_pipelocs(aTHX); /* at least TRY to use a static vmspipe file */ @@ -4344,7 +4344,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) info->out->info = info; } if (!info->useFILE) { - info->fp = PerlIO_open(mbx, mode); + info->fp = PerlIO_open(mbx, mode); } else { info->fp = (PerlIO *) freopen(mbx, mode, stdin); vmssetuserlnm("SYS$INPUT", mbx); @@ -4399,7 +4399,7 @@ safe_popen(pTHX_ const char *cmd, const char *in_mode, int *psts) info->in = pipe_tochild_setup(aTHX_ in,mbx); if (!info->useFILE) { - info->fp = PerlIO_open(mbx, mode); + info->fp = PerlIO_open(mbx, mode); } else { info->fp = (PerlIO *) freopen(mbx, mode, stdout); vmssetuserlnm("SYS$OUTPUT", mbx); @@ -4906,21 +4906,21 @@ rms_free_search_context(struct FAB * fab) #define rms_nam_rsl(nam) nam.nam$b_rsl #define rms_bind_fab_nam(fab, nam) fab.fab$l_nam = &nam #define rms_set_fna(fab, nam, name, size) \ - { fab.fab$b_fns = size; fab.fab$l_fna = name; } + { fab.fab$b_fns = size; fab.fab$l_fna = name; } #define rms_get_fna(fab, nam) fab.fab$l_fna #define rms_set_dna(fab, nam, name, size) \ - { fab.fab$b_dns = size; fab.fab$l_dna = name; } + { fab.fab$b_dns = size; fab.fab$l_dna = name; } #define rms_nam_dns(fab, nam) fab.fab$b_dns #define rms_set_esa(nam, name, size) \ - { nam.nam$b_ess = size; nam.nam$l_esa = name; } + { nam.nam$b_ess = size; nam.nam$l_esa = name; } #define rms_set_esal(nam, s_name, s_size, l_name, l_size) \ - { nam.nam$l_esa = s_name; nam.nam$b_ess = s_size;} + { nam.nam$l_esa = s_name; nam.nam$b_ess = s_size;} #define rms_set_rsa(nam, name, size) \ - { nam.nam$l_rsa = name; nam.nam$b_rss = size; } + { nam.nam$l_rsa = name; nam.nam$b_rss = size; } #define rms_set_rsal(nam, s_name, s_size, l_name, l_size) \ - { nam.nam$l_rsa = s_name; nam.nam$b_rss = s_size; } + { nam.nam$l_rsa = s_name; nam.nam$b_rss = s_size; } #define rms_nam_name_type_l_size(nam) \ - (nam.nam$b_name + nam.nam$b_type) + (nam.nam$b_name + nam.nam$b_type) #else static int rms_free_search_context(struct FAB * fab) @@ -4953,33 +4953,33 @@ rms_free_search_context(struct FAB * fab) #define rms_nam_rsl(nam) nam.naml$b_rsl #define rms_bind_fab_nam(fab, nam) fab.fab$l_naml = &nam #define rms_set_fna(fab, nam, name, size) \ - { fab.fab$b_fns = 0; fab.fab$l_fna = (char *) -1; \ - nam.naml$l_long_filename_size = size; \ - nam.naml$l_long_filename = name;} + { fab.fab$b_fns = 0; fab.fab$l_fna = (char *) -1; \ + nam.naml$l_long_filename_size = size; \ + nam.naml$l_long_filename = name;} #define rms_get_fna(fab, nam) nam.naml$l_long_filename #define rms_set_dna(fab, nam, name, size) \ - { fab.fab$b_dns = 0; fab.fab$l_dna = (char *) -1; \ - nam.naml$l_long_defname_size = size; \ - nam.naml$l_long_defname = name; } + { fab.fab$b_dns = 0; fab.fab$l_dna = (char *) -1; \ + nam.naml$l_long_defname_size = size; \ + nam.naml$l_long_defname = name; } #define rms_nam_dns(fab, nam) nam.naml$l_long_defname_size #define rms_set_esa(nam, name, size) \ - { nam.naml$b_ess = 0; nam.naml$l_esa = (char *) -1; \ - nam.naml$l_long_expand_alloc = size; \ - nam.naml$l_long_expand = name; } + { nam.naml$b_ess = 0; nam.naml$l_esa = (char *) -1; \ + nam.naml$l_long_expand_alloc = size; \ + nam.naml$l_long_expand = name; } #define rms_set_esal(nam, s_name, s_size, l_name, l_size) \ - { nam.naml$l_esa = s_name; nam.naml$b_ess = s_size; \ - nam.naml$l_long_expand = l_name; \ - nam.naml$l_long_expand_alloc = l_size; } + { nam.naml$l_esa = s_name; nam.naml$b_ess = s_size; \ + nam.naml$l_long_expand = l_name; \ + nam.naml$l_long_expand_alloc = l_size; } #define rms_set_rsa(nam, name, size) \ - { nam.naml$l_rsa = NULL; nam.naml$b_rss = 0; \ - nam.naml$l_long_result = name; \ - nam.naml$l_long_result_alloc = size; } + { nam.naml$l_rsa = NULL; nam.naml$b_rss = 0; \ + nam.naml$l_long_result = name; \ + nam.naml$l_long_result_alloc = size; } #define rms_set_rsal(nam, s_name, s_size, l_name, l_size) \ - { nam.naml$l_rsa = s_name; nam.naml$b_rss = s_size; \ - nam.naml$l_long_result = l_name; \ - nam.naml$l_long_result_alloc = l_size; } + { nam.naml$l_rsa = s_name; nam.naml$b_rss = s_size; \ + nam.naml$l_long_result = l_name; \ + nam.naml$l_long_result_alloc = l_size; } #define rms_nam_name_type_l_size(nam) \ - (nam.naml$l_long_name_size + nam.naml$l_long_type_size) + (nam.naml$l_long_name_size + nam.naml$l_long_type_size) #endif @@ -5010,8 +5010,8 @@ rms_erase(const char * vmsname) static int vms_rename_with_acl(pTHX_ const struct dsc$descriptor_s * vms_src_dsc, - const struct dsc$descriptor_s * vms_dst_dsc, - unsigned long flags) + const struct dsc$descriptor_s * vms_dst_dsc, + unsigned long flags) { /* VMS and UNIX handle file permissions differently and * the same ACL trick may be needed for renaming files, @@ -5039,31 +5039,31 @@ vms_rename_with_acl(pTHX_ const struct dsc$descriptor_s * vms_src_dsc, unsigned long int myace$l_access; unsigned long int myace$l_ident; } newace = { sizeof(struct myacedef), ACE$C_KEYID, 0, - ACE$M_READ | ACE$M_WRITE | ACE$M_DELETE | ACE$M_CONTROL, - 0}, - oldace = { sizeof(struct myacedef), ACE$C_KEYID, 0, 0, 0}; + ACE$M_READ | ACE$M_WRITE | ACE$M_DELETE | ACE$M_CONTROL, + 0}, + oldace = { sizeof(struct myacedef), ACE$C_KEYID, 0, 0, 0}; struct item_list_3 - findlst[3] = {{sizeof oldace, OSS$_ACL_FIND_ENTRY, &oldace, 0}, - {sizeof oldace, OSS$_ACL_READ_ENTRY, &oldace, 0}, - {0,0,0,0}}, - addlst[2] = {{sizeof newace, OSS$_ACL_ADD_ENTRY, &newace, 0},{0,0,0,0}}, - dellst[2] = {{sizeof newace, OSS$_ACL_DELETE_ENTRY, &newace, 0}, - {0,0,0,0}}; + findlst[3] = {{sizeof oldace, OSS$_ACL_FIND_ENTRY, &oldace, 0}, + {sizeof oldace, OSS$_ACL_READ_ENTRY, &oldace, 0}, + {0,0,0,0}}, + addlst[2] = {{sizeof newace, OSS$_ACL_ADD_ENTRY, &newace, 0},{0,0,0,0}}, + dellst[2] = {{sizeof newace, OSS$_ACL_DELETE_ENTRY, &newace, 0}, + {0,0,0,0}}; /* Expand the input spec using RMS, since we do not want to put * ACLs on the target of a symbolic link */ vmsname = (char *)PerlMem_malloc(NAM$C_MAXRSS+1); if (vmsname == NULL) - return SS$_INSFMEM; + return SS$_INSFMEM; rslt = int_rmsexpand_tovms(vms_src_dsc->dsc$a_pointer, - vmsname, - PERL_RMSEXPAND_M_SYMLINK); + vmsname, + PERL_RMSEXPAND_M_SYMLINK); if (rslt == NULL) { - PerlMem_free(vmsname); - return SS$_INSFMEM; + PerlMem_free(vmsname); + return SS$_INSFMEM; } /* So we get our own UIC to use as a rights identifier, @@ -5081,91 +5081,91 @@ vms_rename_with_acl(pTHX_ const struct dsc$descriptor_s * vms_src_dsc, /* Grab any existing ACEs with this identifier in case we fail */ clean_dsc = &fildsc; aclsts = fndsts = sys$get_security(&obj_file_dsc, - &fildsc, - NULL, - OSS$M_WLOCK, - findlst, - &ctx, - &access_mode); + &fildsc, + NULL, + OSS$M_WLOCK, + findlst, + &ctx, + &access_mode); if ($VMS_STATUS_SUCCESS(fndsts) || (fndsts == SS$_ACLEMPTY)) { - /* Add the new ACE . . . */ - - /* if the sys$get_security succeeded, then ctx is valid, and the - * object/file descriptors will be ignored. But otherwise they - * are needed - */ - aclsts = sys$set_security(&obj_file_dsc, &fildsc, NULL, - OSS$M_RELCTX, addlst, &ctx, &access_mode); - if (!$VMS_STATUS_SUCCESS(aclsts) && (aclsts != SS$_NOCLASS)) { - set_errno(EVMSERR); - set_vaxc_errno(aclsts); - PerlMem_free(vmsname); - return aclsts; - } - - rnsts = lib$rename_file(vms_src_dsc, vms_dst_dsc, - NULL, NULL, - &flags, - NULL, NULL, NULL, NULL, NULL, NULL, NULL); - - if ($VMS_STATUS_SUCCESS(rnsts)) { - clean_dsc = (struct dsc$descriptor_s *)vms_dst_dsc; - } - - /* Put things back the way they were. */ - ctx = 0; - aclsts = sys$get_security(&obj_file_dsc, - clean_dsc, - NULL, - OSS$M_WLOCK, - findlst, - &ctx, - &access_mode); - - if ($VMS_STATUS_SUCCESS(aclsts)) { - int sec_flags; - - sec_flags = 0; - if (!$VMS_STATUS_SUCCESS(fndsts)) - sec_flags = OSS$M_RELCTX; - - /* Get rid of the new ACE */ - aclsts = sys$set_security(NULL, NULL, NULL, - sec_flags, dellst, &ctx, &access_mode); - - /* If there was an old ACE, put it back */ - if ($VMS_STATUS_SUCCESS(aclsts) && $VMS_STATUS_SUCCESS(fndsts)) { - addlst[0].bufadr = &oldace; - aclsts = sys$set_security(NULL, NULL, NULL, - OSS$M_RELCTX, addlst, &ctx, &access_mode); - if (!$VMS_STATUS_SUCCESS(aclsts) && (aclsts != SS$_NOCLASS)) { - set_errno(EVMSERR); - set_vaxc_errno(aclsts); - rnsts = aclsts; - } - } else { - int aclsts2; - - /* Try to clear the lock on the ACL list */ - aclsts2 = sys$set_security(NULL, NULL, NULL, - OSS$M_RELCTX, NULL, &ctx, &access_mode); - - /* Rename errors are most important */ - if (!$VMS_STATUS_SUCCESS(rnsts)) - aclsts = rnsts; - set_errno(EVMSERR); - set_vaxc_errno(aclsts); - rnsts = aclsts; - } - } - else { - if (aclsts != SS$_ACLEMPTY) - rnsts = aclsts; - } + /* Add the new ACE . . . */ + + /* if the sys$get_security succeeded, then ctx is valid, and the + * object/file descriptors will be ignored. But otherwise they + * are needed + */ + aclsts = sys$set_security(&obj_file_dsc, &fildsc, NULL, + OSS$M_RELCTX, addlst, &ctx, &access_mode); + if (!$VMS_STATUS_SUCCESS(aclsts) && (aclsts != SS$_NOCLASS)) { + set_errno(EVMSERR); + set_vaxc_errno(aclsts); + PerlMem_free(vmsname); + return aclsts; + } + + rnsts = lib$rename_file(vms_src_dsc, vms_dst_dsc, + NULL, NULL, + &flags, + NULL, NULL, NULL, NULL, NULL, NULL, NULL); + + if ($VMS_STATUS_SUCCESS(rnsts)) { + clean_dsc = (struct dsc$descriptor_s *)vms_dst_dsc; + } + + /* Put things back the way they were. */ + ctx = 0; + aclsts = sys$get_security(&obj_file_dsc, + clean_dsc, + NULL, + OSS$M_WLOCK, + findlst, + &ctx, + &access_mode); + + if ($VMS_STATUS_SUCCESS(aclsts)) { + int sec_flags; + + sec_flags = 0; + if (!$VMS_STATUS_SUCCESS(fndsts)) + sec_flags = OSS$M_RELCTX; + + /* Get rid of the new ACE */ + aclsts = sys$set_security(NULL, NULL, NULL, + sec_flags, dellst, &ctx, &access_mode); + + /* If there was an old ACE, put it back */ + if ($VMS_STATUS_SUCCESS(aclsts) && $VMS_STATUS_SUCCESS(fndsts)) { + addlst[0].bufadr = &oldace; + aclsts = sys$set_security(NULL, NULL, NULL, + OSS$M_RELCTX, addlst, &ctx, &access_mode); + if (!$VMS_STATUS_SUCCESS(aclsts) && (aclsts != SS$_NOCLASS)) { + set_errno(EVMSERR); + set_vaxc_errno(aclsts); + rnsts = aclsts; + } + } else { + int aclsts2; + + /* Try to clear the lock on the ACL list */ + aclsts2 = sys$set_security(NULL, NULL, NULL, + OSS$M_RELCTX, NULL, &ctx, &access_mode); + + /* Rename errors are most important */ + if (!$VMS_STATUS_SUCCESS(rnsts)) + aclsts = rnsts; + set_errno(EVMSERR); + set_vaxc_errno(aclsts); + rnsts = aclsts; + } + } + else { + if (aclsts != SS$_ACLEMPTY) + rnsts = aclsts; + } } else - rnsts = fndsts; + rnsts = fndsts; PerlMem_free(vmsname); return rnsts; @@ -5191,8 +5191,8 @@ Perl_rename(pTHX_ const char *src, const char * dst) src_sts = flex_lstat(src, &src_st); if (src_sts != 0) { - /* No source file or other problem */ - return src_sts; + /* No source file or other problem */ + return src_sts; } if (src_st.st_devnam[0] == 0) { /* This may be possible so fail if it is seen. */ @@ -5203,49 +5203,49 @@ Perl_rename(pTHX_ const char *src, const char * dst) dst_sts = flex_lstat(dst, &dst_st); if (dst_sts == 0) { - if (dst_st.st_dev != src_st.st_dev) { - /* Must be on the same device */ - errno = EXDEV; - return -1; - } + if (dst_st.st_dev != src_st.st_dev) { + /* Must be on the same device */ + errno = EXDEV; + return -1; + } - /* VMS_INO_T_COMPARE is true if the inodes are different - * to match the output of memcmp - */ + /* VMS_INO_T_COMPARE is true if the inodes are different + * to match the output of memcmp + */ - if (!VMS_INO_T_COMPARE(src_st.st_ino, dst_st.st_ino)) { - /* That was easy, the files are the same! */ - return 0; - } + if (!VMS_INO_T_COMPARE(src_st.st_ino, dst_st.st_ino)) { + /* That was easy, the files are the same! */ + return 0; + } - if (S_ISDIR(src_st.st_mode) && !S_ISDIR(dst_st.st_mode)) { - /* If source is a directory, so must be dest */ - errno = EISDIR; - return -1; - } + if (S_ISDIR(src_st.st_mode) && !S_ISDIR(dst_st.st_mode)) { + /* If source is a directory, so must be dest */ + errno = EISDIR; + return -1; + } } if ((dst_sts == 0) && - (vms_unlink_all_versions || S_ISDIR(dst_st.st_mode))) { - - /* We have issues here if vms_unlink_all_versions is set - * If the destination exists, and is not a directory, then - * we must delete in advance. - * - * If the src is a directory, then we must always pre-delete - * the destination. - * - * If we successfully delete the dst in advance, and the rename fails - * X/Open requires that errno be EIO. - * - */ - - if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) { - int d_sts; - d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, - S_ISDIR(dst_st.st_mode)); + (vms_unlink_all_versions || S_ISDIR(dst_st.st_mode))) { + + /* We have issues here if vms_unlink_all_versions is set + * If the destination exists, and is not a directory, then + * we must delete in advance. + * + * If the src is a directory, then we must always pre-delete + * the destination. + * + * If we successfully delete the dst in advance, and the rename fails + * X/Open requires that errno be EIO. + * + */ + + if (!S_ISDIR(dst_st.st_mode) || S_ISDIR(src_st.st_mode)) { + int d_sts; + d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, + S_ISDIR(dst_st.st_mode)); /* Need to delete all versions ? */ if ((d_sts == 0) && (vms_unlink_all_versions == 1)) { @@ -5266,12 +5266,12 @@ Perl_rename(pTHX_ const char *src, const char * dst) } } - if (d_sts != 0) - return d_sts; + if (d_sts != 0) + return d_sts; - /* We killed the destination, so only errno now is EIO */ - pre_delete = 1; - } + /* We killed the destination, so only errno now is EIO */ + pre_delete = 1; + } } /* Originally the idea was to call the CRTL rename() and only @@ -5282,171 +5282,171 @@ Perl_rename(pTHX_ const char *src, const char * dst) retval = -1; { - /* Is the source and dest both in VMS format */ - /* if the source is a directory, then need to fileify */ - /* and dest must be a directory or non-existent. */ - - char * vms_dst; - int sts; - char * ret_str; - unsigned long flags; - struct dsc$descriptor_s old_file_dsc; - struct dsc$descriptor_s new_file_dsc; - - /* We need to modify the src and dst depending - * on if one or more of them are directories. - */ - - vms_dst = (char *)PerlMem_malloc(VMS_MAXRSS); - if (vms_dst == NULL) - _ckvmssts_noperl(SS$_INSFMEM); - - if (S_ISDIR(src_st.st_mode)) { - char * ret_str; - char * vms_dir_file; - - vms_dir_file = (char *)PerlMem_malloc(VMS_MAXRSS); - if (vms_dir_file == NULL) - _ckvmssts_noperl(SS$_INSFMEM); - - /* If the dest is a directory, we must remove it */ - if (dst_sts == 0) { - int d_sts; - d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 1); - if (d_sts != 0) { - PerlMem_free(vms_dst); - errno = EIO; - return d_sts; - } - - pre_delete = 1; - } - - /* The dest must be a VMS file specification */ - ret_str = int_tovmsspec(dst, vms_dst, 0, NULL); - if (ret_str == NULL) { - PerlMem_free(vms_dst); - errno = EIO; - return -1; - } - - /* The source must be a file specification */ - ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL); - if (ret_str == NULL) { - PerlMem_free(vms_dst); - PerlMem_free(vms_dir_file); - errno = EIO; - return -1; - } - PerlMem_free(vms_dst); - vms_dst = vms_dir_file; - - } else { - /* File to file or file to new dir */ - - if ((dst_sts == 0) && S_ISDIR(dst_st.st_mode)) { - /* VMS pathify a dir target */ - ret_str = int_tovmspath(dst, vms_dst, NULL); - if (ret_str == NULL) { - PerlMem_free(vms_dst); - errno = EIO; - return -1; - } - } else { + /* Is the source and dest both in VMS format */ + /* if the source is a directory, then need to fileify */ + /* and dest must be a directory or non-existent. */ + + char * vms_dst; + int sts; + char * ret_str; + unsigned long flags; + struct dsc$descriptor_s old_file_dsc; + struct dsc$descriptor_s new_file_dsc; + + /* We need to modify the src and dst depending + * on if one or more of them are directories. + */ + + vms_dst = (char *)PerlMem_malloc(VMS_MAXRSS); + if (vms_dst == NULL) + _ckvmssts_noperl(SS$_INSFMEM); + + if (S_ISDIR(src_st.st_mode)) { + char * ret_str; + char * vms_dir_file; + + vms_dir_file = (char *)PerlMem_malloc(VMS_MAXRSS); + if (vms_dir_file == NULL) + _ckvmssts_noperl(SS$_INSFMEM); + + /* If the dest is a directory, we must remove it */ + if (dst_sts == 0) { + int d_sts; + d_sts = mp_do_kill_file(aTHX_ dst_st.st_devnam, 1); + if (d_sts != 0) { + PerlMem_free(vms_dst); + errno = EIO; + return d_sts; + } + + pre_delete = 1; + } + + /* The dest must be a VMS file specification */ + ret_str = int_tovmsspec(dst, vms_dst, 0, NULL); + if (ret_str == NULL) { + PerlMem_free(vms_dst); + errno = EIO; + return -1; + } + + /* The source must be a file specification */ + ret_str = do_fileify_dirspec(vms_dst, vms_dir_file, 0, NULL); + if (ret_str == NULL) { + PerlMem_free(vms_dst); + PerlMem_free(vms_dir_file); + errno = EIO; + return -1; + } + PerlMem_free(vms_dst); + vms_dst = vms_dir_file; + + } else { + /* File to file or file to new dir */ + + if ((dst_sts == 0) && S_ISDIR(dst_st.st_mode)) { + /* VMS pathify a dir target */ + ret_str = int_tovmspath(dst, vms_dst, NULL); + if (ret_str == NULL) { + PerlMem_free(vms_dst); + errno = EIO; + return -1; + } + } else { char * v_spec, * r_spec, * d_spec, * n_spec; char * e_spec, * vs_spec; int sts, v_len, r_len, d_len, n_len, e_len, vs_len; - /* fileify a target VMS file specification */ - ret_str = int_tovmsspec(dst, vms_dst, 0, NULL); - if (ret_str == NULL) { - PerlMem_free(vms_dst); - errno = EIO; - return -1; - } + /* fileify a target VMS file specification */ + ret_str = int_tovmsspec(dst, vms_dst, 0, NULL); + if (ret_str == NULL) { + PerlMem_free(vms_dst); + errno = EIO; + return -1; + } - sts = vms_split_path(vms_dst, &v_spec, &v_len, &r_spec, &r_len, + sts = vms_split_path(vms_dst, &v_spec, &v_len, &r_spec, &r_len, &d_spec, &d_len, &n_spec, &n_len, &e_spec, &e_len, &vs_spec, &vs_len); - if (sts == 0) { - if (e_len == 0) { - /* Get rid of the version */ - if (vs_len != 0) { - *vs_spec = '\0'; - } - /* Need to specify a '.' so that the extension */ - /* is not inherited */ - strcat(vms_dst,"."); - } - } - } - } - - old_file_dsc.dsc$a_pointer = src_st.st_devnam; - old_file_dsc.dsc$w_length = strlen(src_st.st_devnam); - old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T; - old_file_dsc.dsc$b_class = DSC$K_CLASS_S; - - new_file_dsc.dsc$a_pointer = vms_dst; - new_file_dsc.dsc$w_length = strlen(vms_dst); - new_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T; - new_file_dsc.dsc$b_class = DSC$K_CLASS_S; - - flags = 0; + if (sts == 0) { + if (e_len == 0) { + /* Get rid of the version */ + if (vs_len != 0) { + *vs_spec = '\0'; + } + /* Need to specify a '.' so that the extension */ + /* is not inherited */ + strcat(vms_dst,"."); + } + } + } + } + + old_file_dsc.dsc$a_pointer = src_st.st_devnam; + old_file_dsc.dsc$w_length = strlen(src_st.st_devnam); + old_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T; + old_file_dsc.dsc$b_class = DSC$K_CLASS_S; + + new_file_dsc.dsc$a_pointer = vms_dst; + new_file_dsc.dsc$w_length = strlen(vms_dst); + new_file_dsc.dsc$b_dtype = DSC$K_DTYPE_T; + new_file_dsc.dsc$b_class = DSC$K_CLASS_S; + + flags = 0; #if defined(NAML$C_MAXRSS) - flags |= 4; /* LIB$M_FIL_LONG_NAMES (bit 2) */ + flags |= 4; /* LIB$M_FIL_LONG_NAMES (bit 2) */ #endif - sts = lib$rename_file(&old_file_dsc, - &new_file_dsc, - NULL, NULL, - &flags, - NULL, NULL, NULL, NULL, NULL, NULL, NULL); - if (!$VMS_STATUS_SUCCESS(sts)) { - - /* We could have failed because VMS style permissions do not - * permit renames that UNIX will allow. Just like the hack - * in for kill_file. - */ - sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags); - } + sts = lib$rename_file(&old_file_dsc, + &new_file_dsc, + NULL, NULL, + &flags, + NULL, NULL, NULL, NULL, NULL, NULL, NULL); + if (!$VMS_STATUS_SUCCESS(sts)) { + + /* We could have failed because VMS style permissions do not + * permit renames that UNIX will allow. Just like the hack + * in for kill_file. + */ + sts = vms_rename_with_acl(aTHX_ &old_file_dsc, &new_file_dsc, flags); + } - PerlMem_free(vms_dst); - if (!$VMS_STATUS_SUCCESS(sts)) { - errno = EIO; - return -1; - } - retval = 0; + PerlMem_free(vms_dst); + if (!$VMS_STATUS_SUCCESS(sts)) { + errno = EIO; + return -1; + } + retval = 0; } if (vms_unlink_all_versions) { - /* Now get rid of any previous versions of the source file that - * might still exist - */ - int i = 0; - dSAVEDERRNO; - SAVE_ERRNO; - src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam, - S_ISDIR(src_st.st_mode)); - while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) { - src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam, - S_ISDIR(src_st.st_mode)); - if (src_sts != 0) - break; - i++; - - /* Make sure that we do not loop forever */ - if (i > 32767) { - src_sts = -1; - break; - } - } - RESTORE_ERRNO; + /* Now get rid of any previous versions of the source file that + * might still exist + */ + int i = 0; + dSAVEDERRNO; + SAVE_ERRNO; + src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam, + S_ISDIR(src_st.st_mode)); + while (lstat(src_st.st_devnam, &src_st.crtl_stat) == 0) { + src_sts = mp_do_kill_file(aTHX_ src_st.st_devnam, + S_ISDIR(src_st.st_mode)); + if (src_sts != 0) + break; + i++; + + /* Make sure that we do not loop forever */ + if (i > 32767) { + src_sts = -1; + break; + } + } + RESTORE_ERRNO; } /* We deleted the destination, so must force the error to be EIO */ if ((retval != 0) && (pre_delete != 0)) - errno = EIO; + errno = EIO; return retval; } @@ -5620,14 +5620,14 @@ int_rmsexpand /*----------------------------------------------*/ sts = rms_free_search_context(&myfab); /* Free search context */ if (vmsdefspec != NULL) - PerlMem_free(vmsdefspec); + PerlMem_free(vmsdefspec); if (vmsfspec != NULL) - PerlMem_free(vmsfspec); + PerlMem_free(vmsfspec); if (outbufl != NULL) - PerlMem_free(outbufl); + PerlMem_free(outbufl); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); else if (retsts == RMS$_DEV) set_errno(ENODEV); @@ -5639,14 +5639,14 @@ int_rmsexpand if (!(retsts & STS$K_SUCCESS) && retsts != RMS$_FNF) { sts = rms_free_search_context(&myfab); /* Free search context */ if (vmsdefspec != NULL) - PerlMem_free(vmsdefspec); + PerlMem_free(vmsdefspec); if (vmsfspec != NULL) - PerlMem_free(vmsfspec); + PerlMem_free(vmsfspec); if (outbufl != NULL) - PerlMem_free(outbufl); + PerlMem_free(outbufl); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); set_vaxc_errno(retsts); if (retsts == RMS$_PRV) set_errno(EACCES); else set_errno(EVMSERR); @@ -5668,23 +5668,23 @@ int_rmsexpand #if defined(NAML$C_MAXRSS) if ((opts & PERL_RMSEXPAND_M_LONG) != 0) { if (rms_nam_rsll(mynam)) { - spec_buf = outbufl; - speclen = rms_nam_rsll(mynam); + spec_buf = outbufl; + speclen = rms_nam_rsll(mynam); } else { - spec_buf = esal; /* Not esa */ - speclen = rms_nam_esll(mynam); + spec_buf = esal; /* Not esa */ + speclen = rms_nam_esll(mynam); } } else { #endif if (rms_nam_rsl(mynam)) { - spec_buf = outbuf; - speclen = rms_nam_rsl(mynam); + spec_buf = outbuf; + speclen = rms_nam_rsl(mynam); } else { - spec_buf = esa; /* Not esal */ - speclen = rms_nam_esl(mynam); + spec_buf = esa; /* Not esal */ + speclen = rms_nam_esl(mynam); } #if defined(NAML$C_MAXRSS) } @@ -5715,69 +5715,69 @@ int_rmsexpand defesal = (char *)PerlMem_malloc(VMS_MAXRSS + 1); if (defesal == NULL) _ckvmssts_noperl(SS$_INSFMEM); #endif - rms_setup_nam(defnam); + rms_setup_nam(defnam); - rms_bind_fab_nam(deffab, defnam); + rms_bind_fab_nam(deffab, defnam); - /* Cast ok */ - rms_set_fna - (deffab, defnam, (char *)defspec, rms_nam_dns(myfab, mynam)); + /* Cast ok */ + rms_set_fna + (deffab, defnam, (char *)defspec, rms_nam_dns(myfab, mynam)); - /* RMS needs the esa/esal as a work area if wildcards are involved */ - rms_set_esal(defnam, defesa, NAM$C_MAXRSS, defesal, VMS_MAXRSS - 1); + /* RMS needs the esa/esal as a work area if wildcards are involved */ + rms_set_esal(defnam, defesa, NAM$C_MAXRSS, defesal, VMS_MAXRSS - 1); - rms_clear_nam_nop(defnam); - rms_set_nam_nop(defnam, NAM$M_SYNCHK); + rms_clear_nam_nop(defnam); + rms_set_nam_nop(defnam, NAM$M_SYNCHK); #ifdef NAM$M_NO_SHORT_UPCASE - if (DECC_EFS_CASE_PRESERVE) - rms_set_nam_nop(defnam, NAM$M_NO_SHORT_UPCASE); + if (DECC_EFS_CASE_PRESERVE) + rms_set_nam_nop(defnam, NAM$M_NO_SHORT_UPCASE); #endif #ifdef NAML$M_OPEN_SPECIAL - if ((opts & PERL_RMSEXPAND_M_SYMLINK) != 0) - rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL); + if ((opts & PERL_RMSEXPAND_M_SYMLINK) != 0) + rms_set_nam_nop(mynam, NAML$M_OPEN_SPECIAL); #endif - if (sys$parse(&deffab,0,0) & STS$K_SUCCESS) { - if (trimver) { - trimver = !rms_is_nam_fnb(defnam, NAM$M_EXP_VER); - } - if (trimtype) { - trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE); - } - } - if (defesal != NULL) - PerlMem_free(defesal); - PerlMem_free(defesa); + if (sys$parse(&deffab,0,0) & STS$K_SUCCESS) { + if (trimver) { + trimver = !rms_is_nam_fnb(defnam, NAM$M_EXP_VER); + } + if (trimtype) { + trimtype = !rms_is_nam_fnb(defnam, NAM$M_EXP_TYPE); + } + } + if (defesal != NULL) + PerlMem_free(defesal); + PerlMem_free(defesa); } else { _ckvmssts_noperl(SS$_INSFMEM); } } if (trimver) { if ((opts & PERL_RMSEXPAND_M_LONG) != 0) { - if (*(rms_nam_verl(mynam)) != '\"') - speclen = rms_nam_verl(mynam) - spec_buf; + if (*(rms_nam_verl(mynam)) != '\"') + speclen = rms_nam_verl(mynam) - spec_buf; } else { - if (*(rms_nam_ver(mynam)) != '\"') - speclen = rms_nam_ver(mynam) - spec_buf; + if (*(rms_nam_ver(mynam)) != '\"') + speclen = rms_nam_ver(mynam) - spec_buf; } } if (trimtype) { /* If we didn't already trim version, copy down */ if ((opts & PERL_RMSEXPAND_M_LONG) != 0) { - if (speclen > rms_nam_verl(mynam) - spec_buf) - memmove - (rms_nam_typel(mynam), - rms_nam_verl(mynam), - speclen - (rms_nam_verl(mynam) - spec_buf)); - speclen -= rms_nam_verl(mynam) - rms_nam_typel(mynam); + if (speclen > rms_nam_verl(mynam) - spec_buf) + memmove + (rms_nam_typel(mynam), + rms_nam_verl(mynam), + speclen - (rms_nam_verl(mynam) - spec_buf)); + speclen -= rms_nam_verl(mynam) - rms_nam_typel(mynam); } else { - if (speclen > rms_nam_ver(mynam) - spec_buf) - memmove - (rms_nam_type(mynam), - rms_nam_ver(mynam), - speclen - (rms_nam_ver(mynam) - spec_buf)); - speclen -= rms_nam_ver(mynam) - rms_nam_type(mynam); + if (speclen > rms_nam_ver(mynam) - spec_buf) + memmove + (rms_nam_type(mynam), + rms_nam_ver(mynam), + speclen - (rms_nam_ver(mynam) - spec_buf)); + speclen -= rms_nam_ver(mynam) - rms_nam_type(mynam); } } } @@ -5785,25 +5785,25 @@ int_rmsexpand /* Done with these copies of the input files */ /*-------------------------------------------*/ if (vmsfspec != NULL) - PerlMem_free(vmsfspec); + PerlMem_free(vmsfspec); if (vmsdefspec != NULL) - PerlMem_free(vmsdefspec); + PerlMem_free(vmsdefspec); /* If we just had a directory spec on input, $PARSE "helpfully" * adds an empty name and type for us */ #if defined(NAML$C_MAXRSS) if ((opts & PERL_RMSEXPAND_M_LONG) != 0) { if (rms_nam_namel(mynam) == rms_nam_typel(mynam) && - rms_nam_verl(mynam) == rms_nam_typel(mynam) + 1 && - !(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME))) + rms_nam_verl(mynam) == rms_nam_typel(mynam) + 1 && + !(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME))) speclen = rms_nam_namel(mynam) - spec_buf; } else #endif { if (rms_nam_name(mynam) == rms_nam_type(mynam) && - rms_nam_ver(mynam) == rms_nam_ver(mynam) + 1 && - !(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME))) + rms_nam_ver(mynam) == rms_nam_ver(mynam) + 1 && + !(rms_is_nam_fnb(mynam, NAM$M_EXP_NAME))) speclen = rms_nam_name(mynam) - spec_buf; } @@ -6020,7 +6020,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) unsigned short int trnlnm_iter_count; int sts; if (utf8_fl != NULL) - *utf8_fl = 0; + *utf8_fl = 0; if (!dir || !*dir) { set_errno(EINVAL); set_vaxc_errno(SS$_BADPARAM); return NULL; @@ -6033,7 +6033,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) dirlen = 9; } else - dirlen = 1; + dirlen = 1; } if (dirlen > (VMS_MAXRSS - 1)) { set_errno(ENAMETOOLONG); set_vaxc_errno(RMS$_SYN); @@ -6042,7 +6042,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) trndir = (char *)PerlMem_malloc(VMS_MAXRSS + 1); if (trndir == NULL) _ckvmssts_noperl(SS$_INSFMEM); if (!strpbrk(dir+1,"/]>:") && - (!DECC_POSIX_COMPLIANT_PATHNAMES && DECC_DISABLE_POSIX_ROOT)) { + (!DECC_POSIX_COMPLIANT_PATHNAMES && DECC_DISABLE_POSIX_ROOT)) { strcpy(trndir,*dir == '/' ? dir + 1: dir); trnlnm_iter_count = 0; while (!strpbrk(trndir,"/]>:") && simple_trnlnm(trndir,trndir,VMS_MAXRSS-1)) { @@ -6082,13 +6082,13 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) of explicit directories in a VMS spec which ends with directories. */ else { for (cp2 = cp1; cp2 > trndir; cp2--) { - if (*cp2 == '.') { - if ((cp2 - 1 > trndir) && (*(cp2 - 1) != '^')) { + if (*cp2 == '.') { + if ((cp2 - 1 > trndir) && (*(cp2 - 1) != '^')) { /* fix-me, can not scan EFS file specs backward like this */ *cp2 = *cp1; *cp1 = '\0'; hasfilename = 1; - break; - } + break; + } } if (*cp2 == '[' || *cp2 == '<') break; } @@ -6105,16 +6105,16 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) if (trndir[0] == '.') { if (trndir[1] == '\0' || (trndir[1] == '/' && trndir[2] == '\0')) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(trndir); + PerlMem_free(vmsdir); return int_fileify_dirspec("[]", buf, NULL); - } + } else if (trndir[1] == '.' && (trndir[2] == '\0' || (trndir[2] == '/' && trndir[3] == '\0'))) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(trndir); + PerlMem_free(vmsdir); return int_fileify_dirspec("[-]", buf, NULL); - } + } } if (dirlen && trndir[dirlen-1] == '/') { /* path ends with '/'; just add .dir;1 */ dirlen -= 1; /* to last element */ @@ -6127,31 +6127,31 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) do { if (*(cp1+2) == '.') cp1++; if (*(cp1+2) == '/' || *(cp1+2) == '\0') { - char * ret_chr; + char * ret_chr; if (int_tovmsspec(trndir, vmsdir, 0, utf8_fl) == NULL) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); - return NULL; - } + PerlMem_free(trndir); + PerlMem_free(vmsdir); + return NULL; + } if (strchr(vmsdir,'/') != NULL) { /* If int_tovmsspec() returned it, it must have VMS syntax * delimiters in it, so it's a mixed VMS/Unix spec. We take * the time to check this here only so we avoid a recursion * loop; otherwise, gigo. */ - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(trndir); + PerlMem_free(vmsdir); set_errno(EINVAL); set_vaxc_errno(RMS$_SYN); - return NULL; + return NULL; } if (int_fileify_dirspec(vmsdir, trndir, NULL) == NULL) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); - return NULL; - } - ret_chr = int_tounixspec(trndir, buf, utf8_fl); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(trndir); + PerlMem_free(vmsdir); + return NULL; + } + ret_chr = int_tounixspec(trndir, buf, utf8_fl); + PerlMem_free(trndir); + PerlMem_free(vmsdir); return ret_chr; } cp1++; @@ -6159,7 +6159,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) lastdir = strrchr(trndir,'/'); } else if (dirlen >= 7 && strEQ(&trndir[dirlen-7],"/000000")) { - char * ret_chr; + char * ret_chr; /* Ditto for specs that end in an MFD -- let the VMS code * figure out whether it's a real device or a rooted logical. */ @@ -6171,18 +6171,18 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) trndir[dirlen] = '/'; trndir[dirlen+1] = '\0'; if (int_tovmsspec(trndir, vmsdir, 0, NULL) == NULL) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); - return NULL; - } + PerlMem_free(trndir); + PerlMem_free(vmsdir); + return NULL; + } if (int_fileify_dirspec(vmsdir, trndir, NULL) == NULL) { - PerlMem_free(trndir); - PerlMem_free(vmsdir); - return NULL; - } - ret_chr = int_tounixspec(trndir, buf, utf8_fl); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(trndir); + PerlMem_free(vmsdir); + return NULL; + } + ret_chr = int_tounixspec(trndir, buf, utf8_fl); + PerlMem_free(trndir); + PerlMem_free(vmsdir); return ret_chr; } else { @@ -6230,7 +6230,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) memmove(cp4 + 1, cp4, trndir + dirlen - cp4 + 1); *cp4 = '^'; dirlen++; - } + } } } } @@ -6277,7 +6277,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) rms_set_esal(dirnam, esa, NAM$C_MAXRSS, esal, (VMS_MAXRSS - 1)); #ifdef NAM$M_NO_SHORT_UPCASE if (DECC_EFS_CASE_PRESERVE) - rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE); + rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE); #endif for (cp = trndir; *cp; cp++) @@ -6290,11 +6290,11 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) sts = sys$parse(&dirfab); } if (!sts) { - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(trndir); + PerlMem_free(vmsdir); set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts); return NULL; @@ -6302,7 +6302,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) } else { savnam = dirnam; - /* Does the file really exist? */ + /* Does the file really exist? */ if (sys$search(&dirfab)& STS$K_SUCCESS) { /* Yes; fake the fnb bits so we'll check type below */ rms_set_nam_fnb(dirnam, (NAM$M_EXP_TYPE | NAM$M_EXP_VER)); @@ -6313,14 +6313,14 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) || dirfab.fab$l_sts == RMS$_FND) dirnam = savnam; else { - int fab_sts; - fab_sts = dirfab.fab$l_sts; - sts = rms_free_search_context(&dirfab); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + int fab_sts; + fab_sts = dirfab.fab$l_sts; + sts = rms_free_search_context(&dirfab); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(trndir); + PerlMem_free(vmsdir); set_errno(EVMSERR); set_vaxc_errno(fab_sts); return NULL; } @@ -6330,11 +6330,11 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) /* Make sure we are using the right buffer */ #if defined(NAML$C_MAXRSS) if (esal != NULL) { - my_esa = esal; - my_esa_len = rms_nam_esll(dirnam); + my_esa = esal; + my_esa_len = rms_nam_esll(dirnam); } else { #endif - my_esa = esa; + my_esa = esa; my_esa_len = rms_nam_esl(dirnam); #if defined(NAML$C_MAXRSS) } @@ -6353,12 +6353,12 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) cmplen = rms_is_nam_fnb(dirnam, NAM$M_EXP_VER) ? 6 : 4; if (strnNE(rms_nam_typel(dirnam), ".DIR;1", cmplen)) { /* Something other than .DIR[;1]. Bzzt. */ - sts = rms_free_search_context(&dirfab); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + sts = rms_free_search_context(&dirfab); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(trndir); + PerlMem_free(vmsdir); set_errno(ENOTDIR); set_vaxc_errno(RMS$_DIR); return NULL; @@ -6368,12 +6368,12 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) if (rms_is_nam_fnb(dirnam, NAM$M_EXP_NAME)) { /* They provided at least the name; we added the type, if necessary, */ my_strlcpy(buf, my_esa, VMS_MAXRSS); - sts = rms_free_search_context(&dirfab); - PerlMem_free(trndir); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(vmsdir); + sts = rms_free_search_context(&dirfab); + PerlMem_free(trndir); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(vmsdir); return buf; } if ((cp1 = strstr(esa,".][000000]")) != NULL) { @@ -6383,12 +6383,12 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) } if ((cp1 = strrchr(my_esa,']')) == NULL) cp1 = strrchr(my_esa,'>'); if (cp1 == NULL) { /* should never happen */ - sts = rms_free_search_context(&dirfab); - PerlMem_free(trndir); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(vmsdir); + sts = rms_free_search_context(&dirfab); + PerlMem_free(trndir); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(vmsdir); return NULL; } term = *cp1; @@ -6399,14 +6399,14 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) /* Fix-me, can not scan EFS file specifications backwards */ while (cp1 != NULL) { if ((cp1-1 == my_esa) || (*(cp1-1) != '^')) - break; - else { - cp1--; - while ((cp1 > my_esa) && (*cp1 != '.')) - cp1--; - } - if (cp1 == my_esa) - cp1 = NULL; + break; + else { + cp1--; + while ((cp1 > my_esa) && (*cp1 != '.')) + cp1--; + } + if (cp1 == my_esa) + cp1 = NULL; } if ((cp1) != NULL) { @@ -6419,27 +6419,27 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) /* Go back and expand rooted logical name */ rms_set_nam_nop(dirnam, NAM$M_SYNCHK | NAM$M_NOCONCEAL); #ifdef NAM$M_NO_SHORT_UPCASE - if (DECC_EFS_CASE_PRESERVE) - rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE); + if (DECC_EFS_CASE_PRESERVE) + rms_set_nam_nop(dirnam, NAM$M_NO_SHORT_UPCASE); #endif if (!(sys$parse(&dirfab) & STS$K_SUCCESS)) { - sts = rms_free_search_context(&dirfab); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(trndir); - PerlMem_free(vmsdir); + sts = rms_free_search_context(&dirfab); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(trndir); + PerlMem_free(vmsdir); set_errno(EVMSERR); set_vaxc_errno(dirfab.fab$l_sts); return NULL; } - /* This changes the length of the string of course */ - if (esal != NULL) { - my_esa_len = rms_nam_esll(dirnam); - } else { - my_esa_len = rms_nam_esl(dirnam); - } + /* This changes the length of the string of course */ + if (esal != NULL) { + my_esa_len = rms_nam_esll(dirnam); + } else { + my_esa_len = rms_nam_esl(dirnam); + } retlen = my_esa_len - 9; /* esa - '][' - '].DIR;1' */ cp1 = strstr(my_esa,"]["); @@ -6448,18 +6448,18 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) memcpy(buf, my_esa, dirlen); if (strBEGINs(cp1+2,"000000]")) { buf[dirlen-1] = '\0'; - /* fix-me Not full ODS-5, just extra dots in directories for now */ - cp1 = buf + dirlen - 1; - while (cp1 > buf) - { - if (*cp1 == '[') - break; - if (*cp1 == '.') { - if (*(cp1-1) != '^') - break; - } - cp1--; - } + /* fix-me Not full ODS-5, just extra dots in directories for now */ + cp1 = buf + dirlen - 1; + while (cp1 > buf) + { + if (*cp1 == '[') + break; + if (*cp1 == '.') { + if (*(cp1-1) != '^') + break; + } + cp1--; + } if (*cp1 == '.') *cp1 = ']'; else { memmove(cp1+8, cp1+1, buf+dirlen-cp1); @@ -6471,14 +6471,14 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) buf[retlen] = '\0'; /* Convert last '.' to ']' */ cp1 = buf+retlen-1; - while (*cp != '[') { - cp1--; - if (*cp1 == '.') { - /* Do not trip on extra dots in ODS-5 directories */ - if ((cp1 == buf) || (*(cp1-1) != '^')) - break; - } - } + while (*cp != '[') { + cp1--; + if (*cp1 == '.') { + /* Do not trip on extra dots in ODS-5 directories */ + if ((cp1 == buf) || (*(cp1-1) != '^')) + break; + } + } if (*cp1 == '.') *cp1 = ']'; else { memmove(cp1+8, cp1+1, buf+dirlen-cp1); @@ -6506,7 +6506,7 @@ int_fileify_dirspec(const char *dir, char *buf, int *utf8_fl) PerlMem_free(trndir); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(vmsdir); return buf; } @@ -7062,23 +7062,23 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) tunix_len = my_strlcpy(tunix, spec, VMS_MAXRSS); nl_flag = 0; if (tunix[tunix_len - 1] == '\n') { - tunix[tunix_len - 1] = '\"'; - tunix[tunix_len] = '\0'; - tunix_len--; - nl_flag = 1; + tunix[tunix_len - 1] = '\"'; + tunix[tunix_len] = '\0'; + tunix_len--; + nl_flag = 1; } uspec = decc$translate_vms(tunix); PerlMem_free(tunix); if ((int)uspec > 0) { - my_strlcpy(rslt, uspec, VMS_MAXRSS); - if (nl_flag) { - strcat(rslt,"\n"); - } - else { - /* If we can not translate it, makemaker wants as-is */ - my_strlcpy(rslt, spec, VMS_MAXRSS); - } - return rslt; + my_strlcpy(rslt, uspec, VMS_MAXRSS); + if (nl_flag) { + strcat(rslt,"\n"); + } + else { + /* If we can not translate it, makemaker wants as-is */ + my_strlcpy(rslt, spec, VMS_MAXRSS); + } + return rslt; } } } @@ -7091,12 +7091,12 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) /* Look for EFS ^/ */ if (DECC_EFS_CHARSET) { while (cp1 != NULL) { - cp2 = cp1 - 1; - if (*cp2 != '^') { - /* Found illegal VMS, assume UNIX */ - cmp_rslt = 1; - break; - } + cp2 = cp1 - 1; + if (*cp2 != '^') { + /* Found illegal VMS, assume UNIX */ + cmp_rslt = 1; + break; + } cp1++; cp1 = strchr(cp1, '/'); } @@ -7106,12 +7106,12 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) if (DECC_FILENAME_UNIX_REPORT) { if (spec[0] == '.') { if ((spec[1] == '\0') || (spec[1] == '\n')) { - cmp_rslt = 1; + cmp_rslt = 1; } else { - if ((spec[1] == '.') && ((spec[2] == '\0') || (spec[2] == '\n'))) { - cmp_rslt = 1; - } + if ((spec[1] == '.') && ((spec[2] == '\0') || (spec[2] == '\n'))) { + cmp_rslt = 1; + } } } } @@ -7184,9 +7184,9 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) cp1 = cp1 + 4; cp2 = cp2 + 12; if (spec[12] != '\0') { - cp1[4] = '/'; - cp1++; - cp2++; + cp1[4] = '/'; + cp1++; + cp2++; } } } @@ -7202,7 +7202,7 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) } else if ( *cp2 != '^' && *cp2 != '.' && *cp2 != '-') { /* add the implied device */ if (getcwd(tmp, VMS_MAXRSS-1 ,1) == NULL) { - PerlMem_free(tmp); + PerlMem_free(tmp); if (vms_debug_fileify) { fprintf(stderr, "int_tounixspec: rslt = NULL\n"); } @@ -7223,14 +7223,14 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) while (*cp3) { *(cp1++) = *(cp3++); if (cp1 - rslt > (VMS_MAXRSS - 1)) { - PerlMem_free(tmp); + PerlMem_free(tmp); set_errno(ENAMETOOLONG); set_vaxc_errno(SS$_BUFFEROVF); if (vms_debug_fileify) { fprintf(stderr, "int_tounixspec: rslt = NULL\n"); } - return NULL; /* No room */ - } + return NULL; /* No room */ + } } *(cp1++) = '/'; } @@ -7368,14 +7368,14 @@ int_tounixspec(const char *spec, char *rslt, int * utf8_fl) /* Get rid of "000000/ in rooted filespecs */ if (ulen > 7) { - zeros = strstr(rslt, "/000000/"); - if (zeros != NULL) { - int mlen; - mlen = ulen - (zeros - rslt) - 7; - memmove(zeros, &zeros[7], mlen); - ulen = ulen - 7; - rslt[ulen] = '\0'; - } + zeros = strstr(rslt, "/000000/"); + if (zeros != NULL) { + int mlen; + mlen = ulen - (zeros - rslt) - 7; + memmove(zeros, &zeros[7], mlen); + ulen = ulen - 7; + rslt[ulen] = '\0'; + } } } @@ -7499,13 +7499,13 @@ posix_root_to_vms(char *vmspath, int vmspath_len, /* Check to see if this is under the POSIX root */ if (DECC_DISABLE_POSIX_ROOT) { - return RMS$_FNF; + return RMS$_FNF; } /* Skip leading / */ if (unixpath[0] == '/') { - unixpath++; - unixlen--; + unixpath++; + unixlen--; } @@ -7513,8 +7513,8 @@ posix_root_to_vms(char *vmspath, int vmspath_len, /* If this is only the / , or blank, then... */ if (unixpath[0] == '\0') { - /* by definition, this is the answer */ - return SS$_NORMAL; + /* by definition, this is the answer */ + return SS$_NORMAL; } /* Need to look up a directory */ @@ -7527,18 +7527,18 @@ posix_root_to_vms(char *vmspath, int vmspath_len, while (unixpath[i] != 0) { int k; - j += copy_expand_unix_filename_escape - (&vmspath[j], &unixpath[i], &k, utf8_fl); - i += k; + j += copy_expand_unix_filename_escape + (&vmspath[j], &unixpath[i], &k, utf8_fl); + i += k; } path_len = strlen(vmspath); if (vmspath[path_len - 1] == '/') - path_len--; + path_len--; vmspath[path_len] = ']'; path_len++; vmspath[path_len] = '\0'; - + } vmspath[vmspath_len] = 0; if (unixpath[unixlen - 1] == '/') @@ -7615,52 +7615,52 @@ posix_root_to_vms(char *vmspath, int vmspath_len, i = specdsc.dsc$w_length - 1; while (i > 0) { int zercnt; - zercnt = 0; - /* Version must be '1' */ - if (vmspath[i--] != '1') - break; - /* Version delimiter is one of ".;" */ - if ((vmspath[i] != '.') && (vmspath[i] != ';')) - break; - i--; - if (vmspath[i--] != 'R') - break; - if (vmspath[i--] != 'I') - break; - if (vmspath[i--] != 'D') - break; - if (vmspath[i--] != '.') - break; - eptr = &vmspath[i+1]; - while (i > 0) { - if ((vmspath[i] == ']') || (vmspath[i] == '>')) { - if (vmspath[i-1] != '^') { - if (zercnt != 6) { - *eptr = vmspath[i]; - eptr[1] = '\0'; - vmspath[i] = '.'; - break; - } - else { - /* Get rid of 6 imaginary zero directory filename */ - vmspath[i+1] = '\0'; - } - } - } - if (vmspath[i] == '0') - zercnt++; - else - zercnt = 10; - i--; - } - break; - } - } - } - PerlMem_free(esal); - return sts; -} - + zercnt = 0; + /* Version must be '1' */ + if (vmspath[i--] != '1') + break; + /* Version delimiter is one of ".;" */ + if ((vmspath[i] != '.') && (vmspath[i] != ';')) + break; + i--; + if (vmspath[i--] != 'R') + break; + if (vmspath[i--] != 'I') + break; + if (vmspath[i--] != 'D') + break; + if (vmspath[i--] != '.') + break; + eptr = &vmspath[i+1]; + while (i > 0) { + if ((vmspath[i] == ']') || (vmspath[i] == '>')) { + if (vmspath[i-1] != '^') { + if (zercnt != 6) { + *eptr = vmspath[i]; + eptr[1] = '\0'; + vmspath[i] = '.'; + break; + } + else { + /* Get rid of 6 imaginary zero directory filename */ + vmspath[i+1] = '\0'; + } + } + } + if (vmspath[i] == '0') + zercnt++; + else + zercnt = 10; + i--; + } + break; + } + } + } + PerlMem_free(esal); + return sts; +} + /* /dev/mumble needs to be handled special. /dev/null becomes NLA0:, And there is the potential for other stuff like /dev/tty which may need to be mapped to something. @@ -7676,12 +7676,12 @@ slash_dev_special_to_vms(const char *unixptr, char *vmspath, int vmspath_len) nextslash = strchr(unixptr, '/'); len = strlen(unixptr); if (nextslash != NULL) - len = nextslash - unixptr; + len = nextslash - unixptr; if (strEQ(unixptr, "null")) { - if (vmspath_len >= 6) { - strcpy(vmspath, "_NLA0:"); - return SS$_NORMAL; - } + if (vmspath_len >= 6) { + strcpy(vmspath, "_NLA0:"); + return SS$_NORMAL; + } } return 0; } @@ -7786,151 +7786,151 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* If allowing logical names on relative pathnames, then handle here */ if ((unixptr[0] != '.') && !DECC_DISABLE_TO_VMS_LOGNAME_TRANSLATION && - !DECC_POSIX_COMPLIANT_PATHNAMES) { + !DECC_POSIX_COMPLIANT_PATHNAMES) { char * nextslash; int seg_len; char * trn; int islnm; - /* Find the next slash */ - nextslash = strchr(unixptr,'/'); - - esa = (char *)PerlMem_malloc(vmspath_len); - if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM); - - trn = (char *)PerlMem_malloc(VMS_MAXRSS); - if (trn == NULL) _ckvmssts_noperl(SS$_INSFMEM); - - if (nextslash != NULL) { - - seg_len = nextslash - unixptr; - memcpy(esa, unixptr, seg_len); - esa[seg_len] = 0; - } - else { - seg_len = my_strlcpy(esa, unixptr, sizeof(esa)); - } - /* trnlnm(section) */ - islnm = vmstrnenv(esa, trn, 0, fildev, 0); - - if (islnm) { - /* Now fix up the directory */ - - /* Split up the path to find the components */ - sts = vms_split_path - (trn, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); - - while (sts == 0) { - - /* A logical name must be a directory or the full - specification. It is only a full specification if - it is the only component */ - if ((unixptr[seg_len] == '\0') || - (unixptr[seg_len+1] == '\0')) { - - /* Is a directory being required? */ - if (((n_len + e_len) != 0) && (dir_flag !=0)) { - /* Not a logical name */ - break; - } - - - if ((unixptr[seg_len] == '/') || (dir_flag != 0)) { - /* This must be a directory */ - if (((n_len + e_len) == 0)&&(seg_len <= vmspath_len)) { - vmslen = my_strlcpy(vmsptr, esa, vmspath_len - 1); - vmsptr[vmslen] = ':'; - vmslen++; - vmsptr[vmslen] = '\0'; - return SS$_NORMAL; - } - } - - } - - - /* must be dev/directory - ignore version */ - if ((n_len + e_len) != 0) - break; - - /* transfer the volume */ - if (v_len > 0 && ((v_len + vmslen) < vmspath_len)) { - memcpy(vmsptr, v_spec, v_len); - vmsptr += v_len; - vmsptr[0] = '\0'; - vmslen += v_len; - } - - /* unroot the rooted directory */ - if ((r_len > 0) && ((r_len + d_len + vmslen) < vmspath_len)) { - r_spec[0] = '['; - r_spec[r_len - 1] = ']'; - - /* This should not be there, but nothing is perfect */ - if (r_len > 9) { - if (strEQ(&r_spec[1], "000000.")) { - r_spec += 7; - r_spec[7] = '['; - r_len -= 7; - if (r_len == 2) - r_len = 0; - } - } - if (r_len > 0) { - memcpy(vmsptr, r_spec, r_len); - vmsptr += r_len; - vmslen += r_len; - vmsptr[0] = '\0'; - } - } - /* Bring over the directory. */ - if ((d_len > 0) && - ((d_len + vmslen) < vmspath_len)) { - d_spec[0] = '['; - d_spec[d_len - 1] = ']'; - if (d_len > 9) { - if (strEQ(&d_spec[1], "000000.")) { - d_spec += 7; - d_spec[7] = '['; - d_len -= 7; - if (d_len == 2) - d_len = 0; - } - } - - if (r_len > 0) { - /* Remove the redundant root */ - if (r_len > 0) { - /* remove the ][ */ - vmsptr--; - vmslen--; - d_spec++; - d_len--; - } - memcpy(vmsptr, d_spec, d_len); - vmsptr += d_len; - vmslen += d_len; - vmsptr[0] = '\0'; - } - } - break; - } - } - - PerlMem_free(esa); - PerlMem_free(trn); + /* Find the next slash */ + nextslash = strchr(unixptr,'/'); + + esa = (char *)PerlMem_malloc(vmspath_len); + if (esa == NULL) _ckvmssts_noperl(SS$_INSFMEM); + + trn = (char *)PerlMem_malloc(VMS_MAXRSS); + if (trn == NULL) _ckvmssts_noperl(SS$_INSFMEM); + + if (nextslash != NULL) { + + seg_len = nextslash - unixptr; + memcpy(esa, unixptr, seg_len); + esa[seg_len] = 0; + } + else { + seg_len = my_strlcpy(esa, unixptr, sizeof(esa)); + } + /* trnlnm(section) */ + islnm = vmstrnenv(esa, trn, 0, fildev, 0); + + if (islnm) { + /* Now fix up the directory */ + + /* Split up the path to find the components */ + sts = vms_split_path + (trn, + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); + + while (sts == 0) { + + /* A logical name must be a directory or the full + specification. It is only a full specification if + it is the only component */ + if ((unixptr[seg_len] == '\0') || + (unixptr[seg_len+1] == '\0')) { + + /* Is a directory being required? */ + if (((n_len + e_len) != 0) && (dir_flag !=0)) { + /* Not a logical name */ + break; + } + + + if ((unixptr[seg_len] == '/') || (dir_flag != 0)) { + /* This must be a directory */ + if (((n_len + e_len) == 0)&&(seg_len <= vmspath_len)) { + vmslen = my_strlcpy(vmsptr, esa, vmspath_len - 1); + vmsptr[vmslen] = ':'; + vmslen++; + vmsptr[vmslen] = '\0'; + return SS$_NORMAL; + } + } + + } + + + /* must be dev/directory - ignore version */ + if ((n_len + e_len) != 0) + break; + + /* transfer the volume */ + if (v_len > 0 && ((v_len + vmslen) < vmspath_len)) { + memcpy(vmsptr, v_spec, v_len); + vmsptr += v_len; + vmsptr[0] = '\0'; + vmslen += v_len; + } + + /* unroot the rooted directory */ + if ((r_len > 0) && ((r_len + d_len + vmslen) < vmspath_len)) { + r_spec[0] = '['; + r_spec[r_len - 1] = ']'; + + /* This should not be there, but nothing is perfect */ + if (r_len > 9) { + if (strEQ(&r_spec[1], "000000.")) { + r_spec += 7; + r_spec[7] = '['; + r_len -= 7; + if (r_len == 2) + r_len = 0; + } + } + if (r_len > 0) { + memcpy(vmsptr, r_spec, r_len); + vmsptr += r_len; + vmslen += r_len; + vmsptr[0] = '\0'; + } + } + /* Bring over the directory. */ + if ((d_len > 0) && + ((d_len + vmslen) < vmspath_len)) { + d_spec[0] = '['; + d_spec[d_len - 1] = ']'; + if (d_len > 9) { + if (strEQ(&d_spec[1], "000000.")) { + d_spec += 7; + d_spec[7] = '['; + d_len -= 7; + if (d_len == 2) + d_len = 0; + } + } + + if (r_len > 0) { + /* Remove the redundant root */ + if (r_len > 0) { + /* remove the ][ */ + vmsptr--; + vmslen--; + d_spec++; + d_len--; + } + memcpy(vmsptr, d_spec, d_len); + vmsptr += d_len; + vmslen += d_len; + vmsptr[0] = '\0'; + } + } + break; + } + } + + PerlMem_free(esa); + PerlMem_free(trn); } if (lastslash > unixptr) { @@ -7939,54 +7939,54 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* skip leading ./ */ dotdir_seen = 0; while ((unixptr[0] == '.') && (unixptr[1] == '/')) { - dotdir_seen = 1; - unixptr++; - unixptr++; + dotdir_seen = 1; + unixptr++; + unixptr++; } /* Are we still in a directory? */ if (unixptr <= lastslash) { - *vmsptr++ = '['; - vmslen = 1; - dir_start = 1; + *vmsptr++ = '['; + vmslen = 1; + dir_start = 1; - /* if not backing up, then it is relative forward. */ - if (!((*unixptr == '.') && (unixptr[1] == '.') && - ((unixptr[2] == '/') || (&unixptr[2] == unixend)))) { - *vmsptr++ = '.'; - vmslen++; - dir_dot = 1; - } + /* if not backing up, then it is relative forward. */ + if (!((*unixptr == '.') && (unixptr[1] == '.') && + ((unixptr[2] == '/') || (&unixptr[2] == unixend)))) { + *vmsptr++ = '.'; + vmslen++; + dir_dot = 1; + } } else { - if (dotdir_seen) { - /* Perl wants an empty directory here to tell the difference - * between a DCL command and a filename - */ - *vmsptr++ = '['; - *vmsptr++ = ']'; - vmslen = 2; - } + if (dotdir_seen) { + /* Perl wants an empty directory here to tell the difference + * between a DCL command and a filename + */ + *vmsptr++ = '['; + *vmsptr++ = ']'; + vmslen = 2; + } } } else { /* Handle two special files . and .. */ if (unixptr[0] == '.') { if (&unixptr[1] == unixend) { - *vmsptr++ = '['; - *vmsptr++ = ']'; - vmslen += 2; - *vmsptr++ = '\0'; - return SS$_NORMAL; - } + *vmsptr++ = '['; + *vmsptr++ = ']'; + vmslen += 2; + *vmsptr++ = '\0'; + return SS$_NORMAL; + } if ((unixptr[1] == '.') && (&unixptr[2] == unixend)) { - *vmsptr++ = '['; - *vmsptr++ = '-'; - *vmsptr++ = ']'; - vmslen += 3; - *vmsptr++ = '\0'; - return SS$_NORMAL; - } + *vmsptr++ = '['; + *vmsptr++ = '-'; + *vmsptr++ = ']'; + vmslen += 3; + *vmsptr++ = '\0'; + return SS$_NORMAL; + } } } } @@ -8012,9 +8012,9 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, seg_len = nextslash - &unixptr[1]; my_strlcpy(vmspath, unixptr, seg_len + 2); if (memEQs(vmspath, seg_len, "dev")) { - sts = slash_dev_special_to_vms(unixptr, vmspath, vmspath_len); - if (sts == SS$_NORMAL) - return SS$_NORMAL; + sts = slash_dev_special_to_vms(unixptr, vmspath, vmspath_len); + if (sts == SS$_NORMAL) + return SS$_NORMAL; } sts = posix_root_to_vms(esa, vmspath_len, vmspath, utf8_fl); } @@ -8024,38 +8024,38 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, sts = posix_root_to_vms(esa, vmspath_len, "/", NULL); if ($VMS_STATUS_SUCCESS(sts)) { - vmslen = my_strlcpy(vmspath, esa, vmspath_len + 1); - vmsptr = vmspath + vmslen; - unixptr++; - if (unixptr < lastslash) { - char * rptr; - vmsptr--; - *vmsptr++ = '.'; - dir_start = 1; - dir_dot = 1; - if (vmslen > 7) { - rptr = vmsptr - 7; - if (strEQ(rptr,"000000.")) { - vmslen -= 7; - vmsptr -= 7; - vmsptr[1] = '\0'; - } /* removing 6 zeros */ - } /* vmslen < 7, no 6 zeros possible */ - } /* Not in a directory */ + vmslen = my_strlcpy(vmspath, esa, vmspath_len + 1); + vmsptr = vmspath + vmslen; + unixptr++; + if (unixptr < lastslash) { + char * rptr; + vmsptr--; + *vmsptr++ = '.'; + dir_start = 1; + dir_dot = 1; + if (vmslen > 7) { + rptr = vmsptr - 7; + if (strEQ(rptr,"000000.")) { + vmslen -= 7; + vmsptr -= 7; + vmsptr[1] = '\0'; + } /* removing 6 zeros */ + } /* vmslen < 7, no 6 zeros possible */ + } /* Not in a directory */ } /* Posix root found */ else { - /* No posix root, fall back to default directory */ - strcpy(vmspath, "SYS$DISK:["); - vmsptr = &vmspath[10]; - vmslen = 10; - if (unixptr > lastslash) { - *vmsptr = ']'; - vmsptr++; - vmslen++; - } - else { - dir_start = 1; - } + /* No posix root, fall back to default directory */ + strcpy(vmspath, "SYS$DISK:["); + vmsptr = &vmspath[10]; + vmslen = 10; + if (unixptr > lastslash) { + *vmsptr = ']'; + vmsptr++; + vmslen++; + } + else { + dir_start = 1; + } } } /* end of verified real path handling */ else { @@ -8075,53 +8075,53 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* Now do we need to add the fake 6 zero directory to it? */ add_6zero = 1; if ((*lastslash == '/') && (nextslash < lastslash)) { - /* No there is another directory */ - add_6zero = 0; + /* No there is another directory */ + add_6zero = 0; } else { int trnend; - /* now we have foo:bar or foo:[000000]bar to decide from */ - islnm = vmstrnenv(vmspath, esa, 0, fildev, 0); + /* now we have foo:bar or foo:[000000]bar to decide from */ + islnm = vmstrnenv(vmspath, esa, 0, fildev, 0); if (!islnm && !DECC_POSIX_COMPLIANT_PATHNAMES) { - if (strEQ(vmspath, "bin")) { - /* bin => SYS$SYSTEM: */ - islnm = vmstrnenv("SYS$SYSTEM:", esa, 0, fildev, 0); - } - else { - /* tmp => SYS$SCRATCH: */ - if (strEQ(vmspath, "tmp")) { - islnm = vmstrnenv("SYS$SCRATCH:", esa, 0, fildev, 0); - } - } - } + if (strEQ(vmspath, "bin")) { + /* bin => SYS$SYSTEM: */ + islnm = vmstrnenv("SYS$SYSTEM:", esa, 0, fildev, 0); + } + else { + /* tmp => SYS$SCRATCH: */ + if (strEQ(vmspath, "tmp")) { + islnm = vmstrnenv("SYS$SCRATCH:", esa, 0, fildev, 0); + } + } + } trnend = islnm ? islnm - 1 : 0; - /* if this was a logical name, ']' or '>' must be present */ - /* if not a logical name, then assume a device and hope. */ - islnm = trnend ? (esa[trnend] == ']' || esa[trnend] == '>') : 0; + /* if this was a logical name, ']' or '>' must be present */ + /* if not a logical name, then assume a device and hope. */ + islnm = trnend ? (esa[trnend] == ']' || esa[trnend] == '>') : 0; - /* if log name and trailing '.' then rooted - treat as device */ - add_6zero = islnm ? (esa[trnend-1] == '.') : 0; + /* if log name and trailing '.' then rooted - treat as device */ + add_6zero = islnm ? (esa[trnend-1] == '.') : 0; - /* Fix me, if not a logical name, a device lookup should be + /* Fix me, if not a logical name, a device lookup should be * done to see if the device is file structured. If the device * is not file structured, the 6 zeros should not be put on. * * As it is, perl is occasionally looking for dev:[000000]tty. - * which looks a little strange. - * - * Not that easy to detect as "/dev" may be file structured with - * special device files. + * which looks a little strange. + * + * Not that easy to detect as "/dev" may be file structured with + * special device files. */ - if (!islnm && (add_6zero == 0) && (*nextslash == '/') && - (&nextslash[1] == unixend)) { - /* No real directory present */ - add_6zero = 1; - } + if (!islnm && (add_6zero == 0) && (*nextslash == '/') && + (&nextslash[1] == unixend)) { + /* No real directory present */ + add_6zero = 1; + } } /* Put the device delimiter on */ @@ -8132,22 +8132,22 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* Start directory if needed */ if (!islnm || add_6zero) { - *vmsptr++ = '['; - vmslen++; - dir_start = 1; + *vmsptr++ = '['; + vmslen++; + dir_start = 1; } /* add fake 000000] if needed */ if (add_6zero) { - *vmsptr++ = '0'; - *vmsptr++ = '0'; - *vmsptr++ = '0'; - *vmsptr++ = '0'; - *vmsptr++ = '0'; - *vmsptr++ = '0'; - *vmsptr++ = ']'; - vmslen += 7; - dir_start = 0; + *vmsptr++ = '0'; + *vmsptr++ = '0'; + *vmsptr++ = '0'; + *vmsptr++ = '0'; + *vmsptr++ = '0'; + *vmsptr++ = '0'; + *vmsptr++ = ']'; + vmslen += 7; + dir_start = 0; } } /* non-POSIX translation */ @@ -8165,109 +8165,109 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* First characters in a directory are handled special */ while ((*unixptr == '/') || - ((*unixptr == '.') && - ((unixptr[1]=='.') || (unixptr[1]=='/') || - (&unixptr[1]==unixend)))) { + ((*unixptr == '.') && + ((unixptr[1]=='.') || (unixptr[1]=='/') || + (&unixptr[1]==unixend)))) { int loop_flag; - loop_flag = 0; + loop_flag = 0; /* Skip redundant / in specification */ while ((*unixptr == '/') && (dir_start != 0)) { - loop_flag = 1; - unixptr++; - if (unixptr == lastslash) - break; - } - if (unixptr == lastslash) - break; + loop_flag = 1; + unixptr++; + if (unixptr == lastslash) + break; + } + if (unixptr == lastslash) + break; /* Skip redundant ./ characters */ - while ((*unixptr == '.') && - ((unixptr[1] == '/')||(&unixptr[1] == unixend))) { - loop_flag = 1; - unixptr++; - if (unixptr == lastslash) - break; - if (*unixptr == '/') - unixptr++; - } - if (unixptr == lastslash) - break; - - /* Skip redundant ../ characters */ - while ((*unixptr == '.') && (unixptr[1] == '.') && - ((unixptr[2] == '/') || (&unixptr[2] == unixend))) { - /* Set the backing up flag */ - loop_flag = 1; - dir_dot = 0; - dash_flag = 1; - *vmsptr++ = '-'; - vmslen++; - unixptr++; /* first . */ - unixptr++; /* second . */ - if (unixptr == lastslash) - break; - if (*unixptr == '/') /* The slash */ - unixptr++; - } - if (unixptr == lastslash) - break; - - /* To do: Perl expects /.../ to be translated to [...] on VMS */ - /* Not needed when VMS is pretending to be UNIX. */ - - /* Is this loop stuck because of too many dots? */ - if (loop_flag == 0) { - /* Exit the loop and pass the rest through */ - break; - } + while ((*unixptr == '.') && + ((unixptr[1] == '/')||(&unixptr[1] == unixend))) { + loop_flag = 1; + unixptr++; + if (unixptr == lastslash) + break; + if (*unixptr == '/') + unixptr++; + } + if (unixptr == lastslash) + break; + + /* Skip redundant ../ characters */ + while ((*unixptr == '.') && (unixptr[1] == '.') && + ((unixptr[2] == '/') || (&unixptr[2] == unixend))) { + /* Set the backing up flag */ + loop_flag = 1; + dir_dot = 0; + dash_flag = 1; + *vmsptr++ = '-'; + vmslen++; + unixptr++; /* first . */ + unixptr++; /* second . */ + if (unixptr == lastslash) + break; + if (*unixptr == '/') /* The slash */ + unixptr++; + } + if (unixptr == lastslash) + break; + + /* To do: Perl expects /.../ to be translated to [...] on VMS */ + /* Not needed when VMS is pretending to be UNIX. */ + + /* Is this loop stuck because of too many dots? */ + if (loop_flag == 0) { + /* Exit the loop and pass the rest through */ + break; + } } /* Are we done with directories yet? */ if (unixptr >= lastslash) { - /* Watch out for trailing dots */ - if (dir_dot != 0) { - vmslen --; - vmsptr--; - } - *vmsptr++ = ']'; - vmslen++; - dash_flag = 0; - dir_start = 0; - if (*unixptr == '/') - unixptr++; + /* Watch out for trailing dots */ + if (dir_dot != 0) { + vmslen --; + vmsptr--; + } + *vmsptr++ = ']'; + vmslen++; + dash_flag = 0; + dir_start = 0; + if (*unixptr == '/') + unixptr++; } else { - /* Have we stopped backing up? */ - if (dash_flag) { - *vmsptr++ = '.'; - vmslen++; - dash_flag = 0; - /* dir_start continues to be = 1 */ - } - if (*unixptr == '-') { - *vmsptr++ = '^'; - *vmsptr++ = *unixptr++; - vmslen += 2; - dir_start = 0; - - /* Now are we done with directories yet? */ - if (unixptr >= lastslash) { - - /* Watch out for trailing dots */ - if (dir_dot != 0) { - vmslen --; - vmsptr--; - } - - *vmsptr++ = ']'; - vmslen++; - dash_flag = 0; - dir_start = 0; - } - } + /* Have we stopped backing up? */ + if (dash_flag) { + *vmsptr++ = '.'; + vmslen++; + dash_flag = 0; + /* dir_start continues to be = 1 */ + } + if (*unixptr == '-') { + *vmsptr++ = '^'; + *vmsptr++ = *unixptr++; + vmslen += 2; + dir_start = 0; + + /* Now are we done with directories yet? */ + if (unixptr >= lastslash) { + + /* Watch out for trailing dots */ + if (dir_dot != 0) { + vmslen --; + vmsptr--; + } + + *vmsptr++ = ']'; + vmslen++; + dash_flag = 0; + dir_start = 0; + } + } } } @@ -8281,72 +8281,72 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, switch(*unixptr) { case '/': - /* remove multiple / */ - while (unixptr[1] == '/') { - unixptr++; - } - if (unixptr == lastslash) { - /* Watch out for trailing dots */ - if (dir_dot != 0) { - vmslen --; - vmsptr--; - } - *vmsptr++ = ']'; - } - else { - dir_start = 1; - *vmsptr++ = '.'; - dir_dot = 1; - - /* To do: Perl expects /.../ to be translated to [...] on VMS */ - /* Not needed when VMS is pretending to be UNIX. */ - - } - dash_flag = 0; - if (unixptr != unixend) - unixptr++; - vmslen++; - break; + /* remove multiple / */ + while (unixptr[1] == '/') { + unixptr++; + } + if (unixptr == lastslash) { + /* Watch out for trailing dots */ + if (dir_dot != 0) { + vmslen --; + vmsptr--; + } + *vmsptr++ = ']'; + } + else { + dir_start = 1; + *vmsptr++ = '.'; + dir_dot = 1; + + /* To do: Perl expects /.../ to be translated to [...] on VMS */ + /* Not needed when VMS is pretending to be UNIX. */ + + } + dash_flag = 0; + if (unixptr != unixend) + unixptr++; + vmslen++; + break; case '.': - if ((unixptr < lastdot) || (unixptr < lastslash) || - (&unixptr[1] == unixend)) { - *vmsptr++ = '^'; - *vmsptr++ = '.'; - vmslen += 2; - unixptr++; - - /* trailing dot ==> '^..' on VMS */ - if (unixptr == unixend) { - *vmsptr++ = '.'; - vmslen++; - unixptr++; - } - break; - } - - *vmsptr++ = *unixptr++; - vmslen ++; - break; + if ((unixptr < lastdot) || (unixptr < lastslash) || + (&unixptr[1] == unixend)) { + *vmsptr++ = '^'; + *vmsptr++ = '.'; + vmslen += 2; + unixptr++; + + /* trailing dot ==> '^..' on VMS */ + if (unixptr == unixend) { + *vmsptr++ = '.'; + vmslen++; + unixptr++; + } + break; + } + + *vmsptr++ = *unixptr++; + vmslen ++; + break; case '"': - if (quoted && (&unixptr[1] == unixend)) { - unixptr++; - break; - } - in_cnt = copy_expand_unix_filename_escape - (vmsptr, unixptr, &out_cnt, utf8_fl); - vmsptr += out_cnt; - unixptr += in_cnt; - break; + if (quoted && (&unixptr[1] == unixend)) { + unixptr++; + break; + } + in_cnt = copy_expand_unix_filename_escape + (vmsptr, unixptr, &out_cnt, utf8_fl); + vmsptr += out_cnt; + unixptr += in_cnt; + break; case ';': case '\\': case '?': case ' ': default: - in_cnt = copy_expand_unix_filename_escape - (vmsptr, unixptr, &out_cnt, utf8_fl); - vmsptr += out_cnt; - unixptr += in_cnt; - break; + in_cnt = copy_expand_unix_filename_escape + (vmsptr, unixptr, &out_cnt, utf8_fl); + vmsptr += out_cnt; + unixptr += in_cnt; + break; } } @@ -8360,12 +8360,12 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* directories do not end in a dot bracket */ if (*vmsptr2 == '.') { - vmsptr2--; + vmsptr2--; - /* ^. is allowed */ + /* ^. is allowed */ if (*vmsptr2 != '^') { - vmsptr--; /* back up over the dot */ - } + vmsptr--; /* back up over the dot */ + } } *vmsptr++ = ']'; } @@ -8375,9 +8375,9 @@ posix_to_vmsspec_hardway(char *vmspath, int vmspath_len, const char *unixpath, /* Add a trailing dot if a file with no extension */ vmsptr2 = vmsptr - 1; if ((vmslen > 1) && - (*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') && - (*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) { - *vmsptr++ = '.'; + (*vmsptr2 != ']') && (*vmsptr2 != '*') && (*vmsptr2 != '%') && + (*vmsptr2 != ')') && (*lastdot != '.') && (*vmsptr2 != ':')) { + *vmsptr++ = '.'; vmslen++; } } @@ -8436,15 +8436,15 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) if (path[1] == '\0') { strcpy(rslt,"[]"); if (utf8_flag != NULL) - *utf8_flag = 0; + *utf8_flag = 0; return rslt; } else { if (path[1] == '.' && path[2] == '\0') { - strcpy(rslt,"[-]"); - if (utf8_flag != NULL) - *utf8_flag = 0; - return rslt; + strcpy(rslt,"[-]"); + if (utf8_flag != NULL) + *utf8_flag = 0; + return rslt; } } } @@ -8463,18 +8463,18 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) /* This is really the only way to see if this is already in VMS format */ sts = vms_split_path (path, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); if (sts == 0) { /* FIX-ME - If dir_flag is non-zero, then this is a mp_do_vmspath() replacement, because the above parse just took care of most of @@ -8489,7 +8489,7 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) /* If VMS punctuation was found, it is already VMS format */ if ((v_len != 0) || (r_len != 0) || (d_len != 0) || (vs_len != 0)) { if (utf8_flag != NULL) - *utf8_flag = 0; + *utf8_flag = 0; my_strlcpy(rslt, path, VMS_MAXRSS); if (vms_debug_fileify) { fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt); @@ -8553,13 +8553,13 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) while (*(cp2+1) == '/') cp2++; /* Skip multiple /s */ if (!*(cp2+1)) { if (DECC_DISABLE_POSIX_ROOT) { - strcpy(rslt,"sys$disk:[000000]"); + strcpy(rslt,"sys$disk:[000000]"); } else { - strcpy(rslt,"sys$posix_root:[000000]"); + strcpy(rslt,"sys$posix_root:[000000]"); } if (utf8_flag != NULL) - *utf8_flag = 0; + *utf8_flag = 0; if (vms_debug_fileify) { fprintf(stderr, "int_tovmsspec: rslt = %s\n", rslt); } @@ -8574,35 +8574,35 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) /* DECC special handling */ if (!islnm) { if (strEQ(rslt,"bin")) { - strcpy(rslt,"sys$system"); - cp1 = rslt + 10; - *cp1 = 0; - islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); + strcpy(rslt,"sys$system"); + cp1 = rslt + 10; + *cp1 = 0; + islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); } else if (strEQ(rslt,"tmp")) { - strcpy(rslt,"sys$scratch"); - cp1 = rslt + 11; - *cp1 = 0; - islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); + strcpy(rslt,"sys$scratch"); + cp1 = rslt + 11; + *cp1 = 0; + islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); } else if (!DECC_DISABLE_POSIX_ROOT) { strcpy(rslt, "sys$posix_root"); - cp1 = rslt + 14; - *cp1 = 0; - cp2 = path; + cp1 = rslt + 14; + *cp1 = 0; + cp2 = path; while (*(cp2+1) == '/') cp2++; /* Skip multiple /s */ - islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); + islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); } else if (strEQ(rslt,"dev")) { - if (strBEGINs(cp2,"/null")) { - if ((cp2[5] == 0) || (cp2[5] == '/')) { - strcpy(rslt,"NLA0"); - cp1 = rslt + 4; - *cp1 = 0; - cp2 = cp2 + 5; - islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); - } - } + if (strBEGINs(cp2,"/null")) { + if ((cp2[5] == 0) || (cp2[5] == '/')) { + strcpy(rslt,"NLA0"); + cp1 = rslt + 4; + *cp1 = 0; + cp2 = cp2 + 5; + islnm = simple_trnlnm(rslt,trndev,VMS_MAXRSS-1); + } + } } } @@ -8621,16 +8621,16 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) if (cp2 != dirend) { my_strlcpy(rslt, trndev, VMS_MAXRSS); cp1 = rslt + trnend; - if (*cp2 != 0) { + if (*cp2 != 0) { *(cp1++) = '.'; cp2++; } } else { - if (DECC_DISABLE_POSIX_ROOT) { - *(cp1++) = ':'; - hasdir = 0; - } + if (DECC_DISABLE_POSIX_ROOT) { + *(cp1++) = ':'; + hasdir = 0; + } } } PerlMem_free(trndev); @@ -8653,8 +8653,8 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) cp2 += 4; } else if ((cp2 != lastdot) || (lastdot < dirend)) { - /* Escape the extra dots in EFS file specifications */ - *(cp1++) = '^'; + /* Escape the extra dots in EFS file specifications */ + *(cp1++) = '^'; } if (cp2 > dirend) cp2 = dirend; } @@ -8690,26 +8690,26 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) } else { if (DECC_EFS_CHARSET == 0) { - if (cp1 > rslt && *(cp1-1) == '^') - cp1--; /* remove the escape, if any */ - *(cp1++) = '_'; /* fix up syntax - '.' in name not allowed */ - } - else { - VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); - } + if (cp1 > rslt && *(cp1-1) == '^') + cp1--; /* remove the escape, if any */ + *(cp1++) = '_'; /* fix up syntax - '.' in name not allowed */ + } + else { + VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); + } } } else { if (!infront && cp1 > rslt && *(cp1-1) == '-') *(cp1++) = '.'; if (*cp2 == '.') { if (DECC_EFS_CHARSET == 0) { - if (cp1 > rslt && *(cp1-1) == '^') - cp1--; /* remove the escape, if any */ - *(cp1++) = '_'; - } - else { - VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); - } + if (cp1 > rslt && *(cp1-1) == '^') + cp1--; /* remove the escape, if any */ + *(cp1++) = '_'; + } + else { + VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); + } } else { int out_cnt; @@ -8730,66 +8730,66 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) switch(*cp2) { case '?': if (DECC_EFS_CHARSET == 0) - *(cp1++) = '%'; - else - *(cp1++) = '?'; - cp2++; - break; + *(cp1++) = '%'; + else + *(cp1++) = '?'; + cp2++; + break; case ' ': - if (cp2 >= path && (cp2 == path || *(cp2-1) != '^')) /* not previously escaped */ - *(cp1)++ = '^'; - *(cp1)++ = '_'; - cp2++; - break; + if (cp2 >= path && (cp2 == path || *(cp2-1) != '^')) /* not previously escaped */ + *(cp1)++ = '^'; + *(cp1)++ = '_'; + cp2++; + break; case '.': - if (((cp2 < lastdot) || (cp2[1] == '\0')) && - DECC_READDIR_DROPDOTNOTYPE) { - VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); - cp2++; - - /* trailing dot ==> '^..' on VMS */ - if (*cp2 == '\0') { - *(cp1++) = '.'; - no_type_seen = 0; - } - } - else { - *(cp1++) = *(cp2++); - no_type_seen = 0; - } - break; + if (((cp2 < lastdot) || (cp2[1] == '\0')) && + DECC_READDIR_DROPDOTNOTYPE) { + VMSEFS_DOT_WITH_ESCAPE(cp1, rslt, VMS_MAXRSS); + cp2++; + + /* trailing dot ==> '^..' on VMS */ + if (*cp2 == '\0') { + *(cp1++) = '.'; + no_type_seen = 0; + } + } + else { + *(cp1++) = *(cp2++); + no_type_seen = 0; + } + break; case '$': - /* This could be a macro to be passed through */ - *(cp1++) = *(cp2++); - if (*cp2 == '(') { - const char * save_cp2; - char * save_cp1; - int is_macro; - - /* paranoid check */ - save_cp2 = cp2; - save_cp1 = cp1; - is_macro = 0; - - /* Test through */ - *(cp1++) = *(cp2++); - if (isALPHA_L1(*cp2) || (*cp2 == '.') || (*cp2 == '_')) { - *(cp1++) = *(cp2++); - while (isALPHA_L1(*cp2) || (*cp2 == '.') || (*cp2 == '_')) { - *(cp1++) = *(cp2++); - } - if (*cp2 == ')') { - *(cp1++) = *(cp2++); - is_macro = 1; - } - } - if (is_macro == 0) { - /* Not really a macro - never mind */ - cp2 = save_cp2; - cp1 = save_cp1; - } - } - break; + /* This could be a macro to be passed through */ + *(cp1++) = *(cp2++); + if (*cp2 == '(') { + const char * save_cp2; + char * save_cp1; + int is_macro; + + /* paranoid check */ + save_cp2 = cp2; + save_cp1 = cp1; + is_macro = 0; + + /* Test through */ + *(cp1++) = *(cp2++); + if (isALPHA_L1(*cp2) || (*cp2 == '.') || (*cp2 == '_')) { + *(cp1++) = *(cp2++); + while (isALPHA_L1(*cp2) || (*cp2 == '.') || (*cp2 == '_')) { + *(cp1++) = *(cp2++); + } + if (*cp2 == ')') { + *(cp1++) = *(cp2++); + is_macro = 1; + } + } + if (is_macro == 0) { + /* Not really a macro - never mind */ + cp2 = save_cp2; + cp1 = save_cp1; + } + } + break; case '\"': case '`': case '!': @@ -8800,8 +8800,8 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) * already something we escape. */ if (memCHRs("\"`!#%^&()=+\'@[]{}:\\|<>_.", *(cp2+1))) { - *(cp1++) = *(cp2++); - break; + *(cp1++) = *(cp2++); + break; } /* But otherwise fall through and escape it. */ case '&': @@ -8820,27 +8820,27 @@ int_tovmsspec(const char *path, char *rslt, int dir_flag, int * utf8_flag) case '|': case '<': case '>': - if (cp2 >= path && *(cp2-1) != '^') /* not previously escaped */ - *(cp1++) = '^'; - *(cp1++) = *(cp2++); - break; + if (cp2 >= path && *(cp2-1) != '^') /* not previously escaped */ + *(cp1++) = '^'; + *(cp1++) = *(cp2++); + break; case ';': /* If it doesn't look like the beginning of a version number, * or we've been promised there are no version numbers, then * escape it. */ - if (DECC_FILENAME_UNIX_NO_VERSION) { - *(cp1++) = '^'; - } - else { - size_t all_nums = strspn(cp2+1, "0123456789"); - if (all_nums > 5 || *(cp2 + all_nums + 1) != '\0') - *(cp1++) = '^'; - } - *(cp1++) = *(cp2++); - break; + if (DECC_FILENAME_UNIX_NO_VERSION) { + *(cp1++) = '^'; + } + else { + size_t all_nums = strspn(cp2+1, "0123456789"); + if (all_nums > 5 || *(cp2 + all_nums + 1) != '\0') + *(cp1++) = '^'; + } + *(cp1++) = *(cp2++); + break; default: - *(cp1++) = *(cp2++); + *(cp1++) = *(cp2++); } } if ((no_type_seen == 1) && DECC_READDIR_DROPDOTNOTYPE) { @@ -9129,14 +9129,14 @@ struct list_item }; static void add_item(struct list_item **head, - struct list_item **tail, - char *value, - int *count); + struct list_item **tail, + char *value, + int *count); static void mp_expand_wild_cards(pTHX_ char *item, - struct list_item **head, - struct list_item **tail, - int *count); + struct list_item **head, + struct list_item **tail, + int *count); static int background_process(pTHX_ int argc, char **argv); @@ -9190,104 +9190,104 @@ mp_getredirection(pTHX_ int *ac, char ***av) if (strEQ(ap, "&")) exit(background_process(aTHX_ --argc, argv)); if (*ap && '&' == ap[strlen(ap)-1]) - { - ap[strlen(ap)-1] = '\0'; + { + ap[strlen(ap)-1] = '\0'; exit(background_process(aTHX_ argc, argv)); - } + } /* * Now we handle the general redirection cases that involve '>', '>>', * '<', and pipes '|'. */ for (j = 0; j < argc; ++j) - { - if (strEQ(argv[j], "<")) - { - if (j+1 >= argc) - { - fprintf(stderr,"No input file after < on command line"); - exit(LIB$_WRONUMARG); - } - in = argv[++j]; - continue; - } - if ('<' == *(ap = argv[j])) - { - in = 1 + ap; - continue; - } - if (strEQ(ap, ">")) - { - if (j+1 >= argc) - { - fprintf(stderr,"No output file after > on command line"); - exit(LIB$_WRONUMARG); - } - out = argv[++j]; - continue; - } - if ('>' == *ap) - { - if ('>' == ap[1]) - { - outmode = "a"; - if ('\0' == ap[2]) - out = argv[++j]; - else - out = 2 + ap; - } - else - out = 1 + ap; - if (j >= argc) - { - fprintf(stderr,"No output file after > or >> on command line"); - exit(LIB$_WRONUMARG); - } - continue; - } - if (('2' == *ap) && ('>' == ap[1])) - { - if ('>' == ap[2]) - { - errmode = "a"; - if ('\0' == ap[3]) - err = argv[++j]; - else - err = 3 + ap; - } - else - if ('\0' == ap[2]) - err = argv[++j]; - else - err = 2 + ap; - if (j >= argc) - { - fprintf(stderr,"No output file after 2> or 2>> on command line"); - exit(LIB$_WRONUMARG); - } - continue; - } - if (strEQ(argv[j], "|")) - { - if (j+1 >= argc) - { - fprintf(stderr,"No command into which to pipe on command line"); - exit(LIB$_WRONUMARG); - } - cmargc = argc-(j+1); - cmargv = &argv[j+1]; - argc = j; - continue; - } - if ('|' == *(ap = argv[j])) - { - ++argv[j]; - cmargc = argc-j; - cmargv = &argv[j]; - argc = j; - continue; - } - expand_wild_cards(ap, &list_head, &list_tail, &item_count); - } + { + if (strEQ(argv[j], "<")) + { + if (j+1 >= argc) + { + fprintf(stderr,"No input file after < on command line"); + exit(LIB$_WRONUMARG); + } + in = argv[++j]; + continue; + } + if ('<' == *(ap = argv[j])) + { + in = 1 + ap; + continue; + } + if (strEQ(ap, ">")) + { + if (j+1 >= argc) + { + fprintf(stderr,"No output file after > on command line"); + exit(LIB$_WRONUMARG); + } + out = argv[++j]; + continue; + } + if ('>' == *ap) + { + if ('>' == ap[1]) + { + outmode = "a"; + if ('\0' == ap[2]) + out = argv[++j]; + else + out = 2 + ap; + } + else + out = 1 + ap; + if (j >= argc) + { + fprintf(stderr,"No output file after > or >> on command line"); + exit(LIB$_WRONUMARG); + } + continue; + } + if (('2' == *ap) && ('>' == ap[1])) + { + if ('>' == ap[2]) + { + errmode = "a"; + if ('\0' == ap[3]) + err = argv[++j]; + else + err = 3 + ap; + } + else + if ('\0' == ap[2]) + err = argv[++j]; + else + err = 2 + ap; + if (j >= argc) + { + fprintf(stderr,"No output file after 2> or 2>> on command line"); + exit(LIB$_WRONUMARG); + } + continue; + } + if (strEQ(argv[j], "|")) + { + if (j+1 >= argc) + { + fprintf(stderr,"No command into which to pipe on command line"); + exit(LIB$_WRONUMARG); + } + cmargc = argc-(j+1); + cmargv = &argv[j+1]; + argc = j; + continue; + } + if ('|' == *(ap = argv[j])) + { + ++argv[j]; + cmargc = argc-j; + cmargv = &argv[j]; + argc = j; + continue; + } + expand_wild_cards(ap, &list_head, &list_tail, &item_count); + } /* * Allocate and fill in the new argument vector, Some Unix's terminate * the list with an extra null pointer. @@ -9296,84 +9296,84 @@ mp_getredirection(pTHX_ int *ac, char ***av) if (argv == NULL) _ckvmssts_noperl(SS$_INSFMEM); *av = argv; for (j = 0; j < item_count; ++j, list_head = list_head->next) - argv[j] = list_head->value; + argv[j] = list_head->value; *ac = item_count; if (cmargv != NULL) - { - if (out != NULL) - { - fprintf(stderr,"'|' and '>' may not both be specified on command line"); - exit(LIB$_INVARGORD); - } - pipe_and_fork(aTHX_ cmargv); - } - + { + if (out != NULL) + { + fprintf(stderr,"'|' and '>' may not both be specified on command line"); + exit(LIB$_INVARGORD); + } + pipe_and_fork(aTHX_ cmargv); + } + /* Check for input from a pipe (mailbox) */ if (in == NULL && 1 == isapipe(0)) - { - char mbxname[L_tmpnam]; - long int bufsize; - long int dvi_item = DVI$_DEVBUFSIZ; - $DESCRIPTOR(mbxnam, ""); - $DESCRIPTOR(mbxdevnam, ""); - - /* Input from a pipe, reopen it in binary mode to disable */ - /* carriage control processing. */ - - fgetname(stdin, mbxname, 1); - mbxnam.dsc$a_pointer = mbxname; - mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer); - lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0); - mbxdevnam.dsc$a_pointer = mbxname; - mbxdevnam.dsc$w_length = sizeof(mbxname); - dvi_item = DVI$_DEVNAM; - lib$getdvi(&dvi_item, 0, &mbxnam, 0, &mbxdevnam, &mbxdevnam.dsc$w_length); - mbxdevnam.dsc$a_pointer[mbxdevnam.dsc$w_length] = '\0'; - set_errno(0); - set_vaxc_errno(1); - freopen(mbxname, "rb", stdin); - if (errno != 0) - { - fprintf(stderr,"Can't reopen input pipe (name: %s) in binary mode",mbxname); - exit(vaxc$errno); - } - } + { + char mbxname[L_tmpnam]; + long int bufsize; + long int dvi_item = DVI$_DEVBUFSIZ; + $DESCRIPTOR(mbxnam, ""); + $DESCRIPTOR(mbxdevnam, ""); + + /* Input from a pipe, reopen it in binary mode to disable */ + /* carriage control processing. */ + + fgetname(stdin, mbxname, 1); + mbxnam.dsc$a_pointer = mbxname; + mbxnam.dsc$w_length = strlen(mbxnam.dsc$a_pointer); + lib$getdvi(&dvi_item, 0, &mbxnam, &bufsize, 0, 0); + mbxdevnam.dsc$a_pointer = mbxname; + mbxdevnam.dsc$w_length = sizeof(mbxname); + dvi_item = DVI$_DEVNAM; + lib$getdvi(&dvi_item, 0, &mbxnam, 0, &mbxdevnam, &mbxdevnam.dsc$w_length); + mbxdevnam.dsc$a_pointer[mbxdevnam.dsc$w_length] = '\0'; + set_errno(0); + set_vaxc_errno(1); + freopen(mbxname, "rb", stdin); + if (errno != 0) + { + fprintf(stderr,"Can't reopen input pipe (name: %s) in binary mode",mbxname); + exit(vaxc$errno); + } + } if ((in != NULL) && (NULL == freopen(in, "r", stdin, "mbc=32", "mbf=2"))) - { - fprintf(stderr,"Can't open input file %s as stdin",in); - exit(vaxc$errno); - } + { + fprintf(stderr,"Can't open input file %s as stdin",in); + exit(vaxc$errno); + } if ((out != NULL) && (NULL == freopen(out, outmode, stdout, "mbc=32", "mbf=2"))) - { - fprintf(stderr,"Can't open output file %s as stdout",out); - exit(vaxc$errno); - } - if (out != NULL) vmssetuserlnm("SYS$OUTPUT", out); + { + fprintf(stderr,"Can't open output file %s as stdout",out); + exit(vaxc$errno); + } + if (out != NULL) vmssetuserlnm("SYS$OUTPUT", out); if (err != NULL) { if (strEQ(err, "&1")) { dup2(fileno(stdout), fileno(stderr)); vmssetuserlnm("SYS$ERROR", "SYS$OUTPUT"); } else { - FILE *tmperr; - if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2"))) - { - fprintf(stderr,"Can't open error file %s as stderr",err); - exit(vaxc$errno); - } - fclose(tmperr); + FILE *tmperr; + if (NULL == (tmperr = fopen(err, errmode, "mbc=32", "mbf=2"))) + { + fprintf(stderr,"Can't open error file %s as stderr",err); + exit(vaxc$errno); + } + fclose(tmperr); if (NULL == freopen(err, "a", stderr, "mbc=32", "mbf=2")) - { - exit(vaxc$errno); - } - vmssetuserlnm("SYS$ERROR", err); - } + { + exit(vaxc$errno); + } + vmssetuserlnm("SYS$ERROR", err); + } } #ifdef ARGPROC_DEBUG PerlIO_printf(Perl_debug_log, "Arglist:\n"); for (j = 0; j < *ac; ++j) - PerlIO_printf(Perl_debug_log, "argv[%d] = '%s'\n", j, argv[j]); + PerlIO_printf(Perl_debug_log, "argv[%d] = '%s'\n", j, argv[j]); #endif /* Clear errors we may have hit expanding wildcards, so they don't show up in Perl's $! later */ @@ -9385,16 +9385,16 @@ static void add_item(struct list_item **head, struct list_item **tail, char *value, int *count) { if (*head == 0) - { - *head = (struct list_item *) PerlMem_malloc(sizeof(struct list_item)); - if (head == NULL) _ckvmssts_noperl(SS$_INSFMEM); - *tail = *head; - } + { + *head = (struct list_item *) PerlMem_malloc(sizeof(struct list_item)); + if (head == NULL) _ckvmssts_noperl(SS$_INSFMEM); + *tail = *head; + } else { - (*tail)->next = (struct list_item *) PerlMem_malloc(sizeof(struct list_item)); - if ((*tail)->next == NULL) _ckvmssts_noperl(SS$_INSFMEM); - *tail = (*tail)->next; - } + (*tail)->next = (struct list_item *) PerlMem_malloc(sizeof(struct list_item)); + if ((*tail)->next == NULL) _ckvmssts_noperl(SS$_INSFMEM); + *tail = (*tail)->next; + } (*tail)->value = value; ++(*count); } @@ -9424,14 +9424,14 @@ mp_expand_wild_cards(pTHX_ char *item, struct list_item **head, #endif for (cp = item; *cp; cp++) { - if (*cp == '*' || *cp == '%' || isSPACE_L1(*cp)) break; - if (*cp == '.' && *(cp-1) == '.' && *(cp-2) =='.') break; + if (*cp == '*' || *cp == '%' || isSPACE_L1(*cp)) break; + if (*cp == '.' && *(cp-1) == '.' && *(cp-2) =='.') break; } if (!*cp || isSPACE_L1(*cp)) - { - add_item(head, tail, item, count); - return; - } + { + add_item(head, tail, item, count); + return; + } else { /* "double quoted" wild card expressions pass as is */ @@ -9467,58 +9467,58 @@ mp_expand_wild_cards(pTHX_ char *item, struct list_item **head, had_directory = (isunix || NULL != strchr(item, '[')) || (NULL != strchr(item, '<')); while ($VMS_STATUS_SUCCESS(sts = lib$find_file - (&filespec, &resultspec, &context, - &defaultspec, 0, &rms_sts, &lff_flags))) - { - char *string; - char *c; + (&filespec, &resultspec, &context, + &defaultspec, 0, &rms_sts, &lff_flags))) + { + char *string; + char *c; - string = (char *)PerlMem_malloc(resultspec.dsc$w_length+1); + string = (char *)PerlMem_malloc(resultspec.dsc$w_length+1); if (string == NULL) _ckvmssts_noperl(SS$_INSFMEM); - my_strlcpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length+1); - if (NULL == had_version) - *(strrchr(string, ';')) = '\0'; - if ((!had_directory) && (had_device == NULL)) - { - if (NULL == (devdir = strrchr(string, ']'))) - devdir = strrchr(string, '>'); - my_strlcpy(string, devdir + 1, resultspec.dsc$w_length+1); - } - /* - * Be consistent with what the C RTL has already done to the rest of - * the argv items and lowercase all of these names. - */ - if (!DECC_EFS_CASE_PRESERVE) { - for (c = string; *c; ++c) - if (isupper(*c)) - *c = toLOWER_L1(*c); - } - if (isunix) trim_unixpath(string,item,1); - add_item(head, tail, string, count); - ++expcount; + my_strlcpy(string, resultspec.dsc$a_pointer, resultspec.dsc$w_length+1); + if (NULL == had_version) + *(strrchr(string, ';')) = '\0'; + if ((!had_directory) && (had_device == NULL)) + { + if (NULL == (devdir = strrchr(string, ']'))) + devdir = strrchr(string, '>'); + my_strlcpy(string, devdir + 1, resultspec.dsc$w_length+1); + } + /* + * Be consistent with what the C RTL has already done to the rest of + * the argv items and lowercase all of these names. + */ + if (!DECC_EFS_CASE_PRESERVE) { + for (c = string; *c; ++c) + if (isupper(*c)) + *c = toLOWER_L1(*c); + } + if (isunix) trim_unixpath(string,item,1); + add_item(head, tail, string, count); + ++expcount; } PerlMem_free(vmsspec); if (sts != RMS$_NMF) - { - set_vaxc_errno(sts); - switch (sts) - { - case RMS$_FNF: case RMS$_DNF: - set_errno(ENOENT); break; - case RMS$_DIR: - set_errno(ENOTDIR); break; - case RMS$_DEV: - set_errno(ENODEV); break; - case RMS$_FNM: case RMS$_SYN: - set_errno(EINVAL); break; - case RMS$_PRV: - set_errno(EACCES); break; - default: - _ckvmssts_noperl(sts); - } - } + { + set_vaxc_errno(sts); + switch (sts) + { + case RMS$_FNF: case RMS$_DNF: + set_errno(ENOENT); break; + case RMS$_DIR: + set_errno(ENOTDIR); break; + case RMS$_DEV: + set_errno(ENODEV); break; + case RMS$_FNM: case RMS$_SYN: + set_errno(EINVAL); break; + case RMS$_PRV: + set_errno(EACCES); break; + default: + _ckvmssts_noperl(sts); + } + } if (expcount == 0) - add_item(head, tail, item, count); + add_item(head, tail, item, count); _ckvmssts_noperl(lib$sfree1_dd(&resultspec)); _ckvmssts_noperl(lib$find_file_end(&context)); } @@ -9557,12 +9557,12 @@ pipe_and_fork(pTHX_ char **cmargv) *p++ = '"'; l++; } - } + } } else { if ((quote||tquote) && *q == '"') { *p++ = '"'; l++; - } + } *p++ = *q++; l++; } @@ -9591,20 +9591,20 @@ background_process(pTHX_ int argc, char **argv) len = my_strlcat(command, argv[0], sizeof(command)); while (--argc && (len < MAX_DCL_SYMBOL)) - { - my_strlcat(command, " \"", sizeof(command)); - my_strlcat(command, *(++argv), sizeof(command)); - len = my_strlcat(command, "\"", sizeof(command)); - } + { + my_strlcat(command, " \"", sizeof(command)); + my_strlcat(command, *(++argv), sizeof(command)); + len = my_strlcat(command, "\"", sizeof(command)); + } value.dsc$a_pointer = command; value.dsc$w_length = strlen(value.dsc$a_pointer); _ckvmssts_noperl(lib$set_symbol(&cmd, &value)); retsts = lib$spawn(&cmd, &null, 0, &flags, 0, &pid); if (retsts == 0x38250) { /* DCL-W-NOTIFY - We must be BATCH, so retry */ - _ckvmssts_noperl(lib$spawn(&cmd, &null, 0, &one, 0, &pid)); + _ckvmssts_noperl(lib$spawn(&cmd, &null, 0, &one, 0, &pid)); } else { - _ckvmssts_noperl(retsts); + _ckvmssts_noperl(retsts); } #ifdef ARGPROC_DEBUG PerlIO_printf(Perl_debug_log, "%s\n", command); @@ -9711,11 +9711,11 @@ vms_image_init(int *argcp, char ***argvp) if (ulen > 7) { zeros = strstr(argvp[0][0], "/000000/"); if (zeros != NULL) { - int mlen; - mlen = ulen - (zeros - argvp[0][0]) - 7; - memmove(zeros, &zeros[7], mlen); - ulen = ulen - 7; - argvp[0][0][ulen] = '\0'; + int mlen; + mlen = ulen - (zeros - argvp[0][0]) - 7; + memmove(zeros, &zeros[7], mlen); + ulen = ulen - 7; + argvp[0][0][ulen] = '\0'; } } /* It also may have a trailing dot that needs to be removed otherwise @@ -9766,7 +9766,7 @@ vms_image_init(int *argcp, char ***argvp) tabidx++) { if (!tabidx) { tabvec = (struct dsc$descriptor_s **) - PerlMem_malloc(tabct * sizeof(struct dsc$descriptor_s *)); + PerlMem_malloc(tabct * sizeof(struct dsc$descriptor_s *)); if (tabvec == NULL) _ckvmssts_noperl(SS$_INSFMEM); } else if (tabidx >= tabct) { @@ -9827,7 +9827,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) if (strpbrk(wildspec,"]>:") != NULL) { if (int_tounixspec(wildspec, unixwild, NULL) == NULL) { PerlMem_free(unixwild); - return 0; + return 0; } } else { @@ -9839,7 +9839,7 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) if (int_tounixspec(fspec, unixified, NULL) == NULL) { PerlMem_free(unixwild); PerlMem_free(unixified); - return 0; + return 0; } else base = unixified; /* reslen != 0 ==> we had to unixify resultant filespec, so we must @@ -9853,12 +9853,12 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) PerlMem_free(unixwild); if (base == fspec) { PerlMem_free(unixified); - return 1; + return 1; } tmplen = strlen(unixified); if (tmplen > reslen) { PerlMem_free(unixified); - return 0; /* not enough space */ + return 0; /* not enough space */ } /* Copy unixified resultant, including trailing NUL */ memmove(fspec,unixified,tmplen+1); @@ -9899,22 +9899,22 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) * could match template). */ if (getcwd(tpl, (VMS_MAXRSS - 1),0) == NULL) { - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); - return 0; + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); + return 0; } if (!DECC_EFS_CASE_PRESERVE) { - for (cp1 = tpl, cp2 = base; *cp1 && *cp2; cp1++,cp2++) - if (toLOWER_L1(*cp1) != toLOWER_L1(*cp2)) break; + for (cp1 = tpl, cp2 = base; *cp1 && *cp2; cp1++,cp2++) + if (toLOWER_L1(*cp1) != toLOWER_L1(*cp2)) break; } segdirs = dirs - totells; /* Min # of dirs we must have left */ for (front = cp2+1; *front; front++) if (*front == '/') segdirs--; if (*cp1 == '\0' && *cp2 == '/' && segdirs < 1) { memmove(fspec,cp2+1,end - cp2); - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); return 1; } } @@ -9927,19 +9927,19 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) if (lcres == NULL) _ckvmssts_noperl(SS$_INSFMEM); for (cp1=tplate,cp2=lcres; *cp1 && cp2 <= lcres + (VMS_MAXRSS - 1); cp1++,cp2++) { - if (!DECC_EFS_CASE_PRESERVE) { - *cp2 = toLOWER_L1(*cp1); /* Make lc copy for match */ - } - else { - *cp2 = *cp1; - } + if (!DECC_EFS_CASE_PRESERVE) { + *cp2 = toLOWER_L1(*cp1); /* Make lc copy for match */ + } + else { + *cp2 = *cp1; + } } if (cp1 != '\0') { - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); - PerlMem_free(lcres); - return 0; /* Path too long. */ + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); + PerlMem_free(lcres); + return 0; /* Path too long. */ } lcend = cp2; *cp2 = '\0'; /* Pick up with memcpy later */ @@ -9961,21 +9961,21 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) cp1++, cp2++) { if (*cp1 == '?') *cp2 = '%'; /* Substitute VMS' wildcard for Unix' */ else { - if (!DECC_EFS_CASE_PRESERVE) { - *cp2 = toLOWER_L1(*cp1); /* else lowercase for match */ - } - else { - *cp2 = *cp1; /* else preserve case for match */ - } - } + if (!DECC_EFS_CASE_PRESERVE) { + *cp2 = toLOWER_L1(*cp1); /* else lowercase for match */ + } + else { + *cp2 = *cp1; /* else preserve case for match */ + } + } if (*cp2 == '/') segdirs++; } if (cp1 != ellipsis - 1) { - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); - PerlMem_free(lcres); - return 0; /* Path too long */ + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); + PerlMem_free(lcres); + return 0; /* Path too long */ } /* Back up at least as many dirs as in template before matching */ for (cp1 = lcfront - 1; segdirs && cp1 >= lcres; cp1--) @@ -9989,11 +9989,11 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) for ( ; cp1 >= lcres; cp1--) if (*cp1 == '/') { cp1++; break; } } if (!match) { - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); - PerlMem_free(lcres); - return 0; /* Can't find prefix ??? */ + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); + PerlMem_free(lcres); + return 0; /* Can't find prefix ??? */ } if (match > 1 && opts & 1) { /* This ... wildcard could cover more than one set of dirs (i.e. @@ -10007,24 +10007,24 @@ Perl_trim_unixpath(pTHX_ char *fspec, const char *wildspec, int opts) char def[NAM$C_MAXRSS+1], *st; if (getcwd(def, sizeof def,0) == NULL) { - PerlMem_free(unixified); - PerlMem_free(unixwild); - PerlMem_free(lcres); - PerlMem_free(tpl); - return 0; - } - if (!DECC_EFS_CASE_PRESERVE) { - for (cp1 = def, cp2 = base; *cp1 && *cp2; cp1++,cp2++) - if (toLOWER_L1(*cp1) != toLOWER_L1(*cp2)) break; - } + PerlMem_free(unixified); + PerlMem_free(unixwild); + PerlMem_free(lcres); + PerlMem_free(tpl); + return 0; + } + if (!DECC_EFS_CASE_PRESERVE) { + for (cp1 = def, cp2 = base; *cp1 && *cp2; cp1++,cp2++) + if (toLOWER_L1(*cp1) != toLOWER_L1(*cp2)) break; + } segdirs = dirs - totells; /* Min # of dirs we must have left */ for (st = cp2+1; *st; st++) if (*st == '/') segdirs--; if (*cp1 == '\0' && *cp2 == '/') { memmove(fspec,cp2+1,end - cp2); - PerlMem_free(tpl); - PerlMem_free(unixified); - PerlMem_free(unixwild); - PerlMem_free(lcres); + PerlMem_free(tpl); + PerlMem_free(unixified); + PerlMem_free(unixwild); + PerlMem_free(lcres); return 1; } /* Nope -- stick with lcfront from above and keep going. */ @@ -10135,9 +10135,9 @@ void vmsreaddirversions(DIR *dd, int flag) { if (flag) - dd->flags |= PERL_VMSDIR_M_VERSIONS; + dd->flags |= PERL_VMSDIR_M_VERSIONS; else - dd->flags &= ~PERL_VMSDIR_M_VERSIONS; + dd->flags &= ~PERL_VMSDIR_M_VERSIONS; } /*}}}*/ @@ -10199,20 +10199,20 @@ collectversions(pTHX_ DIR *dd) for (context = 0, e->vms_verscount = 0; e->vms_verscount < VERSIZE(e); e->vms_verscount++) { - unsigned long rsts; - unsigned long flags = 0; + unsigned long rsts; + unsigned long flags = 0; #ifdef VMS_LONGNAME_SUPPORT - flags = LIB$M_FIL_LONG_NAMES; + flags = LIB$M_FIL_LONG_NAMES; #endif - tmpsts = lib$find_file(&pat, &res, &context, NULL, NULL, &rsts, &flags); - if (tmpsts == RMS$_NMF || context == 0) break; - _ckvmssts(tmpsts); - buff[VMS_MAXRSS - 1] = '\0'; - if ((p = strchr(buff, ';'))) - e->vms_versions[e->vms_verscount] = atoi(p + 1); - else - e->vms_versions[e->vms_verscount] = -1; + tmpsts = lib$find_file(&pat, &res, &context, NULL, NULL, &rsts, &flags); + if (tmpsts == RMS$_NMF || context == 0) break; + _ckvmssts(tmpsts); + buff[VMS_MAXRSS - 1] = '\0'; + if ((p = strchr(buff, ';'))) + e->vms_versions[e->vms_verscount] = atoi(p + 1); + else + e->vms_versions[e->vms_verscount] = -1; } _ckvmssts(lib$find_file_end(&context)); @@ -10248,7 +10248,7 @@ Perl_readdir(pTHX_ DIR *dd) #endif tmpsts = lib$find_file - (&dd->pat, &res, &dd->context, NULL, NULL, &rsts, &flags); + (&dd->pat, &res, &dd->context, NULL, NULL, &rsts, &flags); if (dd->context == 0) tmpsts = RMS$_NMF; /* None left. (should be set, but make sure) */ @@ -10283,18 +10283,18 @@ Perl_readdir(pTHX_ DIR *dd) /* Skip any directory component and just copy the name. */ sts = vms_split_path (buff, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) { @@ -10314,9 +10314,9 @@ Perl_readdir(pTHX_ DIR *dd) } /* Drop NULL extensions on UNIX file specification */ - if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { - e_len = 0; - e_spec[0] = '\0'; + if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { + e_len = 0; + e_spec[0] = '\0'; } } @@ -10327,26 +10327,26 @@ Perl_readdir(pTHX_ DIR *dd) /* Convert the filename to UNIX format if needed */ if (dd->flags & PERL_VMSDIR_M_UNIXSPECS) { - /* Translate the encoded characters. */ - /* Fixme: Unicode handling could result in embedded 0 characters */ - if (strchr(dd->entry.d_name, '^') != NULL) { - char new_name[256]; - char * q; - p = dd->entry.d_name; - q = new_name; - while (*p != 0) { - int inchars_read, outchars_added; - inchars_read = copy_expand_vms_filename_escape(q, p, &outchars_added); - p += inchars_read; - q += outchars_added; - /* fix-me */ - /* if outchars_added > 1, then this is a wide file specification */ - /* Wide file specifications need to be passed in Perl */ - /* counted strings apparently with a Unicode flag */ - } - *q = 0; - dd->entry.d_namlen = my_strlcpy(dd->entry.d_name, new_name, sizeof(dd->entry.d_name)); - } + /* Translate the encoded characters. */ + /* Fixme: Unicode handling could result in embedded 0 characters */ + if (strchr(dd->entry.d_name, '^') != NULL) { + char new_name[256]; + char * q; + p = dd->entry.d_name; + q = new_name; + while (*p != 0) { + int inchars_read, outchars_added; + inchars_read = copy_expand_vms_filename_escape(q, p, &outchars_added); + p += inchars_read; + q += outchars_added; + /* fix-me */ + /* if outchars_added > 1, then this is a wide file specification */ + /* Wide file specifications need to be passed in Perl */ + /* counted strings apparently with a Unicode flag */ + } + *q = 0; + dd->entry.d_namlen = my_strlcpy(dd->entry.d_name, new_name, sizeof(dd->entry.d_name)); + } } dd->entry.vms_verscount = 0; @@ -10401,7 +10401,7 @@ Perl_seekdir(pTHX_ DIR *dd, long count) /* If we haven't done anything yet... */ if (dd->count == 0) - return; + return; /* Remember some state, and clear it. */ old_flags = dd->flags; @@ -10411,7 +10411,7 @@ Perl_seekdir(pTHX_ DIR *dd, long count) /* The increment is in readdir(). */ for (dd->count = 0; dd->count < count; ) - readdir(dd); + readdir(dd); dd->flags = old_flags; @@ -10704,10 +10704,10 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags); if (!(retsts & 1) && *s == '$') { _ckvmssts_noperl(lib$find_file_end(&cxt)); - imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--; - retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags); - if (!(retsts&1)) { - _ckvmssts_noperl(lib$find_file_end(&cxt)); + imgdsc.dsc$a_pointer++; imgdsc.dsc$w_length--; + retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc,0,&rsts,&flags); + if (!(retsts&1)) { + _ckvmssts_noperl(lib$find_file_end(&cxt)); retsts = lib$find_file(&imgdsc,&resdsc,&cxt,&defdsc2,0,&rsts,&flags); } } @@ -10726,109 +10726,109 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, char b[256] = {0,0,0,0}; read(fileno(fp), b, 256); isdcl = isPRINT_L1(b[0]) && isPRINT_L1(b[1]) && isPRINT_L1(b[2]) && isPRINT_L1(b[3]); - if (isdcl) { - int shebang_len; + if (isdcl) { + int shebang_len; - /* Check for script */ - shebang_len = 0; - if ((b[0] == '#') && (b[1] == '!')) - shebang_len = 2; + /* Check for script */ + shebang_len = 0; + if ((b[0] == '#') && (b[1] == '!')) + shebang_len = 2; #ifdef ALTERNATE_SHEBANG - else { - if (strEQ(b, ALTERNATE_SHEBANG)) { - char * perlstr; - perlstr = strstr("perl",b); - if (perlstr == NULL) - shebang_len = 0; + else { + if (strEQ(b, ALTERNATE_SHEBANG)) { + char * perlstr; + perlstr = strstr("perl",b); + if (perlstr == NULL) + shebang_len = 0; else shebang_len = strlen(ALTERNATE_SHEBANG); - } - else - shebang_len = 0; - } + } + else + shebang_len = 0; + } #endif - if (shebang_len > 0) { - int i; - int j; - char tmpspec[NAM$C_MAXRSS + 1]; - - i = shebang_len; - /* Image is following after white space */ - /*--------------------------------------*/ - while (isPRINT_L1(b[i]) && isSPACE_L1(b[i])) - i++; - - j = 0; - while (isPRINT_L1(b[i]) && !isSPACE_L1(b[i])) { - tmpspec[j++] = b[i++]; - if (j >= NAM$C_MAXRSS) - break; - } - tmpspec[j] = '\0'; - - /* There may be some default parameters to the image */ - /*---------------------------------------------------*/ - j = 0; - while (isPRINT_L1(b[i])) { - image_argv[j++] = b[i++]; - if (j >= NAM$C_MAXRSS) - break; - } - while ((j > 0) && !isPRINT_L1(image_argv[j-1])) - j--; - image_argv[j] = 0; - - /* It will need to be converted to VMS format and validated */ - if (tmpspec[0] != '\0') { - char * iname; - - /* Try to find the exact program requested to be run */ - /*---------------------------------------------------*/ - iname = int_rmsexpand - (tmpspec, image_name, ".exe", - PERL_RMSEXPAND_M_VMS, NULL, NULL); - if (iname != NULL) { - if (cando_by_name_int - (S_IXUSR,0,image_name,PERL_RMSEXPAND_M_VMS_IN)) { - /* MCR prefix needed */ - isdcl = 0; - } - else { - /* Try again with a null type */ - /*----------------------------*/ - iname = int_rmsexpand - (tmpspec, image_name, ".", - PERL_RMSEXPAND_M_VMS, NULL, NULL); - if (iname != NULL) { - if (cando_by_name_int - (S_IXUSR,0,image_name, PERL_RMSEXPAND_M_VMS_IN)) { - /* MCR prefix needed */ - isdcl = 0; - } - } - } - - /* Did we find the image to run the script? */ - /*------------------------------------------*/ - if (isdcl) { - char *tchr; - - /* Assume DCL or foreign command exists */ - /*--------------------------------------*/ - tchr = strrchr(tmpspec, '/'); - if (tchr != NULL) { - tchr++; - } - else { - tchr = tmpspec; - } - my_strlcpy(image_name, tchr, sizeof(image_name)); - } - } - } - } - } + if (shebang_len > 0) { + int i; + int j; + char tmpspec[NAM$C_MAXRSS + 1]; + + i = shebang_len; + /* Image is following after white space */ + /*--------------------------------------*/ + while (isPRINT_L1(b[i]) && isSPACE_L1(b[i])) + i++; + + j = 0; + while (isPRINT_L1(b[i]) && !isSPACE_L1(b[i])) { + tmpspec[j++] = b[i++]; + if (j >= NAM$C_MAXRSS) + break; + } + tmpspec[j] = '\0'; + + /* There may be some default parameters to the image */ + /*---------------------------------------------------*/ + j = 0; + while (isPRINT_L1(b[i])) { + image_argv[j++] = b[i++]; + if (j >= NAM$C_MAXRSS) + break; + } + while ((j > 0) && !isPRINT_L1(image_argv[j-1])) + j--; + image_argv[j] = 0; + + /* It will need to be converted to VMS format and validated */ + if (tmpspec[0] != '\0') { + char * iname; + + /* Try to find the exact program requested to be run */ + /*---------------------------------------------------*/ + iname = int_rmsexpand + (tmpspec, image_name, ".exe", + PERL_RMSEXPAND_M_VMS, NULL, NULL); + if (iname != NULL) { + if (cando_by_name_int + (S_IXUSR,0,image_name,PERL_RMSEXPAND_M_VMS_IN)) { + /* MCR prefix needed */ + isdcl = 0; + } + else { + /* Try again with a null type */ + /*----------------------------*/ + iname = int_rmsexpand + (tmpspec, image_name, ".", + PERL_RMSEXPAND_M_VMS, NULL, NULL); + if (iname != NULL) { + if (cando_by_name_int + (S_IXUSR,0,image_name, PERL_RMSEXPAND_M_VMS_IN)) { + /* MCR prefix needed */ + isdcl = 0; + } + } + } + + /* Did we find the image to run the script? */ + /*------------------------------------------*/ + if (isdcl) { + char *tchr; + + /* Assume DCL or foreign command exists */ + /*--------------------------------------*/ + tchr = strrchr(tmpspec, '/'); + if (tchr != NULL) { + tchr++; + } + else { + tchr = tmpspec; + } + my_strlcpy(image_name, tchr, sizeof(image_name)); + } + } + } + } + } fclose(fp); } if (check_img && isdcl) { @@ -10840,44 +10840,44 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, if (cando_by_name(S_IXUSR,0,resspec)) { vmscmd->dsc$a_pointer = (char *)PerlMem_malloc(MAX_DCL_LINE_LENGTH); - if (vmscmd->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM); + if (vmscmd->dsc$a_pointer == NULL) _ckvmssts_noperl(SS$_INSFMEM); if (!isdcl) { my_strlcpy(vmscmd->dsc$a_pointer,"$ MCR ", MAX_DCL_LINE_LENGTH); - if (image_name[0] != 0) { - my_strlcat(vmscmd->dsc$a_pointer, image_name, MAX_DCL_LINE_LENGTH); - my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); - } - } else if (image_name[0] != 0) { - my_strlcpy(vmscmd->dsc$a_pointer, image_name, MAX_DCL_LINE_LENGTH); - my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); + if (image_name[0] != 0) { + my_strlcat(vmscmd->dsc$a_pointer, image_name, MAX_DCL_LINE_LENGTH); + my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); + } + } else if (image_name[0] != 0) { + my_strlcpy(vmscmd->dsc$a_pointer, image_name, MAX_DCL_LINE_LENGTH); + my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); } else { my_strlcpy(vmscmd->dsc$a_pointer, "@", MAX_DCL_LINE_LENGTH); } if (suggest_quote) *suggest_quote = 1; - /* If there is an image name, use original command */ - if (image_name[0] == 0) - my_strlcat(vmscmd->dsc$a_pointer, resspec, MAX_DCL_LINE_LENGTH); - else { - rest = cmd; - while (*rest && isSPACE_L1(*rest)) rest++; - } - - if (image_argv[0] != 0) { - my_strlcat(vmscmd->dsc$a_pointer, image_argv, MAX_DCL_LINE_LENGTH); - my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); - } + /* If there is an image name, use original command */ + if (image_name[0] == 0) + my_strlcat(vmscmd->dsc$a_pointer, resspec, MAX_DCL_LINE_LENGTH); + else { + rest = cmd; + while (*rest && isSPACE_L1(*rest)) rest++; + } + + if (image_argv[0] != 0) { + my_strlcat(vmscmd->dsc$a_pointer, image_argv, MAX_DCL_LINE_LENGTH); + my_strlcat(vmscmd->dsc$a_pointer, " ", MAX_DCL_LINE_LENGTH); + } if (rest) { - int rest_len; - int vmscmd_len; - - rest_len = strlen(rest); - vmscmd_len = strlen(vmscmd->dsc$a_pointer); - if ((rest_len + vmscmd_len) < MAX_DCL_LINE_LENGTH) - my_strlcat(vmscmd->dsc$a_pointer, rest, MAX_DCL_LINE_LENGTH); - else - retsts = CLI$_BUFOVF; - } + int rest_len; + int vmscmd_len; + + rest_len = strlen(rest); + vmscmd_len = strlen(vmscmd->dsc$a_pointer); + if ((rest_len + vmscmd_len) < MAX_DCL_LINE_LENGTH) + my_strlcat(vmscmd->dsc$a_pointer, rest, MAX_DCL_LINE_LENGTH); + else + retsts = CLI$_BUFOVF; + } vmscmd->dsc$w_length = strlen(vmscmd->dsc$a_pointer); PerlMem_free(cmd); PerlMem_free(vmsspec); @@ -10885,7 +10885,7 @@ setup_cmddsc(pTHX_ const char *incmd, int check_img, int *suggest_quote, return (vmscmd->dsc$w_length > MAX_DCL_LINE_LENGTH ? CLI$_BUFOVF : retsts); } else - retsts = RMS$_PRV; + retsts = RMS$_PRV; } } /* It's either a DCL command or we couldn't find a suitable image */ @@ -11021,8 +11021,8 @@ Perl_do_aspawn(pTHX_ SV* really, SV** mark, SV** sp) * waiting for completion -- other values are ignored. */ if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { - ++mark; - flags = SvIVx(*mark); + ++mark; + flags = SvIVx(*mark); } if (flags && flags == 1) /* the Win32 P_NOWAIT value */ @@ -11094,7 +11094,7 @@ do_spawn2(pTHX_ const char *cmd, int flags) set_vaxc_errno(sts); if (ckWARN(WARN_EXEC)) { Perl_warner(aTHX_ packWARN(WARN_EXEC),"Can't spawn: %s", - Strerror(errno)); + Strerror(errno)); } } sts = substs; @@ -11227,10 +11227,10 @@ Perl_my_flush(pTHX_ FILE *fp) int res; if ((res = fflush(fp)) == 0 && fp) { #ifdef VMS_DO_SOCKETS - Stat_t s; - if (fstat(fileno(fp), &s.crtl_stat) == 0 && !S_ISSOCK(s.st_mode)) + Stat_t s; + if (fstat(fileno(fp), &s.crtl_stat) == 0 && !S_ISSOCK(s.st_mode)) #endif - res = fsync(fileno(fp)); + res = fsync(fileno(fp)); } /* * If the flush succeeded but set end-of-file, we need to clear @@ -11802,7 +11802,7 @@ encode_dev (pTHX_ const char *dev) i = 0; for (q = dev + strlen(dev); q >= dev; q--) { if (*q == ':') - break; + break; if (isdigit (*q)) c= (*q) - '0'; else if (isALPHA_A(toUPPER_A(*q))) @@ -11818,10 +11818,10 @@ encode_dev (pTHX_ const char *dev) } /* end of encode_dev() */ #define VMS_DEVICE_ENCODE(device_no, devname, new_dev_no) \ - device_no = encode_dev(aTHX_ devname) + device_no = encode_dev(aTHX_ devname) #else #define VMS_DEVICE_ENCODE(device_no, devname, new_dev_no) \ - device_no = new_dev_no + device_no = new_dev_no #endif static int @@ -11946,9 +11946,9 @@ Perl_cando_by_name_int(pTHX_ I32 bit, bool effective, const char *fname, int opt break; default: if (fileified != NULL) - PerlMem_free(fileified); + PerlMem_free(fileified); if (vmsname != NULL) - PerlMem_free(vmsname); + PerlMem_free(vmsname); return FALSE; } @@ -12016,7 +12016,7 @@ bool Perl_cando(pTHX_ Mode_t bit, bool effective, const Stat_t *statbufp) { return cando_by_name_int - (bit, effective, statbufp->st_devnam, PERL_RMSEXPAND_M_VMS_IN); + (bit, effective, statbufp->st_devnam, PERL_RMSEXPAND_M_VMS_IN); } /* end of cando() */ /*}}}*/ @@ -12047,22 +12047,22 @@ Perl_flex_fstat(pTHX_ int fd, Stat_t *statbufp) /* This should not happen, but just in case */ if (cptr == NULL) { - statbufp->st_devnam[0] = 0; + statbufp->st_devnam[0] = 0; } else { - /* Make sure that the saved name fits in 255 characters */ - cptr = int_rmsexpand_vms - (vms_filename, - statbufp->st_devnam, - 0); - if (cptr == NULL) - statbufp->st_devnam[0] = 0; + /* Make sure that the saved name fits in 255 characters */ + cptr = int_rmsexpand_vms + (vms_filename, + statbufp->st_devnam, + 0); + if (cptr == NULL) + statbufp->st_devnam[0] = 0; } PerlMem_free(vms_filename); VMS_INO_T_COPY(statbufp->st_ino, statbufp->crtl_stat.st_ino); VMS_DEVICE_ENCODE - (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev); + (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev); # ifdef VMSISH_TIME if (VMSISH_TIME) { @@ -12098,14 +12098,14 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) if (decc_bug_devnull != 0) { if (is_null_device(fspec)) { /* Fake a stat() for the null device */ - memset(statbufp,0,sizeof *statbufp); + memset(statbufp,0,sizeof *statbufp); VMS_DEVICE_ENCODE(statbufp->st_dev, "_NLA0:", 0); - statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC; - statbufp->st_uid = 0x00010001; - statbufp->st_gid = 0x0001; - time((time_t *)&statbufp->st_mtime); - statbufp->st_atime = statbufp->st_ctime = statbufp->st_mtime; - return 0; + statbufp->st_mode = S_IFBLK | S_IREAD | S_IWRITE | S_IEXEC; + statbufp->st_uid = 0x00010001; + statbufp->st_gid = 0x0001; + time((time_t *)&statbufp->st_mtime); + statbufp->st_atime = statbufp->st_ctime = statbufp->st_mtime; + return 0; } } @@ -12181,9 +12181,9 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) if (!DECC_EFS_CHARSET && (efs_charset_index > 0)) decc$feature_set_value(efs_charset_index, 1, 1); if (lstat_flag == 0) - retval = stat(fspec, &statbufp->crtl_stat); + retval = stat(fspec, &statbufp->crtl_stat); else - retval = lstat(fspec, &statbufp->crtl_stat); + retval = lstat(fspec, &statbufp->crtl_stat); save_spec = fspec; if (!DECC_EFS_CHARSET && (efs_charset_index > 0)) { decc$feature_set_value(efs_charset_index, 1, 0); @@ -12211,7 +12211,7 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) /* If this is an lstat, do not follow the link */ if (lstat_flag) - rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK; + rmsex_flags |= PERL_RMSEXPAND_M_SYMLINK; /* If we used the efs_hack above, we must also use it here for */ /* perl_cando to work */ @@ -12246,11 +12246,11 @@ Perl_flex_stat_int(pTHX_ const char *fspec, Stat_t *statbufp, int lstat_flag) /* Fix me: If this is NULL then stat found a file, and we could */ /* not convert the specification to VMS - Should never happen */ if (cptr == NULL) - statbufp->st_devnam[0] = 0; + statbufp->st_devnam[0] = 0; VMS_INO_T_COPY(statbufp->st_ino, statbufp->crtl_stat.st_ino); VMS_DEVICE_ENCODE - (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev); + (statbufp->st_dev, statbufp->st_devnam, statbufp->crtl_stat.st_dev); # ifdef VMSISH_TIME if (VMSISH_TIME) { statbufp->st_mtime = _toloc(statbufp->st_mtime); @@ -12370,7 +12370,7 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates rms_nam_rsll(nam) = 0; #ifdef NAM$M_NO_SHORT_UPCASE if (DECC_EFS_CASE_PRESERVE) - rms_set_nam_nop(nam, NAM$M_NO_SHORT_UPCASE); + rms_set_nam_nop(nam, NAM$M_NO_SHORT_UPCASE); #endif xabdat = cc$rms_xabdat; /* To get creation date */ @@ -12386,10 +12386,10 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates PerlMem_free(vmsout); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(rsa); if (rsal != NULL) - PerlMem_free(rsal); + PerlMem_free(rsal); set_vaxc_errno(sts); switch (sts) { case RMS$_FNF: case RMS$_DNF: @@ -12437,27 +12437,27 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates rms_set_nam_nop(nam_out, NAM$M_SYNCHK); fab_out.fab$l_xab = NULL; /* Don't disturb data from input file */ if (!((sts = sys$parse(&fab_out)) & STS$K_SUCCESS)) { - PerlMem_free(vmsin); - PerlMem_free(vmsout); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(rsa); - if (rsal != NULL) - PerlMem_free(rsal); - PerlMem_free(esa_out); - if (esal_out != NULL) - PerlMem_free(esal_out); - PerlMem_free(rsa_out); - if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(vmsin); + PerlMem_free(vmsout); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(rsa); + if (rsal != NULL) + PerlMem_free(rsal); + PerlMem_free(esa_out); + if (esal_out != NULL) + PerlMem_free(esal_out); + PerlMem_free(rsa_out); + if (rsal_out != NULL) + PerlMem_free(rsal_out); set_errno(sts == RMS$_SYN ? EINVAL : EVMSERR); set_vaxc_errno(sts); return 0; } fab_out.fab$l_xab = (void *) &xabdat; if (rms_is_nam_fnb(nam, NAM$M_EXP_NAME | NAM$M_EXP_TYPE)) - preserve_dates = 1; + preserve_dates = 1; } if (preserve_dates < 0) /* Clear all bits; we'll use it as a */ preserve_dates =0; /* bitmask from this point forward */ @@ -12468,16 +12468,16 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates PerlMem_free(vmsout); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(rsa); if (rsal != NULL) - PerlMem_free(rsal); + PerlMem_free(rsal); PerlMem_free(esa_out); if (esal_out != NULL) - PerlMem_free(esal_out); + PerlMem_free(esal_out); PerlMem_free(rsa_out); if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(rsal_out); set_vaxc_errno(sts); switch (sts) { case RMS$_DNF: @@ -12517,16 +12517,16 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates PerlMem_free(ubf); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(rsa); if (rsal != NULL) - PerlMem_free(rsal); + PerlMem_free(rsal); PerlMem_free(esa_out); if (esal_out != NULL) - PerlMem_free(esal_out); + PerlMem_free(esal_out); PerlMem_free(rsa_out); if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(rsal_out); set_errno(EVMSERR); set_vaxc_errno(sts); return 0; } @@ -12541,16 +12541,16 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates PerlMem_free(ubf); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(rsa); if (rsal != NULL) - PerlMem_free(rsal); + PerlMem_free(rsal); PerlMem_free(esa_out); if (esal_out != NULL) - PerlMem_free(esal_out); + PerlMem_free(esal_out); PerlMem_free(rsa_out); if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(rsal_out); set_errno(EVMSERR); set_vaxc_errno(sts); return 0; } @@ -12560,21 +12560,21 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates rab_out.rab$w_rsz = rab_in.rab$w_rsz; if (!(sts & 1) || !((sts = sys$write(&rab_out)) & 1)) { sys$close(&fab_in); sys$close(&fab_out); - PerlMem_free(vmsin); - PerlMem_free(vmsout); - PerlMem_free(ubf); - PerlMem_free(esa); - if (esal != NULL) - PerlMem_free(esal); - PerlMem_free(rsa); - if (rsal != NULL) - PerlMem_free(rsal); - PerlMem_free(esa_out); - if (esal_out != NULL) - PerlMem_free(esal_out); - PerlMem_free(rsa_out); - if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(vmsin); + PerlMem_free(vmsout); + PerlMem_free(ubf); + PerlMem_free(esa); + if (esal != NULL) + PerlMem_free(esal); + PerlMem_free(rsa); + if (rsal != NULL) + PerlMem_free(rsal); + PerlMem_free(esa_out); + if (esal_out != NULL) + PerlMem_free(esal_out); + PerlMem_free(rsa_out); + if (rsal_out != NULL) + PerlMem_free(rsal_out); set_errno(EVMSERR); set_vaxc_errno(sts); return 0; } @@ -12590,16 +12590,16 @@ Perl_rmscopy(pTHX_ const char *spec_in, const char *spec_out, int preserve_dates PerlMem_free(ubf); PerlMem_free(esa); if (esal != NULL) - PerlMem_free(esal); + PerlMem_free(esal); PerlMem_free(rsa); if (rsal != NULL) - PerlMem_free(rsal); + PerlMem_free(rsal); PerlMem_free(esa_out); if (esal_out != NULL) - PerlMem_free(esal_out); + PerlMem_free(esal_out); PerlMem_free(rsa_out); if (rsal_out != NULL) - PerlMem_free(rsal_out); + PerlMem_free(rsal_out); if (!(sts & 1)) { set_errno(EVMSERR); set_vaxc_errno(sts); @@ -12645,7 +12645,7 @@ rmsexpand_fromperl(pTHX_ CV *cv) if (rslt != NULL) { sv_usepvn(ST(0),rslt,strlen(rslt)); if (fs_utf8) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12666,7 +12666,7 @@ vmsify_fromperl(pTHX_ CV *cv) if (vmsified != NULL) { sv_usepvn(ST(0),vmsified,strlen(vmsified)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12687,7 +12687,7 @@ unixify_fromperl(pTHX_ CV *cv) if (unixified != NULL) { sv_usepvn(ST(0),unixified,strlen(unixified)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12708,7 +12708,7 @@ fileify_fromperl(pTHX_ CV *cv) if (fileified != NULL) { sv_usepvn(ST(0),fileified,strlen(fileified)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12729,7 +12729,7 @@ pathify_fromperl(pTHX_ CV *cv) if (pathified != NULL) { sv_usepvn(ST(0),pathified,strlen(pathified)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12750,7 +12750,7 @@ vmspath_fromperl(pTHX_ CV *cv) if (vmspath != NULL) { sv_usepvn(ST(0),vmspath,strlen(vmspath)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12771,7 +12771,7 @@ unixpath_fromperl(pTHX_ CV *cv) if (unixpath != NULL) { sv_usepvn(ST(0),unixpath,strlen(unixpath)); if (utf8_fl) { - SvUTF8_on(ST(0)); + SvUTF8_on(ST(0)); } } XSRETURN(1); @@ -12917,7 +12917,7 @@ mod2fname(pTHX_ CV *cv) last = 0; for (source = work_name; *source; source++) { if (last == *source && last == '_') { - continue; + continue; } *dest++ = *source; last = *source; @@ -12930,11 +12930,11 @@ mod2fname(pTHX_ CV *cv) last = 0; dest = workbuff; for (source = work_name; *source; source++) { - if (last == toUPPER_A(*source)) { - continue; - } - *dest++ = *source; - last = toUPPER_A(*source); + if (last == toUPPER_A(*source)) { + continue; + } + *dest++ = *source; + last = toUPPER_A(*source); } my_strlcpy(work_name, workbuff, sizeof(work_name)); } @@ -13009,31 +13009,31 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) Newx(vmsspec, VMS_MAXRSS, char); - /* We could find out if there's an explicit dev/dir or version - by peeking into lib$find_file's internal context at - ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb - but that's unsupported, so I don't want to do it now and - have it bite someone in the future. */ - /* Fix-me: vms_split_path() is the only way to do this, the - existing method will fail with many legal EFS or UNIX specifications - */ + /* We could find out if there's an explicit dev/dir or version + by peeking into lib$find_file's internal context at + ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb + but that's unsupported, so I don't want to do it now and + have it bite someone in the future. */ + /* Fix-me: vms_split_path() is the only way to do this, the + existing method will fail with many legal EFS or UNIX specifications + */ cp = SvPV(tmpglob,i); for (; i; i--) { - if (cp[i] == ';') hasver = 1; - if (cp[i] == '.') { - if (sts) hasver = 1; - else sts = 1; - } - if (cp[i] == '/') { - hasdir = isunix = 1; - break; - } - if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') { - hasdir = 1; - break; - } + if (cp[i] == ';') hasver = 1; + if (cp[i] == '.') { + if (sts) hasver = 1; + else sts = 1; + } + if (cp[i] == '/') { + hasdir = isunix = 1; + break; + } + if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') { + hasdir = 1; + break; + } } /* In UNIX report mode, assume UNIX unless VMS directory delimiters seen */ @@ -13042,15 +13042,15 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) } if ((tmpfp = PerlIO_tmpfile()) != NULL) { - char * wv_spec, * wr_spec, * wd_spec, * wn_spec, * we_spec, * wvs_spec; - int wv_sts, wv_len, wr_len, wd_len, wn_len, we_len, wvs_len; - int wildstar = 0; - int wildquery = 0; - int found = 0; - Stat_t st; - int stat_sts; - stat_sts = PerlLIO_stat(SvPVX_const(tmpglob),&st); - if (!stat_sts && S_ISDIR(st.st_mode)) { + char * wv_spec, * wr_spec, * wd_spec, * wn_spec, * we_spec, * wvs_spec; + int wv_sts, wv_len, wr_len, wd_len, wn_len, we_len, wvs_len; + int wildstar = 0; + int wildquery = 0; + int found = 0; + Stat_t st; + int stat_sts; + stat_sts = PerlLIO_stat(SvPVX_const(tmpglob),&st); + if (!stat_sts && S_ISDIR(st.st_mode)) { char * vms_dir; const char * fname; STRLEN fname_len; @@ -13076,18 +13076,18 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) wilddsc.dsc$a_pointer = st.st_devnam; ok = 1; } - } - else { - wilddsc.dsc$a_pointer = tovmsspec_utf8(SvPVX(tmpglob),vmsspec,NULL); - ok = (wilddsc.dsc$a_pointer != NULL); - } - if (ok) - wilddsc.dsc$w_length = strlen(wilddsc.dsc$a_pointer); - - /* If not extended character set, replace ? with % */ - /* With extended character set, ? is a wildcard single character */ - for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++) { - if (*cp == '?') { + } + else { + wilddsc.dsc$a_pointer = tovmsspec_utf8(SvPVX(tmpglob),vmsspec,NULL); + ok = (wilddsc.dsc$a_pointer != NULL); + } + if (ok) + wilddsc.dsc$w_length = strlen(wilddsc.dsc$a_pointer); + + /* If not extended character set, replace ? with % */ + /* With extended character set, ? is a wildcard single character */ + for (cp=wilddsc.dsc$a_pointer; ok && cp && *cp; cp++) { + if (*cp == '?') { wildquery = 1; if (!DECC_EFS_CHARSET) *cp = '%'; @@ -13096,7 +13096,7 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) } else if (*cp == '*') { wildstar = 1; } - } + } if (ok) { wv_sts = vms_split_path( @@ -13110,41 +13110,41 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) we_len = 0; } - sts = SS$_NORMAL; - while (ok && $VMS_STATUS_SUCCESS(sts)) { - char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec; - int v_sts, v_len, r_len, d_len, n_len, e_len, vs_len; + sts = SS$_NORMAL; + while (ok && $VMS_STATUS_SUCCESS(sts)) { + char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec; + int v_sts, v_len, r_len, d_len, n_len, e_len, vs_len; int valid_find; valid_find = 0; - sts = lib$find_file(&wilddsc,&rsdsc,&cxt, - &dfltdsc,NULL,&rms_sts,&lff_flags); - if (!$VMS_STATUS_SUCCESS(sts)) - break; - - /* with varying string, 1st word of buffer contains result length */ - rstr[rslt->length] = '\0'; - - /* Find where all the components are */ - v_sts = vms_split_path - (rstr, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); - - /* If no version on input, truncate the version on output */ - if (!hasver && (vs_len > 0)) { - *vs_spec = '\0'; - vs_len = 0; + sts = lib$find_file(&wilddsc,&rsdsc,&cxt, + &dfltdsc,NULL,&rms_sts,&lff_flags); + if (!$VMS_STATUS_SUCCESS(sts)) + break; + + /* with varying string, 1st word of buffer contains result length */ + rstr[rslt->length] = '\0'; + + /* Find where all the components are */ + v_sts = vms_split_path + (rstr, + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); + + /* If no version on input, truncate the version on output */ + if (!hasver && (vs_len > 0)) { + *vs_spec = '\0'; + vs_len = 0; } if (isunix) { @@ -13165,16 +13165,16 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) } } - /* No version & a null extension on UNIX handling */ - if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { - e_len = 0; - *e_spec = '\0'; - } - } + /* No version & a null extension on UNIX handling */ + if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { + e_len = 0; + *e_spec = '\0'; + } + } - if (!DECC_EFS_CASE_PRESERVE) { - for (cp = rstr; *cp; cp++) *cp = toLOWER_L1(*cp); - } + if (!DECC_EFS_CASE_PRESERVE) { + for (cp = rstr; *cp; cp++) *cp = toLOWER_L1(*cp); + } /* Find File treats a Null extension as return all extensions */ /* This is contrary to Perl expectations */ @@ -13202,44 +13202,44 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) } if (valid_find) { - found++; - - if (hasdir) { - if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1); - begin = rstr; - } - else { - /* Start with the name */ - begin = n_spec; - } - strcat(begin,"\n"); - ok = (PerlIO_puts(tmpfp,begin) != EOF); + found++; + + if (hasdir) { + if (isunix) trim_unixpath(rstr,SvPVX(tmpglob),1); + begin = rstr; + } + else { + /* Start with the name */ + begin = n_spec; + } + strcat(begin,"\n"); + ok = (PerlIO_puts(tmpfp,begin) != EOF); + } + } + if (cxt) (void)lib$find_file_end(&cxt); + + if (!found) { + /* Be POSIXish: return the input pattern when no matches */ + my_strlcpy(rstr, SvPVX(tmpglob), VMS_MAXRSS); + strcat(rstr,"\n"); + ok = (PerlIO_puts(tmpfp,rstr) != EOF); + } + + if (ok && sts != RMS$_NMF && + sts != RMS$_DNF && sts != RMS_FNF) ok = 0; + if (!ok) { + if (!(sts & 1)) { + SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts); } - } - if (cxt) (void)lib$find_file_end(&cxt); - - if (!found) { - /* Be POSIXish: return the input pattern when no matches */ - my_strlcpy(rstr, SvPVX(tmpglob), VMS_MAXRSS); - strcat(rstr,"\n"); - ok = (PerlIO_puts(tmpfp,rstr) != EOF); - } - - if (ok && sts != RMS$_NMF && - sts != RMS$_DNF && sts != RMS_FNF) ok = 0; - if (!ok) { - if (!(sts & 1)) { - SETERRNO((sts == RMS$_SYN ? EINVAL : EVMSERR),sts); - } - PerlIO_close(tmpfp); - fp = NULL; - } - else { - PerlIO_rewind(tmpfp); - IoTYPE(io) = IoTYPE_RDONLY; - IoIFP(io) = fp = tmpfp; - IoFLAGS(io) &= ~IOf_UNTAINT; /* maybe redundant */ - } + PerlIO_close(tmpfp); + fp = NULL; + } + else { + PerlIO_rewind(tmpfp); + IoTYPE(io) = IoTYPE_RDONLY; + IoIFP(io) = fp = tmpfp; + IoFLAGS(io) &= ~IOf_UNTAINT; /* maybe redundant */ + } } Safefree(vmsspec); Safefree(rslt); @@ -13249,7 +13249,7 @@ Perl_vms_start_glob(pTHX_ SV *tmpglob, IO *io) static char * mp_do_vms_realpath(pTHX_ const char *filespec, char * rslt_spec, - int *utf8_fl); + int *utf8_fl); void unixrealpath_fromperl(pTHX_ CV *cv) @@ -13259,7 +13259,7 @@ unixrealpath_fromperl(pTHX_ CV *cv) STRLEN n_a; if (!items || items != 1) - Perl_croak(aTHX_ "Usage: VMS::Filespec::unixrealpath(spec)"); + Perl_croak(aTHX_ "Usage: VMS::Filespec::unixrealpath(spec)"); fspec = SvPV(ST(0),n_a); if (!fspec || !*fspec) XSRETURN_UNDEF; @@ -13269,15 +13269,15 @@ unixrealpath_fromperl(pTHX_ CV *cv) ST(0) = sv_newmortal(); if (rslt != NULL) - sv_usepvn(ST(0),rslt,strlen(rslt)); + sv_usepvn(ST(0),rslt,strlen(rslt)); else - Safefree(rslt_spec); - XSRETURN(1); + Safefree(rslt_spec); + XSRETURN(1); } static char * mp_do_vms_realname(pTHX_ const char *filespec, char * rslt_spec, - int *utf8_fl); + int *utf8_fl); void vmsrealpath_fromperl(pTHX_ CV *cv) @@ -13287,7 +13287,7 @@ vmsrealpath_fromperl(pTHX_ CV *cv) STRLEN n_a; if (!items || items != 1) - Perl_croak(aTHX_ "Usage: VMS::Filespec::vmsrealpath(spec)"); + Perl_croak(aTHX_ "Usage: VMS::Filespec::vmsrealpath(spec)"); fspec = SvPV(ST(0),n_a); if (!fspec || !*fspec) XSRETURN_UNDEF; @@ -13297,10 +13297,10 @@ vmsrealpath_fromperl(pTHX_ CV *cv) ST(0) = sv_newmortal(); if (rslt != NULL) - sv_usepvn(ST(0),rslt,strlen(rslt)); + sv_usepvn(ST(0),rslt,strlen(rslt)); else - Safefree(rslt_spec); - XSRETURN(1); + Safefree(rslt_spec); + XSRETURN(1); } #ifdef HAS_SYMLINK @@ -13537,22 +13537,22 @@ int vms_fid_to_name(char * outname, int outlen, if (sts == 0) { int vms_sts; - dvidsc.dsc$a_pointer=statbuf.st_dev; + dvidsc.dsc$a_pointer=statbuf.st_dev; dvidsc.dsc$w_length=strlen(statbuf.st_dev); - specdsc.dsc$a_pointer = outname; - specdsc.dsc$w_length = outlen-1; + specdsc.dsc$a_pointer = outname; + specdsc.dsc$w_length = outlen-1; vms_sts = lib$fid_to_name - (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length); + (&dvidsc, statbuf.st_ino, &specdsc, &specdsc.dsc$w_length); if ($VMS_STATUS_SUCCESS(vms_sts)) { - outname[specdsc.dsc$w_length] = 0; + outname[specdsc.dsc$w_length] = 0; /* Return the mode */ if (mode) { *mode = statbuf.old_st_mode; } - } + } } PerlMem_free(temp_fspec); PerlMem_free(fileified); @@ -13563,16 +13563,16 @@ int vms_fid_to_name(char * outname, int outlen, static char * mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, - int *utf8_fl) + int *utf8_fl) { char * rslt = NULL; #ifdef HAS_SYMLINK if (DECC_POSIX_COMPLIANT_PATHNAMES) { - /* realpath currently only works if posix compliant pathnames are - * enabled. It may start working when they are not, but in that - * case we still want the fallback behavior for backwards compatibility - */ + /* realpath currently only works if posix compliant pathnames are + * enabled. It may start working when they are not, but in that + * case we still want the fallback behavior for backwards compatibility + */ rslt = realpath(filespec, outbuf); } #endif @@ -13583,159 +13583,159 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, int sts, v_len, r_len, d_len, n_len, e_len, vs_len; mode_t my_mode; - /* Fall back to fid_to_name */ + /* Fall back to fid_to_name */ Newx(vms_spec, VMS_MAXRSS + 1, char); - sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec, 0, &my_mode); - if (sts == 0) { - - - /* Now need to trim the version off */ - sts = vms_split_path - (vms_spec, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); - - - if (sts == 0) { - int haslower = 0; - const char *cp; - - /* Trim off the version */ - int file_len = v_len + r_len + d_len + n_len + e_len; - vms_spec[file_len] = 0; - - /* Trim off the .DIR if this is a directory */ - if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) { + sts = vms_fid_to_name(vms_spec, VMS_MAXRSS + 1, filespec, 0, &my_mode); + if (sts == 0) { + + + /* Now need to trim the version off */ + sts = vms_split_path + (vms_spec, + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); + + + if (sts == 0) { + int haslower = 0; + const char *cp; + + /* Trim off the version */ + int file_len = v_len + r_len + d_len + n_len + e_len; + vms_spec[file_len] = 0; + + /* Trim off the .DIR if this is a directory */ + if (is_dir_ext(e_spec, e_len, vs_spec, vs_len)) { if (S_ISDIR(my_mode)) { e_len = 0; e_spec[0] = 0; } - } + } - /* Drop NULL extensions on UNIX file specification */ - if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { - e_len = 0; - e_spec[0] = '\0'; - } + /* Drop NULL extensions on UNIX file specification */ + if ((e_len == 1) && DECC_READDIR_DROPDOTNOTYPE) { + e_len = 0; + e_spec[0] = '\0'; + } - /* The result is expected to be in UNIX format */ - rslt = int_tounixspec(vms_spec, outbuf, utf8_fl); + /* The result is expected to be in UNIX format */ + rslt = int_tounixspec(vms_spec, outbuf, utf8_fl); /* Downcase if input had any lower case letters and - * case preservation is not in effect. - */ - if (!DECC_EFS_CASE_PRESERVE) { - for (cp = filespec; *cp; cp++) - if (islower(*cp)) { haslower = 1; break; } - - if (haslower) __mystrtolower(rslt); - } - } - } else { - - /* Now for some hacks to deal with backwards and forward */ - /* compatibility */ - if (!DECC_EFS_CHARSET) { - - /* 1. ODS-2 mode wants to do a syntax only translation */ - rslt = int_rmsexpand(filespec, outbuf, - NULL, 0, NULL, utf8_fl); - - } else { - if (DECC_FILENAME_UNIX_REPORT) { - char * dir_name; - char * vms_dir_name; - char * file_name; - - /* 2. ODS-5 / UNIX report mode should return a failure */ - /* if the parent directory also does not exist */ - /* Otherwise, get the real path for the parent */ - /* and add the child to it. */ - - /* basename / dirname only available for VMS 7.0+ */ - /* So we may need to implement them as common routines */ - - Newx(dir_name, VMS_MAXRSS + 1, char); - Newx(vms_dir_name, VMS_MAXRSS + 1, char); - dir_name[0] = '\0'; - file_name = NULL; - - /* First try a VMS parse */ - sts = vms_split_path - (filespec, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); - - if (sts == 0) { - /* This is VMS */ - - int dir_len = v_len + r_len + d_len + n_len; - if (dir_len > 0) { - memcpy(dir_name, filespec, dir_len); - dir_name[dir_len] = '\0'; - file_name = (char *)&filespec[dir_len + 1]; - } - } else { - /* This must be UNIX */ - char * tchar; - - tchar = strrchr(filespec, '/'); - - if (tchar != NULL) { - int dir_len = tchar - filespec; - memcpy(dir_name, filespec, dir_len); - dir_name[dir_len] = '\0'; - file_name = (char *) &filespec[dir_len + 1]; - } - } - - /* Dir name is defaulted */ - if (dir_name[0] == 0) { - dir_name[0] = '.'; - dir_name[1] = '\0'; - } - - /* Need realpath for the directory */ - sts = vms_fid_to_name(vms_dir_name, - VMS_MAXRSS + 1, - dir_name, 0, NULL); - - if (sts == 0) { - /* Now need to pathify it. */ - char *tdir = int_pathify_dirspec(vms_dir_name, - outbuf); - - /* And now add the original filespec to it */ - if (file_name != NULL) { - my_strlcat(outbuf, file_name, VMS_MAXRSS); - } - return outbuf; - } - Safefree(vms_dir_name); - Safefree(dir_name); - } + * case preservation is not in effect. + */ + if (!DECC_EFS_CASE_PRESERVE) { + for (cp = filespec; *cp; cp++) + if (islower(*cp)) { haslower = 1; break; } + + if (haslower) __mystrtolower(rslt); + } + } + } else { + + /* Now for some hacks to deal with backwards and forward */ + /* compatibility */ + if (!DECC_EFS_CHARSET) { + + /* 1. ODS-2 mode wants to do a syntax only translation */ + rslt = int_rmsexpand(filespec, outbuf, + NULL, 0, NULL, utf8_fl); + + } else { + if (DECC_FILENAME_UNIX_REPORT) { + char * dir_name; + char * vms_dir_name; + char * file_name; + + /* 2. ODS-5 / UNIX report mode should return a failure */ + /* if the parent directory also does not exist */ + /* Otherwise, get the real path for the parent */ + /* and add the child to it. */ + + /* basename / dirname only available for VMS 7.0+ */ + /* So we may need to implement them as common routines */ + + Newx(dir_name, VMS_MAXRSS + 1, char); + Newx(vms_dir_name, VMS_MAXRSS + 1, char); + dir_name[0] = '\0'; + file_name = NULL; + + /* First try a VMS parse */ + sts = vms_split_path + (filespec, + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); + + if (sts == 0) { + /* This is VMS */ + + int dir_len = v_len + r_len + d_len + n_len; + if (dir_len > 0) { + memcpy(dir_name, filespec, dir_len); + dir_name[dir_len] = '\0'; + file_name = (char *)&filespec[dir_len + 1]; + } + } else { + /* This must be UNIX */ + char * tchar; + + tchar = strrchr(filespec, '/'); + + if (tchar != NULL) { + int dir_len = tchar - filespec; + memcpy(dir_name, filespec, dir_len); + dir_name[dir_len] = '\0'; + file_name = (char *) &filespec[dir_len + 1]; + } + } + + /* Dir name is defaulted */ + if (dir_name[0] == 0) { + dir_name[0] = '.'; + dir_name[1] = '\0'; + } + + /* Need realpath for the directory */ + sts = vms_fid_to_name(vms_dir_name, + VMS_MAXRSS + 1, + dir_name, 0, NULL); + + if (sts == 0) { + /* Now need to pathify it. */ + char *tdir = int_pathify_dirspec(vms_dir_name, + outbuf); + + /* And now add the original filespec to it */ + if (file_name != NULL) { + my_strlcat(outbuf, file_name, VMS_MAXRSS); + } + return outbuf; + } + Safefree(vms_dir_name); + Safefree(dir_name); + } } } Safefree(vms_spec); @@ -13745,7 +13745,7 @@ mp_do_vms_realpath(pTHX_ const char *filespec, char *outbuf, static char * mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf, - int *utf8_fl) + int *utf8_fl) { char * v_spec, * r_spec, * d_spec, * n_spec, * e_spec, * vs_spec; int sts, v_len, r_len, d_len, n_len, e_len, vs_len; @@ -13754,46 +13754,46 @@ mp_do_vms_realname(pTHX_ const char *filespec, char *outbuf, sts = vms_fid_to_name(outbuf, VMS_MAXRSS + 1, filespec, 0, NULL); if (sts != 0) { - return NULL; + return NULL; } else { - /* Now need to trim the version off */ - sts = vms_split_path - (outbuf, - &v_spec, - &v_len, - &r_spec, - &r_len, - &d_spec, - &d_len, - &n_spec, - &n_len, - &e_spec, - &e_len, - &vs_spec, - &vs_len); - - - if (sts == 0) { - int haslower = 0; - const char *cp; - - /* Trim off the version */ - int file_len = v_len + r_len + d_len + n_len + e_len; - outbuf[file_len] = 0; - - /* Downcase if input had any lower case letters and - * case preservation is not in effect. - */ - if (!DECC_EFS_CASE_PRESERVE) { - for (cp = filespec; *cp; cp++) - if (islower(*cp)) { haslower = 1; break; } - - if (haslower) __mystrtolower(outbuf); - } - } + /* Now need to trim the version off */ + sts = vms_split_path + (outbuf, + &v_spec, + &v_len, + &r_spec, + &r_len, + &d_spec, + &d_len, + &n_spec, + &n_len, + &e_spec, + &e_len, + &vs_spec, + &vs_len); + + + if (sts == 0) { + int haslower = 0; + const char *cp; + + /* Trim off the version */ + int file_len = v_len + r_len + d_len + n_len + e_len; + outbuf[file_len] = 0; + + /* Downcase if input had any lower case letters and + * case preservation is not in effect. + */ + if (!DECC_EFS_CASE_PRESERVE) { + for (cp = filespec; *cp; cp++) + if (islower(*cp)) { haslower = 1; break; } + + if (haslower) __mystrtolower(outbuf); + } + } } return outbuf; } @@ -13849,7 +13849,7 @@ set_feature_default(const char *name, int value) if (status) { val_str[0] = toUPPER_A(val_str[0]); if (val_str[0] == 'D' || val_str[0] == '0' || val_str[0] == 'F') - return 0; + return 0; } } @@ -13901,20 +13901,20 @@ vmsperl_set_features(void) if (status) { val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_debug_on_exception = 1; + vms_debug_on_exception = 1; else - vms_debug_on_exception = 0; + vms_debug_on_exception = 0; } /* Debug unix/vms file translation routines */ vms_debug_fileify = 0; status = simple_trnlnm("PERL_VMS_FILEIFY_DEBUG", val_str, sizeof(val_str)); if (status) { - val_str[0] = toUPPER_A(val_str[0]); + val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_debug_fileify = 1; + vms_debug_fileify = 1; else - vms_debug_fileify = 0; + vms_debug_fileify = 0; } @@ -13930,11 +13930,11 @@ vmsperl_set_features(void) vms_bug_stat_filename = 0; status = simple_trnlnm("PERL_VMS_BUG_STAT_FILENAME", val_str, sizeof(val_str)); if (status) { - val_str[0] = toUPPER_A(val_str[0]); + val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_bug_stat_filename = 1; + vms_bug_stat_filename = 1; else - vms_bug_stat_filename = 0; + vms_bug_stat_filename = 0; } @@ -13944,9 +13944,9 @@ vmsperl_set_features(void) if (status) { val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_vtf7_filenames = 1; + vms_vtf7_filenames = 1; else - vms_vtf7_filenames = 0; + vms_vtf7_filenames = 0; } /* unlink all versions on unlink() or rename() */ @@ -13955,9 +13955,9 @@ vmsperl_set_features(void) if (status) { val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_unlink_all_versions = 1; + vms_unlink_all_versions = 1; else - vms_unlink_all_versions = 0; + vms_unlink_all_versions = 0; } /* The path separator in PERL5LIB is '|' unless running under a Unix shell. */ @@ -13967,17 +13967,17 @@ vmsperl_set_features(void) gnv_unix_shell = 0; status = simple_trnlnm("GNV$UNIX_SHELL", val_str, sizeof(val_str)); if (status) { - gnv_unix_shell = 1; - set_feature_default("DECC$FILENAME_UNIX_NO_VERSION", 1); - set_feature_default("DECC$FILENAME_UNIX_REPORT", 1); - set_feature_default("DECC$READDIR_DROPDOTNOTYPE", 1); - set_feature_default("DECC$DISABLE_POSIX_ROOT", 0); - vms_unlink_all_versions = 1; - vms_posix_exit = 1; - /* Reverse default ordering of PERL_ENV_TABLES. */ - defenv[0] = &crtlenvdsc; - defenv[1] = &fildevdsc; - PL_perllib_sep = ':'; + gnv_unix_shell = 1; + set_feature_default("DECC$FILENAME_UNIX_NO_VERSION", 1); + set_feature_default("DECC$FILENAME_UNIX_REPORT", 1); + set_feature_default("DECC$READDIR_DROPDOTNOTYPE", 1); + set_feature_default("DECC$DISABLE_POSIX_ROOT", 0); + vms_unlink_all_versions = 1; + vms_posix_exit = 1; + /* Reverse default ordering of PERL_ENV_TABLES. */ + defenv[0] = &crtlenvdsc; + defenv[1] = &fildevdsc; + PL_perllib_sep = ':'; } /* Some reasonable defaults that are not CRTL defaults */ set_feature_default("DECC$EFS_CASE_PRESERVE", 1); @@ -14008,7 +14008,7 @@ vmsperl_set_features(void) if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) decc_bug_devnull = 1; else - decc_bug_devnull = 0; + decc_bug_devnull = 0; } s = decc$feature_get_index("DECC$DISABLE_TO_VMS_LOGNAME_TRANSLATION"); @@ -14043,13 +14043,13 @@ vmsperl_set_features(void) /*----------------------------*/ status = lib$getjpi(&jpicode1, 0, 0, &case_perm, 0, 0); if (!$VMS_STATUS_SUCCESS(status)) - case_perm = PPROP$K_CASE_BLIND; + case_perm = PPROP$K_CASE_BLIND; status = lib$getjpi(&jpicode2, 0, 0, &case_image, 0, 0); if (!$VMS_STATUS_SUCCESS(status)) - case_image = PPROP$K_CASE_BLIND; + case_image = PPROP$K_CASE_BLIND; if ((case_perm == PPROP$K_CASE_SENSITIVE) || - (case_image == PPROP$K_CASE_SENSITIVE)) - vms_process_case_tolerant = 0; + (case_image == PPROP$K_CASE_SENSITIVE)) + vms_process_case_tolerant = 0; #endif @@ -14059,9 +14059,9 @@ vmsperl_set_features(void) if (status) { val_str[0] = toUPPER_A(val_str[0]); if ((val_str[0] == 'E') || (val_str[0] == '1') || (val_str[0] == 'T')) - vms_posix_exit = 1; + vms_posix_exit = 1; else - vms_posix_exit = 0; + vms_posix_exit = 0; } } diff --git a/vms/vmsish.h b/vms/vmsish.h index a0003e90bc70..ed3b299ce378 100644 --- a/vms/vmsish.h +++ b/vms/vmsish.h @@ -320,8 +320,8 @@ struct interp_intern { # define PERL_FS_VER_FMT "%d_%d_%d" #endif #define PERL_FS_VERSION STRINGIFY(PERL_REVISION) "_" \ - STRINGIFY(PERL_VERSION) "_" \ - STRINGIFY(PERL_SUBVERSION) + STRINGIFY(PERL_VERSION) "_" \ + STRINGIFY(PERL_SUBVERSION) /* Temporary; we need to add support for this to Configure.Com */ #ifdef PERL_INC_VERSION_LIST # undef PERL_INC_VERSION_LIST diff --git a/win32/fcrypt.c b/win32/fcrypt.c index 4433e684c94e..edc80b19ddd8 100644 --- a/win32/fcrypt.c +++ b/win32/fcrypt.c @@ -13,15 +13,15 @@ typedef unsigned char des_cblock[8]; typedef struct des_ks_struct - { - union { - des_cblock _; - /* make sure things are correct size on machines with - * 8 byte longs */ - unsigned long pad[2]; - } ks; + { + union { + des_cblock _; + /* make sure things are correct size on machines with + * 8 byte longs */ + unsigned long pad[2]; + } ks; #define _ ks._ - } des_key_schedule[16]; + } des_key_schedule[16]; #define DES_KEY_SZ (sizeof(des_cblock)) #define DES_ENCRYPT 1 @@ -31,14 +31,14 @@ typedef struct des_ks_struct #define HALF_ITERATIONS 8 #define c2l(c,l) (l =((unsigned long)(*((c)++))) , \ - l|=((unsigned long)(*((c)++)))<< 8, \ - l|=((unsigned long)(*((c)++)))<<16, \ - l|=((unsigned long)(*((c)++)))<<24) + l|=((unsigned long)(*((c)++)))<< 8, \ + l|=((unsigned long)(*((c)++)))<<16, \ + l|=((unsigned long)(*((c)++)))<<24) #define l2c(l,c) (*((c)++)=(unsigned char)(((l) )&0xff), \ - *((c)++)=(unsigned char)(((l)>> 8)&0xff), \ - *((c)++)=(unsigned char)(((l)>>16)&0xff), \ - *((c)++)=(unsigned char)(((l)>>24)&0xff)) + *((c)++)=(unsigned char)(((l)>> 8)&0xff), \ + *((c)++)=(unsigned char)(((l)>>16)&0xff), \ + *((c)++)=(unsigned char)(((l)>>24)&0xff)) static const unsigned long SPtrans[8][64]={ { /* nibble 0 */ @@ -319,77 +319,77 @@ static const unsigned long skb[8][64]={ /* See ecb_encrypt.c for a pseudo description of these macros. */ #define PERM_OP(a,b,t,n,m) ((t)=((((a)>>(n))^(b))&(m)),\ - (b)^=(t),\ - (a)^=((t)<<(n))) + (b)^=(t),\ + (a)^=((t)<<(n))) #define HPERM_OP(a,t,n,m) ((t)=((((a)<<(16-(n)))^(a))&(m)),\ - (a)=(a)^(t)^(t>>(16-(n))))\ + (a)=(a)^(t)^(t>>(16-(n))))\ static const char shifts2[16]={0,0,1,1,1,1,1,1,0,1,1,1,1,1,1,0}; static int body( - unsigned long *out0, - unsigned long *out1, - des_key_schedule ks, - unsigned long Eswap0, - unsigned long Eswap1); + unsigned long *out0, + unsigned long *out1, + des_key_schedule ks, + unsigned long Eswap0, + unsigned long Eswap1); static int des_set_key(des_cblock *key, des_key_schedule schedule) - { - unsigned long c,d,t,s; - unsigned char *in; - unsigned long *k; - int i; - - k=(unsigned long *)schedule; - in=(unsigned char *)key; - - c2l(in,c); - c2l(in,d); - - /* I now do it in 47 simple operations :-) - * Thanks to John Fletcher (john_fletcher@lccmail.ocf.llnl.gov) - * for the inspiration. :-) */ - PERM_OP (d,c,t,4,0x0f0f0f0f); - HPERM_OP(c,t,-2,0xcccc0000); - HPERM_OP(d,t,-2,0xcccc0000); - PERM_OP (d,c,t,1,0x55555555); - PERM_OP (c,d,t,8,0x00ff00ff); - PERM_OP (d,c,t,1,0x55555555); - d= (((d&0x000000ff)<<16)| (d&0x0000ff00) | - ((d&0x00ff0000)>>16)|((c&0xf0000000)>>4)); - c&=0x0fffffff; - - for (i=0; i>2)|(c<<26)); d=((d>>2)|(d<<26)); } - else - { c=((c>>1)|(c<<27)); d=((d>>1)|(d<<27)); } - c&=0x0fffffff; - d&=0x0fffffff; - /* could be a few less shifts but I am to lazy at this - * point in time to investigate */ - s= skb[0][ (c )&0x3f ]| - skb[1][((c>> 6)&0x03)|((c>> 7)&0x3c)]| - skb[2][((c>>13)&0x0f)|((c>>14)&0x30)]| - skb[3][((c>>20)&0x01)|((c>>21)&0x06) | - ((c>>22)&0x38)]; - t= skb[4][ (d )&0x3f ]| - skb[5][((d>> 7)&0x03)|((d>> 8)&0x3c)]| - skb[6][ (d>>15)&0x3f ]| - skb[7][((d>>21)&0x0f)|((d>>22)&0x30)]; - - /* table contained 0213 4657 */ - *(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff; - s= ((s>>16)|(t&0xffff0000)); - - s=(s<<4)|(s>>28); - *(k++)=s&0xffffffff; - } - return(0); - } + { + unsigned long c,d,t,s; + unsigned char *in; + unsigned long *k; + int i; + + k=(unsigned long *)schedule; + in=(unsigned char *)key; + + c2l(in,c); + c2l(in,d); + + /* I now do it in 47 simple operations :-) + * Thanks to John Fletcher (john_fletcher@lccmail.ocf.llnl.gov) + * for the inspiration. :-) */ + PERM_OP (d,c,t,4,0x0f0f0f0f); + HPERM_OP(c,t,-2,0xcccc0000); + HPERM_OP(d,t,-2,0xcccc0000); + PERM_OP (d,c,t,1,0x55555555); + PERM_OP (c,d,t,8,0x00ff00ff); + PERM_OP (d,c,t,1,0x55555555); + d= (((d&0x000000ff)<<16)| (d&0x0000ff00) | + ((d&0x00ff0000)>>16)|((c&0xf0000000)>>4)); + c&=0x0fffffff; + + for (i=0; i>2)|(c<<26)); d=((d>>2)|(d<<26)); } + else + { c=((c>>1)|(c<<27)); d=((d>>1)|(d<<27)); } + c&=0x0fffffff; + d&=0x0fffffff; + /* could be a few less shifts but I am to lazy at this + * point in time to investigate */ + s= skb[0][ (c )&0x3f ]| + skb[1][((c>> 6)&0x03)|((c>> 7)&0x3c)]| + skb[2][((c>>13)&0x0f)|((c>>14)&0x30)]| + skb[3][((c>>20)&0x01)|((c>>21)&0x06) | + ((c>>22)&0x38)]; + t= skb[4][ (d )&0x3f ]| + skb[5][((d>> 7)&0x03)|((d>> 8)&0x3c)]| + skb[6][ (d>>15)&0x3f ]| + skb[7][((d>>21)&0x0f)|((d>>22)&0x30)]; + + /* table contained 0213 4657 */ + *(k++)=((t<<16)|(s&0x0000ffff))&0xffffffff; + s= ((s>>16)|(t&0xffff0000)); + + s=(s<<4)|(s>>28); + *(k++)=s&0xffffffff; + } + return(0); + } /****************************************************************** * modified stuff for crypt. @@ -402,37 +402,37 @@ des_set_key(des_cblock *key, des_key_schedule schedule) */ #ifdef ALT_ECB #define D_ENCRYPT(L,R,S) \ - v=(R^(R>>16)); \ - u=(v&E0); \ - v=(v&E1); \ - u=((u^(u<<16))^R^s[S ])<<2; \ - t=(v^(v<<16))^R^s[S+1]; \ - t=(t>>2)|(t<<30); \ - L^= \ - *(unsigned long *)(des_SP+0x0100+((t )&0xfc))+ \ - *(unsigned long *)(des_SP+0x0300+((t>> 8)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0500+((t>>16)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0700+((t>>24)&0xfc))+ \ - *(unsigned long *)(des_SP+ ((u )&0xfc))+ \ - *(unsigned long *)(des_SP+0x0200+((u>> 8)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0400+((u>>16)&0xfc))+ \ - *(unsigned long *)(des_SP+0x0600+((u>>24)&0xfc)); + v=(R^(R>>16)); \ + u=(v&E0); \ + v=(v&E1); \ + u=((u^(u<<16))^R^s[S ])<<2; \ + t=(v^(v<<16))^R^s[S+1]; \ + t=(t>>2)|(t<<30); \ + L^= \ + *(unsigned long *)(des_SP+0x0100+((t )&0xfc))+ \ + *(unsigned long *)(des_SP+0x0300+((t>> 8)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0500+((t>>16)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0700+((t>>24)&0xfc))+ \ + *(unsigned long *)(des_SP+ ((u )&0xfc))+ \ + *(unsigned long *)(des_SP+0x0200+((u>> 8)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0400+((u>>16)&0xfc))+ \ + *(unsigned long *)(des_SP+0x0600+((u>>24)&0xfc)); #else /* original version */ #define D_ENCRYPT(L,R,S) \ - v=(R^(R>>16)); \ - u=(v&E0); \ - v=(v&E1); \ - u=(u^(u<<16))^R^s[S ]; \ - t=(v^(v<<16))^R^s[S+1]; \ - t=(t>>4)|(t<<28); \ - L^= SPtrans[1][(t )&0x3f]| \ - SPtrans[3][(t>> 8)&0x3f]| \ - SPtrans[5][(t>>16)&0x3f]| \ - SPtrans[7][(t>>24)&0x3f]| \ - SPtrans[0][(u )&0x3f]| \ - SPtrans[2][(u>> 8)&0x3f]| \ - SPtrans[4][(u>>16)&0x3f]| \ - SPtrans[6][(u>>24)&0x3f]; + v=(R^(R>>16)); \ + u=(v&E0); \ + v=(v&E1); \ + u=(u^(u<<16))^R^s[S ]; \ + t=(v^(v<<16))^R^s[S+1]; \ + t=(t>>4)|(t<<28); \ + L^= SPtrans[1][(t )&0x3f]| \ + SPtrans[3][(t>> 8)&0x3f]| \ + SPtrans[5][(t>>16)&0x3f]| \ + SPtrans[7][(t>>24)&0x3f]| \ + SPtrans[0][(u )&0x3f]| \ + SPtrans[2][(u>> 8)&0x3f]| \ + SPtrans[4][(u>>16)&0x3f]| \ + SPtrans[6][(u>>24)&0x3f]; #endif unsigned const char con_salt[128]={ @@ -475,119 +475,119 @@ unsigned const char cov_2char[64]={ char * des_fcrypt(const char *buf, const char *salt, char *buff) - { - unsigned int i,j,x,y; - unsigned long Eswap0,Eswap1; - unsigned long out[2],ll; - des_cblock key; - des_key_schedule ks; - unsigned char bb[9]; - unsigned char *b=bb; - unsigned char c,u; + { + unsigned int i,j,x,y; + unsigned long Eswap0,Eswap1; + unsigned long out[2],ll; + des_cblock key; + des_key_schedule ks; + unsigned char bb[9]; + unsigned char *b=bb; + unsigned char c,u; if (!good_for_salt(salt[0]) || !good_for_salt(salt[1])) { errno = EINVAL; return NULL; } - /* eay 25/08/92 - * If you call crypt("pwd","*") as often happens when you - * have * as the pwd field in /etc/passwd, the function - * returns *\0XXXXXXXXX - * The \0 makes the string look like * so the pwd "*" would - * crypt to "*". This was found when replacing the crypt in - * our shared libraries. People found that the disbled - * accounts effectivly had no passwd :-(. */ - x=buff[0]=((salt[0] == '\0')?(char)'A':salt[0]); - Eswap0=con_salt[x]; - x=buff[1]=((salt[1] == '\0')?(char)'A':salt[1]); - Eswap1=con_salt[x]<<4; - - for (i=0; i<8; i++) - { - c= *(buf++); - if (!c) break; - key[i]=(char)(c<<1); - } - for (; i<8; i++) - key[i]=0; - - des_set_key((des_cblock *)(key),ks); - body(&out[0],&out[1],ks,Eswap0,Eswap1); - - ll=out[0]; l2c(ll,b); - ll=out[1]; l2c(ll,b); - y=0; - u=0x80; - bb[8]=0; - for (i=2; i<13; i++) - { - c=0; - for (j=0; j<6; j++) - { - c<<=1; - if (bb[y] & u) c|=1; - u>>=1; - if (!u) - { - y++; - u=0x80; - } - } - buff[i]=cov_2char[c]; - } - buff[13]='\0'; - return buff; - } + /* eay 25/08/92 + * If you call crypt("pwd","*") as often happens when you + * have * as the pwd field in /etc/passwd, the function + * returns *\0XXXXXXXXX + * The \0 makes the string look like * so the pwd "*" would + * crypt to "*". This was found when replacing the crypt in + * our shared libraries. People found that the disbled + * accounts effectivly had no passwd :-(. */ + x=buff[0]=((salt[0] == '\0')?(char)'A':salt[0]); + Eswap0=con_salt[x]; + x=buff[1]=((salt[1] == '\0')?(char)'A':salt[1]); + Eswap1=con_salt[x]<<4; + + for (i=0; i<8; i++) + { + c= *(buf++); + if (!c) break; + key[i]=(char)(c<<1); + } + for (; i<8; i++) + key[i]=0; + + des_set_key((des_cblock *)(key),ks); + body(&out[0],&out[1],ks,Eswap0,Eswap1); + + ll=out[0]; l2c(ll,b); + ll=out[1]; l2c(ll,b); + y=0; + u=0x80; + bb[8]=0; + for (i=2; i<13; i++) + { + c=0; + for (j=0; j<6; j++) + { + c<<=1; + if (bb[y] & u) c|=1; + u>>=1; + if (!u) + { + y++; + u=0x80; + } + } + buff[i]=cov_2char[c]; + } + buff[13]='\0'; + return buff; + } static int body( unsigned long *out0, - unsigned long *out1, - des_key_schedule ks, - unsigned long Eswap0, - unsigned long Eswap1) - { - unsigned long l,r,t,u,v; + unsigned long *out1, + des_key_schedule ks, + unsigned long Eswap0, + unsigned long Eswap1) + { + unsigned long l,r,t,u,v; #ifdef ALT_ECB - unsigned char *des_SP=(unsigned char *)SPtrans; + unsigned char *des_SP=(unsigned char *)SPtrans; #endif - unsigned long *s; - int i,j; - unsigned long E0,E1; - - l=0; - r=0; - - s=(unsigned long *)ks; - E0=Eswap0; - E1=Eswap1; - - for (j=0; j<25; j++) - { - for (i=0; i<(ITERATIONS*2); i+=4) - { - D_ENCRYPT(l,r, i); /* 1 */ - D_ENCRYPT(r,l, i+2); /* 2 */ - } - t=l; - l=r; - r=t; - } - t=r; - r=(l>>1)|(l<<31); - l=(t>>1)|(t<<31); - /* clear the top bits on machines with 8byte longs */ - l&=0xffffffff; - r&=0xffffffff; - - PERM_OP(r,l,t, 1,0x55555555); - PERM_OP(l,r,t, 8,0x00ff00ff); - PERM_OP(r,l,t, 2,0x33333333); - PERM_OP(l,r,t,16,0x0000ffff); - PERM_OP(r,l,t, 4,0x0f0f0f0f); - - *out0=l; - *out1=r; - return(0); - } + unsigned long *s; + int i,j; + unsigned long E0,E1; + + l=0; + r=0; + + s=(unsigned long *)ks; + E0=Eswap0; + E1=Eswap1; + + for (j=0; j<25; j++) + { + for (i=0; i<(ITERATIONS*2); i+=4) + { + D_ENCRYPT(l,r, i); /* 1 */ + D_ENCRYPT(r,l, i+2); /* 2 */ + } + t=l; + l=r; + r=t; + } + t=r; + r=(l>>1)|(l<<31); + l=(t>>1)|(t<<31); + /* clear the top bits on machines with 8byte longs */ + l&=0xffffffff; + r&=0xffffffff; + + PERM_OP(r,l,t, 1,0x55555555); + PERM_OP(l,r,t, 8,0x00ff00ff); + PERM_OP(r,l,t, 2,0x33333333); + PERM_OP(l,r,t,16,0x0000ffff); + PERM_OP(r,l,t, 4,0x0f0f0f0f); + + *out0=l; + *out1=r; + return(0); + } diff --git a/win32/include/dirent.h b/win32/include/dirent.h index 503782542579..9396743c0d90 100644 --- a/win32/include/dirent.h +++ b/win32/include/dirent.h @@ -24,21 +24,21 @@ /* structure of a directory entry */ typedef struct direct { - long d_ino; /* inode number (not used by MS-DOS) */ - long d_namlen; /* name length */ - char d_name[257]; /* file name */ + long d_ino; /* inode number (not used by MS-DOS) */ + long d_namlen; /* name length */ + char d_name[257]; /* file name */ } _DIRECT; /* structure for dir operations */ typedef struct _dir_struc { - char *start; /* starting position */ - char *curr; /* current position */ - long size; /* allocated size of string table */ - long nfiles; /* number of filenames in table */ - struct direct dirstr; /* directory structure to return */ - void* handle; /* system handle */ - char *end; /* position after last filename */ + char *start; /* starting position */ + char *curr; /* current position */ + long size; /* allocated size of string table */ + long nfiles; /* number of filenames in table */ + struct direct dirstr; /* directory structure to return */ + void* handle; /* system handle */ + char *end; /* position after last filename */ } DIR; #if 0 /* these have moved to win32iop.h */ diff --git a/win32/include/sys/socket.h b/win32/include/sys/socket.h index 5374a806f53e..8f93fa042973 100644 --- a/win32/include/sys/socket.h +++ b/win32/include/sys/socket.h @@ -73,7 +73,7 @@ int win32_recv (SOCKET s, char * buf, int len, int flags); int win32_recvfrom (SOCKET s, char * buf, int len, int flags, struct sockaddr *from, int * fromlen); int win32_select (int nfds, Perl_fd_set *rfds, Perl_fd_set *wfds, Perl_fd_set *xfds, - const struct timeval *timeout); + const struct timeval *timeout); int win32_send (SOCKET s, const char * buf, int len, int flags); int win32_sendto (SOCKET s, const char * buf, int len, int flags, const struct sockaddr *to, int tolen); diff --git a/win32/perlglob.c b/win32/perlglob.c index 305fd3bee5c5..09061a4de0d1 100644 --- a/win32/perlglob.c +++ b/win32/perlglob.c @@ -40,12 +40,12 @@ main(int argc, char *argv[]) /* check out the file system characteristics */ if (GetFullPathName(".", MAX_PATH, root, &dummy)) { dummy = strchr(root,'\\'); - if (dummy) - *++dummy = '\0'; - if (GetVolumeInformation(root, volname, MAX_PATH, - &serial, &maxname, &flags, 0, 0)) { - downcase = !(flags & FS_CASE_IS_PRESERVED); - } + if (dummy) + *++dummy = '\0'; + if (GetVolumeInformation(root, volname, MAX_PATH, + &serial, &maxname, &flags, 0, 0)) { + downcase = !(flags & FS_CASE_IS_PRESERVED); + } } fd = fileno(stdout); @@ -56,11 +56,11 @@ main(int argc, char *argv[]) assert(fd >= 0 && fd < SHRT_MAX); setmode(fd, O_BINARY); for (i = 1; i < argc; i++) { - len = strlen(argv[i]); - if (downcase) - strlwr(argv[i]); - if (i > 1) fwrite("\0", sizeof(char), 1, stdout); - fwrite(argv[i], sizeof(char), len, stdout); + len = strlen(argv[i]); + if (downcase) + strlwr(argv[i]); + if (i > 1) fwrite("\0", sizeof(char), 1, stdout); + fwrite(argv[i], sizeof(char), len, stdout); } return 0; } diff --git a/win32/perlhost.h b/win32/perlhost.h index 6d12abf252e1..5ce496590f27 100644 --- a/win32/perlhost.h +++ b/win32/perlhost.h @@ -32,10 +32,10 @@ class CPerlHost /* Constructors */ CPerlHost(void); CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc); + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc); CPerlHost(CPerlHost& host); ~CPerlHost(void); @@ -61,11 +61,11 @@ class CPerlHost inline void Free(void* ptr) { m_pVMem->Free(ptr); }; inline void* Calloc(size_t num, size_t size) { - size_t count = num*size; - void* lpVoid = Malloc(count); - if (lpVoid) - ZeroMemory(lpVoid, count); - return lpVoid; + size_t count = num*size; + void* lpVoid = Malloc(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; }; inline void GetLock(void) { m_pVMem->GetLock(); }; inline void FreeLock(void) { m_pVMem->FreeLock(); }; @@ -78,33 +78,33 @@ class CPerlHost inline int IsLockedShared(void) { return m_pVMemShared->IsLocked(); }; inline void* MallocShared(size_t size) { - void *result; - GetLockShared(); - result = m_pVMemShared->Malloc(size); - FreeLockShared(); - return result; + void *result; + GetLockShared(); + result = m_pVMemShared->Malloc(size); + FreeLockShared(); + return result; }; inline void* ReallocShared(void* ptr, size_t size) { - void *result; - GetLockShared(); - result = m_pVMemShared->Realloc(ptr, size); - FreeLockShared(); - return result; + void *result; + GetLockShared(); + result = m_pVMemShared->Realloc(ptr, size); + FreeLockShared(); + return result; }; inline void FreeShared(void* ptr) { - GetLockShared(); - m_pVMemShared->Free(ptr); - FreeLockShared(); + GetLockShared(); + m_pVMemShared->Free(ptr); + FreeLockShared(); }; inline void* CallocShared(size_t num, size_t size) { - size_t count = num*size; - void* lpVoid = MallocShared(count); - if (lpVoid) - ZeroMemory(lpVoid, count); - return lpVoid; + size_t count = num*size; + void* lpVoid = MallocShared(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; }; /* IPerlMemParse */ @@ -119,11 +119,11 @@ class CPerlHost inline void FreeParse(void* ptr) { m_pVMemParse->Free(ptr); }; inline void* CallocParse(size_t num, size_t size) { - size_t count = num*size; - void* lpVoid = MallocParse(count); - if (lpVoid) - ZeroMemory(lpVoid, count); - return lpVoid; + size_t count = num*size; + void* lpVoid = MallocParse(count); + if (lpVoid) + ZeroMemory(lpVoid, count); + return lpVoid; }; /* IPerlEnv */ @@ -131,11 +131,11 @@ class CPerlHost int Putenv(const char *envstring); inline char *Getenv(const char *varname, unsigned long *len) { - *len = 0; - char *e = Getenv(varname); - if (e) - *len = strlen(e); - return e; + *len = 0; + char *e = Getenv(varname); + if (e) + *len = strlen(e); + return e; } void* CreateChildEnv(void) { return CreateLocalEnvironmentStrings(*m_pvDir); }; void FreeChildEnv(void* pStr) { FreeLocalEnvironmentStrings((char*)pStr); }; @@ -146,12 +146,12 @@ class CPerlHost inline LPSTR GetIndex(DWORD &dwIndex) { - if(dwIndex < m_dwEnvCount) - { - ++dwIndex; - return m_lppEnvList[dwIndex-1]; - } - return NULL; + if(dwIndex < m_dwEnvCount) + { + ++dwIndex; + return m_lppEnvList[dwIndex-1]; + } + return NULL; }; protected: @@ -524,7 +524,7 @@ PerlEnvSiteLibPath(struct IPerlEnv* piPerl, const char *pl, STRLEN *const len) char* PerlEnvVendorLibPath(struct IPerlEnv* piPerl, const char *pl, - STRLEN *const len) + STRLEN *const len) { return win32_get_vendorlib(pl, len); } @@ -833,17 +833,17 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) /* open the file in the same mode */ if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RD) { - mode[0] = 'r'; - mode[1] = 0; + mode[0] = 'r'; + mode[1] = 0; } else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_WR) { - mode[0] = 'a'; - mode[1] = 0; + mode[0] = 'a'; + mode[1] = 0; } else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RW) { - mode[0] = 'r'; - mode[1] = '+'; - mode[2] = 0; + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; } /* it appears that the binmode is attached to the @@ -854,7 +854,7 @@ PerlStdIOFdupopen(struct IPerlStdIO* piPerl, FILE* pf) /* move the file pointer to the same position */ if (!fgetpos(pf, &pos)) { - fsetpos(pfdup, &pos); + fsetpos(pfdup, &pos); } return pfdup; } @@ -1724,24 +1724,24 @@ win32_start_child(LPVOID arg) /* push a zero on the stack (we are the child) */ { - dSP; - dTARGET; - PUSHi(0); - PUTBACK; + dSP; + dTARGET; + PUSHi(0); + PUTBACK; } /* continue from next op */ PL_op = PL_op->op_next; { - dJMPENV; - volatile int oldscope = 1; /* We are responsible for all scopes */ + dJMPENV; + volatile int oldscope = 1; /* We are responsible for all scopes */ restart: - JMPENV_PUSH(status); - switch (status) { - case 0: - CALLRUNOPS(aTHX); + JMPENV_PUSH(status); + switch (status) { + case 0: + CALLRUNOPS(aTHX); /* We may have additional unclosed scopes if fork() was called * from within a BEGIN block. See perlfork.pod for more details. * We cannot clean up these other scopes because they belong to a @@ -1752,48 +1752,48 @@ win32_start_child(LPVOID arg) PL_scopestack[oldscope-1] = PL_scopestack[PL_scopestack_ix-1]; PL_scopestack_ix = oldscope; } - status = 0; - break; - case 2: - while (PL_scopestack_ix > oldscope) - LEAVE; - FREETMPS; - PL_curstash = PL_defstash; - if (PL_curstash != PL_defstash) { - SvREFCNT_dec(PL_curstash); - PL_curstash = (HV *)SvREFCNT_inc(PL_defstash); - } - if (PL_endav && !PL_minus_c) { - PERL_SET_PHASE(PERL_PHASE_END); - call_list(oldscope, PL_endav); - } - status = STATUS_EXIT; - break; - case 3: - if (PL_restartop) { - POPSTACK_TO(PL_mainstack); - PL_op = PL_restartop; - PL_restartop = (OP*)NULL; - goto restart; - } - PerlIO_printf(Perl_error_log, "panic: restartop\n"); - FREETMPS; - status = 1; - break; - } - JMPENV_POP; - - /* XXX hack to avoid perl_destruct() freeing optree */ + status = 0; + break; + case 2: + while (PL_scopestack_ix > oldscope) + LEAVE; + FREETMPS; + PL_curstash = PL_defstash; + if (PL_curstash != PL_defstash) { + SvREFCNT_dec(PL_curstash); + PL_curstash = (HV *)SvREFCNT_inc(PL_defstash); + } + if (PL_endav && !PL_minus_c) { + PERL_SET_PHASE(PERL_PHASE_END); + call_list(oldscope, PL_endav); + } + status = STATUS_EXIT; + break; + case 3: + if (PL_restartop) { + POPSTACK_TO(PL_mainstack); + PL_op = PL_restartop; + PL_restartop = (OP*)NULL; + goto restart; + } + PerlIO_printf(Perl_error_log, "panic: restartop\n"); + FREETMPS; + status = 1; + break; + } + JMPENV_POP; + + /* XXX hack to avoid perl_destruct() freeing optree */ win32_checkTLS(my_perl); - PL_main_root = (OP*)NULL; + PL_main_root = (OP*)NULL; } win32_checkTLS(my_perl); /* close the std handles to avoid fd leaks */ { - do_close(PL_stdingv, FALSE); - do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */ - do_close(PL_stderrgv, FALSE); + do_close(PL_stdingv, FALSE); + do_close(gv_fetchpv("STDOUT", TRUE, SVt_PVIO), FALSE); /* PL_stdoutgv - ISAGN */ + do_close(PL_stderrgv, FALSE); } /* destroy everything (waits for any pseudo-forked children) */ @@ -1820,22 +1820,22 @@ PerlProcFork(struct IPerlProc* piPerl) CPerlHost *h; if (w32_num_pseudo_children >= MAXIMUM_WAIT_OBJECTS) { - errno = EAGAIN; - return -1; + errno = EAGAIN; + return -1; } h = new CPerlHost(*(CPerlHost*)w32_internal_host); PerlInterpreter *new_perl = perl_clone_using((PerlInterpreter*)aTHX, - CLONEf_COPY_STACKS, - h->m_pHostperlMem, - h->m_pHostperlMemShared, - h->m_pHostperlMemParse, - h->m_pHostperlEnv, - h->m_pHostperlStdIO, - h->m_pHostperlLIO, - h->m_pHostperlDir, - h->m_pHostperlSock, - h->m_pHostperlProc - ); + CLONEf_COPY_STACKS, + h->m_pHostperlMem, + h->m_pHostperlMemShared, + h->m_pHostperlMemParse, + h->m_pHostperlEnv, + h->m_pHostperlStdIO, + h->m_pHostperlLIO, + h->m_pHostperlDir, + h->m_pHostperlSock, + h->m_pHostperlProc + ); new_perl->Isys_intern.internal_host = h; h->host_perl = new_perl; # ifdef PERL_SYNC_FORK @@ -1849,15 +1849,15 @@ PerlProcFork(struct IPerlProc* piPerl) (w32_message_hwnd == NULL) ? (HWND)NULL : (HWND)INVALID_HANDLE_VALUE; # ifdef USE_RTL_THREAD_API handle = (HANDLE)_beginthreadex((void*)NULL, 0, win32_start_child, - (void*)new_perl, 0, (unsigned*)&id); + (void*)new_perl, 0, (unsigned*)&id); # else handle = CreateThread(NULL, 0, win32_start_child, - (LPVOID)new_perl, 0, &id); + (LPVOID)new_perl, 0, &id); # endif PERL_SET_THX(aTHX); /* XXX perl_clone*() set TLS */ if (!handle) { - errno = EAGAIN; - return -1; + errno = EAGAIN; + return -1; } w32_pseudo_child_handles[w32_num_pseudo_children] = handle; w32_pseudo_child_pids[w32_num_pseudo_children] = id; @@ -1985,20 +1985,20 @@ CPerlHost::CPerlHost(void) #define SETUPEXCHANGE(xptr, iptr, table) \ STMT_START { \ - if (xptr) { \ - iptr = *xptr; \ - *xptr = &table; \ - } \ - else { \ - iptr = &table; \ - } \ + if (xptr) { \ + iptr = *xptr; \ + *xptr = &table; \ + } \ + else { \ + iptr = &table; \ + } \ } STMT_END CPerlHost::CPerlHost(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc) + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) { InterlockedIncrement(&num_hosts); m_pvDir = new VDir(0); @@ -2073,7 +2073,7 @@ CPerlHost::CPerlHost(CPerlHost& host) LPSTR lpPtr; DWORD dwIndex = 0; while(lpPtr = host.GetIndex(dwIndex)) - Add(lpPtr); + Add(lpPtr); } CPerlHost::~CPerlHost(void) @@ -2092,13 +2092,13 @@ CPerlHost::Find(LPCSTR lpStr) LPSTR lpPtr; LPSTR* lppPtr = Lookup(lpStr); if(lppPtr != NULL) { - for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr) - ; + for(lpPtr = *lppPtr; *lpPtr != '\0' && *lpPtr != '='; ++lpPtr) + ; - if(*lpPtr == '=') - ++lpPtr; + if(*lpPtr == '=') + ++lpPtr; - return lpPtr; + return lpPtr; } return NULL; } @@ -2112,26 +2112,26 @@ lookup(const void *arg1, const void *arg2) ptr1 = *(char**)arg1; ptr2 = *(char**)arg2; for(;;) { - c1 = *ptr1++; - c2 = *ptr2++; - if(c1 == '\0' || c1 == '=') { - if(c2 == '\0' || c2 == '=') - break; - - return -1; // string 1 < string 2 - } - else if(c2 == '\0' || c2 == '=') - return 1; // string 1 > string 2 - else if(c1 != c2) { - c1 = toupper(c1); - c2 = toupper(c2); - if(c1 != c2) { - if(c1 < c2) - return -1; // string 1 < string 2 - - return 1; // string 1 > string 2 - } - } + c1 = *ptr1++; + c2 = *ptr2++; + if(c1 == '\0' || c1 == '=') { + if(c2 == '\0' || c2 == '=') + break; + + return -1; // string 1 < string 2 + } + else if(c2 == '\0' || c2 == '=') + return 1; // string 1 > string 2 + else if(c1 != c2) { + c1 = toupper(c1); + c2 = toupper(c2); + if(c1 != c2) { + if(c1 < c2) + return -1; // string 1 < string 2 + + return 1; // string 1 > string 2 + } + } } return 0; } @@ -2140,7 +2140,7 @@ LPSTR* CPerlHost::Lookup(LPCSTR lpStr) { if (!lpStr) - return NULL; + return NULL; return (LPSTR*)bsearch(&lpStr, m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), lookup); } @@ -2153,26 +2153,26 @@ compare(const void *arg1, const void *arg2) ptr1 = *(char**)arg1; ptr2 = *(char**)arg2; for(;;) { - c1 = *ptr1++; - c2 = *ptr2++; - if(c1 == '\0' || c1 == '=') { - if(c1 == c2) - break; - - return -1; // string 1 < string 2 - } - else if(c2 == '\0' || c2 == '=') - return 1; // string 1 > string 2 - else if(c1 != c2) { - c1 = toupper(c1); - c2 = toupper(c2); - if(c1 != c2) { - if(c1 < c2) - return -1; // string 1 < string 2 - - return 1; // string 1 > string 2 - } - } + c1 = *ptr1++; + c2 = *ptr2++; + if(c1 == '\0' || c1 == '=') { + if(c1 == c2) + break; + + return -1; // string 1 < string 2 + } + else if(c2 == '\0' || c2 == '=') + return 1; // string 1 > string 2 + else if(c1 != c2) { + c1 = toupper(c1); + c2 = toupper(c2); + if(c1 != c2) { + if(c1 < c2) + return -1; // string 1 < string 2 + + return 1; // string 1 > string 2 + } + } } return 0; } @@ -2186,23 +2186,23 @@ CPerlHost::Add(LPCSTR lpStr) // replacing ? lpPtr = Lookup(lpStr); if (lpPtr != NULL) { - // must allocate things via host memory allocation functions - // rather than perl's Renew() et al, as the perl interpreter - // may either not be initialized enough when we allocate these, - // or may already be dead when we go to free these - *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char)); - strcpy(*lpPtr, lpStr); + // must allocate things via host memory allocation functions + // rather than perl's Renew() et al, as the perl interpreter + // may either not be initialized enough when we allocate these, + // or may already be dead when we go to free these + *lpPtr = (char*)Realloc(*lpPtr, length * sizeof(char)); + strcpy(*lpPtr, lpStr); } else { - m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR)); - if (m_lppEnvList) { - m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char)); - if (m_lppEnvList[m_dwEnvCount] != NULL) { - strcpy(m_lppEnvList[m_dwEnvCount], lpStr); - ++m_dwEnvCount; - qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare); - } - } + m_lppEnvList = (LPSTR*)Realloc(m_lppEnvList, (m_dwEnvCount+1) * sizeof(LPSTR)); + if (m_lppEnvList) { + m_lppEnvList[m_dwEnvCount] = (char*)Malloc(length * sizeof(char)); + if (m_lppEnvList[m_dwEnvCount] != NULL) { + strcpy(m_lppEnvList[m_dwEnvCount], lpStr); + ++m_dwEnvCount; + qsort(m_lppEnvList, m_dwEnvCount, sizeof(LPSTR), compare); + } + } } } @@ -2212,7 +2212,7 @@ CPerlHost::CalculateEnvironmentSpace(void) DWORD index; DWORD dwSize = 0; for(index = 0; index < m_dwEnvCount; ++index) - dwSize += strlen(m_lppEnvList[index]) + 1; + dwSize += strlen(m_lppEnvList[index]) + 1; return dwSize; } @@ -2257,13 +2257,13 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) // step over current directory stuff while(*lpTmp == '=') - lpTmp += strlen(lpTmp) + 1; + lpTmp += strlen(lpTmp) + 1; // save the start of the environment strings lpEnvPtr = lpTmp; for(dwSize = 1; *lpTmp != '\0'; lpTmp += strlen(lpTmp) + 1) { - // calculate the size of the environment strings - dwSize += strlen(lpTmp) + 1; + // calculate the size of the environment strings + dwSize += strlen(lpTmp) + 1; } // add the size of current directories @@ -2275,57 +2275,57 @@ CPerlHost::CreateLocalEnvironmentStrings(VDir &vDir) Newx(lpStr, dwSize, char); lpPtr = lpStr; if(lpStr != NULL) { - // build the local environment - lpStr = vDir.BuildEnvironmentSpace(lpStr); - - dwEnvIndex = 0; - lpLocalEnv = GetIndex(dwEnvIndex); - while(*lpEnvPtr != '\0') { - if(!lpLocalEnv) { - // all environment overrides have been added - // so copy string into place - strcpy(lpStr, lpEnvPtr); - nLength = strlen(lpEnvPtr) + 1; - lpStr += nLength; - lpEnvPtr += nLength; - } - else { - // determine which string to copy next - compVal = compare(&lpEnvPtr, &lpLocalEnv); - if(compVal < 0) { - strcpy(lpStr, lpEnvPtr); - nLength = strlen(lpEnvPtr) + 1; - lpStr += nLength; - lpEnvPtr += nLength; - } - else { - char *ptr = strchr(lpLocalEnv, '='); - if(ptr && ptr[1]) { - strcpy(lpStr, lpLocalEnv); - lpStr += strlen(lpLocalEnv) + 1; - } - lpLocalEnv = GetIndex(dwEnvIndex); - if(compVal == 0) { - // this string was replaced - lpEnvPtr += strlen(lpEnvPtr) + 1; - } - } - } - } - - while(lpLocalEnv) { - // still have environment overrides to add - // so copy the strings into place if not an override - char *ptr = strchr(lpLocalEnv, '='); - if(ptr && ptr[1]) { - strcpy(lpStr, lpLocalEnv); - lpStr += strlen(lpLocalEnv) + 1; - } - lpLocalEnv = GetIndex(dwEnvIndex); - } - - // add final NULL - *lpStr = '\0'; + // build the local environment + lpStr = vDir.BuildEnvironmentSpace(lpStr); + + dwEnvIndex = 0; + lpLocalEnv = GetIndex(dwEnvIndex); + while(*lpEnvPtr != '\0') { + if(!lpLocalEnv) { + // all environment overrides have been added + // so copy string into place + strcpy(lpStr, lpEnvPtr); + nLength = strlen(lpEnvPtr) + 1; + lpStr += nLength; + lpEnvPtr += nLength; + } + else { + // determine which string to copy next + compVal = compare(&lpEnvPtr, &lpLocalEnv); + if(compVal < 0) { + strcpy(lpStr, lpEnvPtr); + nLength = strlen(lpEnvPtr) + 1; + lpStr += nLength; + lpEnvPtr += nLength; + } + else { + char *ptr = strchr(lpLocalEnv, '='); + if(ptr && ptr[1]) { + strcpy(lpStr, lpLocalEnv); + lpStr += strlen(lpLocalEnv) + 1; + } + lpLocalEnv = GetIndex(dwEnvIndex); + if(compVal == 0) { + // this string was replaced + lpEnvPtr += strlen(lpEnvPtr) + 1; + } + } + } + } + + while(lpLocalEnv) { + // still have environment overrides to add + // so copy the strings into place if not an override + char *ptr = strchr(lpLocalEnv, '='); + if(ptr && ptr[1]) { + strcpy(lpStr, lpLocalEnv); + lpStr += strlen(lpLocalEnv) + 1; + } + lpLocalEnv = GetIndex(dwEnvIndex); + } + + // add final NULL + *lpStr = '\0'; } // release the process environment strings @@ -2338,10 +2338,10 @@ void CPerlHost::Reset(void) { if(m_lppEnvList != NULL) { - for(DWORD index = 0; index < m_dwEnvCount; ++index) { - Free(m_lppEnvList[index]); - m_lppEnvList[index] = NULL; - } + for(DWORD index = 0; index < m_dwEnvCount; ++index) { + Free(m_lppEnvList[index]); + m_lppEnvList[index] = NULL; + } } m_dwEnvCount = 0; Free(m_lppEnvList); @@ -2354,13 +2354,13 @@ CPerlHost::Clearenv(void) char ch; LPSTR lpPtr, lpStr, lpEnvPtr; if (m_lppEnvList != NULL) { - /* set every entry to an empty string */ - for(DWORD index = 0; index < m_dwEnvCount; ++index) { - char* ptr = strchr(m_lppEnvList[index], '='); - if(ptr) { - *++ptr = 0; - } - } + /* set every entry to an empty string */ + for(DWORD index = 0; index < m_dwEnvCount; ++index) { + char* ptr = strchr(m_lppEnvList[index], '='); + if(ptr) { + *++ptr = 0; + } + } } /* get the process environment strings */ @@ -2368,19 +2368,19 @@ CPerlHost::Clearenv(void) /* step over current directory stuff */ while(*lpStr == '=') - lpStr += strlen(lpStr) + 1; + lpStr += strlen(lpStr) + 1; while(*lpStr) { - lpPtr = strchr(lpStr, '='); - if(lpPtr) { - ch = *++lpPtr; - *lpPtr = 0; - Add(lpStr); - if (m_bTopLevel) - (void)win32_putenv(lpStr); - *lpPtr = ch; - } - lpStr += strlen(lpStr) + 1; + lpPtr = strchr(lpStr, '='); + if(lpPtr) { + ch = *++lpPtr; + *lpPtr = 0; + Add(lpStr); + if (m_bTopLevel) + (void)win32_putenv(lpStr); + *lpPtr = ch; + } + lpStr += strlen(lpStr) + 1; } win32_freeenvironmentstrings(lpEnvPtr); @@ -2391,9 +2391,9 @@ char* CPerlHost::Getenv(const char *varname) { if (!m_bTopLevel) { - char *pEnv = Find(varname); - if (pEnv && *pEnv) - return pEnv; + char *pEnv = Find(varname); + if (pEnv && *pEnv) + return pEnv; } return win32_getenv(varname); } @@ -2403,7 +2403,7 @@ CPerlHost::Putenv(const char *envstring) { Add(envstring); if (m_bTopLevel) - return win32_putenv(envstring); + return win32_putenv(envstring); return 0; } @@ -2413,12 +2413,12 @@ CPerlHost::Chdir(const char *dirname) { int ret; if (!dirname) { - errno = ENOENT; - return -1; + errno = ENOENT; + return -1; } ret = m_pvDir->SetCurrentDirectoryA((char*)dirname); if(ret < 0) { - errno = ENOENT; + errno = ENOENT; } return ret; } diff --git a/win32/perllib.c b/win32/perllib.c index 9948a1a3ba28..a8fe7af9c0ee 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -51,85 +51,85 @@ win32_checkTLS(PerlInterpreter *host_perl) { dTHX; if (host_perl != my_perl) { - int *nowhere = NULL; - abort(); + int *nowhere = NULL; + abort(); } } EXTERN_C void perl_get_host_info(struct IPerlMemInfo* perlMemInfo, - struct IPerlMemInfo* perlMemSharedInfo, - struct IPerlMemInfo* perlMemParseInfo, - struct IPerlEnvInfo* perlEnvInfo, - struct IPerlStdIOInfo* perlStdIOInfo, - struct IPerlLIOInfo* perlLIOInfo, - struct IPerlDirInfo* perlDirInfo, - struct IPerlSockInfo* perlSockInfo, - struct IPerlProcInfo* perlProcInfo) + struct IPerlMemInfo* perlMemSharedInfo, + struct IPerlMemInfo* perlMemParseInfo, + struct IPerlEnvInfo* perlEnvInfo, + struct IPerlStdIOInfo* perlStdIOInfo, + struct IPerlLIOInfo* perlLIOInfo, + struct IPerlDirInfo* perlDirInfo, + struct IPerlSockInfo* perlSockInfo, + struct IPerlProcInfo* perlProcInfo) { if (perlMemInfo) { - Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); - perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + Copy(&perlMem, &perlMemInfo->perlMemList, perlMemInfo->nCount, void*); + perlMemInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); } if (perlMemSharedInfo) { - Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*); - perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + Copy(&perlMem, &perlMemSharedInfo->perlMemList, perlMemSharedInfo->nCount, void*); + perlMemSharedInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); } if (perlMemParseInfo) { - Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*); - perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); + Copy(&perlMem, &perlMemParseInfo->perlMemList, perlMemParseInfo->nCount, void*); + perlMemParseInfo->nCount = (sizeof(struct IPerlMem)/sizeof(void*)); } if (perlEnvInfo) { - Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); - perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); + Copy(&perlEnv, &perlEnvInfo->perlEnvList, perlEnvInfo->nCount, void*); + perlEnvInfo->nCount = (sizeof(struct IPerlEnv)/sizeof(void*)); } if (perlStdIOInfo) { - Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); - perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); + Copy(&perlStdIO, &perlStdIOInfo->perlStdIOList, perlStdIOInfo->nCount, void*); + perlStdIOInfo->nCount = (sizeof(struct IPerlStdIO)/sizeof(void*)); } if (perlLIOInfo) { - Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); - perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); + Copy(&perlLIO, &perlLIOInfo->perlLIOList, perlLIOInfo->nCount, void*); + perlLIOInfo->nCount = (sizeof(struct IPerlLIO)/sizeof(void*)); } if (perlDirInfo) { - Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); - perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); + Copy(&perlDir, &perlDirInfo->perlDirList, perlDirInfo->nCount, void*); + perlDirInfo->nCount = (sizeof(struct IPerlDir)/sizeof(void*)); } if (perlSockInfo) { - Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); - perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); + Copy(&perlSock, &perlSockInfo->perlSockList, perlSockInfo->nCount, void*); + perlSockInfo->nCount = (sizeof(struct IPerlSock)/sizeof(void*)); } if (perlProcInfo) { - Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); - perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); + Copy(&perlProc, &perlProcInfo->perlProcList, perlProcInfo->nCount, void*); + perlProcInfo->nCount = (sizeof(struct IPerlProc)/sizeof(void*)); } } EXTERN_C PerlInterpreter* perl_alloc_override(struct IPerlMem** ppMem, struct IPerlMem** ppMemShared, - struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, - struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, - struct IPerlDir** ppDir, struct IPerlSock** ppSock, - struct IPerlProc** ppProc) + struct IPerlMem** ppMemParse, struct IPerlEnv** ppEnv, + struct IPerlStdIO** ppStdIO, struct IPerlLIO** ppLIO, + struct IPerlDir** ppDir, struct IPerlSock** ppSock, + struct IPerlProc** ppProc) { PerlInterpreter *my_perl = NULL; CPerlHost* pHost = new CPerlHost(ppMem, ppMemShared, ppMemParse, ppEnv, - ppStdIO, ppLIO, ppDir, ppSock, ppProc); + ppStdIO, ppLIO, ppDir, ppSock, ppProc); if (pHost) { - my_perl = perl_alloc_using(pHost->m_pHostperlMem, - pHost->m_pHostperlMemShared, - pHost->m_pHostperlMemParse, - pHost->m_pHostperlEnv, - pHost->m_pHostperlStdIO, - pHost->m_pHostperlLIO, - pHost->m_pHostperlDir, - pHost->m_pHostperlSock, - pHost->m_pHostperlProc); - if (my_perl) { - w32_internal_host = pHost; - pHost->host_perl = my_perl; - } + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { + w32_internal_host = pHost; + pHost->host_perl = my_perl; + } } return my_perl; } @@ -140,19 +140,19 @@ perl_alloc(void) PerlInterpreter* my_perl = NULL; CPerlHost* pHost = new CPerlHost(); if (pHost) { - my_perl = perl_alloc_using(pHost->m_pHostperlMem, - pHost->m_pHostperlMemShared, - pHost->m_pHostperlMemParse, - pHost->m_pHostperlEnv, - pHost->m_pHostperlStdIO, - pHost->m_pHostperlLIO, - pHost->m_pHostperlDir, - pHost->m_pHostperlSock, - pHost->m_pHostperlProc); - if (my_perl) { - w32_internal_host = pHost; + my_perl = perl_alloc_using(pHost->m_pHostperlMem, + pHost->m_pHostperlMemShared, + pHost->m_pHostperlMemParse, + pHost->m_pHostperlEnv, + pHost->m_pHostperlStdIO, + pHost->m_pHostperlLIO, + pHost->m_pHostperlDir, + pHost->m_pHostperlSock, + pHost->m_pHostperlProc); + if (my_perl) { + w32_internal_host = pHost; pHost->host_perl = my_perl; - } + } } return my_perl; } @@ -178,7 +178,7 @@ RunPerl(int argc, char **argv, char **env) PERL_SYS_INIT(&argc,&argv); if (!(my_perl = perl_alloc())) - return (1); + return (1); perl_construct(my_perl); PL_perl_destruct_level = 0; @@ -194,11 +194,11 @@ RunPerl(int argc, char **argv, char **env) if (!perl_parse(my_perl, xs_init, argc, argv, env)) { #if defined(TOP_CLONE) && defined(USE_ITHREADS) /* XXXXXX testing */ - new_perl = perl_clone(my_perl, 1); - (void) perl_run(new_perl); - PERL_SET_THX(my_perl); + new_perl = perl_clone(my_perl, 1); + (void) perl_run(new_perl); + PERL_SET_THX(my_perl); #else - (void) perl_run(my_perl); + (void) perl_run(my_perl); #endif } @@ -206,9 +206,9 @@ RunPerl(int argc, char **argv, char **env) perl_free(my_perl); #ifdef USE_ITHREADS if (new_perl) { - PERL_SET_THX(new_perl); - exitstatus = perl_destruct(new_perl); - perl_free(new_perl); + PERL_SET_THX(new_perl); + exitstatus = perl_destruct(new_perl); + perl_free(new_perl); } #endif @@ -229,23 +229,23 @@ EXTERN_C /* GCC in C++ mode mangles the name, otherwise */ #endif BOOL APIENTRY DllMain(HINSTANCE hModule, /* DLL module handle */ - DWORD fdwReason, /* reason called */ - LPVOID lpvReserved) /* reserved */ + DWORD fdwReason, /* reason called */ + LPVOID lpvReserved) /* reserved */ { switch (fdwReason) { - /* The DLL is attaching to a process due to process - * initialization or a call to LoadLibrary. - */ + /* The DLL is attaching to a process due to process + * initialization or a call to LoadLibrary. + */ case DLL_PROCESS_ATTACH: - DisableThreadLibraryCalls((HMODULE)hModule); + DisableThreadLibraryCalls((HMODULE)hModule); - w32_perldll_handle = hModule; - set_w32_module_name(); - break; + w32_perldll_handle = hModule; + set_w32_module_name(); + break; - /* The DLL is detaching from a process due to - * process termination or call to FreeLibrary. - */ + /* The DLL is detaching from a process due to + * process termination or call to FreeLibrary. + */ case DLL_PROCESS_DETACH: /* As long as we use TerminateProcess()/TerminateThread() etc. for mimicing kill() anything here had better be harmless if: @@ -253,23 +253,23 @@ DllMain(HINSTANCE hModule, /* DLL module handle */ B. Called after memory allocation for Heap has been forcibly removed by OS. PerlIO_cleanup() was done here but fails (B). */ - EndSockets(); + EndSockets(); #if defined(USE_ITHREADS) - if (PL_curinterp) - FREE_THREAD_KEY; + if (PL_curinterp) + FREE_THREAD_KEY; #endif - break; + break; - /* The attached process creates a new thread. */ + /* The attached process creates a new thread. */ case DLL_THREAD_ATTACH: - break; + break; - /* The thread of the attached process terminates. */ + /* The thread of the attached process terminates. */ case DLL_THREAD_DETACH: - break; + break; default: - break; + break; } return TRUE; } @@ -295,6 +295,6 @@ perl_clone_host(PerlInterpreter* proto_perl, UV flags) { proto_perl->Isys_intern.internal_host = h; h->host_perl = proto_perl; return proto_perl; - + } #endif diff --git a/win32/vdir.h b/win32/vdir.h index c21ec7c400a0..f06830af41ac 100644 --- a/win32/vdir.h +++ b/win32/vdir.h @@ -34,25 +34,25 @@ class VDir inline char* GetCurrentDirectoryA(int dwBufSize, char *lpBuffer) { - char* ptr = dirTableA[nDefault]; - while (--dwBufSize) - { - if ((*lpBuffer++ = *ptr++) == '\0') - break; - } + char* ptr = dirTableA[nDefault]; + while (--dwBufSize) + { + if ((*lpBuffer++ = *ptr++) == '\0') + break; + } *lpBuffer = '\0'; - return /* unused */ NULL; + return /* unused */ NULL; }; inline WCHAR* GetCurrentDirectoryW(int dwBufSize, WCHAR *lpBuffer) { - WCHAR* ptr = dirTableW[nDefault]; - while (--dwBufSize) - { - if ((*lpBuffer++ = *ptr++) == '\0') - break; - } + WCHAR* ptr = dirTableW[nDefault]; + while (--dwBufSize) + { + if ((*lpBuffer++ = *ptr++) == '\0') + break; + } *lpBuffer = '\0'; - return /* unused */ NULL; + return /* unused */ NULL; }; DWORD CalculateEnvironmentSpace(void); @@ -66,54 +66,54 @@ class VDir inline const char *GetDefaultDirA(void) { - return dirTableA[nDefault]; + return dirTableA[nDefault]; }; inline void SetDefaultDirA(char const *pPath, int index) { - SetDirA(pPath, index); - nDefault = index; + SetDirA(pPath, index); + nDefault = index; }; inline const WCHAR *GetDefaultDirW(void) { - return dirTableW[nDefault]; + return dirTableW[nDefault]; }; inline void SetDefaultDirW(WCHAR const *pPath, int index) { - SetDirW(pPath, index); - nDefault = index; + SetDirW(pPath, index); + nDefault = index; }; inline const char *GetDirA(int index) { - char *ptr = dirTableA[index]; - if (!ptr) { - /* simulate the existence of this drive */ - ptr = szLocalBufferA; - ptr[0] = 'A' + index; - ptr[1] = ':'; - ptr[2] = '\\'; - ptr[3] = 0; - } - return ptr; + char *ptr = dirTableA[index]; + if (!ptr) { + /* simulate the existence of this drive */ + ptr = szLocalBufferA; + ptr[0] = 'A' + index; + ptr[1] = ':'; + ptr[2] = '\\'; + ptr[3] = 0; + } + return ptr; }; inline const WCHAR *GetDirW(int index) { - WCHAR *ptr = dirTableW[index]; - if (!ptr) { - /* simulate the existence of this drive */ - ptr = szLocalBufferW; - ptr[0] = 'A' + index; - ptr[1] = ':'; - ptr[2] = '\\'; - ptr[3] = 0; - } - return ptr; + WCHAR *ptr = dirTableW[index]; + if (!ptr) { + /* simulate the existence of this drive */ + ptr = szLocalBufferW; + ptr[0] = 'A' + index; + ptr[1] = ':'; + ptr[2] = '\\'; + ptr[3] = 0; + } + return ptr; }; inline int DriveIndex(char chr) { - if (chr == '\\' || chr == '/') - return ('Z'-'A')+1; - return (chr | 0x20)-'a'; + if (chr == '\\' || chr == '/') + return ('Z'-'A')+1; + return (chr | 0x20)-'a'; }; VMem *pMem; @@ -139,16 +139,16 @@ void VDir::Init(VDir* pDir, VMem *p) pMem = p; if (pDir) { - for (index = 0; index < driveCount; ++index) { - SetDirW(pDir->GetDirW(index), index); - } - nDefault = pDir->GetDefault(); + for (index = 0; index < driveCount; ++index) { + SetDirW(pDir->GetDirW(index), index); + } + nDefault = pDir->GetDefault(); } else { - int bSave = bManageDirectory; - DWORD driveBits = GetLogicalDrives(); + int bSave = bManageDirectory; + DWORD driveBits = GetLogicalDrives(); - bManageDirectory = 0; + bManageDirectory = 0; WCHAR szBuffer[MAX_PATH*driveCount]; if (GetLogicalDriveStringsW(sizeof(szBuffer), szBuffer)) { WCHAR* pEnv = GetEnvironmentStringsW(); @@ -162,7 +162,7 @@ void VDir::Init(VDir* pDir, VMem *p) FreeEnvironmentStringsW(pEnv); } SetDefaultW(L"."); - bManageDirectory = bSave; + bManageDirectory = bSave; } } @@ -172,30 +172,30 @@ int VDir::SetDirA(char const *pPath, int index) int length = 0; WCHAR wBuffer[MAX_PATH+1]; if (index < driveCount && pPath != NULL) { - length = strlen(pPath); - pMem->Free(dirTableA[index]); - ptr = dirTableA[index] = (char*)pMem->Malloc(length+2); - if (ptr != NULL) { - strcpy(ptr, pPath); - ptr += length-1; - chr = *ptr++; - if (chr != '\\' && chr != '/') { - *ptr++ = '\\'; - *ptr = '\0'; - } - MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1, - wBuffer, (sizeof(wBuffer)/sizeof(WCHAR))); - length = wcslen(wBuffer); - pMem->Free(dirTableW[index]); - dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2); - if (dirTableW[index] != NULL) { - wcscpy(dirTableW[index], wBuffer); - } - } + length = strlen(pPath); + pMem->Free(dirTableA[index]); + ptr = dirTableA[index] = (char*)pMem->Malloc(length+2); + if (ptr != NULL) { + strcpy(ptr, pPath); + ptr += length-1; + chr = *ptr++; + if (chr != '\\' && chr != '/') { + *ptr++ = '\\'; + *ptr = '\0'; + } + MultiByteToWideChar(CP_ACP, 0, dirTableA[index], -1, + wBuffer, (sizeof(wBuffer)/sizeof(WCHAR))); + length = wcslen(wBuffer); + pMem->Free(dirTableW[index]); + dirTableW[index] = (WCHAR*)pMem->Malloc((length+1)*2); + if (dirTableW[index] != NULL) { + wcscpy(dirTableW[index], wBuffer); + } + } } if(bManageDirectory) - ::SetCurrentDirectoryA(pPath); + ::SetCurrentDirectoryA(pPath); return length; } @@ -203,26 +203,26 @@ int VDir::SetDirA(char const *pPath, int index) void VDir::FromEnvA(char *pEnv, int index) { /* gets the directory for index from the environment variable. */ while (*pEnv != '\0') { - if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index) + if ((pEnv[0] == '=') && (DriveIndex(pEnv[1]) == index) && pEnv[2] == ':' && pEnv[3] == '=') { - SetDirA(&pEnv[4], index); - break; - } - else - pEnv += strlen(pEnv)+1; + SetDirA(&pEnv[4], index); + break; + } + else + pEnv += strlen(pEnv)+1; } } void VDir::FromEnvW(WCHAR *pEnv, int index) { /* gets the directory for index from the environment variable. */ while (*pEnv != '\0') { - if ((pEnv[0] == '=') && (DriveIndex((char)pEnv[1]) == index) + if ((pEnv[0] == '=') && (DriveIndex((char)pEnv[1]) == index) && pEnv[2] == ':' && pEnv[3] == '=') { - SetDirW(&pEnv[4], index); - break; - } - else - pEnv += wcslen(pEnv)+1; + SetDirW(&pEnv[4], index); + break; + } + else + pEnv += wcslen(pEnv)+1; } } @@ -233,9 +233,9 @@ void VDir::SetDefaultA(char const *pDefault) if (GetFullPathNameA(pDefault, sizeof(szBuffer), szBuffer, &pPtr)) { if (*pDefault != '.' && pPtr != NULL) - *pPtr = '\0'; + *pPtr = '\0'; - SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); + SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); } } @@ -244,31 +244,31 @@ int VDir::SetDirW(WCHAR const *pPath, int index) WCHAR chr, *ptr; int length = 0; if (index < driveCount && pPath != NULL) { - length = wcslen(pPath); - pMem->Free(dirTableW[index]); - ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2); - if (ptr != NULL) { + length = wcslen(pPath); + pMem->Free(dirTableW[index]); + ptr = dirTableW[index] = (WCHAR*)pMem->Malloc((length+2)*2); + if (ptr != NULL) { char *ansi; - wcscpy(ptr, pPath); - ptr += length-1; - chr = *ptr++; - if (chr != '\\' && chr != '/') { - *ptr++ = '\\'; - *ptr = '\0'; - } + wcscpy(ptr, pPath); + ptr += length-1; + chr = *ptr++; + if (chr != '\\' && chr != '/') { + *ptr++ = '\\'; + *ptr = '\0'; + } ansi = win32_ansipath(dirTableW[index]); - length = strlen(ansi); - pMem->Free(dirTableA[index]); - dirTableA[index] = (char*)pMem->Malloc(length+1); - if (dirTableA[index] != NULL) { - strcpy(dirTableA[index], ansi); - } + length = strlen(ansi); + pMem->Free(dirTableA[index]); + dirTableA[index] = (char*)pMem->Malloc(length+1); + if (dirTableA[index] != NULL) { + strcpy(dirTableA[index], ansi); + } win32_free(ansi); - } + } } if(bManageDirectory) - ::SetCurrentDirectoryW(pPath); + ::SetCurrentDirectoryW(pPath); return length; } @@ -280,9 +280,9 @@ void VDir::SetDefaultW(WCHAR const *pDefault) if (GetFullPathNameW(pDefault, (sizeof(szBuffer)/sizeof(WCHAR)), szBuffer, &pPtr)) { if (*pDefault != '.' && pPtr != NULL) - *pPtr = '\0'; + *pPtr = '\0'; - SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0])); + SetDefaultDirW(szBuffer, DriveIndex((char)szBuffer[0])); } } @@ -314,69 +314,69 @@ inline bool IsSpecialFileName(const char* pName) char ch = (pName[0] & ~0x20); switch (ch) { - case 'A': /* AUX */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'X') - && !pName[3]) - return true; - break; - case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ - ch = (pName[1] & ~0x20); - switch (ch) - { - case 'L': /* CLOCK$ */ - if (((pName[2] & ~0x20) == 'O') - && ((pName[3] & ~0x20) == 'C') - && ((pName[4] & ~0x20) == 'K') - && (pName[5] == '$') - && !pName[6]) - return true; - break; - case 'O': /* COMx, CON, CONIN$ CONOUT$ */ - if ((pName[2] & ~0x20) == 'M') { - if ( inRANGE(pName[3], '1', '9') - && !pName[4]) - return true; - } - else if ((pName[2] & ~0x20) == 'N') { - if (!pName[3]) - return true; - else if ((pName[3] & ~0x20) == 'I') { - if (((pName[4] & ~0x20) == 'N') - && (pName[5] == '$') - && !pName[6]) - return true; - } - else if ((pName[3] & ~0x20) == 'O') { - if (((pName[4] & ~0x20) == 'U') - && ((pName[5] & ~0x20) == 'T') - && (pName[6] == '$') - && !pName[7]) - return true; - } - } - break; - } - break; - case 'L': /* LPTx */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'X') - && inRANGE(pName[3], '1', '9') - && !pName[4]) - return true; - break; - case 'N': /* NUL */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'L') - && !pName[3]) - return true; - break; - case 'P': /* PRN */ - if (((pName[1] & ~0x20) == 'R') - && ((pName[2] & ~0x20) == 'N') - && !pName[3]) - return true; - break; + case 'A': /* AUX */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && !pName[3]) + return true; + break; + case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ + ch = (pName[1] & ~0x20); + switch (ch) + { + case 'L': /* CLOCK$ */ + if (((pName[2] & ~0x20) == 'O') + && ((pName[3] & ~0x20) == 'C') + && ((pName[4] & ~0x20) == 'K') + && (pName[5] == '$') + && !pName[6]) + return true; + break; + case 'O': /* COMx, CON, CONIN$ CONOUT$ */ + if ((pName[2] & ~0x20) == 'M') { + if ( inRANGE(pName[3], '1', '9') + && !pName[4]) + return true; + } + else if ((pName[2] & ~0x20) == 'N') { + if (!pName[3]) + return true; + else if ((pName[3] & ~0x20) == 'I') { + if (((pName[4] & ~0x20) == 'N') + && (pName[5] == '$') + && !pName[6]) + return true; + } + else if ((pName[3] & ~0x20) == 'O') { + if (((pName[4] & ~0x20) == 'U') + && ((pName[5] & ~0x20) == 'T') + && (pName[6] == '$') + && !pName[7]) + return true; + } + } + break; + } + break; + case 'L': /* LPTx */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && inRANGE(pName[3], '1', '9') + && !pName[4]) + return true; + break; + case 'N': /* NUL */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'L') + && !pName[3]) + return true; + break; + case 'P': /* PRN */ + if (((pName[1] & ~0x20) == 'R') + && ((pName[2] & ~0x20) == 'N') + && !pName[3]) + return true; + break; } return false; } @@ -392,66 +392,66 @@ char *VDir::MapPathA(const char *pInName) int length = strlen(pInName); if (!length) - return (char*)pInName; + return (char*)pInName; if (length > MAX_PATH) { - strncpy(szlBuf, pInName, MAX_PATH); - if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { - /* absolute path - reduce length by 2 for drive specifier */ - szlBuf[MAX_PATH-2] = '\0'; - } - else - szlBuf[MAX_PATH] = '\0'; - pInName = szlBuf; + strncpy(szlBuf, pInName, MAX_PATH); + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + /* absolute path - reduce length by 2 for drive specifier */ + szlBuf[MAX_PATH-2] = '\0'; + } + else + szlBuf[MAX_PATH] = '\0'; + pInName = szlBuf; } /* strlen(pInName) is now <= MAX_PATH */ if (length > 1 && pInName[1] == ':') { - /* has drive letter */ - if (length > 2 && IsPathSep(pInName[2])) { - /* absolute with drive letter */ - DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); - } - else { - /* relative path with drive letter */ + /* has drive letter */ + if (length > 2 && IsPathSep(pInName[2])) { + /* absolute with drive letter */ + DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); + } + else { + /* relative path with drive letter */ driveIndex = DriveIndex(*pInName); if (driveIndex < 0 || driveIndex >= driveLetterCount) return (char *)pInName; - strcpy(szBuffer, GetDirA(driveIndex)); - strcat(szBuffer, &pInName[2]); - if(strlen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; + strcpy(szBuffer, GetDirA(driveIndex)); + strcat(szBuffer, &pInName[2]); + if(strlen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; - DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); - } + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } } else { - /* no drive letter */ - if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { - /* UNC name */ - DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); - } - else { - strcpy(szBuffer, GetDefaultDirA()); - if (IsPathSep(pInName[0])) { - /* absolute path */ - strcpy(&szBuffer[2], pInName); - DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); - } - else { - /* relative path */ - if (IsSpecialFileName(pInName)) { - return (char*)pInName; - } - else { - strcat(szBuffer, pInName); - if (strlen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; - - DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); - } - } - } + /* no drive letter */ + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + /* UNC name */ + DoGetFullPathNameA((char*)pInName, sizeof(szLocalBufferA), szLocalBufferA); + } + else { + strcpy(szBuffer, GetDefaultDirA()); + if (IsPathSep(pInName[0])) { + /* absolute path */ + strcpy(&szBuffer[2], pInName); + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } + else { + /* relative path */ + if (IsSpecialFileName(pInName)) { + return (char*)pInName; + } + else { + strcat(szBuffer, pInName); + if (strlen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameA(szBuffer, sizeof(szLocalBufferA), szLocalBufferA); + } + } + } } return szLocalBufferA; @@ -465,17 +465,17 @@ int VDir::SetCurrentDirectoryA(char *lpBuffer) pPtr = MapPathA(lpBuffer); length = strlen(pPtr); if(length > 3 && IsPathSep(pPtr[length-1])) { - /* don't remove the trailing slash from 'x:\' */ - pPtr[length-1] = '\0'; + /* don't remove the trailing slash from 'x:\' */ + pPtr[length-1] = '\0'; } DWORD r = GetFileAttributesA(pPtr); if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY)) { - char szBuffer[(MAX_PATH+1)*2]; - DoGetFullPathNameA(pPtr, sizeof(szBuffer), szBuffer); - SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); - nRet = 0; + char szBuffer[(MAX_PATH+1)*2]; + DoGetFullPathNameA(pPtr, sizeof(szBuffer), szBuffer); + SetDefaultDirA(szBuffer, DriveIndex(szBuffer[0])); + nRet = 0; } return nRet; @@ -486,9 +486,9 @@ DWORD VDir::CalculateEnvironmentSpace(void) int index; DWORD dwSize = 0; for (index = 0; index < driveCount; ++index) { - if (dirTableA[index] != NULL) { - dwSize += strlen(dirTableA[index]) + 5; /* add 1 for trailing NULL and 4 for '=D:=' */ - } + if (dirTableA[index] != NULL) { + dwSize += strlen(dirTableA[index]) + 5; /* add 1 for trailing NULL and 4 for '=D:=' */ + } } return dwSize; } @@ -498,22 +498,22 @@ LPSTR VDir::BuildEnvironmentSpace(LPSTR lpStr) int index, length; LPSTR lpDirStr; for (index = 0; index < driveCount; ++index) { - lpDirStr = dirTableA[index]; - if (lpDirStr != NULL) { - lpStr[0] = '='; - lpStr[1] = lpDirStr[0]; - lpStr[2] = '\0'; - CharUpper(&lpStr[1]); - lpStr[2] = ':'; - lpStr[3] = '='; - strcpy(&lpStr[4], lpDirStr); - length = strlen(lpDirStr); - lpStr += length + 5; /* add 1 for trailing NULL and 4 for '=D:=' */ - if (length > 3 && IsPathSep(lpStr[-2])) { - lpStr[-2] = '\0'; /* remove the trailing path separator */ - --lpStr; - } - } + lpDirStr = dirTableA[index]; + if (lpDirStr != NULL) { + lpStr[0] = '='; + lpStr[1] = lpDirStr[0]; + lpStr[2] = '\0'; + CharUpper(&lpStr[1]); + lpStr[2] = ':'; + lpStr[3] = '='; + strcpy(&lpStr[4], lpDirStr); + length = strlen(lpDirStr); + lpStr += length + 5; /* add 1 for trailing NULL and 4 for '=D:=' */ + if (length > 3 && IsPathSep(lpStr[-2])) { + lpStr[-2] = '\0'; /* remove the trailing path separator */ + --lpStr; + } + } } return lpStr; } @@ -546,69 +546,69 @@ inline bool IsSpecialFileName(const WCHAR* pName) WCHAR ch = (pName[0] & ~0x20); switch (ch) { - case 'A': /* AUX */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'X') - && !pName[3]) - return true; - break; - case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ - ch = (pName[1] & ~0x20); - switch (ch) - { - case 'L': /* CLOCK$ */ - if (((pName[2] & ~0x20) == 'O') - && ((pName[3] & ~0x20) == 'C') - && ((pName[4] & ~0x20) == 'K') - && (pName[5] == '$') - && !pName[6]) - return true; - break; - case 'O': /* COMx, CON, CONIN$ CONOUT$ */ - if ((pName[2] & ~0x20) == 'M') { - if ( inRANGE(pName[3], '1', '9') - && !pName[4]) - return true; - } - else if ((pName[2] & ~0x20) == 'N') { - if (!pName[3]) - return true; - else if ((pName[3] & ~0x20) == 'I') { - if (((pName[4] & ~0x20) == 'N') - && (pName[5] == '$') - && !pName[6]) - return true; - } - else if ((pName[3] & ~0x20) == 'O') { - if (((pName[4] & ~0x20) == 'U') - && ((pName[5] & ~0x20) == 'T') - && (pName[6] == '$') - && !pName[7]) - return true; - } - } - break; - } - break; - case 'L': /* LPTx */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'X') - && inRANGE(pName[3], '1', '9') - && !pName[4]) - return true; - break; - case 'N': /* NUL */ - if (((pName[1] & ~0x20) == 'U') - && ((pName[2] & ~0x20) == 'L') - && !pName[3]) - return true; - break; - case 'P': /* PRN */ - if (((pName[1] & ~0x20) == 'R') - && ((pName[2] & ~0x20) == 'N') - && !pName[3]) - return true; - break; + case 'A': /* AUX */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && !pName[3]) + return true; + break; + case 'C': /* CLOCK$, COMx, CON, CONIN$ CONOUT$ */ + ch = (pName[1] & ~0x20); + switch (ch) + { + case 'L': /* CLOCK$ */ + if (((pName[2] & ~0x20) == 'O') + && ((pName[3] & ~0x20) == 'C') + && ((pName[4] & ~0x20) == 'K') + && (pName[5] == '$') + && !pName[6]) + return true; + break; + case 'O': /* COMx, CON, CONIN$ CONOUT$ */ + if ((pName[2] & ~0x20) == 'M') { + if ( inRANGE(pName[3], '1', '9') + && !pName[4]) + return true; + } + else if ((pName[2] & ~0x20) == 'N') { + if (!pName[3]) + return true; + else if ((pName[3] & ~0x20) == 'I') { + if (((pName[4] & ~0x20) == 'N') + && (pName[5] == '$') + && !pName[6]) + return true; + } + else if ((pName[3] & ~0x20) == 'O') { + if (((pName[4] & ~0x20) == 'U') + && ((pName[5] & ~0x20) == 'T') + && (pName[6] == '$') + && !pName[7]) + return true; + } + } + break; + } + break; + case 'L': /* LPTx */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'X') + && inRANGE(pName[3], '1', '9') + && !pName[4]) + return true; + break; + case 'N': /* NUL */ + if (((pName[1] & ~0x20) == 'U') + && ((pName[2] & ~0x20) == 'L') + && !pName[3]) + return true; + break; + case 'P': /* PRN */ + if (((pName[1] & ~0x20) == 'R') + && ((pName[2] & ~0x20) == 'N') + && !pName[3]) + return true; + break; } return false; } @@ -624,66 +624,66 @@ WCHAR* VDir::MapPathW(const WCHAR *pInName) int length = wcslen(pInName); if (!length) - return (WCHAR*)pInName; + return (WCHAR*)pInName; if (length > MAX_PATH) { - wcsncpy(szlBuf, pInName, MAX_PATH); - if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { - /* absolute path - reduce length by 2 for drive specifier */ - szlBuf[MAX_PATH-2] = '\0'; - } - else - szlBuf[MAX_PATH] = '\0'; - pInName = szlBuf; + wcsncpy(szlBuf, pInName, MAX_PATH); + if (IsPathSep(pInName[0]) && !IsPathSep(pInName[1])) { + /* absolute path - reduce length by 2 for drive specifier */ + szlBuf[MAX_PATH-2] = '\0'; + } + else + szlBuf[MAX_PATH] = '\0'; + pInName = szlBuf; } /* strlen(pInName) is now <= MAX_PATH */ if (length > 1 && pInName[1] == ':') { - /* has drive letter */ - if (IsPathSep(pInName[2])) { - /* absolute with drive letter */ - DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); - } - else { - /* relative path with drive letter */ + /* has drive letter */ + if (IsPathSep(pInName[2])) { + /* absolute with drive letter */ + DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + else { + /* relative path with drive letter */ driveIndex = DriveIndex(*pInName); if (driveIndex < 0 || driveIndex >= driveLetterCount) return (WCHAR *)pInName; - wcscpy(szBuffer, GetDirW(driveIndex)); - wcscat(szBuffer, &pInName[2]); - if(wcslen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; + wcscpy(szBuffer, GetDirW(driveIndex)); + wcscat(szBuffer, &pInName[2]); + if(wcslen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; - DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); - } + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } } else { - /* no drive letter */ - if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { - /* UNC name */ - DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); - } - else { - wcscpy(szBuffer, GetDefaultDirW()); - if (IsPathSep(pInName[0])) { - /* absolute path */ - wcscpy(&szBuffer[2], pInName); - DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); - } - else { - /* relative path */ - if (IsSpecialFileName(pInName)) { - return (WCHAR*)pInName; - } - else { - wcscat(szBuffer, pInName); - if (wcslen(szBuffer) > MAX_PATH) - szBuffer[MAX_PATH] = '\0'; - - DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); - } - } - } + /* no drive letter */ + if (length > 1 && IsPathSep(pInName[1]) && IsPathSep(pInName[0])) { + /* UNC name */ + DoGetFullPathNameW((WCHAR*)pInName, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + else { + wcscpy(szBuffer, GetDefaultDirW()); + if (IsPathSep(pInName[0])) { + /* absolute path */ + wcscpy(&szBuffer[2], pInName); + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + else { + /* relative path */ + if (IsSpecialFileName(pInName)) { + return (WCHAR*)pInName; + } + else { + wcscat(szBuffer, pInName); + if (wcslen(szBuffer) > MAX_PATH) + szBuffer[MAX_PATH] = '\0'; + + DoGetFullPathNameW(szBuffer, (sizeof(szLocalBufferW)/sizeof(WCHAR)), szLocalBufferW); + } + } + } } return szLocalBufferW; } @@ -696,17 +696,17 @@ int VDir::SetCurrentDirectoryW(WCHAR *lpBuffer) pPtr = MapPathW(lpBuffer); length = wcslen(pPtr); if(length > 3 && IsPathSep(pPtr[length-1])) { - /* don't remove the trailing slash from 'x:\' */ - pPtr[length-1] = '\0'; + /* don't remove the trailing slash from 'x:\' */ + pPtr[length-1] = '\0'; } DWORD r = GetFileAttributesW(pPtr); if ((r != 0xffffffff) && (r & FILE_ATTRIBUTE_DIRECTORY)) { - WCHAR wBuffer[(MAX_PATH+1)*2]; - DoGetFullPathNameW(pPtr, (sizeof(wBuffer)/sizeof(WCHAR)), wBuffer); - SetDefaultDirW(wBuffer, DriveIndex((char)wBuffer[0])); - nRet = 0; + WCHAR wBuffer[(MAX_PATH+1)*2]; + DoGetFullPathNameW(pPtr, (sizeof(wBuffer)/sizeof(WCHAR)), wBuffer); + SetDefaultDirW(wBuffer, DriveIndex((char)wBuffer[0])); + nRet = 0; } return nRet; diff --git a/win32/vmem.h b/win32/vmem.h index 3fd7e169fc44..bd765f68e22d 100644 --- a/win32/vmem.h +++ b/win32/vmem.h @@ -93,26 +93,26 @@ class VMem inline BOOL CreateOk(void) { - return TRUE; + return TRUE; }; protected: #ifdef _USE_LINKED_LIST void LinkBlock(PMEMORY_BLOCK_HEADER ptr) { - PMEMORY_BLOCK_HEADER next = m_Dummy.pNext; - m_Dummy.pNext = ptr; - ptr->pPrev = &m_Dummy; - ptr->pNext = next; + PMEMORY_BLOCK_HEADER next = m_Dummy.pNext; + m_Dummy.pNext = ptr; + ptr->pPrev = &m_Dummy; + ptr->pNext = next; ptr->owner = this; - next->pPrev = ptr; + next->pPrev = ptr; } void UnlinkBlock(PMEMORY_BLOCK_HEADER ptr) { - PMEMORY_BLOCK_HEADER next = ptr->pNext; - PMEMORY_BLOCK_HEADER prev = ptr->pPrev; - prev->pNext = next; - next->pPrev = prev; + PMEMORY_BLOCK_HEADER next = ptr->pNext; + PMEMORY_BLOCK_HEADER prev = ptr->pPrev; + prev->pNext = next; + next->pPrev = prev; } MEMORY_BLOCK_HEADER m_Dummy; @@ -136,7 +136,7 @@ VMem::~VMem(void) { #ifdef _USE_LINKED_LIST while (m_Dummy.pNext != &m_Dummy) { - Free(m_Dummy.pNext+1); + Free(m_Dummy.pNext+1); } DeleteCriticalSection(&m_cs); #endif @@ -148,8 +148,8 @@ void* VMem::Malloc(size_t size) GetLock(); PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)malloc(size+sizeof(MEMORY_BLOCK_HEADER)); if (!ptr) { - FreeLock(); - return NULL; + FreeLock(); + return NULL; } LinkBlock(ptr); FreeLock(); @@ -163,11 +163,11 @@ void* VMem::Realloc(void* pMem, size_t size) { #ifdef _USE_LINKED_LIST if (!pMem) - return Malloc(size); + return Malloc(size); if (!size) { - Free(pMem); - return NULL; + Free(pMem); + return NULL; } GetLock(); @@ -175,8 +175,8 @@ void* VMem::Realloc(void* pMem, size_t size) UnlinkBlock(ptr); ptr = (PMEMORY_BLOCK_HEADER)realloc(ptr, size+sizeof(MEMORY_BLOCK_HEADER)); if (!ptr) { - FreeLock(); - return NULL; + FreeLock(); + return NULL; } LinkBlock(ptr); FreeLock(); @@ -191,25 +191,25 @@ void VMem::Free(void* pMem) { #ifdef _USE_LINKED_LIST if (pMem) { - PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER)); + PMEMORY_BLOCK_HEADER ptr = (PMEMORY_BLOCK_HEADER)(((char*)pMem)-sizeof(MEMORY_BLOCK_HEADER)); if (ptr->owner != this) { - if (ptr->owner) { + if (ptr->owner) { #if 1 - int *nowhere = NULL; - Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->owner); - *nowhere = 0; /* this segfault is deliberate, - so you can see the stack trace */ + int *nowhere = NULL; + Perl_warn_nocontext("Free to wrong pool %p not %p",this,ptr->owner); + *nowhere = 0; /* this segfault is deliberate, + so you can see the stack trace */ #else ptr->owner->Free(pMem); #endif - } - return; + } + return; } - GetLock(); - UnlinkBlock(ptr); - ptr->owner = NULL; - free(ptr); - FreeLock(); + GetLock(); + UnlinkBlock(ptr); + ptr->owner = NULL; + free(ptr); + FreeLock(); } #else /*_USE_LINKED_LIST*/ free(pMem); @@ -238,7 +238,7 @@ int VMem::IsLocked(void) * skirt the issue for now. */ BOOL bAccessed = TryEnterCriticalSection(&m_cs); if(bAccessed) { - LeaveCriticalSection(&m_cs); + LeaveCriticalSection(&m_cs); } return !bAccessed; #else @@ -251,7 +251,7 @@ long VMem::Release(void) { long lCount = InterlockedDecrement(&m_lRefCount); if(!lCount) - delete this; + delete this; return lCount; } @@ -411,9 +411,9 @@ class VMem inline BOOL CreateOk(void) { #ifdef _USE_BUDDY_BLOCKS - return TRUE; + return TRUE; #else - return m_hHeap != NULL; + return m_hHeap != NULL; #endif }; @@ -425,7 +425,7 @@ class VMem int HeapAdd(void* ptr, size_t size #ifdef USE_BIGBLOCK_ALLOC - , BOOL bBigBlock + , BOOL bBigBlock #endif ); @@ -434,35 +434,35 @@ class VMem #ifdef _USE_BUDDY_BLOCKS inline PBLOCK GetFreeListLink(int index) { - if (index >= nListEntries) - index = nListEntries-1; - return &m_FreeList[index].Dummy[sizeofTag]; + if (index >= nListEntries) + index = nListEntries-1; + return &m_FreeList[index].Dummy[sizeofTag]; } inline PBLOCK GetOverSizeFreeList(void) { - return &m_FreeList[nListEntries-1].Dummy[sizeofTag]; + return &m_FreeList[nListEntries-1].Dummy[sizeofTag]; } inline PBLOCK GetEOLFreeList(void) { - return &m_FreeList[nListEntries].Dummy[sizeofTag]; + return &m_FreeList[nListEntries].Dummy[sizeofTag]; } void AddToFreeList(PBLOCK block, size_t size) { - PBLOCK pFreeList = GetFreeListLink(CalcEntry(size)); - PBLOCK next = NEXT(pFreeList); - NEXT(pFreeList) = block; - SetLink(block, pFreeList, next); - PREV(next) = block; + PBLOCK pFreeList = GetFreeListLink(CalcEntry(size)); + PBLOCK next = NEXT(pFreeList); + NEXT(pFreeList) = block; + SetLink(block, pFreeList, next); + PREV(next) = block; } #endif inline size_t CalcAllocSize(size_t size) { - /* - * Adjust the real size of the block to be a multiple of sizeof(long), and add - * the overhead for the boundary tags. Disallow negative or zero sizes. - */ - return (size < minBlockSize) ? minAllocSize : (size_t)ROUND_UP(size) + blockOverhead; + /* + * Adjust the real size of the block to be a multiple of sizeof(long), and add + * the overhead for the boundary tags. Disallow negative or zero sizes. + */ + return (size < minBlockSize) ? minAllocSize : (size_t)ROUND_UP(size) + blockOverhead; } #ifdef _USE_BUDDY_BLOCKS @@ -491,8 +491,8 @@ VMem::VMem() m_lRefCount = 1; #ifndef _USE_BUDDY_BLOCKS BOOL bRet = (NULL != (m_hHeap = HeapCreate(HEAP_NO_SERIALIZE, - lAllocStart, /* initial size of heap */ - 0))); /* no upper limit on size of heap */ + lAllocStart, /* initial size of heap */ + 0))); /* no upper limit on size of heap */ ASSERT(bRet); #endif @@ -514,14 +514,14 @@ VMem::~VMem(void) DeleteCriticalSection(&m_cs); #ifdef _USE_BUDDY_BLOCKS for(int index = 0; index < m_nHeaps; ++index) { - VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); + VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); } #else /* !_USE_BUDDY_BLOCKS */ #ifdef USE_BIGBLOCK_ALLOC for(int index = 0; index < m_nHeaps; ++index) { - if (m_heaps[index].bBigBlock) { - VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); - } + if (m_heaps[index].bBigBlock) { + VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); + } } #endif BOOL bRet = HeapDestroy(m_hHeap); @@ -533,15 +533,15 @@ void VMem::ReInit(void) { for(int index = 0; index < m_nHeaps; ++index) { #ifdef _USE_BUDDY_BLOCKS - VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); + VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); #else #ifdef USE_BIGBLOCK_ALLOC - if (m_heaps[index].bBigBlock) { - VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); - } - else + if (m_heaps[index].bBigBlock) { + VirtualFree(m_heaps[index].base, 0, MEM_RELEASE); + } + else #endif - HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base); + HeapFree(m_hHeap, HEAP_NO_SERIALIZE, m_heaps[index].base); #endif /* _USE_BUDDY_BLOCKS */ } @@ -559,9 +559,9 @@ void VMem::Init(void) * Set the next allocation size. */ for (int index = 0; index < nListEntries; ++index) { - pFreeList = GetFreeListLink(index); - SIZE(pFreeList) = PSIZE(pFreeList+minAllocSize) = 0; - PREV(pFreeList) = NEXT(pFreeList) = pFreeList; + pFreeList = GetFreeListLink(index); + SIZE(pFreeList) = PSIZE(pFreeList+minAllocSize) = 0; + PREV(pFreeList) = NEXT(pFreeList) = pFreeList; } pFreeList = GetEOLFreeList(); SIZE(pFreeList) = PSIZE(pFreeList+minAllocSize) = 0; @@ -592,7 +592,7 @@ void* VMem::Malloc(size_t size) */ size_t realsize = CalcAllocSize(size); if((int)realsize < minAllocSize || size == 0) - return NULL; + return NULL; #ifdef _USE_BUDDY_BLOCKS /* @@ -602,78 +602,78 @@ void* VMem::Malloc(size_t size) * split the block if needed, stop at end of list marker */ { - int index = CalcEntry(realsize); - if (index < nListEntries-1) { - ptr = GetFreeListLink(index); - lsize = SIZE(ptr); - if (lsize >= realsize) { - rem = lsize - realsize; - if(rem < minAllocSize) { - /* Unlink the block from the free list. */ - Unlink(ptr); - } - else { - /* - * split the block - * The remainder is big enough to split off into a new block. - * Use the end of the block, resize the beginning of the block - * no need to change the free list. - */ - SetTags(ptr, rem); - ptr += SIZE(ptr); - lsize = realsize; - } - SetTags(ptr, lsize | 1); - return ptr; - } - ptr = m_pRover; - lsize = SIZE(ptr); - if (lsize >= realsize) { - rem = lsize - realsize; - if(rem < minAllocSize) { - /* Unlink the block from the free list. */ - Unlink(ptr); - } - else { - /* - * split the block - * The remainder is big enough to split off into a new block. - * Use the end of the block, resize the beginning of the block - * no need to change the free list. - */ - SetTags(ptr, rem); - ptr += SIZE(ptr); - lsize = realsize; - } - SetTags(ptr, lsize | 1); - return ptr; - } - ptr = GetFreeListLink(index+1); - while (NEXT(ptr)) { - lsize = SIZE(ptr); - if (lsize >= realsize) { - size_t rem = lsize - realsize; - if(rem < minAllocSize) { - /* Unlink the block from the free list. */ - Unlink(ptr); - } - else { - /* - * split the block - * The remainder is big enough to split off into a new block. - * Use the end of the block, resize the beginning of the block - * no need to change the free list. - */ - SetTags(ptr, rem); - ptr += SIZE(ptr); - lsize = realsize; - } - SetTags(ptr, lsize | 1); - return ptr; - } - ptr += sizeof(FREE_LIST_ENTRY); - } - } + int index = CalcEntry(realsize); + if (index < nListEntries-1) { + ptr = GetFreeListLink(index); + lsize = SIZE(ptr); + if (lsize >= realsize) { + rem = lsize - realsize; + if(rem < minAllocSize) { + /* Unlink the block from the free list. */ + Unlink(ptr); + } + else { + /* + * split the block + * The remainder is big enough to split off into a new block. + * Use the end of the block, resize the beginning of the block + * no need to change the free list. + */ + SetTags(ptr, rem); + ptr += SIZE(ptr); + lsize = realsize; + } + SetTags(ptr, lsize | 1); + return ptr; + } + ptr = m_pRover; + lsize = SIZE(ptr); + if (lsize >= realsize) { + rem = lsize - realsize; + if(rem < minAllocSize) { + /* Unlink the block from the free list. */ + Unlink(ptr); + } + else { + /* + * split the block + * The remainder is big enough to split off into a new block. + * Use the end of the block, resize the beginning of the block + * no need to change the free list. + */ + SetTags(ptr, rem); + ptr += SIZE(ptr); + lsize = realsize; + } + SetTags(ptr, lsize | 1); + return ptr; + } + ptr = GetFreeListLink(index+1); + while (NEXT(ptr)) { + lsize = SIZE(ptr); + if (lsize >= realsize) { + size_t rem = lsize - realsize; + if(rem < minAllocSize) { + /* Unlink the block from the free list. */ + Unlink(ptr); + } + else { + /* + * split the block + * The remainder is big enough to split off into a new block. + * Use the end of the block, resize the beginning of the block + * no need to change the free list. + */ + SetTags(ptr, rem); + ptr += SIZE(ptr); + lsize = realsize; + } + SetTags(ptr, lsize | 1); + return ptr; + } + ptr += sizeof(FREE_LIST_ENTRY); + } + } } #endif @@ -684,46 +684,46 @@ void* VMem::Malloc(size_t size) ptr = m_pRover; /* start searching at rover */ int loops = 2; /* allow two times through the loop */ for(;;) { - lsize = SIZE(ptr); - ASSERT((lsize&1)==0); - /* is block big enough? */ - if(lsize >= realsize) { - /* if the remainder is too small, don't bother splitting the block. */ - rem = lsize - realsize; - if(rem < minAllocSize) { - if(m_pRover == ptr) - m_pRover = NEXT(ptr); - - /* Unlink the block from the free list. */ - Unlink(ptr); - } - else { - /* - * split the block - * The remainder is big enough to split off into a new block. - * Use the end of the block, resize the beginning of the block - * no need to change the free list. - */ - SetTags(ptr, rem); - ptr += SIZE(ptr); - lsize = realsize; - } - /* Set the boundary tags to mark it as allocated. */ - SetTags(ptr, lsize | 1); - return ((void *)ptr); - } - - /* - * This block was unsuitable. If we've gone through this list once already without - * finding anything, allocate some new memory from the heap and try again. - */ - ptr = NEXT(ptr); - if(ptr == m_pRover) { - if(!(loops-- && Getmem(realsize))) { - return NULL; - } - ptr = m_pRover; - } + lsize = SIZE(ptr); + ASSERT((lsize&1)==0); + /* is block big enough? */ + if(lsize >= realsize) { + /* if the remainder is too small, don't bother splitting the block. */ + rem = lsize - realsize; + if(rem < minAllocSize) { + if(m_pRover == ptr) + m_pRover = NEXT(ptr); + + /* Unlink the block from the free list. */ + Unlink(ptr); + } + else { + /* + * split the block + * The remainder is big enough to split off into a new block. + * Use the end of the block, resize the beginning of the block + * no need to change the free list. + */ + SetTags(ptr, rem); + ptr += SIZE(ptr); + lsize = realsize; + } + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, lsize | 1); + return ((void *)ptr); + } + + /* + * This block was unsuitable. If we've gone through this list once already without + * finding anything, allocate some new memory from the heap and try again. + */ + ptr = NEXT(ptr); + if(ptr == m_pRover) { + if(!(loops-- && Getmem(realsize))) { + return NULL; + } + ptr = m_pRover; + } } } @@ -733,24 +733,24 @@ void* VMem::Realloc(void* block, size_t size) /* if size is zero, free the block. */ if(size == 0) { - Free(block); - return (NULL); + Free(block); + return (NULL); } /* if block pointer is NULL, do a Malloc(). */ if(block == NULL) - return Malloc(size); + return Malloc(size); /* * Grow or shrink the block in place. * if the block grows then the next block will be used if free */ if(Expand(block, size) != NULL) - return block; + return block; size_t realsize = CalcAllocSize(size); if((int)realsize < minAllocSize) - return NULL; + return NULL; /* * see if the previous block is free, and is it big enough to cover the new size @@ -760,46 +760,46 @@ void* VMem::Realloc(void* block, size_t size) size_t cursize = SIZE(ptr) & ~1; size_t psize = PSIZE(ptr); if((psize&1) == 0 && (psize + cursize) >= realsize) { - PBLOCK prev = ptr - psize; - if(m_pRover == prev) - m_pRover = NEXT(prev); - - /* Unlink the next block from the free list. */ - Unlink(prev); - - /* Copy contents of old block to new location, make it the current block. */ - memmove(prev, ptr, cursize); - cursize += psize; /* combine sizes */ - ptr = prev; - - size_t rem = cursize - realsize; - if(rem >= minAllocSize) { - /* - * The remainder is big enough to be a new block. Set boundary - * tags for the resized block and the new block. - */ - prev = ptr + realsize; - /* - * add the new block to the free list. - * next block cannot be free - */ - SetTags(prev, rem); + PBLOCK prev = ptr - psize; + if(m_pRover == prev) + m_pRover = NEXT(prev); + + /* Unlink the next block from the free list. */ + Unlink(prev); + + /* Copy contents of old block to new location, make it the current block. */ + memmove(prev, ptr, cursize); + cursize += psize; /* combine sizes */ + ptr = prev; + + size_t rem = cursize - realsize; + if(rem >= minAllocSize) { + /* + * The remainder is big enough to be a new block. Set boundary + * tags for the resized block and the new block. + */ + prev = ptr + realsize; + /* + * add the new block to the free list. + * next block cannot be free + */ + SetTags(prev, rem); #ifdef _USE_BUDDY_BLOCKS - AddToFreeList(prev, rem); + AddToFreeList(prev, rem); #else - AddToFreeList(prev, m_pFreeList); + AddToFreeList(prev, m_pFreeList); #endif - cursize = realsize; + cursize = realsize; } - /* Set the boundary tags to mark it as allocated. */ - SetTags(ptr, cursize | 1); + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, cursize | 1); return ((void *)ptr); } /* Allocate a new block, copy the old to the new, and free the old. */ if((ptr = (PBLOCK)Malloc(size)) != NULL) { - memmove(ptr, block, cursize-blockOverhead); - Free(block); + memmove(ptr, block, cursize-blockOverhead); + Free(block); } return ((void *)ptr); } @@ -810,15 +810,15 @@ void VMem::Free(void* p) /* Ignore null pointer. */ if(p == NULL) - return; + return; PBLOCK ptr = (PBLOCK)p; /* Check for attempt to free a block that's already free. */ size_t size = SIZE(ptr); if((size&1) == 0) { - MEMODSlx("Attempt to free previously freed block", (long)p); - return; + MEMODSlx("Attempt to free previously freed block", (long)p); + return; } size &= ~1; /* remove allocated tag */ @@ -828,12 +828,12 @@ void VMem::Free(void* p) #endif size_t psize = PSIZE(ptr); if((psize&1) == 0) { - ptr -= psize; /* point to previous block */ - size += psize; /* merge the sizes of the two blocks */ + ptr -= psize; /* point to previous block */ + size += psize; /* merge the sizes of the two blocks */ #ifdef _USE_BUDDY_BLOCKS - Unlink(ptr); + Unlink(ptr); #else - linked = TRUE; /* it's already on the free list */ + linked = TRUE; /* it's already on the free list */ #endif } @@ -841,15 +841,15 @@ void VMem::Free(void* p) PBLOCK next = ptr + size; /* point to next physical block */ size_t nsize = SIZE(next); if((nsize&1) == 0) { - /* block is free move rover if needed */ - if(m_pRover == next) - m_pRover = NEXT(next); + /* block is free move rover if needed */ + if(m_pRover == next) + m_pRover = NEXT(next); - /* unlink the next block from the free list. */ - Unlink(next); + /* unlink the next block from the free list. */ + Unlink(next); - /* merge the sizes of this block and the next block. */ - size += nsize; + /* merge the sizes of this block and the next block. */ + size += nsize; } /* Set the boundary tags for the block; */ @@ -857,10 +857,10 @@ void VMem::Free(void* p) /* Link the block to the head of the free list. */ #ifdef _USE_BUDDY_BLOCKS - AddToFreeList(ptr, size); + AddToFreeList(ptr, size); #else if(!linked) { - AddToFreeList(ptr, m_pFreeList); + AddToFreeList(ptr, m_pFreeList); } #endif } @@ -883,7 +883,7 @@ int VMem::IsLocked(void) * skirt the issue for now. */ BOOL bAccessed = TryEnterCriticalSection(&m_cs); if(bAccessed) { - LeaveCriticalSection(&m_cs); + LeaveCriticalSection(&m_cs); } return !bAccessed; #else @@ -897,7 +897,7 @@ long VMem::Release(void) { long lCount = InterlockedDecrement(&m_lRefCount); if(!lCount) - delete this; + delete this; return lCount; } @@ -923,30 +923,30 @@ int VMem::Getmem(size_t requestSize) * adjust up */ if(size < (unsigned long)m_lAllocSize) - size = m_lAllocSize; + size = m_lAllocSize; /* Update the size to allocate on the next request */ if(m_lAllocSize != lAllocMax) - m_lAllocSize <<= 2; + m_lAllocSize <<= 2; #ifndef _USE_BUDDY_BLOCKS if(m_nHeaps != 0 #ifdef USE_BIGBLOCK_ALLOC - && !m_heaps[m_nHeaps-1].bBigBlock + && !m_heaps[m_nHeaps-1].bBigBlock #endif - ) { - /* Expand the last allocated heap */ - ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|HEAP_NO_SERIALIZE, - m_heaps[m_nHeaps-1].base, - m_heaps[m_nHeaps-1].len + size); - if(ptr != 0) { - HeapAdd(((char*)ptr) + m_heaps[m_nHeaps-1].len, size + ) { + /* Expand the last allocated heap */ + ptr = HeapReAlloc(m_hHeap, HEAP_REALLOC_IN_PLACE_ONLY|HEAP_NO_SERIALIZE, + m_heaps[m_nHeaps-1].base, + m_heaps[m_nHeaps-1].len + size); + if(ptr != 0) { + HeapAdd(((char*)ptr) + m_heaps[m_nHeaps-1].len, size #ifdef USE_BIGBLOCK_ALLOC - , FALSE + , FALSE #endif - ); - return -1; - } + ); + return -1; + } } #endif /* _USE_BUDDY_BLOCKS */ @@ -957,7 +957,7 @@ int VMem::Getmem(size_t requestSize) * the above ROUND_UP64K may not have added any memory to include this. */ if(size == requestSize) - size = (size_t)ROUND_UP64K(requestSize+(blockOverhead)); + size = (size_t)ROUND_UP64K(requestSize+(blockOverhead)); Restart: #ifdef _USE_BUDDY_BLOCKS @@ -966,8 +966,8 @@ int VMem::Getmem(size_t requestSize) #ifdef USE_BIGBLOCK_ALLOC bBigBlock = FALSE; if (size >= nMaxHeapAllocSize) { - bBigBlock = TRUE; - ptr = VirtualAlloc(NULL, size, MEM_COMMIT, PAGE_READWRITE); + bBigBlock = TRUE; + ptr = VirtualAlloc(NULL, size, MEM_COMMIT, PAGE_READWRITE); } else #endif @@ -975,28 +975,28 @@ int VMem::Getmem(size_t requestSize) #endif /* _USE_BUDDY_BLOCKS */ if (!ptr) { - /* try to allocate a smaller chunk */ - size >>= 1; - if(size > requestSize) - goto Restart; + /* try to allocate a smaller chunk */ + size >>= 1; + if(size > requestSize) + goto Restart; } if(ptr == 0) { - MEMODSlx("HeapAlloc failed on size!!!", size); - return 0; + MEMODSlx("HeapAlloc failed on size!!!", size); + return 0; } #ifdef _USE_BUDDY_BLOCKS if (HeapAdd(ptr, size)) { - VirtualFree(ptr, 0, MEM_RELEASE); - return 0; + VirtualFree(ptr, 0, MEM_RELEASE); + return 0; } #else #ifdef USE_BIGBLOCK_ALLOC if (HeapAdd(ptr, size, bBigBlock)) { - if (bBigBlock) { - VirtualFree(ptr, 0, MEM_RELEASE); - } + if (bBigBlock) { + VirtualFree(ptr, 0, MEM_RELEASE); + } } #else HeapAdd(ptr, size); @@ -1015,7 +1015,7 @@ int VMem::HeapAdd(void* p, size_t size /* Check size, then round size down to next long word boundary. */ if(size < minAllocSize) - return -1; + return -1; size = (size_t)ROUND_DOWN(size); PBLOCK ptr = (PBLOCK)p; @@ -1023,47 +1023,47 @@ int VMem::HeapAdd(void* p, size_t size #ifdef USE_BIGBLOCK_ALLOC if (!bBigBlock) { #endif - /* - * Search for another heap area that's contiguous with the bottom of this new area. - * (It should be extremely unusual to find one that's contiguous with the top). - */ - for(index = 0; index < m_nHeaps; ++index) { - if(ptr == m_heaps[index].base + (int)m_heaps[index].len) { - /* - * The new block is contiguous with a previously allocated heap area. Add its - * length to that of the previous heap. Merge it with the dummy end-of-heap - * area marker of the previous heap. - */ - m_heaps[index].len += size; - break; - } - } + /* + * Search for another heap area that's contiguous with the bottom of this new area. + * (It should be extremely unusual to find one that's contiguous with the top). + */ + for(index = 0; index < m_nHeaps; ++index) { + if(ptr == m_heaps[index].base + (int)m_heaps[index].len) { + /* + * The new block is contiguous with a previously allocated heap area. Add its + * length to that of the previous heap. Merge it with the dummy end-of-heap + * area marker of the previous heap. + */ + m_heaps[index].len += size; + break; + } + } #ifdef USE_BIGBLOCK_ALLOC } else { - index = m_nHeaps; + index = m_nHeaps; } #endif if(index == m_nHeaps) { - /* The new block is not contiguous, or is BigBlock. Add it to the heap list. */ - if(m_nHeaps == maxHeaps) { - return -1; /* too many non-contiguous heaps */ - } - m_heaps[m_nHeaps].base = ptr; - m_heaps[m_nHeaps].len = size; + /* The new block is not contiguous, or is BigBlock. Add it to the heap list. */ + if(m_nHeaps == maxHeaps) { + return -1; /* too many non-contiguous heaps */ + } + m_heaps[m_nHeaps].base = ptr; + m_heaps[m_nHeaps].len = size; #ifdef USE_BIGBLOCK_ALLOC - m_heaps[m_nHeaps].bBigBlock = bBigBlock; + m_heaps[m_nHeaps].bBigBlock = bBigBlock; #endif - m_nHeaps++; - - /* - * Reserve the first LONG in the block for the ending boundary tag of a dummy - * block at the start of the heap area. - */ - size -= blockOverhead; - ptr += blockOverhead; - PSIZE(ptr) = 1; /* mark the dummy previous block as allocated */ + m_nHeaps++; + + /* + * Reserve the first LONG in the block for the ending boundary tag of a dummy + * block at the start of the heap area. + */ + size -= blockOverhead; + ptr += blockOverhead; + PSIZE(ptr) = 1; /* mark the dummy previous block as allocated */ } /* @@ -1091,36 +1091,36 @@ void* VMem::Expand(void* block, size_t size) */ size_t realsize = CalcAllocSize(size); if((int)realsize < minAllocSize || size == 0) - return NULL; + return NULL; PBLOCK ptr = (PBLOCK)block; /* if the current size is the same as requested, do nothing. */ size_t cursize = SIZE(ptr) & ~1; if(cursize == realsize) { - return block; + return block; } /* if the block is being shrunk, convert the remainder of the block into a new free block. */ if(realsize <= cursize) { - size_t nextsize = cursize - realsize; /* size of new remainder block */ - if(nextsize >= minAllocSize) { - /* - * Split the block - * Set boundary tags for the resized block and the new block. - */ - SetTags(ptr, realsize | 1); - ptr += realsize; - - /* - * add the new block to the free list. - * call Free to merge this block with next block if free - */ - SetTags(ptr, nextsize | 1); - Free(ptr); - } - - return block; + size_t nextsize = cursize - realsize; /* size of new remainder block */ + if(nextsize >= minAllocSize) { + /* + * Split the block + * Set boundary tags for the resized block and the new block. + */ + SetTags(ptr, realsize | 1); + ptr += realsize; + + /* + * add the new block to the free list. + * call Free to merge this block with next block if free + */ + SetTags(ptr, nextsize | 1); + Free(ptr); + } + + return block; } PBLOCK next = ptr + cursize; @@ -1128,39 +1128,39 @@ void* VMem::Expand(void* block, size_t size) /* Check the next block for consistency.*/ if((nextsize&1) == 0 && (nextsize + cursize) >= realsize) { - /* - * The next block is free and big enough. Add the part that's needed - * to our block, and split the remainder off into a new block. - */ - if(m_pRover == next) - m_pRover = NEXT(next); - - /* Unlink the next block from the free list. */ - Unlink(next); - cursize += nextsize; /* combine sizes */ - - size_t rem = cursize - realsize; /* size of remainder */ - if(rem >= minAllocSize) { - /* - * The remainder is big enough to be a new block. - * Set boundary tags for the resized block and the new block. - */ - next = ptr + realsize; - /* - * add the new block to the free list. - * next block cannot be free - */ - SetTags(next, rem); + /* + * The next block is free and big enough. Add the part that's needed + * to our block, and split the remainder off into a new block. + */ + if(m_pRover == next) + m_pRover = NEXT(next); + + /* Unlink the next block from the free list. */ + Unlink(next); + cursize += nextsize; /* combine sizes */ + + size_t rem = cursize - realsize; /* size of remainder */ + if(rem >= minAllocSize) { + /* + * The remainder is big enough to be a new block. + * Set boundary tags for the resized block and the new block. + */ + next = ptr + realsize; + /* + * add the new block to the free list. + * next block cannot be free + */ + SetTags(next, rem); #ifdef _USE_BUDDY_BLOCKS - AddToFreeList(next, rem); + AddToFreeList(next, rem); #else - AddToFreeList(next, m_pFreeList); + AddToFreeList(next, m_pFreeList); #endif - cursize = realsize; + cursize = realsize; } - /* Set the boundary tags to mark it as allocated. */ - SetTags(ptr, cursize | 1); - return ((void *)ptr); + /* Set the boundary tags to mark it as allocated. */ + SetTags(ptr, cursize | 1); + return ((void *)ptr); } return NULL; } @@ -1172,70 +1172,70 @@ void VMem::MemoryUsageMessage(char *str, long x, long y, int c) { char szBuffer[512]; if(str) { - if(!m_pLog) - m_pLog = fopen(LOG_FILENAME, "w"); - sprintf(szBuffer, str, x, y, c); - fputs(szBuffer, m_pLog); + if(!m_pLog) + m_pLog = fopen(LOG_FILENAME, "w"); + sprintf(szBuffer, str, x, y, c); + fputs(szBuffer, m_pLog); } else { - if(m_pLog) { - fflush(m_pLog); - fclose(m_pLog); - m_pLog = 0; - } + if(m_pLog) { + fflush(m_pLog); + fclose(m_pLog); + m_pLog = 0; + } } } void VMem::WalkHeap(int complete) { if(complete) { - MemoryUsageMessage(NULL, 0, 0, 0); - size_t total = 0; - for(int i = 0; i < m_nHeaps; ++i) { - total += m_heaps[i].len; - } - MemoryUsageMessage("VMem heaps used %d. Total memory %08x\n", m_nHeaps, total, 0); - - /* Walk all the heaps - verify structures */ - for(int index = 0; index < m_nHeaps; ++index) { - PBLOCK ptr = m_heaps[index].base; - size_t size = m_heaps[index].len; + MemoryUsageMessage(NULL, 0, 0, 0); + size_t total = 0; + for(int i = 0; i < m_nHeaps; ++i) { + total += m_heaps[i].len; + } + MemoryUsageMessage("VMem heaps used %d. Total memory %08x\n", m_nHeaps, total, 0); + + /* Walk all the heaps - verify structures */ + for(int index = 0; index < m_nHeaps; ++index) { + PBLOCK ptr = m_heaps[index].base; + size_t size = m_heaps[index].len; #ifndef _USE_BUDDY_BLOCKS #ifdef USE_BIGBLOCK_ALLOC - if (!m_heaps[m_nHeaps].bBigBlock) + if (!m_heaps[m_nHeaps].bBigBlock) #endif - ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, ptr)); + ASSERT(HeapValidate(m_hHeap, HEAP_NO_SERIALIZE, ptr)); #endif - /* set over reserved header block */ - size -= blockOverhead; - ptr += blockOverhead; - PBLOCK pLast = ptr + size; - ASSERT(PSIZE(ptr) == 1); /* dummy previous block is allocated */ - ASSERT(SIZE(pLast) == 1); /* dummy next block is allocated */ - while(ptr < pLast) { - ASSERT(ptr > m_heaps[index].base); - size_t cursize = SIZE(ptr) & ~1; - ASSERT((PSIZE(ptr+cursize) & ~1) == cursize); - MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(ptr)&1) ? 'x' : ' '); - if(!(SIZE(ptr)&1)) { - /* this block is on the free list */ - PBLOCK tmp = NEXT(ptr); - while(tmp != ptr) { - ASSERT((SIZE(tmp)&1)==0); - if(tmp == m_pFreeList) - break; - ASSERT(NEXT(tmp)); - tmp = NEXT(tmp); - } - if(tmp == ptr) { - MemoryUsageMessage("Memory Block %08x: Size %08x free but not in free list\n", (long)ptr, cursize, 0); - } - } - ptr += cursize; - } - } - MemoryUsageMessage(NULL, 0, 0, 0); + /* set over reserved header block */ + size -= blockOverhead; + ptr += blockOverhead; + PBLOCK pLast = ptr + size; + ASSERT(PSIZE(ptr) == 1); /* dummy previous block is allocated */ + ASSERT(SIZE(pLast) == 1); /* dummy next block is allocated */ + while(ptr < pLast) { + ASSERT(ptr > m_heaps[index].base); + size_t cursize = SIZE(ptr) & ~1; + ASSERT((PSIZE(ptr+cursize) & ~1) == cursize); + MemoryUsageMessage("Memory Block %08x: Size %08x %c\n", (long)ptr, cursize, (SIZE(ptr)&1) ? 'x' : ' '); + if(!(SIZE(ptr)&1)) { + /* this block is on the free list */ + PBLOCK tmp = NEXT(ptr); + while(tmp != ptr) { + ASSERT((SIZE(tmp)&1)==0); + if(tmp == m_pFreeList) + break; + ASSERT(NEXT(tmp)); + tmp = NEXT(tmp); + } + if(tmp == ptr) { + MemoryUsageMessage("Memory Block %08x: Size %08x free but not in free list\n", (long)ptr, cursize, 0); + } + } + ptr += cursize; + } + } + MemoryUsageMessage(NULL, 0, 0, 0); } } #endif /* _DEBUG_MEM */ diff --git a/win32/win32.c b/win32/win32.c index 9f0259a807f4..cdd5685c4176 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -110,8 +110,8 @@ END_EXTERN_C #ifdef SET_INVALID_PARAMETER_HANDLER static BOOL set_silent_invalid_parameter_handler(BOOL newvalue); static void my_invalid_parameter_handler(const wchar_t* expression, - const wchar_t* function, const wchar_t* file, - unsigned int line, uintptr_t pReserved); + const wchar_t* function, const wchar_t* file, + unsigned int line, uintptr_t pReserved); #endif #ifndef WIN32_NO_REGISTRY @@ -120,10 +120,10 @@ static char* get_regstr(const char *valuename, SV **svp); #endif static char* get_emd_part(SV **prev_pathp, STRLEN *const len, - char *trailing, ...); + char *trailing, ...); static char* win32_get_xlib(const char *pl, - WIN32_NO_REGISTRY_M_(const char *xlib) - const char *libname, STRLEN *const len); + WIN32_NO_REGISTRY_M_(const char *xlib) + const char *libname, STRLEN *const len); static BOOL has_shell_metachars(const char *ptr); static long tokenize(const char *str, char **dest, char ***destv); @@ -135,7 +135,7 @@ static int do_spawn2_handles(pTHX_ const char *cmd, int exectype, static int do_spawnvp_handles(int mode, const char *cmdname, const char * const *argv, const int *handles); static PerlIO * do_popen(const char *mode, const char *command, IV narg, - SV **args); + SV **args); static long find_pid(pTHX_ int pid); static void remove_dead_process(long child); static int terminate_process(DWORD pid, HANDLE process_handle, int sig); @@ -146,11 +146,11 @@ static char* wstr_to_str(const wchar_t* wstr); static long filetime_to_clock(PFILETIME ft); static BOOL filetime_from_time(PFILETIME ft, time_t t); static char* create_command_line(char *cname, STRLEN clen, - const char * const *args); + const char * const *args); static char* qualified_path(const char *cmd, bool other_exts); static void ansify_path(void); static LRESULT win32_process_message(HWND hwnd, UINT msg, - WPARAM wParam, LPARAM lParam); + WPARAM wParam, LPARAM lParam); #ifdef USE_ITHREADS static long find_pseudo_pid(pTHX_ int pid); @@ -221,7 +221,7 @@ my_invalid_parameter_handler(const wchar_t* expression, char* ansi_function; char* ansi_file; if (silent_invalid_parameter_handler) - return; + return; ansi_expression = wstr_to_str(expression); ansi_function = wstr_to_str(function); ansi_file = wstr_to_str(file); @@ -277,9 +277,9 @@ set_w32_module_name(void) /* normalize to forward slashes */ ptr = w32_module_name; while (*ptr) { - if (*ptr == '\\') - *ptr = '/'; - ++ptr; + if (*ptr == '\\') + *ptr = '/'; + ++ptr; } } @@ -296,18 +296,18 @@ get_regstr_from(HKEY handle, const char *valuename, SV **svp) retval = RegQueryValueEx(handle, valuename, 0, &type, NULL, &datalen); if (retval == ERROR_SUCCESS - && (type == REG_SZ || type == REG_EXPAND_SZ)) + && (type == REG_SZ || type == REG_EXPAND_SZ)) { - dTHX; - if (!*svp) - *svp = sv_2mortal(newSVpvs("")); - SvGROW(*svp, datalen); - retval = RegQueryValueEx(handle, valuename, 0, NULL, - (PBYTE)SvPVX(*svp), &datalen); - if (retval == ERROR_SUCCESS) { - str = SvPVX(*svp); - SvCUR_set(*svp,datalen-1); - } + dTHX; + if (!*svp) + *svp = sv_2mortal(newSVpvs("")); + SvGROW(*svp, datalen); + retval = RegQueryValueEx(handle, valuename, 0, NULL, + (PBYTE)SvPVX(*svp), &datalen); + if (retval == ERROR_SUCCESS) { + str = SvPVX(*svp); + SvCUR_set(*svp,datalen-1); + } } return str; } @@ -318,16 +318,16 @@ get_regstr(const char *valuename, SV **svp) { char *str; if (HKCU_Perl_hnd) { - str = get_regstr_from(HKCU_Perl_hnd, valuename, svp); - if (!str) - goto try_HKLM; + str = get_regstr_from(HKCU_Perl_hnd, valuename, svp); + if (!str) + goto try_HKLM; } else { - try_HKLM: - if (HKLM_Perl_hnd) - str = get_regstr_from(HKLM_Perl_hnd, valuename, svp); - else - str = NULL; + try_HKLM: + if (HKLM_Perl_hnd) + str = get_regstr_from(HKLM_Perl_hnd, valuename, svp); + else + str = NULL; } return str; } @@ -352,49 +352,49 @@ get_emd_part(SV **prev_pathp, STRLEN *const len, char *trailing_path, ...) baselen = strlen(base); if (!*w32_module_name) { - set_w32_module_name(); + set_w32_module_name(); } strcpy(mod_name, w32_module_name); ptr = strrchr(mod_name, '/'); while (ptr && strip) { /* look for directories to skip back */ - optr = ptr; - *ptr = '\0'; - ptr = strrchr(mod_name, '/'); - /* avoid stripping component if there is no slash, - * or it doesn't match ... */ - if (!ptr || stricmp(ptr+1, strip) != 0) { - /* ... but not if component matches m|5\.$patchlevel.*| */ - if (!ptr || !(*strip == '5' && *(ptr+1) == '5' - && strnEQ(strip, base, baselen) - && strnEQ(ptr+1, base, baselen))) - { - *optr = '/'; - ptr = optr; - } - } - strip = va_arg(ap, char *); + optr = ptr; + *ptr = '\0'; + ptr = strrchr(mod_name, '/'); + /* avoid stripping component if there is no slash, + * or it doesn't match ... */ + if (!ptr || stricmp(ptr+1, strip) != 0) { + /* ... but not if component matches m|5\.$patchlevel.*| */ + if (!ptr || !(*strip == '5' && *(ptr+1) == '5' + && strnEQ(strip, base, baselen) + && strnEQ(ptr+1, base, baselen))) + { + *optr = '/'; + ptr = optr; + } + } + strip = va_arg(ap, char *); } if (!ptr) { - ptr = mod_name; - *ptr++ = '.'; - *ptr = '/'; + ptr = mod_name; + *ptr++ = '.'; + *ptr = '/'; } va_end(ap); strcpy(++ptr, trailing_path); /* only add directory if it exists */ if (GetFileAttributes(mod_name) != (DWORD) -1) { - /* directory exists */ - dTHX; - if (!*prev_pathp) - *prev_pathp = sv_2mortal(newSVpvs("")); - else if (SvPVX(*prev_pathp)) - sv_catpvs(*prev_pathp, ";"); - sv_catpv(*prev_pathp, mod_name); - if(len) - *len = SvCUR(*prev_pathp); - return SvPVX(*prev_pathp); + /* directory exists */ + dTHX; + if (!*prev_pathp) + *prev_pathp = sv_2mortal(newSVpvs("")); + else if (SvPVX(*prev_pathp)) + sv_catpvs(*prev_pathp, ";"); + sv_catpv(*prev_pathp, mod_name); + if(len) + *len = SvCUR(*prev_pathp); + return SvPVX(*prev_pathp); } return NULL; @@ -411,7 +411,7 @@ win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len) /* $stdlib = $HKCU{"lib-$]"} || $HKLM{"lib-$]"} || $HKCU{"lib"} || $HKLM{"lib"} || ""; */ sprintf(buffer, "%s-%s", stdlib, pl); if (!get_regstr(buffer, &sv)) - (void)get_regstr(stdlib, &sv); + (void)get_regstr(stdlib, &sv); #endif /* $stdlib .= ";$EMD/../../lib" */ @@ -420,7 +420,7 @@ win32_get_privlib(WIN32_NO_REGISTRY_M_(const char *pl) STRLEN *const len) static char * win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib) - const char *libname, STRLEN *const len) + const char *libname, STRLEN *const len) { #ifndef WIN32_NO_REGISTRY char regstr[40]; @@ -451,17 +451,17 @@ win32_get_xlib(const char *pl, WIN32_NO_REGISTRY_M_(const char *xlib) (void)get_emd_part(&sv2, NULL, pathstr, ARCHNAME, "bin", pl, NULL); if (!sv1 && !sv2) - return NULL; + return NULL; if (!sv1) { - sv1 = sv2; + sv1 = sv2; } else if (sv2) { dTHX; - sv_catpvs(sv1, ";"); - sv_catsv(sv1, sv2); + sv_catpvs(sv1, ";"); + sv_catsv(sv1, sv2); } if (len) - *len = SvCUR(sv1); + *len = SvCUR(sv1); return SvPVX(sv1); } @@ -493,31 +493,31 @@ has_shell_metachars(const char *ptr) * Shell variable interpolation (%VAR%) can also happen inside strings. */ while (*ptr) { - switch(*ptr) { - case '%': - return TRUE; - case '\'': - case '\"': - if (inquote) { - if (quote == *ptr) { - inquote = 0; - quote = '\0'; - } - } - else { - quote = *ptr; - inquote++; - } - break; - case '>': - case '<': - case '|': - if (!inquote) - return TRUE; - default: - break; - } - ++ptr; + switch(*ptr) { + case '%': + return TRUE; + case '\'': + case '\"': + if (inquote) { + if (quote == *ptr) { + inquote = 0; + quote = '\0'; + } + } + else { + quote = *ptr; + inquote++; + } + break; + case '>': + case '<': + case '|': + if (!inquote) + return TRUE; + default: + break; + } + ++ptr; } return FALSE; } @@ -552,7 +552,7 @@ win32_getpid(void) #ifdef USE_ITHREADS dTHX; if (w32_pseudo_id) - return -((int)w32_pseudo_id); + return -((int)w32_pseudo_id); #endif return _getpid(); } @@ -570,39 +570,39 @@ tokenize(const char *str, char **dest, char ***destv) char **retvstart = 0; int items = -1; if (str) { - int slen = strlen(str); - char *ret; - char **retv; - Newx(ret, slen+2, char); - Newx(retv, (slen+3)/2, char*); - - retstart = ret; - retvstart = retv; - *retv = ret; - items = 0; - while (*str) { - *ret = *str++; - if (*ret == '\\' && *str) - *ret = *str++; - else if (*ret == ' ') { - while (*str == ' ') - str++; - if (ret == retstart) - ret--; - else { - *ret = '\0'; - ++items; - if (*str) - *++retv = ret+1; - } - } - else if (!*str) - ++items; - ret++; - } - retvstart[items] = NULL; - *ret++ = '\0'; - *ret = '\0'; + int slen = strlen(str); + char *ret; + char **retv; + Newx(ret, slen+2, char); + Newx(retv, (slen+3)/2, char*); + + retstart = ret; + retvstart = retv; + *retv = ret; + items = 0; + while (*str) { + *ret = *str++; + if (*ret == '\\' && *str) + *ret = *str++; + else if (*ret == ' ') { + while (*str == ' ') + str++; + if (ret == retstart) + ret--; + else { + *ret = '\0'; + ++items; + if (*str) + *++retv = ret+1; + } + } + else if (!*str) + ++items; + ret++; + } + retvstart[items] = NULL; + *ret++ = '\0'; + *ret = '\0'; } *dest = retstart; *destv = retvstart; @@ -614,18 +614,18 @@ get_shell(void) { dTHX; if (!w32_perlshell_tokens) { - /* we don't use COMSPEC here for two reasons: - * 1. the same reason perl on UNIX doesn't use SHELL--rampant and - * uncontrolled unportability of the ensuing scripts. - * 2. PERL5SHELL could be set to a shell that may not be fit for - * interactive use (which is what most programs look in COMSPEC - * for). - */ - const char* defaultshell = "cmd.exe /x/d/c"; - const char *usershell = PerlEnv_getenv("PERL5SHELL"); - w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, - &w32_perlshell_tokens, - &w32_perlshell_vec); + /* we don't use COMSPEC here for two reasons: + * 1. the same reason perl on UNIX doesn't use SHELL--rampant and + * uncontrolled unportability of the ensuing scripts. + * 2. PERL5SHELL could be set to a shell that may not be fit for + * interactive use (which is what most programs look in COMSPEC + * for). + */ + const char* defaultshell = "cmd.exe /x/d/c"; + const char *usershell = PerlEnv_getenv("PERL5SHELL"); + w32_perlshell_items = tokenize(usershell ? usershell : defaultshell, + &w32_perlshell_tokens, + &w32_perlshell_vec); } } @@ -642,54 +642,54 @@ Perl_do_aspawn(pTHX_ SV *really, SV **mark, SV **sp) PERL_ARGS_ASSERT_DO_ASPAWN; if (sp <= mark) - return -1; + return -1; get_shell(); Newx(argv, (sp - mark) + w32_perlshell_items + 2, char*); if (SvNIOKp(*(mark+1)) && !SvPOKp(*(mark+1))) { - ++mark; - flag = SvIVx(*mark); + ++mark; + flag = SvIVx(*mark); } while (++mark <= sp) { - if (*mark && (str = SvPV_nolen(*mark))) - argv[index++] = str; - else - argv[index++] = ""; + if (*mark && (str = SvPV_nolen(*mark))) + argv[index++] = str; + else + argv[index++] = ""; } argv[index++] = 0; status = win32_spawnvp(flag, - (const char*)(really ? SvPV_nolen(really) : argv[0]), - (const char* const*)argv); + (const char*)(really ? SvPV_nolen(really) : argv[0]), + (const char* const*)argv); if (status < 0 && (eno = errno, (eno == ENOEXEC || eno == ENOENT))) { - /* possible shell-builtin, invoke with shell */ - int sh_items; - sh_items = w32_perlshell_items; - while (--index >= 0) - argv[index+sh_items] = argv[index]; - while (--sh_items >= 0) - argv[sh_items] = w32_perlshell_vec[sh_items]; + /* possible shell-builtin, invoke with shell */ + int sh_items; + sh_items = w32_perlshell_items; + while (--index >= 0) + argv[index+sh_items] = argv[index]; + while (--sh_items >= 0) + argv[sh_items] = w32_perlshell_vec[sh_items]; - status = win32_spawnvp(flag, - (const char*)(really ? SvPV_nolen(really) : argv[0]), - (const char* const*)argv); + status = win32_spawnvp(flag, + (const char*)(really ? SvPV_nolen(really) : argv[0]), + (const char* const*)argv); } if (flag == P_NOWAIT) { - PL_statusvalue = -1; /* >16bits hint for pp_system() */ + PL_statusvalue = -1; /* >16bits hint for pp_system() */ } else { - if (status < 0) { - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); - status = 255 * 256; - } - else - status *= 256; - PL_statusvalue = status; + if (status < 0) { + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't spawn \"%s\": %s", argv[0], strerror(errno)); + status = 255 * 256; + } + else + status *= 256; + PL_statusvalue = status; } Safefree(argv); return (status); @@ -701,20 +701,20 @@ find_next_space(const char *s) { bool in_quotes = FALSE; while (*s) { - /* ignore doubled backslashes, or backslash+quote */ - if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) { - s += 2; - } - /* keep track of when we're within quotes */ - else if (*s == '"') { - s++; - in_quotes = !in_quotes; - } - /* break it up only at spaces that aren't in quotes */ - else if (!in_quotes && isSPACE(*s)) - return (char*)s; - else - s++; + /* ignore doubled backslashes, or backslash+quote */ + if (*s == '\\' && (s[1] == '\\' || s[1] == '"')) { + s += 2; + } + /* keep track of when we're within quotes */ + else if (*s == '"') { + s++; + in_quotes = !in_quotes; + } + /* break it up only at spaces that aren't in quotes */ + else if (!in_quotes && isSPACE(*s)) + return (char*)s; + else + s++; } return (char*)s; } @@ -737,79 +737,79 @@ do_spawn2_handles(pTHX_ const char *cmd, int exectype, const int *handles) /* Save an extra exec if possible. See if there are shell * metacharacters in it */ if (!has_shell_metachars(cmd)) { - Newx(argv, strlen(cmd) / 2 + 2, char*); - Newx(cmd2, strlen(cmd) + 1, char); - strcpy(cmd2, cmd); - a = argv; - for (s = cmd2; *s;) { - while (*s && isSPACE(*s)) - s++; - if (*s) - *(a++) = s; - s = find_next_space(s); - if (*s) - *s++ = '\0'; - } - *a = NULL; - if (argv[0]) { - switch (exectype) { - case EXECF_SPAWN: - status = win32_spawnvp(P_WAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_SPAWN_NOWAIT: - status = do_spawnvp_handles(P_NOWAIT, argv[0], - (const char* const*)argv, handles); - break; - case EXECF_EXEC: - status = win32_execvp(argv[0], (const char* const*)argv); - break; - } - if (status != -1 || errno == 0) - needToTry = FALSE; - } - Safefree(argv); - Safefree(cmd2); + Newx(argv, strlen(cmd) / 2 + 2, char*); + Newx(cmd2, strlen(cmd) + 1, char); + strcpy(cmd2, cmd); + a = argv; + for (s = cmd2; *s;) { + while (*s && isSPACE(*s)) + s++; + if (*s) + *(a++) = s; + s = find_next_space(s); + if (*s) + *s++ = '\0'; + } + *a = NULL; + if (argv[0]) { + switch (exectype) { + case EXECF_SPAWN: + status = win32_spawnvp(P_WAIT, argv[0], + (const char* const*)argv); + break; + case EXECF_SPAWN_NOWAIT: + status = do_spawnvp_handles(P_NOWAIT, argv[0], + (const char* const*)argv, handles); + break; + case EXECF_EXEC: + status = win32_execvp(argv[0], (const char* const*)argv); + break; + } + if (status != -1 || errno == 0) + needToTry = FALSE; + } + Safefree(argv); + Safefree(cmd2); } if (needToTry) { - char **argv; - int i = -1; - get_shell(); - Newx(argv, w32_perlshell_items + 2, char*); - while (++i < w32_perlshell_items) - argv[i] = w32_perlshell_vec[i]; - argv[i++] = (char *)cmd; - argv[i] = NULL; - switch (exectype) { - case EXECF_SPAWN: - status = win32_spawnvp(P_WAIT, argv[0], - (const char* const*)argv); - break; - case EXECF_SPAWN_NOWAIT: - status = do_spawnvp_handles(P_NOWAIT, argv[0], - (const char* const*)argv, handles); - break; - case EXECF_EXEC: - status = win32_execvp(argv[0], (const char* const*)argv); - break; - } - cmd = argv[0]; - Safefree(argv); + char **argv; + int i = -1; + get_shell(); + Newx(argv, w32_perlshell_items + 2, char*); + while (++i < w32_perlshell_items) + argv[i] = w32_perlshell_vec[i]; + argv[i++] = (char *)cmd; + argv[i] = NULL; + switch (exectype) { + case EXECF_SPAWN: + status = win32_spawnvp(P_WAIT, argv[0], + (const char* const*)argv); + break; + case EXECF_SPAWN_NOWAIT: + status = do_spawnvp_handles(P_NOWAIT, argv[0], + (const char* const*)argv, handles); + break; + case EXECF_EXEC: + status = win32_execvp(argv[0], (const char* const*)argv); + break; + } + cmd = argv[0]; + Safefree(argv); } if (exectype == EXECF_SPAWN_NOWAIT) { - PL_statusvalue = -1; /* >16bits hint for pp_system() */ + PL_statusvalue = -1; /* >16bits hint for pp_system() */ } else { - if (status < 0) { - if (ckWARN(WARN_EXEC)) - Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", - (exectype == EXECF_EXEC ? "exec" : "spawn"), - cmd, strerror(errno)); - status = 255 * 256; - } - else - status *= 256; - PL_statusvalue = status; + if (status < 0) { + if (ckWARN(WARN_EXEC)) + Perl_warner(aTHX_ packWARN(WARN_EXEC), "Can't %s \"%s\": %s", + (exectype == EXECF_EXEC ? "exec" : "spawn"), + cmd, strerror(errno)); + status = 255 * 256; + } + else + status *= 256; + PL_statusvalue = status; } return (status); } @@ -858,12 +858,12 @@ win32_opendir(const char *filename) len = strlen(filename); if (len == 0) { - errno = ENOENT; - return NULL; + errno = ENOENT; + return NULL; } if (len > MAX_PATH) { - errno = ENAMETOOLONG; - return NULL; + errno = ENAMETOOLONG; + return NULL; } /* Get us a DIR structure */ @@ -874,11 +874,11 @@ win32_opendir(const char *filename) /* bare drive name means look in cwd for drive */ if (len == 2 && isALPHA(scanname[0]) && scanname[1] == ':') { - scanname[len++] = '.'; - scanname[len++] = '/'; + scanname[len++] = '.'; + scanname[len++] = '/'; } else if (scanname[len-1] != '/' && scanname[len-1] != '\\') { - scanname[len++] = '/'; + scanname[len++] = '/'; } scanname[len++] = '*'; scanname[len] = '\0'; @@ -889,24 +889,24 @@ win32_opendir(const char *filename) dirp->handle = FindFirstFileW(PerlDir_mapW(wscanname), &wFindData); if (dirp->handle == INVALID_HANDLE_VALUE) { - DWORD err = GetLastError(); - /* FindFirstFile() fails on empty drives! */ - switch (err) { - case ERROR_FILE_NOT_FOUND: - return dirp; - case ERROR_NO_MORE_FILES: - case ERROR_PATH_NOT_FOUND: - errno = ENOENT; - break; - case ERROR_NOT_ENOUGH_MEMORY: - errno = ENOMEM; - break; - default: - errno = EINVAL; - break; - } - Safefree(dirp); - return NULL; + DWORD err = GetLastError(); + /* FindFirstFile() fails on empty drives! */ + switch (err) { + case ERROR_FILE_NOT_FOUND: + return dirp; + case ERROR_NO_MORE_FILES: + case ERROR_PATH_NOT_FOUND: + errno = ENOENT; + break; + case ERROR_NOT_ENOUGH_MEMORY: + errno = ENOMEM; + break; + default: + errno = EINVAL; + break; + } + Safefree(dirp); + return NULL; } use_default = FALSE; @@ -924,9 +924,9 @@ win32_opendir(const char *filename) */ idx = strlen(buffer)+1; if (idx < 256) - dirp->size = 256; + dirp->size = 256; else - dirp->size = idx; + dirp->size = idx; Newx(dirp->start, dirp->size, char); strcpy(dirp->start, buffer); dirp->nfiles++; @@ -945,30 +945,30 @@ win32_readdir(DIR *dirp) long len; if (dirp->curr) { - /* first set up the structure to return */ - len = strlen(dirp->curr); - strcpy(dirp->dirstr.d_name, dirp->curr); - dirp->dirstr.d_namlen = len; + /* first set up the structure to return */ + len = strlen(dirp->curr); + strcpy(dirp->dirstr.d_name, dirp->curr); + dirp->dirstr.d_namlen = len; - /* Fake an inode */ - dirp->dirstr.d_ino = dirp->curr - dirp->start; + /* Fake an inode */ + dirp->dirstr.d_ino = dirp->curr - dirp->start; - /* Now set up for the next call to readdir */ - dirp->curr += len + 1; - if (dirp->curr >= dirp->end) { - BOOL res; - char buffer[MAX_PATH*2]; + /* Now set up for the next call to readdir */ + dirp->curr += len + 1; + if (dirp->curr >= dirp->end) { + BOOL res; + char buffer[MAX_PATH*2]; if (dirp->handle == INVALID_HANDLE_VALUE) { res = 0; } - /* finding the next file that matches the wildcard - * (which should be all of them in this directory!). - */ - else { + /* finding the next file that matches the wildcard + * (which should be all of them in this directory!). + */ + else { WIN32_FIND_DATAW wFindData; - res = FindNextFileW(dirp->handle, &wFindData); - if (res) { + res = FindNextFileW(dirp->handle, &wFindData); + if (res) { BOOL use_default = FALSE; WideCharToMultiByte(CP_ACP, WC_NO_BEST_FIT_CHARS, wFindData.cFileName, -1, @@ -980,33 +980,33 @@ win32_readdir(DIR *dirp) } } } - if (res) { - long endpos = dirp->end - dirp->start; - long newsize = endpos + strlen(buffer) + 1; - /* bump the string table size by enough for the - * new name and its null terminator */ - while (newsize > dirp->size) { - long curpos = dirp->curr - dirp->start; - Renew(dirp->start, dirp->size * 2, char); - dirp->size *= 2; - dirp->curr = dirp->start + curpos; - } - strcpy(dirp->start + endpos, buffer); - dirp->end = dirp->start + newsize; - dirp->nfiles++; - } - else { - dirp->curr = NULL; + if (res) { + long endpos = dirp->end - dirp->start; + long newsize = endpos + strlen(buffer) + 1; + /* bump the string table size by enough for the + * new name and its null terminator */ + while (newsize > dirp->size) { + long curpos = dirp->curr - dirp->start; + Renew(dirp->start, dirp->size * 2, char); + dirp->size *= 2; + dirp->curr = dirp->start + curpos; + } + strcpy(dirp->start + endpos, buffer); + dirp->end = dirp->start + newsize; + dirp->nfiles++; + } + else { + dirp->curr = NULL; if (dirp->handle != INVALID_HANDLE_VALUE) { FindClose(dirp->handle); dirp->handle = INVALID_HANDLE_VALUE; } } - } - return &(dirp->dirstr); + } + return &(dirp->dirstr); } else - return NULL; + return NULL; } /* Telldir returns the current string pointer position */ @@ -1038,7 +1038,7 @@ DllExport int win32_closedir(DIR *dirp) { if (dirp->handle != INVALID_HANDLE_VALUE) - FindClose(dirp->handle); + FindClose(dirp->handle); Safefree(dirp->start); Safefree(dirp); return 1; @@ -1145,7 +1145,7 @@ getlogin(void) char *buf = w32_getlogin_buffer; DWORD size = sizeof(w32_getlogin_buffer); if (GetUserName(buf,&size)) - return buf; + return buf; return (char*)NULL; } @@ -1169,16 +1169,16 @@ int mkstemp(const char *path) retry: if (i++ > 10) { /* give up */ - errno = ENOENT; - return -1; + errno = ENOENT; + return -1; } if (!GetTempFileNameA((LPCSTR)path, "plr", 1, buf)) { - errno = ENOENT; - return -1; + errno = ENOENT; + return -1; } fd = PerlLIO_open3(buf, O_CREAT|O_RDWR|O_EXCL, 0600); if (fd == -1) - goto retry; + goto retry; return fd; } #endif @@ -1188,8 +1188,8 @@ find_pid(pTHX_ int pid) { long child = w32_num_children; while (--child >= 0) { - if ((int)w32_child_pids[child] == pid) - return child; + if ((int)w32_child_pids[child] == pid) + return child; } return -1; } @@ -1198,13 +1198,13 @@ static void remove_dead_process(long child) { if (child >= 0) { - dTHX; - CloseHandle(w32_child_handles[child]); - Move(&w32_child_handles[child+1], &w32_child_handles[child], - (w32_num_children-child-1), HANDLE); - Move(&w32_child_pids[child+1], &w32_child_pids[child], - (w32_num_children-child-1), DWORD); - w32_num_children--; + dTHX; + CloseHandle(w32_child_handles[child]); + Move(&w32_child_handles[child+1], &w32_child_handles[child], + (w32_num_children-child-1), HANDLE); + Move(&w32_child_pids[child+1], &w32_child_pids[child], + (w32_num_children-child-1), DWORD); + w32_num_children--; } } @@ -1214,8 +1214,8 @@ find_pseudo_pid(pTHX_ int pid) { long child = w32_num_pseudo_children; while (--child >= 0) { - if ((int)w32_pseudo_child_pids[child] == pid) - return child; + if ((int)w32_pseudo_child_pids[child] == pid) + return child; } return -1; } @@ -1224,17 +1224,17 @@ static void remove_dead_pseudo_process(long child) { if (child >= 0) { - dTHX; - CloseHandle(w32_pseudo_child_handles[child]); - Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child], - (w32_num_pseudo_children-child-1), HANDLE); - Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child], - (w32_num_pseudo_children-child-1), DWORD); - Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child], - (w32_num_pseudo_children-child-1), HWND); - Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child], - (w32_num_pseudo_children-child-1), char); - w32_num_pseudo_children--; + dTHX; + CloseHandle(w32_pseudo_child_handles[child]); + Move(&w32_pseudo_child_handles[child+1], &w32_pseudo_child_handles[child], + (w32_num_pseudo_children-child-1), HANDLE); + Move(&w32_pseudo_child_pids[child+1], &w32_pseudo_child_pids[child], + (w32_num_pseudo_children-child-1), DWORD); + Move(&w32_pseudo_child_message_hwnds[child+1], &w32_pseudo_child_message_hwnds[child], + (w32_num_pseudo_children-child-1), HWND); + Move(&w32_pseudo_child_sigterm[child+1], &w32_pseudo_child_sigterm[child], + (w32_num_pseudo_children-child-1), char); + w32_num_pseudo_children--; } } @@ -1373,14 +1373,14 @@ get_hwnd_delay(pTHX, long child, DWORD tries) if (hwnd != INVALID_HANDLE_VALUE) return hwnd; { - unsigned int count = 0; - /* No Sleep(1) if tries==0, just fail instead if we get this far. */ - while (count++ < tries) { - Sleep(1); - win32_async_check(aTHX); - hwnd = w32_pseudo_child_message_hwnds[child]; - if (hwnd != INVALID_HANDLE_VALUE) return hwnd; - } + unsigned int count = 0; + /* No Sleep(1) if tries==0, just fail instead if we get this far. */ + while (count++ < tries) { + Sleep(1); + win32_async_check(aTHX); + hwnd = w32_pseudo_child_message_hwnds[child]; + if (hwnd != INVALID_HANDLE_VALUE) return hwnd; + } } Perl_croak(aTHX_ "panic: child pseudo-process was never scheduled"); @@ -1394,64 +1394,64 @@ win32_kill(int pid, int sig) long child; #ifdef USE_ITHREADS if (pid < 0) { - /* it is a pseudo-forked child */ - child = find_pseudo_pid(aTHX_ -pid); - if (child >= 0) { - HANDLE hProcess = w32_pseudo_child_handles[child]; - switch (sig) { - case 0: - /* "Does process exist?" use of kill */ - return 0; - - case 9: { - /* kill -9 style un-graceful exit */ - /* Do a wait to make sure child starts and isn't in DLL - * Loader Lock */ - HWND hwnd = get_hwnd_delay(aTHX, child, 5); - if (TerminateThread(hProcess, sig)) { - /* Allow the scheduler to finish cleaning up the other - * thread. - * Otherwise, if we ExitProcess() before another context - * switch happens we will end up with a process exit - * code of "sig" instead of our own exit status. - * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 - */ - Sleep(0); - remove_dead_pseudo_process(child); - return 0; - } - break; - } - - default: { - HWND hwnd = get_hwnd_delay(aTHX, child, 5); - /* We fake signals to pseudo-processes using Win32 - * message queue. */ - if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) || - PostThreadMessage(-pid, WM_USER_KILL, sig, 0)) - { - /* Don't wait for child process to terminate after we send a - * SIGTERM because the child may be blocked in a system call - * and never receive the signal. - */ - if (sig == SIGTERM) { - Sleep(0); - w32_pseudo_child_sigterm[child] = 1; - } - /* It might be us ... */ - PERL_ASYNC_CHECK(); - return 0; - } - break; - } - } /* switch */ - } + /* it is a pseudo-forked child */ + child = find_pseudo_pid(aTHX_ -pid); + if (child >= 0) { + HANDLE hProcess = w32_pseudo_child_handles[child]; + switch (sig) { + case 0: + /* "Does process exist?" use of kill */ + return 0; + + case 9: { + /* kill -9 style un-graceful exit */ + /* Do a wait to make sure child starts and isn't in DLL + * Loader Lock */ + HWND hwnd = get_hwnd_delay(aTHX, child, 5); + if (TerminateThread(hProcess, sig)) { + /* Allow the scheduler to finish cleaning up the other + * thread. + * Otherwise, if we ExitProcess() before another context + * switch happens we will end up with a process exit + * code of "sig" instead of our own exit status. + * https://rt.cpan.org/Ticket/Display.html?id=66016#txn-908976 + */ + Sleep(0); + remove_dead_pseudo_process(child); + return 0; + } + break; + } + + default: { + HWND hwnd = get_hwnd_delay(aTHX, child, 5); + /* We fake signals to pseudo-processes using Win32 + * message queue. */ + if ((hwnd != NULL && PostMessage(hwnd, WM_USER_KILL, sig, 0)) || + PostThreadMessage(-pid, WM_USER_KILL, sig, 0)) + { + /* Don't wait for child process to terminate after we send a + * SIGTERM because the child may be blocked in a system call + * and never receive the signal. + */ + if (sig == SIGTERM) { + Sleep(0); + w32_pseudo_child_sigterm[child] = 1; + } + /* It might be us ... */ + PERL_ASYNC_CHECK(); + return 0; + } + break; + } + } /* switch */ + } } else #endif { - child = find_pid(aTHX_ pid); - if (child >= 0) { + child = find_pid(aTHX_ pid); + if (child >= 0) { if (my_kill(pid, sig)) { DWORD exitcode = 0; if (GetExitCodeProcess(w32_child_handles[child], &exitcode) && @@ -1461,11 +1461,11 @@ win32_kill(int pid, int sig) } return 0; } - } - else { + } + else { if (my_kill(pid, sig)) return 0; - } + } } errno = EINVAL; return -1; @@ -1871,13 +1871,13 @@ win32_lstat(const char *path, Stat_t *sbuf) #define isSLASH(c) ((c) == '/' || (c) == '\\') #define SKIP_SLASHES(s) \ STMT_START { \ - while (*(s) && isSLASH(*(s))) \ - ++(s); \ + while (*(s) && isSLASH(*(s))) \ + ++(s); \ } STMT_END #define COPY_NONSLASHES(d,s) \ STMT_START { \ - while (*(s) && !isSLASH(*(s))) \ - *(d)++ = *(s)++; \ + while (*(s) && !isSLASH(*(s))) \ + *(d)++ = *(s)++; \ } STMT_END /* Find the longname of a given path. path is destructively modified. @@ -1892,78 +1892,78 @@ win32_longpath(char *path) char *start = path; char sep; if (!path) - return NULL; + return NULL; /* drive prefix */ if (isALPHA(path[0]) && path[1] == ':') { - start = path + 2; - *tmpstart++ = path[0]; - *tmpstart++ = ':'; + start = path + 2; + *tmpstart++ = path[0]; + *tmpstart++ = ':'; } /* UNC prefix */ else if (isSLASH(path[0]) && isSLASH(path[1])) { - start = path + 2; - *tmpstart++ = path[0]; - *tmpstart++ = path[1]; - SKIP_SLASHES(start); - COPY_NONSLASHES(tmpstart,start); /* copy machine name */ - if (*start) { - *tmpstart++ = *start++; - SKIP_SLASHES(start); - COPY_NONSLASHES(tmpstart,start); /* copy share name */ - } + start = path + 2; + *tmpstart++ = path[0]; + *tmpstart++ = path[1]; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy machine name */ + if (*start) { + *tmpstart++ = *start++; + SKIP_SLASHES(start); + COPY_NONSLASHES(tmpstart,start); /* copy share name */ + } } *tmpstart = '\0'; while (*start) { - /* copy initial slash, if any */ - if (isSLASH(*start)) { - *tmpstart++ = *start++; - *tmpstart = '\0'; - SKIP_SLASHES(start); - } - - /* FindFirstFile() expands "." and "..", so we need to pass - * those through unmolested */ - if (*start == '.' - && (!start[1] || isSLASH(start[1]) - || (start[1] == '.' && (!start[2] || isSLASH(start[2]))))) - { - COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */ - *tmpstart = '\0'; - continue; - } - - /* if this is the end, bust outta here */ - if (!*start) - break; - - /* now we're at a non-slash; walk up to next slash */ - while (*start && !isSLASH(*start)) - ++start; - - /* stop and find full name of component */ - sep = *start; - *start = '\0'; - fhand = FindFirstFile(path,&fdata); - *start = sep; - if (fhand != INVALID_HANDLE_VALUE) { - STRLEN len = strlen(fdata.cFileName); - if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) { - strcpy(tmpstart, fdata.cFileName); - tmpstart += len; - FindClose(fhand); - } - else { - FindClose(fhand); - errno = ERANGE; - return NULL; - } - } - else { - /* failed a step, just return without side effects */ - errno = EINVAL; - return NULL; - } + /* copy initial slash, if any */ + if (isSLASH(*start)) { + *tmpstart++ = *start++; + *tmpstart = '\0'; + SKIP_SLASHES(start); + } + + /* FindFirstFile() expands "." and "..", so we need to pass + * those through unmolested */ + if (*start == '.' + && (!start[1] || isSLASH(start[1]) + || (start[1] == '.' && (!start[2] || isSLASH(start[2]))))) + { + COPY_NONSLASHES(tmpstart,start); /* copy "." or ".." */ + *tmpstart = '\0'; + continue; + } + + /* if this is the end, bust outta here */ + if (!*start) + break; + + /* now we're at a non-slash; walk up to next slash */ + while (*start && !isSLASH(*start)) + ++start; + + /* stop and find full name of component */ + sep = *start; + *start = '\0'; + fhand = FindFirstFile(path,&fdata); + *start = sep; + if (fhand != INVALID_HANDLE_VALUE) { + STRLEN len = strlen(fdata.cFileName); + if ((STRLEN)(tmpbuf + sizeof(tmpbuf) - tmpstart) > len) { + strcpy(tmpstart, fdata.cFileName); + tmpstart += len; + FindClose(fhand); + } + else { + FindClose(fhand); + errno = ERANGE; + return NULL; + } + } + else { + /* failed a step, just return without side effects */ + errno = EINVAL; + return NULL; + } } strcpy(path,tmpbuf); return path; @@ -1974,7 +1974,7 @@ out_of_memory(void) { if (PL_curinterp) - croak_no_mem(); + croak_no_mem(); exit(1); } @@ -2101,7 +2101,7 @@ win32_getenv(const char *name) needlen = GetEnvironmentVariableA(name,NULL,0); if (needlen != 0) { - curitem = sv_2mortal(newSVpvs("")); + curitem = sv_2mortal(newSVpvs("")); do { SvGROW(curitem, needlen+1); needlen = GetEnvironmentVariableA(name,SvPVX(curitem), @@ -2110,42 +2110,42 @@ win32_getenv(const char *name) SvCUR_set(curitem, needlen); } else { - last_err = GetLastError(); - if (last_err == ERROR_NOT_ENOUGH_MEMORY) { - /* It appears the variable is in the env, but the Win32 API - doesn't have a canned way of getting it. So we fall back to - grabbing the whole env and pulling this value out if possible */ - char *envv = GetEnvironmentStrings(); - char *cur = envv; - STRLEN len; - while (*cur) { - char *end = strchr(cur,'='); - if (end && end != cur) { - *end = '\0'; - if (strEQ(cur,name)) { - curitem = sv_2mortal(newSVpv(end+1,0)); - *end = '='; - break; - } - *end = '='; - cur = end + strlen(end+1)+2; - } - else if ((len = strlen(cur))) - cur += len+1; - } - FreeEnvironmentStrings(envv); - } + last_err = GetLastError(); + if (last_err == ERROR_NOT_ENOUGH_MEMORY) { + /* It appears the variable is in the env, but the Win32 API + doesn't have a canned way of getting it. So we fall back to + grabbing the whole env and pulling this value out if possible */ + char *envv = GetEnvironmentStrings(); + char *cur = envv; + STRLEN len; + while (*cur) { + char *end = strchr(cur,'='); + if (end && end != cur) { + *end = '\0'; + if (strEQ(cur,name)) { + curitem = sv_2mortal(newSVpv(end+1,0)); + *end = '='; + break; + } + *end = '='; + cur = end + strlen(end+1)+2; + } + else if ((len = strlen(cur))) + cur += len+1; + } + FreeEnvironmentStrings(envv); + } #ifndef WIN32_NO_REGISTRY - else { - /* last ditch: allow any environment variables that begin with 'PERL' - to be obtained from the registry, if found there */ - if (strBEGINs(name, "PERL")) - (void)get_regstr(name, &curitem); - } + else { + /* last ditch: allow any environment variables that begin with 'PERL' + to be obtained from the registry, if found there */ + if (strBEGINs(name, "PERL")) + (void)get_regstr(name, &curitem); + } #endif } if (curitem && SvCUR(curitem)) - return SvPVX(curitem); + return SvPVX(curitem); return NULL; } @@ -2206,16 +2206,16 @@ win32_times(struct tms *timebuf) clock_t process_time_so_far = clock(); if (GetProcessTimes(GetCurrentProcess(), &dummy, &dummy, &kernel,&user)) { - timebuf->tms_utime = filetime_to_clock(&user); - timebuf->tms_stime = filetime_to_clock(&kernel); - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; + timebuf->tms_utime = filetime_to_clock(&user); + timebuf->tms_stime = filetime_to_clock(&kernel); + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; } else { /* That failed - e.g. Win95 fallback to clock() */ - timebuf->tms_utime = process_time_so_far; - timebuf->tms_stime = 0; - timebuf->tms_cutime = 0; - timebuf->tms_cstime = 0; + timebuf->tms_utime = process_time_so_far; + timebuf->tms_stime = 0; + timebuf->tms_cutime = 0; + timebuf->tms_cstime = 0; } return process_time_so_far; } @@ -2308,7 +2308,7 @@ win32_utime(const char *filename, struct utimbuf *times) } if (filetime_from_time(&ftAccess, times->actime) && - filetime_from_time(&ftWrite, times->modtime)) { + filetime_from_time(&ftWrite, times->modtime)) { if (SetFileTime(handle, NULL, &ftAccess, &ftWrite)) { rc = 0; } @@ -2394,49 +2394,49 @@ win32_uname(struct utsname *name) /* nodename */ hep = win32_gethostbyname("localhost"); if (hep) { - STRLEN len = strlen(hep->h_name); - if (len <= nodemax) { - strcpy(name->nodename, hep->h_name); - } - else { - strncpy(name->nodename, hep->h_name, nodemax); - name->nodename[nodemax] = '\0'; - } + STRLEN len = strlen(hep->h_name); + if (len <= nodemax) { + strcpy(name->nodename, hep->h_name); + } + else { + strncpy(name->nodename, hep->h_name, nodemax); + name->nodename[nodemax] = '\0'; + } } else { - DWORD sz = nodemax; - if (!GetComputerName(name->nodename, &sz)) - *name->nodename = '\0'; + DWORD sz = nodemax; + if (!GetComputerName(name->nodename, &sz)) + *name->nodename = '\0'; } /* machine (architecture) */ { - SYSTEM_INFO info; - DWORD procarch; - char *arch; - GetSystemInfo(&info); + SYSTEM_INFO info; + DWORD procarch; + char *arch; + GetSystemInfo(&info); #if (defined(__MINGW32__) && !defined(_ANONYMOUS_UNION) && !defined(__MINGW_EXTENSION)) - procarch = info.u.s.wProcessorArchitecture; + procarch = info.u.s.wProcessorArchitecture; #else - procarch = info.wProcessorArchitecture; + procarch = info.wProcessorArchitecture; #endif - switch (procarch) { - case PROCESSOR_ARCHITECTURE_INTEL: - arch = "x86"; break; - case PROCESSOR_ARCHITECTURE_IA64: - arch = "ia64"; break; - case PROCESSOR_ARCHITECTURE_AMD64: - arch = "amd64"; break; - case PROCESSOR_ARCHITECTURE_UNKNOWN: - arch = "unknown"; break; - default: - sprintf(name->machine, "unknown(0x%x)", procarch); - arch = name->machine; - break; - } - if (name->machine != arch) - strcpy(name->machine, arch); + switch (procarch) { + case PROCESSOR_ARCHITECTURE_INTEL: + arch = "x86"; break; + case PROCESSOR_ARCHITECTURE_IA64: + arch = "ia64"; break; + case PROCESSOR_ARCHITECTURE_AMD64: + arch = "amd64"; break; + case PROCESSOR_ARCHITECTURE_UNKNOWN: + arch = "unknown"; break; + default: + sprintf(name->machine, "unknown(0x%x)", procarch); + arch = name->machine; + break; + } + if (name->machine != arch) + strcpy(name->machine, arch); } return 0; } @@ -2447,30 +2447,30 @@ int do_raise(pTHX_ int sig) { if (sig < SIG_SIZE) { - Sighandler_t handler = w32_sighandler[sig]; - if (handler == SIG_IGN) { - return 0; - } - else if (handler != SIG_DFL) { - (*handler)(sig); - return 0; - } - else { - /* Choose correct default behaviour */ - switch (sig) { + Sighandler_t handler = w32_sighandler[sig]; + if (handler == SIG_IGN) { + return 0; + } + else if (handler != SIG_DFL) { + (*handler)(sig); + return 0; + } + else { + /* Choose correct default behaviour */ + switch (sig) { #ifdef SIGCLD - case SIGCLD: + case SIGCLD: #endif #ifdef SIGCHLD - case SIGCHLD: + case SIGCHLD: #endif - case 0: - return 0; - case SIGTERM: - default: - break; - } - } + case 0: + return 0; + case SIGTERM: + default: + break; + } + } } /* Tell caller to exit thread/process as appropriate */ return 1; @@ -2545,9 +2545,9 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result FT_t ticks = {0}; unsigned __int64 endtime = timeout; if (timeout != INFINITE) { - GetSystemTimeAsFileTime(&ticks.ft_val); - ticks.ft_i64 /= 10000; - endtime += ticks.ft_i64; + GetSystemTimeAsFileTime(&ticks.ft_val); + ticks.ft_i64 /= 10000; + endtime += ticks.ft_i64; } /* This was a race condition. Do not let a non INFINITE timeout to * MsgWaitForMultipleObjects roll under 0 creating a near @@ -2564,41 +2564,41 @@ win32_msgwait(pTHX_ DWORD count, LPHANDLE handles, DWORD timeout, LPDWORD result * causes msctf.dll to be loaded into Perl by kernel), see [perl #33096]. */ while (ticks.ft_i64 <= endtime) { - /* if timeout's type is lengthened, remember to split 64b timeout - * into multiple non-infinity runs of MWFMO */ - DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE, - (DWORD)(endtime - ticks.ft_i64), - QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE); - if (resultp) - *resultp = result; - if (result == WAIT_TIMEOUT) { - /* Ran out of time - explicit return of zero to avoid -ve if we - have scheduling issues + /* if timeout's type is lengthened, remember to split 64b timeout + * into multiple non-infinity runs of MWFMO */ + DWORD result = MsgWaitForMultipleObjects(count, handles, FALSE, + (DWORD)(endtime - ticks.ft_i64), + QS_POSTMESSAGE|QS_TIMER|QS_SENDMESSAGE); + if (resultp) + *resultp = result; + if (result == WAIT_TIMEOUT) { + /* Ran out of time - explicit return of zero to avoid -ve if we + have scheduling issues */ - return 0; - } - if (timeout != INFINITE) { - GetSystemTimeAsFileTime(&ticks.ft_val); - ticks.ft_i64 /= 10000; - } - if (result == WAIT_OBJECT_0 + count) { - /* Message has arrived - check it */ - (void)win32_async_check(aTHX); + return 0; + } + if (timeout != INFINITE) { + GetSystemTimeAsFileTime(&ticks.ft_val); + ticks.ft_i64 /= 10000; + } + if (result == WAIT_OBJECT_0 + count) { + /* Message has arrived - check it */ + (void)win32_async_check(aTHX); /* retry */ if (ticks.ft_i64 > endtime) endtime = ticks.ft_i64; continue; - } - else { - /* Not timeout or message - one of handles is ready */ - break; - } + } + else { + /* Not timeout or message - one of handles is ready */ + break; + } } /* If we are past the end say zero */ if (!ticks.ft_i64 || ticks.ft_i64 > endtime) - return 0; + return 0; /* compute time left to wait */ ticks.ft_i64 = endtime - ticks.ft_i64; /* if more ms than DWORD, then return max DWORD */ @@ -2616,52 +2616,52 @@ win32_internal_wait(pTHX_ int *status, DWORD timeout) #ifdef USE_ITHREADS if (w32_num_pseudo_children) { - win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles, - timeout, &waitcode); + win32_msgwait(aTHX_ w32_num_pseudo_children, w32_pseudo_child_handles, + timeout, &waitcode); /* Time out here if there are no other children to wait for. */ - if (waitcode == WAIT_TIMEOUT) { - if (!w32_num_children) { - return 0; - } - } - else if (waitcode != WAIT_FAILED) { - if (waitcode >= WAIT_ABANDONED_0 - && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) - i = waitcode - WAIT_ABANDONED_0; - else - i = waitcode - WAIT_OBJECT_0; - if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { - *status = (int)((exitcode & 0xff) << 8); - retval = (int)w32_pseudo_child_pids[i]; - remove_dead_pseudo_process(i); - return -retval; - } - } + if (waitcode == WAIT_TIMEOUT) { + if (!w32_num_children) { + return 0; + } + } + else if (waitcode != WAIT_FAILED) { + if (waitcode >= WAIT_ABANDONED_0 + && waitcode < WAIT_ABANDONED_0 + w32_num_pseudo_children) + i = waitcode - WAIT_ABANDONED_0; + else + i = waitcode - WAIT_OBJECT_0; + if (GetExitCodeThread(w32_pseudo_child_handles[i], &exitcode)) { + *status = (int)((exitcode & 0xff) << 8); + retval = (int)w32_pseudo_child_pids[i]; + remove_dead_pseudo_process(i); + return -retval; + } + } } #endif if (!w32_num_children) { - errno = ECHILD; - return -1; + errno = ECHILD; + return -1; } /* if a child exists, wait for it to die */ win32_msgwait(aTHX_ w32_num_children, w32_child_handles, timeout, &waitcode); if (waitcode == WAIT_TIMEOUT) { - return 0; + return 0; } if (waitcode != WAIT_FAILED) { - if (waitcode >= WAIT_ABANDONED_0 - && waitcode < WAIT_ABANDONED_0 + w32_num_children) - i = waitcode - WAIT_ABANDONED_0; - else - i = waitcode - WAIT_OBJECT_0; - if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) { - *status = (int)((exitcode & 0xff) << 8); - retval = (int)w32_child_pids[i]; - remove_dead_process(i); - return retval; - } + if (waitcode >= WAIT_ABANDONED_0 + && waitcode < WAIT_ABANDONED_0 + w32_num_children) + i = waitcode - WAIT_ABANDONED_0; + else + i = waitcode - WAIT_OBJECT_0; + if (GetExitCodeProcess(w32_child_handles[i], &exitcode) ) { + *status = (int)((exitcode & 0xff) << 8); + retval = (int)w32_child_pids[i]; + remove_dead_process(i); + return retval; + } } errno = GetLastError(); @@ -2676,71 +2676,71 @@ win32_waitpid(int pid, int *status, int flags) int retval = -1; long child; if (pid == -1) /* XXX threadid == 1 ? */ - return win32_internal_wait(aTHX_ status, timeout); + return win32_internal_wait(aTHX_ status, timeout); #ifdef USE_ITHREADS else if (pid < 0) { - child = find_pseudo_pid(aTHX_ -pid); - if (child >= 0) { - HANDLE hThread = w32_pseudo_child_handles[child]; - DWORD waitcode; - win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode); - if (waitcode == WAIT_TIMEOUT) { - return 0; - } - else if (waitcode == WAIT_OBJECT_0) { - if (GetExitCodeThread(hThread, &waitcode)) { - *status = (int)((waitcode & 0xff) << 8); - retval = (int)w32_pseudo_child_pids[child]; - remove_dead_pseudo_process(child); - return -retval; - } - } - else - errno = ECHILD; - } + child = find_pseudo_pid(aTHX_ -pid); + if (child >= 0) { + HANDLE hThread = w32_pseudo_child_handles[child]; + DWORD waitcode; + win32_msgwait(aTHX_ 1, &hThread, timeout, &waitcode); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode == WAIT_OBJECT_0) { + if (GetExitCodeThread(hThread, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + retval = (int)w32_pseudo_child_pids[child]; + remove_dead_pseudo_process(child); + return -retval; + } + } + else + errno = ECHILD; + } } #endif else { - HANDLE hProcess; - DWORD waitcode; - child = find_pid(aTHX_ pid); - if (child >= 0) { - hProcess = w32_child_handles[child]; - win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode); - if (waitcode == WAIT_TIMEOUT) { - return 0; - } - else if (waitcode == WAIT_OBJECT_0) { - if (GetExitCodeProcess(hProcess, &waitcode)) { - *status = (int)((waitcode & 0xff) << 8); - retval = (int)w32_child_pids[child]; - remove_dead_process(child); - return retval; - } - } - else - errno = ECHILD; - } - else { - hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); - if (hProcess) { - win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode); - if (waitcode == WAIT_TIMEOUT) { + HANDLE hProcess; + DWORD waitcode; + child = find_pid(aTHX_ pid); + if (child >= 0) { + hProcess = w32_child_handles[child]; + win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode); + if (waitcode == WAIT_TIMEOUT) { + return 0; + } + else if (waitcode == WAIT_OBJECT_0) { + if (GetExitCodeProcess(hProcess, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + retval = (int)w32_child_pids[child]; + remove_dead_process(child); + return retval; + } + } + else + errno = ECHILD; + } + else { + hProcess = OpenProcess(PROCESS_ALL_ACCESS, TRUE, pid); + if (hProcess) { + win32_msgwait(aTHX_ 1, &hProcess, timeout, &waitcode); + if (waitcode == WAIT_TIMEOUT) { CloseHandle(hProcess); - return 0; - } - else if (waitcode == WAIT_OBJECT_0) { - if (GetExitCodeProcess(hProcess, &waitcode)) { - *status = (int)((waitcode & 0xff) << 8); - CloseHandle(hProcess); - return pid; - } - } - CloseHandle(hProcess); - } - else - errno = ECHILD; - } + return 0; + } + else if (waitcode == WAIT_OBJECT_0) { + if (GetExitCodeProcess(hProcess, &waitcode)) { + *status = (int)((waitcode & 0xff) << 8); + CloseHandle(hProcess); + return pid; + } + } + CloseHandle(hProcess); + } + else + errno = ECHILD; + } } return retval >= 0 ? pid : retval; } @@ -2758,8 +2758,8 @@ win32_sleep(unsigned int t) dTHX; /* Win32 times are in ms so *1000 in and /1000 out */ if (t > UINT_MAX / 1000) { - Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), - "sleep(%lu) too large", t); + Perl_ck_warner(aTHX_ packWARN(WARN_OVERFLOW), + "sleep(%lu) too large", t); } return win32_msgwait(aTHX_ 0, NULL, t * 1000, NULL) / 1000; } @@ -2790,15 +2790,15 @@ win32_alarm(unsigned int sec) if (w32_message_hwnd == NULL) w32_timerid = SetTimer(NULL, w32_timerid, sec*1000, NULL); else { - w32_timerid = 1; + w32_timerid = 1; SetTimer(w32_message_hwnd, w32_timerid, sec*1000, NULL); } } else { - if (w32_timerid) { + if (w32_timerid) { KillTimer(w32_message_hwnd, w32_timerid); - w32_timerid = 0; - } + w32_timerid = 0; + } } return 0; } @@ -2831,29 +2831,29 @@ win32_flock(int fd, int oper) switch(oper) { case LOCK_SH: /* shared lock */ - if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o)) + if (LockFileEx(fh, 0, 0, LK_LEN, 0, &o)) i = 0; - break; + break; case LOCK_EX: /* exclusive lock */ - if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o)) + if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK, 0, LK_LEN, 0, &o)) i = 0; - break; + break; case LOCK_SH|LOCK_NB: /* non-blocking shared lock */ - if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o)) + if (LockFileEx(fh, LOCKFILE_FAIL_IMMEDIATELY, 0, LK_LEN, 0, &o)) i = 0; - break; + break; case LOCK_EX|LOCK_NB: /* non-blocking exclusive lock */ - if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY, - 0, LK_LEN, 0, &o)) + if (LockFileEx(fh, LOCKFILE_EXCLUSIVE_LOCK|LOCKFILE_FAIL_IMMEDIATELY, + 0, LK_LEN, 0, &o)) i = 0; - break; + break; case LOCK_UN: /* unlock lock */ - if (UnlockFileEx(fh, 0, LK_LEN, 0, &o)) + if (UnlockFileEx(fh, 0, LK_LEN, 0, &o)) i = 0; - break; + break; default: /* unknown */ - errno = EINVAL; - return -1; + errno = EINVAL; + return -1; } if (i == -1) { if (GetLastError() == ERROR_LOCK_VIOLATION) @@ -2951,30 +2951,30 @@ win32_strerror(int e) if (e < 0 || e > sys_nerr) { dTHXa(NULL); - if (e < 0) - e = GetLastError(); + if (e < 0) + e = GetLastError(); #ifdef ERRNO_HAS_POSIX_SUPPLEMENT - /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno - * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but - * sys_nerr is still 43 and strerror() returns "Unknown error" for them. - * We must therefore still roll our own messages for these codes, and - * additionally map them to corresponding Windows (sockets) error codes - * first to avoid getting the wrong system message. - */ - else if (inRANGE(e, EADDRINUSE, EWOULDBLOCK)) { - e = convert_errno_to_wsa_error(e); - } + /* VC10+ and some MinGW/gcc-4.8+ define a "POSIX supplement" of errno + * values ranging from EADDRINUSE (100) to EWOULDBLOCK (140), but + * sys_nerr is still 43 and strerror() returns "Unknown error" for them. + * We must therefore still roll our own messages for these codes, and + * additionally map them to corresponding Windows (sockets) error codes + * first to avoid getting the wrong system message. + */ + else if (inRANGE(e, EADDRINUSE, EWOULDBLOCK)) { + e = convert_errno_to_wsa_error(e); + } #endif - aTHXa(PERL_GET_THX); - if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM + aTHXa(PERL_GET_THX); + if (FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |FORMAT_MESSAGE_IGNORE_INSERTS, NULL, e, 0, - w32_strerror_buffer, sizeof(w32_strerror_buffer), + w32_strerror_buffer, sizeof(w32_strerror_buffer), NULL) == 0) { - strcpy(w32_strerror_buffer, "Unknown Error"); + strcpy(w32_strerror_buffer, "Unknown Error"); } - return w32_strerror_buffer; + return w32_strerror_buffer; } #undef strerror return strerror(e); @@ -2987,29 +2987,29 @@ win32_str_os_error(void *sv, DWORD dwErr) DWORD dwLen; char *sMsg; dwLen = FormatMessageA(FORMAT_MESSAGE_ALLOCATE_BUFFER - |FORMAT_MESSAGE_IGNORE_INSERTS - |FORMAT_MESSAGE_FROM_SYSTEM, NULL, - dwErr, 0, (char *)&sMsg, 1, NULL); + |FORMAT_MESSAGE_IGNORE_INSERTS + |FORMAT_MESSAGE_FROM_SYSTEM, NULL, + dwErr, 0, (char *)&sMsg, 1, NULL); /* strip trailing whitespace and period */ if (0 < dwLen) { - do { - --dwLen; /* dwLen doesn't include trailing null */ - } while (0 < dwLen && isSPACE(sMsg[dwLen])); - if ('.' != sMsg[dwLen]) - dwLen++; - sMsg[dwLen] = '\0'; + do { + --dwLen; /* dwLen doesn't include trailing null */ + } while (0 < dwLen && isSPACE(sMsg[dwLen])); + if ('.' != sMsg[dwLen]) + dwLen++; + sMsg[dwLen] = '\0'; } if (0 == dwLen) { - sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); - if (sMsg) - dwLen = sprintf(sMsg, - "Unknown error #0x%lX (lookup 0x%lX)", - dwErr, GetLastError()); + sMsg = (char*)LocalAlloc(0, 64/**sizeof(TCHAR)*/); + if (sMsg) + dwLen = sprintf(sMsg, + "Unknown error #0x%lX (lookup 0x%lX)", + dwErr, GetLastError()); } if (sMsg) { - dTHX; - sv_setpvn((SV*)sv, sMsg, dwLen); - LocalFree(sMsg); + dTHX; + sv_setpvn((SV*)sv, sMsg, dwLen); + LocalFree(sMsg); } } @@ -3064,16 +3064,16 @@ win32_fopen(const char *filename, const char *mode) FILE *f; if (!*filename) - return NULL; + return NULL; if (stricmp(filename, "/dev/null")==0) - filename = "NUL"; + filename = "NUL"; aTHXa(PERL_GET_THX); f = fopen(PerlDir_mapA(filename), mode); /* avoid buffering headaches for child processes */ if (f && *mode == 'a') - win32_fseek(f, 0, SEEK_END); + win32_fseek(f, 0, SEEK_END); return f; } @@ -3084,7 +3084,7 @@ win32_fdopen(int handle, const char *mode) f = fdopen(handle, (char *) mode); /* avoid buffering headaches for child processes */ if (f && *mode == 'a') - win32_fseek(f, 0, SEEK_END); + win32_fseek(f, 0, SEEK_END); return f; } @@ -3093,7 +3093,7 @@ win32_freopen(const char *path, const char *mode, FILE *stream) { dTHXa(NULL); if (stricmp(path, "/dev/null")==0) - path = "NUL"; + path = "NUL"; aTHXa(PERL_GET_THX); return freopen(PerlDir_mapA(path), mode, stream); @@ -3157,7 +3157,7 @@ win32_ftell(FILE *pf) { fpos_t pos; if (fgetpos(pf, &pos)) - return -1; + return -1; return (Off_t)pos; } @@ -3167,20 +3167,20 @@ win32_fseek(FILE *pf, Off_t offset,int origin) fpos_t pos; switch (origin) { case SEEK_CUR: - if (fgetpos(pf, &pos)) - return -1; - offset += pos; - break; + if (fgetpos(pf, &pos)) + return -1; + offset += pos; + break; case SEEK_END: - fseek(pf, 0, SEEK_END); - pos = _telli64(fileno(pf)); - offset += pos; - break; + fseek(pf, 0, SEEK_END); + pos = _telli64(fileno(pf)); + offset += pos; + break; case SEEK_SET: - break; + break; default: - errno = EINVAL; - return -1; + errno = EINVAL; + return -1; } return fsetpos(pf, &offset); } @@ -3219,25 +3219,25 @@ win32_tmpfd_mode(int mode) mode &= ~( O_ACCMODE | O_CREAT | O_EXCL ); mode |= O_RDWR; if (len && len < MAX_PATH) { - if (GetTempFileName(prefix, "plx", 0, filename)) { - HANDLE fh = CreateFile(filename, - DELETE | GENERIC_READ | GENERIC_WRITE, - 0, - NULL, - CREATE_ALWAYS, - FILE_ATTRIBUTE_NORMAL - | FILE_FLAG_DELETE_ON_CLOSE, - NULL); - if (fh != INVALID_HANDLE_VALUE) { - int fd = win32_open_osfhandle((intptr_t)fh, mode); - if (fd >= 0) { - PERL_DEB(dTHX;) - DEBUG_p(PerlIO_printf(Perl_debug_log, - "Created tmpfile=%s\n",filename)); - return fd; - } - } - } + if (GetTempFileName(prefix, "plx", 0, filename)) { + HANDLE fh = CreateFile(filename, + DELETE | GENERIC_READ | GENERIC_WRITE, + 0, + NULL, + CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL + | FILE_FLAG_DELETE_ON_CLOSE, + NULL); + if (fh != INVALID_HANDLE_VALUE) { + int fd = win32_open_osfhandle((intptr_t)fh, mode); + if (fd >= 0) { + PERL_DEB(dTHX;) + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Created tmpfile=%s\n",filename)); + return fd; + } + } + } } return -1; } @@ -3247,7 +3247,7 @@ win32_tmpfile(void) { int fd = win32_tmpfd(); if (fd >= 0) - return win32_fdopen(fd, "w+b"); + return win32_fdopen(fd, "w+b"); return NULL; } @@ -3297,13 +3297,13 @@ do_popen(const char *mode, const char *command, IV narg, SV **args) { stdfd = 0; /* stdin */ parent = 1; child = 0; - nhandle = STD_INPUT_HANDLE; + nhandle = STD_INPUT_HANDLE; } else if (strchr(mode,'r')) { stdfd = 1; /* stdout */ parent = 0; child = 1; - nhandle = STD_OUTPUT_HANDLE; + nhandle = STD_OUTPUT_HANDLE; } else return NULL; @@ -3336,44 +3336,44 @@ do_popen(const char *mode, const char *command, IV narg, SV **args) { /* CreateProcess() requires inheritable handles */ if (!SetHandleInformation((HANDLE)_get_osfhandle(p[child]), HANDLE_FLAG_INHERIT, - HANDLE_FLAG_INHERIT)) { + HANDLE_FLAG_INHERIT)) { goto cleanup; } /* start the child */ { - dTHX; - - if (command) { - if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1) - goto cleanup; - - } - else { - int i; - const char *exe_name; + dTHX; - Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *); - SAVEFREEPV(args_pvs); - for (i = 0; i < narg; ++i) - args_pvs[i] = SvPV_nolen(args[i]); - args_pvs[i] = NULL; - exe_name = qualified_path(args_pvs[0], TRUE); - if (!exe_name) - /* let CreateProcess() try to find it instead */ - exe_name = args_pvs[0]; + if (command) { + if ((childpid = do_spawn2_handles(aTHX_ command, EXECF_SPAWN_NOWAIT, handles)) == -1) + goto cleanup; - if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) { - goto cleanup; - } - } + } + else { + int i; + const char *exe_name; + + Newx(args_pvs, narg + 1 + w32_perlshell_items, const char *); + SAVEFREEPV(args_pvs); + for (i = 0; i < narg; ++i) + args_pvs[i] = SvPV_nolen(args[i]); + args_pvs[i] = NULL; + exe_name = qualified_path(args_pvs[0], TRUE); + if (!exe_name) + /* let CreateProcess() try to find it instead */ + exe_name = args_pvs[0]; + + if ((childpid = do_spawnvp_handles(P_NOWAIT, exe_name, args_pvs, handles)) == -1) { + goto cleanup; + } + } - win32_close(p[child]); + win32_close(p[child]); - sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); + sv_setiv(*av_fetch(w32_fdpid, p[parent], TRUE), childpid); - /* set process id so that it can be returned by perl's open() */ - PL_forkprocess = childpid; + /* set process id so that it can be returned by perl's open() */ + PL_forkprocess = childpid; } /* we have an fd, return a file stream */ @@ -3420,12 +3420,12 @@ win32_pclose(PerlIO *pf) sv = *av_fetch(w32_fdpid, PerlIO_fileno(pf), TRUE); if (SvIOK(sv)) - childpid = SvIVX(sv); + childpid = SvIVX(sv); else - childpid = 0; + childpid = 0; if (!childpid) { - errno = EBADF; + errno = EBADF; return -1; } @@ -3453,10 +3453,10 @@ win32_link(const char *oldname, const char *newname) if (MultiByteToWideChar(CP_ACP, 0, oldname, -1, wOldName, MAX_PATH+1) && MultiByteToWideChar(CP_ACP, 0, newname, -1, wNewName, MAX_PATH+1) && - ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)), + ((aTHXa(PERL_GET_THX)), wcscpy(wOldName, PerlDir_mapW(wOldName)), CreateHardLinkW(PerlDir_mapW(wNewName), wOldName, NULL))) { - return 0; + return 0; } translate_to_errno(); return -1; @@ -3623,37 +3623,37 @@ win32_chsize(int fd, Off_t size) cur = win32_tell(fd); if (cur < 0) - return -1; + return -1; end = win32_lseek(fd, 0, SEEK_END); if (end < 0) - return -1; + return -1; extend = size - end; if (extend == 0) { - /* do nothing */ + /* do nothing */ } else if (extend > 0) { - /* must grow the file, padding with nulls */ - char b[4096]; - int oldmode = win32_setmode(fd, O_BINARY); - size_t count; - memset(b, '\0', sizeof(b)); - do { - count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend; - count = win32_write(fd, b, count); - if ((int)count < 0) { - retval = -1; - break; - } - } while ((extend -= count) > 0); - win32_setmode(fd, oldmode); + /* must grow the file, padding with nulls */ + char b[4096]; + int oldmode = win32_setmode(fd, O_BINARY); + size_t count; + memset(b, '\0', sizeof(b)); + do { + count = extend >= sizeof(b) ? sizeof(b) : (size_t)extend; + count = win32_write(fd, b, count); + if ((int)count < 0) { + retval = -1; + break; + } + } while ((extend -= count) > 0); + win32_setmode(fd, oldmode); } else { - /* shrink the file */ - win32_lseek(fd, size, SEEK_SET); - if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) { - errno = EACCES; - retval = -1; - } + /* shrink the file */ + win32_lseek(fd, size, SEEK_SET); + if (!SetEndOfFile((HANDLE)_get_osfhandle(fd))) { + errno = EACCES; + retval = -1; + } } win32_lseek(fd, cur, SEEK_SET); return retval; @@ -3683,7 +3683,7 @@ win32_open(const char *path, int flag, ...) va_end(ap); if (stricmp(path, "/dev/null")==0) - path = "NUL"; + path = "NUL"; aTHXa(PERL_GET_THX); return open(PerlDir_mapA(path), flag, pmode); @@ -3771,8 +3771,8 @@ DllExport int win32_chdir(const char *dir) { if (!dir || !*dir) { - errno = ENOENT; - return -1; + errno = ENOENT; + return -1; } return chdir(dir); } @@ -3807,7 +3807,7 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) bool quote_next = FALSE; if (!cname) - cname = (char*)args[0]; + cname = (char*)args[0]; /* The NT cmd.exe shell has the following peculiarity that needs to be * worked around. It strips a leading and trailing dquote when any @@ -3825,44 +3825,44 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) * always, making for the convolutions below :-( */ if (cname) { - if (!clen) - clen = strlen(cname); - - if (clen > 4 - && (stricmp(&cname[clen-4], ".bat") == 0 - || (stricmp(&cname[clen-4], ".cmd") == 0))) - { - bat_file = TRUE; + if (!clen) + clen = strlen(cname); + + if (clen > 4 + && (stricmp(&cname[clen-4], ".bat") == 0 + || (stricmp(&cname[clen-4], ".cmd") == 0))) + { + bat_file = TRUE; len += 3; - } - else { - char *exe = strrchr(cname, '/'); - char *exe2 = strrchr(cname, '\\'); - if (exe2 > exe) - exe = exe2; - if (exe) - ++exe; - else - exe = cname; - if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) { - cmd_shell = TRUE; - len += 3; - } - else if (stricmp(exe, "command.com") == 0 - || stricmp(exe, "command") == 0) - { - dumb_shell = TRUE; - } - } + } + else { + char *exe = strrchr(cname, '/'); + char *exe2 = strrchr(cname, '\\'); + if (exe2 > exe) + exe = exe2; + if (exe) + ++exe; + else + exe = cname; + if (stricmp(exe, "cmd.exe") == 0 || stricmp(exe, "cmd") == 0) { + cmd_shell = TRUE; + len += 3; + } + else if (stricmp(exe, "command.com") == 0 + || stricmp(exe, "command") == 0) + { + dumb_shell = TRUE; + } + } } DEBUG_p(PerlIO_printf(Perl_debug_log, "Args ")); for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { - STRLEN curlen = strlen(arg); - if (!(arg[0] == '"' && arg[curlen-1] == '"')) - len += 2; /* assume quoting needed (worst case) */ - len += curlen + 1; - DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg)); + STRLEN curlen = strlen(arg); + if (!(arg[0] == '"' && arg[curlen-1] == '"')) + len += 2; /* assume quoting needed (worst case) */ + len += curlen + 1; + DEBUG_p(PerlIO_printf(Perl_debug_log, "[%s]",arg)); } DEBUG_p(PerlIO_printf(Perl_debug_log, "\n")); @@ -3871,76 +3871,76 @@ create_command_line(char *cname, STRLEN clen, const char * const *args) ptr = cmd; if (bat_file) { - *ptr++ = '"'; - extra_quotes = TRUE; + *ptr++ = '"'; + extra_quotes = TRUE; } for (index = 0; (arg = (char*)args[index]) != NULL; ++index) { - bool do_quote = 0; - STRLEN curlen = strlen(arg); - - /* we want to protect empty arguments and ones with spaces with - * dquotes, but only if they aren't already there */ - if (!dumb_shell) { - if (!curlen) { - do_quote = 1; - } - else if (quote_next) { - /* see if it really is multiple arguments pretending to - * be one and force a set of quotes around it */ - if (*find_next_space(arg)) - do_quote = 1; - } - else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) { - STRLEN i = 0; - while (i < curlen) { - if (isSPACE(arg[i])) { - do_quote = 1; - } - else if (arg[i] == '"') { - do_quote = 0; - break; - } - i++; - } - } - } - - if (do_quote) - *ptr++ = '"'; - - strcpy(ptr, arg); - ptr += curlen; - - if (do_quote) - *ptr++ = '"'; - - if (args[index+1]) - *ptr++ = ' '; - - if (!extra_quotes - && cmd_shell - && curlen >= 2 - && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */ - && stricmp(arg+curlen-2, "/c") == 0) - { - /* is there a next argument? */ - if (args[index+1]) { - /* are there two or more next arguments? */ - if (args[index+2]) { - *ptr++ = '"'; - extra_quotes = TRUE; - } - else { - /* single argument, force quoting if it has spaces */ - quote_next = TRUE; - } - } - } + bool do_quote = 0; + STRLEN curlen = strlen(arg); + + /* we want to protect empty arguments and ones with spaces with + * dquotes, but only if they aren't already there */ + if (!dumb_shell) { + if (!curlen) { + do_quote = 1; + } + else if (quote_next) { + /* see if it really is multiple arguments pretending to + * be one and force a set of quotes around it */ + if (*find_next_space(arg)) + do_quote = 1; + } + else if (!(arg[0] == '"' && curlen > 1 && arg[curlen-1] == '"')) { + STRLEN i = 0; + while (i < curlen) { + if (isSPACE(arg[i])) { + do_quote = 1; + } + else if (arg[i] == '"') { + do_quote = 0; + break; + } + i++; + } + } + } + + if (do_quote) + *ptr++ = '"'; + + strcpy(ptr, arg); + ptr += curlen; + + if (do_quote) + *ptr++ = '"'; + + if (args[index+1]) + *ptr++ = ' '; + + if (!extra_quotes + && cmd_shell + && curlen >= 2 + && *arg == '/' /* see if arg is "/c", "/x/c", "/x/d/c" etc. */ + && stricmp(arg+curlen-2, "/c") == 0) + { + /* is there a next argument? */ + if (args[index+1]) { + /* are there two or more next arguments? */ + if (args[index+2]) { + *ptr++ = '"'; + extra_quotes = TRUE; + } + else { + /* single argument, force quoting if it has spaces */ + quote_next = TRUE; + } + } + } } if (extra_quotes) - *ptr++ = '"'; + *ptr++ = '"'; *ptr = '\0'; @@ -3963,19 +3963,19 @@ qualified_path(const char *cmd, bool other_exts) int has_slash = 0; if (!cmd) - return NULL; + return NULL; fullcmd = (char*)cmd; while (*fullcmd) { - if (*fullcmd == '/' || *fullcmd == '\\') - has_slash++; - fullcmd++; - cmdlen++; + if (*fullcmd == '/' || *fullcmd == '\\') + has_slash++; + fullcmd++; + cmdlen++; } /* look in PATH */ { - dTHX; - pathstr = PerlEnv_getenv("PATH"); + dTHX; + pathstr = PerlEnv_getenv("PATH"); } /* worst case: PATH is a single directory; we need additional space * to append "/", ".exe" and trailing "\0" */ @@ -3983,65 +3983,65 @@ qualified_path(const char *cmd, bool other_exts) curfullcmd = fullcmd; while (1) { - DWORD res; - - /* start by appending the name to the current prefix */ - strcpy(curfullcmd, cmd); - curfullcmd += cmdlen; - - /* if it doesn't end with '.', or has no extension, try adding - * a trailing .exe first */ - if (cmd[cmdlen-1] != '.' - && (cmdlen < 4 || cmd[cmdlen-4] != '.')) - { - int i; - /* first extension is .exe */ - int ext_limit = other_exts ? C_ARRAY_LENGTH(exe_extensions) : 1; - for (i = 0; i < ext_limit; ++i) { - strcpy(curfullcmd, exe_extensions[i]); - res = GetFileAttributes(fullcmd); - if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) - return fullcmd; - } - - *curfullcmd = '\0'; - } - - /* that failed, try the bare name */ - res = GetFileAttributes(fullcmd); - if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) - return fullcmd; - - /* quit if no other path exists, or if cmd already has path */ - if (!pathstr || !*pathstr || has_slash) - break; - - /* skip leading semis */ - while (*pathstr == ';') - pathstr++; - - /* build a new prefix from scratch */ - curfullcmd = fullcmd; - while (*pathstr && *pathstr != ';') { - if (*pathstr == '"') { /* foo;"baz;etc";bar */ - pathstr++; /* skip initial '"' */ - while (*pathstr && *pathstr != '"') { + DWORD res; + + /* start by appending the name to the current prefix */ + strcpy(curfullcmd, cmd); + curfullcmd += cmdlen; + + /* if it doesn't end with '.', or has no extension, try adding + * a trailing .exe first */ + if (cmd[cmdlen-1] != '.' + && (cmdlen < 4 || cmd[cmdlen-4] != '.')) + { + int i; + /* first extension is .exe */ + int ext_limit = other_exts ? C_ARRAY_LENGTH(exe_extensions) : 1; + for (i = 0; i < ext_limit; ++i) { + strcpy(curfullcmd, exe_extensions[i]); + res = GetFileAttributes(fullcmd); + if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) + return fullcmd; + } + + *curfullcmd = '\0'; + } + + /* that failed, try the bare name */ + res = GetFileAttributes(fullcmd); + if (res != 0xFFFFFFFF && !(res & FILE_ATTRIBUTE_DIRECTORY)) + return fullcmd; + + /* quit if no other path exists, or if cmd already has path */ + if (!pathstr || !*pathstr || has_slash) + break; + + /* skip leading semis */ + while (*pathstr == ';') + pathstr++; + + /* build a new prefix from scratch */ + curfullcmd = fullcmd; + while (*pathstr && *pathstr != ';') { + if (*pathstr == '"') { /* foo;"baz;etc";bar */ + pathstr++; /* skip initial '"' */ + while (*pathstr && *pathstr != '"') { *curfullcmd++ = *pathstr++; - } - if (*pathstr) - pathstr++; /* skip trailing '"' */ - } - else { + } + if (*pathstr) + pathstr++; /* skip trailing '"' */ + } + else { *curfullcmd++ = *pathstr++; - } - } - if (*pathstr) - pathstr++; /* skip trailing semi */ - if (curfullcmd > fullcmd /* append a dir separator */ - && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\') - { - *curfullcmd++ = '\\'; - } + } + } + if (*pathstr) + pathstr++; /* skip trailing semi */ + if (curfullcmd > fullcmd /* append a dir separator */ + && curfullcmd[-1] != '/' && curfullcmd[-1] != '\\') + { + *curfullcmd++ = '\\'; + } } Safefree(fullcmd); @@ -4072,15 +4072,15 @@ win32_clearenv(void) char *cur = envv; STRLEN len; while (*cur) { - char *end = strchr(cur,'='); - if (end && end != cur) { - *end = '\0'; - SetEnvironmentVariable(cur, NULL); - *end = '='; - cur = end + strlen(end+1)+2; - } - else if ((len = strlen(cur))) - cur += len+1; + char *end = strchr(cur,'='); + if (end && end != cur) { + *end = '\0'; + SetEnvironmentVariable(cur, NULL); + *end = '='; + cur = end + strlen(end+1)+2; + } + else if ((len = strlen(cur))) + cur += len+1; } FreeEnvironmentStrings(envv); } @@ -4142,21 +4142,21 @@ do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv, STRLEN clen = 0; if (cname) { - clen = strlen(cname); - /* if command name contains dquotes, must remove them */ - if (strchr(cname, '"')) { - cmd = cname; - Newx(cname,clen+1,char); - clen = 0; - while (*cmd) { - if (*cmd != '"') { - cname[clen] = *cmd; - ++clen; - } - ++cmd; - } - cname[clen] = '\0'; - } + clen = strlen(cname); + /* if command name contains dquotes, must remove them */ + if (strchr(cname, '"')) { + cmd = cname; + Newx(cname,clen+1,char); + clen = 0; + while (*cmd) { + if (*cmd != '"') { + cname[clen] = *cmd; + ++clen; + } + ++cmd; + } + cname[clen] = '\0'; + } } cmd = create_command_line(cname, clen, argv); @@ -4167,23 +4167,23 @@ do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv, switch(mode) { case P_NOWAIT: /* asynch + remember result */ - if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) { - errno = EAGAIN; - ret = -1; - goto RETVAL; - } - /* Create a new process group so we can use GenerateConsoleCtrlEvent() - * in win32_kill() - */ + if (w32_num_children >= MAXIMUM_WAIT_OBJECTS) { + errno = EAGAIN; + ret = -1; + goto RETVAL; + } + /* Create a new process group so we can use GenerateConsoleCtrlEvent() + * in win32_kill() + */ create |= CREATE_NEW_PROCESS_GROUP; - /* FALL THROUGH */ + /* FALL THROUGH */ case P_WAIT: /* synchronous execution */ - break; + break; default: /* invalid mode */ - errno = EINVAL; - ret = -1; - goto RETVAL; + errno = EINVAL; + ret = -1; + goto RETVAL; } memset(&StartupInfo,0,sizeof(StartupInfo)); @@ -4204,15 +4204,15 @@ do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv, StartupInfo.hStdOutput = handles && handles[1] != -1 ? (HANDLE)_get_osfhandle(handles[1]) : tbl.childStdOut; StartupInfo.hStdError = handles && handles[2] != -1 ? - (HANDLE)_get_osfhandle(handles[2]) : tbl.childStdErr; + (HANDLE)_get_osfhandle(handles[2]) : tbl.childStdErr; if (StartupInfo.hStdInput == INVALID_HANDLE_VALUE && - StartupInfo.hStdOutput == INVALID_HANDLE_VALUE && - StartupInfo.hStdError == INVALID_HANDLE_VALUE) + StartupInfo.hStdOutput == INVALID_HANDLE_VALUE && + StartupInfo.hStdError == INVALID_HANDLE_VALUE) { - create |= CREATE_NEW_CONSOLE; + create |= CREATE_NEW_CONSOLE; } else { - StartupInfo.dwFlags |= STARTF_USESTDHANDLES; + StartupInfo.dwFlags |= STARTF_USESTDHANDLES; } if (w32_use_showwindow) { StartupInfo.dwFlags |= STARTF_USESHOWWINDOW; @@ -4220,59 +4220,59 @@ do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv, } DEBUG_p(PerlIO_printf(Perl_debug_log, "Spawning [%s] with [%s]\n", - cname,cmd)); + cname,cmd)); RETRY: if (!CreateProcess(cname, /* search PATH to find executable */ - cmd, /* executable, and its arguments */ - NULL, /* process attributes */ - NULL, /* thread attributes */ - TRUE, /* inherit handles */ - create, /* creation flags */ - (LPVOID)env, /* inherit environment */ - dir, /* inherit cwd */ - &StartupInfo, - &ProcessInformation)) + cmd, /* executable, and its arguments */ + NULL, /* process attributes */ + NULL, /* thread attributes */ + TRUE, /* inherit handles */ + create, /* creation flags */ + (LPVOID)env, /* inherit environment */ + dir, /* inherit cwd */ + &StartupInfo, + &ProcessInformation)) { - /* initial NULL argument to CreateProcess() does a PATH - * search, but it always first looks in the directory - * where the current process was started, which behavior - * is undesirable for backward compatibility. So we - * jump through our own hoops by picking out the path - * we really want it to use. */ - if (!fullcmd) { - fullcmd = qualified_path(cname, FALSE); - if (fullcmd) { - if (cname != cmdname) - Safefree(cname); - cname = fullcmd; - DEBUG_p(PerlIO_printf(Perl_debug_log, - "Retrying [%s] with same args\n", - cname)); - goto RETRY; - } - } - errno = ENOENT; - ret = -1; - goto RETVAL; + /* initial NULL argument to CreateProcess() does a PATH + * search, but it always first looks in the directory + * where the current process was started, which behavior + * is undesirable for backward compatibility. So we + * jump through our own hoops by picking out the path + * we really want it to use. */ + if (!fullcmd) { + fullcmd = qualified_path(cname, FALSE); + if (fullcmd) { + if (cname != cmdname) + Safefree(cname); + cname = fullcmd; + DEBUG_p(PerlIO_printf(Perl_debug_log, + "Retrying [%s] with same args\n", + cname)); + goto RETRY; + } + } + errno = ENOENT; + ret = -1; + goto RETVAL; } if (mode == P_NOWAIT) { - /* asynchronous spawn -- store handle, return PID */ - ret = (int)ProcessInformation.dwProcessId; + /* asynchronous spawn -- store handle, return PID */ + ret = (int)ProcessInformation.dwProcessId; - w32_child_handles[w32_num_children] = ProcessInformation.hProcess; - w32_child_pids[w32_num_children] = (DWORD)ret; - ++w32_num_children; + w32_child_handles[w32_num_children] = ProcessInformation.hProcess; + w32_child_pids[w32_num_children] = (DWORD)ret; + ++w32_num_children; } else { - DWORD status; - win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL); - /* FIXME: if msgwait returned due to message perhaps forward the - "signal" to the process + DWORD status; + win32_msgwait(aTHX_ 1, &ProcessInformation.hProcess, INFINITE, NULL); + /* FIXME: if msgwait returned due to message perhaps forward the + "signal" to the process */ - GetExitCodeProcess(ProcessInformation.hProcess, &status); - ret = (int)status; - CloseHandle(ProcessInformation.hProcess); + GetExitCodeProcess(ProcessInformation.hProcess, &status); + ret = (int)status; + CloseHandle(ProcessInformation.hProcess); } CloseHandle(ProcessInformation.hThread); @@ -4282,7 +4282,7 @@ do_spawnvp_handles(int mode, const char *cmdname, const char *const *argv, PerlEnv_free_childdir(dir); Safefree(cmd); if (cname != cmdname) - Safefree(cname); + Safefree(cname); return ret; } @@ -4294,7 +4294,7 @@ win32_execv(const char *cmdname, const char *const *argv) /* if this is a pseudo-forked child, we just want to spawn * the new program, and return */ if (w32_pseudo_id) - return _spawnv(P_WAIT, cmdname, argv); + return _spawnv(P_WAIT, cmdname, argv); #endif return _execv(cmdname, argv); } @@ -4307,13 +4307,13 @@ win32_execvp(const char *cmdname, const char *const *argv) /* if this is a pseudo-forked child, we just want to spawn * the new program, and return */ if (w32_pseudo_id) { - int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv); - if (status != -1) { - my_exit(status); - return 0; - } - else - return status; + int status = win32_spawnvp(P_WAIT, cmdname, (const char *const *)argv); + if (status != -1) { + my_exit(status); + return 0; + } + else + return status; } #endif return _execvp(cmdname, argv); @@ -4536,17 +4536,17 @@ win32_fdupopen(FILE *pf) /* open the file in the same mode */ if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RD) { - mode[0] = 'r'; - mode[1] = 0; + mode[0] = 'r'; + mode[1] = 0; } else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_WR) { - mode[0] = 'a'; - mode[1] = 0; + mode[0] = 'a'; + mode[1] = 0; } else if (PERLIO_FILE_flag(pf) & PERLIO_FILE_flag_RW) { - mode[0] = 'r'; - mode[1] = '+'; - mode[2] = 0; + mode[0] = 'r'; + mode[1] = '+'; + mode[2] = 0; } /* it appears that the binmode is attached to the @@ -4557,7 +4557,7 @@ win32_fdupopen(FILE *pf) /* move the file pointer to the same position */ if (!fgetpos(pf, &pos)) { - fsetpos(pfdup, &pos); + fsetpos(pfdup, &pos); } return pfdup; } @@ -4573,17 +4573,17 @@ win32_dynaload(const char* filename) * so turn 'em back. */ first = strchr(filename, '/'); if (first) { - STRLEN len = strlen(filename); - if (len <= MAX_PATH) { - strcpy(buf, filename); - filename = &buf[first - filename]; - while (*filename) { - if (*filename == '/') - *(char*)filename = '\\'; - ++filename; - } - filename = buf; - } + STRLEN len = strlen(filename); + if (len <= MAX_PATH) { + strcpy(buf, filename); + filename = &buf[first - filename]; + while (*filename) { + if (*filename == '/') + *(char*)filename = '\\'; + ++filename; + } + filename = buf; + } } aTHXa(PERL_GET_THX); return LoadLibraryExA(PerlDir_mapA(filename), NULL, LOAD_WITH_ALTERED_SEARCH_PATH); @@ -4597,7 +4597,7 @@ XS(w32_SetChildShowWindow) unsigned short showwindow = w32_showwindow; if (items > 1) - croak_xs_usage(cv, "[showwindow]"); + croak_xs_usage(cv, "[showwindow]"); if (items == 0 || !SvOK(ST(0))) w32_use_showwindow = FALSE; @@ -4628,16 +4628,16 @@ XS(w32_GetCwd) * else return 'undef' */ if (ptr) { - SV *sv = sv_newmortal(); - sv_setpv(sv, ptr); - PerlEnv_free_childdir(ptr); + SV *sv = sv_newmortal(); + sv_setpv(sv, ptr); + PerlEnv_free_childdir(ptr); #ifndef INCOMPLETE_TAINTS - SvTAINTED_on(sv); + SvTAINTED_on(sv); #endif - ST(0) = sv; - XSRETURN(1); + ST(0) = sv; + XSRETURN(1); } XSRETURN_UNDEF; } @@ -4675,8 +4675,8 @@ win32_signal_context(void) dTHX; #ifdef MULTIPLICITY if (!my_perl) { - my_perl = PL_curinterp; - PERL_SET_THX(my_perl); + my_perl = PL_curinterp; + PERL_SET_THX(my_perl); } return my_perl; #else @@ -4692,7 +4692,7 @@ win32_ctrlhandler(DWORD dwCtrlType) dTHXa(PERL_GET_SIG_CONTEXT); if (!my_perl) - return FALSE; + return FALSE; #endif switch(dwCtrlType) { @@ -4702,37 +4702,37 @@ win32_ctrlhandler(DWORD dwCtrlType) console window's System menu, or by choosing the End Task command from the Task List */ - if (do_raise(aTHX_ 1)) /* SIGHUP */ - sig_terminate(aTHX_ 1); - return TRUE; + if (do_raise(aTHX_ 1)) /* SIGHUP */ + sig_terminate(aTHX_ 1); + return TRUE; case CTRL_C_EVENT: - /* A CTRL+c signal was received */ - if (do_raise(aTHX_ SIGINT)) - sig_terminate(aTHX_ SIGINT); - return TRUE; + /* A CTRL+c signal was received */ + if (do_raise(aTHX_ SIGINT)) + sig_terminate(aTHX_ SIGINT); + return TRUE; case CTRL_BREAK_EVENT: - /* A CTRL+BREAK signal was received */ - if (do_raise(aTHX_ SIGBREAK)) - sig_terminate(aTHX_ SIGBREAK); - return TRUE; + /* A CTRL+BREAK signal was received */ + if (do_raise(aTHX_ SIGBREAK)) + sig_terminate(aTHX_ SIGBREAK); + return TRUE; case CTRL_LOGOFF_EVENT: /* A signal that the system sends to all console processes when a user is logging off. This signal does not indicate which user is logging off, so no assumptions can be made. */ - break; + break; case CTRL_SHUTDOWN_EVENT: /* A signal that the system sends to all console processes when the system is shutting down. */ - if (do_raise(aTHX_ SIGTERM)) - sig_terminate(aTHX_ SIGTERM); - return TRUE; + if (do_raise(aTHX_ SIGTERM)) + sig_terminate(aTHX_ SIGTERM); + return TRUE; default: - break; + break; } return FALSE; } @@ -4869,13 +4869,13 @@ Perl_win32_init(int *argcp, char ***argvp) #ifdef WIN32_DYN_IOINFO_SIZE { - Size_t ioinfo_size = _msize((void*)__pioinfo[0]);; - if((SSize_t)ioinfo_size <= 0) { /* -1 is err */ - fprintf(stderr, "panic: invalid size for ioinfo\n"); /* no interp */ - exit(1); - } - ioinfo_size /= IOINFO_ARRAY_ELTS; - w32_ioinfo_size = ioinfo_size; + Size_t ioinfo_size = _msize((void*)__pioinfo[0]);; + if((SSize_t)ioinfo_size <= 0) { /* -1 is err */ + fprintf(stderr, "panic: invalid size for ioinfo\n"); /* no interp */ + exit(1); + } + ioinfo_size /= IOINFO_ARRAY_ELTS; + w32_ioinfo_size = ioinfo_size; } #endif @@ -4883,15 +4883,15 @@ Perl_win32_init(int *argcp, char ***argvp) #ifndef WIN32_NO_REGISTRY { - LONG retval; - retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd); - if (retval != ERROR_SUCCESS) { - HKCU_Perl_hnd = NULL; - } - retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd); - if (retval != ERROR_SUCCESS) { - HKLM_Perl_hnd = NULL; - } + LONG retval; + retval = RegOpenKeyExW(HKEY_CURRENT_USER, L"SOFTWARE\\Perl", 0, KEY_READ, &HKCU_Perl_hnd); + if (retval != ERROR_SUCCESS) { + HKCU_Perl_hnd = NULL; + } + retval = RegOpenKeyExW(HKEY_LOCAL_MACHINE, L"SOFTWARE\\Perl", 0, KEY_READ, &HKLM_Perl_hnd); + if (retval != ERROR_SUCCESS) { + HKLM_Perl_hnd = NULL; + } } #endif @@ -4899,8 +4899,8 @@ Perl_win32_init(int *argcp, char ***argvp) FILETIME ft; if (!SystemTimeToFileTime(&time_t_epoch_base_systemtime, &ft)) { - fprintf(stderr, "panic: cannot convert base system time to filetime\n"); /* no interp */ - exit(1); + fprintf(stderr, "panic: cannot convert base system time to filetime\n"); /* no interp */ + exit(1); } time_t_epoch_base_filetime.LowPart = ft.dwLowDateTime; time_t_epoch_base_filetime.HighPart = ft.dwHighDateTime; @@ -4938,28 +4938,28 @@ win32_signal(int sig, Sighandler_t subcode) { dTHXa(NULL); if (sig < SIG_SIZE) { - int save_errno = errno; - Sighandler_t result; + int save_errno = errno; + Sighandler_t result; #ifdef SET_INVALID_PARAMETER_HANDLER - /* Silence our invalid parameter handler since we expect to make some - * calls with invalid signal numbers giving a SIG_ERR result. */ - BOOL oldvalue = set_silent_invalid_parameter_handler(TRUE); + /* Silence our invalid parameter handler since we expect to make some + * calls with invalid signal numbers giving a SIG_ERR result. */ + BOOL oldvalue = set_silent_invalid_parameter_handler(TRUE); #endif - result = signal(sig, subcode); + result = signal(sig, subcode); #ifdef SET_INVALID_PARAMETER_HANDLER - set_silent_invalid_parameter_handler(oldvalue); + set_silent_invalid_parameter_handler(oldvalue); #endif - aTHXa(PERL_GET_THX); - if (result == SIG_ERR) { - result = w32_sighandler[sig]; - errno = save_errno; - } - w32_sighandler[sig] = subcode; - return result; + aTHXa(PERL_GET_THX); + if (result == SIG_ERR) { + result = w32_sighandler[sig]; + errno = save_errno; + } + w32_sighandler[sig] = subcode; + return result; } else { - errno = EINVAL; - return SIG_ERR; + errno = EINVAL; + return SIG_ERR; } } @@ -5105,16 +5105,16 @@ Perl_sys_intern_init(pTHX) w32_message_hwnd = CAST_HWND__(INVALID_HANDLE_VALUE); w32_poll_count = 0; for (i=0; i < SIG_SIZE; i++) { - w32_sighandler[i] = SIG_DFL; + w32_sighandler[i] = SIG_DFL; } # ifdef MULTIPLICITY if (my_perl == PL_curinterp) { # else { # endif - /* Force C runtime signal stuff to set its console handler */ - signal(SIGINT,win32_csighandler); - signal(SIGBREAK,win32_csighandler); + /* Force C runtime signal stuff to set its console handler */ + signal(SIGINT,win32_csighandler); + signal(SIGBREAK,win32_csighandler); /* We spawn asynchronous processes with the CREATE_NEW_PROCESS_GROUP * flag. This has the side-effect of disabling Ctrl-C events in all @@ -5124,8 +5124,8 @@ Perl_sys_intern_init(pTHX) */ SetConsoleCtrlHandler(NULL,FALSE); - /* Push our handler on top */ - SetConsoleCtrlHandler(win32_ctrlhandler,TRUE); + /* Push our handler on top */ + SetConsoleCtrlHandler(win32_ctrlhandler,TRUE); } } @@ -5138,8 +5138,8 @@ Perl_sys_intern_clear(pTHX) /* NOTE: w32_fdpid is freed by sv_clean_all() */ Safefree(w32_children); if (w32_timerid) { - KillTimer(w32_message_hwnd, w32_timerid); - w32_timerid = 0; + KillTimer(w32_message_hwnd, w32_timerid); + w32_timerid = 0; } if (w32_message_hwnd != NULL && w32_message_hwnd != INVALID_HANDLE_VALUE) DestroyWindow(w32_message_hwnd); @@ -5148,7 +5148,7 @@ Perl_sys_intern_clear(pTHX) # else { # endif - SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); + SetConsoleCtrlHandler(win32_ctrlhandler,FALSE); } # ifdef USE_ITHREADS Safefree(w32_pseudo_children); diff --git a/win32/win32.h b/win32/win32.h index 40ab7e043a46..2325d0edc963 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -111,7 +111,7 @@ #if (defined(__GNUC__) && defined(__MINGW32__) && \ !defined(__MINGW64_VERSION_MAJOR) && !defined(__clang__) && \ - ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ <= 5)))) + ((__GNUC__ < 3) || ((__GNUC__ == 3) && (__GNUC_MINOR__ <= 5)))) /* use default fallbacks from perl.h for this particular GCC */ #else # if !defined(PERLDLL) && !defined(PERL_EXT_RE_BUILD) @@ -181,10 +181,10 @@ WINBASEAPI LPCH WINAPI GetEnvironmentStringsA(VOID); #endif struct tms { - long tms_utime; - long tms_stime; - long tms_cutime; - long tms_cstime; + long tms_utime; + long tms_stime; + long tms_cutime; + long tms_cstime; }; #ifndef SYS_NMLN diff --git a/win32/win32io.c b/win32/win32io.c index 814fc8bf8f3a..2b4f27611dab 100644 --- a/win32/win32io.c +++ b/win32/win32io.c @@ -63,8 +63,8 @@ PerlIOWin32_pushed(pTHX_ PerlIO *f, const char *mode, SV *arg, PerlIO_funcs *tab PerlIOBase(f)->flags |= PERLIO_F_OPEN; Perl_ck_warner_d(aTHX_ - packWARN(WARN_EXPERIMENTAL__WIN32_PERLIO), - "PerlIO layer ':win32' is experimental"); + packWARN(WARN_EXPERIMENTAL__WIN32_PERLIO), + "PerlIO layer ':win32' is experimental"); return code; } diff --git a/win32/win32iop.h b/win32/win32iop.h index fd6b1c151b23..9733d7b53244 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -88,7 +88,7 @@ DllExport int win32_isatty(int fd); DllExport int win32_read(int fd, void *buf, unsigned int cnt); DllExport int win32_write(int fd, const void *buf, unsigned int cnt); DllExport int win32_spawnvp(int mode, const char *cmdname, - const char *const *argv); + const char *const *argv); DllExport int win32_mkdir(const char *dir, int mode); DllExport int win32_rmdir(const char *dir); DllExport int win32_chdir(const char *dir); diff --git a/win32/win32sck.c b/win32/win32sck.c index 2798ee507b53..ef5c682101c8 100644 --- a/win32/win32sck.c +++ b/win32/win32sck.c @@ -35,19 +35,19 @@ #define StartSockets() \ STMT_START { \ - if (!wsock_started) \ - start_sockets(); \ + if (!wsock_started) \ + start_sockets(); \ } STMT_END #define SOCKET_TEST(x, y) \ STMT_START { \ - StartSockets(); \ - if((x) == (y)) \ - { \ - int wsaerr = WSAGetLastError(); \ - errno = convert_wsa_error_to_errno(wsaerr); \ - SetLastError(wsaerr); \ - } \ + StartSockets(); \ + if((x) == (y)) \ + { \ + int wsaerr = WSAGetLastError(); \ + errno = convert_wsa_error_to_errno(wsaerr); \ + SetLastError(wsaerr); \ + } \ } STMT_END #define SOCKET_TEST_ERROR(x) SOCKET_TEST(x, SOCKET_ERROR) @@ -66,7 +66,7 @@ EXTERN_C void EndSockets(void) { if (wsock_started) - WSACleanup(); + WSACleanup(); } /* Translate WSAExxx values to corresponding Exxx values where possible. Not all @@ -89,107 +89,107 @@ convert_wsa_error_to_errno(int wsaerr) { switch (wsaerr) { case WSAEINTR: - return EINTR; + return EINTR; case WSAEBADF: - return EBADF; + return EBADF; case WSAEACCES: - return EACCES; + return EACCES; case WSAEFAULT: - return EFAULT; + return EFAULT; case WSAEINVAL: - return EINVAL; + return EINVAL; case WSAEMFILE: - return EMFILE; + return EMFILE; case WSAEWOULDBLOCK: - return EWOULDBLOCK; + return EWOULDBLOCK; case WSAEINPROGRESS: - return EINPROGRESS; + return EINPROGRESS; case WSAEALREADY: - return EALREADY; + return EALREADY; case WSAENOTSOCK: - return ENOTSOCK; + return ENOTSOCK; case WSAEDESTADDRREQ: - return EDESTADDRREQ; + return EDESTADDRREQ; case WSAEMSGSIZE: - return EMSGSIZE; + return EMSGSIZE; case WSAEPROTOTYPE: - return EPROTOTYPE; + return EPROTOTYPE; case WSAENOPROTOOPT: - return ENOPROTOOPT; + return ENOPROTOOPT; case WSAEPROTONOSUPPORT: - return EPROTONOSUPPORT; + return EPROTONOSUPPORT; case WSAESOCKTNOSUPPORT: - return ESOCKTNOSUPPORT; + return ESOCKTNOSUPPORT; case WSAEOPNOTSUPP: - return EOPNOTSUPP; + return EOPNOTSUPP; case WSAEPFNOSUPPORT: - return EPFNOSUPPORT; + return EPFNOSUPPORT; case WSAEAFNOSUPPORT: - return EAFNOSUPPORT; + return EAFNOSUPPORT; case WSAEADDRINUSE: - return EADDRINUSE; + return EADDRINUSE; case WSAEADDRNOTAVAIL: - return EADDRNOTAVAIL; + return EADDRNOTAVAIL; case WSAENETDOWN: - return ENETDOWN; + return ENETDOWN; case WSAENETUNREACH: - return ENETUNREACH; + return ENETUNREACH; case WSAENETRESET: - return ENETRESET; + return ENETRESET; case WSAECONNABORTED: - return ECONNABORTED; + return ECONNABORTED; case WSAECONNRESET: - return ECONNRESET; + return ECONNRESET; case WSAENOBUFS: - return ENOBUFS; + return ENOBUFS; case WSAEISCONN: - return EISCONN; + return EISCONN; case WSAENOTCONN: - return ENOTCONN; + return ENOTCONN; case WSAESHUTDOWN: - return ESHUTDOWN; + return ESHUTDOWN; case WSAETOOMANYREFS: - return ETOOMANYREFS; + return ETOOMANYREFS; case WSAETIMEDOUT: - return ETIMEDOUT; + return ETIMEDOUT; case WSAECONNREFUSED: - return ECONNREFUSED; + return ECONNREFUSED; case WSAELOOP: - return ELOOP; + return ELOOP; case WSAENAMETOOLONG: - return ENAMETOOLONG; + return ENAMETOOLONG; case WSAEHOSTDOWN: - return WSAEHOSTDOWN; /* EHOSTDOWN is not defined */ + return WSAEHOSTDOWN; /* EHOSTDOWN is not defined */ case WSAEHOSTUNREACH: - return EHOSTUNREACH; + return EHOSTUNREACH; case WSAENOTEMPTY: - return ENOTEMPTY; + return ENOTEMPTY; case WSAEPROCLIM: - return EPROCLIM; + return EPROCLIM; case WSAEUSERS: - return EUSERS; + return EUSERS; case WSAEDQUOT: - return EDQUOT; + return EDQUOT; case WSAESTALE: - return ESTALE; + return ESTALE; case WSAEREMOTE: - return EREMOTE; + return EREMOTE; case WSAEDISCON: - return WSAEDISCON; /* EDISCON is not defined */ + return WSAEDISCON; /* EDISCON is not defined */ case WSAENOMORE: - return WSAENOMORE; /* ENOMORE is not defined */ + return WSAENOMORE; /* ENOMORE is not defined */ #ifdef WSAECANCELLED case WSAECANCELLED: /* New in WinSock2 */ - return ECANCELED; + return ECANCELED; #endif case WSAEINVALIDPROCTABLE: - return WSAEINVALIDPROCTABLE; /* EINVALIDPROCTABLE is not defined */ + return WSAEINVALIDPROCTABLE; /* EINVALIDPROCTABLE is not defined */ case WSAEINVALIDPROVIDER: - return WSAEINVALIDPROVIDER; /* EINVALIDPROVIDER is not defined */ + return WSAEINVALIDPROVIDER; /* EINVALIDPROVIDER is not defined */ case WSAEPROVIDERFAILEDINIT: - return WSAEPROVIDERFAILEDINIT; /* EPROVIDERFAILEDINIT is not defined */ + return WSAEPROVIDERFAILEDINIT; /* EPROVIDERFAILEDINIT is not defined */ case WSAEREFUSED: - return WSAEREFUSED; /* EREFUSED is not defined */ + return WSAEREFUSED; /* EREFUSED is not defined */ } return wsaerr; @@ -213,113 +213,113 @@ convert_errno_to_wsa_error(int err) { switch (err) { case EADDRINUSE: - return WSAEADDRINUSE; + return WSAEADDRINUSE; case EADDRNOTAVAIL: - return WSAEADDRNOTAVAIL; + return WSAEADDRNOTAVAIL; case EAFNOSUPPORT: - return WSAEAFNOSUPPORT; + return WSAEAFNOSUPPORT; case EALREADY: - return WSAEALREADY; + return WSAEALREADY; #ifdef EBADMSG case EBADMSG: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ECANCELED: #ifdef WSAECANCELLED - return WSAECANCELLED; /* New in WinSock2 */ + return WSAECANCELLED; /* New in WinSock2 */ #else - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ECONNABORTED: - return WSAECONNABORTED; + return WSAECONNABORTED; case ECONNREFUSED: - return WSAECONNREFUSED; + return WSAECONNREFUSED; case ECONNRESET: - return WSAECONNRESET; + return WSAECONNRESET; case EDESTADDRREQ: - return WSAEDESTADDRREQ; + return WSAEDESTADDRREQ; case EHOSTUNREACH: - return WSAEHOSTUNREACH; + return WSAEHOSTUNREACH; #ifdef EIDRM case EIDRM: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case EINPROGRESS: - return WSAEINPROGRESS; + return WSAEINPROGRESS; case EISCONN: - return WSAEISCONN; + return WSAEISCONN; case ELOOP: - return WSAELOOP; + return WSAELOOP; case EMSGSIZE: - return WSAEMSGSIZE; + return WSAEMSGSIZE; case ENETDOWN: - return WSAENETDOWN; + return WSAENETDOWN; case ENETRESET: - return WSAENETRESET; + return WSAENETRESET; case ENETUNREACH: - return WSAENETUNREACH; + return WSAENETUNREACH; case ENOBUFS: - return WSAENOBUFS; + return WSAENOBUFS; #ifdef ENODATA case ENODATA: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif #ifdef ENOLINK case ENOLINK: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif #ifdef ENOMSG case ENOMSG: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ENOPROTOOPT: - return WSAENOPROTOOPT; + return WSAENOPROTOOPT; #ifdef ENOSR case ENOSR: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif #ifdef ENOSTR case ENOSTR: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ENOTCONN: - return WSAENOTCONN; + return WSAENOTCONN; #ifdef ENOTRECOVERABLE case ENOTRECOVERABLE: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ENOTSOCK: - return WSAENOTSOCK; + return WSAENOTSOCK; case ENOTSUP: - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; case EOPNOTSUPP: - return WSAEOPNOTSUPP; + return WSAEOPNOTSUPP; #ifdef EOTHER case EOTHER: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case EOVERFLOW: - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; case EOWNERDEAD: - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; case EPROTO: - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; case EPROTONOSUPPORT: - return WSAEPROTONOSUPPORT; + return WSAEPROTONOSUPPORT; case EPROTOTYPE: - return WSAEPROTOTYPE; + return WSAEPROTOTYPE; #ifdef ETIME case ETIME: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case ETIMEDOUT: - return WSAETIMEDOUT; + return WSAETIMEDOUT; #ifdef ETXTBSY case ETXTBSY: /* Not defined in gcc-4.8.0 */ - return ERROR_INVALID_FUNCTION; + return ERROR_INVALID_FUNCTION; #endif case EWOULDBLOCK: - return WSAEWOULDBLOCK; + return WSAEWOULDBLOCK; } return err; @@ -339,9 +339,9 @@ start_sockets(void) */ version = 0x2; if(ret = WSAStartup(version, &retdata)) - Perl_croak_nocontext("Unable to locate winsock library!\n"); + Perl_croak_nocontext("Unable to locate winsock library!\n"); if(retdata.wVersion != version) - Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n"); + Perl_croak_nocontext("Could not find version 2.0 of winsock dll\n"); /* atexit((void (*)(void)) EndSockets); */ wsock_started = 1; @@ -482,7 +482,7 @@ win32_recvfrom(SOCKET s, char *buf, int len, int flags, struct sockaddr *from, i * of sockets, so go the extra mile. */ if (r != SOCKET_ERROR && frombufsize == *fromlen) - (void)win32_getpeername(s, from, fromlen); + (void)win32_getpeername(s, from, fromlen); return r; } @@ -501,33 +501,33 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const FD_ZERO(&nwr); FD_ZERO(&nex); for (i = 0; i < nfds; i++) { - if (rd && PERL_FD_ISSET(i,rd)) { - fd = TO_SOCKET(i); - FD_SET((unsigned)fd, &nrd); + if (rd && PERL_FD_ISSET(i,rd)) { + fd = TO_SOCKET(i); + FD_SET((unsigned)fd, &nrd); just_sleep = FALSE; - } - if (wr && PERL_FD_ISSET(i,wr)) { - fd = TO_SOCKET(i); - FD_SET((unsigned)fd, &nwr); + } + if (wr && PERL_FD_ISSET(i,wr)) { + fd = TO_SOCKET(i); + FD_SET((unsigned)fd, &nwr); just_sleep = FALSE; - } - if (ex && PERL_FD_ISSET(i,ex)) { - fd = TO_SOCKET(i); - FD_SET((unsigned)fd, &nex); + } + if (ex && PERL_FD_ISSET(i,ex)) { + fd = TO_SOCKET(i); + FD_SET((unsigned)fd, &nex); just_sleep = FALSE; - } + } } /* winsock seems incapable of dealing with all three fd_sets being empty, * so do the (millisecond) sleep as a special case */ if (just_sleep) { - if (timeout) - Sleep(timeout->tv_sec * 1000 + - timeout->tv_usec / 1000); /* do the best we can */ - else - Sleep(UINT_MAX); - return 0; + if (timeout) + Sleep(timeout->tv_sec * 1000 + + timeout->tv_usec / 1000); /* do the best we can */ + else + Sleep(UINT_MAX); + return 0; } errno = save_errno; @@ -535,21 +535,21 @@ win32_select(int nfds, Perl_fd_set* rd, Perl_fd_set* wr, Perl_fd_set* ex, const save_errno = errno; for (i = 0; i < nfds; i++) { - if (rd && PERL_FD_ISSET(i,rd)) { - fd = TO_SOCKET(i); - if (!FD_ISSET(fd, &nrd)) - PERL_FD_CLR(i,rd); - } - if (wr && PERL_FD_ISSET(i,wr)) { - fd = TO_SOCKET(i); - if (!FD_ISSET(fd, &nwr)) - PERL_FD_CLR(i,wr); - } - if (ex && PERL_FD_ISSET(i,ex)) { - fd = TO_SOCKET(i); - if (!FD_ISSET(fd, &nex)) - PERL_FD_CLR(i,ex); - } + if (rd && PERL_FD_ISSET(i,rd)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nrd)) + PERL_FD_CLR(i,rd); + } + if (wr && PERL_FD_ISSET(i,wr)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nwr)) + PERL_FD_CLR(i,wr); + } + if (ex && PERL_FD_ISSET(i,ex)) { + fd = TO_SOCKET(i); + if (!FD_ISSET(fd, &nex)) + PERL_FD_CLR(i,ex); + } } errno = save_errno; return r; @@ -566,7 +566,7 @@ win32_send(SOCKET s, const char *buf, int len, int flags) int win32_sendto(SOCKET s, const char *buf, int len, int flags, - const struct sockaddr *to, int tolen) + const struct sockaddr *to, int tolen) { int r; @@ -623,7 +623,7 @@ open_ifs_socket(int af, int type, int protocol) if (WSCEnumProtocols(NULL, NULL, &proto_buffers_len, &error_code) == SOCKET_ERROR && error_code == WSAENOBUFS) { - WSAPROTOCOL_INFOW *proto_buffers; + WSAPROTOCOL_INFOW *proto_buffers; int protocols_available = 0; Newx(proto_buffers, proto_buffers_len / sizeof(WSAPROTOCOL_INFOW), @@ -672,12 +672,12 @@ win32_socket(int af, int type, int protocol) if((s = open_ifs_socket(af, type, protocol)) == INVALID_SOCKET) { - int wsaerr = WSAGetLastError(); - errno = convert_wsa_error_to_errno(wsaerr); - SetLastError(wsaerr); - } + int wsaerr = WSAGetLastError(); + errno = convert_wsa_error_to_errno(wsaerr); + SetLastError(wsaerr); + } else - s = OPEN_SOCKET(s); + s = OPEN_SOCKET(s); return s; } @@ -693,32 +693,32 @@ int my_close(int fd) { int osf; if (!wsock_started) /* No WinSock? */ - return(close(fd)); /* Then not a socket. */ + return(close(fd)); /* Then not a socket. */ osf = TO_SOCKET(fd);/* Get it now before it's gone! */ if (osf != -1) { - int err; - err = closesocket(osf); - if (err == 0) { + int err; + err = closesocket(osf); + if (err == 0) { #ifdef _set_osfhnd - assert(_osfhnd(fd) == osf); /* catch a bad ioinfo struct def */ - /* don't close freed handle */ - _set_osfhnd(fd, INVALID_HANDLE_VALUE); - return close(fd); + assert(_osfhnd(fd) == osf); /* catch a bad ioinfo struct def */ + /* don't close freed handle */ + _set_osfhnd(fd, INVALID_HANDLE_VALUE); + return close(fd); #else - (void)close(fd); /* handle already closed, ignore error */ - return 0; + (void)close(fd); /* handle already closed, ignore error */ + return 0; #endif - } - else if (err == SOCKET_ERROR) { - int wsaerr = WSAGetLastError(); - err = convert_wsa_error_to_errno(wsaerr); - if (err != ENOTSOCK) { - (void)close(fd); - errno = err; - SetLastError(wsaerr); - return EOF; - } - } + } + else if (err == SOCKET_ERROR) { + int wsaerr = WSAGetLastError(); + err = convert_wsa_error_to_errno(wsaerr); + if (err != ENOTSOCK) { + (void)close(fd); + errno = err; + SetLastError(wsaerr); + return EOF; + } + } } return close(fd); } @@ -729,33 +729,33 @@ my_fclose (FILE *pf) { int osf; if (!wsock_started) /* No WinSock? */ - return(fclose(pf)); /* Then not a socket. */ + return(fclose(pf)); /* Then not a socket. */ osf = TO_SOCKET(win32_fileno(pf));/* Get it now before it's gone! */ if (osf != -1) { - int err; - win32_fflush(pf); - err = closesocket(osf); - if (err == 0) { + int err; + win32_fflush(pf); + err = closesocket(osf); + if (err == 0) { #ifdef _set_osfhnd - assert(_osfhnd(win32_fileno(pf)) == osf); /* catch a bad ioinfo struct def */ - /* don't close freed handle */ - _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE); - return fclose(pf); + assert(_osfhnd(win32_fileno(pf)) == osf); /* catch a bad ioinfo struct def */ + /* don't close freed handle */ + _set_osfhnd(win32_fileno(pf), INVALID_HANDLE_VALUE); + return fclose(pf); #else - (void)fclose(pf); /* handle already closed, ignore error */ - return 0; + (void)fclose(pf); /* handle already closed, ignore error */ + return 0; #endif - } - else if (err == SOCKET_ERROR) { - int wsaerr = WSAGetLastError(); - err = convert_wsa_error_to_errno(wsaerr); - if (err != ENOTSOCK) { - (void)fclose(pf); - errno = err; - SetLastError(wsaerr); - return EOF; - } - } + } + else if (err == SOCKET_ERROR) { + int wsaerr = WSAGetLastError(); + err = convert_wsa_error_to_errno(wsaerr); + if (err != ENOTSOCK) { + (void)fclose(pf); + errno = err; + SetLastError(wsaerr); + return EOF; + } + } } return fclose(pf); } @@ -814,7 +814,7 @@ win32_getservbyname(const char *name, const char *proto) SOCKET_TEST(r = getservbyname(name, proto), NULL); if (r) { aTHXa(PERL_GET_THX); - r = win32_savecopyservent(&w32_servent, r, proto); + r = win32_savecopyservent(&w32_servent, r, proto); } return r; } @@ -828,7 +828,7 @@ win32_getservbyport(int port, const char *proto) SOCKET_TEST(r = getservbyport(port, proto), NULL); if (r) { aTHXa(PERL_GET_THX); - r = win32_savecopyservent(&w32_servent, r, proto); + r = win32_savecopyservent(&w32_servent, r, proto); } return r; } @@ -840,8 +840,8 @@ win32_ioctl(int i, unsigned int u, char *data) int retval; if (!wsock_started) { - Perl_croak_nocontext("ioctl implemented only on sockets"); - /* NOTREACHED */ + Perl_croak_nocontext("ioctl implemented only on sockets"); + /* NOTREACHED */ } /* mauke says using memcpy avoids alignment issues */ @@ -850,14 +850,14 @@ win32_ioctl(int i, unsigned int u, char *data) memcpy(data, &u_long_arg, sizeof u_long_arg); if (retval == SOCKET_ERROR) { - int wsaerr = WSAGetLastError(); - int err = convert_wsa_error_to_errno(wsaerr); - if (err == ENOTSOCK) { - Perl_croak_nocontext("ioctl implemented only on sockets"); - /* NOTREACHED */ - } - errno = err; - SetLastError(wsaerr); + int wsaerr = WSAGetLastError(); + int err = convert_wsa_error_to_errno(wsaerr); + if (err == ENOTSOCK) { + Perl_croak_nocontext("ioctl implemented only on sockets"); + /* NOTREACHED */ + } + errno = err; + SetLastError(wsaerr); } return retval; } @@ -974,12 +974,12 @@ win32_savecopyservent(struct servent*d, struct servent*s, const char *proto) d->s_aliases = s->s_aliases; d->s_port = s->s_port; if (s->s_proto && strlen(s->s_proto)) - d->s_proto = s->s_proto; + d->s_proto = s->s_proto; else if (proto && strlen(proto)) - d->s_proto = (char *)proto; + d->s_proto = (char *)proto; else - d->s_proto = "tcp"; + d->s_proto = "tcp"; return d; } diff --git a/win32/win32thread.h b/win32/win32thread.h index 9ac964ccf465..9306157c1cda 100644 --- a/win32/win32thread.h +++ b/win32/win32thread.h @@ -24,26 +24,26 @@ typedef CRITICAL_SECTION perl_mutex; typedef HANDLE perl_mutex; # define MUTEX_INIT(m) \ STMT_START { \ - if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \ - Perl_croak_nocontext("panic: MUTEX_INIT"); \ + if ((*(m) = CreateMutex(NULL,FALSE,NULL)) == NULL) \ + Perl_croak_nocontext("panic: MUTEX_INIT"); \ } STMT_END # define MUTEX_LOCK(m) \ STMT_START { \ - if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \ - Perl_croak_nocontext("panic: MUTEX_LOCK"); \ + if (WaitForSingleObject(*(m),INFINITE) == WAIT_FAILED) \ + Perl_croak_nocontext("panic: MUTEX_LOCK"); \ } STMT_END # define MUTEX_UNLOCK(m) \ STMT_START { \ - if (ReleaseMutex(*(m)) == 0) \ - Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \ + if (ReleaseMutex(*(m)) == 0) \ + Perl_croak_nocontext("panic: MUTEX_UNLOCK"); \ } STMT_END # define MUTEX_DESTROY(m) \ STMT_START { \ - if (CloseHandle(*(m)) == 0) \ - Perl_croak_nocontext("panic: MUTEX_DESTROY"); \ + if (CloseHandle(*(m)) == 0) \ + Perl_croak_nocontext("panic: MUTEX_DESTROY"); \ } STMT_END #endif @@ -54,53 +54,53 @@ typedef HANDLE perl_mutex; */ #define COND_INIT(c) \ STMT_START { \ - (c)->waiters = 0; \ - (c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL); \ - if ((c)->sem == NULL) \ - Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \ + (c)->waiters = 0; \ + (c)->sem = Win_CreateSemaphore(NULL,0,LONG_MAX,NULL); \ + if ((c)->sem == NULL) \ + Perl_croak_nocontext("panic: COND_INIT (%ld)",GetLastError()); \ } STMT_END #define COND_SIGNAL(c) \ STMT_START { \ - if ((c)->waiters > 0 && \ - ReleaseSemaphore((c)->sem,1,NULL) == 0) \ - Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \ + if ((c)->waiters > 0 && \ + ReleaseSemaphore((c)->sem,1,NULL) == 0) \ + Perl_croak_nocontext("panic: COND_SIGNAL (%ld)",GetLastError()); \ } STMT_END #define COND_BROADCAST(c) \ STMT_START { \ - if ((c)->waiters > 0 && \ - ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \ - Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\ + if ((c)->waiters > 0 && \ + ReleaseSemaphore((c)->sem,(c)->waiters,NULL) == 0) \ + Perl_croak_nocontext("panic: COND_BROADCAST (%ld)",GetLastError());\ } STMT_END #define COND_WAIT(c, m) \ STMT_START { \ - (c)->waiters++; \ - MUTEX_UNLOCK(m); \ - /* Note that there's no race here, since a \ - * COND_BROADCAST() on another thread will have seen the\ - * right number of waiters (i.e. including this one) */ \ - if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\ - Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \ - /* XXX there may be an inconsequential race here */ \ - MUTEX_LOCK(m); \ - (c)->waiters--; \ + (c)->waiters++; \ + MUTEX_UNLOCK(m); \ + /* Note that there's no race here, since a \ + * COND_BROADCAST() on another thread will have seen the\ + * right number of waiters (i.e. including this one) */ \ + if (WaitForSingleObject((c)->sem,INFINITE)==WAIT_FAILED)\ + Perl_croak_nocontext("panic: COND_WAIT (%ld)",GetLastError()); \ + /* XXX there may be an inconsequential race here */ \ + MUTEX_LOCK(m); \ + (c)->waiters--; \ } STMT_END #define COND_DESTROY(c) \ STMT_START { \ - (c)->waiters = 0; \ - if (CloseHandle((c)->sem) == 0) \ - Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError()); \ + (c)->waiters = 0; \ + if (CloseHandle((c)->sem) == 0) \ + Perl_croak_nocontext("panic: COND_DESTROY (%ld)",GetLastError()); \ } STMT_END #define DETACH(t) \ STMT_START { \ - if (CloseHandle((t)->self) == 0) { \ - MUTEX_UNLOCK(&(t)->mutex); \ - Perl_croak_nocontext("panic: DETACH"); \ - } \ + if (CloseHandle((t)->self) == 0) { \ + MUTEX_UNLOCK(&(t)->mutex); \ + Perl_croak_nocontext("panic: DETACH"); \ + } \ } STMT_END @@ -148,15 +148,15 @@ END_EXTERN_C #define INIT_THREADS NOOP #define ALLOC_THREAD_KEY \ STMT_START { \ - if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) { \ - PerlIO_printf(PerlIO_stderr(),"panic: TlsAlloc"); \ - exit(1); \ - } \ + if ((PL_thr_key = TlsAlloc()) == TLS_OUT_OF_INDEXES) { \ + PerlIO_printf(PerlIO_stderr(),"panic: TlsAlloc"); \ + exit(1); \ + } \ } STMT_END #define FREE_THREAD_KEY \ STMT_START { \ - TlsFree(PL_thr_key); \ + TlsFree(PL_thr_key); \ } STMT_END #define PTHREAD_ATFORK(prepare,parent,child) NOOP @@ -164,19 +164,19 @@ END_EXTERN_C #if defined(USE_RTL_THREAD_API) && !defined(_MSC_VER) #define JOIN(t, avp) \ STMT_START { \ - if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ - || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ - || (CloseHandle((t)->self) == 0)) \ - Perl_croak_nocontext("panic: JOIN"); \ - *avp = (AV *)((t)->i.retv); \ + if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ + || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ + || (CloseHandle((t)->self) == 0)) \ + Perl_croak_nocontext("panic: JOIN"); \ + *avp = (AV *)((t)->i.retv); \ } STMT_END #else /* !USE_RTL_THREAD_API || _MSC_VER */ #define JOIN(t, avp) \ STMT_START { \ - if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ - || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ - || (CloseHandle((t)->self) == 0)) \ - Perl_croak_nocontext("panic: JOIN"); \ + if ((WaitForSingleObject((t)->self,INFINITE) == WAIT_FAILED) \ + || (GetExitCodeThread((t)->self,(LPDWORD)(avp)) == 0) \ + || (CloseHandle((t)->self) == 0)) \ + Perl_croak_nocontext("panic: JOIN"); \ } STMT_END #endif /* !USE_RTL_THREAD_API || _MSC_VER */ From 9824c081922f8e3697322536c3da1702e35e45ab Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Mon, 28 Dec 2020 19:48:01 -0800 Subject: [PATCH 430/503] style: Detabify regen files. They generate C files. Bump feature.pm and warnings.pm versions to satisfy cmpVERSION.pl. I can't get it to easily ignore whitespace, `git diff --name-only` does not respect the -w flag. regen_perly.pl is left alone. That would require rebuilding perly.* which is beyond a simple indentation change. --- charclass_invlists.h | 6 +- keywords.c | 2 +- keywords.h | 2 +- lib/unicore/uni_keywords.pl | 6 +- lib/warnings.pm | 186 ++++----- opcode.h | 4 +- reentr.c | 374 +++++++++--------- reentr.h | 122 +++--- regcharclass.h | 4 +- regen.pl | 2 +- regen/charset_translations.pl | 20 +- regen/embed.pl | 480 +++++++++++------------ regen/embed_lib.pl | 146 +++---- regen/keywords.pl | 14 +- regen/lib_cleanup.pl | 2 +- regen/mg_vtable.pl | 260 ++++++------- regen/mk_PL_charclass.pl | 2 +- regen/mk_invlists.pl | 6 +- regen/opcode.pl | 308 +++++++-------- regen/overload.pl | 10 +- regen/reentr.pl | 704 +++++++++++++++++----------------- regen/regcharclass.pl | 8 +- regen/regen_lib.pl | 58 +-- regen/warnings.pl | 304 +++++++-------- uni_keywords.h | 6 +- warnings.h | 16 +- 26 files changed, 1526 insertions(+), 1526 deletions(-) diff --git a/charclass_invlists.h b/charclass_invlists.h index 42dd659a5a69..4493ae9f3953 100644 --- a/charclass_invlists.h +++ b/charclass_invlists.h @@ -419902,7 +419902,7 @@ static const U8 WB_table[23][23] = { * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version - * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl - * b1d799ef06236277bdbe06eea253a83a7d39f161ec51f4d4bf5e9b5b5a57f251 regen/mk_invlists.pl + * 24120d5e0c9685c442c93bc1dbea9b85ef973bf8e9474baf0e55b160c288226b regen/charset_translations.pl + * 9f74e34278592ddf58fef8c32236b294e94ea5e12627f911f4563e8040a07292 regen/mk_PL_charclass.pl + * 5eb9e6c825496cc9aa705e3cd33bc6d5a9657dcca16d4c4acc4824ff30b34a26 regen/mk_invlists.pl * ex: set ro: */ diff --git a/keywords.c b/keywords.c index d503bc9c2d90..b2dd655fdd5a 100644 --- a/keywords.c +++ b/keywords.c @@ -3451,5 +3451,5 @@ Perl_keyword (pTHX_ const char *name, I32 len, bool all_keywords) } /* Generated from: - * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl + * dd384f0c948716414a93d758d89a38e3c8116acfdc48eb7e34fa6737887097d5 regen/keywords.pl * ex: set ro: */ diff --git a/keywords.h b/keywords.h index 23fa6944d898..50dc717984c3 100644 --- a/keywords.h +++ b/keywords.h @@ -271,5 +271,5 @@ #define KEY_y 255 /* Generated from: - * f77998a5bc995c1b42d3d080de227ef5f11638bcd329367431d8f193aef2d3cc regen/keywords.pl + * dd384f0c948716414a93d758d89a38e3c8116acfdc48eb7e34fa6737887097d5 regen/keywords.pl * ex: set ro: */ diff --git a/lib/unicore/uni_keywords.pl b/lib/unicore/uni_keywords.pl index dda925bc7830..1cb6740e2533 100644 --- a/lib/unicore/uni_keywords.pl +++ b/lib/unicore/uni_keywords.pl @@ -1297,7 +1297,7 @@ # 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt # ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables # 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version -# 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl -# 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl -# d99eae7d3b60d8ed3af56e6fdc41ab53b22288238749812aa1cd01f847fe9d5f regen/mk_invlists.pl +# 24120d5e0c9685c442c93bc1dbea9b85ef973bf8e9474baf0e55b160c288226b regen/charset_translations.pl +# 9f74e34278592ddf58fef8c32236b294e94ea5e12627f911f4563e8040a07292 regen/mk_PL_charclass.pl +# 5eb9e6c825496cc9aa705e3cd33bc6d5a9657dcca16d4c4acc4824ff30b34a26 regen/mk_invlists.pl # ex: set ro: diff --git a/lib/warnings.pm b/lib/warnings.pm index 6f3420b8dd67..d1c17ab70020 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = "1.49"; +our $VERSION = "1.50"; # Verify that we're called correctly so that warnings will work. # Can't use Carp, since Carp uses us! @@ -284,16 +284,16 @@ sub _expand_bits { my $want_len = ($LAST_BIT + 7) >> 3; my $len = length($bits); if ($len != $want_len) { - if ($bits eq "") { - $bits = "\x00" x $want_len; - } elsif ($len > $want_len) { - substr $bits, $want_len, $len-$want_len, ""; - } else { - my $x = vec($bits, $Offsets{all} >> 1, 2); - $x |= $x << 2; - $x |= $x << 4; - $bits .= chr($x) x ($want_len - $len); - } + if ($bits eq "") { + $bits = "\x00" x $want_len; + } elsif ($len > $want_len) { + substr $bits, $want_len, $len-$want_len, ""; + } else { + my $x = vec($bits, $Offsets{all} >> 1, 2); + $x |= $x << 2; + $x |= $x << 4; + $bits .= chr($x) x ($want_len - $len); + } } return $bits; } @@ -306,21 +306,21 @@ sub _bits { $mask = _expand_bits($mask); foreach my $word ( @_ ) { - if ($word eq 'FATAL') { - $fatal = 1; - $no_fatal = 0; - } - elsif ($word eq 'NONFATAL') { - $fatal = 0; - $no_fatal = 1; - } - elsif ($catmask = $Bits{$word}) { - $mask |= $catmask ; - $mask |= $DeadBits{$word} if $fatal ; - $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ; - } - else - { Croaker("Unknown warnings category '$word'")} + if ($word eq 'FATAL') { + $fatal = 1; + $no_fatal = 0; + } + elsif ($word eq 'NONFATAL') { + $fatal = 0; + $no_fatal = 1; + } + elsif ($catmask = $Bits{$word}) { + $mask |= $catmask ; + $mask |= $DeadBits{$word} if $fatal ; + $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ; + } + else + { Croaker("Unknown warnings category '$word'")} } return $mask ; @@ -367,14 +367,14 @@ sub unimport $mask = _expand_bits($mask); foreach my $word ( @_ ) { - if ($word eq 'FATAL') { - next; - } - elsif ($catmask = $Bits{$word}) { - $mask = ~(~$mask | $catmask | $DeadBits{$word}); - } - else - { Croaker("Unknown warnings category '$word'")} + if ($word eq 'FATAL') { + next; + } + elsif ($catmask = $Bits{$word}) { + $mask = ~(~$mask | $catmask | $DeadBits{$word}); + } + else + { Croaker("Unknown warnings category '$word'")} } ${^WARNING_BITS} = $mask ; @@ -397,71 +397,71 @@ sub __chk my $has_level = $wanted & LEVEL ; if ($has_level) { - if (@_ != ($has_message ? 3 : 2)) { - my $sub = (caller 1)[3]; - my $syntax = $has_message - ? "category, level, 'message'" - : 'category, level'; - Croaker("Usage: $sub($syntax)"); + if (@_ != ($has_message ? 3 : 2)) { + my $sub = (caller 1)[3]; + my $syntax = $has_message + ? "category, level, 'message'" + : 'category, level'; + Croaker("Usage: $sub($syntax)"); } } elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) { - my $sub = (caller 1)[3]; - my $syntax = $has_message ? "[category,] 'message'" : '[category]'; - Croaker("Usage: $sub($syntax)"); + my $sub = (caller 1)[3]; + my $syntax = $has_message ? "[category,] 'message'" : '[category]'; + Croaker("Usage: $sub($syntax)"); } my $message = pop if $has_message; if (@_) { - # check the category supplied. - $category = shift ; - if (my $type = ref $category) { - Croaker("not an object") - if exists $builtin_type{$type}; - $category = $type; - $isobj = 1 ; - } - $offset = $Offsets{$category}; - Croaker("Unknown warnings category '$category'") - unless defined $offset; + # check the category supplied. + $category = shift ; + if (my $type = ref $category) { + Croaker("not an object") + if exists $builtin_type{$type}; + $category = $type; + $isobj = 1 ; + } + $offset = $Offsets{$category}; + Croaker("Unknown warnings category '$category'") + unless defined $offset; } else { - $category = (caller(1))[0] ; - $offset = $Offsets{$category}; - Croaker("package '$category' not registered for warnings") - unless defined $offset ; + $category = (caller(1))[0] ; + $offset = $Offsets{$category}; + Croaker("package '$category' not registered for warnings") + unless defined $offset ; } my $i; if ($isobj) { - my $pkg; - $i = 2; - while (do { { package DB; $pkg = (caller($i++))[0] } } ) { - last unless @DB::args && $DB::args[0] =~ /^$category=/ ; - } - $i -= 2 ; + my $pkg; + $i = 2; + while (do { { package DB; $pkg = (caller($i++))[0] } } ) { + last unless @DB::args && $DB::args[0] =~ /^$category=/ ; + } + $i -= 2 ; } elsif ($has_level) { - $i = 2 + shift; + $i = 2 + shift; } else { - $i = _error_loc(); # see where Carp will allocate the error + $i = _error_loc(); # see where Carp will allocate the error } # Default to 0 if caller returns nothing. Default to $DEFAULT if it # explicitly returns undef. my(@callers_bitmask) = (caller($i))[9] ; my $callers_bitmask = - @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ; + @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ; length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all}; my @results; foreach my $type (FATAL, NORMAL) { - next unless $wanted & $type; + next unless $wanted & $type; - push @results, vec($callers_bitmask, $offset + $type - 1, 1); + push @results, vec($callers_bitmask, $offset + $type - 1, 1); } # &enabled and &fatal_enabled @@ -469,19 +469,19 @@ sub __chk # &warnif, and the category is neither enabled as warning nor as fatal return if ($wanted & (NORMAL | FATAL | MESSAGE)) - == (NORMAL | FATAL | MESSAGE) - && !($results[0] || $results[1]); + == (NORMAL | FATAL | MESSAGE) + && !($results[0] || $results[1]); # If we have an explicit level, bypass Carp. if ($has_level and @callers_bitmask) { - # logic copied from util.c:mess_sv - my $stuff = " at " . join " line ", (caller $i)[1,2]; - $stuff .= sprintf ", <%s> %s %d", - *${^LAST_FH}{NAME}, - ($/ eq "\n" ? "line" : "chunk"), $. - if $. && ${^LAST_FH}; - die "$message$stuff.\n" if $results[0]; - return warn "$message$stuff.\n"; + # logic copied from util.c:mess_sv + my $stuff = " at " . join " line ", (caller $i)[1,2]; + $stuff .= sprintf ", <%s> %s %d", + *${^LAST_FH}{NAME}, + ($/ eq "\n" ? "line" : "chunk"), $. + if $. && ${^LAST_FH}; + die "$message$stuff.\n" if $results[0]; + return warn "$message$stuff.\n"; } require Carp; @@ -505,15 +505,15 @@ sub register_categories my @names = @_; for my $name (@names) { - if (! defined $Bits{$name}) { - $Offsets{$name} = $LAST_BIT; - $Bits{$name} = _mkMask($LAST_BIT++); - $DeadBits{$name} = _mkMask($LAST_BIT++); - if (length($Bits{$name}) > length($Bits{all})) { - $Bits{all} .= "\x55"; - $DeadBits{all} .= "\xaa"; - } - } + if (! defined $Bits{$name}) { + $Offsets{$name} = $LAST_BIT; + $Bits{$name} = _mkMask($LAST_BIT++); + $DeadBits{$name} = _mkMask($LAST_BIT++); + if (length($Bits{$name}) > length($Bits{all})) { + $Bits{all} .= "\x55"; + $DeadBits{all} .= "\xaa"; + } + } } } @@ -634,7 +634,7 @@ For example, consider the code below: my @x; { no warnings; - my $y = @x[0]; + my $y = @x[0]; } my $z = @x[0]; @@ -719,8 +719,8 @@ a block of code. You might expect this to be enough to do the trick: { local ($^W) = 0; - my $x =+ 2; - my $y; chop $y; + my $x =+ 2; + my $y; chop $y; } When this code is run with the B<-w> flag, a warning will be produced @@ -731,8 +731,8 @@ disable compile-time warnings you need to rewrite the code like this: { BEGIN { $^W = 0 } - my $x =+ 2; - my $y; chop $y; + my $x =+ 2; + my $y; chop $y; } And note that unlike the first example, this will permanently set C<$^W> diff --git a/opcode.h b/opcode.h index 7c708e402ed5..859b20575045 100644 --- a/opcode.h +++ b/opcode.h @@ -549,7 +549,7 @@ EXTCONST char* const PL_op_name[] = { "isa", "cmpchain_and", "cmpchain_dup", - "freed", + "freed", }; #endif @@ -957,7 +957,7 @@ EXTCONST char* const PL_op_desc[] = { "derived class test", "comparison chaining", "comparand shuffling", - "freed op", + "freed op", }; #endif diff --git a/reentr.c b/reentr.c index 2429aa2f5daa..e3204e3244c9 100644 --- a/reentr.c +++ b/reentr.c @@ -36,14 +36,14 @@ #define RenewDouble(data_pointer, size_pointer, type) \ STMT_START { \ - const size_t size = MAX(*(size_pointer), 1) * 2; \ - Renew((data_pointer), (size), type); \ - *(size_pointer) = size; \ + const size_t size = MAX(*(size_pointer), 1) * 2; \ + Renew((data_pointer), (size), type); \ + *(size_pointer) = size; \ } STMT_END void Perl_reentrant_size(pTHX) { - PERL_UNUSED_CONTEXT; + PERL_UNUSED_CONTEXT; /* Set the sizes of the reentrant buffers */ @@ -52,83 +52,83 @@ Perl_reentrant_size(pTHX) { # define REENTRANTUSUALSIZE 4096 /* Make something up. */ # ifdef HAS_ASCTIME_R - PL_reentrant_buffer->_asctime_size = 26; + PL_reentrant_buffer->_asctime_size = 26; # endif /* HAS_ASCTIME_R */ # ifdef HAS_CRYPT_R # endif /* HAS_CRYPT_R */ # ifdef HAS_CTIME_R - PL_reentrant_buffer->_ctime_size = 26; + PL_reentrant_buffer->_ctime_size = 26; # endif /* HAS_CTIME_R */ # ifdef HAS_GETGRNAM_R # if defined(HAS_SYSCONF) && defined(_SC_GETGR_R_SIZE_MAX) && !defined(__GLIBC__) - PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX); - if (PL_reentrant_buffer->_grent_size == (size_t) -1) - PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_grent_size = sysconf(_SC_GETGR_R_SIZE_MAX); + if (PL_reentrant_buffer->_grent_size == (size_t) -1) + PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE; # elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_grent_size = SIABUFSIZ; + PL_reentrant_buffer->_grent_size = SIABUFSIZ; # elif defined(__sgi) - PL_reentrant_buffer->_grent_size = BUFSIZ; + PL_reentrant_buffer->_grent_size = BUFSIZ; # else - PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_grent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETGRNAM_R */ # ifdef HAS_GETHOSTBYNAME_R # if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_hostent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETHOSTBYNAME_R */ # ifdef HAS_GETLOGIN_R - PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE; + PL_reentrant_buffer->_getlogin_size = REENTRANTSMALLSIZE; # endif /* HAS_GETLOGIN_R */ # ifdef HAS_GETNETBYNAME_R # if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_netent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETNETBYNAME_R */ # ifdef HAS_GETPROTOBYNAME_R # if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_protoent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETPROTOBYNAME_R */ # ifdef HAS_GETPWNAM_R # if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__) - PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX); - if (PL_reentrant_buffer->_pwent_size == (size_t) -1) - PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_pwent_size = sysconf(_SC_GETPW_R_SIZE_MAX); + if (PL_reentrant_buffer->_pwent_size == (size_t) -1) + PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE; # elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_pwent_size = SIABUFSIZ; + PL_reentrant_buffer->_pwent_size = SIABUFSIZ; # elif defined(__sgi) - PL_reentrant_buffer->_pwent_size = BUFSIZ; + PL_reentrant_buffer->_pwent_size = BUFSIZ; # else - PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_pwent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETPWNAM_R */ # ifdef HAS_GETSERVBYNAME_R # if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD) - PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_servent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETSERVBYNAME_R */ # ifdef HAS_GETSPNAM_R # if defined(HAS_SYSCONF) && defined(_SC_GETPW_R_SIZE_MAX) && !defined(__GLIBC__) - PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX); - if (PL_reentrant_buffer->_spent_size == (size_t) -1) - PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_spent_size = sysconf(_SC_GETPW_R_SIZE_MAX); + if (PL_reentrant_buffer->_spent_size == (size_t) -1) + PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE; # elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->_spent_size = SIABUFSIZ; + PL_reentrant_buffer->_spent_size = SIABUFSIZ; # elif defined(__sgi) - PL_reentrant_buffer->_spent_size = BUFSIZ; + PL_reentrant_buffer->_spent_size = BUFSIZ; # else - PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_spent_size = REENTRANTUSUALSIZE; # endif # endif /* HAS_GETSPNAM_R */ @@ -139,27 +139,27 @@ Perl_reentrant_size(pTHX) { # endif /* HAS_LOCALTIME_R */ # ifdef HAS_READDIR_R - /* This is the size Solaris recommends. - * (though we go static, should use pathconf() instead) */ - PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1; + /* This is the size Solaris recommends. + * (though we go static, should use pathconf() instead) */ + PL_reentrant_buffer->_readdir_size = sizeof(struct dirent) + MAXPATHLEN + 1; # endif /* HAS_READDIR_R */ # ifdef HAS_READDIR64_R - /* This is the size Solaris recommends. - * (though we go static, should use pathconf() instead) */ - PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1; + /* This is the size Solaris recommends. + * (though we go static, should use pathconf() instead) */ + PL_reentrant_buffer->_readdir64_size = sizeof(struct dirent64) + MAXPATHLEN + 1; # endif /* HAS_READDIR64_R */ # ifdef HAS_SETLOCALE_R - PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE; + PL_reentrant_buffer->_setlocale_size = REENTRANTSMALLSIZE; # endif /* HAS_SETLOCALE_R */ # ifdef HAS_STRERROR_R - PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE; + PL_reentrant_buffer->_strerror_size = REENTRANTSMALLSIZE; # endif /* HAS_STRERROR_R */ # ifdef HAS_TTYNAME_R - PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE; + PL_reentrant_buffer->_ttyname_size = REENTRANTSMALLSIZE; # endif /* HAS_TTYNAME_R */ @@ -169,76 +169,76 @@ Perl_reentrant_size(pTHX) { void Perl_reentrant_init(pTHX) { - PERL_UNUSED_CONTEXT; + PERL_UNUSED_CONTEXT; /* Initialize the whole thing */ #ifdef USE_REENTRANT_API - Newx(PL_reentrant_buffer, 1, REENTR); - Perl_reentrant_size(aTHX); + Newx(PL_reentrant_buffer, 1, REENTR); + Perl_reentrant_size(aTHX); # ifdef HAS_ASCTIME_R - Newx(PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char); + Newx(PL_reentrant_buffer->_asctime_buffer, PL_reentrant_buffer->_asctime_size, char); # endif /* HAS_ASCTIME_R */ # ifdef HAS_CRYPT_R # if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD - PL_reentrant_buffer->_crypt_struct_buffer = 0; + PL_reentrant_buffer->_crypt_struct_buffer = 0; # endif # endif /* HAS_CRYPT_R */ # ifdef HAS_CTIME_R - Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char); + Newx(PL_reentrant_buffer->_ctime_buffer, PL_reentrant_buffer->_ctime_size, char); # endif /* HAS_CTIME_R */ # ifdef HAS_GETGRNAM_R # ifdef USE_GRENT_FPTR - PL_reentrant_buffer->_grent_fptr = NULL; + PL_reentrant_buffer->_grent_fptr = NULL; # endif - Newx(PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char); + Newx(PL_reentrant_buffer->_grent_buffer, PL_reentrant_buffer->_grent_size, char); # endif /* HAS_GETGRNAM_R */ # ifdef HAS_GETHOSTBYNAME_R # if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Newx(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char); + Newx(PL_reentrant_buffer->_hostent_buffer, PL_reentrant_buffer->_hostent_size, char); # endif # endif /* HAS_GETHOSTBYNAME_R */ # ifdef HAS_GETLOGIN_R - Newx(PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char); + Newx(PL_reentrant_buffer->_getlogin_buffer, PL_reentrant_buffer->_getlogin_size, char); # endif /* HAS_GETLOGIN_R */ # ifdef HAS_GETNETBYNAME_R # if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Newx(PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char); + Newx(PL_reentrant_buffer->_netent_buffer, PL_reentrant_buffer->_netent_size, char); # endif # endif /* HAS_GETNETBYNAME_R */ # ifdef HAS_GETPROTOBYNAME_R # if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Newx(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char); + Newx(PL_reentrant_buffer->_protoent_buffer, PL_reentrant_buffer->_protoent_size, char); # endif # endif /* HAS_GETPROTOBYNAME_R */ # ifdef HAS_GETPWNAM_R # ifdef USE_PWENT_FPTR - PL_reentrant_buffer->_pwent_fptr = NULL; + PL_reentrant_buffer->_pwent_fptr = NULL; # endif - Newx(PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char); + Newx(PL_reentrant_buffer->_pwent_buffer, PL_reentrant_buffer->_pwent_size, char); # endif /* HAS_GETPWNAM_R */ # ifdef HAS_GETSERVBYNAME_R # if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD) - Newx(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char); + Newx(PL_reentrant_buffer->_servent_buffer, PL_reentrant_buffer->_servent_size, char); # endif # endif /* HAS_GETSERVBYNAME_R */ # ifdef HAS_GETSPNAM_R # ifdef USE_SPENT_FPTR - PL_reentrant_buffer->_spent_fptr = NULL; + PL_reentrant_buffer->_spent_fptr = NULL; # endif - Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char); + Newx(PL_reentrant_buffer->_spent_buffer, PL_reentrant_buffer->_spent_size, char); # endif /* HAS_GETSPNAM_R */ # ifdef HAS_GMTIME_R @@ -248,23 +248,23 @@ Perl_reentrant_init(pTHX) { # endif /* HAS_LOCALTIME_R */ # ifdef HAS_READDIR_R - PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size); + PL_reentrant_buffer->_readdir_struct = (struct dirent*)safemalloc(PL_reentrant_buffer->_readdir_size); # endif /* HAS_READDIR_R */ # ifdef HAS_READDIR64_R - PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size); + PL_reentrant_buffer->_readdir64_struct = (struct dirent64*)safemalloc(PL_reentrant_buffer->_readdir64_size); # endif /* HAS_READDIR64_R */ # ifdef HAS_SETLOCALE_R - Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char); + Newx(PL_reentrant_buffer->_setlocale_buffer, PL_reentrant_buffer->_setlocale_size, char); # endif /* HAS_SETLOCALE_R */ # ifdef HAS_STRERROR_R - Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char); + Newx(PL_reentrant_buffer->_strerror_buffer, PL_reentrant_buffer->_strerror_size, char); # endif /* HAS_STRERROR_R */ # ifdef HAS_TTYNAME_R - Newx(PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char); + Newx(PL_reentrant_buffer->_ttyname_buffer, PL_reentrant_buffer->_ttyname_size, char); # endif /* HAS_TTYNAME_R */ @@ -274,64 +274,64 @@ Perl_reentrant_init(pTHX) { void Perl_reentrant_free(pTHX) { - PERL_UNUSED_CONTEXT; + PERL_UNUSED_CONTEXT; /* Tear down */ #ifdef USE_REENTRANT_API # ifdef HAS_ASCTIME_R - Safefree(PL_reentrant_buffer->_asctime_buffer); + Safefree(PL_reentrant_buffer->_asctime_buffer); # endif /* HAS_ASCTIME_R */ # ifdef HAS_CRYPT_R # if CRYPT_R_PROTO != REENTRANT_PROTO_B_CCD - Safefree(PL_reentrant_buffer->_crypt_struct_buffer); + Safefree(PL_reentrant_buffer->_crypt_struct_buffer); # endif # endif /* HAS_CRYPT_R */ # ifdef HAS_CTIME_R - Safefree(PL_reentrant_buffer->_ctime_buffer); + Safefree(PL_reentrant_buffer->_ctime_buffer); # endif /* HAS_CTIME_R */ # ifdef HAS_GETGRNAM_R - Safefree(PL_reentrant_buffer->_grent_buffer); + Safefree(PL_reentrant_buffer->_grent_buffer); # endif /* HAS_GETGRNAM_R */ # ifdef HAS_GETHOSTBYNAME_R # if !(GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Safefree(PL_reentrant_buffer->_hostent_buffer); + Safefree(PL_reentrant_buffer->_hostent_buffer); # endif # endif /* HAS_GETHOSTBYNAME_R */ # ifdef HAS_GETLOGIN_R - Safefree(PL_reentrant_buffer->_getlogin_buffer); + Safefree(PL_reentrant_buffer->_getlogin_buffer); # endif /* HAS_GETLOGIN_R */ # ifdef HAS_GETNETBYNAME_R # if !(GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Safefree(PL_reentrant_buffer->_netent_buffer); + Safefree(PL_reentrant_buffer->_netent_buffer); # endif # endif /* HAS_GETNETBYNAME_R */ # ifdef HAS_GETPROTOBYNAME_R # if !(GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD) - Safefree(PL_reentrant_buffer->_protoent_buffer); + Safefree(PL_reentrant_buffer->_protoent_buffer); # endif # endif /* HAS_GETPROTOBYNAME_R */ # ifdef HAS_GETPWNAM_R - Safefree(PL_reentrant_buffer->_pwent_buffer); + Safefree(PL_reentrant_buffer->_pwent_buffer); # endif /* HAS_GETPWNAM_R */ # ifdef HAS_GETSERVBYNAME_R # if !(GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD) - Safefree(PL_reentrant_buffer->_servent_buffer); + Safefree(PL_reentrant_buffer->_servent_buffer); # endif # endif /* HAS_GETSERVBYNAME_R */ # ifdef HAS_GETSPNAM_R - Safefree(PL_reentrant_buffer->_spent_buffer); + Safefree(PL_reentrant_buffer->_spent_buffer); # endif /* HAS_GETSPNAM_R */ # ifdef HAS_GMTIME_R @@ -341,27 +341,27 @@ Perl_reentrant_free(pTHX) { # endif /* HAS_LOCALTIME_R */ # ifdef HAS_READDIR_R - Safefree(PL_reentrant_buffer->_readdir_struct); + Safefree(PL_reentrant_buffer->_readdir_struct); # endif /* HAS_READDIR_R */ # ifdef HAS_READDIR64_R - Safefree(PL_reentrant_buffer->_readdir64_struct); + Safefree(PL_reentrant_buffer->_readdir64_struct); # endif /* HAS_READDIR64_R */ # ifdef HAS_SETLOCALE_R - Safefree(PL_reentrant_buffer->_setlocale_buffer); + Safefree(PL_reentrant_buffer->_setlocale_buffer); # endif /* HAS_SETLOCALE_R */ # ifdef HAS_STRERROR_R - Safefree(PL_reentrant_buffer->_strerror_buffer); + Safefree(PL_reentrant_buffer->_strerror_buffer); # endif /* HAS_STRERROR_R */ # ifdef HAS_TTYNAME_R - Safefree(PL_reentrant_buffer->_ttyname_buffer); + Safefree(PL_reentrant_buffer->_ttyname_buffer); # endif /* HAS_TTYNAME_R */ - Safefree(PL_reentrant_buffer); + Safefree(PL_reentrant_buffer); #endif /* USE_REENTRANT_API */ } @@ -402,7 +402,7 @@ Perl_reentrant_retry(const char *f, ...) #ifdef HAS_GETSPNAM_R - /* This is a #define as has no corresponding keyword */ + /* This is a #define as has no corresponding keyword */ if (strEQ(f, "getspnam")) { key = KEY_getspnam; } @@ -425,36 +425,36 @@ Perl_reentrant_retry(const char *f, ...) case KEY_gethostbyaddr: case KEY_gethostbyname: case KEY_endhostent: - { + { char * host_addr; Size_t asize; char * host_name; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_hostent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_hostent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_hostent_buffer, &PL_reentrant_buffer->_hostent_size, char); switch (key) { - case KEY_gethostbyaddr: - host_addr = va_arg(ap, char *); - asize = va_arg(ap, Size_t); - anint = va_arg(ap, int); + case KEY_gethostbyaddr: + host_addr = va_arg(ap, char *); + asize = va_arg(ap, Size_t); + anint = va_arg(ap, int); /* socklen_t is what Posix 2001 says this should be */ - retptr = gethostbyaddr(host_addr, (socklen_t) asize, anint); break; - case KEY_gethostbyname: - host_name = va_arg(ap, char *); - retptr = gethostbyname(host_name); break; - case KEY_endhostent: - retptr = gethostent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + retptr = gethostbyaddr(host_addr, (socklen_t) asize, anint); break; + case KEY_gethostbyname: + host_name = va_arg(ap, char *); + retptr = gethostbyname(host_name); break; + case KEY_endhostent: + retptr = gethostent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_GRENT_BUFFER @@ -462,35 +462,35 @@ Perl_reentrant_retry(const char *f, ...) case KEY_getgrent: case KEY_getgrgid: case KEY_getgrnam: - { + { char * name; Gid_t gid; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_grent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_grent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_grent_buffer, &PL_reentrant_buffer->_grent_size, char); switch (key) { - case KEY_getgrnam: - name = va_arg(ap, char *); - retptr = getgrnam(name); break; - case KEY_getgrgid: + case KEY_getgrnam: + name = va_arg(ap, char *); + retptr = getgrnam(name); break; + case KEY_getgrgid: # if Gid_t_size < INTSIZE gid = (Gid_t)va_arg(ap, int); # else - gid = va_arg(ap, Gid_t); + gid = va_arg(ap, Gid_t); # endif - retptr = getgrgid(gid); break; - case KEY_getgrent: - retptr = getgrent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + retptr = getgrgid(gid); break; + case KEY_getgrent: + retptr = getgrent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_NETENT_BUFFER @@ -498,14 +498,14 @@ Perl_reentrant_retry(const char *f, ...) case KEY_getnetbyaddr: case KEY_getnetbyname: case KEY_getnetent: - { + { char * name; Netdb_net_t net; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_netent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_netent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_netent_buffer, &PL_reentrant_buffer->_netent_size, char); @@ -522,9 +522,9 @@ Perl_reentrant_retry(const char *f, ...) default: SETERRNO(ERANGE, LIB_INVARG); break; - } - } - break; + } + } + break; # endif # ifdef USE_PWENT_BUFFER @@ -532,66 +532,66 @@ Perl_reentrant_retry(const char *f, ...) case KEY_getpwnam: case KEY_getpwuid: case KEY_getpwent: - { + { Uid_t uid; char * name; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_pwent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_pwent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_pwent_buffer, &PL_reentrant_buffer->_pwent_size, char); switch (key) { - case KEY_getpwnam: - name = va_arg(ap, char *); - retptr = getpwnam(name); break; - case KEY_getpwuid: + case KEY_getpwnam: + name = va_arg(ap, char *); + retptr = getpwnam(name); break; + case KEY_getpwuid: # if Uid_t_size < INTSIZE - uid = (Uid_t)va_arg(ap, int); + uid = (Uid_t)va_arg(ap, int); # else - uid = va_arg(ap, Uid_t); + uid = va_arg(ap, Uid_t); # endif - retptr = getpwuid(uid); break; + retptr = getpwuid(uid); break; # if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R) - case KEY_getpwent: - retptr = getpwent(); break; + case KEY_getpwent: + retptr = getpwent(); break; # endif - default: - SETERRNO(ERANGE, LIB_INVARG); - break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; } - } - break; + } + break; # endif # ifdef USE_SPENT_BUFFER case KEY_getspnam: - { + { char * name; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_spent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_spent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_spent_buffer, &PL_reentrant_buffer->_spent_size, char); switch (key) { - case KEY_getspnam: - name = va_arg(ap, char *); - retptr = getspnam(name); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; + case KEY_getspnam: + name = va_arg(ap, char *); + retptr = getspnam(name); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; } - } - break; + } + break; # endif # ifdef USE_PROTOENT_BUFFER @@ -599,31 +599,31 @@ Perl_reentrant_retry(const char *f, ...) case KEY_getprotobyname: case KEY_getprotobynumber: case KEY_getprotoent: - { + { char * name; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_protoent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_protoent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_protoent_buffer, &PL_reentrant_buffer->_protoent_size, char); switch (key) { - case KEY_getprotobyname: - name = va_arg(ap, char *); - retptr = getprotobyname(name); break; - case KEY_getprotobynumber: - anint = va_arg(ap, int); - retptr = getprotobynumber(anint); break; - case KEY_getprotoent: - retptr = getprotoent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + case KEY_getprotobyname: + name = va_arg(ap, char *); + retptr = getprotobyname(name); break; + case KEY_getprotobynumber: + anint = va_arg(ap, int); + retptr = getprotobynumber(anint); break; + case KEY_getprotoent: + retptr = getprotoent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_SERVENT_BUFFER @@ -631,40 +631,40 @@ Perl_reentrant_retry(const char *f, ...) case KEY_getservbyname: case KEY_getservbyport: case KEY_getservent: - { + { char * name; char * proto; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_servent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_servent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_servent_buffer, &PL_reentrant_buffer->_servent_size, char); switch (key) { - case KEY_getservbyname: - name = va_arg(ap, char *); - proto = va_arg(ap, char *); - retptr = getservbyname(name, proto); break; - case KEY_getservbyport: - anint = va_arg(ap, int); - name = va_arg(ap, char *); - retptr = getservbyport(anint, name); break; - case KEY_getservent: - retptr = getservent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + case KEY_getservbyname: + name = va_arg(ap, char *); + proto = va_arg(ap, char *); + retptr = getservbyname(name, proto); break; + case KEY_getservbyport: + anint = va_arg(ap, int); + name = va_arg(ap, char *); + retptr = getservbyport(anint, name); break; + case KEY_getservent: + retptr = getservent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif default: - /* Not known how to retry, so just fail. */ - break; + /* Not known how to retry, so just fail. */ + break; } #else diff --git a/reentr.h b/reentr.h index 78b851871087..fefb3f065bff 100644 --- a/reentr.h +++ b/reentr.h @@ -653,165 +653,165 @@ typedef struct { # ifdef HAS_ASCTIME_R - char* _asctime_buffer; - size_t _asctime_size; + char* _asctime_buffer; + size_t _asctime_size; # endif /* HAS_ASCTIME_R */ # ifdef HAS_CRYPT_R # if CRYPT_R_PROTO == REENTRANT_PROTO_B_CCD - CRYPTD* _crypt_data; + CRYPTD* _crypt_data; # else - struct crypt_data *_crypt_struct_buffer; + struct crypt_data *_crypt_struct_buffer; # endif # endif /* HAS_CRYPT_R */ # ifdef HAS_CTIME_R - char* _ctime_buffer; - size_t _ctime_size; + char* _ctime_buffer; + size_t _ctime_size; # endif /* HAS_CTIME_R */ # ifdef HAS_GETGRNAM_R - struct group _grent_struct; - char* _grent_buffer; - size_t _grent_size; + struct group _grent_struct; + char* _grent_buffer; + size_t _grent_size; # ifdef USE_GRENT_PTR - struct group* _grent_ptr; + struct group* _grent_ptr; # endif # ifdef USE_GRENT_FPTR - FILE* _grent_fptr; + FILE* _grent_fptr; # endif # endif /* HAS_GETGRNAM_R */ # ifdef HAS_GETHOSTBYNAME_R - struct hostent _hostent_struct; + struct hostent _hostent_struct; # if GETHOSTBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD - struct hostent_data _hostent_data; + struct hostent_data _hostent_data; # else - char* _hostent_buffer; - size_t _hostent_size; + char* _hostent_buffer; + size_t _hostent_size; # endif # ifdef USE_HOSTENT_PTR - struct hostent* _hostent_ptr; + struct hostent* _hostent_ptr; # endif # ifdef USE_HOSTENT_ERRNO - int _hostent_errno; + int _hostent_errno; # endif # endif /* HAS_GETHOSTBYNAME_R */ # ifdef HAS_GETLOGIN_R - char* _getlogin_buffer; - size_t _getlogin_size; + char* _getlogin_buffer; + size_t _getlogin_size; # endif /* HAS_GETLOGIN_R */ # ifdef HAS_GETNETBYNAME_R - struct netent _netent_struct; + struct netent _netent_struct; # if GETNETBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD - struct netent_data _netent_data; + struct netent_data _netent_data; # else - char* _netent_buffer; - size_t _netent_size; + char* _netent_buffer; + size_t _netent_size; # endif # ifdef USE_NETENT_PTR - struct netent* _netent_ptr; + struct netent* _netent_ptr; # endif # ifdef USE_NETENT_ERRNO - int _netent_errno; + int _netent_errno; # endif # endif /* HAS_GETNETBYNAME_R */ # ifdef HAS_GETPROTOBYNAME_R - struct protoent _protoent_struct; + struct protoent _protoent_struct; # if GETPROTOBYNAME_R_PROTO == REENTRANT_PROTO_I_CSD - struct protoent_data _protoent_data; + struct protoent_data _protoent_data; # else - char* _protoent_buffer; - size_t _protoent_size; + char* _protoent_buffer; + size_t _protoent_size; # endif # ifdef USE_PROTOENT_PTR - struct protoent* _protoent_ptr; + struct protoent* _protoent_ptr; # endif # ifdef USE_PROTOENT_ERRNO - int _protoent_errno; + int _protoent_errno; # endif # endif /* HAS_GETPROTOBYNAME_R */ # ifdef HAS_GETPWNAM_R - struct passwd _pwent_struct; - char* _pwent_buffer; - size_t _pwent_size; + struct passwd _pwent_struct; + char* _pwent_buffer; + size_t _pwent_size; # ifdef USE_PWENT_PTR - struct passwd* _pwent_ptr; + struct passwd* _pwent_ptr; # endif # ifdef USE_PWENT_FPTR - FILE* _pwent_fptr; + FILE* _pwent_fptr; # endif # endif /* HAS_GETPWNAM_R */ # ifdef HAS_GETSERVBYNAME_R - struct servent _servent_struct; + struct servent _servent_struct; # if GETSERVBYNAME_R_PROTO == REENTRANT_PROTO_I_CCSD - struct servent_data _servent_data; + struct servent_data _servent_data; # else - char* _servent_buffer; - size_t _servent_size; + char* _servent_buffer; + size_t _servent_size; # endif # ifdef USE_SERVENT_PTR - struct servent* _servent_ptr; + struct servent* _servent_ptr; # endif # ifdef USE_SERVENT_ERRNO - int _servent_errno; + int _servent_errno; # endif # endif /* HAS_GETSERVBYNAME_R */ # ifdef HAS_GETSPNAM_R - struct spwd _spent_struct; - char* _spent_buffer; - size_t _spent_size; + struct spwd _spent_struct; + char* _spent_buffer; + size_t _spent_size; # ifdef USE_SPENT_PTR - struct spwd* _spent_ptr; + struct spwd* _spent_ptr; # endif # ifdef USE_SPENT_FPTR - FILE* _spent_fptr; + FILE* _spent_fptr; # endif # endif /* HAS_GETSPNAM_R */ # ifdef HAS_GMTIME_R - struct tm _gmtime_struct; + struct tm _gmtime_struct; # endif /* HAS_GMTIME_R */ # ifdef HAS_LOCALTIME_R - struct tm _localtime_struct; + struct tm _localtime_struct; # endif /* HAS_LOCALTIME_R */ # ifdef HAS_READDIR_R - struct dirent* _readdir_struct; - size_t _readdir_size; + struct dirent* _readdir_struct; + size_t _readdir_size; # if READDIR_R_PROTO == REENTRANT_PROTO_I_TSR - struct dirent* _readdir_ptr; + struct dirent* _readdir_ptr; # endif # endif /* HAS_READDIR_R */ # ifdef HAS_READDIR64_R - struct dirent64* _readdir64_struct; - size_t _readdir64_size; + struct dirent64* _readdir64_struct; + size_t _readdir64_size; # if READDIR64_R_PROTO == REENTRANT_PROTO_I_TSR - struct dirent64* _readdir64_ptr; + struct dirent64* _readdir64_ptr; # endif # endif /* HAS_READDIR64_R */ # ifdef HAS_SETLOCALE_R - char* _setlocale_buffer; - size_t _setlocale_size; + char* _setlocale_buffer; + size_t _setlocale_size; # endif /* HAS_SETLOCALE_R */ # ifdef HAS_STRERROR_R - char* _strerror_buffer; - size_t _strerror_size; + char* _strerror_buffer; + size_t _strerror_size; # endif /* HAS_STRERROR_R */ # ifdef HAS_TTYNAME_R - char* _ttyname_buffer; - size_t _ttyname_size; + char* _ttyname_buffer; + size_t _ttyname_size; # endif /* HAS_TTYNAME_R */ diff --git a/regcharclass.h b/regcharclass.h index 4ef90f34b97d..2b2c38609dbc 100644 --- a/regcharclass.h +++ b/regcharclass.h @@ -3616,7 +3616,7 @@ * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version - * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * 491175747e1f1e52ce6d6fbcbd7ad75fc5c7a77eec49c0b6fff46fc9a31ca089 regen/regcharclass.pl + * 24120d5e0c9685c442c93bc1dbea9b85ef973bf8e9474baf0e55b160c288226b regen/charset_translations.pl + * 3635c6e564558e965018947bdab45f37d9a4fa82eb05b2694eae1a04bf7e65a3 regen/regcharclass.pl * b2f896452d2b30da3e04800f478c60c1fd0b03d6b668689b020f1e3cf1f1cdd9 regen/regcharclass_multi_char_folds.pl * ex: set ro: */ diff --git a/regen.pl b/regen.pl index b4a6eb54c6d7..71a6eda60a86 100644 --- a/regen.pl +++ b/regen.pl @@ -15,7 +15,7 @@ my $tap = $ARGV[0] && $ARGV[0] eq '--tap' ? '# ' : ''; foreach my $pl (map {chomp; "regen/$_"} ) { - my @command = ($^X, '-I.', '-Ilib', $pl, @ARGV); + my @command = ($^X, '-I.', $pl, @ARGV); print "$tap@command\n"; system @command and die "@command failed: $?" diff --git a/regen/charset_translations.pl b/regen/charset_translations.pl index d2a0014557a7..cb7f801b0721 100644 --- a/regen/charset_translations.pl +++ b/regen/charset_translations.pl @@ -275,21 +275,21 @@ ($$) my $I8_2_utf = get_I8_2_utf($charset); my $len = $ucp < 0xA0 ? 1 : - $ucp < 0x400 ? 2 : - $ucp < 0x4000 ? 3 : - $ucp < 0x40000 ? 4 : - $ucp < 0x400000 ? 5 : - $ucp < 0x4000000 ? 6 : - $ucp < 0x40000000? 7 : + $ucp < 0x400 ? 2 : + $ucp < 0x4000 ? 3 : + $ucp < 0x40000 ? 4 : + $ucp < 0x400000 ? 5 : + $ucp < 0x4000000 ? 6 : + $ucp < 0x40000000? 7 : $CHARSET_TRANSLATIONS::UTF_EBCDIC_MAXBYTES; my @str; - for (1 .. $len - 1) { + for (1 .. $len - 1) { unshift @str, chr $I8_2_utf->[($ucp & 0x1f) | 0xA0]; - $ucp >>= 5; - } + $ucp >>= 5; + } - unshift @str, chr $I8_2_utf->[($ucp & _UTF_START_MASK($len)) | _UTF_START_MARK($len)]; + unshift @str, chr $I8_2_utf->[($ucp & _UTF_START_MASK($len)) | _UTF_START_MARK($len)]; return join "", @str; } diff --git a/regen/embed.pl b/regen/embed.pl index f5db51d51cbb..64a8da3f474c 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -45,7 +45,7 @@ ($) } sub full_name ($$) { # Returns the function name with potentially the - # prefixes 'S_' or 'Perl_' + # prefixes 'S_' or 'Perl_' my ($func, $flags) = @_; return "Perl_$func" if $flags =~ /p/; @@ -57,11 +57,11 @@ sub open_print_header { my ($file, $quote) = @_; return open_new($file, '>', - { file => $file, style => '*', by => 'regen/embed.pl', - from => ['data in embed.fnc', 'regen/embed.pl', - 'regen/opcodes', 'intrpvar.h', 'perlvars.h'], - final => "\nEdit those files and run 'make regen_headers' to effect changes.\n", - copyright => [1993 .. 2009], quote => $quote }); + { file => $file, style => '*', by => 'regen/embed.pl', + from => ['data in embed.fnc', 'regen/embed.pl', + 'regen/opcodes', 'intrpvar.h', 'perlvars.h'], + final => "\nEdit those files and run 'make regen_headers' to effect changes.\n", + copyright => [1993 .. 2009], quote => $quote }); } my ($embed, $core, $ext, $api) = setup_embed(); @@ -73,196 +73,196 @@ sub open_print_header { my $ret; foreach (@$embed) { - if (@$_ == 1) { - print $pr "$_->[0]\n"; - next; - } + if (@$_ == 1) { + print $pr "$_->[0]\n"; + next; + } - my ($flags,$retval,$plain_func,@args) = @$_; + my ($flags,$retval,$plain_func,@args) = @$_; if ($flags =~ / ( [^AabCDdEefFGhIiMmNnOoPpRrSsTUuWXx] ) /x) { - die_at_end "flag $1 is not legal (for function $plain_func)"; - } - my @nonnull; - my $args_assert_line = ( $flags !~ /G/ ); + die_at_end "flag $1 is not legal (for function $plain_func)"; + } + my @nonnull; + my $args_assert_line = ( $flags !~ /G/ ); my $has_depth = ( $flags =~ /W/ ); - my $has_context = ( $flags !~ /T/ ); - my $never_returns = ( $flags =~ /r/ ); - my $binarycompat = ( $flags =~ /b/ ); - my $commented_out = ( $flags =~ /m/ ); - my $is_malloc = ( $flags =~ /a/ ); - my $can_ignore = ( $flags !~ /R/ ) && ( $flags !~ /P/ ) && !$is_malloc; - my @names_of_nn; - my $func; - - if (! $can_ignore && $retval eq 'void') { - warn "It is nonsensical to require the return value of a void function ($plain_func) to be checked"; - } - - die_at_end "$plain_func: S and p flags are mutually exclusive" - if $flags =~ /S/ && $flags =~ /p/; - die_at_end "$plain_func: m and $1 flags are mutually exclusive" - if $flags =~ /m/ && $flags =~ /([pS])/; - - die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/ - && $flags !~ /m/; - - my $static_inline = 0; - if ($flags =~ /([SIi])/) { - my $type; - if ($never_returns) { - $type = { - 'S' => 'PERL_STATIC_NO_RET', - 'i' => 'PERL_STATIC_INLINE_NO_RET', - 'I' => 'PERL_STATIC_FORCE_INLINE_NO_RET' - }->{$1}; - } - else { - $type = { - 'S' => 'STATIC', - 'i' => 'PERL_STATIC_INLINE', - 'I' => 'PERL_STATIC_FORCE_INLINE' - }->{$1}; - } - $retval = "$type $retval"; - die_at_end "Don't declare static function '$plain_func' pure" if $flags =~ /P/; - $static_inline = $type =~ /^PERL_STATIC(?:_FORCE)?_INLINE/; - } - else { - if ($never_returns) { - $retval = "PERL_CALLCONV_NO_RET $retval"; - } - else { - $retval = "PERL_CALLCONV $retval"; - } - } - - die_at_end "For '$plain_func', M flag requires p flag" - if $flags =~ /M/ && $flags !~ /p/; - die_at_end "For '$plain_func', C flag requires one of [pIimb] flags" - if $flags =~ /C/ && $flags !~ /[Iibmp]/; - die_at_end "For '$plain_func', X flag requires one of [Iip] flags" - if $flags =~ /X/ && $flags !~ /[Iip]/; - die_at_end "For '$plain_func', X and m flags are mutually exclusive" - if $flags =~ /X/ && $flags =~ /m/; - die_at_end "For '$plain_func', [Ii] with [ACX] requires p flag" - if $flags =~ /[Ii]/ && $flags =~ /[ACX]/ && $flags !~ /p/; - die_at_end "For '$plain_func', b and m flags are mutually exclusive" - . " (try M flag)" if $flags =~ /b/ && $flags =~ /m/; - die_at_end "For '$plain_func', b flag without M flag requires D flag" - if $flags =~ /b/ && $flags !~ /M/ && $flags !~ /D/; - die_at_end "For '$plain_func', I and i flags are mutually exclusive" - if $flags =~ /I/ && $flags =~ /i/; - - $func = full_name($plain_func, $flags); - $ret = ""; - $ret .= "$retval\t$func("; - if ( $has_context ) { - $ret .= @args ? "pTHX_ " : "pTHX"; - } - if (@args) { - die_at_end "n flag is contradicted by having arguments" - if $flags =~ /n/; - my $n; - for my $arg ( @args ) { - ++$n; - if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) { - warn "$func: $arg needs NN or NULLOK\n"; - ++$unflagged_pointers; - } - my $nn = ( $arg =~ s/\s*\bNN\b\s+// ); - push( @nonnull, $n ) if $nn; - - my $nullok = ( $arg =~ s/\s*\bNULLOK\b\s+// ); # strip NULLOK with no effect - - # Make sure each arg has at least a type and a var name. - # An arg of "int" is valid C, but want it to be "int foo". - my $temp_arg = $arg; - $temp_arg =~ s/\*//g; - $temp_arg =~ s/\s*\bstruct\b\s*/ /g; - if ( ($temp_arg ne "...") - && ($temp_arg !~ /\w+\s+(\w+)(?:\[\d+\])?\s*$/) ) { - die_at_end "$func: $arg ($n) doesn't have a name\n"; - } - if (defined $1 && $nn && !($commented_out && !$binarycompat)) { - push @names_of_nn, $1; - } - } - $ret .= join ", ", @args; - } - else { - $ret .= "void" if !$has_context; - } + my $has_context = ( $flags !~ /T/ ); + my $never_returns = ( $flags =~ /r/ ); + my $binarycompat = ( $flags =~ /b/ ); + my $commented_out = ( $flags =~ /m/ ); + my $is_malloc = ( $flags =~ /a/ ); + my $can_ignore = ( $flags !~ /R/ ) && ( $flags !~ /P/ ) && !$is_malloc; + my @names_of_nn; + my $func; + + if (! $can_ignore && $retval eq 'void') { + warn "It is nonsensical to require the return value of a void function ($plain_func) to be checked"; + } + + die_at_end "$plain_func: S and p flags are mutually exclusive" + if $flags =~ /S/ && $flags =~ /p/; + die_at_end "$plain_func: m and $1 flags are mutually exclusive" + if $flags =~ /m/ && $flags =~ /([pS])/; + + die_at_end "$plain_func: u flag only usable with m" if $flags =~ /u/ + && $flags !~ /m/; + + my $static_inline = 0; + if ($flags =~ /([SIi])/) { + my $type; + if ($never_returns) { + $type = { + 'S' => 'PERL_STATIC_NO_RET', + 'i' => 'PERL_STATIC_INLINE_NO_RET', + 'I' => 'PERL_STATIC_FORCE_INLINE_NO_RET' + }->{$1}; + } + else { + $type = { + 'S' => 'STATIC', + 'i' => 'PERL_STATIC_INLINE', + 'I' => 'PERL_STATIC_FORCE_INLINE' + }->{$1}; + } + $retval = "$type $retval"; + die_at_end "Don't declare static function '$plain_func' pure" if $flags =~ /P/; + $static_inline = $type =~ /^PERL_STATIC(?:_FORCE)?_INLINE/; + } + else { + if ($never_returns) { + $retval = "PERL_CALLCONV_NO_RET $retval"; + } + else { + $retval = "PERL_CALLCONV $retval"; + } + } + + die_at_end "For '$plain_func', M flag requires p flag" + if $flags =~ /M/ && $flags !~ /p/; + die_at_end "For '$plain_func', C flag requires one of [pIimb] flags" + if $flags =~ /C/ && $flags !~ /[Iibmp]/; + die_at_end "For '$plain_func', X flag requires one of [Iip] flags" + if $flags =~ /X/ && $flags !~ /[Iip]/; + die_at_end "For '$plain_func', X and m flags are mutually exclusive" + if $flags =~ /X/ && $flags =~ /m/; + die_at_end "For '$plain_func', [Ii] with [ACX] requires p flag" + if $flags =~ /[Ii]/ && $flags =~ /[ACX]/ && $flags !~ /p/; + die_at_end "For '$plain_func', b and m flags are mutually exclusive" + . " (try M flag)" if $flags =~ /b/ && $flags =~ /m/; + die_at_end "For '$plain_func', b flag without M flag requires D flag" + if $flags =~ /b/ && $flags !~ /M/ && $flags !~ /D/; + die_at_end "For '$plain_func', I and i flags are mutually exclusive" + if $flags =~ /I/ && $flags =~ /i/; + + $func = full_name($plain_func, $flags); + $ret = ""; + $ret .= "$retval\t$func("; + if ( $has_context ) { + $ret .= @args ? "pTHX_ " : "pTHX"; + } + if (@args) { + die_at_end "n flag is contradicted by having arguments" + if $flags =~ /n/; + my $n; + for my $arg ( @args ) { + ++$n; + if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) { + warn "$func: $arg needs NN or NULLOK\n"; + ++$unflagged_pointers; + } + my $nn = ( $arg =~ s/\s*\bNN\b\s+// ); + push( @nonnull, $n ) if $nn; + + my $nullok = ( $arg =~ s/\s*\bNULLOK\b\s+// ); # strip NULLOK with no effect + + # Make sure each arg has at least a type and a var name. + # An arg of "int" is valid C, but want it to be "int foo". + my $temp_arg = $arg; + $temp_arg =~ s/\*//g; + $temp_arg =~ s/\s*\bstruct\b\s*/ /g; + if ( ($temp_arg ne "...") + && ($temp_arg !~ /\w+\s+(\w+)(?:\[\d+\])?\s*$/) ) { + die_at_end "$func: $arg ($n) doesn't have a name\n"; + } + if (defined $1 && $nn && !($commented_out && !$binarycompat)) { + push @names_of_nn, $1; + } + } + $ret .= join ", ", @args; + } + else { + $ret .= "void" if !$has_context; + } $ret .= " _pDEPTH" if $has_depth; - $ret .= ")"; - my @attrs; - if ( $flags =~ /r/ ) { - push @attrs, "__attribute__noreturn__"; - } - if ( $flags =~ /D/ ) { - push @attrs, "__attribute__deprecated__"; - } - if ( $is_malloc ) { - push @attrs, "__attribute__malloc__"; - } - if ( !$can_ignore ) { - push @attrs, "__attribute__warn_unused_result__"; - } - if ( $flags =~ /P/ ) { - push @attrs, "__attribute__pure__"; - } - if ( $flags =~ /I/ ) { - push @attrs, "__attribute__always_inline__"; - } - if( $flags =~ /f/ ) { - my $prefix = $has_context ? 'pTHX_' : ''; - my ($args, $pat); - if ($args[-1] eq '...') { - $args = scalar @args; - $pat = $args - 1; - $args = $prefix . $args; - } - else { - # don't check args, and guess which arg is the pattern - # (one of 'fmt', 'pat', 'f'), - $args = 0; - my @fmts = grep $args[$_] =~ /\b(f|pat|fmt)$/, 0..$#args; - if (@fmts != 1) { - die "embed.pl: '$plain_func': can't determine pattern arg\n"; - } - $pat = $fmts[0] + 1; - } - my $macro = grep($_ == $pat, @nonnull) - ? '__attribute__format__' - : '__attribute__format__null_ok__'; - if ($plain_func =~ /strftime/) { - push @attrs, sprintf "%s(__strftime__,%s1,0)", $macro, $prefix; - } - else { - push @attrs, sprintf "%s(__printf__,%s%d,%s)", $macro, - $prefix, $pat, $args; - } - } - elsif ((grep { $_ eq '...' } @args) && $flags !~ /F/) { - die_at_end "$plain_func: Function with '...' arguments must have" - . " f or F flag"; - } - if ( @attrs ) { - $ret .= "\n"; - $ret .= join( "\n", map { "\t\t\t$_" } @attrs ); - } - $ret .= ";"; - $ret = "/* $ret */" if $commented_out; - - $ret .= "\n#define PERL_ARGS_ASSERT_\U$plain_func\E" - if $args_assert_line || @names_of_nn; - $ret .= "\t\\\n\t" . join '; ', map "assert($_)", @names_of_nn - if @names_of_nn; - - $ret = "#ifndef PERL_NO_INLINE_FUNCTIONS\n$ret\n#endif" if $static_inline; - $ret = "#ifndef NO_MATHOMS\n$ret\n#endif" if $binarycompat; - $ret .= @attrs ? "\n\n" : "\n"; - - print $pr $ret; + $ret .= ")"; + my @attrs; + if ( $flags =~ /r/ ) { + push @attrs, "__attribute__noreturn__"; + } + if ( $flags =~ /D/ ) { + push @attrs, "__attribute__deprecated__"; + } + if ( $is_malloc ) { + push @attrs, "__attribute__malloc__"; + } + if ( !$can_ignore ) { + push @attrs, "__attribute__warn_unused_result__"; + } + if ( $flags =~ /P/ ) { + push @attrs, "__attribute__pure__"; + } + if ( $flags =~ /I/ ) { + push @attrs, "__attribute__always_inline__"; + } + if( $flags =~ /f/ ) { + my $prefix = $has_context ? 'pTHX_' : ''; + my ($args, $pat); + if ($args[-1] eq '...') { + $args = scalar @args; + $pat = $args - 1; + $args = $prefix . $args; + } + else { + # don't check args, and guess which arg is the pattern + # (one of 'fmt', 'pat', 'f'), + $args = 0; + my @fmts = grep $args[$_] =~ /\b(f|pat|fmt)$/, 0..$#args; + if (@fmts != 1) { + die "embed.pl: '$plain_func': can't determine pattern arg\n"; + } + $pat = $fmts[0] + 1; + } + my $macro = grep($_ == $pat, @nonnull) + ? '__attribute__format__' + : '__attribute__format__null_ok__'; + if ($plain_func =~ /strftime/) { + push @attrs, sprintf "%s(__strftime__,%s1,0)", $macro, $prefix; + } + else { + push @attrs, sprintf "%s(__printf__,%s%d,%s)", $macro, + $prefix, $pat, $args; + } + } + elsif ((grep { $_ eq '...' } @args) && $flags !~ /F/) { + die_at_end "$plain_func: Function with '...' arguments must have" + . " f or F flag"; + } + if ( @attrs ) { + $ret .= "\n"; + $ret .= join( "\n", map { "\t\t\t$_" } @attrs ); + } + $ret .= ";"; + $ret = "/* $ret */" if $commented_out; + + $ret .= "\n#define PERL_ARGS_ASSERT_\U$plain_func\E" + if $args_assert_line || @names_of_nn; + $ret .= "\t\\\n\t" . join '; ', map "assert($_)", @names_of_nn + if @names_of_nn; + + $ret = "#ifndef PERL_NO_INLINE_FUNCTIONS\n$ret\n#endif" if $static_inline; + $ret = "#ifndef NO_MATHOMS\n$ret\n#endif" if $binarycompat; + $ret .= @attrs ? "\n\n" : "\n"; + + print $pr $ret; } print $pr <<'EOF'; @@ -282,13 +282,13 @@ sub readvars { local (*FILE, $_); my %seen; open(FILE, '<', $file) - or die "embed.pl: Can't open $file: $!\n"; + or die "embed.pl: Can't open $file: $!\n"; while () { - s/[ \t]*#.*//; # Delete comments. - if (/PERLVARA?I?C?\($pre,\s*(\w+)/) { - die_at_end "duplicate symbol $1 while processing $file line $.\n" - if $seen{$1}++; - } + s/[ \t]*#.*//; # Delete comments. + if (/PERLVARA?I?C?\($pre,\s*(\w+)/) { + die_at_end "duplicate symbol $1 while processing $file line $.\n" + if $seen{$1}++; + } } close(FILE); return sort keys %seen; @@ -334,37 +334,37 @@ sub embed_h { my $lines; foreach (@$funcs) { - if (@$_ == 1) { - my $cond = $_->[0]; - # Indent the conditionals if we are wrapped in an #if/#endif pair. - $cond =~ s/#(.*)/# $1/ if $guard; - $lines .= "$cond\n"; - next; - } - my $ret = ""; - my ($flags,$retval,$func,@args) = @$_; - unless ($flags =~ /[omM]/) { - my $args = scalar @args; - if ($flags =~ /T/) { - my $full_name = full_name($func, $flags); - next if $full_name eq $func; # Don't output a no-op. - $ret = hide($func, $full_name); - } - elsif ($args and $args[$args-1] =~ /\.\.\./) { - if ($flags =~ /p/) { - # we're out of luck for varargs functions under CPP - # So we can only do these macros for no implicit context: - $ret = "#ifndef PERL_IMPLICIT_CONTEXT\n" - . hide($func, full_name($func, $flags)) . "#endif\n"; - } - } - else { - my $alist = join(",", @az[0..$args-1]); - $ret = "#define $func($alist)"; - my $t = int(length($ret) / 8); - $ret .= "\t" x ($t < 4 ? 4 - $t : 1); - $ret .= full_name($func, $flags) . "(aTHX"; - $ret .= "_ " if $alist; + if (@$_ == 1) { + my $cond = $_->[0]; + # Indent the conditionals if we are wrapped in an #if/#endif pair. + $cond =~ s/#(.*)/# $1/ if $guard; + $lines .= "$cond\n"; + next; + } + my $ret = ""; + my ($flags,$retval,$func,@args) = @$_; + unless ($flags =~ /[omM]/) { + my $args = scalar @args; + if ($flags =~ /T/) { + my $full_name = full_name($func, $flags); + next if $full_name eq $func; # Don't output a no-op. + $ret = hide($func, $full_name); + } + elsif ($args and $args[$args-1] =~ /\.\.\./) { + if ($flags =~ /p/) { + # we're out of luck for varargs functions under CPP + # So we can only do these macros for no implicit context: + $ret = "#ifndef PERL_IMPLICIT_CONTEXT\n" + . hide($func, full_name($func, $flags)) . "#endif\n"; + } + } + else { + my $alist = join(",", @az[0..$args-1]); + $ret = "#define $func($alist)"; + my $t = int(length($ret) / 8); + $ret .= "\t" x ($t < 4 ? 4 - $t : 1); + $ret .= full_name($func, $flags) . "(aTHX"; + $ret .= "_ " if $alist; $ret .= $alist; if ($flags =~ /W/) { if ($alist) { @@ -374,10 +374,10 @@ sub embed_h { } } $ret .= ")\n"; - } - $ret = "#ifndef NO_MATHOMS\n$ret#endif\n" if $flags =~ /b/; - } - $lines .= $ret; + } + $ret = "#ifndef NO_MATHOMS\n$ret#endif\n" if $flags =~ /b/; + } + $lines .= $ret; } # Prune empty #if/#endif pairs. while ($lines =~ s/#\s*if[^\n]+\n#\s*endif\n//) { @@ -438,14 +438,14 @@ END { my (%has_va, %has_nocontext); foreach (@$embed) { - next unless @$_ > 1; - ++$has_va{$_->[2]} if $_->[-1] =~ /\.\.\./; - ++$has_nocontext{$1} if $_->[2] =~ /(.*)_nocontext/; + next unless @$_ > 1; + ++$has_va{$_->[2]} if $_->[-1] =~ /\.\.\./; + ++$has_nocontext{$1} if $_->[2] =~ /(.*)_nocontext/; } @nocontext = sort grep { - $has_nocontext{$_} - && !/printf/ # Not clear to me why these are skipped but they are. + $has_nocontext{$_} + && !/printf/ # Not clear to me why these are skipped but they are. } keys %has_va; } @@ -515,11 +515,11 @@ END for $sym (@intrp) { if ($sym eq 'sawampersand') { - print $em "#ifndef PL_sawampersand\n"; + print $em "#ifndef PL_sawampersand\n"; } print $em multon($sym,'I','vTHX->'); if ($sym eq 'sawampersand') { - print $em "#endif\n"; + print $em "#endif\n"; } } diff --git a/regen/embed_lib.pl b/regen/embed_lib.pl index 774b4f25a360..0ef91b2144d7 100644 --- a/regen/embed_lib.pl +++ b/regen/embed_lib.pl @@ -19,8 +19,8 @@ sub current_group { # For embed.fnc, ordering within the && isn't relevant, so we can # sort them to try to group more functions together. foreach (sort @state) { - $group->{$_} ||= {}; - $group = $group->{$_}; + $group->{$_} ||= {}; + $group = $group->{$_}; } return $group->{''} ||= []; } @@ -30,27 +30,27 @@ sub add_level { my $funcs = $level->{''}; my @entries; if ($funcs) { - if (!defined $wanted) { - @entries = @$funcs; - } else { - foreach (@$funcs) { + if (!defined $wanted) { + @entries = @$funcs; + } else { + foreach (@$funcs) { if ($_->[0] =~ /[AC]/) { # 'C' is like 'A' for our purposes # here - push @entries, $_ if $wanted eq 'A'; - } elsif ($_->[0] =~ /E/) { - push @entries, $_ if $wanted eq 'E'; - } else { - push @entries, $_ if $wanted eq ''; - } - } - } - @entries = sort {$a->[2] cmp $b->[2]} @entries; + push @entries, $_ if $wanted eq 'A'; + } elsif ($_->[0] =~ /E/) { + push @entries, $_ if $wanted eq 'E'; + } else { + push @entries, $_ if $wanted eq ''; + } + } + } + @entries = sort {$a->[2] cmp $b->[2]} @entries; } foreach (sort grep {length $_} keys %$level) { - my @conditional = add_level($level->{$_}, $indent . ' ', $wanted); - push @entries, - ["#${indent}if $_"], @conditional, ["#${indent}endif"] - if @conditional; + my @conditional = add_level($level->{$_}, $indent . ' ', $wanted); + push @entries, + ["#${indent}if $_"], @conditional, ["#${indent}endif"] + if @conditional; } return @entries; } @@ -64,31 +64,31 @@ sub setup_embed { my $macro_depth = 0; while () { - chomp; - next if /^:/; - next if /^$/; - while (s|\\$||) { - $_ .= ; - chomp; - } - s/\s+$//; - my @args; - if (/^\s*(#|$)/) { - @args = $_; - } - else { - @args = split /\s*\|\s*/, $_; - } - if (@args == 1) { + chomp; + next if /^:/; + next if /^$/; + while (s|\\$||) { + $_ .= ; + chomp; + } + s/\s+$//; + my @args; + if (/^\s*(#|$)/) { + @args = $_; + } + else { + @args = split /\s*\|\s*/, $_; + } + if (@args == 1) { if ($args[0] !~ /^#\s*(?:if|ifdef|ifndef|else|endif)/) { die "Illegal line $. '$args[0]' in embed.fnc"; } $macro_depth++ if $args[0] =~/^#\s*if(n?def)?\b/; $macro_depth-- if $args[0] =~/^#\s*endif\b/; die "More #endif than #if in embed.fnc:$." if $macro_depth < 0; - } + } else { - die "Illegal line (less than 3 fields) in embed.fnc:$.: $_" + die "Illegal line (less than 3 fields) in embed.fnc:$.: $_" unless @args >= 3; my $name = $args[2]; # only check for duplicates outside of #if's - otherwise @@ -100,7 +100,7 @@ sub setup_embed { $seen{$name} = 1; } - push @embed, \@args; + push @embed, \@args; } die "More #if than #endif by the end of embed.fnc" if $macro_depth != 0; @@ -108,18 +108,18 @@ sub setup_embed { open IN, '<', $prefix . 'regen/opcodes' or die $!; { - my %syms; - - while () { - chomp; - next unless $_; - next if /^#/; - my $check = (split /\t+/, $_)[2]; - next if $syms{$check}++; - - # These are all indirectly referenced by globals.c. - push @embed, ['pR', 'OP *', $check, 'NN OP *o']; - } + my %syms; + + while () { + chomp; + next unless $_; + next if /^#/; + my $check = (split /\t+/, $_)[2]; + next if $syms{$check}++; + + # These are all indirectly referenced by globals.c. + push @embed, ['pR', 'OP *', $check, 'NN OP *o']; + } } close IN or die "Problem reading regen/opcodes: $!"; @@ -133,32 +133,32 @@ sub setup_embed { my $current = current_group(); foreach (@embed) { - if (@$_ > 1) { - push @$current, $_; - next; - } - $_->[0] =~ s/^#\s+/#/; - $_->[0] =~ /^\S*/; - $_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/; - $_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/; - if ($_->[0] =~ /^#if\s*(.*)/) { - push @state, $1; - } elsif ($_->[0] =~ /^#else\s*$/) { - die "Unmatched #else in embed.fnc" unless @state; - $state[-1] = "!($state[-1])"; - } elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) { - die "Unmatched #endif in embed.fnc" unless @state; - pop @state; - } else { - die "Unhandled pre-processor directive '$_->[0]' in embed.fnc"; - } - $current = current_group(); + if (@$_ > 1) { + push @$current, $_; + next; + } + $_->[0] =~ s/^#\s+/#/; + $_->[0] =~ /^\S*/; + $_->[0] =~ s/^#ifdef\s+(\S+)/#if defined($1)/; + $_->[0] =~ s/^#ifndef\s+(\S+)/#if !defined($1)/; + if ($_->[0] =~ /^#if\s*(.*)/) { + push @state, $1; + } elsif ($_->[0] =~ /^#else\s*$/) { + die "Unmatched #else in embed.fnc" unless @state; + $state[-1] = "!($state[-1])"; + } elsif ($_->[0] =~ m!^#endif\s*(?:/\*.*\*/)?$!) { + die "Unmatched #endif in embed.fnc" unless @state; + pop @state; + } else { + die "Unhandled pre-processor directive '$_->[0]' in embed.fnc"; + } + $current = current_group(); } return ([add_level(\%groups, '')], - [add_level(\%groups, '', '')], # core - [add_level(\%groups, '', 'E')], # ext - [add_level(\%groups, '', 'A')]); # api + [add_level(\%groups, '', '')], # core + [add_level(\%groups, '', 'E')], # ext + [add_level(\%groups, '', 'A')]); # api } 1; diff --git a/regen/keywords.pl b/regen/keywords.pl index ffc4882efaba..b9ae8cf0f2fd 100755 --- a/regen/keywords.pl +++ b/regen/keywords.pl @@ -14,11 +14,11 @@ require './regen/regen_lib.pl'; my $h = open_new('keywords.h', '>', - { by => 'regen/keywords.pl', from => 'its data', - file => 'keywords.h', style => '*', - copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]}); + { by => 'regen/keywords.pl', from => 'its data', + file => 'keywords.h', style => '*', + copyright => [1994 .. 1997, 1999 .. 2002, 2005 .. 2007]}); my $c = open_new('keywords.c', '>', - { by => 'regen/keywords.pl', from => 'its data', style => '*'}); + { by => 'regen/keywords.pl', from => 'its data', style => '*'}); my %by_strength; @@ -52,9 +52,9 @@ my %pos = map { ($_ => 1) } @{$by_strength{'+'}}; my $t = Devel::Tokenizer::C->new(TokenFunc => \&perl_keyword, - TokenString => 'name', - StringLength => 'len', - MergeSwitches => 1, + TokenString => 'name', + StringLength => 'len', + MergeSwitches => 1, ); $t->add_tokens(@{$by_strength{'+'}}, @{$by_strength{'-'}}, 'elseif'); diff --git a/regen/lib_cleanup.pl b/regen/lib_cleanup.pl index 5c5c4e24ef60..d80a33ce028f 100644 --- a/regen/lib_cleanup.pl +++ b/regen/lib_cleanup.pl @@ -48,7 +48,7 @@ or die "Can't parse '$file'"; if ($path =~ /\.yml$/) { - next unless $path =~ s!^lib/!!; + next unless $path =~ s!^lib/!!; } elsif ($path =~ /\.pod$/) { unless ($path =~ s!^lib/!!) { # ExtUtils::MakeMaker will install it to a path based on the diff --git a/regen/mg_vtable.pl b/regen/mg_vtable.pl index 019beef99035..ebd34130825f 100644 --- a/regen/mg_vtable.pl +++ b/regen/mg_vtable.pl @@ -121,94 +121,94 @@ BEGIN my %mg = ( sv => { char => "\0", vtable => 'sv', readonly_acceptable => 1, - desc => 'Special scalar variable' }, + desc => 'Special scalar variable' }, # overload, or type "A" magic, used to be here. Hence overloaded is # often called AMAGIC internally, even though it does not use "A" # magic any more. overload_table => { char => 'c', vtable => 'ovrld', - desc => 'Holds overload table (AMT) on stash' }, + desc => 'Holds overload table (AMT) on stash' }, bm => { char => 'B', vtable => 'regexp', value_magic => 1, - readonly_acceptable => 1, - desc => 'Boyer-Moore (fast string search)' }, + readonly_acceptable => 1, + desc => 'Boyer-Moore (fast string search)' }, regdata => { char => 'D', vtable => 'regdata', - desc => "Regex match position data\n(\@+ and \@- vars)" }, + desc => "Regex match position data\n(\@+ and \@- vars)" }, regdatum => { char => 'd', vtable => 'regdatum', - desc => 'Regex match position data element' }, + desc => 'Regex match position data element' }, env => { char => 'E', vtable => 'env', desc => '%ENV hash' }, envelem => { char => 'e', vtable => 'envelem', - desc => '%ENV hash element' }, + desc => '%ENV hash element' }, fm => { char => 'f', vtable => 'regexp', value_magic => 1, - readonly_acceptable => 1, desc => "Formline ('compiled' format)" }, + readonly_acceptable => 1, desc => "Formline ('compiled' format)" }, regex_global => { char => 'g', vtable => 'mglob', value_magic => 1, - readonly_acceptable => 1, desc => 'm//g target' }, + readonly_acceptable => 1, desc => 'm//g target' }, hints => { char => 'H', vtable => 'hints', desc => '%^H hash' }, hintselem => { char => 'h', vtable => 'hintselem', - desc => '%^H hash element' }, + desc => '%^H hash element' }, isa => { char => 'I', vtable => 'isa', desc => '@ISA array' }, isaelem => { char => 'i', vtable => 'isaelem', - desc => '@ISA array element' }, + desc => '@ISA array element' }, nkeys => { char => 'k', vtable => 'nkeys', value_magic => 1, - desc => 'scalar(keys()) lvalue' }, + desc => 'scalar(keys()) lvalue' }, dbfile => { char => 'L', - desc => 'Debugger %_ 'Debugger %_ { char => 'l', vtable => 'dbline', - desc => 'Debugger %_ 'Debugger %_ { char => 'N', desc => 'Shared between threads', - unknown_to_sv_magic => 1 }, + unknown_to_sv_magic => 1 }, shared_scalar => { char => 'n', desc => 'Shared between threads', - unknown_to_sv_magic => 1 }, + unknown_to_sv_magic => 1 }, collxfrm => { char => 'o', vtable => 'collxfrm', value_magic => 1, - desc => 'Locale transformation' }, + desc => 'Locale transformation' }, tied => { char => 'P', vtable => 'pack', - value_magic => 1, # treat as value, so 'local @tied' isn't tied - desc => 'Tied array or hash' }, + value_magic => 1, # treat as value, so 'local @tied' isn't tied + desc => 'Tied array or hash' }, tiedelem => { char => 'p', vtable => 'packelem', - desc => 'Tied array or hash element' }, + desc => 'Tied array or hash element' }, tiedscalar => { char => 'q', vtable => 'packelem', - desc => 'Tied scalar or handle' }, + desc => 'Tied scalar or handle' }, qr => { char => 'r', vtable => 'regexp', value_magic => 1, - readonly_acceptable => 1, desc => 'Precompiled qr// regex' }, + readonly_acceptable => 1, desc => 'Precompiled qr// regex' }, sig => { char => 'S', desc => '%SIG hash' }, sigelem => { char => 's', vtable => 'sigelem', - desc => '%SIG hash element' }, + desc => '%SIG hash element' }, taint => { char => 't', vtable => 'taint', value_magic => 1, - desc => 'Taintedness' }, + desc => 'Taintedness' }, uvar => { char => 'U', vtable => 'uvar', - desc => 'Available for use by extensions' }, + desc => 'Available for use by extensions' }, uvar_elem => { char => 'u', desc => 'Reserved for use by extensions', - unknown_to_sv_magic => 1 }, + unknown_to_sv_magic => 1 }, vec => { char => 'v', vtable => 'vec', value_magic => 1, - desc => 'vec() lvalue' }, + desc => 'vec() lvalue' }, vstring => { char => 'V', value_magic => 1, - desc => 'SV was vstring literal' }, + desc => 'SV was vstring literal' }, utf8 => { char => 'w', vtable => 'utf8', value_magic => 1, - desc => 'Cached UTF-8 information' }, + desc => 'Cached UTF-8 information' }, substr => { char => 'x', vtable => 'substr', value_magic => 1, - desc => 'substr() lvalue' }, + desc => 'substr() lvalue' }, defelem => { char => 'y', vtable => 'defelem', value_magic => 1, - desc => "Shadow \"foreach\" iterator variable /\nsmart parameter vivification" }, + desc => "Shadow \"foreach\" iterator variable /\nsmart parameter vivification" }, nonelem => { char => 'Y', vtable => 'nonelem', value_magic => 1, - desc => "Array element that does not exist" }, + desc => "Array element that does not exist" }, arylen => { char => '#', vtable => 'arylen', value_magic => 1, - desc => 'Array length ($#ary)' }, + desc => 'Array length ($#ary)' }, pos => { char => '.', vtable => 'pos', value_magic => 1, - desc => 'pos() lvalue' }, + desc => 'pos() lvalue' }, backref => { char => '<', vtable => 'backref', value_magic => 1, - readonly_acceptable => 1, desc => 'For weak ref data' }, + readonly_acceptable => 1, desc => 'For weak ref data' }, symtab => { char => ':', value_magic => 1, - desc => 'Extra data for symbol tables' }, + desc => 'Extra data for symbol tables' }, rhash => { char => '%', value_magic => 1, - desc => 'Extra data for restricted hashes' }, + desc => 'Extra data for restricted hashes' }, arylen_p => { char => '@', value_magic => 1, - desc => 'To move arylen out of XPVAV' }, + desc => 'To move arylen out of XPVAV' }, ext => { char => '~', desc => 'Available for use by extensions', - readonly_acceptable => 1 }, + readonly_acceptable => 1 }, checkcall => { char => ']', value_magic => 1, vtable => 'checkcall', - desc => 'Inlining/mutation of call to this CV'}, + desc => 'Inlining/mutation of call to this CV'}, debugvar => { char => '*', desc => '$DB::single, signal, trace vars', - vtable => 'debugvar' }, + vtable => 'debugvar' }, lvref => { char => '\\', vtable => 'lvref', - desc => "Lvalue reference constructor" }, + desc => "Lvalue reference constructor" }, ); @@ -252,7 +252,7 @@ BEGIN 'env' => {set => 'set_all_env', clear => 'clear_all_env'}, 'envelem' => {set => 'setenv', clear => 'clearenv'}, 'sigelem' => {get => 'getsig', set => 'setsig', clear => 'clearsig', - cond => '#ifndef PERL_MICRO'}, + cond => '#ifndef PERL_MICRO'}, 'pack' => {len => 'sizepack', clear => 'wipepack'}, 'packelem' => {get => 'getpack', set => 'setpack', clear => 'clearpack'}, 'dbline' => {set => 'setdbline'}, @@ -279,7 +279,7 @@ BEGIN free => 'freeutf8' }, 'collxfrm' => {set => 'setcollxfrm', free => 'freecollxfrm', - cond => '#ifdef USE_LOCALE_COLLATE'}, + cond => '#ifdef USE_LOCALE_COLLATE'}, 'hintselem' => {set => 'sethint', clear => 'clearhint'}, 'hints' => {clear => 'clearhints'}, 'checkcall' => {copy => 'copycallchecker'}, @@ -296,7 +296,7 @@ BEGIN my ($vt, $raw, $names) = map { open_new($_, '>', - { by => 'regen/mg_vtable.pl', file => $_, style => '*' }); + { by => 'regen/mg_vtable.pl', file => $_, style => '*' }); } 'mg_vtable.h', 'mg_raw.h', 'mg_names.inc'; my $guts = open_new("pod/perlguts.pod", ">"); @@ -323,112 +323,112 @@ BEGIN { my $longest = 0; foreach (keys %mg) { - $longest = length $_ if length $_ > $longest; + $longest = length $_ if length $_ > $longest; } my $longest_p1 = $longest + 1; my %mg_order; while (my ($name, $data) = each %mg) { - my $byte = $data->{char}; - if ($byte =~ /[[:print:]]/) { - $data->{r_char} = $byte; # readable char - ($data->{c_char} = $byte) =~ s/([\\"])/\\$1/g; # for C strings - } - else { - $data->{c_char} = $data->{r_char} = '\\'.ord $byte; - } - $mg_order{(uc $byte) . $byte} = $name; + my $byte = $data->{char}; + if ($byte =~ /[[:print:]]/) { + $data->{r_char} = $byte; # readable char + ($data->{c_char} = $byte) =~ s/([\\"])/\\$1/g; # for C strings + } + else { + $data->{c_char} = $data->{r_char} = '\\'.ord $byte; + } + $mg_order{(uc $byte) . $byte} = $name; } my @rows; my @names; foreach (sort keys %mg_order) { - my $name = $mg_order{$_}; + my $name = $mg_order{$_}; push @names, $name; - my $data = $mg{$name}; - my $i = ord $data->{char}; + my $data = $mg{$name}; + my $i = ord $data->{char}; # add entry to mg_raw.h - unless ($data->{unknown_to_sv_magic}) { - my $value = $data->{vtable} - ? "want_vtbl_$data->{vtable}" : 'magic_vtable_max'; - $value .= ' | PERL_MAGIC_READONLY_ACCEPTABLE' - if $data->{readonly_acceptable}; - $value .= ' | PERL_MAGIC_VALUE_MAGIC' if $data->{value_magic}; - my $comment = "/* $name '$data->{r_char}' $data->{desc} */"; - $comment =~ s/([\\"])/\\$1/g; - $comment =~ tr/\n/ /; - print $raw qq{ { '$data->{c_char}', "$value",\n "$comment" },\n}; - } + unless ($data->{unknown_to_sv_magic}) { + my $value = $data->{vtable} + ? "want_vtbl_$data->{vtable}" : 'magic_vtable_max'; + $value .= ' | PERL_MAGIC_READONLY_ACCEPTABLE' + if $data->{readonly_acceptable}; + $value .= ' | PERL_MAGIC_VALUE_MAGIC' if $data->{value_magic}; + my $comment = "/* $name '$data->{r_char}' $data->{desc} */"; + $comment =~ s/([\\"])/\\$1/g; + $comment =~ tr/\n/ /; + print $raw qq{ { '$data->{c_char}', "$value",\n "$comment" },\n}; + } # add #define PERL_MAGIC_foo entry to vt_table.h - my $comment = $data->{desc}; - my $leader = ' ' x ($longest + 27); - $comment =~ s/\n/\n$leader/s; - printf $vt "#define PERL_MAGIC_%-${longest}s '%s' /* %s */\n", - $name, $data->{c_char}, $comment; + my $comment = $data->{desc}; + my $leader = ' ' x ($longest + 27); + $comment =~ s/\n/\n$leader/s; + printf $vt "#define PERL_MAGIC_%-${longest}s '%s' /* %s */\n", + $name, $data->{c_char}, $comment; # add entry to mg_names.inc - my $char = $data->{r_char}; - $char =~ s/([\\"])/\\$1/g; - printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n], - "$name,", $name, $char; + my $char = $data->{r_char}; + $char =~ s/([\\"])/\\$1/g; + printf $names qq[\t{ PERL_MAGIC_%-${longest_p1}s "%s(%s)" },\n], + "$name,", $name, $char; # construct perlguts.pod entry - push @rows, [(sprintf "%-2s PERL_MAGIC_%s", $data->{r_char},$name), - $data->{vtable} ? "vtbl_$data->{vtable}" : '(none)', - $data->{desc}]; + push @rows, [(sprintf "%-2s PERL_MAGIC_%s", $data->{r_char},$name), + $data->{vtable} ? "vtbl_$data->{vtable}" : '(none)', + $data->{desc}]; } # output @rows to perlguts.pod select +(select($guts), do { - my @header = ('(old-style char and macro)', 'MGVTBL', 'Type of magic'); - my @widths = (0, 0); - foreach my $row (@rows) { - for (0, 1) { - $widths[$_] = length $row->[$_] - if length $row->[$_] > $widths[$_]; - } - } - my $indent = ' '; - my $format - = sprintf "$indent%%-%ds%%-%ds%%s\n", $widths[0] + 1, $widths[1] + 1; - my $desc_wrap = - 79 - 7 - (length $indent) - $widths[0] - $widths[1] - 2; - - open my $oldguts, "<", "pod/perlguts.pod" - or die "$0 cannot open pod/perlguts.pod for reading: $!"; - while (<$oldguts>) { - print; - last if /^=for mg_vtable.pl begin/ - } - - print "\n", $indent . "mg_type\n"; - printf $format, @header; - printf $format, map {'-' x length $_} @header; - foreach (@rows) { - my ($type, $vtbl, $desc) = @$_; - $desc =~ tr/\n/ /; - my @cont; - if (length $desc > $desc_wrap) { - # If it's too long, first split on '(', if there. - # [Which, if there, is always short enough, currently. - # Make this more robust if that changes] - ($desc, @cont) = split /(?=\()/, $desc; - if (!@cont) { - ($desc, @cont) = $desc =~ /(.{1,$desc_wrap})(?: |\z)/g - } - } - printf $format, $type, $vtbl, $desc; - printf $format, '', '', $_ foreach @cont; - } - print "\n\n"; + my @header = ('(old-style char and macro)', 'MGVTBL', 'Type of magic'); + my @widths = (0, 0); + foreach my $row (@rows) { + for (0, 1) { + $widths[$_] = length $row->[$_] + if length $row->[$_] > $widths[$_]; + } + } + my $indent = ' '; + my $format + = sprintf "$indent%%-%ds%%-%ds%%s\n", $widths[0] + 1, $widths[1] + 1; + my $desc_wrap = + 79 - 7 - (length $indent) - $widths[0] - $widths[1] - 2; + + open my $oldguts, "<", "pod/perlguts.pod" + or die "$0 cannot open pod/perlguts.pod for reading: $!"; + while (<$oldguts>) { + print; + last if /^=for mg_vtable.pl begin/ + } + + print "\n", $indent . "mg_type\n"; + printf $format, @header; + printf $format, map {'-' x length $_} @header; + foreach (@rows) { + my ($type, $vtbl, $desc) = @$_; + $desc =~ tr/\n/ /; + my @cont; + if (length $desc > $desc_wrap) { + # If it's too long, first split on '(', if there. + # [Which, if there, is always short enough, currently. + # Make this more robust if that changes] + ($desc, @cont) = split /(?=\()/, $desc; + if (!@cont) { + ($desc, @cont) = $desc =~ /(.{1,$desc_wrap})(?: |\z)/g + } + } + printf $format, $type, $vtbl, $desc; + printf $format, '', '', $_ foreach @cont; + } + print "\n\n"; my $first = 1; for my $magic (sort @names) { @@ -442,10 +442,10 @@ BEGIN } print "\n"; - while (<$oldguts>) { - last if /^=for mg_vtable.pl end/; - } - do { print } while <$oldguts>; + while (<$oldguts>) { + last if /^=for mg_vtable.pl end/; + } + do { print } while <$oldguts>; })[0]; } @@ -503,7 +503,7 @@ BEGIN my $data = $sig{$name}; push @vtable_names, $name; my @funcs = map { - $data->{$_} ? "Perl_magic_$data->{$_}" : 0; + $data->{$_} ? "Perl_magic_$data->{$_}" : 0; } qw(get set len clear free copy dup local); $funcs[0] = "(int (*)(pTHX_ SV *, MAGIC *))" . $funcs[0] if $data->{const}; @@ -520,8 +520,8 @@ BEGIN #endif EOH foreach(@{$data->{alias}}) { - push @aliases, "#define want_vtbl_$_ want_vtbl_$name\n"; - push @vtable_names, $_; + push @aliases, "#define want_vtbl_$_ want_vtbl_$name\n"; + push @vtable_names, $_; } } @@ -542,4 +542,4 @@ BEGIN die "Too many vtable names" if @vtable_names > 63; read_only_bottom_close_and_rename($_) foreach $vt, $raw, $names; - close_and_rename($guts); + close_and_rename($guts); diff --git a/regen/mk_PL_charclass.pl b/regen/mk_PL_charclass.pl index 10802d6ae881..57e3f63c24e3 100644 --- a/regen/mk_PL_charclass.pl +++ b/regen/mk_PL_charclass.pl @@ -282,7 +282,7 @@ sub Punct_and_Symbols { } my $out_fh = open_new('l1_char_class_tab.h', '>', - {style => '*', by => $0, + {style => '*', by => $0, from => "Unicode::UCD"}); print $out_fh <', - {style => '*', by => 'regen/mk_invlists.pl', + {style => '*', by => 'regen/mk_invlists.pl', from => "Unicode::UCD"}); my $in_file_pound_if = ""; @@ -3329,7 +3329,7 @@ ($) } my $uni_pl = open_new('lib/unicore/uni_keywords.pl', '>', - {style => '*', by => 'regen/mk_invlists.pl', + {style => '*', by => 'regen/mk_invlists.pl', from => "Unicode::UCD"}); { print $uni_pl "\%Unicode::UCD::uni_prop_ptrs_indices = (\n"; @@ -3352,7 +3352,7 @@ sub token_name } my $keywords_fh = open_new('uni_keywords.h', '>', - {style => '*', by => 'regen/mk_invlists.pl', + {style => '*', by => 'regen/mk_invlists.pl', from => "mph.pl"}); print $keywords_fh "\n#if defined(PERL_CORE) || defined(PERL_EXT_RE_BUILD)\n\n"; diff --git a/regen/opcode.pl b/regen/opcode.pl index df66201e9ec1..6f631158b9a6 100755 --- a/regen/opcode.pl +++ b/regen/opcode.pl @@ -25,20 +25,20 @@ BEGIN } my $oc = open_new('opcode.h', '>', - {by => 'regen/opcode.pl', from => 'its data', - file => 'opcode.h', style => '*', - copyright => [1993 .. 2007]}); + {by => 'regen/opcode.pl', from => 'its data', + file => 'opcode.h', style => '*', + copyright => [1993 .. 2007]}); my $on = open_new('opnames.h', '>', - { by => 'regen/opcode.pl', from => 'its data', style => '*', - file => 'opnames.h', copyright => [1999 .. 2008] }); + { by => 'regen/opcode.pl', from => 'its data', style => '*', + file => 'opnames.h', copyright => [1999 .. 2008] }); my $oprivpm = open_new('lib/B/Op_private.pm', '>', - { by => 'regen/opcode.pl', + { by => 'regen/opcode.pl', from => "data in\nregen/op_private " ."and pod embedded in regen/opcode.pl", style => '#', - file => 'lib/B/Op_private.pm', + file => 'lib/B/Op_private.pm', copyright => [2014 .. 2014] }); # Read 'opcodes' data. @@ -59,7 +59,7 @@ BEGIN if $seen{$desc} and $key !~ "concat|transr|(?:intro|clone)cv|lvref"; die qq[Opcode "$key" duplicates $seen{$key}\n] if $seen{$key}; die qq[Opcode "freed" is reserved for the slab allocator\n] - if $key eq 'freed'; + if $key eq 'freed'; $seen{$desc} = qq[description of opcode "$key"]; $seen{$key} = qq[opcode "$key"]; @@ -78,84 +78,84 @@ BEGIN # Format is "this function" => "does these op names" my @raw_alias = ( - Perl_do_kv => [qw( keys values )], - Perl_unimplemented_op => [qw(padany custom)], - # All the ops with a body of { return NORMAL; } - Perl_pp_null => [qw(scalar regcmaybe lineseq scope)], - - Perl_pp_goto => ['dump'], - Perl_pp_require => ['dofile'], - Perl_pp_untie => ['dbmclose'], - Perl_pp_sysread => {read => '', recv => '#ifdef HAS_SOCKET'}, - Perl_pp_sysseek => ['seek'], - Perl_pp_ioctl => ['fcntl'], - Perl_pp_ssockopt => {gsockopt => '#ifdef HAS_SOCKET'}, - Perl_pp_getpeername => {getsockname => '#ifdef HAS_SOCKET'}, - Perl_pp_stat => ['lstat'], - Perl_pp_ftrowned => [qw(fteowned ftzero ftsock ftchr ftblk - ftfile ftdir ftpipe ftsuid ftsgid - ftsvtx)], - Perl_pp_fttext => ['ftbinary'], - Perl_pp_gmtime => ['localtime'], - Perl_pp_semget => [qw(shmget msgget)], - Perl_pp_semctl => [qw(shmctl msgctl)], - Perl_pp_ghostent => [qw(ghbyname ghbyaddr)], - Perl_pp_gnetent => [qw(gnbyname gnbyaddr)], - Perl_pp_gprotoent => [qw(gpbyname gpbynumber)], - Perl_pp_gservent => [qw(gsbyname gsbyport)], - Perl_pp_gpwent => [qw(gpwnam gpwuid)], - Perl_pp_ggrent => [qw(ggrnam ggrgid)], - Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)], - Perl_pp_chown => [qw(unlink chmod utime kill)], - Perl_pp_link => ['symlink'], - Perl_pp_ftrread => [qw(ftrwrite ftrexec fteread ftewrite - fteexec)], - Perl_pp_shmwrite => [qw(shmread msgsnd msgrcv semop)], - Perl_pp_syswrite => {send => '#ifdef HAS_SOCKET'}, - Perl_pp_defined => [qw(dor dorassign)], + Perl_do_kv => [qw( keys values )], + Perl_unimplemented_op => [qw(padany custom)], + # All the ops with a body of { return NORMAL; } + Perl_pp_null => [qw(scalar regcmaybe lineseq scope)], + + Perl_pp_goto => ['dump'], + Perl_pp_require => ['dofile'], + Perl_pp_untie => ['dbmclose'], + Perl_pp_sysread => {read => '', recv => '#ifdef HAS_SOCKET'}, + Perl_pp_sysseek => ['seek'], + Perl_pp_ioctl => ['fcntl'], + Perl_pp_ssockopt => {gsockopt => '#ifdef HAS_SOCKET'}, + Perl_pp_getpeername => {getsockname => '#ifdef HAS_SOCKET'}, + Perl_pp_stat => ['lstat'], + Perl_pp_ftrowned => [qw(fteowned ftzero ftsock ftchr ftblk + ftfile ftdir ftpipe ftsuid ftsgid + ftsvtx)], + Perl_pp_fttext => ['ftbinary'], + Perl_pp_gmtime => ['localtime'], + Perl_pp_semget => [qw(shmget msgget)], + Perl_pp_semctl => [qw(shmctl msgctl)], + Perl_pp_ghostent => [qw(ghbyname ghbyaddr)], + Perl_pp_gnetent => [qw(gnbyname gnbyaddr)], + Perl_pp_gprotoent => [qw(gpbyname gpbynumber)], + Perl_pp_gservent => [qw(gsbyname gsbyport)], + Perl_pp_gpwent => [qw(gpwnam gpwuid)], + Perl_pp_ggrent => [qw(ggrnam ggrgid)], + Perl_pp_ftis => [qw(ftsize ftmtime ftatime ftctime)], + Perl_pp_chown => [qw(unlink chmod utime kill)], + Perl_pp_link => ['symlink'], + Perl_pp_ftrread => [qw(ftrwrite ftrexec fteread ftewrite + fteexec)], + Perl_pp_shmwrite => [qw(shmread msgsnd msgrcv semop)], + Perl_pp_syswrite => {send => '#ifdef HAS_SOCKET'}, + Perl_pp_defined => [qw(dor dorassign)], Perl_pp_and => ['andassign'], - Perl_pp_or => ['orassign'], - Perl_pp_ucfirst => ['lcfirst'], - Perl_pp_sle => [qw(slt sgt sge)], - Perl_pp_print => ['say'], - Perl_pp_index => ['rindex'], - Perl_pp_oct => ['hex'], - Perl_pp_shift => ['pop'], - Perl_pp_sin => [qw(cos exp log sqrt)], - Perl_pp_bit_or => ['bit_xor'], - Perl_pp_nbit_or => ['nbit_xor'], - Perl_pp_sbit_or => ['sbit_xor'], - Perl_pp_rv2av => ['rv2hv'], - Perl_pp_akeys => ['avalues'], - Perl_pp_trans => [qw(trans transr)], - Perl_pp_chop => [qw(chop chomp)], - Perl_pp_schop => [qw(schop schomp)], - Perl_pp_bind => {connect => '#ifdef HAS_SOCKET'}, - Perl_pp_preinc => ['i_preinc'], - Perl_pp_predec => ['i_predec'], - Perl_pp_postinc => ['i_postinc'], - Perl_pp_postdec => ['i_postdec'], - Perl_pp_ehostent => [qw(enetent eprotoent eservent - spwent epwent sgrent egrent)], - Perl_pp_shostent => [qw(snetent sprotoent sservent)], - Perl_pp_aelemfast => ['aelemfast_lex'], - Perl_pp_grepstart => ['mapstart'], - ); + Perl_pp_or => ['orassign'], + Perl_pp_ucfirst => ['lcfirst'], + Perl_pp_sle => [qw(slt sgt sge)], + Perl_pp_print => ['say'], + Perl_pp_index => ['rindex'], + Perl_pp_oct => ['hex'], + Perl_pp_shift => ['pop'], + Perl_pp_sin => [qw(cos exp log sqrt)], + Perl_pp_bit_or => ['bit_xor'], + Perl_pp_nbit_or => ['nbit_xor'], + Perl_pp_sbit_or => ['sbit_xor'], + Perl_pp_rv2av => ['rv2hv'], + Perl_pp_akeys => ['avalues'], + Perl_pp_trans => [qw(trans transr)], + Perl_pp_chop => [qw(chop chomp)], + Perl_pp_schop => [qw(schop schomp)], + Perl_pp_bind => {connect => '#ifdef HAS_SOCKET'}, + Perl_pp_preinc => ['i_preinc'], + Perl_pp_predec => ['i_predec'], + Perl_pp_postinc => ['i_postinc'], + Perl_pp_postdec => ['i_postdec'], + Perl_pp_ehostent => [qw(enetent eprotoent eservent + spwent epwent sgrent egrent)], + Perl_pp_shostent => [qw(snetent sprotoent sservent)], + Perl_pp_aelemfast => ['aelemfast_lex'], + Perl_pp_grepstart => ['mapstart'], + ); while (my ($func, $names) = splice @raw_alias, 0, 2) { if (ref $names eq 'ARRAY') { - foreach (@$names) { + foreach (@$names) { $alias{$_} = [$func, '']; - } + } } else { - while (my ($opname, $cond) = each %$names) { + while (my ($opname, $cond) = each %$names) { $alias{$opname} = [$func, $cond]; - } + } } } foreach my $sock_func (qw(socket bind listen accept shutdown - ssockopt getpeername)) { + ssockopt getpeername)) { $alias{$sock_func} = ["Perl_pp_$sock_func", '#ifdef HAS_SOCKET'], } @@ -927,31 +927,31 @@ package main; my @unimplemented; sub unimplemented { - if (@unimplemented) { - print $oc "#else\n"; - foreach (@unimplemented) { - print $oc "#define $_ Perl_unimplemented_op\n"; - } - print $oc "#endif\n"; - @unimplemented = (); - } + if (@unimplemented) { + print $oc "#else\n"; + foreach (@unimplemented) { + print $oc "#define $_ Perl_unimplemented_op\n"; + } + print $oc "#endif\n"; + @unimplemented = (); + } } for (@ops) { - my ($impl, $cond) = @{$alias{$_} || ["Perl_pp_$_", '']}; - my $op_func = "Perl_pp_$_"; - - if ($cond ne $last_cond) { - # A change in condition. (including to or from no condition) - unimplemented(); - $last_cond = $cond; - if ($last_cond) { - print $oc "$last_cond\n"; - } - } - push @unimplemented, $op_func if $last_cond; - print $oc "#define $op_func $impl\n" if $impl ne $op_func; + my ($impl, $cond) = @{$alias{$_} || ["Perl_pp_$_", '']}; + my $op_func = "Perl_pp_$_"; + + if ($cond ne $last_cond) { + # A change in condition. (including to or from no condition) + unimplemented(); + $last_cond = $cond; + if ($last_cond) { + print $oc "$last_cond\n"; + } + } + push @unimplemented, $op_func if $last_cond; + print $oc "#define $op_func $impl\n" if $impl ne $op_func; } # If the last op was conditional, we need to close it out: unimplemented(); @@ -985,7 +985,7 @@ END } print $oc <<'END'; - "freed", + "freed", }; #endif @@ -1005,7 +1005,7 @@ END } print $oc <<'END'; - "freed op", + "freed op", }; #endif @@ -1027,10 +1027,10 @@ END my $op_func = "Perl_pp_$_"; my $name = $alias{$_}; if ($name && $name->[0] ne $op_func) { - print $oc "\t$op_func,\t/* implemented by $name->[0] */\n"; + print $oc "\t$op_func,\t/* implemented by $name->[0] */\n"; } else { - print $oc "\t$op_func,\n"; + print $oc "\t$op_func,\n"; } } @@ -1118,40 +1118,40 @@ END my $argsum = 0; my $flags = $flags{$op}; for my $flag (keys %opflags) { - if ($flags =~ s/$flag//) { - die "Flag collision for '$op' ($flags{$op}, $flag)\n" - if $argsum & $opflags{$flag}; - $argsum |= $opflags{$flag}; - } + if ($flags =~ s/$flag//) { + die "Flag collision for '$op' ($flags{$op}, $flag)\n" + if $argsum & $opflags{$flag}; + $argsum |= $opflags{$flag}; + } } die qq[Opcode '$op' has no class indicator ($flags{$op} => $flags)\n] - unless exists $opclass{$flags}; + unless exists $opclass{$flags}; $argsum |= $opclass{$flags} << $OCSHIFT; my $argshift = $OASHIFT; for my $arg (split(' ',$args{$op})) { - if ($arg =~ s/^D//) { - # handle 1st, just to put D 1st. - $OP_IS_DIRHOP{$op} = $opnum{$op}; - } - if ($arg =~ /^F/) { - # record opnums of these opnames - $OP_IS_SOCKET{$op} = $opnum{$op} if $arg =~ s/s//; - $OP_IS_FILETEST{$op} = $opnum{$op} if $arg =~ s/-//; - $OP_IS_FT_ACCESS{$op} = $opnum{$op} if $arg =~ s/\+//; + if ($arg =~ s/^D//) { + # handle 1st, just to put D 1st. + $OP_IS_DIRHOP{$op} = $opnum{$op}; + } + if ($arg =~ /^F/) { + # record opnums of these opnames + $OP_IS_SOCKET{$op} = $opnum{$op} if $arg =~ s/s//; + $OP_IS_FILETEST{$op} = $opnum{$op} if $arg =~ s/-//; + $OP_IS_FT_ACCESS{$op} = $opnum{$op} if $arg =~ s/\+//; + } + elsif ($arg =~ /^S./) { + $OP_IS_NUMCOMPARE{$op} = $opnum{$op} if $arg =~ s/= $ARGBITS || - $argnum > ((1 << ($ARGBITS - $argshift)) - 1); - $argsum += $argnum << $argshift; - $argshift += 4; + unless exists $argnum{$arg}; + $argnum += $argnum{$arg}; + die "Argument overflow for '$op'\n" + if $argshift >= $ARGBITS || + $argnum > ((1 << ($ARGBITS - $argshift)) - 1); + $argsum += $argnum << $argshift; + $argshift += 4; } $argsum = sprintf("0x%08x", $argsum); print $oc "\t", tab(3, "$argsum,"), "/* $op */\n"; @@ -1184,41 +1184,41 @@ END sub gen_op_is_macro { my ($op_is, $macname) = @_; if (keys %$op_is) { - - # get opnames whose numbers are lowest and highest - my ($first, @rest) = sort { - $op_is->{$a} <=> $op_is->{$b} - } keys %$op_is; - - my $last = pop @rest; # @rest slurped, get its last - die "Invalid range of ops: $first .. $last\n" unless $last; - - print $on "\n#define $macname(op) \\\n\t("; - - # verify that op-ct matches 1st..last range (and fencepost) - # (we know there are no dups) - if ( $op_is->{$last} - $op_is->{$first} == scalar @rest + 1) { - - # contiguous ops -> optimized version - print $on "(op) >= OP_" . uc($first) - . " && (op) <= OP_" . uc($last); - } - else { - print $on join(" || \\\n\t ", - map { "(op) == OP_" . uc() } sort keys %$op_is); - } - print $on ")\n"; + + # get opnames whose numbers are lowest and highest + my ($first, @rest) = sort { + $op_is->{$a} <=> $op_is->{$b} + } keys %$op_is; + + my $last = pop @rest; # @rest slurped, get its last + die "Invalid range of ops: $first .. $last\n" unless $last; + + print $on "\n#define $macname(op) \\\n\t("; + + # verify that op-ct matches 1st..last range (and fencepost) + # (we know there are no dups) + if ( $op_is->{$last} - $op_is->{$first} == scalar @rest + 1) { + + # contiguous ops -> optimized version + print $on "(op) >= OP_" . uc($first) + . " && (op) <= OP_" . uc($last); + } + else { + print $on join(" || \\\n\t ", + map { "(op) == OP_" . uc() } sort keys %$op_is); + } + print $on ")\n"; } } my $pp = open_new('pp_proto.h', '>', - { by => 'opcode.pl', from => 'its data' }); + { by => 'opcode.pl', from => 'its data' }); { my %funcs; for (@ops) { - my $name = $alias{$_} ? $alias{$_}[0] : "Perl_pp_$_"; - ++$funcs{$name}; + my $name = $alias{$_} ? $alias{$_}[0] : "Perl_pp_$_"; + ++$funcs{$name}; } print $pp "PERL_CALLCONV OP *$_(pTHX);\n" foreach sort keys %funcs; } diff --git a/regen/overload.pl b/regen/overload.pl index 38dac323c0bc..cbd01b5d1b54 100644 --- a/regen/overload.pl +++ b/regen/overload.pl @@ -32,14 +32,14 @@ BEGIN my ($c, $h) = map { open_new($_, '>', - { by => 'regen/overload.pl', file => $_, style => '*', - copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] }); + { by => 'regen/overload.pl', file => $_, style => '*', + copyright => [1997, 1998, 2000, 2001, 2005 .. 2007, 2011] }); } 'overload.inc', 'overload.h'; mkdir("lib/overload", 0777) unless -d 'lib/overload'; my $p = open_new('lib/overload/numbers.pm', '>', - { by => 'regen/overload.pl', - file => 'lib/overload/numbers.pm', copyright => [2008] }); + { by => 'regen/overload.pl', + file => 'lib/overload/numbers.pm', copyright => [2008] }); { local $" = "\n "; @@ -70,7 +70,7 @@ package overload::numbers; my $l = 3 - int((length($enums[$_]) + 9) / 8); $l = 1 if $l < 1; printf $h " %s_amg,%s/* 0x%02x %-8s */\n", $enums[$_], - ("\t" x $l), $_, $op; + ("\t" x $l), $_, $op; } print $h <<'EOF'; diff --git a/regen/reentr.pl b/regen/reentr.pl index 9d93fdf1fff5..5742278fe99c 100644 --- a/regen/reentr.pl +++ b/regen/reentr.pl @@ -27,16 +27,16 @@ BEGIN getopts('Uv', \%opts); my %map = ( - V => "void", - A => "char*", # as an input argument - B => "char*", # as an output argument - C => "const char*", # as a read-only input argument - I => "int", - L => "long", - W => "size_t", - H => "FILE**", - E => "int*", - ); + V => "void", + A => "char*", # as an input argument + B => "char*", # as an output argument + C => "const char*", # as a read-only input argument + I => "int", + L => "long", + W => "size_t", + H => "FILE**", + E => "int*", + ); # (See the definitions after __DATA__.) # In func|inc|type|... a "S" means "type*", and a "R" means "type**". @@ -53,11 +53,11 @@ BEGIN sub open_print_header { my ($file, $quote) = @_; return open_new($file, '>', - { by => 'regen/reentr.pl', - from => 'data in regen/reentr.pl', - file => $file, style => '*', - copyright => [2002, 2003, 2005 .. 2007], - quote => $quote }); + { by => 'regen/reentr.pl', + from => 'data in regen/reentr.pl', + file => $file, style => '*', + copyright => [2002, 2003, 2005 .. 2007], + quote => $quote }); } my $h = open_print_header('reentr.h'); @@ -204,17 +204,17 @@ sub open_print_header { push @seenf, $func; my %m = %map; if ($type) { - $m{S} = "$type*"; - $m{R} = "$type**"; + $m{S} = "$type*"; + $m{R} = "$type**"; } # Set any special mapping variables (like X=x_t) if (@p) { - while ($p[-1] =~ /=/) { - my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/); - $m{$k} = $v; - pop @p; - } + while ($p[-1] =~ /=/) { + my ($k, $v) = ($p[-1] =~ /^([A-Za-z])\s*=\s*(.*)/); + $m{$k} = $v; + pop @p; + } } # If given the -U option open up the metaconfig unit for this function. @@ -223,24 +223,24 @@ sub open_print_header { } if ($opts{U}) { - # The metaconfig units needs prerequisite dependencies. - my $prereqs = ''; - my $prereqh = ''; - my $prereqsh = ''; - if ($hdr ne 'stdio') { # There's no i_stdio. - $prereqs = "i_$hdr"; - $prereqh = "$hdr.h"; - $prereqsh = "\$$prereqs $prereqh"; - } - my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads); - push @prereq, $prereqs; + # The metaconfig units needs prerequisite dependencies. + my $prereqs = ''; + my $prereqh = ''; + my $prereqsh = ''; + if ($hdr ne 'stdio') { # There's no i_stdio. + $prereqs = "i_$hdr"; + $prereqh = "$hdr.h"; + $prereqsh = "\$$prereqs $prereqh"; + } + my @prereq = qw(Inlibc Protochk Hasproto i_systypes usethreads); + push @prereq, $prereqs; my $hdrs = "\$i_systypes sys/types.h define stdio.h $prereqsh"; if ($hdr eq 'time') { - $hdrs .= " \$i_systime sys/time.h"; - push @prereq, 'i_systime'; - } - # Output the metaconfig unit header. - print U <<"EOF"; + $hdrs .= " \$i_systime sys/time.h"; + push @prereq, 'i_systime'; + } + # Output the metaconfig unit header. + print U <<"EOF"; ?RCS: \$Id: d_${func}_r.U,v $ ?RCS: ?RCS: Copyright (c) 2002,2003 Jarkko Hietaniemi @@ -285,27 +285,27 @@ sub open_print_header { case "\$d_${func}_r" in "\$define") EOF - print U <<"EOF"; - hdrs="$hdrs" - case "\$d_${func}_r_proto:\$usethreads" in - ":define") d_${func}_r_proto=define - set d_${func}_r_proto ${func}_r \$hdrs - eval \$hasproto ;; - *) ;; - esac - case "\$d_${func}_r_proto" in - define) + print U <<"EOF"; + hdrs="$hdrs" + case "\$d_${func}_r_proto:\$usethreads" in + ":define") d_${func}_r_proto=define + set d_${func}_r_proto ${func}_r \$hdrs + eval \$hasproto ;; + *) ;; + esac + case "\$d_${func}_r_proto" in + define) EOF } for my $p (@p) { my ($r, $a) = ($p =~ /^(.)_(.+)/); - my $v = join(", ", map { $m{$_} } split '', $a); - if ($opts{U}) { - print U <<"EOF"; - case "\$${func}_r_proto" in - ''|0) try='$m{$r} ${func}_r($v);' - ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;; - esac + my $v = join(", ", map { $m{$_} } split '', $a); + if ($opts{U}) { + print U <<"EOF"; + case "\$${func}_r_proto" in + ''|0) try='$m{$r} ${func}_r($v);' + ./protochk "extern \$try" \$hdrs && ${func}_r_proto=$p ;; + esac EOF } $seenh{$func}->{$p}++; @@ -314,35 +314,35 @@ sub open_print_header { $seent{$func} = $type; $seens{$func} = $m{S}; $seend{$func} = $m{D}; - $seenm{$func} = \%m; + $seenm{$func} = \%m; } if ($opts{U}) { - print U <<"EOF"; - case "\$${func}_r_proto" in - ''|0) d_${func}_r=undef + print U <<"EOF"; + case "\$${func}_r_proto" in + ''|0) d_${func}_r=undef ${func}_r_proto=0 - echo "Disabling ${func}_r, cannot determine prototype." >&4 ;; - * ) case "\$${func}_r_proto" in - REENTRANT_PROTO*) ;; - *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;; - esac - echo "Prototype: \$try" ;; - esac - ;; - *) case "\$usethreads" in - define) echo "${func}_r has no prototype, not using it." >&4 ;; - esac - d_${func}_r=undef - ${func}_r_proto=0 - ;; - esac - ;; + echo "Disabling ${func}_r, cannot determine prototype." >&4 ;; + * ) case "\$${func}_r_proto" in + REENTRANT_PROTO*) ;; + *) ${func}_r_proto="REENTRANT_PROTO_\$${func}_r_proto" ;; + esac + echo "Prototype: \$try" ;; + esac + ;; + *) case "\$usethreads" in + define) echo "${func}_r has no prototype, not using it." >&4 ;; + esac + d_${func}_r=undef + ${func}_r_proto=0 + ;; + esac + ;; *) ${func}_r_proto=0 - ;; + ;; esac EOF - close(U); + close(U); } } @@ -352,8 +352,8 @@ sub open_print_header { # Write out all the known prototype signatures. my $i = 1; for my $p (sort keys %seenp) { - print $h "# define REENTRANT_PROTO_${p} ${i}\n"; - $i++; + print $h "# define REENTRANT_PROTO_${p} ${i}\n"; + $i++; } } @@ -379,10 +379,10 @@ sub pushssif { sub pushinitfree { my $func = shift; push @init, <_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); + Newx(PL_reentrant_buffer->_${func}_buffer, PL_reentrant_buffer->_${func}_size, char); EOF push @free, <_${func}_buffer); + Safefree(PL_reentrant_buffer->_${func}_buffer); EOF } @@ -396,18 +396,18 @@ sub define { EOF my $GENFUNC; for my $func (@F) { - my $FUNC = uc $func; - my $HAS = "${FUNC}_R_HAS_$n"; - push @H, $HAS; - my @h = grep { /$p/ } @{$seena{$func}}; - unless (defined $GENFUNC) { - $GENFUNC = $FUNC; - $GENFUNC =~ s/^GET//; - } - if (@h) { - push @define, "# if defined(HAS_${FUNC}_R) && (" . join(" || ", map { "${FUNC}_R_PROTO == REENTRANT_PROTO_$_" } @h) . ")\n"; - - push @define, <_${func}_size = $size; + push @size, <_${func}_size = $size; EOF - pushinitfree $func; - pushssif $endif; - } - elsif ($func =~ /^(gm|local)time$/) { - pushssif $ifdef; - push @struct, <_${func}_struct_buffer = 0; + PL_reentrant_buffer->_${func}_struct_buffer = 0; # endif EOF push @free, <_${func}_struct_buffer); + Safefree(PL_reentrant_buffer->_${func}_struct_buffer); # endif EOF - pushssif $endif; - } + pushssif $endif; + } elsif ($func =~ /^(getgrnam|getpwnam|getspnam)$/) { - pushssif $ifdef; - # 'genfunc' can be read either as 'generic' or 'genre', - # it represents a group of functions. - my $genfunc = $func; - $genfunc =~ s/nam/ent/g; - $genfunc =~ s/^get//; - my $GENFUNC = uc $genfunc; - push @struct, <_${genfunc}_fptr = NULL; + PL_reentrant_buffer->_${genfunc}_fptr = NULL; # endif EOF - my $sc = $genfunc eq 'grent' ? - '_SC_GETGR_R_SIZE_MAX' : '_SC_GETPW_R_SIZE_MAX'; - my $sz = "_${genfunc}_size"; - push @size, <$sz = sysconf($sc); - if (PL_reentrant_buffer->$sz == (size_t) -1) - PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; + PL_reentrant_buffer->$sz = sysconf($sc); + if (PL_reentrant_buffer->$sz == (size_t) -1) + PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # elif defined(__osf__) && defined(__alpha) && defined(SIABUFSIZ) - PL_reentrant_buffer->$sz = SIABUFSIZ; + PL_reentrant_buffer->$sz = SIABUFSIZ; # elif defined(__sgi) - PL_reentrant_buffer->$sz = BUFSIZ; + PL_reentrant_buffer->$sz = BUFSIZ; # else - PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; + PL_reentrant_buffer->$sz = REENTRANTUSUALSIZE; # endif EOF - pushinitfree $genfunc; - pushssif $endif; - } + pushinitfree $genfunc; + pushssif $endif; + } elsif ($func =~ /^(gethostbyname|getnetbyname|getservbyname|getprotobyname)$/) { - pushssif $ifdef; - my $genfunc = $func; - $genfunc =~ s/byname/ent/; - $genfunc =~ s/^get//; - my $GENFUNC = uc $genfunc; - my $D = ifprotomatch($FUNC, grep {/D/} @p); - my $d = $seend{$func}; - $d =~ s/\*$//; # snip: we need the base type. - push @struct, <_${genfunc}_size = REENTRANTUSUALSIZE; + PL_reentrant_buffer->_${genfunc}_size = REENTRANTUSUALSIZE; # endif EOF - push @init, <_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); + Newx(PL_reentrant_buffer->_${genfunc}_buffer, PL_reentrant_buffer->_${genfunc}_size, char); # endif EOF - push @free, <_${genfunc}_buffer); + Safefree(PL_reentrant_buffer->_${genfunc}_buffer); # endif EOF - pushssif $endif; - } + pushssif $endif; + } elsif ($func =~ /^(readdir|readdir64)$/) { - pushssif $ifdef; - my $R = ifprotomatch($FUNC, grep {/R/} @p); - push @struct, <_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; + push @size, <_${func}_size = sizeof($seent{$func}) + MAXPATHLEN + 1; EOF push @init, <_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size); + PL_reentrant_buffer->_${func}_struct = ($seent{$func}*)safemalloc(PL_reentrant_buffer->_${func}_size); EOF - push @free, <_${func}_struct); + push @free, <_${func}_struct); EOF - pushssif $endif; - } + pushssif $endif; + } - push @wrap, $ifdef; + push @wrap, $ifdef; - push @wrap, <_${genfunc}_ptr" : $_ eq 'E' @@ -701,13 +701,13 @@ sub define { : "&PL_reentrant_buffer->_${genfunc}_struct") : $_ } split '', $b; - $w = ", $w" if length $v; - } + $w = ", $w" if length $v; + } # This needs a special case, see its definition in config.h my $setup = ($func eq 'localtime') ? "L_R_TZSET " : ""; - my $call = "$setup${func}_r($v$w)"; + my $call = "$setup${func}_r($v$w)"; # Must make OpenBSD happy my $memzero = ''; @@ -715,46 +715,46 @@ sub define { ($genfunc eq 'protoent' || $genfunc eq 'servent')) { $memzero = 'REENTR_MEMZERO(&PL_reentrant_buffer->_' . $genfunc . '_data, sizeof(PL_reentrant_buffer->_' . $genfunc . '_data)),'; } - push @wrap, <_hostent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_hostent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_hostent_buffer, &PL_reentrant_buffer->_hostent_size, char); switch (key) { - case KEY_gethostbyaddr: - host_addr = va_arg(ap, char *); - asize = va_arg(ap, Size_t); - anint = va_arg(ap, int); + case KEY_gethostbyaddr: + host_addr = va_arg(ap, char *); + asize = va_arg(ap, Size_t); + anint = va_arg(ap, int); /* socklen_t is what Posix 2001 says this should be */ - retptr = gethostbyaddr(host_addr, (socklen_t) asize, anint); break; - case KEY_gethostbyname: - host_name = va_arg(ap, char *); - retptr = gethostbyname(host_name); break; - case KEY_endhostent: - retptr = gethostent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + retptr = gethostbyaddr(host_addr, (socklen_t) asize, anint); break; + case KEY_gethostbyname: + host_name = va_arg(ap, char *); + retptr = gethostbyname(host_name); break; + case KEY_endhostent: + retptr = gethostent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_GRENT_BUFFER @@ -964,35 +964,35 @@ sub define { case KEY_getgrent: case KEY_getgrgid: case KEY_getgrnam: - { + { char * name; Gid_t gid; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_grent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_grent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_grent_buffer, &PL_reentrant_buffer->_grent_size, char); switch (key) { - case KEY_getgrnam: - name = va_arg(ap, char *); - retptr = getgrnam(name); break; - case KEY_getgrgid: + case KEY_getgrnam: + name = va_arg(ap, char *); + retptr = getgrnam(name); break; + case KEY_getgrgid: # if Gid_t_size < INTSIZE gid = (Gid_t)va_arg(ap, int); # else - gid = va_arg(ap, Gid_t); + gid = va_arg(ap, Gid_t); # endif - retptr = getgrgid(gid); break; - case KEY_getgrent: - retptr = getgrent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + retptr = getgrgid(gid); break; + case KEY_getgrent: + retptr = getgrent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_NETENT_BUFFER @@ -1000,14 +1000,14 @@ sub define { case KEY_getnetbyaddr: case KEY_getnetbyname: case KEY_getnetent: - { + { char * name; Netdb_net_t net; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_netent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_netent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_netent_buffer, &PL_reentrant_buffer->_netent_size, char); @@ -1024,9 +1024,9 @@ sub define { default: SETERRNO(ERANGE, LIB_INVARG); break; - } - } - break; + } + } + break; # endif # ifdef USE_PWENT_BUFFER @@ -1034,66 +1034,66 @@ sub define { case KEY_getpwnam: case KEY_getpwuid: case KEY_getpwent: - { + { Uid_t uid; char * name; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_pwent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_pwent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_pwent_buffer, &PL_reentrant_buffer->_pwent_size, char); switch (key) { - case KEY_getpwnam: - name = va_arg(ap, char *); - retptr = getpwnam(name); break; - case KEY_getpwuid: + case KEY_getpwnam: + name = va_arg(ap, char *); + retptr = getpwnam(name); break; + case KEY_getpwuid: # if Uid_t_size < INTSIZE - uid = (Uid_t)va_arg(ap, int); + uid = (Uid_t)va_arg(ap, int); # else - uid = va_arg(ap, Uid_t); + uid = va_arg(ap, Uid_t); # endif - retptr = getpwuid(uid); break; + retptr = getpwuid(uid); break; # if defined(HAS_GETPWENT) || defined(HAS_GETPWENT_R) - case KEY_getpwent: - retptr = getpwent(); break; + case KEY_getpwent: + retptr = getpwent(); break; # endif - default: - SETERRNO(ERANGE, LIB_INVARG); - break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; } - } - break; + } + break; # endif # ifdef USE_SPENT_BUFFER case KEY_getspnam: - { + { char * name; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_spent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_spent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_spent_buffer, &PL_reentrant_buffer->_spent_size, char); switch (key) { - case KEY_getspnam: - name = va_arg(ap, char *); - retptr = getspnam(name); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; + case KEY_getspnam: + name = va_arg(ap, char *); + retptr = getspnam(name); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; } - } - break; + } + break; # endif # ifdef USE_PROTOENT_BUFFER @@ -1101,31 +1101,31 @@ sub define { case KEY_getprotobyname: case KEY_getprotobynumber: case KEY_getprotoent: - { + { char * name; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_protoent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_protoent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_protoent_buffer, &PL_reentrant_buffer->_protoent_size, char); switch (key) { - case KEY_getprotobyname: - name = va_arg(ap, char *); - retptr = getprotobyname(name); break; - case KEY_getprotobynumber: - anint = va_arg(ap, int); - retptr = getprotobynumber(anint); break; - case KEY_getprotoent: - retptr = getprotoent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + case KEY_getprotobyname: + name = va_arg(ap, char *); + retptr = getprotobyname(name); break; + case KEY_getprotobynumber: + anint = va_arg(ap, int); + retptr = getprotobynumber(anint); break; + case KEY_getprotoent: + retptr = getprotoent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif # ifdef USE_SERVENT_BUFFER @@ -1133,40 +1133,40 @@ sub define { case KEY_getservbyname: case KEY_getservbyport: case KEY_getservent: - { + { char * name; char * proto; int anint; # ifdef PERL_REENTRANT_MAXSIZE - if (PL_reentrant_buffer->_servent_size <= - PERL_REENTRANT_MAXSIZE / 2) + if (PL_reentrant_buffer->_servent_size <= + PERL_REENTRANT_MAXSIZE / 2) # endif RenewDouble(PL_reentrant_buffer->_servent_buffer, &PL_reentrant_buffer->_servent_size, char); switch (key) { - case KEY_getservbyname: - name = va_arg(ap, char *); - proto = va_arg(ap, char *); - retptr = getservbyname(name, proto); break; - case KEY_getservbyport: - anint = va_arg(ap, int); - name = va_arg(ap, char *); - retptr = getservbyport(anint, name); break; - case KEY_getservent: - retptr = getservent(); break; - default: - SETERRNO(ERANGE, LIB_INVARG); - break; - } - } - break; + case KEY_getservbyname: + name = va_arg(ap, char *); + proto = va_arg(ap, char *); + retptr = getservbyname(name, proto); break; + case KEY_getservbyport: + anint = va_arg(ap, int); + name = va_arg(ap, char *); + retptr = getservbyport(anint, name); break; + case KEY_getservent: + retptr = getservent(); break; + default: + SETERRNO(ERANGE, LIB_INVARG); + break; + } + } + break; # endif default: - /* Not known how to retry, so just fail. */ - break; + /* Not known how to retry, so just fail. */ + break; } #else diff --git a/regen/regcharclass.pl b/regen/regcharclass.pl index 852ea0d3e8ad..76b1532047d6 100755 --- a/regen/regcharclass.pl +++ b/regen/regcharclass.pl @@ -1375,11 +1375,11 @@ sub make_macro { if ( $path eq '-' ) { $out_fh= \*STDOUT; } else { - $out_fh = open_new( $path ); + $out_fh = open_new( $path ); } print $out_fh read_only_top( lang => 'C', by => $0, - file => 'regcharclass.h', style => '*', - copyright => [2007, 2011], + file => 'regcharclass.h', style => '*', + copyright => [2007, 2011], final => <') { - if (-f $name) { - unlink $name or die "$name exists but can't unlink: $!"; - } - open $fh, '>', $name or die "Can't create $name: $!"; + if (-f $name) { + unlink $name or die "$name exists but can't unlink: $!"; + } + open $fh, '>', $name or die "Can't create $name: $!"; } elsif ($mode eq '>>') { - open $fh, '>>', $name or die "Can't append to $name: $!"; + open $fh, '>>', $name or die "Can't append to $name: $!"; } else { die "Unhandled open mode '$mode'"; } @@ -100,8 +100,8 @@ sub close_and_rename { } else { print STDOUT "ok - $0 $final_name\n"; } - safer_unlink($name); - return; + safer_unlink($name); + return; } unless ($force) { if (compare($name, $final_name) == 0) { @@ -132,10 +132,10 @@ sub read_only_top { my $raw = "-*- buffer-read-only: t -*-\n"; if ($args{file}) { - $raw .= "\n $args{file}\n"; + $raw .= "\n $args{file}\n"; } if ($args{copyright}) { - local $" = ', '; + local $" = ', '; $raw .= wrap(75, ' ', ' ', <<"EOM") . "\n"; Copyright (C) @{$args{copyright}} by\0Larry\0Wall\0and\0others @@ -148,17 +148,17 @@ sub read_only_top { $raw .= "!!!!!!! DO NOT EDIT THIS FILE !!!!!!!\n"; if ($args{by}) { - $raw .= "This file is built by $args{by}"; - if ($args{from}) { - my @from = ref $args{from} eq 'ARRAY' ? @{$args{from}} : $args{from}; - my $last = pop @from; - if (@from) { - $raw .= ' from ' . join (', ', @from) . " and $last"; - } else { - $raw .= " from $last"; - } - } - $raw .= ".\n"; + $raw .= "This file is built by $args{by}"; + if ($args{from}) { + my @from = ref $args{from} eq 'ARRAY' ? @{$args{from}} : $args{from}; + my $last = pop @from; + if (@from) { + $raw .= ' from ' . join (', ', @from) . " and $last"; + } else { + $raw .= " from $last"; + } + } + $raw .= ".\n"; } $raw .= "Any changes made here will be lost!\n"; $raw .= $args{final} if $args{final}; @@ -180,8 +180,8 @@ sub read_only_bottom_close_and_rename { my $comment; if ($sources) { - $comment = "Generated from:\n"; - foreach my $file (sort @$sources) { + $comment = "Generated from:\n"; + foreach my $file (sort @$sources) { my $digest = (-e $file) ? digest($file) # Use a random number that won't match the real @@ -189,17 +189,17 @@ sub read_only_bottom_close_and_rename { # Porting tests likely will fail drawing attention # to the problem. : int(rand(1_000_000)); - $comment .= "$digest $file\n"; - } + $comment .= "$digest $file\n"; + } } $comment .= "ex: set ro:"; if (defined $lang && $lang eq 'Perl') { - $comment =~ s/^/# /mg; + $comment =~ s/^/# /mg; } elsif (!defined $lang or $lang ne 'Pod') { - $comment =~ s/^/ * /mg; - $comment =~ s! \* !/* !; - $comment .= " */"; + $comment =~ s/^/ * /mg; + $comment =~ s! \* !/* !; + $comment .= " */"; } print $fh "\n$comment\n"; diff --git a/regen/warnings.pl b/regen/warnings.pl index 498b93e2854b..0ca928b6f0cd 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.49'; +$VERSION = '1.50'; BEGIN { require './regen/regen_lib.pl'; @@ -144,16 +144,16 @@ sub valueWalk my ($k, $v) ; foreach $k (sort keys %$tre) { - $v = $tre->{$k}; - die "duplicate key $k\n" if defined $list{$k} ; - die "Value associated with key '$k' is not an ARRAY reference" - if !ref $v || ref $v ne 'ARRAY' ; + $v = $tre->{$k}; + die "duplicate key $k\n" if defined $list{$k} ; + die "Value associated with key '$k' is not an ARRAY reference" + if !ref $v || ref $v ne 'ARRAY' ; - my ($ver, $rest) = @{ $v } ; - push @{ $v_list{$ver} }, $k; + my ($ver, $rest) = @{ $v } ; + push @{ $v_list{$ver} }, $k; - if (ref $rest) - { valueWalk ($rest) } + if (ref $rest) + { valueWalk ($rest) } } @@ -164,8 +164,8 @@ sub orderValues my $index = 0; foreach my $ver ( sort { $a <=> $b } keys %v_list ) { foreach my $name (@{ $v_list{$ver} } ) { - $ValueToName{ $index } = [ uc $name, $ver ] ; - $NameToValue{ uc $name } = $index ++ ; + $ValueToName{ $index } = [ uc $name, $ver ] ; + $NameToValue{ uc $name } = $index ++ ; } } @@ -181,21 +181,21 @@ sub walk my ($k, $v) ; foreach $k (sort keys %$tre) { - $v = $tre->{$k}; - die "duplicate key $k\n" if defined $list{$k} ; - die "Can't find key '$k'" - if ! defined $NameToValue{uc $k} ; + $v = $tre->{$k}; + die "duplicate key $k\n" if defined $list{$k} ; + die "Can't find key '$k'" + if ! defined $NameToValue{uc $k} ; push @{ $list{$k} }, $NameToValue{uc $k} ; - die "Value associated with key '$k' is not an ARRAY reference" - if !ref $v || ref $v ne 'ARRAY' ; + die "Value associated with key '$k' is not an ARRAY reference" + if !ref $v || ref $v ne 'ARRAY' ; - my ($ver, $rest) = @{ $v } ; - if (ref $rest) - { push (@{ $list{$k} }, walk ($rest)) } - elsif ($rest == DEFAULT_ON) - { push @def, $NameToValue{uc $k} } + my ($ver, $rest) = @{ $v } ; + if (ref $rest) + { push (@{ $list{$k} }, walk ($rest)) } + elsif ($rest == DEFAULT_ON) + { push @def, $NameToValue{uc $k} } - push @list, @{ $list{$k} } ; + push @list, @{ $list{$k} } ; } return @list ; @@ -209,7 +209,7 @@ sub mkRange my @out = @in ; for my $i (1 .. @in - 1) { - $out[$i] = ".." + $out[$i] = ".." if $in[$i] == $in[$i - 1] + 1 && ($i >= @in - 1 || $in[$i] + 1 == $in[$i + 1] ); } @@ -234,30 +234,30 @@ sub warningsTree my $rv = ''; while ($k = shift @keys) { - $v = $tre->{$k}; - die "Value associated with key '$k' is not an ARRAY reference" - if !ref $v || ref $v ne 'ARRAY' ; + $v = $tre->{$k}; + die "Value associated with key '$k' is not an ARRAY reference" + if !ref $v || ref $v ne 'ARRAY' ; my $offset ; - if ($tre ne $tree) { - $rv .= $prefix . "|\n" ; - $rv .= $prefix . "+- $k" ; - $offset = ' ' x ($max + 4) ; - } - else { - $rv .= $prefix . "$k" ; - $offset = ' ' x ($max + 1) ; - } - - my ($ver, $rest) = @{ $v } ; - if (ref $rest) - { - my $bar = @keys ? "|" : " "; - $rv .= " -" . "-" x ($max - length $k ) . "+\n" ; - $rv .= warningsTree ($rest, $prefix . $bar . $offset ) - } - else - { $rv .= "\n" } + if ($tre ne $tree) { + $rv .= $prefix . "|\n" ; + $rv .= $prefix . "+- $k" ; + $offset = ' ' x ($max + 4) ; + } + else { + $rv .= $prefix . "$k" ; + $offset = ' ' x ($max + 1) ; + } + + my ($ver, $rest) = @{ $v } ; + if (ref $rest) + { + my $bar = @keys ? "|" : " "; + $rv .= " -" . "-" x ($max - length $k ) . "+\n" ; + $rv .= warningsTree ($rest, $prefix . $bar . $offset ) + } + else + { $rv .= "\n" } } return $rv; @@ -272,7 +272,7 @@ sub mkHexOct my $string = "" ; foreach (@bits) { - vec($mask, $_, 1) = 1 ; + vec($mask, $_, 1) = 1 ; } foreach (unpack("C*", $mask)) { @@ -334,7 +334,7 @@ sub mkOct #define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ - (x) == pWARN_NONE) + (x) == pWARN_NONE) /* if PL_warnhook is set to this value, then warnings die */ #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder) @@ -379,9 +379,9 @@ sub mkOct print $warn <<'EOM'; #define isLEXWARN_on \ - cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) + cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off \ - cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) + cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (PerlWarnIsSet_((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (PerlWarnIsSet_((U8 *)(c + 1), 2*(x)+1)) @@ -474,11 +474,11 @@ =head1 Warning and Dieing !specialWARN(PL_curcop->cop_warnings) && \ (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \ (unpackWARN2(x) && \ - (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ - (unpackWARN3(x) && \ - (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ - (unpackWARN4(x) && \ - isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))))))) + (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ + (unpackWARN3(x) && \ + (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ + (unpackWARN4(x) && \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))))))) EOM @@ -526,8 +526,8 @@ =head1 Warning and Dieing my @list = sort { $a <=> $b } @$v ; print $pm tab(6, " '$k'"), '=> "', - mkHex($warn_size, map $_ * 2 , @list), - '", # [', mkRange(@list), "]\n" ; + mkHex($warn_size, map $_ * 2 , @list), + '", # [', mkRange(@list), "]\n" ; } print $pm ");\n\n" ; @@ -539,15 +539,15 @@ =head1 Warning and Dieing my @list = sort { $a <=> $b } @$v ; print $pm tab(6, " '$k'"), '=> "', - mkHex($warn_size, map $_ * 2 + 1 , @list), - '", # [', mkRange(@list), "]\n" ; + mkHex($warn_size, map $_ * 2 + 1 , @list), + '", # [', mkRange(@list), "]\n" ; } print $pm ");\n\n" ; print $pm "# These are used by various things, including our own tests\n"; print $pm tab(6, 'our $NONE'), '= "', ('\0' x $warn_size) , "\";\n" ; print $pm tab(6, 'our $DEFAULT'), '= "', mkHex($warn_size, map $_ * 2, @def), - '"; # [', mkRange(sort { $a <=> $b } @def), "]\n" ; + '"; # [', mkRange(sort { $a <=> $b } @def), "]\n" ; print $pm tab(6, 'our $LAST_BIT'), '= ' . "$index ;\n" ; print $pm tab(6, 'our $BYTES'), '= ' . "$warn_size ;\n" ; while () { @@ -588,16 +588,16 @@ sub _expand_bits { my $want_len = ($LAST_BIT + 7) >> 3; my $len = length($bits); if ($len != $want_len) { - if ($bits eq "") { - $bits = "\x00" x $want_len; - } elsif ($len > $want_len) { - substr $bits, $want_len, $len-$want_len, ""; - } else { - my $x = vec($bits, $Offsets{all} >> 1, 2); - $x |= $x << 2; - $x |= $x << 4; - $bits .= chr($x) x ($want_len - $len); - } + if ($bits eq "") { + $bits = "\x00" x $want_len; + } elsif ($len > $want_len) { + substr $bits, $want_len, $len-$want_len, ""; + } else { + my $x = vec($bits, $Offsets{all} >> 1, 2); + $x |= $x << 2; + $x |= $x << 4; + $bits .= chr($x) x ($want_len - $len); + } } return $bits; } @@ -610,21 +610,21 @@ sub _bits { $mask = _expand_bits($mask); foreach my $word ( @_ ) { - if ($word eq 'FATAL') { - $fatal = 1; - $no_fatal = 0; - } - elsif ($word eq 'NONFATAL') { - $fatal = 0; - $no_fatal = 1; - } - elsif ($catmask = $Bits{$word}) { - $mask |= $catmask ; - $mask |= $DeadBits{$word} if $fatal ; - $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ; - } - else - { Croaker("Unknown warnings category '$word'")} + if ($word eq 'FATAL') { + $fatal = 1; + $no_fatal = 0; + } + elsif ($word eq 'NONFATAL') { + $fatal = 0; + $no_fatal = 1; + } + elsif ($catmask = $Bits{$word}) { + $mask |= $catmask ; + $mask |= $DeadBits{$word} if $fatal ; + $mask = ~(~$mask | $DeadBits{$word}) if $no_fatal ; + } + else + { Croaker("Unknown warnings category '$word'")} } return $mask ; @@ -671,14 +671,14 @@ sub unimport $mask = _expand_bits($mask); foreach my $word ( @_ ) { - if ($word eq 'FATAL') { - next; - } - elsif ($catmask = $Bits{$word}) { - $mask = ~(~$mask | $catmask | $DeadBits{$word}); - } - else - { Croaker("Unknown warnings category '$word'")} + if ($word eq 'FATAL') { + next; + } + elsif ($catmask = $Bits{$word}) { + $mask = ~(~$mask | $catmask | $DeadBits{$word}); + } + else + { Croaker("Unknown warnings category '$word'")} } ${^WARNING_BITS} = $mask ; @@ -701,71 +701,71 @@ sub __chk my $has_level = $wanted & LEVEL ; if ($has_level) { - if (@_ != ($has_message ? 3 : 2)) { - my $sub = (caller 1)[3]; - my $syntax = $has_message - ? "category, level, 'message'" - : 'category, level'; - Croaker("Usage: $sub($syntax)"); + if (@_ != ($has_message ? 3 : 2)) { + my $sub = (caller 1)[3]; + my $syntax = $has_message + ? "category, level, 'message'" + : 'category, level'; + Croaker("Usage: $sub($syntax)"); } } elsif (not @_ == 1 || @_ == ($has_message ? 2 : 0)) { - my $sub = (caller 1)[3]; - my $syntax = $has_message ? "[category,] 'message'" : '[category]'; - Croaker("Usage: $sub($syntax)"); + my $sub = (caller 1)[3]; + my $syntax = $has_message ? "[category,] 'message'" : '[category]'; + Croaker("Usage: $sub($syntax)"); } my $message = pop if $has_message; if (@_) { - # check the category supplied. - $category = shift ; - if (my $type = ref $category) { - Croaker("not an object") - if exists $builtin_type{$type}; - $category = $type; - $isobj = 1 ; - } - $offset = $Offsets{$category}; - Croaker("Unknown warnings category '$category'") - unless defined $offset; + # check the category supplied. + $category = shift ; + if (my $type = ref $category) { + Croaker("not an object") + if exists $builtin_type{$type}; + $category = $type; + $isobj = 1 ; + } + $offset = $Offsets{$category}; + Croaker("Unknown warnings category '$category'") + unless defined $offset; } else { - $category = (caller(1))[0] ; - $offset = $Offsets{$category}; - Croaker("package '$category' not registered for warnings") - unless defined $offset ; + $category = (caller(1))[0] ; + $offset = $Offsets{$category}; + Croaker("package '$category' not registered for warnings") + unless defined $offset ; } my $i; if ($isobj) { - my $pkg; - $i = 2; - while (do { { package DB; $pkg = (caller($i++))[0] } } ) { - last unless @DB::args && $DB::args[0] =~ /^$category=/ ; - } - $i -= 2 ; + my $pkg; + $i = 2; + while (do { { package DB; $pkg = (caller($i++))[0] } } ) { + last unless @DB::args && $DB::args[0] =~ /^$category=/ ; + } + $i -= 2 ; } elsif ($has_level) { - $i = 2 + shift; + $i = 2 + shift; } else { - $i = _error_loc(); # see where Carp will allocate the error + $i = _error_loc(); # see where Carp will allocate the error } # Default to 0 if caller returns nothing. Default to $DEFAULT if it # explicitly returns undef. my(@callers_bitmask) = (caller($i))[9] ; my $callers_bitmask = - @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ; + @callers_bitmask ? $callers_bitmask[0] // $DEFAULT : 0 ; length($callers_bitmask) > ($offset >> 3) or $offset = $Offsets{all}; my @results; foreach my $type (FATAL, NORMAL) { - next unless $wanted & $type; + next unless $wanted & $type; - push @results, vec($callers_bitmask, $offset + $type - 1, 1); + push @results, vec($callers_bitmask, $offset + $type - 1, 1); } # &enabled and &fatal_enabled @@ -773,19 +773,19 @@ sub __chk # &warnif, and the category is neither enabled as warning nor as fatal return if ($wanted & (NORMAL | FATAL | MESSAGE)) - == (NORMAL | FATAL | MESSAGE) - && !($results[0] || $results[1]); + == (NORMAL | FATAL | MESSAGE) + && !($results[0] || $results[1]); # If we have an explicit level, bypass Carp. if ($has_level and @callers_bitmask) { - # logic copied from util.c:mess_sv - my $stuff = " at " . join " line ", (caller $i)[1,2]; - $stuff .= sprintf ", <%s> %s %d", - *${^LAST_FH}{NAME}, - ($/ eq "\n" ? "line" : "chunk"), $. - if $. && ${^LAST_FH}; - die "$message$stuff.\n" if $results[0]; - return warn "$message$stuff.\n"; + # logic copied from util.c:mess_sv + my $stuff = " at " . join " line ", (caller $i)[1,2]; + $stuff .= sprintf ", <%s> %s %d", + *${^LAST_FH}{NAME}, + ($/ eq "\n" ? "line" : "chunk"), $. + if $. && ${^LAST_FH}; + die "$message$stuff.\n" if $results[0]; + return warn "$message$stuff.\n"; } require Carp; @@ -809,15 +809,15 @@ sub register_categories my @names = @_; for my $name (@names) { - if (! defined $Bits{$name}) { - $Offsets{$name} = $LAST_BIT; - $Bits{$name} = _mkMask($LAST_BIT++); - $DeadBits{$name} = _mkMask($LAST_BIT++); - if (length($Bits{$name}) > length($Bits{all})) { - $Bits{all} .= "\x55"; - $DeadBits{all} .= "\xaa"; - } - } + if (! defined $Bits{$name}) { + $Offsets{$name} = $LAST_BIT; + $Bits{$name} = _mkMask($LAST_BIT++); + $DeadBits{$name} = _mkMask($LAST_BIT++); + if (length($Bits{$name}) > length($Bits{all})) { + $Bits{all} .= "\x55"; + $DeadBits{all} .= "\xaa"; + } + } } } @@ -938,7 +938,7 @@ =head1 DESCRIPTION my @x; { no warnings; - my $y = @x[0]; + my $y = @x[0]; } my $z = @x[0]; @@ -1023,8 +1023,8 @@ =head2 What's wrong with B<-w> and C<$^W> { local ($^W) = 0; - my $x =+ 2; - my $y; chop $y; + my $x =+ 2; + my $y; chop $y; } When this code is run with the B<-w> flag, a warning will be produced @@ -1035,8 +1035,8 @@ =head2 What's wrong with B<-w> and C<$^W> { BEGIN { $^W = 0 } - my $x =+ 2; - my $y; chop $y; + my $x =+ 2; + my $y; chop $y; } And note that unlike the first example, this will permanently set C<$^W> diff --git a/uni_keywords.h b/uni_keywords.h index f1b9324e50f4..49acffc7ce13 100644 --- a/uni_keywords.h +++ b/uni_keywords.h @@ -7544,8 +7544,8 @@ MPH_VALt match_uniprop( const unsigned char * const key, const U16 key_len ) { * 5b7c14380d5cceeaffcfbc18db1ed936391d2af2d51f5a41f1a17b692c77e59b lib/unicore/extracted/DNumValues.txt * ee0dd174fd5b158d82dfea95d7d822ca0bfcd490182669353dca3ab39a8ee807 lib/unicore/mktables * 50b85a67451145545a65cea370dab8d3444fbfe07e9c34cef560c5b7da9d3eef lib/unicore/version - * 2680b9254eb236c5c090f11b149605043e8c8433661b96efc4a42fb4709342a5 regen/charset_translations.pl - * 6bbad21de0848e0236b02f34f5fa0edd3cdae9ba8173cc9469a5513936b9e728 regen/mk_PL_charclass.pl - * b1d799ef06236277bdbe06eea253a83a7d39f161ec51f4d4bf5e9b5b5a57f251 regen/mk_invlists.pl + * 24120d5e0c9685c442c93bc1dbea9b85ef973bf8e9474baf0e55b160c288226b regen/charset_translations.pl + * 9f74e34278592ddf58fef8c32236b294e94ea5e12627f911f4563e8040a07292 regen/mk_PL_charclass.pl + * 5eb9e6c825496cc9aa705e3cd33bc6d5a9657dcca16d4c4acc4824ff30b34a26 regen/mk_invlists.pl * cf1d68efb7d919d302c4005641eae8d36da6d7850816ad374b0c00b45e609f43 regen/mph.pl * ex: set ro: */ diff --git a/warnings.h b/warnings.h index 4d5b3ef1d588..b129f6e250ed 100644 --- a/warnings.h +++ b/warnings.h @@ -22,7 +22,7 @@ #define pWARN_NONE (STRLEN *) &PL_WARN_NONE /* no warnings 'all' */ #define specialWARN(x) ((x) == pWARN_STD || (x) == pWARN_ALL || \ - (x) == pWARN_NONE) + (x) == pWARN_NONE) /* if PL_warnhook is set to this value, then warnings die */ #define PERL_WARNHOOK_FATAL (&PL_sv_placeholder) @@ -135,9 +135,9 @@ #define WARN_NONEstring "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" #define isLEXWARN_on \ - cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) + cBOOL(PL_curcop && PL_curcop->cop_warnings != pWARN_STD) #define isLEXWARN_off \ - cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) + cBOOL(!PL_curcop || PL_curcop->cop_warnings == pWARN_STD) #define isWARN_ONCE (PL_dowarn & (G_WARN_ON|G_WARN_ONCE)) #define isWARN_on(c,x) (PerlWarnIsSet_((U8 *)(c + 1), 2*(x))) #define isWARNf_on(c,x) (PerlWarnIsSet_((U8 *)(c + 1), 2*(x)+1)) @@ -230,11 +230,11 @@ category parameters passed. !specialWARN(PL_curcop->cop_warnings) && \ (isWARNf_on(PL_curcop->cop_warnings, unpackWARN1(x)) || \ (unpackWARN2(x) && \ - (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ - (unpackWARN3(x) && \ - (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ - (unpackWARN4(x) && \ - isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))))))) + (isWARNf_on(PL_curcop->cop_warnings, unpackWARN2(x)) || \ + (unpackWARN3(x) && \ + (isWARNf_on(PL_curcop->cop_warnings, unpackWARN3(x)) || \ + (unpackWARN4(x) && \ + isWARNf_on(PL_curcop->cop_warnings, unpackWARN4(x))))))))) From b12f49e146363ad6d1b9f1ae5fd68c9112ae5506 Mon Sep 17 00:00:00 2001 From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> Date: Fri, 8 Jan 2021 01:05:15 +0900 Subject: [PATCH 431/503] perldiag.pod: Correct description for "Lost precision when %s %f by 1" warning. The description of this warning used to state that "the target of C<++> or C<--> is unchanged", but there had been the case where the target is changed by some value while this warning is issued. --- pod/perldiag.pod | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index fd2833a3611f..de9e77241294 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -3488,9 +3488,12 @@ handle. This restriction may be eased in a future release. =item Lost precision when %s %f by 1 -(W imprecision) The value you attempted to increment or decrement by one -is too large for the underlying floating point representation to store -accurately, hence the target of C<++> or C<--> is unchanged. Perl issues this +(W imprecision) You attempted to increment or decrement a value by one, +but the result is too large for the underlying floating point +representation to store accurately. Hence, the target of C<++> or C<--> +is increased or decreased by quite different value than one, such as +zero (I the target is unchanged) or two, due to rounding. +Perl issues this warning because it has already switched from integers to floating point when values are too large for integers, and now even floating point is insufficient. You may wish to switch to using L explicitly. From 6867dc01ea301a9a9931ee096a579f76633de23f Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Mon, 28 Dec 2020 20:27:41 -0800 Subject: [PATCH 432/503] style: Add an EditorConfig file for the C code. EditorConfig lets editors automatically configure themselves to the project standard. Like embedded VIM and emacs mode lines, but universal. Many editors support it out of the box. Most everything else has a plugin. https://editorconfig.org/ It makes contributing with proper style easier. Pretty basic stuff. * 4 spaces for indentation * UTF-8 * Unix newlines * Strip trailing whitespace * Add a final newline on the file --- .editorconfig | 10 ++++++++++ 1 file changed, 10 insertions(+) create mode 100644 .editorconfig diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 000000000000..a7417d0bbe24 --- /dev/null +++ b/.editorconfig @@ -0,0 +1,10 @@ +root = true + +[**/*.[ch]] +charset = utf-8 +indent_style = space +indent_size = 4 +tab_width = 8 +end_of_line = lf +trim_trailing_whitespace = true +insert_final_newline = true From 95effda003dd0ba0ce0f04de22d687e771c1a738 Mon Sep 17 00:00:00 2001 From: "Michael G. Schwern" Date: Mon, 28 Dec 2020 21:55:04 -0800 Subject: [PATCH 433/503] fix: Manifest sorting for dotfiles with no extension. Forgot to add .editorconfig to the MANIFEST. Manfiest sorting was treating all of .editorconfig as an extension which put it before .dir-locals.el which is nonsense. Fixed it not to treat a file named .foo as an extension. --- MANIFEST | 1 + Porting/manifest_lib.pl | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/MANIFEST b/MANIFEST index 533e9e85be5c..d93dda6a55e1 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,4 +1,5 @@ .dir-locals.el Emacs control file +.editorconfig EditorConifg style file .lgtm.yml LGTM.com configuration file .metaconf-exclusions.txt Symbols that should ignored when generating Configure .travis.yml continuous integration on github (where enabled) diff --git a/Porting/manifest_lib.pl b/Porting/manifest_lib.pl index 6232c05851a8..95d49be9cd31 100644 --- a/Porting/manifest_lib.pl +++ b/Porting/manifest_lib.pl @@ -44,7 +44,8 @@ sub sort_manifest { $m =~ s!/!\0!g; # replace the extension (only one) by null null extension. # this puts any foo/blah.ext before any files in foo/blah/ - $m =~ s!(\.[^.]+\z)!\0\0$1!; + $m =~ s{(? Date: Fri, 8 Jan 2021 16:55:01 -0800 Subject: [PATCH 434/503] typo fix --- MANIFEST | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/MANIFEST b/MANIFEST index d93dda6a55e1..134a4ac36292 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,5 +1,5 @@ .dir-locals.el Emacs control file -.editorconfig EditorConifg style file +.editorconfig EditorConfig style file .lgtm.yml LGTM.com configuration file .metaconf-exclusions.txt Symbols that should ignored when generating Configure .travis.yml continuous integration on github (where enabled) From e4a01f167058bce6a22e55dfbeb5ec95eafdbaf7 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 18 Jan 2021 00:40:05 +0000 Subject: [PATCH 435/503] Update Compress::Raw::Bzip2 from 2.096 to 2.100 --- Porting/Maintainers.pl | 2 +- cpan/Compress-Raw-Bzip2/Makefile.PL | 39 +++++++------- .../lib/Compress/Raw/Bzip2.pm | 15 +++--- cpan/Compress-Raw-Bzip2/private/MakeUtil.pm | 22 ++++---- cpan/Compress-Raw-Bzip2/t/000prereq.t | 17 +++--- cpan/Compress-Raw-Bzip2/t/09limitoutput.t | 33 ++++++------ cpan/Compress-Raw-Bzip2/t/19nonpv.t | 28 +++++----- .../t/compress/CompTestUtils.pm | 52 +++++++++---------- cpan/Compress-Raw-Bzip2/typemap | 4 -- 9 files changed, 99 insertions(+), 113 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 66330fe4f451..62d0706c3163 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -199,7 +199,7 @@ package Maintainers; }, 'Compress::Raw::Bzip2' => { - 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.096.tar.gz', + 'DISTRIBUTION' => 'PMQS/Compress-Raw-Bzip2-2.100.tar.gz', 'FILES' => q[cpan/Compress-Raw-Bzip2], 'EXCLUDED' => [ qr{^t/Test/}, diff --git a/cpan/Compress-Raw-Bzip2/Makefile.PL b/cpan/Compress-Raw-Bzip2/Makefile.PL index d60345410158..b4b95ec7ed41 100644 --- a/cpan/Compress-Raw-Bzip2/Makefile.PL +++ b/cpan/Compress-Raw-Bzip2/Makefile.PL @@ -18,10 +18,10 @@ my $BZIP2_INCLUDE = defined($ENV{BZIP2_INCLUDE}) ? $ENV{BZIP2_INCLUDE} : '.'; #ParseCONFIG() ; -UpDowngrade(getPerlFiles('MANIFEST')) +UpDowngrade(getPerlFiles('MANIFEST')) unless $ENV{PERL_CORE}; -WriteMakefile( +WriteMakefile( NAME => 'Compress::Raw::Bzip2', VERSION_FROM => 'lib/Compress/Raw/Bzip2.pm', INC => "-I$BZIP2_INCLUDE" , @@ -29,7 +29,7 @@ WriteMakefile( XS => { 'Bzip2.xs' => 'Bzip2.c'}, 'clean' => { FILES => '*.c bzip2.h bzlib.h bzlib_private.h constants.h constants.xs' }, #'depend' => { 'Makefile' => 'config.in' }, - 'dist' => { COMPRESS => 'gzip', + 'dist' => { COMPRESS => 'gzip', TARFLAGS => '-chvf', SUFFIX => 'gz', DIST_DEFAULT => 'MyTrebleCheck tardist', @@ -40,7 +40,7 @@ WriteMakefile( ? bzip2_files($BZIP2_LIB) : (LIBS => [ "-L$BZIP2_LIB -lbz2 " ]) ), - + ( $] >= 5.005 ? (ABSTRACT_FROM => 'lib/Compress/Raw/Bzip2.pm', @@ -50,9 +50,9 @@ WriteMakefile( INSTALLDIRS => ($] > 5.010 && $] < 5.011 ? 'perl' : 'site'), - ( eval { ExtUtils::MakeMaker->VERSION(6.46) } + ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => { - + "meta-spec" => { version => 2 }, no_index => { @@ -60,7 +60,7 @@ WriteMakefile( }, resources => { - + bugtracker => { web => 'https://github.com/pmqs/Compress-Raw-Bzip2/issues' }, @@ -71,15 +71,15 @@ WriteMakefile( type => 'git', url => 'git://github.com/pmqs/Compress-Raw-Bzip2.git', web => 'https://github.com/pmqs/Compress-Raw-Bzip2', - }, + }, }, - } - ) + } + ) : () - ), + ), ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? - ('LICENSE' => 'perl') : ()), + ('LICENSE' => 'perl') : ()), ) ; @@ -127,7 +127,7 @@ if (eval {require ExtUtils::Constant; 1}) { die "The following names are missing from \@EXPORT in Bzip2.pm\n" . "\t$missing\n" ; } - + #push @names, {name => 'BZ_VERSION', type => 'PV' }; ExtUtils::Constant::WriteConstants( @@ -135,9 +135,9 @@ if (eval {require ExtUtils::Constant; 1}) { NAMES => \@names, C_FILE => 'constants.h', XS_FILE => 'constants.xs', - + ); -} +} else { foreach my $name (qw( constants.h constants.xs )) { @@ -166,8 +166,8 @@ sub bzip2_files foreach my $file (@c_files, @h_files) { copy(catfile($dir, $file), '.') } - - + + @h_files = map { catfile($dir, $_) } @h_files ; my @o_files = map { "$_\$(OBJ_EXT)" } 'Bzip2', @c_files; push @c_files, 'Bzip2.c' ; @@ -177,10 +177,7 @@ sub bzip2_files 'C' => [ @c_files ] , #'OBJECT' => qq[ @o_files ], 'OBJECT' => q[ $(O_FILES) ], - + ) ; } - - - diff --git a/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm b/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm index 842aba3e8b39..695f108bb816 100644 --- a/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm +++ b/cpan/Compress-Raw-Bzip2/lib/Compress/Raw/Bzip2.pm @@ -11,8 +11,8 @@ use Carp ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, $AUTOLOAD); -$VERSION = '2.096'; -$XS_VERSION = $VERSION; +$VERSION = '2.100'; +$XS_VERSION = $VERSION; $VERSION = eval $VERSION; @ISA = qw(Exporter); @@ -61,11 +61,11 @@ eval { require XSLoader; XSLoader::load('Compress::Raw::Bzip2', $XS_VERSION); 1; -} +} or do { require DynaLoader; local @ISA = qw(DynaLoader); - bootstrap Compress::Raw::Bzip2 $XS_VERSION ; + bootstrap Compress::Raw::Bzip2 $XS_VERSION ; }; #sub Compress::Raw::Bzip2::new @@ -132,14 +132,14 @@ Compress::Raw::Bzip2 - Low-Level Interface to bzip2 compression library my ($bz, $status) = new Compress::Raw::Bzip2 [OPTS] or die "Cannot create bzip2 object: $bzerno\n"; - + $status = $bz->bzdeflate($input, $output); $status = $bz->bzflush($output); $status = $bz->bzclose($output); my ($bz, $status) = new Compress::Raw::Bunzip2 [OPTS] or die "Cannot create bunzip2 object: $bzerno\n"; - + $status = $bz->bzinflate($input, $output); my $version = Compress::Raw::Bzip2::bzlibversion(); @@ -384,8 +384,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/Compress-Raw-Bzip2/private/MakeUtil.pm b/cpan/Compress-Raw-Bzip2/private/MakeUtil.pm index 12fa26fd05f1..aa540c68fda3 100644 --- a/cpan/Compress-Raw-Bzip2/private/MakeUtil.pm +++ b/cpan/Compress-Raw-Bzip2/private/MakeUtil.pm @@ -42,14 +42,14 @@ sub MY::libscan return $path; } -sub MY::postamble +sub MY::postamble { return '' if $ENV{PERL_CORE} ; my @files = getPerlFiles('MANIFEST'); - # Note: Once you remove all the layers of shell/makefile escaping + # Note: Once you remove all the layers of shell/makefile escaping # the regular expression below reads # # /^\s*local\s*\(\s*\$^W\s*\)/ @@ -215,7 +215,7 @@ sub UpDowngrade foreach (@files) { #if (-l $_ ) { doUpDown($our_sub, $warn_sub, $_) } - #else + #else #{ doUpDownViaCopy($our_sub, $warn_sub, $_) } } @@ -234,7 +234,7 @@ sub doUpDown local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; local (@ARGV) = shift; - + while (<>) { print, last if /^__(END|DATA)__/ ; @@ -277,7 +277,7 @@ sub doUpDownViaCopy push @keep, $_; last ; } - + &{ $our_sub }() if $our_sub ; &{ $warn_sub }() if $warn_sub ; push @keep, $_; @@ -334,7 +334,7 @@ sub FindBrokenDependencies Compress::Zlib ); - + my @broken = (); foreach my $module ( grep { ! $thisModule{$_} } @modules) @@ -342,12 +342,12 @@ sub FindBrokenDependencies my $hasVersion = getInstalledVersion($module); # No need to upgrade if the module isn't installed at all - next + next if ! defined $hasVersion; # If already have C::Z version 1, then an upgrade to any of the # IO::Compress modules will not break it. - next + next if $module eq 'Compress::Zlib' && $hasVersion < 2; if ($hasVersion < $version) @@ -370,14 +370,12 @@ sub getInstalledVersion { no strict 'refs'; $version = ${ $module . "::VERSION" }; - $version = 0 + $version = 0 } - + return $version; } package MakeUtil ; 1; - - diff --git a/cpan/Compress-Raw-Bzip2/t/000prereq.t b/cpan/Compress-Raw-Bzip2/t/000prereq.t index 397366c00cd4..2eeff538456b 100644 --- a/cpan/Compress-Raw-Bzip2/t/000prereq.t +++ b/cpan/Compress-Raw-Bzip2/t/000prereq.t @@ -19,13 +19,13 @@ BEGIN if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - my $VERSION = '2.096'; + my $VERSION = '2.100'; my @NAMES = qw( - + ); my @OPT = qw( - + ); plan tests => 1 + @NAMES + @OPT + $extra ; @@ -43,15 +43,14 @@ BEGIN eval " require $name " ; if ($@) { - ok 1, "$name not available" + ok 1, "$name not available" } - else + else { my $ver = eval("\$${name}::VERSION"); - is $ver, $VERSION, "$name version should be $VERSION" + is $ver, $VERSION, "$name version should be $VERSION" or diag "$name version is $ver, need $VERSION" ; - } + } } - -} +} diff --git a/cpan/Compress-Raw-Bzip2/t/09limitoutput.t b/cpan/Compress-Raw-Bzip2/t/09limitoutput.t index 78e121aa902f..63138a0d0fe7 100644 --- a/cpan/Compress-Raw-Bzip2/t/09limitoutput.t +++ b/cpan/Compress-Raw-Bzip2/t/09limitoutput.t @@ -13,8 +13,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -22,7 +22,7 @@ BEGIN plan tests => 88 + $extra ; - use_ok('Compress::Raw::Bzip2') ; + use_ok('Compress::Raw::Bzip2') ; } @@ -30,7 +30,7 @@ BEGIN my $hello = "I am a HAL 9000 computer" x 2001; my $tmp = $hello ; -my ($err, $x, $X, $status); +my ($err, $x, $X, $status); ok( ($x, $err) = new Compress::Raw::Bzip2 (1)); ok $x ; @@ -52,7 +52,7 @@ cmp_ok $x->bzclose($out), '==', BZ_STREAM_END, " bzflush returned BZ_STREAM_END ok $GOT eq $hello; } - + sub getOut { my $x = ''; return \$x } for my $bufsize (1, 2, 3, 13, 4096, 1024*10) @@ -68,7 +68,7 @@ for my $bufsize (1, 2, 3, 13, 4096, 1024*10) )); ok $k ; cmp_ok $err, '==', BZ_OK, " status is BZ_OK" ; - + is $k->total_in_lo32(), 0, " total_in_lo32 == 0" ; is $k->total_out_lo32(), 0, " total_out_lo32 == 0" ; my $GOT = getOut(); @@ -83,7 +83,7 @@ for my $bufsize (1, 2, 3, 13, 4096, 1024*10) last if $status != BZ_OK; $deltaOK = 0 if length($GOT) - $prev > $bufsize; } - + ok $deltaOK, " Output Delta never > $bufsize"; cmp_ok $looped, '>=', 1, " looped $looped"; is length($tmp), 0, " length of input buffer is zero"; @@ -98,7 +98,7 @@ sub getit { my $obj = shift ; my $input = shift; - + my $data ; 1 while $obj->bzinflate($input, $data) != BZ_STREAM_END ; return \$data ; @@ -106,9 +106,9 @@ sub getit { title "regression test"; - - my ($err, $x, $X, $status); - + + my ($err, $x, $X, $status); + ok( ($x, $err) = new Compress::Raw::Bzip2 (1)); ok $x ; cmp_ok $err, '==', BZ_OK, " status is BZ_OK" ; @@ -117,11 +117,11 @@ sub getit my $line2 = "second line\n" ; my $text = $line1 . $line2 ; my $tmp = $text; - + my $out ; $status = $x->bzdeflate($tmp, $out) ; cmp_ok $status, '==', BZ_RUN_OK, " status is BZ_RUN_OK" ; - + cmp_ok $x->bzclose($out), '==', BZ_STREAM_END, " bzclose returned BZ_STREAM_END" ; my $k; @@ -130,10 +130,9 @@ sub getit #LimitOutput => 1 )); - + my $c = getit($k, $out); is $$c, $text; - - -} + +} diff --git a/cpan/Compress-Raw-Bzip2/t/19nonpv.t b/cpan/Compress-Raw-Bzip2/t/19nonpv.t index 15d53b92cab7..d97de7e9406a 100644 --- a/cpan/Compress-Raw-Bzip2/t/19nonpv.t +++ b/cpan/Compress-Raw-Bzip2/t/19nonpv.t @@ -12,8 +12,8 @@ use warnings; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -23,7 +23,7 @@ BEGIN use_ok('Compress::Raw::Bzip2', 2) ; } - + my $hello = <uncompressedBytes(), 0, "uncompressedBytes() == 0" ; is $x->compressedBytes(), 0, "compressedBytes() == 0" ; @@ -54,38 +54,36 @@ my $len = length $hello ; $Answer = *Answer; $status = $x->bzdeflate($hello, $Answer) ; cmp_ok $status, '==', BZ_RUN_OK, "bzdeflate returned BZ_RUN_OK" ; - + $X = *X; cmp_ok $x->bzflush($X), '==', BZ_RUN_OK, "bzflush returned BZ_RUN_OK" ; $Answer .= $X ; - + is $x->uncompressedBytes(), length $hello, "uncompressedBytes ok" ; is $x->compressedBytes(), length $Answer, "compressedBytes ok" ; - + $X = *X; cmp_ok $x->bzclose($X), '==', BZ_STREAM_END, "bzclose returned BZ_STREAM_END"; $Answer .= $X ; my @Answer = split('', $Answer) ; - + my $k; ok(($k, $err) = new Compress::Raw::Bunzip2(0, 0)); ok $k, "Compress::Raw::Bunzip2 ok" ; cmp_ok $err, '==', BZ_OK, "status is BZ_OK" ; - + is $k->compressedBytes(), 0, "compressedBytes() == 0" ; is $k->uncompressedBytes(), 0, "uncompressedBytes() == 0" ; my $GOT = *GOT; $GOT = *GOT; my $Z; $status = $k->bzinflate($Answer, $GOT) ; - - + + cmp_ok $status, '==', BZ_STREAM_END, "Got BZ_STREAM_END" ; is $GOT, $hello, "uncompressed data matches ok" ; is $k->compressedBytes(), length $Answer, "compressedBytes ok" ; is $k->uncompressedBytes(), length $hello , "uncompressedBytes ok"; } - - diff --git a/cpan/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm b/cpan/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm index c506632f90e3..fd9d963e0344 100644 --- a/cpan/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm +++ b/cpan/Compress-Raw-Bzip2/t/compress/CompTestUtils.pm @@ -9,13 +9,13 @@ use bytes; #use lib qw(t t/compress); use Carp ; -#use Test::More ; +#use Test::More ; sub title { - #diag "" ; + #diag "" ; ok(1, $_[0]) ; #diag "" ; } @@ -26,7 +26,7 @@ sub like_eval } BEGIN { - eval { + eval { require File::Temp; } ; @@ -38,7 +38,7 @@ BEGIN { our ($index); $index = '00000'; - + sub new { my $self = shift ; @@ -72,7 +72,7 @@ BEGIN { $index = '00000'; our ($useTempFile); our ($useTempDir); - + sub new { my $self = shift ; @@ -115,11 +115,11 @@ BEGIN { # autogenerate the name if none supplied $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ; } - foreach (@_) - { + foreach (@_) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_; - mkdir $_, 0777 + if -d $_; + mkdir $_, 0777 } bless [ @_ ], $self ; } @@ -131,10 +131,10 @@ BEGIN { if (! $useTempFile) { my $self = shift ; - foreach (@$self) - { + foreach (@$self) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_ ; + if -d $_ ; } } } @@ -150,15 +150,15 @@ sub readFile { my $pos = tell($f); seek($f, 0,0); - @strings = <$f> ; + @strings = <$f> ; seek($f, 0, $pos); } else { - open (F, "<$f") + open (F, "<$f") or croak "Cannot open $f: $!\n" ; binmode F; - @strings = ; + @strings = ; close F ; } @@ -175,7 +175,7 @@ sub writeFile { my($filename, @strings) = @_ ; 1 while unlink $filename ; - open (F, ">$filename") + open (F, ">$filename") or croak "Cannot open $filename: $!\n" ; binmode F; foreach (@strings) { @@ -191,10 +191,10 @@ sub GZreadFile my ($uncomp) = "" ; my $line = "" ; - my $fil = gzopen($filename, "rb") + my $fil = gzopen($filename, "rb") or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; - $uncomp .= $line + $uncomp .= $line while $fil->gzread($line) > 0; $fil->gzclose ; @@ -248,7 +248,7 @@ sub readHeaderInfo some text EOM - ok my $x = new IO::Compress::Gzip $name, %opts + ok my $x = new IO::Compress::Gzip $name, %opts or diag "GzipError is $IO::Compress::Gzip::GzipError" ; ok $x->write($string) ; ok $x->close ; @@ -562,9 +562,9 @@ sub anyUncompress } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - Append => 1, - Transparent => 0, + my $o = new IO::Uncompress::AnyUncompress \$data, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts @@ -622,10 +622,10 @@ sub getHeaders } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - MultiStream => 1, - Append => 1, - Transparent => 0, + my $o = new IO::Uncompress::AnyUncompress \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts diff --git a/cpan/Compress-Raw-Bzip2/typemap b/cpan/Compress-Raw-Bzip2/typemap index 873681619f36..c8a988929198 100644 --- a/cpan/Compress-Raw-Bzip2/typemap +++ b/cpan/Compress-Raw-Bzip2/typemap @@ -30,7 +30,6 @@ T_PTROBJ_AV else if (sv_derived_from($arg, \"${ntype}\")) { IV tmp = SvIV(getInnerObject($arg)) ; $var = INT2PTR($type, tmp); - } else croak(\"$var is not of type ${ntype}\") @@ -49,6 +48,3 @@ T_DUAL T_PV sv_setpv((SV*)$arg, $var); - - - From c351a5bad40cda0aa96cf5e2fb0e6ceff968b773 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 18 Jan 2021 01:41:43 +0000 Subject: [PATCH 436/503] Update Compress::Raw::Zlib from 2.096 to 2.100 --- Porting/Maintainers.pl | 2 +- cpan/Compress-Raw-Zlib/Makefile.PL | 85 +++++---- cpan/Compress-Raw-Zlib/config.in | 6 +- .../lib/Compress/Raw/Zlib.pm | 171 +++++++++--------- cpan/Compress-Raw-Zlib/private/MakeUtil.pm | 22 +-- cpan/Compress-Raw-Zlib/t/01version.t | 13 +- cpan/Compress-Raw-Zlib/t/07bufsize.t | 36 ++-- cpan/Compress-Raw-Zlib/t/09limitoutput.t | 59 +++--- cpan/Compress-Raw-Zlib/t/18lvalue.t | 22 +-- cpan/Compress-Raw-Zlib/t/19nonpv.t | 33 ++-- .../t/compress/CompTestUtils.pm | 52 +++--- cpan/Compress-Raw-Zlib/typemap | 3 - 12 files changed, 246 insertions(+), 258 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 62d0706c3163..2dbb3bf4f1f0 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -211,7 +211,7 @@ package Maintainers; }, 'Compress::Raw::Zlib' => { - 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.096.tar.gz', + 'DISTRIBUTION' => 'PMQS/Compress-Raw-Zlib-2.100.tar.gz', 'FILES' => q[cpan/Compress-Raw-Zlib], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/Compress-Raw-Zlib/Makefile.PL b/cpan/Compress-Raw-Zlib/Makefile.PL index 67c28d606f72..60fc8742806a 100644 --- a/cpan/Compress-Raw-Zlib/Makefile.PL +++ b/cpan/Compress-Raw-Zlib/Makefile.PL @@ -32,7 +32,7 @@ my $ZLIB_LIBRARY_NAME = $^O eq 'MSWin32' ? 'zlib' : 'z' ; # ExtUtils::Install. # Don't ask if MM_USE_DEFAULT is set -- enables perl core building on cygwin -if ($^O =~ /cygwin/i and $ExtUtils::Install::VERSION < 1.39 +if ($^O =~ /cygwin/i and $ExtUtils::Install::VERSION < 1.39 and not ($ENV{PERL_MM_USE_DEFAULT} or $ENV{PERL_CORE})) { print < 'Compress::Raw::Zlib', VERSION_FROM => 'lib/Compress/Raw/Zlib.pm', INC => "-I$ZLIB_INCLUDE" , @@ -79,7 +79,7 @@ WriteMakefile( XS => { 'Zlib.xs' => 'Zlib.c'}, 'depend' => { 'Makefile' => 'config.in' }, 'clean' => { FILES => '*.c constants.h constants.xs' }, - 'dist' => { COMPRESS => 'gzip', + 'dist' => { COMPRESS => 'gzip', TARFLAGS => '-chvf', SUFFIX => 'gz', DIST_DEFAULT => 'MyTrebleCheck tardist', @@ -94,9 +94,9 @@ WriteMakefile( INSTALLDIRS => ($] >= 5.009 && $] < 5.011 ? 'perl' : 'site'), - ( eval { ExtUtils::MakeMaker->VERSION(6.46) } + ( eval { ExtUtils::MakeMaker->VERSION(6.46) } ? ( META_MERGE => { - + "meta-spec" => { version => 2 }, no_index => { @@ -104,7 +104,7 @@ WriteMakefile( }, resources => { - + bugtracker => { web => 'https://github.com/pmqs/Compress-Raw-Zlib/issues' }, @@ -115,15 +115,15 @@ WriteMakefile( type => 'git', url => 'git://github.com/pmqs/Compress-Raw-Zlib.git', web => 'https://github.com/pmqs/Compress-Raw-Zlib', - }, + }, }, - } - ) + } + ) : () ), ((ExtUtils::MakeMaker->VERSION() gt '6.30') ? - ('LICENSE' => 'perl') : ()), + ('LICENSE' => 'perl') : ()), ) ; @@ -201,13 +201,13 @@ if (eval {require ExtUtils::Constant; 1}) { die "The following names are missing from \@EXPORT in Zlib.pm\n" . "\t$missing\n" ; } - + push @names, { name => 'ZLIB_VERSION', type => 'PV' }; - - push @names, map { { name => $_, - macro => version_Macro $verSpecificNames{$_} - } - } + + push @names, map { { name => $_, + macro => version_Macro $verSpecificNames{$_} + } + } keys %verSpecificNames ; ExtUtils::Constant::WriteConstants( @@ -215,10 +215,10 @@ if (eval {require ExtUtils::Constant; 1}) { NAMES => \@names, C_FILE => 'constants.h', XS_FILE => 'constants.xs', - + ); -} +} else { foreach my $name (qw( constants.h constants.xs )) { @@ -263,14 +263,14 @@ sub ParseCONFIG # check parsed values my @missing = () ; - die "The following keys are missing from $CONFIG [@missing]\n" + die "The following keys are missing from $CONFIG [@missing]\n" if @missing = keys %Parsed ; $ZLIB_INCLUDE = defined $ENV{'ZLIB_INCLUDE'} - ? $ENV{'ZLIB_INCLUDE'} + ? $ENV{'ZLIB_INCLUDE'} : $Info{'INCLUDE'} ; - $ZLIB_LIB = defined $ENV{'ZLIB_LIB'} - ?$ENV{'ZLIB_LIB'} + $ZLIB_LIB = defined $ENV{'ZLIB_LIB'} + ?$ENV{'ZLIB_LIB'} : $Info{'LIB'} ; if ($^O eq 'VMS') { @@ -279,19 +279,19 @@ sub ParseCONFIG } my $y = defined $ENV{'OLD_ZLIB'} - ? $ENV{'OLD_ZLIB'} + ? $ENV{'OLD_ZLIB'} : $Info{'OLD_ZLIB'} ; $OLD_ZLIB = '-DOLD_ZLIB' if $y and $y =~ /^yes|on|true|1$/i; - my $x = defined $ENV{'BUILD_ZLIB'} - ? $ENV{'BUILD_ZLIB'} + my $x = defined $ENV{'BUILD_ZLIB'} + ? $ENV{'BUILD_ZLIB'} : $Info{'BUILD_ZLIB'} ; if ($x and $x =~ /^yes|on|true|1$/i ) { $BUILD_ZLIB = 1 ; - # ZLIB_LIB & ZLIB_INCLUDE must point to the same place when + # ZLIB_LIB & ZLIB_INCLUDE must point to the same place when # BUILD_ZLIB is specified. die "INCLUDE & LIB must be the same when BUILD_ZLIB is True\n" if $ZLIB_LIB ne $ZLIB_INCLUDE ; @@ -309,8 +309,8 @@ sub ParseCONFIG print "Building Zlib enabled\n" ; } - $GZIP_OS_CODE = defined $ENV{'GZIP_OS_CODE'} - ? $ENV{'GZIP_OS_CODE'} + $GZIP_OS_CODE = defined $ENV{'GZIP_OS_CODE'} + ? $ENV{'GZIP_OS_CODE'} : $Info{'GZIP_OS_CODE'} ; die "GZIP_OS_CODE not 'AUTO_DETECT' or a number between 0 and 255\n" @@ -322,7 +322,7 @@ sub ParseCONFIG print "Auto Detect Gzip OS Code..\n" ; $GZIP_OS_CODE = getOSCode() ; } - + my $name = getOSname($GZIP_OS_CODE); print "Setting Gzip OS Code to $GZIP_OS_CODE [$name]\n" ; @@ -347,22 +347,22 @@ sub zlib_files my @h_files = (); my @c_files = (); - + if (-f catfile($dir, "infback.c")) { # zlib 1.2.0 or greater # - @h_files = qw(crc32.h inffast.h inflate.h trees.h zconf.in.h - zutil.h deflate.h inffixed.h inftrees.h zconf.h - zlib.h + @h_files = qw(crc32.h inffast.h inflate.h trees.h zconf.in.h + zutil.h deflate.h inffixed.h inftrees.h zconf.h + zlib.h ); @c_files = qw(adler32 crc32 infback inflate uncompr - compress deflate inffast inftrees - trees zutil + compress deflate inffast inftrees + trees zutil ); } else { # zlib 1.1.x - + @h_files = qw(deflate.h infcodes.h inftrees.h zconf.h zutil.h infblock.h inffast.h infutil.h zlib.h ); @@ -371,20 +371,20 @@ sub zlib_files inftrees infcodes infutil inffast ); } - + @h_files = map { catfile($dir, $_) } @h_files ; my @o_files = map { "$_\$(OBJ_EXT)" } 'Zlib', @c_files; @c_files = map { "$_.c" } 'Zlib', @c_files ; foreach my $file (@c_files) { copy(catfile($dir, $file), '.') } - + return ( #'H' => [ @h_files ], 'C' => [ @c_files ] , #'OBJECT' => qq[ @o_files ], 'OBJECT' => q[ $(O_FILES) ], - + ) ; } @@ -418,7 +418,7 @@ BEGIN [ '' => 255, 'Unknown OS' ], ); - %OSnames = map { $$_[1] => $$_[2] } + %OSnames = map { $$_[1] => $$_[2] } @GZIP_OS_Names ; } @@ -447,4 +447,3 @@ sub getOSname } # end of file Makefile.PL - diff --git a/cpan/Compress-Raw-Zlib/config.in b/cpan/Compress-Raw-Zlib/config.in index d6701ffb0cf7..fa998b53dbb8 100644 --- a/cpan/Compress-Raw-Zlib/config.in +++ b/cpan/Compress-Raw-Zlib/config.in @@ -3,11 +3,11 @@ # written by Paul Marquess # last modified 28th October 2003 # version 2.000 -# -# +# +# # This file is used to control which zlib library will be used by # Compress::Zlib -# +# # See to the sections below in the README file for details of how to # use this file. # diff --git a/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm b/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm index 59cda238e2dc..df50ea314202 100644 --- a/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm +++ b/cpan/Compress-Raw-Zlib/lib/Compress/Raw/Zlib.pm @@ -10,12 +10,12 @@ use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, %EXPORT_TAGS, @EXPORT_OK, $AUTOLOAD, %DEFLATE_CONSTANTS, @DEFLATE_CONSTANTS); -$VERSION = '2.096'; -$XS_VERSION = $VERSION; +$VERSION = '2.100'; +$XS_VERSION = $VERSION; $VERSION = eval $VERSION; @ISA = qw(Exporter); -%EXPORT_TAGS = ( flush => [qw{ +%EXPORT_TAGS = ( flush => [qw{ Z_NO_FLUSH Z_PARTIAL_FLUSH Z_SYNC_FLUSH @@ -23,30 +23,30 @@ $VERSION = eval $VERSION; Z_FINISH Z_BLOCK }], - level => [qw{ + level => [qw{ Z_NO_COMPRESSION Z_BEST_SPEED Z_BEST_COMPRESSION Z_DEFAULT_COMPRESSION }], - strategy => [qw{ + strategy => [qw{ Z_FILTERED Z_HUFFMAN_ONLY Z_RLE Z_FIXED Z_DEFAULT_STRATEGY }], - status => [qw{ + status => [qw{ Z_OK Z_STREAM_END Z_NEED_DICT Z_ERRNO Z_STREAM_ERROR - Z_DATA_ERROR - Z_MEM_ERROR - Z_BUF_ERROR - Z_VERSION_ERROR - }], + Z_DATA_ERROR + Z_MEM_ERROR + Z_BUF_ERROR + Z_VERSION_ERROR + }], ); %DEFLATE_CONSTANTS = %EXPORT_TAGS; @@ -54,12 +54,12 @@ $VERSION = eval $VERSION; # Items to export into callers namespace by default. Note: do not export # names by default without a very good reason. Use EXPORT_OK instead. # Do not simply export all your public functions/methods/constants. -@DEFLATE_CONSTANTS = +@DEFLATE_CONSTANTS = @EXPORT = qw( ZLIB_VERSION ZLIB_VERNUM - + OS_CODE MAX_MEM_LEVEL @@ -125,13 +125,13 @@ eval { require XSLoader; XSLoader::load('Compress::Raw::Zlib', $XS_VERSION); 1; -} +} or do { require DynaLoader; local @ISA = qw(DynaLoader); - bootstrap Compress::Raw::Zlib $XS_VERSION ; + bootstrap Compress::Raw::Zlib $XS_VERSION ; }; - + use constant Parse_any => 0x01; use constant Parse_unsigned => 0x02; @@ -153,7 +153,7 @@ use constant OFF_STICKY => 5 ; sub ParseParameters { - my $level = shift || 0 ; + my $level = shift || 0 ; my $sub = (caller($level + 1))[3] ; #local $Carp::CarpLevel = 1 ; @@ -186,13 +186,13 @@ sub Compress::Raw::Zlib::Parameters::setError $self->{Error} = $error ; return $retval; } - + #sub getError #{ # my $self = shift ; # return $self->{Error} ; #} - + sub Compress::Raw::Zlib::Parameters::parse { my $self = shift ; @@ -211,10 +211,10 @@ sub Compress::Raw::Zlib::Parameters::parse @entered = () ; } elsif (@_ == 1) { - my $href = $_[0] ; + my $href = $_[0] ; return $self->setError("Expected even number of parameters, got 1") if ! defined $href or ! ref $href or ref $href ne "HASH" ; - + foreach my $key (keys %$href) { push @entered, $key ; push @entered, \$href->{$key} ; @@ -224,7 +224,7 @@ sub Compress::Raw::Zlib::Parameters::parse my $count = @_; return $self->setError("Expected even number of parameters, got $count") if $count % 2 != 0 ; - + for my $i (0.. $count / 2 - 1) { push @entered, $_[2* $i] ; push @entered, \$_[2* $i+1] ; @@ -239,7 +239,7 @@ sub Compress::Raw::Zlib::Parameters::parse my ($first_only, $sticky, $type, $value) = @$v ; my $x ; - $self->_checkType($key, \$value, $type, 0, \$x) + $self->_checkType($key, \$value, $type, 0, \$x) or return undef ; $key = lc $key; @@ -260,7 +260,7 @@ sub Compress::Raw::Zlib::Parameters::parse $key =~ s/^-// ; my $canonkey = lc $key; - + if ($got->{$canonkey} && ($firstTime || ! $got->{$canonkey}[OFF_FIRST_ONLY] )) { @@ -275,7 +275,7 @@ sub Compress::Raw::Zlib::Parameters::parse else { push (@Bad, $key) } } - + if (@Bad) { my ($bad) = join(", ", @Bad) ; return $self->setError("unknown key value(s) @Bad") ; @@ -319,7 +319,7 @@ sub Compress::Raw::Zlib::Parameters::_checkType return $self->setError("Parameter '$key' must be an unsigned int, got '$value'") if $validate && $value !~ /^\d+$/; - $$output = defined $value ? $value : 0 ; + $$output = defined $value ? $value : 0 ; return 1; } elsif ($type & Parse_signed) @@ -329,19 +329,19 @@ sub Compress::Raw::Zlib::Parameters::_checkType return $self->setError("Parameter '$key' must be a signed int, got '$value'") if $validate && $value !~ /^-?\d+$/; - $$output = defined $value ? $value : 0 ; + $$output = defined $value ? $value : 0 ; return 1 ; } elsif ($type & Parse_boolean) { return $self->setError("Parameter '$key' must be an int, got '$value'") if $validate && defined $value && $value !~ /^\d*$/; - $$output = defined $value ? $value != 0 : 0 ; + $$output = defined $value ? $value != 0 : 0 ; return 1; } # elsif ($type & Parse_string) # { -# $$output = defined $value ? $value : "" ; +# $$output = defined $value ? $value : "" ; # return 1; # } @@ -374,7 +374,7 @@ sub Compress::Raw::Zlib::Parameters::value return $self->{Got}{lc $name}[OFF_FIXED] ; } -our $OPTIONS_deflate = +our $OPTIONS_deflate = { 'AppendOutput' => [1, 1, Parse_boolean, 0], 'CRC32' => [1, 1, Parse_boolean, 0], @@ -394,7 +394,7 @@ sub Compress::Raw::Zlib::Deflate::new my $pkg = shift ; my ($got) = ParseParameters(0, $OPTIONS_deflate, @_); - croak "Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified " . + croak "Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified " . $got->value('Bufsize') unless $got->value('Bufsize') >= 1; @@ -408,11 +408,11 @@ sub Compress::Raw::Zlib::Deflate::new if ($windowBits & MAX_WBITS()) == 0 ; _deflateInit($flags, - $got->value('Level'), - $got->value('Method'), - $windowBits, - $got->value('MemLevel'), - $got->value('Strategy'), + $got->value('Level'), + $got->value('Method'), + $windowBits, + $got->value('MemLevel'), + $got->value('Strategy'), $got->value('Bufsize'), $got->value('Dictionary')) ; @@ -431,7 +431,7 @@ sub Compress::Raw::Zlib::deflateStream::STORABLE_thaw } -our $OPTIONS_inflate = +our $OPTIONS_inflate = { 'AppendOutput' => [1, 1, Parse_boolean, 0], 'LimitOutput' => [1, 1, Parse_boolean, 0], @@ -439,7 +439,7 @@ our $OPTIONS_inflate = 'ADLER32' => [1, 1, Parse_boolean, 0], 'ConsumeInput' => [1, 1, Parse_boolean, 1], 'Bufsize' => [1, 1, Parse_unsigned, 4096], - + 'WindowBits' => [1, 1, Parse_signed, MAX_WBITS()], 'Dictionary' => [1, 1, Parse_any, ""], } ; @@ -449,7 +449,7 @@ sub Compress::Raw::Zlib::Inflate::new my $pkg = shift ; my ($got) = ParseParameters(0, $OPTIONS_inflate, @_); - croak "Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified " . + croak "Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified " . $got->value('Bufsize') unless $got->value('Bufsize') >= 1; @@ -465,7 +465,7 @@ sub Compress::Raw::Zlib::Inflate::new $windowBits += MAX_WBITS() if ($windowBits & MAX_WBITS()) == 0 ; - _inflateInit($flags, $windowBits, $got->value('Bufsize'), + _inflateInit($flags, $windowBits, $got->value('Bufsize'), $got->value('Dictionary')) ; } @@ -489,13 +489,13 @@ sub Compress::Raw::Zlib::InflateScan::new 'CRC32' => [1, 1, Parse_boolean, 0], 'ADLER32' => [1, 1, Parse_boolean, 0], 'Bufsize' => [1, 1, Parse_unsigned, 4096], - + 'WindowBits' => [1, 1, Parse_signed, -MAX_WBITS()], 'Dictionary' => [1, 1, Parse_any, ""], }, @_) ; - croak "Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified " . + croak "Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified " . $got->value('Bufsize') unless $got->value('Bufsize') >= 1; @@ -505,7 +505,7 @@ sub Compress::Raw::Zlib::InflateScan::new $flags |= FLAG_ADLER if $got->value('ADLER32') ; #$flags |= FLAG_CONSUME_INPUT if $got->value('ConsumeInput') ; - _inflateScanInit($flags, $got->value('WindowBits'), $got->value('Bufsize'), + _inflateScanInit($flags, $got->value('WindowBits'), $got->value('Bufsize'), '') ; } @@ -518,7 +518,7 @@ sub Compress::Raw::Zlib::inflateScanStream::createDeflateStream 'CRC32' => [1, 1, Parse_boolean, 0], 'ADLER32' => [1, 1, Parse_boolean, 0], 'Bufsize' => [1, 1, Parse_unsigned, 4096], - + 'Level' => [1, 1, Parse_signed, Z_DEFAULT_COMPRESSION()], 'Method' => [1, 1, Parse_unsigned, Z_DEFLATED()], 'WindowBits' => [1, 1, Parse_signed, - MAX_WBITS()], @@ -526,7 +526,7 @@ sub Compress::Raw::Zlib::inflateScanStream::createDeflateStream 'Strategy' => [1, 1, Parse_unsigned, Z_DEFAULT_STRATEGY()], }, @_) ; - croak "Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified " . + croak "Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified " . $got->value('Bufsize') unless $got->value('Bufsize') >= 1; @@ -536,11 +536,11 @@ sub Compress::Raw::Zlib::inflateScanStream::createDeflateStream $flags |= FLAG_ADLER if $got->value('ADLER32') ; $pkg->_createDeflateStream($flags, - $got->value('Level'), - $got->value('Method'), - $got->value('WindowBits'), - $got->value('MemLevel'), - $got->value('Strategy'), + $got->value('Level'), + $got->value('Method'), + $got->value('WindowBits'), + $got->value('MemLevel'), + $got->value('Strategy'), $got->value('Bufsize'), ) ; @@ -556,10 +556,10 @@ sub Compress::Raw::Zlib::inflateScanStream::inflate if ($status == Z_OK() && $_[2]) { my $byte = ' '; - + $status = $self->scan(\$byte, $_[1]) ; } - + return $status ; } @@ -570,14 +570,14 @@ sub Compress::Raw::Zlib::deflateStream::deflateParams 'Level' => [1, 1, Parse_signed, undef], 'Strategy' => [1, 1, Parse_unsigned, undef], 'Bufsize' => [1, 1, Parse_unsigned, undef], - }, + }, @_) ; croak "Compress::Raw::Zlib::deflateParams needs Level and/or Strategy" unless $got->parsed('Level') + $got->parsed('Strategy') + $got->parsed('Bufsize'); - croak "Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified " . + croak "Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified " . $got->value('Bufsize') if $got->parsed('Bufsize') && $got->value('Bufsize') <= 1; @@ -586,7 +586,7 @@ sub Compress::Raw::Zlib::deflateStream::deflateParams $flags |= 2 if $got->parsed('Strategy') ; $flags |= 4 if $got->parsed('Bufsize') ; - $self->_deflateParams($flags, $got->value('Level'), + $self->_deflateParams($flags, $got->value('Level'), $got->value('Strategy'), $got->value('Bufsize')); } @@ -931,18 +931,18 @@ input, deflates it and writes it to standard output. while (<>) { $status = $x->deflate($_, $output) ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; } - + $status = $x->flush($output) ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; =head1 Compress::Raw::Zlib::Inflate @@ -1210,26 +1210,26 @@ Here is an example of using C. use strict ; use warnings ; - + use Compress::Raw::Zlib; - + my $x = new Compress::Raw::Zlib::Inflate() or die "Cannot create a inflation stream\n" ; - + my $input = '' ; binmode STDIN; binmode STDOUT; - + my ($output, $status) ; while (read(STDIN, $input, 4096)) { $status = $x->inflate($input, $output) ; - + print $output ; - + last if $status != Z_OK ; } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1243,16 +1243,16 @@ simpler. use strict ; use warnings ; - + use Compress::Raw::Zlib; - + my $x = new Compress::Raw::Zlib::Inflate(LimitOutput => 1) or die "Cannot create a inflation stream\n" ; - + my $input = '' ; binmode STDIN; binmode STDOUT; - + my ($output, $status) ; OUTER: @@ -1269,7 +1269,7 @@ simpler. } while ($status == Z_OK && length $input); } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1324,24 +1324,24 @@ source and uncompressing as you go the code will look something like this use strict ; use warnings ; - + use Compress::Raw::Zlib; - + my $x = new Compress::Raw::Zlib::Inflate() or die "Cannot create a inflation stream\n" ; - + my $input = '' ; - + my ($output, $status) ; while (read(STDIN, $input, 4096)) { $status = $x->inflate($input, $output) ; - + print $output ; - + last if $status != Z_OK ; } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1391,16 +1391,16 @@ Below is typical code that shows how to use C. use strict ; use warnings ; - + use Compress::Raw::Zlib; - + my $x = new Compress::Raw::Zlib::Inflate(LimitOutput => 1) or die "Cannot create a inflation stream\n" ; - + my $input = '' ; binmode STDIN; binmode STDOUT; - + my ($output, $status) ; OUTER: @@ -1417,7 +1417,7 @@ Below is typical code that shows how to use C. } while ($status == Z_OK && length $input); } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1596,8 +1596,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/Compress-Raw-Zlib/private/MakeUtil.pm b/cpan/Compress-Raw-Zlib/private/MakeUtil.pm index 12fa26fd05f1..aa540c68fda3 100644 --- a/cpan/Compress-Raw-Zlib/private/MakeUtil.pm +++ b/cpan/Compress-Raw-Zlib/private/MakeUtil.pm @@ -42,14 +42,14 @@ sub MY::libscan return $path; } -sub MY::postamble +sub MY::postamble { return '' if $ENV{PERL_CORE} ; my @files = getPerlFiles('MANIFEST'); - # Note: Once you remove all the layers of shell/makefile escaping + # Note: Once you remove all the layers of shell/makefile escaping # the regular expression below reads # # /^\s*local\s*\(\s*\$^W\s*\)/ @@ -215,7 +215,7 @@ sub UpDowngrade foreach (@files) { #if (-l $_ ) { doUpDown($our_sub, $warn_sub, $_) } - #else + #else #{ doUpDownViaCopy($our_sub, $warn_sub, $_) } } @@ -234,7 +234,7 @@ sub doUpDown local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; local (@ARGV) = shift; - + while (<>) { print, last if /^__(END|DATA)__/ ; @@ -277,7 +277,7 @@ sub doUpDownViaCopy push @keep, $_; last ; } - + &{ $our_sub }() if $our_sub ; &{ $warn_sub }() if $warn_sub ; push @keep, $_; @@ -334,7 +334,7 @@ sub FindBrokenDependencies Compress::Zlib ); - + my @broken = (); foreach my $module ( grep { ! $thisModule{$_} } @modules) @@ -342,12 +342,12 @@ sub FindBrokenDependencies my $hasVersion = getInstalledVersion($module); # No need to upgrade if the module isn't installed at all - next + next if ! defined $hasVersion; # If already have C::Z version 1, then an upgrade to any of the # IO::Compress modules will not break it. - next + next if $module eq 'Compress::Zlib' && $hasVersion < 2; if ($hasVersion < $version) @@ -370,14 +370,12 @@ sub getInstalledVersion { no strict 'refs'; $version = ${ $module . "::VERSION" }; - $version = 0 + $version = 0 } - + return $version; } package MakeUtil ; 1; - - diff --git a/cpan/Compress-Raw-Zlib/t/01version.t b/cpan/Compress-Raw-Zlib/t/01version.t index 46200bc9a974..a38a1e6b3b90 100644 --- a/cpan/Compress-Raw-Zlib/t/01version.t +++ b/cpan/Compress-Raw-Zlib/t/01version.t @@ -11,8 +11,8 @@ use warnings ; use Test::More ; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -20,13 +20,13 @@ BEGIN plan tests => 2 + $extra ; - use_ok('Compress::Raw::Zlib', 2) ; + use_ok('Compress::Raw::Zlib', 2) ; } # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; my $zlib_h = ZLIB_VERSION ; my $libz = Compress::Raw::Zlib::zlib_version; @@ -35,12 +35,11 @@ SKIP: { or diag < "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -27,7 +27,7 @@ BEGIN plan tests => 288 + $extra ; - use_ok('Compress::Raw::Zlib', 2) ; + use_ok('Compress::Raw::Zlib', 2) ; } @@ -40,7 +40,7 @@ my $len = length $hello ; # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ; @@ -54,18 +54,18 @@ for my $i (1 .. 13) my $hello = "I am a HAL 9000 computer" x 2001; my $tmp = $hello ; - + my @hello = (); - push @hello, $1 + push @hello, $1 while $tmp =~ s/^(.{$i})//; push @hello, $tmp if length $tmp ; - my ($err, $x, $X, $status); - + my ($err, $x, $X, $status); + ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (-AppendOutput => 1)); ok $x ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; - + ok ! defined $x->msg(), " no msg" ; is $x->total_in(), 0, " total_in == 0" ; is $x->total_out(), 0, " total_out == 0" ; @@ -75,26 +75,26 @@ for my $i (1 .. 13) { $status = $x->deflate($_, $out) ; last unless $status == Z_OK ; - + } cmp_ok $status, '==', Z_OK, " status is Z_OK" ; - + cmp_ok $x->flush($out), '==', Z_OK, " flush returned Z_OK" ; - + ok ! defined $x->msg(), " no msg" ; is $x->total_in(), length $hello, " length total_in" ; is $x->total_out(), length $out, " length total_out" ; - + my @Answer = (); $tmp = $out; push @Answer, $1 while $tmp =~ s/^(.{$i})//; push @Answer, $tmp if length $tmp ; - + my $k; ok(($k, $err) = new Compress::Raw::Zlib::Inflate( -AppendOutput => 1)); ok $k ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; - + ok ! defined $k->msg(), " no msg" ; is $k->total_in(), 0, " total_in == 0" ; is $k->total_out(), 0, " total_out == 0" ; @@ -105,9 +105,9 @@ for my $i (1 .. 13) { $status = $k->inflate($_, $GOT) ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + cmp_ok $status, '==', Z_STREAM_END, " status is Z_STREAM_END" ; is $GOT, $hello, " got expected output" ; ok ! defined $k->msg(), " no msg" ; diff --git a/cpan/Compress-Raw-Zlib/t/09limitoutput.t b/cpan/Compress-Raw-Zlib/t/09limitoutput.t index 2532f9c69266..b77a3b154e3a 100644 --- a/cpan/Compress-Raw-Zlib/t/09limitoutput.t +++ b/cpan/Compress-Raw-Zlib/t/09limitoutput.t @@ -13,8 +13,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -22,7 +22,7 @@ BEGIN plan tests => 107 + $extra ; - use_ok('Compress::Raw::Zlib', 2) ; + use_ok('Compress::Raw::Zlib', 2) ; } @@ -30,7 +30,7 @@ BEGIN my $hello = "I am a HAL 9000 computer" x 2001; my $tmp = $hello ; -my ($err, $x, $X, $status); +my ($err, $x, $X, $status); ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (-AppendOutput => 1)); ok $x ; @@ -41,8 +41,8 @@ $status = $x->deflate($tmp, $out) ; cmp_ok $status, '==', Z_OK, " status is Z_OK" ; cmp_ok $x->flush($out), '==', Z_OK, " flush returned Z_OK" ; - - + + sub getOut { my $x = ''; return \$x } for my $bufsize (1, 2, 3, 13, 4096, 1024*10) @@ -57,7 +57,7 @@ for my $bufsize (1, 2, 3, 13, 4096, 1024*10) )); ok $k ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; - + ok ! defined $k->msg(), " no msg" ; is $k->total_in(), 0, " total_in == 0" ; is $k->total_out(), 0, " total_out == 0" ; @@ -73,7 +73,7 @@ for my $bufsize (1, 2, 3, 13, 4096, 1024*10) last if $status == Z_STREAM_END || $status == Z_DATA_ERROR || $status == Z_STREAM_ERROR ; $deltaOK = 0 if length($GOT) - $prev > $bufsize; } - + ok $deltaOK, " Output Delta never > $bufsize"; cmp_ok $looped, '>=', 1, " looped $looped"; is length($tmp), 0, " length of input buffer is zero"; @@ -89,7 +89,7 @@ sub getit { my $obj = shift ; my $input = shift; - + my $data ; 1 while $obj->inflate($input, $data) != Z_STREAM_END ; return \$data ; @@ -97,9 +97,9 @@ sub getit { title "regression test"; - - my ($err, $x, $X, $status); - + + my ($err, $x, $X, $status); + ok( ($x, $err) = new Compress::Raw::Zlib::Deflate (-AppendOutput => 1)); ok $x ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; @@ -108,11 +108,11 @@ sub getit my $line2 = "second line\n" ; my $text = $line1 . $line2 ; my $tmp = $text; - + my $out ; $status = $x->deflate($tmp, $out) ; cmp_ok $status, '==', Z_OK, " status is Z_OK" ; - + cmp_ok $x->flush($out), '==', Z_OK, " flush returned Z_OK" ; my $k; @@ -120,40 +120,39 @@ sub getit LimitOutput => 1 )); - + my $c = getit($k, $out); is $$c, $text; - - + + } { title "regression test for #92521: Z_OK instead of Z_BUF_ERROR"; - - # 1M "aaa..." - my $in = 'a' x 100000; - my ($deflate, $err) = Compress::Raw::Zlib::Deflate->new(WindowBits => -15, - MemLevel => 8); + + # 1M "aaa..." + my $in = 'a' x 100000; + my ($deflate, $err) = Compress::Raw::Zlib::Deflate->new(WindowBits => -15, + MemLevel => 8); ok $deflate ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; - my $status = $deflate->deflate($in, my $zip); + my $status = $deflate->deflate($in, my $zip); cmp_ok $status, '==', Z_OK, " status is Z_OK" ; - cmp_ok $deflate->flush($zip, Z_SYNC_FLUSH), "==", Z_OK; + cmp_ok $deflate->flush($zip, Z_SYNC_FLUSH), "==", Z_OK; - # Compression should stop after 10K "aaa..." with Z_BUF_ERROR + # Compression should stop after 10K "aaa..." with Z_BUF_ERROR my $inflate; - ($inflate, $err) = Compress::Raw::Zlib::Inflate->new( Bufsize => 10000, - LimitOutput => 1, WindowBits => -15 ); + ($inflate, $err) = Compress::Raw::Zlib::Inflate->new( Bufsize => 10000, + LimitOutput => 1, WindowBits => -15 ); ok $inflate ; cmp_ok $err, '==', Z_OK, " status is Z_OK" ; - $status = $inflate->inflate($zip, my $out); + $status = $inflate->inflate($zip, my $out); cmp_ok length($out), ">=", 10000; - #warn 'RESULT: ', length($out), ' of ', length($in), "\n"; + #warn 'RESULT: ', length($out), ' of ', length($in), "\n"; cmp_ok $status, '==', Z_BUF_ERROR, " status is Z_BUF_ERROR" ; } - diff --git a/cpan/Compress-Raw-Zlib/t/18lvalue.t b/cpan/Compress-Raw-Zlib/t/18lvalue.t index 3b102c799e96..98d8423d10c1 100644 --- a/cpan/Compress-Raw-Zlib/t/18lvalue.t +++ b/cpan/Compress-Raw-Zlib/t/18lvalue.t @@ -13,10 +13,10 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan(skip_all => "lvalue sub tests need Perl ??") - if $] < 5.006 ; + if $] < 5.006 ; # use Test::NoWarnings, if available my $extra = 0 ; @@ -27,7 +27,7 @@ BEGIN use_ok('Compress::Raw::Zlib', 2) ; } - + my $hello = <deflate(getData, getX), '==', Z_OK ; cmp_ok $x->flush(getX), '==', Z_OK ; - + my $append = "Appended" ; $X .= $append ; - + ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1 ) ; - + cmp_ok $k->inflate(getX, getZ), '==', Z_STREAM_END ; ; - + ok $hello eq $Z ; is $X, $append; - -} - +} diff --git a/cpan/Compress-Raw-Zlib/t/19nonpv.t b/cpan/Compress-Raw-Zlib/t/19nonpv.t index bbc20c764867..2567ec55b378 100644 --- a/cpan/Compress-Raw-Zlib/t/19nonpv.t +++ b/cpan/Compress-Raw-Zlib/t/19nonpv.t @@ -12,8 +12,8 @@ use warnings; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -23,7 +23,7 @@ BEGIN use_ok('Compress::Raw::Zlib', 2) ; } - + my $hello = < Z_BEST_COMPRESSION, -Dictionary => $dictionary}) ; - + my $dictID = $x->dict_adler() ; my ($X, $Y, $Z); cmp_ok $x->deflate($hello, $X), '==', Z_OK; cmp_ok $x->flush($Y), '==', Z_OK; $X .= $Y ; - + ok my $k = new Compress::Raw::Zlib::Inflate(-Dictionary => $dictionary) ; - + cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END; is $k->dict_adler(), $dictID; is $hello, $Z ; @@ -72,12 +72,12 @@ SKIP: { # ============================== my $hello = *hello ; - my ($err, $x, $X, $status); - + my ($err, $x, $X, $status); + ok( ($x, $err) = new Compress::Raw::Zlib::Deflate, "Create deflate object" ); ok $x, "Compress::Raw::Zlib::Deflate ok" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ok ! defined $x->msg() ; is $x->total_in(), 0, "total_in() == 0" ; is $x->total_out(), 0, "total_out() == 0" ; @@ -86,22 +86,22 @@ SKIP: { my $Answer = ''; $status = $x->deflate($hello, $X) ; $Answer .= $X ; - + cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; - + $X = *X; cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ; $Answer .= $X ; - + ok ! defined $x->msg() ; is $x->total_in(), length $hello, "total_in ok" ; is $x->total_out(), length $Answer, "total_out ok" ; - + my $k; ok(($k, $err) = new Compress::Raw::Zlib::Inflate); ok $k, "Compress::Raw::Zlib::Inflate ok" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ok ! defined $k->msg(), "No error messages" ; is $k->total_in(), 0, "total_in() == 0" ; is $k->total_out(), 0, "total_out() == 0" ; @@ -111,7 +111,7 @@ SKIP: { my $Alen = length $Answer; $status = $k->inflate($Answer, $Z) ; $GOT .= $Z ; - + cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; is $GOT, $hello, "uncompressed data matches ok" ; ok ! defined $k->msg(), "No error messages" ; @@ -132,4 +132,3 @@ SKIP: { cmp_ok $status, "!=", Z_OK, "inflateSync on *hello returns error (and does not crash)"; } - diff --git a/cpan/Compress-Raw-Zlib/t/compress/CompTestUtils.pm b/cpan/Compress-Raw-Zlib/t/compress/CompTestUtils.pm index c506632f90e3..fd9d963e0344 100644 --- a/cpan/Compress-Raw-Zlib/t/compress/CompTestUtils.pm +++ b/cpan/Compress-Raw-Zlib/t/compress/CompTestUtils.pm @@ -9,13 +9,13 @@ use bytes; #use lib qw(t t/compress); use Carp ; -#use Test::More ; +#use Test::More ; sub title { - #diag "" ; + #diag "" ; ok(1, $_[0]) ; #diag "" ; } @@ -26,7 +26,7 @@ sub like_eval } BEGIN { - eval { + eval { require File::Temp; } ; @@ -38,7 +38,7 @@ BEGIN { our ($index); $index = '00000'; - + sub new { my $self = shift ; @@ -72,7 +72,7 @@ BEGIN { $index = '00000'; our ($useTempFile); our ($useTempDir); - + sub new { my $self = shift ; @@ -115,11 +115,11 @@ BEGIN { # autogenerate the name if none supplied $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ; } - foreach (@_) - { + foreach (@_) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_; - mkdir $_, 0777 + if -d $_; + mkdir $_, 0777 } bless [ @_ ], $self ; } @@ -131,10 +131,10 @@ BEGIN { if (! $useTempFile) { my $self = shift ; - foreach (@$self) - { + foreach (@$self) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_ ; + if -d $_ ; } } } @@ -150,15 +150,15 @@ sub readFile { my $pos = tell($f); seek($f, 0,0); - @strings = <$f> ; + @strings = <$f> ; seek($f, 0, $pos); } else { - open (F, "<$f") + open (F, "<$f") or croak "Cannot open $f: $!\n" ; binmode F; - @strings = ; + @strings = ; close F ; } @@ -175,7 +175,7 @@ sub writeFile { my($filename, @strings) = @_ ; 1 while unlink $filename ; - open (F, ">$filename") + open (F, ">$filename") or croak "Cannot open $filename: $!\n" ; binmode F; foreach (@strings) { @@ -191,10 +191,10 @@ sub GZreadFile my ($uncomp) = "" ; my $line = "" ; - my $fil = gzopen($filename, "rb") + my $fil = gzopen($filename, "rb") or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; - $uncomp .= $line + $uncomp .= $line while $fil->gzread($line) > 0; $fil->gzclose ; @@ -248,7 +248,7 @@ sub readHeaderInfo some text EOM - ok my $x = new IO::Compress::Gzip $name, %opts + ok my $x = new IO::Compress::Gzip $name, %opts or diag "GzipError is $IO::Compress::Gzip::GzipError" ; ok $x->write($string) ; ok $x->close ; @@ -562,9 +562,9 @@ sub anyUncompress } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - Append => 1, - Transparent => 0, + my $o = new IO::Uncompress::AnyUncompress \$data, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts @@ -622,10 +622,10 @@ sub getHeaders } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - MultiStream => 1, - Append => 1, - Transparent => 0, + my $o = new IO::Uncompress::AnyUncompress \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts diff --git a/cpan/Compress-Raw-Zlib/typemap b/cpan/Compress-Raw-Zlib/typemap index 36fce4aa94f0..cf73c737c15c 100644 --- a/cpan/Compress-Raw-Zlib/typemap +++ b/cpan/Compress-Raw-Zlib/typemap @@ -41,7 +41,6 @@ T_PTROBJ_AV else if (sv_derived_from($arg, \"${ntype}\")) { IV tmp = SvIV(getInnerObject($arg)) ; $var = INT2PTR($type, tmp); - } else croak(\"$var is not of type ${ntype}\") @@ -58,5 +57,3 @@ T_DUAL T_PV sv_setpv((SV*)$arg, $var); - - From 8d01fcd8d240d5051df69aa7e48deb774903458f Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 18 Jan 2021 02:03:53 +0000 Subject: [PATCH 437/503] Update ExtUtils::Manifest from 1.72 to 1.73 --- Porting/Maintainers.pl | 2 +- cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP | 3 +++ cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm | 8 ++++---- 3 files changed, 8 insertions(+), 5 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 2dbb3bf4f1f0..9fc327917566 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -493,7 +493,7 @@ package Maintainers; }, 'ExtUtils::Manifest' => { - 'DISTRIBUTION' => 'ETHER/ExtUtils-Manifest-1.72.tar.gz', + 'DISTRIBUTION' => 'ETHER/ExtUtils-Manifest-1.73.tar.gz', 'FILES' => q[cpan/ExtUtils-Manifest], 'EXCLUDED' => [ qr(^t/00-report-prereqs), diff --git a/cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP b/cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP index 72286fdf199b..9d1430745a67 100644 --- a/cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP +++ b/cpan/ExtUtils-Manifest/lib/ExtUtils/MANIFEST.SKIP @@ -5,6 +5,7 @@ ,v$ \B\.svn\b \B\.git\b +^\.github\b \B\.gitignore\b \b_darcs\b \B\.cvsignore$ @@ -51,6 +52,8 @@ \B\.DS_Store # Mac OSX SMB mount metadata files \B\._ +# Placeholder files created when iCloud will "optimize Mac storage" +\.i[cC]loud$ # Avoid Devel::Cover and Devel::CoverX::Covered files. \bcover_db\b diff --git a/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm b/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm index 201fd36cb9eb..c0a7b06764a6 100644 --- a/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm +++ b/cpan/ExtUtils-Manifest/lib/ExtUtils/Manifest.pm @@ -1,4 +1,4 @@ -package ExtUtils::Manifest; # git description: 1.71-18-g17b7919 +package ExtUtils::Manifest; # git description: 1.72-7-g54209ce require Exporter; use Config; @@ -10,7 +10,7 @@ use Carp; use strict; use warnings; -our $VERSION = '1.72'; +our $VERSION = '1.73'; our @ISA = ('Exporter'); our @EXPORT_OK = qw(mkmanifest manicheck filecheck fullcheck skipcheck @@ -56,7 +56,7 @@ our $Verbose = defined $ENV{PERL_MM_MANIFEST_VERBOSE} ? our $Quiet = 0; our $MANIFEST = 'MANIFEST'; -our $DEFAULT_MSKIP = File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" ); +our $DEFAULT_MSKIP = File::Spec->rel2abs(File::Spec->catfile( dirname(__FILE__), "$MANIFEST.SKIP" )); =head1 NAME @@ -65,7 +65,7 @@ ExtUtils::Manifest - Utilities to write and check a MANIFEST file =head1 VERSION -version 1.72 +version 1.73 =head1 SYNOPSIS From 3b97bda7a8e804addcbd10fb61a354d31351ce0c Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 18 Jan 2021 02:23:31 +0000 Subject: [PATCH 438/503] Update IO-Compress from 2.096 to 2.100 --- Porting/Maintainers.pl | 2 +- cpan/IO-Compress/Makefile.PL | 2 +- cpan/IO-Compress/bin/zipdetails | 28 +- cpan/IO-Compress/lib/Compress/Zlib.pm | 199 ++++---- cpan/IO-Compress/lib/File/GlobMapper.pm | 4 +- .../lib/IO/Compress/Adapter/Bzip2.pm | 33 +- .../lib/IO/Compress/Adapter/Deflate.pm | 39 +- .../lib/IO/Compress/Adapter/Identity.pm | 19 +- cpan/IO-Compress/lib/IO/Compress/Base.pm | 55 ++- .../lib/IO/Compress/Base/Common.pm | 10 +- cpan/IO-Compress/lib/IO/Compress/Bzip2.pm | 31 +- cpan/IO-Compress/lib/IO/Compress/Deflate.pm | 28 +- cpan/IO-Compress/lib/IO/Compress/FAQ.pod | 68 +-- cpan/IO-Compress/lib/IO/Compress/Gzip.pm | 50 +- .../lib/IO/Compress/Gzip/Constants.pm | 12 +- .../IO-Compress/lib/IO/Compress/RawDeflate.pm | 61 ++- cpan/IO-Compress/lib/IO/Compress/Zip.pm | 55 ++- .../lib/IO/Compress/Zip/Constants.pm | 2 +- .../lib/IO/Compress/Zlib/Constants.pm | 4 +- .../IO-Compress/lib/IO/Compress/Zlib/Extra.pm | 40 +- .../lib/IO/Uncompress/Adapter/Bunzip2.pm | 23 +- .../lib/IO/Uncompress/Adapter/Identity.pm | 14 +- .../lib/IO/Uncompress/Adapter/Inflate.pm | 27 +- .../lib/IO/Uncompress/AnyInflate.pm | 34 +- .../lib/IO/Uncompress/AnyUncompress.pm | 57 ++- cpan/IO-Compress/lib/IO/Uncompress/Base.pm | 265 +++++----- cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm | 31 +- cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm | 61 ++- cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm | 43 +- .../lib/IO/Uncompress/RawInflate.pm | 73 ++- cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm | 37 +- cpan/IO-Compress/private/MakeUtil.pm | 22 +- cpan/IO-Compress/t/000prereq.t | 19 +- cpan/IO-Compress/t/001bzip2.t | 38 +- cpan/IO-Compress/t/002any-transparent.t | 8 +- cpan/IO-Compress/t/004gziphdr.t | 247 +++++----- cpan/IO-Compress/t/005defhdr.t | 38 +- cpan/IO-Compress/t/006zip.t | 166 +++---- cpan/IO-Compress/t/011-streamzip.t | 18 +- cpan/IO-Compress/t/01misc.t | 110 ++--- cpan/IO-Compress/t/020isize.t | 23 +- cpan/IO-Compress/t/050interop-gzip.t | 24 +- cpan/IO-Compress/t/101truncate-bzip2.t | 2 +- cpan/IO-Compress/t/101truncate-deflate.t | 2 +- cpan/IO-Compress/t/101truncate-gzip.t | 2 +- cpan/IO-Compress/t/101truncate-rawdeflate.t | 35 +- cpan/IO-Compress/t/101truncate-zip.t | 2 +- cpan/IO-Compress/t/105oneshot-gzip-only.t | 17 +- .../IO-Compress/t/105oneshot-zip-bzip2-only.t | 27 +- cpan/IO-Compress/t/105oneshot-zip-only.t | 14 +- .../IO-Compress/t/105oneshot-zip-store-only.t | 7 +- cpan/IO-Compress/t/107multi-zip-only.t | 8 +- cpan/IO-Compress/t/108anyunc-transparent.t | 8 +- cpan/IO-Compress/t/111const-deflate.t | 53 +- cpan/IO-Compress/t/112utf8-zip.t | 52 +- cpan/IO-Compress/t/compress/CompTestUtils.pm | 60 +-- cpan/IO-Compress/t/compress/any.pl | 22 +- cpan/IO-Compress/t/compress/anyunc.pl | 20 +- cpan/IO-Compress/t/compress/destroy.pl | 36 +- cpan/IO-Compress/t/compress/encode.pl | 81 ++- cpan/IO-Compress/t/compress/generic.pl | 462 +++++++++--------- cpan/IO-Compress/t/compress/merge.pl | 54 +- cpan/IO-Compress/t/compress/multi.pl | 34 +- cpan/IO-Compress/t/compress/newtied.pl | 84 ++-- cpan/IO-Compress/t/compress/oneshot.pl | 238 ++++----- cpan/IO-Compress/t/compress/prime.pl | 18 +- cpan/IO-Compress/t/compress/tied.pl | 138 +++--- cpan/IO-Compress/t/compress/truncate.pl | 73 ++- cpan/IO-Compress/t/compress/zlib-generic.pl | 78 ++- cpan/IO-Compress/t/cz-01version.t | 12 +- cpan/IO-Compress/t/cz-03zlib-v1.t | 302 ++++++------ cpan/IO-Compress/t/cz-06gzsetp.t | 42 +- cpan/IO-Compress/t/cz-08encoding.t | 21 +- cpan/IO-Compress/t/cz-14gzopen.t | 224 ++++----- cpan/IO-Compress/t/globmapper.t | 61 ++- 75 files changed, 2190 insertions(+), 2219 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 9fc327917566..ab5ab5e313d9 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -636,7 +636,7 @@ package Maintainers; }, 'IO-Compress' => { - 'DISTRIBUTION' => 'PMQS/IO-Compress-2.096.tar.gz', + 'DISTRIBUTION' => 'PMQS/IO-Compress-2.100.tar.gz', 'FILES' => q[cpan/IO-Compress], 'EXCLUDED' => [ qr{^examples/}, diff --git a/cpan/IO-Compress/Makefile.PL b/cpan/IO-Compress/Makefile.PL index 1249a3c7a035..d55f014296f0 100644 --- a/cpan/IO-Compress/Makefile.PL +++ b/cpan/IO-Compress/Makefile.PL @@ -3,7 +3,7 @@ use strict ; require 5.006 ; -$::VERSION = '2.096' ; +$::VERSION = '2.100' ; use lib '.'; use private::MakeUtil; diff --git a/cpan/IO-Compress/bin/zipdetails b/cpan/IO-Compress/bin/zipdetails index 6a054cd4cd91..55276af67bb7 100644 --- a/cpan/IO-Compress/bin/zipdetails +++ b/cpan/IO-Compress/bin/zipdetails @@ -188,7 +188,7 @@ my %Extras = ( ); -my $VERSION = "2.01" ; +my $VERSION = "2.02" ; my $FH; @@ -198,10 +198,10 @@ my $LocalHeaderCount = 0; my $CentralHeaderCount = 0; my $START; -my $OFFSET = new U64 0; +my $OFFSET = U64->new( 0 ); my $TRAILING = 0 ; -my $PAYLOADLIMIT = 256; #new U64 256; -my $ZERO = new U64 0 ; +my $PAYLOADLIMIT = 256; # U64->new( 256 ); +my $ZERO = U64->new( 0 ); sub prOff { @@ -595,7 +595,7 @@ sub read_U64 myRead($b, 8); my ($lo, $hi) = unpack ("V V" , $b); no warnings 'uninitialized'; - return ($b, new U64 $hi, $lo); + return ($b, U64->new( $hi, $lo) ); } sub read_VV @@ -714,7 +714,7 @@ die "$filename does not exist\n" die "$filename not a standard file\n" unless -f $filename ; -$FH = new IO::File "<$filename" +$FH = IO::File->new( "<$filename" ) or die "Cannot open $filename: $!\n"; @@ -901,7 +901,7 @@ sub LocalHeader myRead($filename, $filenameLength); outputFilename($filename); - my $cl64 = new U64 $compressedLength ; + my $cl64 = U64->new( $compressedLength ); my %ExtraContext = (); if ($extraLength) { @@ -1154,7 +1154,7 @@ sub GeneralPurposeBits if ($method == ZIP_CM_DEFLATE) { - my $mid = $gp & 0x03; + my $mid = ($gp >> 1) & 0x03 ; out1 "[Bits 1-2]", "$mid '$lookup{$mid}'"; } @@ -1171,8 +1171,8 @@ sub GeneralPurposeBits if ($method == ZIP_CM_IMPLODE) # Imploding { - out1 "[Bit 1]", ($gp & 1 ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ; - out1 "[Bit 2]", ($gp & 2 ? "1 '3" : "0 '2" ) . " Shannon-Fano Trees'" ; + out1 "[Bit 1]", ($gp & (1 << 1) ? "1 '8k" : "0 '4k") . " Sliding Dictionary'" ; + out1 "[Bit 2]", ($gp & (2 << 1) ? "1 '3" : "0 '2" ) . " Shannon-Fano Trees'" ; } out1 "[Bit 3]", "1 'Streamed'" if $gp & ZIP_GP_FLAG_STREAMING_MASK; @@ -1363,7 +1363,7 @@ sub Ntfs2Unix # NTFS offset is 19DB1DED53E8000 my $hex = Value_U64($u64) ; - my $NTFS_OFFSET = new U64 0x19DB1DE, 0xD53E8000 ; + my $NTFS_OFFSET = U64->new( 0x19DB1DE, 0xD53E8000 ); $u64->subtract($NTFS_OFFSET); my $elapse = $u64->get64bit(); my $ns = ($elapse % 10000000) * 100; @@ -1766,8 +1766,8 @@ sub scanCentralDirectory my $got = [$locHeaderOffset, $compressedLength] ; - # my $v64 = new U64 $compressedLength ; - # my $loc64 = new U64 $locHeaderOffset ; + # my $v64 = U64->new( $compressedLength ); + # my $loc64 = U64->new( $locHeaderOffset ); # my $got = [$loc64, $v64] ; # if (full32 $compressedLength || full32 $locHeaderOffset) { @@ -2285,7 +2285,7 @@ OPTIONS -v Verbose - output more stuff --version Print version number -Copyright (c) 2011-2020 Paul Marquess. All rights reserved. +Copyright (c) 2011-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/IO-Compress/lib/Compress/Zlib.pm b/cpan/IO-Compress/lib/Compress/Zlib.pm index 1290b1d63356..238027128955 100644 --- a/cpan/IO-Compress/lib/Compress/Zlib.pm +++ b/cpan/IO-Compress/lib/Compress/Zlib.pm @@ -7,18 +7,18 @@ use Carp ; use IO::Handle ; use Scalar::Util qw(dualvar); -use IO::Compress::Base::Common 2.096 ; -use Compress::Raw::Zlib 2.096 ; -use IO::Compress::Gzip 2.096 ; -use IO::Uncompress::Gunzip 2.096 ; +use IO::Compress::Base::Common 2.100 ; +use Compress::Raw::Zlib 2.100 ; +use IO::Compress::Gzip 2.100 ; +use IO::Uncompress::Gunzip 2.100 ; use strict ; use warnings ; use bytes ; our ($VERSION, $XS_VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.096'; -$XS_VERSION = $VERSION; +$VERSION = '2.100'; +$XS_VERSION = $VERSION; $VERSION = eval $VERSION; @ISA = qw(Exporter); @@ -126,7 +126,7 @@ sub gzopen($$) my @params = () ; croak "gzopen: file parameter is not a filehandle or filename" - unless isaFilehandle $file || isaFilename $file || + unless isaFilehandle $file || isaFilename $file || (ref $file && ref $file eq 'SCALAR'); return undef unless $mode =~ /[rwa]/i ; @@ -134,17 +134,17 @@ sub gzopen($$) _set_gzerr(0) ; if ($writing) { - $gz = new IO::Compress::Gzip($file, Minimal => 1, AutoClose => 1, - %defOpts) + $gz = IO::Compress::Gzip->new($file, Minimal => 1, AutoClose => 1, + %defOpts) or $Compress::Zlib::gzerrno = $IO::Compress::Gzip::GzipError; } else { - $gz = new IO::Uncompress::Gunzip($file, + $gz = IO::Uncompress::Gunzip->new($file, Transparent => 1, - Append => 0, - AutoClose => 1, + Append => 0, + AutoClose => 1, MultiStream => 1, - Strict => 0) + Strict => 0) or $Compress::Zlib::gzerrno = $IO::Uncompress::Gunzip::GunzipError; } @@ -161,7 +161,7 @@ sub Compress::Zlib::gzFile::gzread return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'inflate'; - my $len = defined $_[1] ? $_[1] : 4096 ; + my $len = defined $_[1] ? $_[1] : 4096 ; my $gz = $self->[0] ; if ($self->gzeof() || $len == 0) { @@ -171,7 +171,7 @@ sub Compress::Zlib::gzFile::gzread return 0 ; } - my $status = $gz->read($_[0], $len) ; + my $status = $gz->read($_[0], $len) ; _save_gzerr($gz, 1); return $status ; } @@ -185,7 +185,7 @@ sub Compress::Zlib::gzFile::gzreadline # Maintain backward compatibility with 1.x behaviour # It didn't support $/, so this can't either. local $/ = "\n" ; - $_[0] = $gz->getline() ; + $_[0] = $gz->getline() ; } _save_gzerr($gz, 1); return defined $_[0] ? length $_[0] : 0 ; @@ -199,7 +199,7 @@ sub Compress::Zlib::gzFile::gzwrite return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; - $] >= 5.008 and (utf8::downgrade($_[0], 1) + $] >= 5.008 and (utf8::downgrade($_[0], 1) or croak "Wide character in gzwrite"); my $status = $gz->write($_[0]) ; @@ -282,8 +282,8 @@ sub Compress::Zlib::gzFile::gzsetparams return _set_gzerr(Z_STREAM_ERROR()) if $self->[1] ne 'deflate'; - - my $status = *$gz->{Compress}->deflateParams(-Level => $level, + + my $status = *$gz->{Compress}->deflateParams(-Level => $level, -Strategy => $strategy); _save_gzerr($gz); return $status ; @@ -293,7 +293,7 @@ sub Compress::Zlib::gzFile::gzerror { my $self = shift ; my $gz = $self->[0] ; - + return $Compress::Zlib::gzerrno ; } @@ -310,7 +310,7 @@ sub compress($;$) $in = \$_[0] ; } - $] >= 5.008 and (utf8::downgrade($$in, 1) + $] >= 5.008 and (utf8::downgrade($$in, 1) or croak "Wide character in compress"); my $level = (@_ == 2 ? $_[1] : Z_DEFAULT_COMPRESSION() ); @@ -322,7 +322,7 @@ sub compress($;$) MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, - '') + '') or return undef ; $err = $x->deflate($in, $output) ; @@ -330,7 +330,7 @@ sub compress($;$) $err = $x->flush($output) ; return undef unless $err == Z_OK() ; - + return $output ; } @@ -346,21 +346,21 @@ sub uncompress($) $in = \$_[0] ; } - $] >= 5.008 and (utf8::downgrade($$in, 1) - or croak "Wide character in uncompress"); - + $] >= 5.008 and (utf8::downgrade($$in, 1) + or croak "Wide character in uncompress"); + my ($obj, $status) = Compress::Raw::Zlib::_inflateInit(0, - MAX_WBITS, 4096, "") ; - - $status == Z_OK + MAX_WBITS, 4096, "") ; + + $status == Z_OK or return undef; - - $obj->inflate($in, $output) == Z_STREAM_END + + $obj->inflate($in, $output) == Z_STREAM_END or return undef; - + return $output; } - + sub deflateInit(@) { my ($got) = ParseParameters(0, @@ -374,27 +374,27 @@ sub deflateInit(@) 'dictionary' => [IO::Compress::Base::Common::Parse_any, ""], }, @_ ) ; - croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . + croak "Compress::Zlib::deflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $obj ; - + my $status = 0 ; - ($obj, $status) = + ($obj, $status) = Compress::Raw::Zlib::_deflateInit(0, - $got->getValue('level'), - $got->getValue('method'), - $got->getValue('windowbits'), - $got->getValue('memlevel'), - $got->getValue('strategy'), + $got->getValue('level'), + $got->getValue('method'), + $got->getValue('windowbits'), + $got->getValue('memlevel'), + $got->getValue('strategy'), $got->getValue('bufsize'), $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldDeflate" : undef) ; return wantarray ? ($x, $status) : $x ; } - + sub inflateInit(@) { my ($got) = ParseParameters(0, @@ -405,15 +405,15 @@ sub inflateInit(@) }, @_) ; - croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . + croak "Compress::Zlib::inflateInit: Bufsize must be >= 1, you specified " . $got->getValue('bufsize') unless $got->getValue('bufsize') >= 1; my $status = 0 ; my $obj ; ($obj, $status) = Compress::Raw::Zlib::_inflateInit(FLAG_CONSUME_INPUT, - $got->getValue('windowbits'), - $got->getValue('bufsize'), + $got->getValue('windowbits'), + $got->getValue('bufsize'), $got->getValue('dictionary')) ; my $x = ($status == Z_OK() ? bless $obj, "Zlib::OldInflate" : undef) ; @@ -442,7 +442,7 @@ sub flush my $output ; my $flag = shift || Compress::Zlib::Z_FINISH(); my $status = $self->SUPER::flush($output, $flag) ; - + wantarray ? ($output, $status) : $output ; } @@ -461,7 +461,7 @@ sub inflate package Compress::Zlib ; -use IO::Compress::Gzip::Constants 2.096 ; +use IO::Compress::Gzip::Constants 2.100 ; sub memGzip($) { @@ -473,13 +473,13 @@ sub memGzip($) MAX_MEM_LEVEL, Z_DEFAULT_STRATEGY, 4096, - '') + '') or return undef ; - + # if the deflation buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]) ; - $] >= 5.008 and (utf8::downgrade($$string, 1) + $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGzip"); my $out; @@ -487,12 +487,12 @@ sub memGzip($) $x->deflate($string, $out) == Z_OK or return undef ; - + $x->flush($out) == Z_OK or return undef ; - - return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . - $out . + + return IO::Compress::Gzip::Constants::GZIP_MINIMUM_HEADER . + $out . pack("V V", $x->crc32(), $x->total_in()); } @@ -501,10 +501,10 @@ sub _removeGzipHeader($) { my $string = shift ; - return Z_DATA_ERROR() + return Z_DATA_ERROR() if length($$string) < GZIP_MIN_HEADER_SIZE ; - my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = + my ($magic1, $magic2, $method, $flags, $time, $xflags, $oscode) = unpack ('CCCCVCC', $$string); return Z_DATA_ERROR() @@ -551,7 +551,7 @@ sub _removeGzipHeader($) if length ($$string) < GZIP_FHCRC_SIZE ; substr($$string, 0, GZIP_FHCRC_SIZE) = ''; } - + return Z_OK(); } @@ -566,24 +566,24 @@ sub memGunzip($) { # if the buffer isn't a reference, make it one my $string = (ref $_[0] ? $_[0] : \$_[0]); - - $] >= 5.008 and (utf8::downgrade($$string, 1) + + $] >= 5.008 and (utf8::downgrade($$string, 1) or croak "Wide character in memGunzip"); _set_gzerr(0); my $status = _removeGzipHeader($string) ; - $status == Z_OK() + $status == Z_OK() or return _set_gzerr_undef($status); - + my $bufsize = length $$string > 4096 ? length $$string : 4096 ; my $x = Compress::Raw::Zlib::_inflateInit(FLAG_CRC | FLAG_CONSUME_INPUT, - -MAX_WBITS(), $bufsize, '') + -MAX_WBITS(), $bufsize, '') or return _ret_gun_error(); my $output = '' ; $status = $x->inflate($string, $output); - + if ( $status == Z_OK() ) { _set_gzerr(Z_DATA_ERROR()); @@ -606,7 +606,7 @@ sub memGunzip($) $$string = ''; } - return $output; + return $output; } # Autoload methods go after __END__, and are processed by the autosplit program. @@ -938,23 +938,23 @@ I function. use strict ; use warnings ; - + use Compress::Zlib ; - + # use stdin if no files supplied @ARGV = '-' unless @ARGV ; - + foreach my $file (@ARGV) { my $buffer ; - + my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; - + print $buffer while $gz->gzread($buffer) > 0 ; - + die "Error reading from $file: $gzerrno" . ($gzerrno+0) . "\n" if $gzerrno != Z_STREAM_END ; - + $gz->gzclose() ; } @@ -963,28 +963,28 @@ very simple I like script. use strict ; use warnings ; - + use Compress::Zlib ; - + die "Usage: gzgrep pattern [file...]\n" unless @ARGV >= 1; - + my $pattern = shift ; - + # use stdin if no files supplied @ARGV = '-' unless @ARGV ; - + foreach my $file (@ARGV) { my $gz = gzopen($file, "rb") or die "Cannot open $file: $gzerrno\n" ; - + while ($gz->gzreadline($_) > 0) { print if /$pattern/ ; } - + die "Error reading from $file: $gzerrno\n" if $gzerrno != Z_STREAM_END ; - + $gz->gzclose() ; } @@ -994,14 +994,14 @@ standard output. use strict ; use warnings ; - + use Compress::Zlib ; - + binmode STDOUT; # gzopen only sets it on the fd - + my $gz = gzopen(\*STDOUT, "wb") or die "Cannot open stdout: $gzerrno\n" ; - + while (<>) { $gz->gzwrite($_) or die "error writing: $gzerrno\n" ; @@ -1275,18 +1275,18 @@ input, deflates it and writes it to standard output. while (<>) { ($output, $status) = $x->deflate($_) ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; } - + ($output, $status) = $x->flush() ; - + $status == Z_OK or die "deflation failed\n" ; - + print $output ; =head1 Inflate Interface @@ -1313,13 +1313,13 @@ I error code. The function optionally takes a number of named options specified as C<< -Name=>value >> pairs. This allows individual options to be tailored without having to specify them all in the parameter list. - + For backward compatibility, it is also possible to pass the parameters as a reference to a hash containing the name=>value pairs. - + The function takes one optional parameter, a reference to a hash. The contents of the hash allow the deflation interface to be tailored. - + Here is a list of the valid options: =over 5 @@ -1409,27 +1409,27 @@ Here is an example of using C. use strict ; use warnings ; - + use Compress::Zlib ; - + my $x = inflateInit() or die "Cannot create a inflation stream\n" ; - + my $input = '' ; binmode STDIN; binmode STDOUT; - + my ($output, $status) ; while (read(STDIN, $input, 4096)) { ($output, $status) = $x->inflate(\$input) ; - + print $output if $status == Z_OK or $status == Z_STREAM_END ; - + last if $status != Z_OK ; } - + die "inflation failed\n" unless $status == Z_STREAM_END ; @@ -1506,8 +1506,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 1995-2020 Paul Marquess. All rights reserved. +Copyright (c) 1995-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/File/GlobMapper.pm b/cpan/IO-Compress/lib/File/GlobMapper.pm index a4e5385565e7..f015b1656745 100644 --- a/cpan/IO-Compress/lib/File/GlobMapper.pm +++ b/cpan/IO-Compress/lib/File/GlobMapper.pm @@ -51,7 +51,7 @@ sub globmap ($$;) my $inputGlob = shift ; my $outputGlob = shift ; - my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_) + my $obj = File::GlobMapper->new($inputGlob, $outputGlob, @_) or croak "globmap: $Error" ; return $obj->getFileMap(); } @@ -383,7 +383,7 @@ File::GlobMapper - Extend File Glob to Allow Input and Output Files my $aref = globmap $input => $output or die $File::GlobMapper::Error ; - my $gm = new File::GlobMapper $input => $output + my $gm = File::GlobMapper->new( $input => $output ) or die $File::GlobMapper::Error ; diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm index 635091e802a4..d20b62b9b349 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Bzip2.pm @@ -4,12 +4,12 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); -use Compress::Raw::Bzip2 2.096 ; +use Compress::Raw::Bzip2 2.100 ; our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkCompObject { @@ -21,7 +21,7 @@ sub mkCompObject $WorkFactor = 0 if ! defined $WorkFactor ; $Verbosity = 0 if ! defined $Verbosity ; - my ($def, $status) = new Compress::Raw::Bzip2(1, $BlockSize100K, + my ($def, $status) = Compress::Raw::Bzip2->new(1, $BlockSize100K, $WorkFactor, $Verbosity); return (undef, "Could not create Deflate object: $status", $status) @@ -30,7 +30,7 @@ sub mkCompObject return bless {'Def' => $def, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -44,11 +44,11 @@ sub compr if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -62,12 +62,12 @@ sub flush if ($status != BZ_RUN_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } sub close @@ -81,12 +81,12 @@ sub close if ($status != BZ_STREAM_END) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; - + return STATUS_OK; + } @@ -96,18 +96,18 @@ sub reset my $outer = $self->{Outer}; - my ($def, $status) = new Compress::Raw::Bzip2(); + my ($def, $status) = Compress::Raw::Bzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Deflate object: $status"; + $self->{Error} = "Cannot create Deflate object: $status"; return STATUS_ERROR; } $self->{Def} = $def; - return STATUS_OK; + return STATUS_OK; } sub compressedBytes @@ -151,4 +151,3 @@ sub uncompressedBytes 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm index 4f6f1d617508..fc8332ce2010 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Deflate.pm @@ -4,13 +4,13 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); -use Compress::Raw::Zlib 2.096 qw( !crc32 !adler32 ) ; - -require Exporter; +use IO::Compress::Base::Common 2.100 qw(:Status); +use Compress::Raw::Zlib 2.100 qw( !crc32 !adler32 ) ; + +require Exporter; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, @EXPORT, %DEFLATE_CONSTANTS); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @EXPORT_OK = @Compress::Raw::Zlib::DEFLATE_CONSTANTS; %EXPORT_TAGS = %Compress::Raw::Zlib::DEFLATE_CONSTANTS; @@ -24,20 +24,20 @@ sub mkCompObject my $level = shift ; my $strategy = shift ; - my ($def, $status) = new Compress::Raw::Zlib::Deflate + my ($def, $status) = Compress::Raw::Zlib::Deflate->new( -AppendOutput => 1, -CRC32 => $crc32, -ADLER32 => $adler32, -Level => $level, -Strategy => $strategy, - -WindowBits => - MAX_WBITS; + -WindowBits => - MAX_WBITS); - return (undef, "Cannot create Deflate object: $status", $status) - if $status != Z_OK; + return (undef, "Cannot create Deflate object: $status", $status) + if $status != Z_OK; return bless {'Def' => $def, 'Error' => '', - } ; + } ; } sub compr @@ -51,11 +51,11 @@ sub compr if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub flush @@ -70,11 +70,11 @@ sub flush if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } sub close @@ -97,14 +97,14 @@ sub reset $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "Deflate Error: $status"; + $self->{Error} = "Deflate Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; @@ -114,11 +114,11 @@ sub deflateParams $self->{ErrorNo} = $status; if ($status != Z_OK) { - $self->{Error} = "deflateParams Error: $status"; + $self->{Error} = "deflateParams Error: $status"; return STATUS_ERROR; } - return STATUS_OK; + return STATUS_OK; } @@ -167,4 +167,3 @@ sub adler32 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm index 00b529b01999..091e655bd4a1 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Adapter/Identity.pm @@ -4,10 +4,10 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkCompObject { @@ -19,7 +19,7 @@ sub mkCompObject 'UnCompSize' => 0, 'Error' => '', 'ErrorNo' => 0, - } ; + } ; } sub compr @@ -30,7 +30,7 @@ sub compr $self->{CompSize} += length ${ $_[0] } ; $self->{UnCompSize} = $self->{CompSize} ; - if ( ref $_[1] ) + if ( ref $_[1] ) { ${ $_[1] } .= ${ $_[0] } } else { $_[1] .= ${ $_[0] } } @@ -43,14 +43,14 @@ sub flush { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub close { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } sub reset @@ -60,14 +60,14 @@ sub reset $self->{CompSize} = 0; $self->{UnCompSize} = 0; - return STATUS_OK; + return STATUS_OK; } -sub deflateParams +sub deflateParams { my $self = shift ; - return STATUS_OK; + return STATUS_OK; } #sub total_out @@ -98,4 +98,3 @@ sub uncompressedBytes __END__ - diff --git a/cpan/IO-Compress/lib/IO/Compress/Base.pm b/cpan/IO-Compress/lib/IO/Compress/Base.pm index 1f1942965b75..bc49e0184158 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Base.pm @@ -6,7 +6,7 @@ require 5.006 ; use strict ; use warnings; -use IO::Compress::Base::Common 2.096 ; +use IO::Compress::Base::Common 2.100 ; use IO::File (); ; use Scalar::Util (); @@ -20,7 +20,7 @@ use Symbol(); our (@ISA, $VERSION); @ISA = qw(IO::File Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; #Can't locate object method "SWASHNEW" via package "utf8" (perhaps you forgot to load "utf8"?) at .../ext/Compress-Zlib/Gzip/blib/lib/Compress/Zlib/Common.pm line 16. @@ -254,8 +254,8 @@ sub _create *$obj->{Compress} = $obj->mkComp($got) or return undef; - *$obj->{UnCompSize} = new U64 ; - *$obj->{CompSize} = new U64 ; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; if ( $outType eq 'buffer') { ${ *$obj->{Buffer} } = '' @@ -279,7 +279,7 @@ sub _create my $mode = '>' ; $mode = '>>' if $appendOutput; - *$obj->{FH} = new IO::File "$mode $outValue" + *$obj->{FH} = IO::File->new( "$mode $outValue" ) or return $obj->saveErrorString(undef, "cannot open file '$outValue': $!", $!) ; *$obj->{StdIO} = ($outValue eq '-'); setBinModeOutput(*$obj->{FH}) ; @@ -340,7 +340,7 @@ sub _def my $haveOut = @_ ; my $output = shift ; - my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) + my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output) or return undef ; push @_, $output if $haveOut && $x->{Hash}; @@ -493,7 +493,7 @@ sub _wr2 if ( ! $isFilehandle ) { - $fh = new IO::File "<$input" + $fh = IO::File->new( "<$input" ) or return $self->saveErrorString(undef, "cannot open file '$input': $!", $!) ; } binmode $fh ; @@ -983,23 +983,27 @@ sub _notAvailable return sub { Carp::croak "$name Not Available: File opened only for output" ; } ; } -*read = _notAvailable('read'); -*READ = _notAvailable('read'); -*readline = _notAvailable('readline'); -*READLINE = _notAvailable('readline'); -*getc = _notAvailable('getc'); -*GETC = _notAvailable('getc'); - -*FILENO = \&fileno; -*PRINT = \&print; -*PRINTF = \&printf; -*WRITE = \&syswrite; -*write = \&syswrite; -*SEEK = \&seek; -*TELL = \&tell; -*EOF = \&eof; -*CLOSE = \&close; -*BINMODE = \&binmode; +{ + no warnings 'once'; + + *read = _notAvailable('read'); + *READ = _notAvailable('read'); + *readline = _notAvailable('readline'); + *READLINE = _notAvailable('readline'); + *getc = _notAvailable('getc'); + *GETC = _notAvailable('getc'); + + *FILENO = \&fileno; + *PRINT = \&print; + *PRINTF = \&printf; + *WRITE = \&syswrite; + *write = \&syswrite; + *SEEK = \&seek; + *TELL = \&tell; + *EOF = \&eof; + *CLOSE = \&close; + *BINMODE = \&binmode; +} #*sysread = \&_notAvailable; #*syswrite = \&_write; @@ -1047,8 +1051,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm index 37501a63e5f2..8f0530cdddc0 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Base/Common.pm @@ -11,7 +11,7 @@ use File::GlobMapper; require Exporter; our ($VERSION, @ISA, @EXPORT, %EXPORT_TAGS, $HAS_ENCODE); @ISA = qw(Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; @EXPORT = qw( isaFilehandle isaFilename isaScalar whatIsInput whatIsOutput @@ -160,7 +160,7 @@ sub whatIsInput($;$) #use IO::File; $got = 'handle'; $_[0] = *STDIN; - #$_[0] = new IO::File("<-"); + #$_[0] = IO::File->new("<-"); } return $got; @@ -174,7 +174,7 @@ sub whatIsOutput($;$) { $got = 'handle'; $_[0] = *STDOUT; - #$_[0] = new IO::File(">-"); + #$_[0] = IO::File->new(">-"); } return $got; @@ -267,7 +267,7 @@ sub IO::Compress::Base::Validator::new { $data{GlobMap} = 1 ; $data{inType} = $data{outType} = 'filename'; - my $mapper = new File::GlobMapper($_[0], $_[1]); + my $mapper = File::GlobMapper->new($_[0], $_[1]); if ( ! $mapper ) { return $obj->saveErrorString($File::GlobMapper::Error) ; @@ -509,7 +509,7 @@ sub ParseParameters return $_[1] if @_ == 2 && defined $_[1] && UNIVERSAL::isa($_[1], "IO::Compress::Base::Parameters"); - my $p = new IO::Compress::Base::Parameters() ; + my $p = IO::Compress::Base::Parameters->new(); $p->parse(@_) or croak "$sub: $p->[IxError]" ; diff --git a/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm index 950366c378cd..88dd7f9bfe98 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Bzip2.pm @@ -5,16 +5,16 @@ use warnings; use bytes; require Exporter ; -use IO::Compress::Base 2.096 ; +use IO::Compress::Base 2.100 ; -use IO::Compress::Base::Common 2.096 qw(); -use IO::Compress::Adapter::Bzip2 2.096 ; +use IO::Compress::Base::Common 2.100 qw(); +use IO::Compress::Adapter::Bzip2 2.100 ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bzip2Error); -$VERSION = '2.096'; +$VERSION = '2.100'; $Bzip2Error = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -40,7 +40,7 @@ sub bzip2 } -sub mkHeader +sub mkHeader { my $self = shift ; return ''; @@ -51,9 +51,9 @@ sub getExtraParams { my $self = shift ; - use IO::Compress::Base::Common 2.096 qw(:Parse); - - return ( + use IO::Compress::Base::Common 2.100 qw(:Parse); + + return ( 'blocksize100k' => [IO::Compress::Base::Common::Parse_unsigned, 1], 'workfactor' => [IO::Compress::Base::Common::Parse_unsigned, 0], 'verbosity' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -66,7 +66,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + # check that BlockSize100K is a number between 1 & 9 if ($got->parsed('blocksize100k')) { my $value = $got->getValue('blocksize100k'); @@ -101,7 +101,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + return $obj; } @@ -133,7 +133,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } 1; @@ -151,7 +151,7 @@ IO::Compress::Bzip2 - Write bzip2 files/buffers my $status = bzip2 $input => $output [,OPTS] or die "bzip2 failed: $Bzip2Error\n"; - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "bzip2 failed: $Bzip2Error\n"; $z->print($string); @@ -426,7 +426,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Bzip2 qw(bzip2 $Bzip2Error) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -463,7 +463,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C is shown below - my $z = new IO::Compress::Bzip2 $output [,OPTS] + my $z = IO::Compress::Bzip2->new( $output [,OPTS] ) or die "IO::Compress::Bzip2 failed: $Bzip2Error\n"; It returns an C object on success and undef on failure. @@ -818,8 +818,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Deflate.pm b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm index 358e01989ef0..c3aa1eab78ce 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Deflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Deflate.pm @@ -8,16 +8,16 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.096 (); -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::RawDeflate 2.100 (); +use IO::Compress::Adapter::Deflate 2.100 ; -use IO::Compress::Zlib::Constants 2.096 ; -use IO::Compress::Base::Common 2.096 qw(); +use IO::Compress::Zlib::Constants 2.100 ; +use IO::Compress::Base::Common 2.100 qw(); our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $DeflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $DeflateError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -80,7 +80,7 @@ sub mkDeflateHdr($$$;$) return $hdr; } -sub mkHeader +sub mkHeader { my $self = shift ; my $param = shift ; @@ -89,7 +89,7 @@ sub mkHeader my $strategy = $param->getValue('strategy'); my $lflag ; - $level = 6 + $level = 6 if $level == Z_DEFAULT_COMPRESSION ; if (ZLIB_VERNUM >= 0x1210) @@ -118,7 +118,7 @@ sub ckParams { my $self = shift ; my $got = shift; - + $got->setValue('adler32' => 1); return 1 ; } @@ -149,6 +149,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Inflate', \$IO::Uncompress::Inflate::InflateError); } @@ -158,7 +159,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } @@ -178,7 +179,7 @@ IO::Compress::Deflate - Write RFC 1950 files/buffers my $status = deflate $input => $output [,OPTS] or die "deflate failed: $DeflateError\n"; - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "deflate failed: $DeflateError\n"; $z->print($string); @@ -455,7 +456,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Deflate qw(deflate $DeflateError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -492,7 +493,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C is shown below - my $z = new IO::Compress::Deflate $output [,OPTS] + my $z = IO::Compress::Deflate->new( $output [,OPTS] ) or die "IO::Compress::Deflate failed: $DeflateError\n"; It returns an C object on success and undef on failure. @@ -951,8 +952,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/FAQ.pod b/cpan/IO-Compress/lib/IO/Compress/FAQ.pod index d6d11c764679..367468ec0782 100644 --- a/cpan/IO-Compress/lib/IO/Compress/FAQ.pod +++ b/cpan/IO-Compress/lib/IO/Compress/FAQ.pod @@ -79,7 +79,7 @@ write a C<.tar.Z> file use Archive::Tar; use IO::File; - my $fh = new IO::File "| compress -c >$filename"; + my $fh = IO::File->new( "| compress -c >$filename" ); my $tar = Archive::Tar->new(); ... $tar->write($fh); @@ -101,7 +101,7 @@ recompression. my $gzipFile = "somefile.gz"; my $bzipFile = "somefile.bz2"; - my $gunzip = new IO::Uncompress::Gunzip $gzipFile + my $gunzip = IO::Uncompress::Gunzip->new( $gzipFile ) or die "Cannot gunzip $gzipFile: $GunzipError\n" ; bzip2 $gunzip => $bzipFile @@ -167,8 +167,8 @@ by including the C option. If you want to create a zip64 zip file with the OO interface you must specify the C option. - my $zip = new IO::Compress::Zip "whatever", Zip64 => 1; - + my $zip = IO::Compress::Zip->new( "whatever", Zip64 => 1 ); + When uncompressing with C, it will automatically detect if the zip file is zip64. @@ -300,14 +300,14 @@ L 0x1f8b; use constant OS_MAGIC => 0x03; - + sub handler { my $r = shift; my ($fh,$gz); @@ -316,28 +316,28 @@ Lheader_out('Content-Encoding'=>'gzip'); $r->send_http_header; return OK if $r->header_only; - + tie *STDOUT,'Apache::GZip',$r; print($_) while <$fh>; untie *STDOUT; return OK; } - + sub TIEHANDLE { my($class,$r) = @_; # initialize a deflation stream my $d = deflateInit(-WindowBits=>-MAX_WBITS()) || return undef; - + # gzip header -- don't ask how I found out $r->print(pack("nccVcc",GZIP_MAGIC,Z_DEFLATED,0,time(),0,OS_MAGIC)); - + return bless { r => $r, crc => crc32(undef), d => $d, l => 0 },$class; } - + sub PRINT { my $self = shift; foreach (@_) { @@ -349,18 +349,18 @@ L{crc} = crc32($_,$self->{crc}); } } - + sub DESTROY { my $self = shift; - + # flush the output buffers my $data = $self->{d}->flush; $self->{r}->print($data); - + # print the CRC and the total length (uncompressed) $self->{r}->print(pack("LL",@{$self}{qw/crc l/})); } - + 1; Here's the Apache configuration entry you'll need to make use of it. Once @@ -401,12 +401,12 @@ C is used instead of C the whole tied filehandle code can be removed. Here is the rewritten code. package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip; use IO::File; - + sub handler { my $r = shift; my ($fh,$gz); @@ -416,22 +416,22 @@ filehandle code can be removed. Here is the rewritten code. $r->send_http_header; return OK if $r->header_only; - my $gz = new IO::Compress::Gzip '-', Minimal => 1 + my $gz = IO::Compress::Gzip->new( '-', Minimal => 1 ) or return DECLINED ; print $gz $_ while <$fh>; - + return OK; } - + or even more succinctly, like this, using a one-shot gzip package Apache::GZip; - + use strict vars; use Apache::Constants ':common'; use IO::Compress::Gzip qw(gzip); - + sub handler { my $r = shift; $r->header_out('Content-Encoding'=>'gzip'); @@ -443,7 +443,7 @@ or even more succinctly, like this, using a one-shot gzip return OK; } - + 1; The use of one-shot C above just reads from C<< $r->filename >> and @@ -468,7 +468,7 @@ read from the FTP Server. use Net::FTP; use IO::Uncompress::Gunzip qw(:all); - my $ftp = new Net::FTP ... + my $ftp = Net::FTP->new( ... ) my $retr_fh = $ftp->retr($compressed_filename); gunzip $retr_fh => $outFilename, AutoClose => 1 @@ -518,7 +518,7 @@ the other C modules. my $file = $ARGV[0] ; - my $fh = new IO::File "<$file" + my $fh = IO::File->new( "<$file" ) or die "Cannot open '$file': $!\n"; while (1) @@ -566,9 +566,9 @@ the other C modules. # Done reading the Local Header - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -585,14 +585,14 @@ The majority of the code above is concerned with reading the zip local header data. The code that I want to focus on is at the bottom. while (1) { - + # read local zip header data # get $filename # get $compressedLength - my $inf = new IO::Uncompress::RawInflate $fh, + my $inf = IO::Uncompress::RawInflate->new( $fh, Transparent => 1, - InputLength => $compressedLength + InputLength => $compressedLength ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -618,7 +618,7 @@ byte directly after the compressed data stream. Now consider what the code looks like without C while (1) { - + # read local zip header data # get $filename # get $compressedLength @@ -626,8 +626,8 @@ Now consider what the code looks like without C # read all the compressed data into $data read($fh, $data, $compressedLength); - my $inf = new IO::Uncompress::RawInflate \$data, - Transparent => 1, + my $inf = IO::Uncompress::RawInflate->new( \$data, + Transparent => 1 ) or die "Cannot uncompress $file [$filename]: $RawInflateError\n" ; my $line_count = 0; @@ -682,7 +682,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm index 68f6008ef102..cf9d8e263aad 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip.pm @@ -8,24 +8,24 @@ use bytes; require Exporter ; -use IO::Compress::RawDeflate 2.096 () ; -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::RawDeflate 2.100 () ; +use IO::Compress::Adapter::Deflate 2.100 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Gzip::Constants 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Gzip::Constants 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; BEGIN { - if (defined &utf8::downgrade ) + if (defined &utf8::downgrade ) { *noUTF8 = \&utf8::downgrade } else - { *noUTF8 = sub {} } + { *noUTF8 = sub {} } } our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $GzipError); -$VERSION = '2.096'; +$VERSION = '2.100'; $GzipError = '' ; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -65,7 +65,7 @@ sub getExtraParams return ( # zlib behaviour $self->getZlibParams(), - + # Gzip header fields 'minimal' => [IO::Compress::Base::Common::Parse_boolean, 0], 'comment' => [IO::Compress::Base::Common::Parse_any, undef], @@ -105,7 +105,7 @@ sub ckParams # Also check that they only contain ISO 8859-1 chars. if ($got->parsed('name') && defined $got->getValue('name')) { my $name = $got->getValue('name'); - + return $self->saveErrorString(undef, "Null Character found in Name", Z_DATA_ERROR) if $strict && $name =~ /\x00/ ; @@ -132,16 +132,16 @@ sub ckParams return $self->saveErrorString(undef, "OS_Code must be between 0 and 255, got '$value'") if $value < 0 || $value > 255 ; - + } # gzip only supports Deflate at present $got->setValue('method' => Z_DEFLATED) ; if ( ! $got->parsed('extraflags')) { - $got->setValue('extraflags' => 2) + $got->setValue('extraflags' => 2) if $got->getValue('level') == Z_BEST_COMPRESSION ; - $got->setValue('extraflags' => 4) + $got->setValue('extraflags' => 4) if $got->getValue('level') == Z_BEST_SPEED ; } @@ -161,12 +161,13 @@ sub ckParams sub mkTrailer { my $self = shift ; - return pack("V V", *$self->{Compress}->crc32(), + return pack("V V", *$self->{Compress}->crc32(), *$self->{UnCompSize}->get32bit()); } sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Gunzip', \$IO::Uncompress::Gunzip::GunzipError); } @@ -184,7 +185,7 @@ sub getFileInfo $params->setValue('name' => $filename) if ! $params->parsed('name') ; - $params->setValue('time' => $defaultTime) + $params->setValue('time' => $defaultTime) if ! $params->parsed('time') ; } @@ -207,7 +208,7 @@ sub mkHeader $flags |= GZIP_FLG_FEXTRA if $param->wantValue('extrafield') ; $flags |= GZIP_FLG_FNAME if $param->wantValue('name') ; $flags |= GZIP_FLG_FCOMMENT if $param->wantValue('comment') ; - + # MTIME my $time = $param->valueOrDefault('time', GZIP_MTIME_DEFAULT) ; @@ -218,7 +219,7 @@ sub mkHeader my $os_code = $param->valueOrDefault('os_code', GZIP_OS_DEFAULT) ; - my $out = pack("C4 V C C", + my $out = pack("C4 V C C", GZIP_ID1, # ID1 GZIP_ID2, # ID2 $method, # Compression Method @@ -240,7 +241,7 @@ sub mkHeader $name =~ s/\x00.*$//; $out .= $name ; # Terminate the filename with NULL unless it already is - $out .= GZIP_NULL_BYTE + $out .= GZIP_NULL_BYTE if !length $name or substr($name, 1, -1) ne GZIP_NULL_BYTE ; } @@ -257,7 +258,7 @@ sub mkHeader } # HEADER CRC - $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) + $out .= pack("v", Compress::Raw::Zlib::crc32($out) & 0x00FF ) if $param->getValue('headercrc') ; noUTF8($out); @@ -270,7 +271,7 @@ sub mkFinalTrailer return ''; } -1; +1; __END__ @@ -285,7 +286,7 @@ IO::Compress::Gzip - Write RFC 1952 files/buffers my $status = gzip $input => $output [,OPTS] or die "gzip failed: $GzipError\n"; - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "gzip failed: $GzipError\n"; $z->print($string); @@ -573,7 +574,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Gzip qw(gzip $GzipError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -610,7 +611,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C is shown below - my $z = new IO::Compress::Gzip $output [,OPTS] + my $z = IO::Compress::Gzip->new( $output [,OPTS] ) or die "IO::Compress::Gzip failed: $GzipError\n"; It returns an C object on success and undef on failure. @@ -1263,8 +1264,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm index c41fa18fe5c9..ef67f7e66a5a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Gzip/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %GZIP_OS_Names); our ($GZIP_FNAME_INVALID_CHAR_RE, $GZIP_FCOMMENT_INVALID_CHAR_RE); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @@ -89,22 +89,22 @@ use constant GZIP_FEXTRA_SUBFIELD_ID_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_LEN_SIZE => 2 ; use constant GZIP_FEXTRA_SUBFIELD_HEADER_SIZE => GZIP_FEXTRA_SUBFIELD_ID_SIZE + GZIP_FEXTRA_SUBFIELD_LEN_SIZE; -use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - +use constant GZIP_FEXTRA_SUBFIELD_MAX_SIZE => GZIP_FEXTRA_MAX_SIZE - GZIP_FEXTRA_SUBFIELD_HEADER_SIZE ; if (ord('A') == 193) { - # EBCDIC + # EBCDIC $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x3f\xff]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x0a\x11-\x14\x16-\x3f\xff]'; - + } else { $GZIP_FNAME_INVALID_CHAR_RE = '[\x00-\x1F\x7F-\x9F]'; $GZIP_FCOMMENT_INVALID_CHAR_RE = '[\x00-\x09\x11-\x1F\x7F-\x9F]'; -} +} use constant GZIP_FHCRC_SIZE => 2 ; # aka CONTINUATION in gzip @@ -140,7 +140,7 @@ use constant GZIP_OS_DEFAULT=> 0xFF ; GZIP_OS_DEFAULT() => 'Unknown', ) ; -use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", +use constant GZIP_MINIMUM_HEADER => pack("C4 V C C", GZIP_ID1, GZIP_ID2, GZIP_CM_DEFLATED, GZIP_FLG_DEFAULT, GZIP_MTIME_DEFAULT, GZIP_XFL_DEFAULT, GZIP_OS_DEFAULT) ; diff --git a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm index 603c9e02312b..a0005dd6cdb6 100644 --- a/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm +++ b/cpan/IO-Compress/lib/IO/Compress/RawDeflate.pm @@ -6,15 +6,16 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Adapter::Deflate 2.096 ; +use IO::Compress::Base 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status :Parse); +use IO::Compress::Adapter::Deflate 2.100 ; +use Compress::Raw::Zlib 2.100 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %DEFLATE_CONSTANTS, %EXPORT_TAGS, $RawDeflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $RawDeflateError = ''; @ISA = qw(IO::Compress::Base Exporter); @@ -28,8 +29,8 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; my %seen; foreach (keys %EXPORT_TAGS ) { - push @{$EXPORT_TAGS{constants}}, - grep { !$seen{$_}++ } + push @{$EXPORT_TAGS{constants}}, + grep { !$seen{$_}++ } @{ $EXPORT_TAGS{$_} } } $EXPORT_TAGS{all} = $EXPORT_TAGS{constants} ; @@ -41,7 +42,7 @@ push @EXPORT_OK, @IO::Compress::Adapter::Deflate::EXPORT_OK ; #push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); - + sub new @@ -82,7 +83,7 @@ sub mkComp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - return $obj; + return $obj; } @@ -116,8 +117,6 @@ sub getExtraParams return getZlibParams(); } -use IO::Compress::Base::Common 2.096 qw(:Parse); -use Compress::Raw::Zlib 2.096 qw(Z_DEFLATED Z_DEFAULT_COMPRESSION Z_DEFAULT_STRATEGY); our %PARAMS = ( #'method' => [IO::Compress::Base::Common::Parse_unsigned, Z_DEFLATED], 'level' => [IO::Compress::Base::Common::Parse_signed, Z_DEFAULT_COMPRESSION], @@ -125,17 +124,18 @@ our %PARAMS = ( 'crc32' => [IO::Compress::Base::Common::Parse_boolean, 0], 'adler32' => [IO::Compress::Base::Common::Parse_boolean, 0], - 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], + 'merge' => [IO::Compress::Base::Common::Parse_boolean, 0], ); - + sub getZlibParams { - return %PARAMS; + return %PARAMS; } sub getInverseClass { - return ('IO::Uncompress::RawInflate', + no warnings 'once'; + return ('IO::Uncompress::RawInflate', \$IO::Uncompress::RawInflate::RawInflateError); } @@ -144,7 +144,7 @@ sub getFileInfo my $self = shift ; my $params = shift; my $file = shift ; - + } use Fcntl qw(SEEK_SET); @@ -156,20 +156,20 @@ sub createMerge my $outType = shift ; my ($invClass, $error_ref) = $self->getInverseClass(); - eval "require $invClass" + eval "require $invClass" or die "aaaahhhh" ; - my $inf = $invClass->new( $outValue, - Transparent => 0, + my $inf = $invClass->new( $outValue, + Transparent => 0, #Strict => 1, AutoClose => 0, Scan => 1) or return $self->saveErrorString(undef, "Cannot create InflateScan object: $$error_ref" ) ; my $end_offset = 0; - $inf->scan() + $inf->scan() or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $inf->errorNo) ; - $inf->zap($end_offset) + $inf->zap($end_offset) or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $inf->errorNo) ; my $def = *$self->{Compress} = $inf->createDeflate(); @@ -178,10 +178,10 @@ sub createMerge *$self->{UnCompSize} = *$inf->{UnCompSize}->clone(); *$self->{CompSize} = *$inf->{CompSize}->clone(); # TODO -- fix this - #*$self->{CompSize} = new U64(0, *$self->{UnCompSize_32bit}); + #*$self->{CompSize} = U64->new(0, *$self->{UnCompSize_32bit}); - if ( $outType eq 'buffer') + if ( $outType eq 'buffer') { substr( ${ *$self->{Buffer} }, $end_offset) = '' } elsif ($outType eq 'handle' || $outType eq 'filename') { *$self->{FH} = *$inf->{FH} ; @@ -189,8 +189,8 @@ sub createMerge *$self->{FH}->flush() ; *$self->{Handle} = 1 if $outType eq 'handle'; - #seek(*$self->{FH}, $end_offset, SEEK_SET) - *$self->{FH}->seek($end_offset, SEEK_SET) + #seek(*$self->{FH}, $end_offset, SEEK_SET) + *$self->{FH}->seek($end_offset, SEEK_SET) or return $self->saveErrorString(undef, $!, $!) ; } @@ -199,7 +199,7 @@ sub createMerge #### zlib specific methods -sub deflateParams +sub deflateParams { my $self = shift ; @@ -210,7 +210,7 @@ sub deflateParams return $self->saveErrorString(0, *$self->{Compress}{Error}, *$self->{Compress}{ErrorNo}) if $status == STATUS_ERROR; - return 1; + return 1; } @@ -231,7 +231,7 @@ IO::Compress::RawDeflate - Write RFC 1951 files/buffers my $status = rawdeflate $input => $output [,OPTS] or die "rawdeflate failed: $RawDeflateError\n"; - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "rawdeflate failed: $RawDeflateError\n"; $z->print($string); @@ -511,7 +511,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::RawDeflate qw(rawdeflate $RawDeflateError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -548,7 +548,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for C is shown below - my $z = new IO::Compress::RawDeflate $output [,OPTS] + my $z = IO::Compress::RawDeflate->new( $output [,OPTS] ) or die "IO::Compress::RawDeflate failed: $RawDeflateError\n"; It returns an C object on success and undef on failure. @@ -1007,8 +1007,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip.pm b/cpan/IO-Compress/lib/IO/Compress/Zip.pm index 63bd9981ab71..16d956129e23 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip.pm @@ -4,40 +4,41 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::RawDeflate 2.096 (); -use IO::Compress::Adapter::Deflate 2.096 ; -use IO::Compress::Adapter::Identity 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; -use IO::Compress::Zip::Constants 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::RawDeflate 2.100 (); +use IO::Compress::Adapter::Deflate 2.100 ; +use IO::Compress::Adapter::Identity 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; +use IO::Compress::Zip::Constants 2.100 ; use File::Spec(); use Config; -use Compress::Raw::Zlib 2.096 (); +use Compress::Raw::Zlib 2.100 (); BEGIN { eval { require IO::Compress::Adapter::Bzip2 ; - import IO::Compress::Adapter::Bzip2 2.096 ; + IO::Compress::Adapter::Bzip2->import( 2.096 ); require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.096 ; + IO::Compress::Bzip2->import( 2.096 ); } ; eval { require IO::Compress::Adapter::Lzma ; - import IO::Compress::Adapter::Lzma 2.096 ; + IO::Compress::Adapter::Lzma->import( 2.096 ); require IO::Compress::Lzma ; - import IO::Compress::Lzma 2.096 ; + IO::Compress::Lzma->import( 2.096 ); } ; + eval { require IO::Compress::Adapter::Xz ; - import IO::Compress::Adapter::Xz 2.096 ; + IO::Compress::Adapter::Xz->import( 2.096 ); require IO::Compress::Xz ; - import IO::Compress::Xz 2.096 ; + IO::Compress::Xz->import( 2.096 ); } ; eval { require IO::Compress::Adapter::Zstd ; - import IO::Compress::Adapter::Zstd 2.096 ; + IO::Compress::Adapter::Zstd->import( 2.096 ); require IO::Compress::Zstd ; - import IO::Compress::Zstd 2.096 ; + IO::Compress::Zstd->import( 2.096 ); } ; } @@ -46,7 +47,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $ZipError); -$VERSION = '2.096'; +$VERSION = '2.100'; $ZipError = ''; @ISA = qw(IO::Compress::RawDeflate Exporter); @@ -177,7 +178,7 @@ sub mkComp if (! defined *$self->{ZipData}{SizesOffset}) { *$self->{ZipData}{SizesOffset} = 0; - *$self->{ZipData}{Offset} = new U64 ; + *$self->{ZipData}{Offset} = U64->new(); } *$self->{ZipData}{AnyZip64} = 0 @@ -753,6 +754,7 @@ sub getExtraParams sub getInverseClass { + no warnings 'once'; return ('IO::Uncompress::Unzip', \$IO::Uncompress::Unzip::UnzipError); } @@ -905,7 +907,7 @@ IO::Compress::Zip - Write zip files/buffers my $status = zip $input => $output [,OPTS] or die "zip failed: $ZipError\n"; - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "zip failed: $ZipError\n"; $z->print($string); @@ -1251,7 +1253,7 @@ compressed data to a buffer, C<$buffer>. use IO::Compress::Zip qw(zip $ZipError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -1292,7 +1294,7 @@ or more succinctly The format of the constructor for C is shown below - my $z = new IO::Compress::Zip $output [,OPTS] + my $z = IO::Compress::Zip->new( $output [,OPTS] ) or die "IO::Compress::Zip failed: $ZipError\n"; It returns an C object on success and undef on failure. @@ -1730,10 +1732,10 @@ By default, no comment field is written to the zip file. =item C<< Method => $method >> Controls which compression method is used. At present the compression -methods are supported are: Store (no compression at all), Deflate, -Bzip2, Xz and Lzma. +methods supported are: Store (no compression at all), Deflate, +Bzip2, Zstd, Xz and Lzma. -The symbols, ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_XZ and ZIP_CM_LZMA +The symbols ZIP_CM_STORE, ZIP_CM_DEFLATE, ZIP_CM_BZIP2, ZIP_CM_ZSTD, ZIP_CM_XZ and ZIP_CM_LZMA are used to select the compression method. These constants are not imported by C by default. @@ -1754,6 +1756,10 @@ Note that to create Xz content, the module C must be installed. A fatal error will be thrown if you attempt to create Xz content when C is not available. +Note that to create Zstd content, the module C must +be installed. A fatal error will be thrown if you attempt to create Zstd +content when C is not available. + The default method is ZIP_CM_DEFLATE. =item C<< TextFlag => 0|1 >> @@ -2137,8 +2143,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm index 526e0ba994d9..c81a4ad56c4a 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zip/Constants.pm @@ -7,7 +7,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT, %ZIP_CM_MIN_VERSIONS); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm index a6903a76621e..1b953510b318 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Constants.pm @@ -9,7 +9,7 @@ require Exporter; our ($VERSION, @ISA, @EXPORT); -$VERSION = '2.096'; +$VERSION = '2.100'; @ISA = qw(Exporter); @@ -23,7 +23,7 @@ $VERSION = '2.096'; ZLIB_CMF_CM_DEFLATED ZLIB_CMF_CINFO_OFFSET - ZLIB_CMF_CINFO_BITS + ZLIB_CMF_CINFO_BITS ZLIB_CMF_CINFO_MAX ZLIB_FLG_FCHECK_OFFSET diff --git a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm index b5c49b7cde46..0bbef359f2d4 100644 --- a/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm +++ b/cpan/IO-Compress/lib/IO/Compress/Zlib/Extra.pm @@ -8,9 +8,9 @@ use bytes; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS); -$VERSION = '2.096'; +$VERSION = '2.100'; -use IO::Compress::Gzip::Constants 2.096 ; +use IO::Compress::Gzip::Constants 2.100 ; sub ExtraFieldError { @@ -36,11 +36,11 @@ sub validateExtraFieldPair return ExtraFieldError("SubField Data is a reference") if ref $pair->[1] ; - # ID is exactly two chars + # ID is exactly two chars return ExtraFieldError("SubField ID not two chars long") unless length $pair->[0] == GZIP_FEXTRA_SUBFIELD_ID_SIZE ; - # Check that the 2nd byte of the ID isn't 0 + # Check that the 2nd byte of the ID isn't 0 return ExtraFieldError("SubField ID 2nd byte is 0x00") if $strict && $gzipMode && substr($pair->[0], 1, 1) eq "\x00" ; @@ -74,7 +74,7 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -84,8 +84,8 @@ sub parseRawExtra return ExtraFieldError("Truncated in FEXTRA Body Section") if $offset + $subLen > $XLEN ; - my $bad = validateExtraFieldPair( [$id, - substr($data, $offset, $subLen)], + my $bad = validateExtraFieldPair( [$id, + substr($data, $offset, $subLen)], $strict, $gzipMode ); return $bad if $bad ; push @$extraRef, [$id => substr($data, $offset, $subLen)] @@ -94,7 +94,7 @@ sub parseRawExtra $offset += $subLen ; } - + return undef ; } @@ -111,7 +111,7 @@ sub findID return undef if $offset + GZIP_FEXTRA_SUBFIELD_HEADER_SIZE > $XLEN ; - my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); + my $id = substr($data, $offset, GZIP_FEXTRA_SUBFIELD_ID_SIZE); $offset += GZIP_FEXTRA_SUBFIELD_ID_SIZE; my $subLen = unpack("v", substr($data, $offset, @@ -126,7 +126,7 @@ sub findID $offset += $subLen ; } - + return undef ; } @@ -165,7 +165,7 @@ sub parseExtraField # $id2 => $data2, # ... # } - + if ( ! ref $dataRef ) { return undef @@ -177,7 +177,7 @@ sub parseExtraField my $data = $dataRef; my $out = '' ; - if (ref $data eq 'ARRAY') { + if (ref $data eq 'ARRAY') { if (ref $data->[0]) { foreach my $pair (@$data) { @@ -188,30 +188,30 @@ sub parseExtraField return $bad if $bad ; $out .= mkSubField(@$pair); - } - } + } + } else { return ExtraFieldError("Not even number of elements") unless @$data % 2 == 0; for (my $ix = 0; $ix <= @$data -1 ; $ix += 2) { my $bad = validateExtraFieldPair([$data->[$ix], - $data->[$ix+1]], + $data->[$ix+1]], $strict, $gzipMode) ; return $bad if $bad ; $out .= mkSubField($data->[$ix], $data->[$ix+1]); - } + } } - } - elsif (ref $data eq 'HASH') { + } + elsif (ref $data eq 'HASH') { while (my ($id, $info) = each %$data) { my $bad = validateExtraFieldPair([$id, $info], $strict, $gzipMode); return $bad if $bad ; $out .= mkSubField($id, $info); - } - } + } + } else { return ExtraFieldError("Not a scalar, array ref or hash ref") ; } diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm index 60b34bab8249..92f3945c4d72 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Bunzip2.pm @@ -4,19 +4,19 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); -use Compress::Raw::Bzip2 2.096 ; +use Compress::Raw::Bzip2 2.100 ; our ($VERSION, @ISA); -$VERSION = '2.096'; +$VERSION = '2.100'; sub mkUncompObject { my $small = shift || 0; my $verbosity = shift || 0; - my ($inflate, $status) = new Compress::Raw::Bunzip2(1, 1, $small, $verbosity, 1); + my ($inflate, $status) = Compress::Raw::Bunzip2->new(1, 1, $small, $verbosity, 1); return (undef, "Could not create Inflation object: $status", $status) if $status != BZ_OK ; @@ -26,8 +26,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -48,7 +48,7 @@ sub uncompr return STATUS_ERROR; } - + return STATUS_OK if $status == BZ_OK ; return STATUS_ENDSTREAM if $status == BZ_STREAM_END ; return STATUS_ERROR ; @@ -59,12 +59,12 @@ sub reset { my $self = shift ; - my ($inf, $status) = new Compress::Raw::Bunzip2(); + my ($inf, $status) = Compress::Raw::Bunzip2->new(); $self->{ErrorNo} = ($status == BZ_OK) ? 0 : $status ; if ($status != BZ_OK) { - $self->{Error} = "Cannot create Inflate object: $status"; + $self->{Error} = "Cannot create Inflate object: $status"; return STATUS_ERROR; } @@ -100,8 +100,8 @@ sub adler32 sub sync { my $self = shift ; - #( $self->{Inf}->inflateSync(@_) == BZ_OK) - # ? STATUS_OK + #( $self->{Inf}->inflateSync(@_) == BZ_OK) + # ? STATUS_OK # : STATUS_ERROR ; } @@ -109,4 +109,3 @@ sub sync 1; __END__ - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm index 84d74c9cabe2..07621b4f694e 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Identity.pm @@ -4,14 +4,14 @@ use warnings; use strict; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); +use IO::Compress::Base::Common 2.100 qw(:Status); use IO::Compress::Zip::Constants ; our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; -use Compress::Raw::Zlib 2.096 (); +use Compress::Raw::Zlib 2.100 (); sub mkUncompObject { @@ -21,7 +21,7 @@ sub mkUncompObject my $crc32 = 1; #shift ; my $adler32 = shift; - bless { 'CompSize' => new U64 , # 0, + bless { 'CompSize' => U64->new(), # 0, 'UnCompSize' => 0, 'wantCRC32' => $crc32, 'CRC32' => Compress::Raw::Zlib::crc32(''), @@ -70,7 +70,7 @@ sub uncompr $ind = $len - 1 ; } } - + if ($ind >= 0) { $remainder = substr($$in, $ind) ; substr($$in, $ind) = '' ; @@ -94,7 +94,7 @@ sub uncompr $l1 = U64::newUnpack_V32(substr($remainder, 8)); $l2 = U64::newUnpack_V32(substr($remainder, 12)); } - + my $newLen = $self->{CompSize}->clone(); $newLen->add(length $$in); if ($l1->equal($l2) && $l1->equal($newLen) ) { @@ -142,7 +142,7 @@ sub reset $self->{CompSize}->reset(); $self->{UnCompSize} = 0; $self->{CRC32} = Compress::Raw::Zlib::crc32(''); - $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); + $self->{ADLER32} = Compress::Raw::Zlib::adler32(''); return STATUS_OK ; } diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm index 63e87077379e..9d5dba948107 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Adapter/Inflate.pm @@ -4,11 +4,11 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status); -use Compress::Raw::Zlib 2.096 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); +use IO::Compress::Base::Common 2.100 qw(:Status); +use Compress::Raw::Zlib 2.100 qw(Z_OK Z_BUF_ERROR Z_STREAM_END Z_FINISH MAX_WBITS); our ($VERSION); -$VERSION = '2.096'; +$VERSION = '2.100'; @@ -23,23 +23,23 @@ sub mkUncompObject if ($scan) { - ($inflate, $status) = new Compress::Raw::Zlib::InflateScan + ($inflate, $status) = Compress::Raw::Zlib::InflateScan->new( #LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } else { - ($inflate, $status) = new Compress::Raw::Zlib::Inflate + ($inflate, $status) = Compress::Raw::Zlib::Inflate->new( AppendOutput => 1, LimitOutput => 1, CRC32 => $crc32, ADLER32 => $adler32, - WindowBits => - MAX_WBITS ; + WindowBits => - MAX_WBITS ); } - return (undef, "Could not create Inflation object: $status", $status) + return (undef, "Could not create Inflation object: $status", $status) if $status != Z_OK ; return bless {'Inf' => $inflate, @@ -47,8 +47,8 @@ sub mkUncompObject 'UnCompSize' => 0, 'Error' => '', 'ConsumesInput' => 1, - } ; - + } ; + } sub uncompr @@ -67,7 +67,7 @@ sub uncompr $self->{Error} = "Inflation Error: $status"; return STATUS_ERROR; } - + return STATUS_OK if $status == Z_BUF_ERROR ; # ??? return STATUS_OK if $status == Z_OK ; return STATUS_ENDSTREAM if $status == Z_STREAM_END ; @@ -115,8 +115,8 @@ sub adler32 sub sync { my $self = shift ; - ( $self->{Inf}->inflateSync(@_) == Z_OK) - ? STATUS_OK + ( $self->{Inf}->inflateSync(@_) == Z_OK) + ? STATUS_OK : STATUS_ERROR ; } @@ -154,4 +154,3 @@ sub createDeflateStream __END__ - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm index 63ada56ee1dd..7e2066d4e82a 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyInflate.pm @@ -6,27 +6,27 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 (); +use IO::Compress::Base::Common 2.100 qw(:Parse); -use IO::Uncompress::Adapter::Inflate 2.096 (); +use IO::Uncompress::Adapter::Inflate 2.100 (); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Gunzip 2.096 ; -use IO::Uncompress::Inflate 2.096 ; -use IO::Uncompress::RawInflate 2.096 ; -use IO::Uncompress::Unzip 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Gunzip 2.100 ; +use IO::Uncompress::Inflate 2.100 ; +use IO::Uncompress::RawInflate 2.100 ; +use IO::Uncompress::Unzip 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $AnyInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyInflateError anyinflate ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -48,7 +48,6 @@ sub anyinflate sub getExtraParams { - use IO::Compress::Base::Common 2.096 qw(:Parse); return ( 'rawinflate' => [Parse_boolean, 0] ) ; } @@ -75,9 +74,9 @@ sub mkUncomp if ! defined $obj; *$self->{Uncomp} = $obj; - + my @possible = qw( Inflate Gunzip Unzip ); - unshift @possible, 'RawInflate' + unshift @possible, 'RawInflate' if 1 || $got->getValue('rawinflate'); my $magic = $self->ckMagic( @possible ); @@ -113,7 +112,7 @@ sub ckMagic $self->pushBack(*$self->{HeaderPending}) ; *$self->{HeaderPending} = '' ; - } + } bless $self => $keep; return undef; @@ -135,7 +134,7 @@ IO::Uncompress::AnyInflate - Uncompress zlib-based (zip, gzip) file/buffer my $status = anyinflate $input => $output [,OPTS] or die "anyinflate failed: $AnyInflateError\n"; - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "anyinflate failed: $AnyInflateError\n"; $status = $z->read($buffer) @@ -444,7 +443,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyInflate qw(anyinflate $AnyInflateError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -479,7 +478,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyInflate is shown below - my $z = new IO::Uncompress::AnyInflate $input [OPTS] + my $z = IO::Uncompress::AnyInflate->new( $input [OPTS] ) or die "IO::Uncompress::AnyInflate failed: $AnyInflateError\n"; Returns an C object on success and undef on failure. @@ -999,8 +998,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm index ae8acdf2d836..b17a3edbdad8 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/AnyUncompress.pm @@ -4,21 +4,21 @@ use strict; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 (); +use IO::Compress::Base::Common 2.100 (); -use IO::Uncompress::Base 2.096 ; +use IO::Uncompress::Base 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyUncompressError); -$VERSION = '2.096'; +$VERSION = '2.100'; $AnyUncompressError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @EXPORT_OK = qw( $AnyUncompressError anyuncompress ) ; -%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS ; +%EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS; push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); @@ -33,26 +33,26 @@ BEGIN # Don't trigger any __DIE__ Hooks. local $SIG{__DIE__}; - eval ' use IO::Uncompress::Adapter::Inflate 2.096 ;'; - eval ' use IO::Uncompress::Adapter::Bunzip2 2.096 ;'; - eval ' use IO::Uncompress::Adapter::LZO 2.096 ;'; - eval ' use IO::Uncompress::Adapter::Lzf 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnLzma 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnXz 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnZstd 2.096 ;'; - eval ' use IO::Uncompress::Adapter::UnLzip 2.096 ;'; - - eval ' use IO::Uncompress::Bunzip2 2.096 ;'; - eval ' use IO::Uncompress::UnLzop 2.096 ;'; - eval ' use IO::Uncompress::Gunzip 2.096 ;'; - eval ' use IO::Uncompress::Inflate 2.096 ;'; - eval ' use IO::Uncompress::RawInflate 2.096 ;'; - eval ' use IO::Uncompress::Unzip 2.096 ;'; - eval ' use IO::Uncompress::UnLzf 2.096 ;'; - eval ' use IO::Uncompress::UnLzma 2.096 ;'; - eval ' use IO::Uncompress::UnXz 2.096 ;'; - eval ' use IO::Uncompress::UnZstd 2.096 ;'; - eval ' use IO::Uncompress::UnLzip 2.096 ;'; + eval ' use IO::Uncompress::Adapter::Inflate 2.100 ;'; + eval ' use IO::Uncompress::Adapter::Bunzip2 2.100 ;'; + eval ' use IO::Uncompress::Adapter::LZO 2.100 ;'; + eval ' use IO::Uncompress::Adapter::Lzf 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnLzma 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnXz 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnZstd 2.100 ;'; + eval ' use IO::Uncompress::Adapter::UnLzip 2.100 ;'; + + eval ' use IO::Uncompress::Bunzip2 2.100 ;'; + eval ' use IO::Uncompress::UnLzop 2.100 ;'; + eval ' use IO::Uncompress::Gunzip 2.100 ;'; + eval ' use IO::Uncompress::Inflate 2.100 ;'; + eval ' use IO::Uncompress::RawInflate 2.100 ;'; + eval ' use IO::Uncompress::Unzip 2.100 ;'; + eval ' use IO::Uncompress::UnLzf 2.100 ;'; + eval ' use IO::Uncompress::UnLzma 2.100 ;'; + eval ' use IO::Uncompress::UnXz 2.100 ;'; + eval ' use IO::Uncompress::UnZstd 2.100 ;'; + eval ' use IO::Uncompress::UnLzip 2.100 ;'; } @@ -279,7 +279,7 @@ IO::Uncompress::AnyUncompress - Uncompress gzip, zip, bzip2, zstd, xz, lzma, lzi my $status = anyuncompress $input => $output [,OPTS] or die "anyuncompress failed: $AnyUncompressError\n"; - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "anyuncompress failed: $AnyUncompressError\n"; $status = $z->read($buffer) @@ -600,7 +600,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::AnyUncompress qw(anyuncompress $AnyUncompressError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -635,7 +635,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::AnyUncompress is shown below - my $z = new IO::Uncompress::AnyUncompress $input [OPTS] + my $z = IO::Uncompress::AnyUncompress->new( $input [OPTS] ) or die "IO::Uncompress::AnyUncompress failed: $AnyUncompressError\n"; Returns an C object on success and undef on failure. @@ -1077,8 +1077,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm index 91a50e726328..5627bc6a44f7 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Base.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Base.pm @@ -9,12 +9,12 @@ our (@ISA, $VERSION, @EXPORT_OK, %EXPORT_TAGS); @ISA = qw(IO::File Exporter); -$VERSION = '2.096'; +$VERSION = '2.100'; use constant G_EOF => 0 ; use constant G_ERR => -1 ; -use IO::Compress::Base::Common 2.096 ; +use IO::Compress::Base::Common 2.100 ; use IO::File ; use Symbol; @@ -58,7 +58,7 @@ sub smartRead if (defined *$self->{FH}) { if ($offset) { - # Not using this + # Not using this # # *$self->{FH}->read($$out, $get_size, $offset); # @@ -75,7 +75,7 @@ sub smartRead elsif (defined *$self->{InputEvent}) { my $got = 1 ; while (length $$out < $size) { - last + last if ($got = *$self->{InputEvent}->($$out, $get_size)) <= 0; } @@ -93,13 +93,13 @@ sub smartRead substr($$out, $offset) = substr($$buf, *$self->{BufferOffset}, $get_size); if (*$self->{ConsumeInput}) { substr($$buf, 0, $get_size) = '' } - else + else { *$self->{BufferOffset} += length($$out) - $offset } } - *$self->{InputLengthRemaining} -= length($$out) #- $offset + *$self->{InputLengthRemaining} -= length($$out) #- $offset if defined *$self->{InputLength}; - + if (! defined $status) { $self->saveStatus($!) ; return STATUS_ERROR; @@ -169,7 +169,7 @@ sub smartTell if (defined *$self->{FH}) { return *$self->{FH}->tell() } - else + else { return *$self->{BufferOffset} } } @@ -179,7 +179,7 @@ sub smartWrite my $out_data = shift ; if (defined *$self->{FH}) { - # flush needed for 5.8.0 + # flush needed for 5.8.0 defined *$self->{FH}->write($out_data, length $out_data) && defined *$self->{FH}->flush() ; } @@ -199,7 +199,7 @@ sub smartReadExact sub smartEof { my ($self) = $_[0]; - local $.; + local $.; return 0 if length *$self->{Prime} || *$self->{PushMode}; @@ -207,15 +207,15 @@ sub smartEof { # Could use # - # *$self->{FH}->eof() + # *$self->{FH}->eof() # # here, but this can cause trouble if # the filehandle is itself a tied handle, but it uses sysread. - # Then we get into mixing buffered & non-buffered IO, + # Then we get into mixing buffered & non-buffered IO, # which will cause trouble my $info = $self->getErrInfo(); - + my $buffer = ''; my $status = $self->smartRead(\$buffer, 1); $self->pushBack($buffer) if length $buffer; @@ -225,7 +225,7 @@ sub smartEof } elsif (defined *$self->{InputEvent}) { *$self->{EventEof} } - else + else { *$self->{BufferOffset} >= length(${ *$self->{Buffer} }) } } @@ -347,7 +347,7 @@ sub checkParams my $class = shift ; my $got = shift || IO::Compress::Base::Parameters::new(); - + my $Valid = { 'blocksize' => [IO::Compress::Base::Common::Parse_unsigned, 16 * 1024], 'autoclose' => [IO::Compress::Base::Common::Parse_boolean, 0], @@ -362,7 +362,7 @@ sub checkParams #'decode' => [IO::Compress::Base::Common::Parse_any, undef], #'consumeinput' => [IO::Compress::Base::Common::Parse_boolean, 0], - + $self->getExtraParams(), #'Todo - Revert to ordinary file on end Z_STREAM_END'=> 0, @@ -371,11 +371,11 @@ sub checkParams $Valid->{trailingdata} = [IO::Compress::Base::Common::Parse_writable_scalar, undef] if *$self->{OneShot} ; - - $got->parse($Valid, @_ ) + + $got->parse($Valid, @_ ) or $self->croakError("${class}: " . $got->getError()) ; - $self->postCheckParams($got) + $self->postCheckParams($got) or $self->croakError("${class}: " . $self->error()) ; return $got; @@ -403,7 +403,7 @@ sub _create my $inType = whatIsInput($inValue, 1); - $obj->ckInputParam($class, $inValue, 1) + $obj->ckInputParam($class, $inValue, 1) or return undef ; *$obj->{InNew} = 1; @@ -412,8 +412,8 @@ sub _create or $obj->croakError("${class}: " . *$obj->{Error}); if ($inType eq 'buffer' || $inType eq 'code') { - *$obj->{Buffer} = $inValue ; - *$obj->{InputEvent} = $inValue + *$obj->{Buffer} = $inValue ; + *$obj->{InputEvent} = $inValue if $inType eq 'code' ; } else { @@ -422,18 +422,18 @@ sub _create *$obj->{Handle} = 1 ; # Need to rewind for Scan - *$obj->{FH}->seek(0, SEEK_SET) + *$obj->{FH}->seek(0, SEEK_SET) if $got->getValue('scan'); - } - else { + } + else { no warnings ; my $mode = '<'; $mode = '+<' if $got->getValue('scan'); *$obj->{StdIO} = ($inValue eq '-'); - *$obj->{FH} = new IO::File "$mode $inValue" + *$obj->{FH} = IO::File->new( "$mode $inValue" ) or return $obj->saveErrorString(undef, "cannot open file '$inValue': $!", $!) ; } - + *$obj->{LineNo} = $. = 0; setBinModeInput(*$obj->{FH}) ; @@ -441,7 +441,7 @@ sub _create *$obj->{Buffer} = \$buff ; } -# if ($got->getValue('decode')) { +# if ($got->getValue('decode')) { # my $want_encoding = $got->getValue('decode'); # *$obj->{Encoding} = IO::Compress::Base::Common::getEncoding($obj, $class, $want_encoding); # } @@ -449,7 +449,7 @@ sub _create # *$obj->{Encoding} = undef; # } - *$obj->{InputLength} = $got->parsed('inputlength') + *$obj->{InputLength} = $got->parsed('inputlength') ? $got->getValue('inputlength') : undef ; *$obj->{InputLengthRemaining} = $got->getValue('inputlength'); @@ -465,7 +465,7 @@ sub _create # TODO - move these two into RawDeflate *$obj->{Scan} = $got->getValue('scan'); - *$obj->{ParseExtra} = $got->getValue('parseextra') + *$obj->{ParseExtra} = $got->getValue('parseextra') || $got->getValue('strict') ; *$obj->{Type} = ''; *$obj->{Prime} = $got->getValue('prime') || '' ; @@ -473,8 +473,8 @@ sub _create *$obj->{Plain} = 0; *$obj->{PlainBytesRead} = 0; *$obj->{InflatedBytesRead} = 0; - *$obj->{UnCompSize} = new U64; - *$obj->{CompSize} = new U64; + *$obj->{UnCompSize} = U64->new; + *$obj->{CompSize} = U64->new; *$obj->{TotalInflatedBytesRead} = 0; *$obj->{NewStream} = 0 ; *$obj->{EventEof} = 0 ; @@ -494,19 +494,19 @@ sub _create *$obj->{InNew} = 0; *$obj->{Closed} = 0; - - return $obj + + return $obj if *$obj->{Pause} ; if ($status) { # Need to try uncompressing to catch the case # where the compressed file uncompresses to an # empty string - so eof is set immediately. - + my $out_buffer = ''; $status = $obj->read(\$out_buffer); - + if ($status < 0) { *$obj->{ReadStatus} = [ $status, $obj->error(), $obj->errorNo() ]; } @@ -515,7 +515,7 @@ sub _create if length $out_buffer; } else { - return undef + return undef unless *$obj->{Transparent}; $obj->clearError(); @@ -549,7 +549,7 @@ sub ckInputParam # # if ($_[0] ne '-' && ! -e $_[0] ) # { -# return $self->saveErrorString(1, +# return $self->saveErrorString(1, # "input file '$_[0]' does not exist", STATUS_ERROR); # } # } @@ -573,13 +573,13 @@ sub _inf my $output = shift ; - my $x = new IO::Compress::Base::Validator($class, *$obj->{Error}, $name, $input, $output) + my $x = IO::Compress::Base::Validator->new($class, *$obj->{Error}, $name, $input, $output) or return undef ; - + push @_, $output if $haveOut && $x->{Hash}; *$obj->{OneShot} = 1 ; - + my $got = $obj->checkParams($name, undef, @_) or return undef ; @@ -589,25 +589,25 @@ sub _inf # warn "TD $value "; # #$value = $$value; ## warn "TD $value $$value "; -# +# # return retErr($obj, "Parameter 'TrailingData' not writable") -# if readonly $$value ; +# if readonly $$value ; # -# if (ref $$value) +# if (ref $$value) # { # return retErr($obj,"Parameter 'TrailingData' not a scalar reference") # if ref $$value ne 'SCALAR' ; -# +# # *$obj->{TrailingData} = $$value ; # } -# else +# else # { # return retErr($obj,"Parameter 'TrailingData' not a scalar") -# if ref $value ne 'SCALAR' ; +# if ref $value ne 'SCALAR' ; # # *$obj->{TrailingData} = $value ; # } - + *$obj->{TrailingData} = $got->getValue('trailingdata'); } @@ -620,7 +620,7 @@ sub _inf # { # while (my($k, $v) = each %$input) # { -# $v = \$input->{$k} +# $v = \$input->{$k} # unless defined $v ; # # $obj->_singleTarget($x, $k, $v, @_) @@ -629,7 +629,7 @@ sub _inf # # return keys %$input ; # } - + if ($x->{GlobMap}) { $x->{oneInput} = 1 ; @@ -645,11 +645,11 @@ sub _inf if (! $x->{oneOutput} ) { - my $inFile = ($x->{inType} eq 'filenames' + my $inFile = ($x->{inType} eq 'filenames' || $x->{inType} eq 'filename'); $x->{inType} = $inFile ? 'filename' : 'buffer'; - + foreach my $in ($x->{oneInput} ? $input : @$input) { my $out ; @@ -684,7 +684,7 @@ sub _singleTarget my $x = shift ; my $input = shift; my $output = shift; - + my $buff = ''; $x->{buff} = \$buff ; @@ -693,7 +693,7 @@ sub _singleTarget my $mode = '>' ; $mode = '>>' if $x->{Got}->getValue('append') ; - $x->{fh} = new IO::File "$mode $output" + $x->{fh} = IO::File->new( "$mode $output" ) or return retErr($x, "cannot open file '$output': $!") ; binmode $x->{fh} ; @@ -708,10 +708,10 @@ sub _singleTarget } } - + elsif ($x->{outType} eq 'buffer' ) { - $$output = '' + $$output = '' unless $x->{Got}->getValue('append'); $x->{buff} = $output ; } @@ -719,22 +719,22 @@ sub _singleTarget if ($x->{oneInput}) { defined $self->_rd2($x, $input, $output) - or return undef; + or return undef; } else { for my $element ( ($x->{inType} eq 'hash') ? keys %$input : @$input) { - defined $self->_rd2($x, $element, $output) + defined $self->_rd2($x, $element, $output) or return undef ; } } - if ( ($x->{outType} eq 'filename' && $output ne '-') || + if ( ($x->{outType} eq 'filename' && $output ne '-') || ($x->{outType} eq 'handle' && $x->{Got}->getValue('autoclose'))) { - $x->{fh}->close() - or return retErr($x, $!); + $x->{fh}->close() + or return retErr($x, $!); delete $x->{fh}; } @@ -747,15 +747,15 @@ sub _rd2 my $x = shift ; my $input = shift; my $output = shift; - + my $z = IO::Compress::Base::Common::createSelfTiedObject($x->{Class}, *$self->{Error}); - + $z->_create($x->{Got}, 1, $input, @_) or return undef ; my $status ; my $fh = $x->{fh}; - + while (1) { while (($status = $z->read($x->{buff})) > 0) { @@ -770,9 +770,9 @@ sub _rd2 if (! $x->{oneOutput} ) { my $ot = $x->{outType} ; - if ($ot eq 'array') + if ($ot eq 'array') { push @$output, $x->{buff} } - elsif ($ot eq 'hash') + elsif ($ot eq 'hash') { $output->{$input} = $x->{buff} } my $buff = ''; @@ -781,12 +781,12 @@ sub _rd2 last if $status < 0 || $z->smartEof(); - last + last unless *$self->{MultiStream}; $status = $z->nextStream(); - last + last unless $status == 1 ; } @@ -796,7 +796,7 @@ sub _rd2 ${ *$self->{TrailingData} } = $z->trailingData() if defined *$self->{TrailingData} ; - $z->close() + $z->close() or return undef ; return 1 ; @@ -808,7 +808,7 @@ sub TIEHANDLE die "OOPS\n" ; } - + sub UNTIE { my $self = shift ; @@ -836,7 +836,7 @@ sub readBlock $size = List::Util::min($size, *$self->{CompressedInputLengthRemaining} ); *$self->{CompressedInputLengthRemaining} -= $size ; } - + my $status = $self->smartRead($buff, $size) ; return $self->saveErrorString(STATUS_ERROR, "Error Reading Data: $!", $!) if $status == STATUS_ERROR ; @@ -861,7 +861,7 @@ sub _raw_read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; return G_EOF if *$self->{Closed} ; @@ -873,8 +873,8 @@ sub _raw_read if (*$self->{Plain}) { my $tmp_buff ; my $len = $self->smartRead(\$tmp_buff, *$self->{BlockSize}) ; - - return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) + + return $self->saveErrorString(G_ERR, "Error reading data: $!", $!) if $len == STATUS_ERROR ; if ($len == 0 ) { @@ -898,13 +898,13 @@ sub _raw_read $$buffer .= *$self->{Pending} ; my $len = length *$self->{Pending} ; *$self->{Pending} = ''; - return $len; + return $len; } my $temp_buf = ''; my $outSize = 0; my $status = $self->readBlock(\$temp_buf, *$self->{BlockSize}, $outSize) ; - + return G_ERR if $status == STATUS_ERROR ; @@ -915,18 +915,18 @@ sub _raw_read $status = *$self->{Uncomp}->uncompr(\$temp_buf, $buffer, defined *$self->{CompressedInputLengthDone} || $self->smartEof(), $outSize); - + # Remember the input buffer if it wasn't consumed completely $self->pushBack($temp_buf) if *$self->{Uncomp}{ConsumesInput}; return $self->saveErrorString(G_ERR, *$self->{Uncomp}{Error}, *$self->{Uncomp}{ErrorNo}) - if $self->saveStatus($status) == STATUS_ERROR; + if $self->saveStatus($status) == STATUS_ERROR; $self->postBlockChk($buffer, $before_len) == STATUS_OK or return G_ERR; $buf_len = defined $$buffer ? length($$buffer) - $before_len : 0; - + *$self->{CompSize}->add($beforeC_len - length $temp_buf) ; *$self->{InflatedBytesRead} += $buf_len ; @@ -960,7 +960,7 @@ sub _raw_read or return G_ERR; } else { - return $self->TrailerError("trailer truncated. Expected " . + return $self->TrailerError("trailer truncated. Expected " . "$trailer_size bytes, got $got") if *$self->{Strict}; $self->pushBack($trailer) ; @@ -978,7 +978,7 @@ sub _raw_read } } - + # return the number of uncompressed bytes read return $buf_len ; @@ -1029,7 +1029,7 @@ sub gotoNextStream # TODO - make this more efficient if know the offset for the end of # the stream and seekable - $status = $self->read($buffer) + $status = $self->read($buffer) while $status > 0 ; return $status @@ -1074,7 +1074,7 @@ sub gotoNextStream push @{ *$self->{InfoList} }, *$self->{Info} ; - return 1; + return 1; } sub streamCount @@ -1090,7 +1090,7 @@ sub read # >0 - ok, number of bytes read # =0 - ok, eof # <0 - not ok - + my $self = shift ; if (defined *$self->{ReadStatus} ) { @@ -1123,7 +1123,7 @@ sub read my $offset = $_[2] || 0; if (! *$self->{AppendOutput}) { - if (! $offset) { + if (! $offset) { $$buffer = '' ; } @@ -1161,13 +1161,13 @@ sub read } else { my $len = 0; - $len = $self->_raw_read($buffer) + $len = $self->_raw_read($buffer) while ! *$self->{EndStream} && $len == 0 ; return $len ; } } - # Need to jump through more hoops - either length or offset + # Need to jump through more hoops - either length or offset # or both are specified. my $out_buffer = *$self->{Pending} ; *$self->{Pending} = ''; @@ -1176,17 +1176,17 @@ sub read while (! *$self->{EndStream} && length($out_buffer) < $length) { my $buf_len = $self->_raw_read(\$out_buffer); - return $buf_len + return $buf_len if $buf_len < 0 ; } - $length = length $out_buffer + $length = length $out_buffer if length($out_buffer) < $length ; - return 0 + return 0 if $length == 0 ; - $$buffer = '' + $$buffer = '' if ! defined $$buffer; $offset = length $$buffer @@ -1223,7 +1223,7 @@ sub _getline # Paragraph Mode if ( ! length $/ ) { - my $paragraph ; + my $paragraph ; while (($status = $self->read($paragraph)) > 0 ) { if ($paragraph =~ s/^(.*?\n\n+)//s) { *$self->{Pending} = $paragraph ; @@ -1236,13 +1236,13 @@ sub _getline # $/ isn't empty, or a reference, so it's Line Mode. { - my $line ; + my $line ; my $p = \*$self->{Pending} ; while (($status = $self->read($line)) > 0 ) { my $offset = index($line, $/); if ($offset >= 0) { my $l = substr($line, 0, $offset + length $/ ); - substr($line, 0, $offset + length $/) = ''; + substr($line, 0, $offset + length $/) = ''; $$p = $line; return (1, \$l); } @@ -1262,7 +1262,7 @@ sub getline return undef; } - return undef + return undef if *$self->{Closed} || (!length *$self->{Pending} && *$self->{EndStream}) ; my $current_append = *$self->{AppendOutput} ; @@ -1271,7 +1271,7 @@ sub getline my ($status, $lineref) = $self->_getline(); *$self->{AppendOutput} = $current_append; - return undef + return undef if $status < 0 || length $$lineref == 0 ; $. = ++ *$self->{LineNo} ; @@ -1282,10 +1282,10 @@ sub getline sub getlines { my $self = shift; - $self->croakError(*$self->{ClassName} . + $self->croakError(*$self->{ClassName} . "::getlines: called in scalar context\n") unless wantarray; my($line, @lines); - push(@lines, $line) + push(@lines, $line) while defined($line = $self->getline); return @lines; } @@ -1307,8 +1307,8 @@ sub getc sub ungetc { my $self = shift; - *$self->{Pending} = "" unless defined *$self->{Pending} ; - *$self->{Pending} = $_[0] . *$self->{Pending} ; + *$self->{Pending} = "" unless defined *$self->{Pending} ; + *$self->{Pending} = $_[0] . *$self->{Pending} ; } @@ -1332,7 +1332,7 @@ sub eof my $self = shift ; return (*$self->{Closed} || - (!length *$self->{Pending} + (!length *$self->{Pending} && ( $self->smartEof() || *$self->{EndStream}))) ; } @@ -1362,14 +1362,14 @@ sub close return 1 if *$self->{Closed} ; - untie *$self + untie *$self if $] >= 5.008 ; my $status = 1 ; if (defined *$self->{FH}) { if ((! *$self->{Handle} || *$self->{AutoClose}) && ! *$self->{StdIO}) { - local $.; + local $.; $! = 0 ; $status = *$self->{FH}->close(); return $self->saveErrorString(0, $!, $!) @@ -1449,8 +1449,8 @@ sub seek sub fileno { my $self = shift ; - return defined *$self->{FH} - ? fileno *$self->{FH} + return defined *$self->{FH} + ? fileno *$self->{FH} : undef ; } @@ -1458,8 +1458,8 @@ sub binmode { 1; # my $self = shift ; -# return defined *$self->{FH} -# ? binmode *$self->{FH} +# return defined *$self->{FH} +# ? binmode *$self->{FH} # : 1 ; } @@ -1472,8 +1472,8 @@ sub opened sub autoflush { my $self = shift ; - return defined *$self->{FH} - ? *$self->{FH}->autoflush(@_) + return defined *$self->{FH} + ? *$self->{FH}->autoflush(@_) : undef ; } @@ -1485,33 +1485,35 @@ sub input_line_number return $last; } - -*BINMODE = \&binmode; -*SEEK = \&seek; -*READ = \&read; -*sysread = \&read; -*TELL = \&tell; -*EOF = \&eof; - -*FILENO = \&fileno; -*CLOSE = \&close; - sub _notAvailable { my $name = shift ; return sub { croak "$name Not Available: File opened only for intput" ; } ; } - -*print = _notAvailable('print'); -*PRINT = _notAvailable('print'); -*printf = _notAvailable('printf'); -*PRINTF = _notAvailable('printf'); -*write = _notAvailable('write'); -*WRITE = _notAvailable('write'); - -#*sysread = \&read; -#*syswrite = \&_notAvailable; +{ + no warnings 'once'; + + *BINMODE = \&binmode; + *SEEK = \&seek; + *READ = \&read; + *sysread = \&read; + *TELL = \&tell; + *EOF = \&eof; + + *FILENO = \&fileno; + *CLOSE = \&close; + + *print = _notAvailable('print'); + *PRINT = _notAvailable('print'); + *printf = _notAvailable('printf'); + *PRINTF = _notAvailable('printf'); + *write = _notAvailable('write'); + *WRITE = _notAvailable('write'); + + #*sysread = \&read; + #*syswrite = \&_notAvailable; +} @@ -1560,8 +1562,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm index 65932c19c445..1bc8ac2b0eba 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Bunzip2.pm @@ -4,15 +4,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); +use IO::Compress::Base::Common 2.100 qw(:Status ); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Adapter::Bunzip2 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Adapter::Bunzip2 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $Bunzip2Error); -$VERSION = '2.096'; +$VERSION = '2.100'; $Bunzip2Error = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -72,7 +72,7 @@ sub mkUncomp return $self->saveErrorString(undef, $errstr, $errno) if ! defined $obj; - + *$self->{Uncomp} = $obj; return 1; @@ -88,15 +88,15 @@ sub ckMagic $self->smartReadExact(\$magic, 4); *$self->{HeaderPending} = $magic ; - - return $self->HeaderError("Header size is " . - 4 . " bytes") + + return $self->HeaderError("Header size is " . + 4 . " bytes") if length $magic != 4; return $self->HeaderError("Bad Magic.") if ! isBzip2Magic($magic) ; - - + + *$self->{Type} = 'bzip2'; return $magic; } @@ -117,7 +117,7 @@ sub readHeader 'TrailerLength' => 0, 'Header' => '$magic' }; - + } sub chkTrailer @@ -149,7 +149,7 @@ IO::Uncompress::Bunzip2 - Read bzip2 files/buffers my $status = bunzip2 $input => $output [,OPTS] or die "bunzip2 failed: $Bunzip2Error\n"; - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "bunzip2 failed: $Bunzip2Error\n"; $status = $z->read($buffer) @@ -440,7 +440,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -475,7 +475,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Bunzip2 is shown below - my $z = new IO::Uncompress::Bunzip2 $input [OPTS] + my $z = IO::Uncompress::Bunzip2->new( $input [OPTS] ) or die "IO::Uncompress::Bunzip2 failed: $Bunzip2Error\n"; Returns an C object on success and undef on failure. @@ -907,8 +907,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm index 2bb383c2b886..2c2529d53b1b 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Gunzip.pm @@ -9,12 +9,12 @@ use strict ; use warnings; use bytes; -use IO::Uncompress::RawInflate 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; -use Compress::Raw::Zlib 2.096 () ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Gzip::Constants 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; +use Compress::Raw::Zlib 2.100 () ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Gzip::Constants 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; require Exporter ; @@ -28,7 +28,7 @@ Exporter::export_ok_tags('all'); $GunzipError = ''; -$VERSION = '2.096'; +$VERSION = '2.100'; sub new { @@ -70,9 +70,9 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") if ! isGzipMagic($magic) ; @@ -95,10 +95,10 @@ sub chkTrailer my $self = shift; my $trailer = shift; - # Check CRC & ISIZE + # Check CRC & ISIZE my ($CRC32, $ISIZE) = unpack("V V", $trailer) ; - *$self->{Info}{CRC32} = $CRC32; - *$self->{Info}{ISIZE} = $ISIZE; + *$self->{Info}{CRC32} = $CRC32; + *$self->{Info}{ISIZE} = $ISIZE; if (*$self->{Strict}) { return $self->TrailerError("CRC mismatch") @@ -130,9 +130,9 @@ sub _readFullGzipHeader($) *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Minimum header size is " . - GZIP_MIN_HEADER_SIZE . " bytes") - if length $magic != GZIP_ID_SIZE ; + return $self->HeaderError("Minimum header size is " . + GZIP_MIN_HEADER_SIZE . " bytes") + if length $magic != GZIP_ID_SIZE ; return $self->HeaderError("Bad Magic") @@ -150,7 +150,7 @@ sub _readGzipHeader($) my ($buffer) = '' ; $self->smartReadExact(\$buffer, GZIP_MIN_HEADER_SIZE - GZIP_ID_SIZE) - or return $self->HeaderError("Minimum header size is " . + or return $self->HeaderError("Minimum header size is " . GZIP_MIN_HEADER_SIZE . " bytes") ; my $keep = $magic . $buffer ; @@ -159,22 +159,22 @@ sub _readGzipHeader($) # now split out the various parts my ($cm, $flag, $mtime, $xfl, $os) = unpack("C C V C C", $buffer) ; - $cm == GZIP_CM_DEFLATED + $cm == GZIP_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; # check for use of reserved bits return $self->HeaderError("Use of Reserved Bits in FLG field.") - if $flag & GZIP_FLG_RESERVED ; + if $flag & GZIP_FLG_RESERVED ; my $EXTRA ; my @EXTRA = () ; if ($flag & GZIP_FLG_FEXTRA) { $EXTRA = "" ; - $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) + $self->smartReadExact(\$buffer, GZIP_FEXTRA_HEADER_SIZE) or return $self->TruncatedHeader("FEXTRA Length") ; my ($XLEN) = unpack("v", $buffer) ; - $self->smartReadExact(\$EXTRA, $XLEN) + $self->smartReadExact(\$EXTRA, $XLEN) or return $self->TruncatedHeader("FEXTRA Body"); $keep .= $buffer . $EXTRA ; @@ -190,10 +190,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FNAME) { $origname = "" ; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FNAME"); last if $buffer eq GZIP_NULL_BYTE ; - $origname .= $buffer + $origname .= $buffer } $keep .= $origname . GZIP_NULL_BYTE ; @@ -205,10 +205,10 @@ sub _readGzipHeader($) if ($flag & GZIP_FLG_FCOMMENT) { $comment = ""; while (1) { - $self->smartReadExact(\$buffer, 1) + $self->smartReadExact(\$buffer, 1) or return $self->TruncatedHeader("FCOMMENT"); last if $buffer eq GZIP_NULL_BYTE ; - $comment .= $buffer + $comment .= $buffer } $keep .= $comment . GZIP_NULL_BYTE ; @@ -217,7 +217,7 @@ sub _readGzipHeader($) } if ($flag & GZIP_FLG_FHCRC) { - $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) + $self->smartReadExact(\$buffer, GZIP_FHCRC_SIZE) or return $self->TruncatedHeader("FHCRC"); $HeaderCRC = unpack("v", $buffer) ; @@ -254,7 +254,7 @@ sub _readGzipHeader($) 'Comment' => $comment, 'Time' => $mtime, 'OsID' => $os, - 'OsName' => defined $GZIP_OS_Names{$os} + 'OsName' => defined $GZIP_OS_Names{$os} ? $GZIP_OS_Names{$os} : "Unknown", 'HeaderCRC' => $HeaderCRC, 'Flags' => $flag, @@ -286,7 +286,7 @@ IO::Uncompress::Gunzip - Read RFC 1952 files/buffers my $status = gunzip $input => $output [,OPTS] or die "gunzip failed: $GunzipError\n"; - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "gunzip failed: $GunzipError\n"; $status = $z->read($buffer) @@ -579,7 +579,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -614,7 +614,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Gunzip is shown below - my $z = new IO::Uncompress::Gunzip $input [OPTS] + my $z = IO::Uncompress::Gunzip->new( $input [OPTS] ) or die "IO::Uncompress::Gunzip failed: $GunzipError\n"; Returns an C object on success and undef on failure. @@ -1122,8 +1122,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm index 3d576f952914..5621959af930 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Inflate.pm @@ -5,15 +5,15 @@ use strict ; use warnings; use bytes; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Compress::Zlib::Constants 2.096 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Compress::Zlib::Constants 2.100 ; -use IO::Uncompress::RawInflate 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $InflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $InflateError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -62,14 +62,14 @@ sub ckMagic *$self->{HeaderPending} = $magic ; - return $self->HeaderError("Header size is " . - ZLIB_HEADER_SIZE . " bytes") + return $self->HeaderError("Header size is " . + ZLIB_HEADER_SIZE . " bytes") if length $magic != ZLIB_HEADER_SIZE; #return $self->HeaderError("CRC mismatch.") return undef if ! $self->isZlibMagic($magic) ; - + *$self->{Type} = 'rfc1950'; return $magic; } @@ -88,7 +88,7 @@ sub chkTrailer my $trailer = shift; my $ADLER32 = unpack("N", $trailer) ; - *$self->{Info}{ADLER32} = $ADLER32; + *$self->{Info}{ADLER32} = $ADLER32; return $self->TrailerError("CRC mismatch") if *$self->{Strict} && $ADLER32 != *$self->{Uncomp}->adler32() ; @@ -102,7 +102,7 @@ sub isZlibMagic my $self = shift; my $buffer = shift ; - return 0 + return 0 if length $buffer < ZLIB_HEADER_SIZE ; my $hdr = unpack("n", $buffer) ; @@ -114,16 +114,16 @@ sub isZlibMagic my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; # Only Deflate supported - return $self->HeaderError("Not Deflate (CM is $cm)") + return $self->HeaderError("Not Deflate (CM is $cm)") if $cm != ZLIB_CMF_CM_DEFLATED ; # Max window value is 7 for Deflate. my $cinfo = bits($CMF, ZLIB_CMF_CINFO_OFFSET, ZLIB_CMF_CINFO_BITS) ; - return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . - " (CINFO is $cinfo)") + return $self->HeaderError("CINFO > " . ZLIB_CMF_CINFO_MAX . + " (CINFO is $cinfo)") if $cinfo > ZLIB_CMF_CINFO_MAX ; - return 1; + return 1; } sub bits @@ -145,19 +145,19 @@ sub _readDeflateHeader # # *$self->{HeaderPending} = $buffer ; # -# return $self->HeaderError("Header size is " . -# ZLIB_HEADER_SIZE . " bytes") +# return $self->HeaderError("Header size is " . +# ZLIB_HEADER_SIZE . " bytes") # if length $buffer != ZLIB_HEADER_SIZE; # # return $self->HeaderError("CRC mismatch.") # if ! isZlibMagic($buffer) ; # } - + my ($CMF, $FLG) = unpack "C C", $buffer; my $FDICT = bits($FLG, ZLIB_FLG_FDICT_OFFSET, ZLIB_FLG_FDICT_BITS ), my $cm = bits($CMF, ZLIB_CMF_CM_OFFSET, ZLIB_CMF_CM_BITS) ; - $cm == ZLIB_CMF_CM_DEFLATED + $cm == ZLIB_CMF_CM_DEFLATED or return $self->HeaderError("Not Deflate (CM is $cm)") ; my $DICTID; @@ -208,7 +208,7 @@ IO::Uncompress::Inflate - Read RFC 1950 files/buffers my $status = inflate $input => $output [,OPTS] or die "inflate failed: $InflateError\n"; - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "inflate failed: $InflateError\n"; $status = $z->read($buffer) @@ -501,7 +501,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Inflate qw(inflate $InflateError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -536,7 +536,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::Inflate is shown below - my $z = new IO::Uncompress::Inflate $input [OPTS] + my $z = IO::Uncompress::Inflate->new( $input [OPTS] ) or die "IO::Uncompress::Inflate failed: $InflateError\n"; Returns an C object on success and undef on failure. @@ -994,8 +994,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm index b5a4b8a71ead..1a6c1f5860cc 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/RawInflate.pm @@ -5,16 +5,16 @@ use strict ; use warnings; use bytes; -use Compress::Raw::Zlib 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); +use Compress::Raw::Zlib 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); -use IO::Uncompress::Base 2.096 ; -use IO::Uncompress::Adapter::Inflate 2.096 ; +use IO::Uncompress::Base 2.100 ; +use IO::Uncompress::Adapter::Inflate 2.100 ; require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, %DEFLATE_CONSTANTS, $RawInflateError); -$VERSION = '2.096'; +$VERSION = '2.100'; $RawInflateError = ''; @ISA = qw(IO::Uncompress::Base Exporter); @@ -25,16 +25,16 @@ push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ; Exporter::export_ok_tags('all'); #{ -# # Execute at runtime +# # Execute at runtime # my %bad; # for my $module (qw(Compress::Raw::Zlib IO::Compress::Base::Common IO::Uncompress::Base IO::Uncompress::Adapter::Inflate)) # { # my $ver = ${ $module . "::VERSION"} ; -# +# # $bad{$module} = $ver # if $ver ne $VERSION; # } -# +# # if (keys %bad) # { # my $string = join "\n", map { "$_ $bad{$_}" } keys %bad; @@ -148,14 +148,14 @@ sub _isRawx my $buffer = ''; - $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 + $self->smartRead(\$buffer, *$self->{BlockSize}) >= 0 or return $self->saveErrorString(undef, "No data to read"); my $temp_buf = $magic . $buffer ; - *$self->{HeaderPending} = $temp_buf ; + *$self->{HeaderPending} = $temp_buf ; $buffer = ''; my $status = *$self->{Uncomp}->uncompr(\$temp_buf, \$buffer, $self->smartEof()) ; - + return $self->saveErrorString(undef, *$self->{Uncomp}{Error}, STATUS_ERROR) if $status == STATUS_ERROR; @@ -163,12 +163,12 @@ sub _isRawx return $self->saveErrorString(undef, "unexpected end of file", STATUS_ERROR) if $self->smartEof() && $status != STATUS_ENDSTREAM; - + #my $buf_len = *$self->{Uncomp}->uncompressedBytes(); my $buf_len = length $buffer; if ($status == STATUS_ENDSTREAM) { - if (*$self->{MultiStream} + if (*$self->{MultiStream} && (length $temp_buf || ! $self->smartEof())){ *$self->{NewStream} = 1 ; *$self->{EndStream} = 0 ; @@ -177,9 +177,9 @@ sub _isRawx *$self->{EndStream} = 1 ; } } - *$self->{HeaderPending} = $buffer ; - *$self->{InflatedBytesRead} = $buf_len ; - *$self->{TotalInflatedBytesRead} += $buf_len ; + *$self->{HeaderPending} = $buffer ; + *$self->{InflatedBytesRead} = $buf_len ; + *$self->{TotalInflatedBytesRead} += $buf_len ; *$self->{Type} = 'rfc1951'; $self->saveStatus(STATUS_OK); @@ -229,7 +229,7 @@ sub inflateSync return $self->saveErrorString(0, "unexpected end of file", STATUS_ERROR); } } - + $status = *$self->{Uncomp}->sync($temp_buf) ; if ($status == STATUS_OK) @@ -251,23 +251,23 @@ sub inflateSync # my $status ; # my $end_offset = 0; # -# $status = $self->scan() +# $status = $self->scan() # #or return $self->saveErrorString(undef, "Error Scanning: $$error_ref", $self->errorNo) ; # or return $self->saveErrorString(G_ERR, "Error Scanning: $status") # -# $status = $self->zap($end_offset) +# $status = $self->zap($end_offset) # or return $self->saveErrorString(G_ERR, "Error Zapping: $status"); # #or return $self->saveErrorString(undef, "Error Zapping: $$error_ref", $self->errorNo) ; # # #(*$obj->{Deflate}, $status) = $inf->createDeflate(); # ## *$obj->{Header} = *$inf->{Info}{Header}; -## *$obj->{UnCompSize_32bit} = +## *$obj->{UnCompSize_32bit} = ## *$obj->{BytesWritten} = *$inf->{UnCompSize_32bit} ; ## *$obj->{CompSize_32bit} = *$inf->{CompSize_32bit} ; # # -## if ( $outType eq 'buffer') +## if ( $outType eq 'buffer') ## { substr( ${ *$self->{Buffer} }, $end_offset) = '' } ## elsif ($outType eq 'handle' || $outType eq 'filename') { ## *$self->{FH} = *$inf->{FH} ; @@ -275,11 +275,11 @@ sub inflateSync ## *$obj->{FH}->flush() ; ## *$obj->{Handle} = 1 if $outType eq 'handle'; ## -## #seek(*$obj->{FH}, $end_offset, SEEK_SET) -## *$obj->{FH}->seek($end_offset, SEEK_SET) +## #seek(*$obj->{FH}, $end_offset, SEEK_SET) +## *$obj->{FH}->seek($end_offset, SEEK_SET) ## or return $obj->saveErrorString(undef, $!, $!) ; ## } -# +# #} sub scan @@ -292,7 +292,7 @@ sub scan my $buffer = '' ; my $len = 0; - $len = $self->_raw_read(\$buffer, 1) + $len = $self->_raw_read(\$buffer, 1) while ! *$self->{EndStream} && $len >= 0 ; #return $len if $len < 0 ? $len : 0 ; @@ -310,16 +310,16 @@ sub zap #printf "# block_offset $block_offset %x\n", $block_offset; my $byte ; ( $self->smartSeek($block_offset) && - $self->smartRead(\$byte, 1) ) - or return $self->saveErrorString(0, $!, $!); + $self->smartRead(\$byte, 1) ) + or return $self->saveErrorString(0, $!, $!); #printf "#byte is %x\n", unpack('C*',$byte); *$self->{Uncomp}->resetLastBlockByte($byte); #printf "#to byte is %x\n", unpack('C*',$byte); - ( $self->smartSeek($block_offset) && + ( $self->smartSeek($block_offset) && $self->smartWrite($byte) ) - or return $self->saveErrorString(0, $!, $!); + or return $self->saveErrorString(0, $!, $!); #$self->smartSeek($end_offset, 1); @@ -335,12 +335,12 @@ sub createDeflate -CRC32 => *$self->{Params}->getValue('crc32'), -ADLER32 => *$self->{Params}->getValue('adler32'), ); - - return wantarray ? ($status, $def) : $def ; + + return wantarray ? ($status, $def) : $def ; } -1; +1; __END__ @@ -356,7 +356,7 @@ IO::Uncompress::RawInflate - Read RFC 1951 files/buffers my $status = rawinflate $input => $output [,OPTS] or die "rawinflate failed: $RawInflateError\n"; - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "rawinflate failed: $RawInflateError\n"; $status = $z->read($buffer) @@ -646,7 +646,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::RawInflate qw(rawinflate $RawInflateError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -681,7 +681,7 @@ and if you want to compress each file one at a time, this will do the trick The format of the constructor for IO::Uncompress::RawInflate is shown below - my $z = new IO::Uncompress::RawInflate $input [OPTS] + my $z = IO::Uncompress::RawInflate->new( $input [OPTS] ) or die "IO::Uncompress::RawInflate failed: $RawInflateError\n"; Returns an C object on success and undef on failure. @@ -1122,8 +1122,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm index 24cd66e51ee3..55eb89e0103a 100644 --- a/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm +++ b/cpan/IO-Compress/lib/IO/Uncompress/Unzip.pm @@ -9,14 +9,14 @@ use warnings; use bytes; use IO::File; -use IO::Uncompress::RawInflate 2.096 ; -use IO::Compress::Base::Common 2.096 qw(:Status ); -use IO::Uncompress::Adapter::Inflate 2.096 ; -use IO::Uncompress::Adapter::Identity 2.096 ; -use IO::Compress::Zlib::Extra 2.096 ; -use IO::Compress::Zip::Constants 2.096 ; +use IO::Uncompress::RawInflate 2.100 ; +use IO::Compress::Base::Common 2.100 qw(:Status ); +use IO::Uncompress::Adapter::Inflate 2.100 ; +use IO::Uncompress::Adapter::Identity 2.100 ; +use IO::Compress::Zlib::Extra 2.100 ; +use IO::Compress::Zip::Constants 2.100 ; -use Compress::Raw::Zlib 2.096 () ; +use Compress::Raw::Zlib 2.100 () ; BEGIN { @@ -24,13 +24,13 @@ BEGIN local $SIG{__DIE__}; eval{ require IO::Uncompress::Adapter::Bunzip2 ; - import IO::Uncompress::Adapter::Bunzip2 } ; + IO::Uncompress::Adapter::Bunzip2->import() } ; eval{ require IO::Uncompress::Adapter::UnLzma ; - import IO::Uncompress::Adapter::UnLzma } ; + IO::Uncompress::Adapter::UnLzma->import() } ; eval{ require IO::Uncompress::Adapter::UnXz ; - import IO::Uncompress::Adapter::UnXz } ; + IO::Uncompress::Adapter::UnXz->import() } ; eval{ require IO::Uncompress::Adapter::UnZstd ; - import IO::Uncompress::Adapter::UnZstd } ; + IO::Uncompress::Adapter::UnZstd->import() } ; } @@ -38,7 +38,7 @@ require Exporter ; our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnzipError, %headerLookup); -$VERSION = '2.096'; +$VERSION = '2.100'; $UnzipError = ''; @ISA = qw(IO::Uncompress::RawInflate Exporter); @@ -932,7 +932,7 @@ sub scanCentralDirectory $self->skip($filename_length ) ; - my $v64 = new U64 $compressedLength ; + my $v64 = U64->new( $compressedLength ); if (U64::full32 $compressedLength ) { $self->smartReadExact(\$buffer, $extra_length) ; @@ -1093,7 +1093,7 @@ IO::Uncompress::Unzip - Read zip files/buffers my $status = unzip $input => $output [,OPTS] or die "unzip failed: $UnzipError\n"; - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "unzip failed: $UnzipError\n"; $status = $z->read($buffer) @@ -1445,7 +1445,7 @@ uncompressed data to a buffer, C<$buffer>. use IO::Uncompress::Unzip qw(unzip $UnzipError) ; use IO::File ; - my $input = new IO::File "new( " \$buffer @@ -1457,7 +1457,7 @@ uncompressed data to a buffer, C<$buffer>. The format of the constructor for IO::Uncompress::Unzip is shown below - my $z = new IO::Uncompress::Unzip $input [OPTS] + my $z = IO::Uncompress::Unzip->new( $input [OPTS] ) or die "IO::Uncompress::Unzip failed: $UnzipError\n"; Returns an C object on success and undef on failure. @@ -1890,7 +1890,7 @@ stream at a time. use IO::Uncompress::Unzip qw($UnzipError); my $zipfile = "somefile.zip"; - my $u = new IO::Uncompress::Unzip $zipfile + my $u = IO::Uncompress::Unzip->new( $zipfile ) or die "Cannot open $zipfile: $UnzipError"; my $status; @@ -1965,8 +1965,7 @@ See the Changes file. =head1 COPYRIGHT AND LICENSE -Copyright (c) 2005-2020 Paul Marquess. All rights reserved. +Copyright (c) 2005-2021 Paul Marquess. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. - diff --git a/cpan/IO-Compress/private/MakeUtil.pm b/cpan/IO-Compress/private/MakeUtil.pm index 12fa26fd05f1..aa540c68fda3 100644 --- a/cpan/IO-Compress/private/MakeUtil.pm +++ b/cpan/IO-Compress/private/MakeUtil.pm @@ -42,14 +42,14 @@ sub MY::libscan return $path; } -sub MY::postamble +sub MY::postamble { return '' if $ENV{PERL_CORE} ; my @files = getPerlFiles('MANIFEST'); - # Note: Once you remove all the layers of shell/makefile escaping + # Note: Once you remove all the layers of shell/makefile escaping # the regular expression below reads # # /^\s*local\s*\(\s*\$^W\s*\)/ @@ -215,7 +215,7 @@ sub UpDowngrade foreach (@files) { #if (-l $_ ) { doUpDown($our_sub, $warn_sub, $_) } - #else + #else #{ doUpDownViaCopy($our_sub, $warn_sub, $_) } } @@ -234,7 +234,7 @@ sub doUpDown local ($^I) = ($^O eq 'VMS') ? "_bak" : ".bak"; local (@ARGV) = shift; - + while (<>) { print, last if /^__(END|DATA)__/ ; @@ -277,7 +277,7 @@ sub doUpDownViaCopy push @keep, $_; last ; } - + &{ $our_sub }() if $our_sub ; &{ $warn_sub }() if $warn_sub ; push @keep, $_; @@ -334,7 +334,7 @@ sub FindBrokenDependencies Compress::Zlib ); - + my @broken = (); foreach my $module ( grep { ! $thisModule{$_} } @modules) @@ -342,12 +342,12 @@ sub FindBrokenDependencies my $hasVersion = getInstalledVersion($module); # No need to upgrade if the module isn't installed at all - next + next if ! defined $hasVersion; # If already have C::Z version 1, then an upgrade to any of the # IO::Compress modules will not break it. - next + next if $module eq 'Compress::Zlib' && $hasVersion < 2; if ($hasVersion < $version) @@ -370,14 +370,12 @@ sub getInstalledVersion { no strict 'refs'; $version = ${ $module . "::VERSION" }; - $version = 0 + $version = 0 } - + return $version; } package MakeUtil ; 1; - - diff --git a/cpan/IO-Compress/t/000prereq.t b/cpan/IO-Compress/t/000prereq.t index 205e032573d9..f657083ad4f8 100644 --- a/cpan/IO-Compress/t/000prereq.t +++ b/cpan/IO-Compress/t/000prereq.t @@ -25,7 +25,7 @@ BEGIN if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; - my $VERSION = '2.096'; + my $VERSION = '2.100'; my @NAMES = qw( Compress::Raw::Bzip2 Compress::Raw::Zlib @@ -60,7 +60,7 @@ BEGIN ); - my @OPT = qw( + my @OPT = qw( ); plan tests => 1 + 2 + @NAMES + @OPT + $extra ; @@ -76,21 +76,21 @@ BEGIN eval " require $name " ; if ($@) { - ok 1, "$name not available" + ok 1, "$name not available" } - else + else { my $ver = eval("\$${name}::VERSION"); - is $ver, $VERSION, "$name version should be $VERSION" + is $ver, $VERSION, "$name version should be $VERSION" or diag "$name version is $ver, need $VERSION" ; - } + } } # need zlib 1.2.0 or better - + cmp_ok Compress::Raw::Zlib::ZLIB_VERNUM(), ">=", 0x1200 - or diag "IO::Compress needs zlib 1.2.0 or better, you have " . Compress::Raw::Zlib::zlib_version(); - + or diag "IO::Compress needs zlib 1.2.0 or better, you have " . Compress::Raw::Zlib::zlib_version(); + use_ok('Scalar::Util') ; } @@ -99,4 +99,3 @@ ok gotScalarUtilXS(), "Got XS Version of Scalar::Util" or diag <can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -66,7 +66,7 @@ sub myBZreadFile title "BlockSize100K => $stringValue"; my $err = "Parameter 'BlockSize100K' must be an unsigned int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, BlockSize100K => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -80,7 +80,7 @@ sub myBZreadFile title "BlockSize100K => $stringValue"; my $err = "Parameter 'BlockSize100K' not between 1 and 9, got $stringValue"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, BlockSize100K => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, BlockSize100K => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -94,7 +94,7 @@ sub myBZreadFile title "WorkFactor => $stringValue"; my $err = "Parameter 'WorkFactor' must be an unsigned int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, WorkFactor => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -108,7 +108,7 @@ sub myBZreadFile title "WorkFactor => $stringValue"; my $err = "Parameter 'WorkFactor' not between 0 and 250, got $stringValue"; my $bz ; - eval { $bz = new IO::Compress::Bzip2(\$buffer, WorkFactor => $value) }; + eval { $bz = IO::Compress::Bzip2->new(\$buffer, WorkFactor => $value) }; like $@, mkErr("IO::Compress::Bzip2: $err"), " value $stringValue is bad"; is $Bzip2Error, "IO::Compress::Bzip2: $err", @@ -130,7 +130,7 @@ sub myBZreadFile title "Small => $stringValue"; my $err = "Parameter 'Small' must be an int, got '$stringValue'"; my $bz ; - eval { $bz = new IO::Uncompress::Bunzip2(\$buffer, Small => $value) }; + eval { $bz = IO::Uncompress::Bunzip2->new(\$buffer, Small => $value) }; like $@, mkErr("IO::Uncompress::Bunzip2: $err"), " value $stringValue is bad"; is $Bunzip2Error, "IO::Uncompress::Bunzip2: $err", @@ -151,9 +151,9 @@ EOM for my $value ( 1 .. 9 ) { title "$CompressClass - BlockSize100K => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name, BlockSize100K => $value) + $bz = IO::Compress::Bzip2->new($name, BlockSize100K => $value) or diag $IO::Compress::Bzip2::Bzip2Error ; ok $bz, " bz object ok"; $bz->write($hello); @@ -165,9 +165,9 @@ EOM for my $value ( 0 .. 250 ) { title "$CompressClass - WorkFactor => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name, WorkFactor => $value); + $bz = IO::Compress::Bzip2->new($name, WorkFactor => $value); ok $bz, " bz object ok"; $bz->write($hello); $bz->close($hello); @@ -178,16 +178,16 @@ EOM for my $value ( 0 .. 1 ) { title "$UncompressClass - Small => $value"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $bz ; - $bz = new IO::Compress::Bzip2($name); + $bz = IO::Compress::Bzip2->new($name); ok $bz, " bz object ok"; $bz->write($hello); $bz->close($hello); - my $fil = new $UncompressClass $name, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $name, Append => 1, - Small => $value ; + Small => $value ); my $data = ''; 1 while $fil->read($data) > 0; @@ -200,7 +200,3 @@ EOM 1; - - - - diff --git a/cpan/IO-Compress/t/002any-transparent.t b/cpan/IO-Compress/t/002any-transparent.t index bb26bbcac0af..bb323928ec75 100644 --- a/cpan/IO-Compress/t/002any-transparent.t +++ b/cpan/IO-Compress/t/002any-transparent.t @@ -6,7 +6,7 @@ BEGIN { } use lib qw(t t/compress); - + use strict; use warnings; use bytes; @@ -38,7 +38,7 @@ EOM { title "AnyInflate with Non-compressed data (File $file)" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -52,12 +52,12 @@ EOM my $unc ; my $keep = $buffer ; - $unc = new IO::Uncompress::AnyInflate $input, -Transparent => 0 ; + $unc = IO::Uncompress::AnyInflate->new( $input, -Transparent => 0 ); ok ! $unc," no AnyInflate object when -Transparent => 0" ; is $buffer, $keep ; $buffer = $keep ; - $unc = new IO::Uncompress::AnyInflate \$buffer, -Transparent => 1 ; + $unc = IO::Uncompress::AnyInflate->new( \$buffer, -Transparent => 1 ); ok $unc, " AnyInflate object when -Transparent => 1" ; my $uncomp ; diff --git a/cpan/IO-Compress/t/004gziphdr.t b/cpan/IO-Compress/t/004gziphdr.t index 27a901354657..0ed4099ebe72 100644 --- a/cpan/IO-Compress/t/004gziphdr.t +++ b/cpan/IO-Compress/t/004gziphdr.t @@ -37,7 +37,7 @@ BEGIN { my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code; -my $lex = new LexFile my $name ; +my $lex = LexFile->new( my $name ); { title "Check Defaults"; @@ -63,12 +63,12 @@ my $lex = new LexFile my $name ; title "Check name can be different from filename" ; # Check Name can be different from filename # Comment and Extra can be set - # Can specify a zero Time + # Can specify a zero Time my $comment = "This is a Comment" ; my $extra = "A little something extra" ; my $aname = "a new name" ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -Strict => 0, -Name => $aname, -Comment => $comment, @@ -92,7 +92,7 @@ my $lex = new LexFile my $name ; # Check Time defaults to now # and that can have empty name, comment and extrafield my $before = time ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -TextFlag => 1, -Name => "", -Comment => "", @@ -121,7 +121,7 @@ my $lex = new LexFile my $name ; title "can have null extrafield" ; my $before = time ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -strict => 0, -Name => "a", -Comment => "b", @@ -144,7 +144,7 @@ my $lex = new LexFile my $name ; { title "can have undef name, comment, time and extrafield" ; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, -Name => undef, -Comment => undef, -ExtraField => undef, @@ -167,9 +167,9 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") my $v = pack "h*", $value; my $comment = "my${v}comment$v"; - my $hdr = readHeaderInfo $name, + my $hdr = readHeaderInfo $name, Time => 0, - -TextFlag => 1, + -TextFlag => 1, -Name => "", -Comment => $comment, -ExtraField => ""; @@ -249,14 +249,14 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") for my $code ( -1, undef, '', 'fred' ) { my $code_name = defined $code ? "'$code'" : "'undef'"; - eval { new IO::Compress::Gzip $name, -OS_Code => $code } ; + eval { IO::Compress::Gzip->new( $name, -OS_Code => $code ) } ; like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"), " Trap OS Code $code_name"; } for my $code ( qw( 256 ) ) { - eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) }; + eval { ok ! IO::Compress::Gzip->new($name, OS_Code => $code) }; like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"), " Trap OS Code $code"; like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/", @@ -285,34 +285,34 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [1, ['Xx' => '','AB' => 'Fred'] => [['Xx' => ''],['AB'=>'Fred']] ], [1, ['Xx' => '','Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred']] ], [1, ['Xx' => '', - 'Xx' => 'Fred', + 'Xx' => 'Fred', 'Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred'], ['Xx'=>'Fred']] ], [1, [ ['Xx' => 'a'], ['AB' => 'Fred'] ] => [['Xx' => 'a'],['AB'=>'Fred']] ], - [0, {'AB' => 'Fred', - 'Pq' => 'r', + [0, {'AB' => 'Fred', + 'Pq' => 'r', "\x01\x02" => "\x03"} => [['AB'=>'Fred'], - ['Pq'=>'r'], + ['Pq'=>'r'], ["\x01\x02"=>"\x03"]] ], - [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => + [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] => [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ], ); foreach my $test (@tests) { my ($order, $input, $result) = @$test ; - ok my $x = new IO::Compress::Gzip $name, + ok my $x = IO::Compress::Gzip->new( $name, -ExtraField => $input, - -HeaderCRC => 1 + -HeaderCRC => 1 ) or diag "GzipError is $GzipError" ; ; my $string = "abcd" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok $x = new IO::Uncompress::Gunzip $name, + ok $x = IO::Uncompress::Gunzip->new( $name, #-Strict => 1, - -ParseExtra => 1 + -ParseExtra => 1 ) or diag "GunzipError is $GunzipError" ; ; my $hdr = $x->getHeaderInfo(); ok $hdr; @@ -331,7 +331,7 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") eq_array $extra, $result; } else { eq_set $extra, $result; - } + } } } @@ -351,7 +351,7 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"], [ [ ["aa"] ] => "SubField must have two parts"], [ [ ["aa", "b", "c"] ] => "SubField must have two parts"], - [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] + [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ] => "SubField Data too long"], [ { 'abc', 1 } => "SubField ID not two chars long"], @@ -359,15 +359,15 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") [ { "ab", \1 } => "SubField Data is a reference"], ); - + foreach my $test (@tests) { my ($input, $string) = @$test ; my $buffer ; my $x ; - eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField => $input; }; - like $@, mkErr("$prefix$string"); - like $GzipError, "/$prefix$string/"; + eval { $x = IO::Compress::Gzip->new( \$buffer, -ExtraField => $input ); }; + like $@, mkErr("$prefix$string"); + like $GzipError, "/$prefix$string/"; ok ! $x ; } @@ -378,19 +378,19 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") # Corrupt ExtraField my @tests = ( - ["Sub-field truncated", + ["Sub-field truncated", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ['a', undef, undef] ], - ["Length of field incorrect", + ["Length of field incorrect", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ["ab", 255, "abc"] ], - ["Length of 2nd field incorrect", + ["Length of 2nd field incorrect", "Error with ExtraField Parameter: Truncated in FEXTRA Body Section", "Header Error: Truncated in FEXTRA Body Section", ["ab", 3, "abc"], ["de", 7, "x"] ], - ["Length of 2nd field incorrect", + ["Length of 2nd field incorrect", "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00", "Header Error: SubField ID 2nd byte is 0x00", ["a\x00", 3, "abc"], ["de", 7, "x"] ], @@ -418,31 +418,31 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") my $buffer ; my $x ; - eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField => $input, Strict => 1; }; - like $@, mkErr("$gzip_error"), " $name"; - like $GzipError, "/$gzip_error/", " $name"; + eval {$x = IO::Compress::Gzip->new( \$buffer, -ExtraField => $input, Strict => 1 ); }; + like $@, mkErr("$gzip_error"), " $name"; + like $GzipError, "/$gzip_error/", " $name"; ok ! $x, " IO::Compress::Gzip fails"; - like $GzipError, "/$gzip_error/", " $name"; + like $GzipError, "/$gzip_error/", " $name"; - foreach my $check (0, 1) + foreach my $check (0, 1) { - ok $x = new IO::Compress::Gzip \$buffer, - ExtraField => $input, - Strict => 0 + ok $x = IO::Compress::Gzip->new( \$buffer, + ExtraField => $input, + Strict => 0 ) or diag "GzipError is $GzipError" ; my $string = "abcd" ; $x->write($string) ; $x->close ; is anyUncompress(\$buffer), $string ; - $x = new IO::Uncompress::Gunzip \$buffer, + $x = IO::Uncompress::Gunzip->new( \$buffer, Strict => 0, Transparent => 0, - ParseExtra => $check; + ParseExtra => $check ); if ($check) { ok ! $x ; - like $GunzipError, "/^$gunzip_error/"; + like $GunzipError, "/^$gunzip_error/"; } else { ok $x ; @@ -456,13 +456,13 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") { title 'Check Minimal'; - ok my $x = new IO::Compress::Gzip $name, -Minimal => 1; + ok my $x = IO::Compress::Gzip->new( $name, -Minimal => 1 ); my $string = "abcd" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok $x = new IO::Uncompress::Gunzip $name ; + ok $x = IO::Uncompress::Gunzip->new( $name ); my $hdr = $x->getHeaderInfo(); ok $hdr; ok $hdr->{Time} == 0; @@ -482,11 +482,11 @@ for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D") title "Check Minimal + no compressed data"; # This is the smallest possible gzip file (20 bytes) - ok my $x = new IO::Compress::Gzip $name, -Minimal => 1; + ok my $x = IO::Compress::Gzip->new( $name, -Minimal => 1 ); isa_ok $x, "IO::Compress::Gzip"; ok $x->close, "closed" ; - ok $x = new IO::Uncompress::Gunzip $name, -Append => 0 ; + ok $x = IO::Uncompress::Gunzip->new( $name, -Append => 0 ); isa_ok $x, "IO::Uncompress::Gunzip"; my $data ; my $status = 1; @@ -528,7 +528,7 @@ some text EOM my $good = ''; - ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -537,7 +537,7 @@ EOM my $buffer = $good ; substr($buffer, 0, 1) = 'x' ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); ok $GunzipError =~ /Header Error: Bad Magic/; } @@ -546,7 +546,7 @@ EOM my $buffer = $good ; substr($buffer, 1, 1) = "\xFF" ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); ok $GunzipError =~ /Header Error: Bad Magic/; #print "$GunzipError\n"; } @@ -556,7 +556,7 @@ EOM my $buffer = $good ; substr($buffer, 2, 1) = 'x' ; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/'; } @@ -565,7 +565,7 @@ EOM my $buffer = $good ; substr($buffer, 3, 1) = "\xff"; - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0 ); like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./'; } @@ -574,7 +574,7 @@ EOM my $buffer = $good ; substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF); - ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1 + ok ! IO::Uncompress::Gunzip->new( \$buffer, -Transparent => 0, Strict => 1 ) or print "# $GunzipError\n"; like $GunzipError, '/Header Error: CRC16 mismatch/' #or diag "buffer length " . length($buffer); @@ -587,10 +587,10 @@ EOM my $x ; my $store = "x" x GZIP_FEXTRA_MAX_SIZE ; { - my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ; + my $z = IO::Compress::Gzip->new(\$x, ExtraField => $store, Strict => 0) ; ok $z, "Created IO::Compress::Gzip object" ; } - my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0; + my $gunz = IO::Uncompress::Gunzip->new( \$x, Strict => 0 ); ok $gunz, "Created IO::Uncompress::Gunzip object" ; my $hdr = $gunz->getHeaderInfo(); ok $hdr; @@ -601,7 +601,7 @@ EOM { title "Header Corruption - ExtraField too big"; my $x; - eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;}; + eval { IO::Compress::Gzip->new(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;}; like $@, mkErr('Error with ExtraField Parameter: Too Large'); like $GzipError, '/Error with ExtraField Parameter: Too Large/'; } @@ -610,24 +610,24 @@ EOM title "Header Corruption - Create Name with Illegal Chars"; my $x; - eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "fred\x02" ) }; like $@, mkErr('Non ISO 8859-1 Character found in Name'); like $GzipError, '/Non ISO 8859-1 Character found in Name/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Name => "fred\x02" ; - ok $gz->close(); + -Name => "fred\x02" ); + ok $gz->close(); - ok ! new IO::Uncompress::Gunzip \$x, + ok ! IO::Uncompress::Gunzip->new( \$x, -Transparent => 0, - -Strict => 1; + -Strict => 1 ); - like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/'; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/'; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Name}, "fred\x02"; @@ -636,47 +636,47 @@ EOM { title "Header Corruption - Null Chars in Name"; my $x; - eval { new IO::Compress::Gzip \$x, -Name => "\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "\x00" ) }; like $@, mkErr('Null Character found in Name'); like $GzipError, '/Null Character found in Name/'; - eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Name => "abc\x00" ) }; like $@, mkErr('Null Character found in Name'); like $GzipError, '/Null Character found in Name/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Name => "abc\x00de" ; - ok $gz->close() ; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + -Name => "abc\x00de" ); + ok $gz->close() ; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Name}, "abc"; - + } { title "Header Corruption - Create Comment with Illegal Chars"; my $x; - eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" }; + eval { IO::Compress::Gzip->new( \$x, -Comment => "fred\x02" ) }; like $@, mkErr('Non ISO 8859-1 Character found in Comment'); like $GzipError, '/Non ISO 8859-1 Character found in Comment/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Comment => "fred\x02" ; - ok $gz->close(); + -Comment => "fred\x02" ); + ok $gz->close(); - ok ! new IO::Uncompress::Gunzip \$x, Strict => 1, - -Transparent => 0; + ok ! IO::Uncompress::Gunzip->new( \$x, Strict => 1, + -Transparent => 0 ); like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/'; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Comment}, "fred\x02"; @@ -685,25 +685,25 @@ EOM { title "Header Corruption - Null Char in Comment"; my $x; - eval { new IO::Compress::Gzip \$x, -Comment => "\x00" }; + eval { IO::Compress::Gzip->new( \$x, -Comment => "\x00" ) }; like $@, mkErr('Null Character found in Comment'); like $GzipError, '/Null Character found in Comment/'; - eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ; + eval { IO::Compress::Gzip->new( \$x, -Comment => "abc\x00" ) } ; like $@, mkErr('Null Character found in Comment'); like $GzipError, '/Null Character found in Comment/'; - ok my $gz = new IO::Compress::Gzip \$x, + ok my $gz = IO::Compress::Gzip->new( \$x, -Strict => 0, - -Comment => "abc\x00de" ; - ok $gz->close() ; - ok my $gunzip = new IO::Uncompress::Gunzip \$x, - -Strict => 0; + -Comment => "abc\x00de" ); + ok $gz->close() ; + ok my $gunzip = IO::Uncompress::Gunzip->new( \$x, + -Strict => 0 ); - my $hdr = $gunzip->getHeaderInfo() ; + my $hdr = $gunzip->getHeaderInfo() ; is $hdr->{Comment}, "abc"; - + } @@ -715,18 +715,18 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0, - -ExtraField => "hello" x 10 ; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1, Strict => 0, + -ExtraField => "hello" x 10 ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - #my $lex = new LexFile my $name ; + #my $lex = LexFile->new( my $name ); #writeFile($name, $truncated) ; - #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like($GunzipError, '/^Header Error: Truncated in FEXTRA/'); @@ -744,14 +744,14 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Name => $Name ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FNAME Section/'; @@ -767,17 +767,17 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Comment => $Comment ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - #my $lex = new LexFile my $name ; + #my $lex = LexFile->new( my $name ); #writeFile($name, $truncated) ; - #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + #my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + my $g = IO::Uncompress::Gunzip->new( \$truncated, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/'; @@ -792,17 +792,16 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; substr($truncated, $index) = '' ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $truncated) ; - my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0; - #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0; - ok ! $g + my $g = IO::Uncompress::Gunzip->new( $name, -Transparent => 0 ); + ok ! $g or print "# $g\n" ; like $GunzipError, '/^Header Error: Truncated in FHCRC Section/'; @@ -820,19 +819,19 @@ EOM my $good ; { - ok my $x = new IO::Compress::Gzip \$good ; + ok my $x = IO::Compress::Gzip->new( \$good ); ok $x->write($string) ; ok $x->close ; } writeFile($name, $good) ; - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => 1; + -Strict => 1 ); my $uncomp ; 1 while $gunz->read($uncomp) > 0 ; ok $gunz->close() ; - ok $uncomp eq $string + ok $uncomp eq $string or print "# got [$uncomp] wanted [$string]\n";; foreach my $trim (-8 .. -1) @@ -848,7 +847,7 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, Append => 1, -Strict => $strict ; + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Append => 1, -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -860,7 +859,7 @@ EOM else { is $status, 0, "status 0"; - ok ! $GunzipError, "no error" + ok ! $GunzipError, "no error" or diag "$GunzipError"; my $expected = substr($buffer, - $got); is $gunz->trailingData(), $expected_trailing, "trailing data"; @@ -881,9 +880,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -916,9 +915,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -951,9 +950,9 @@ EOM foreach my $strict (0, 1) { - ok my $gunz = new IO::Uncompress::Gunzip $name, + ok my $gunz = IO::Uncompress::Gunzip->new( $name, -Append => 1, - -Strict => $strict ; + -Strict => $strict ); my $uncomp ; my $status = 1; $status = $gunz->read($uncomp) while $status > 0; @@ -980,11 +979,11 @@ EOM 'SubField ID not two chars long' ; my $buffer ; my $x ; - eval { $x = new IO::Compress::Gzip \$buffer, - -ExtraField => [ at => 'mouse', bad => 'dog'] ; + eval { $x = IO::Compress::Gzip->new( \$buffer, + -ExtraField => [ at => 'mouse', bad => 'dog'] ); }; - like $@, mkErr("$error"); - like $GzipError, "/$error/"; + like $@, mkErr("$error"); + like $GzipError, "/$error/"; ok ! $x ; } } diff --git a/cpan/IO-Compress/t/005defhdr.t b/cpan/IO-Compress/t/005defhdr.t index 28059ce2d11b..8d4d16310fcb 100644 --- a/cpan/IO-Compress/t/005defhdr.t +++ b/cpan/IO-Compress/t/005defhdr.t @@ -37,12 +37,12 @@ sub ReadHeaderInfo my %opts = @_ ; my $buffer ; - ok my $def = new IO::Compress::Deflate \$buffer, %opts ; + ok my $def = IO::Compress::Deflate->new( \$buffer, %opts ); is $def->write($string), length($string), "write" ; ok $def->close, "closed" ; #print "ReadHeaderInfo\n"; hexDump(\$buffer); - ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1 ; + ok my $inf = IO::Uncompress::Inflate->new( \$buffer, Append => 1 ); my $uncomp = ""; #ok $inf->read($uncomp) ; my $actual = 0 ; @@ -67,12 +67,12 @@ sub ReadHeaderInfoZlib my %opts = @_ ; my $buffer ; - ok my $def = new Compress::Raw::Zlib::Deflate AppendOutput => 1, %opts ; + ok my $def = Compress::Raw::Zlib::Deflate->new( AppendOutput => 1, %opts ); cmp_ok $def->deflate($string, $buffer), '==', Z_OK; cmp_ok $def->flush($buffer), '==', Z_OK; #print "ReadHeaderInfoZlib\n"; hexDump(\$buffer); - - ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1 ; + + ok my $inf = IO::Uncompress::Inflate->new( \$buffer, Append => 1 ); my $uncomp ; #ok $inf->read($uncomp) ; my $actual = 0 ; @@ -94,7 +94,7 @@ sub ReadHeaderInfoZlib sub printHeaderInfo { my $buffer = shift ; - my $inf = new IO::Uncompress::Inflate \$buffer ; + my $inf = IO::Uncompress::Inflate->new( \$buffer ); my $hdr = $inf->getHeaderInfo(); no warnings 'uninitialized' ; @@ -107,7 +107,7 @@ sub printHeaderInfo # Check the Deflate Header Parameters #======================================== -#my $lex = new LexFile my $name ; +#my $lex = LexFile->new( my $name ); { title "Check default header settings" ; @@ -210,7 +210,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Deflate \$good ; + ok my $x = IO::Compress::Deflate->new( \$good ); ok $x->write($string) ; ok $x->close ; @@ -219,7 +219,7 @@ EOM my $buffer = $good ; substr($buffer, 0, 1) = "\x00" ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/', "CRC mismatch"; } @@ -229,7 +229,7 @@ EOM my $buffer = $good ; substr($buffer, 1, 1) = "\x00" ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/', "CRC mismatch"; } @@ -260,8 +260,8 @@ EOM substr($buffer, 0, 2) = $header; - my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; - ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ; + my $un = IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); + ok ! IO::Uncompress::Inflate->new( \$buffer, -Transparent => 0 ); like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate \(CM is 3\)/', " Not Deflate"; } @@ -277,7 +277,7 @@ EOM $string = $string x 1000; my $good ; - ok my $x = new IO::Compress::Deflate \$good ; + ok my $x = IO::Compress::Deflate->new( \$good ); ok $x->write($string) ; ok $x->close ; @@ -287,7 +287,7 @@ EOM foreach my $s (0, 1) { title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $buffer = $good ; my $expected_trailing = substr($good, -4, 4) ; substr($expected_trailing, $trim) = ''; @@ -295,7 +295,7 @@ EOM substr($buffer, $trim) = ''; writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => $s; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => $s ); my $uncomp ; if ($s) { @@ -322,10 +322,10 @@ EOM my $buffer = $good ; my $crc = unpack("N", substr($buffer, -4, 4)); substr($buffer, -4, 4) = pack('N', $crc+1); - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 1; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => 1 ); my $uncomp ; my $status ; 1 while ($status = $gunz->read($uncomp)) > 0; @@ -343,10 +343,10 @@ EOM my $buffer = $good ; my $crc = unpack("N", substr($buffer, -4, 4)); substr($buffer, -4, 4) = pack('N', $crc+1); - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $buffer) ; - ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 0; + ok my $gunz = IO::Uncompress::Inflate->new( $name, Append => 1, Strict => 0 ); my $uncomp ; my $status ; 1 while ($status = $gunz->read($uncomp)) > 0; diff --git a/cpan/IO-Compress/t/006zip.t b/cpan/IO-Compress/t/006zip.t index cfc53d79ab21..830009127a29 100644 --- a/cpan/IO-Compress/t/006zip.t +++ b/cpan/IO-Compress/t/006zip.t @@ -24,11 +24,11 @@ BEGIN { use_ok('IO::Compress::Zip', qw(:all)) ; use_ok('IO::Uncompress::Unzip', qw(unzip $UnzipError)) ; - eval { - require IO::Compress::Bzip2 ; - import IO::Compress::Bzip2 2.010 ; - require IO::Uncompress::Bunzip2 ; - import IO::Uncompress::Bunzip2 2.010 ; + eval { + require IO::Compress::Bzip2 ; + IO::Compress::Bzip2->import( 2.010 ); + require IO::Uncompress::Bunzip2 ; + IO::Uncompress::Bunzip2->import( 2.010 ); } ; } @@ -38,7 +38,7 @@ sub getContent { my $filename = shift; - my $u = new IO::Uncompress::Unzip $filename, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $filename, Append => 1, @_ ) or die "Cannot open $filename: $UnzipError"; isa_ok $u, "IO::Uncompress::Unzip"; @@ -59,7 +59,7 @@ sub getContent } die "Error processing $filename: $status $!\n" - if $status < 0 ; + if $status < 0 ; return @content; } @@ -69,7 +69,7 @@ sub getContent { title "Create a simple zip - All Deflate"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -77,16 +77,16 @@ sub getContent 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_DEFLATE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -102,7 +102,7 @@ SKIP: skip "IO::Compress::Bzip2 not available", 9 unless defined $IO::Compress::Bzip2::VERSION; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -110,16 +110,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_BZIP2, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_BZIP2, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_BZIP2); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -135,7 +135,7 @@ SKIP: skip "IO::Compress::Bzip2 not available", 9 unless $IO::Compress::Bzip2::VERSION; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -143,16 +143,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_BZIP2); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -164,7 +164,7 @@ SKIP: { title "Create a simple zip - All STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello', @@ -172,16 +172,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_STORE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -193,24 +193,24 @@ SKIP: { title "Create a simple zip - Deflate + STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = qw( - hello + hello and - goodbye + goodbye ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -222,7 +222,7 @@ SKIP: { title "Create a simple zip - Deflate + zero length STORE"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @content = ( 'hello ', @@ -230,16 +230,16 @@ SKIP: 'goodbye ', ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_DEFLATE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; $zip->newStream(Name=> "three", Method => ZIP_CM_DEFLATE); - is $zip->write($content[2]), length($content[2]), "write"; - ok $zip->close(), "closed"; + is $zip->write($content[2]), length($content[2]), "write"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -251,7 +251,7 @@ SKIP: { title "RT #72548"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $blockSize = 1024 * 16; @@ -260,16 +260,16 @@ SKIP: "x" x ($blockSize + 1) ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content[0]), length($content[0]), "write"; + is $zip->write($content[0]), length($content[0]), "write"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - is $zip->write($content[1]), length($content[1]), "write"; + is $zip->write($content[1]), length($content[1]), "write"; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; my @got = getContent($file1, BlockSize => $blockSize); @@ -280,15 +280,15 @@ SKIP: { title "Zip file with a single zero-length file"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); - my $zip = new IO::Compress::Zip $file1, - Name => "one", Method => ZIP_CM_STORE, Stream => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => "one", Method => ZIP_CM_STORE, Stream => 0 ); isa_ok $zip, "IO::Compress::Zip"; $zip->newStream(Name=> "two", Method => ZIP_CM_STORE); - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; my @got = getContent($file1); @@ -307,13 +307,13 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) my $content = "a single line\n"; my $zip ; - my $status = zip \$content => \$zip, - Method => $method, - Stream => 0, + my $status = zip \$content => \$zip, + Method => $method, + Stream => 0, Name => "123"; is $status, 1, " Created a zip file"; - my $u = new IO::Uncompress::Unzip \$zip; + my $u = IO::Uncompress::Unzip->new( \$zip ); isa_ok $u, "IO::Uncompress::Unzip"; is $u->getline, $content, " Read first line ok"; @@ -324,39 +324,39 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) { title "isMethodAvailable" ; - + ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available"; ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_DEFLATE), "ZIP_CM_DEFLATE available"; #ok IO::Compress::Zip::isMethodAvailable(ZIP_CM_STORE), "ZIP_CM_STORE available"; - - ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available"; + + ok ! IO::Compress::Zip::isMethodAvailable(999), "999 not available"; } { title "Member & Comment 0"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = 'hello' ; - - my $zip = new IO::Compress::Zip $file1, - Name => "0", Comment => "0" ; + + my $zip = IO::Compress::Zip->new( $file1, + Name => "0", Comment => "0" ); isa_ok $zip, "IO::Compress::Zip"; - is $zip->write($content), length($content), "write"; + is $zip->write($content), length($content), "write"; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $file1, Append => 1, @_ ) or die "Cannot open $file1: $UnzipError"; isa_ok $u, "IO::Uncompress::Unzip"; my $name = $u->getHeaderInfo()->{Name}; - + is $u->getHeaderInfo()->{Name}, "0", "Name is '0'"; } @@ -365,12 +365,12 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) title "nexStream regression"; # https://github.com/pmqs/IO-Compress/issues/3 - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content1 = qq["organisation_path","collection_occasion_key","episode_key"\n] ; - - my $zip = new IO::Compress::Zip $file1, - Name => "one"; + + my $zip = IO::Compress::Zip->new( $file1, + Name => "one" ); isa_ok $zip, "IO::Compress::Zip"; print $zip $content1; @@ -384,16 +384,16 @@ for my $method (ZIP_CM_DEFLATE, ZIP_CM_STORE, ZIP_CM_BZIP2) EOM print $zip $content2; - ok $zip->close(), "closed"; + ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Append => 1, @_ + my $u = IO::Uncompress::Unzip->new( $file1, Append => 1, @_ ) or die "Cannot open $file1: $UnzipError"; isa_ok $u, "IO::Uncompress::Unzip"; my $name = $u->getHeaderInfo()->{Name}; - + is $u->getHeaderInfo()->{Name}, "one", "Name is 'one'"; ok $u->nextStream(), "nextStream OK"; diff --git a/cpan/IO-Compress/t/011-streamzip.t b/cpan/IO-Compress/t/011-streamzip.t index df3fbfb0fd84..181371a7c83e 100644 --- a/cpan/IO-Compress/t/011-streamzip.t +++ b/cpan/IO-Compress/t/011-streamzip.t @@ -15,11 +15,11 @@ use Test::More ; use CompTestUtils; use IO::Uncompress::Unzip 'unzip' ; -BEGIN -{ +BEGIN +{ plan(skip_all => "Needs Perl 5.005 or better - you have Perl $]" ) if $] < 5.005 ; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -35,7 +35,7 @@ $Inc = '"-MExtUtils::testlib"' my $Perl = ($ENV{'FULLPERL'} or $^X or 'perl') ; $Perl = qq["$Perl"] if $^O eq 'MSWin32' ; - + $Perl = "$Perl $Inc -w" ; #$Perl .= " -Mblib " ; my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" @@ -43,7 +43,7 @@ my $binDir = $ENV{PERL_CORE} ? "../ext/IO-Compress/bin/" my $hello1 = <new( my $stderr ); sub check @@ -62,7 +62,7 @@ sub check my $command = shift ; my $expected = shift ; - my $lex = new LexFile my $stderr ; + my $lex = LexFile->new( my $stderr ); my $cmd = "$command 2>$stderr"; my $stdout = `$cmd` ; @@ -93,7 +93,7 @@ sub check title "streamzip" ; my ($infile, $outfile); - my $lex = new LexFile $infile, $outfile ; + my $lex = LexFile->new( $infile, $outfile ); writeFile($infile, $hello1) ; check "$Perl ${binDir}/streamzip <$infile >$outfile"; @@ -107,7 +107,7 @@ sub check title "streamzip" ; my ($infile, $outfile); - my $lex = new LexFile $infile, $outfile ; + my $lex = LexFile->new( $infile, $outfile ); writeFile($infile, $hello1) ; check "$Perl ${binDir}/streamzip -zipfile=$outfile <$infile"; diff --git a/cpan/IO-Compress/t/01misc.t b/cpan/IO-Compress/t/01misc.t index 7e0d6fd45614..36373db6300a 100644 --- a/cpan/IO-Compress/t/01misc.t +++ b/cpan/IO-Compress/t/01misc.t @@ -10,7 +10,7 @@ use strict; use warnings; use bytes; -use Test::More ; +use Test::More ; use CompTestUtils; BEGIN { @@ -36,35 +36,35 @@ EOM sub My::testParseParameters() { eval { ParseParameters(1, {}, 1) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {}, undef) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {}, []) ; }; - like $@, mkErr(': Expected even number of parameters, got 1'), + like $@, mkErr(': Expected even number of parameters, got 1'), "Trap odd number of params"; eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; }; - like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), + like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), "wanted unsigned, got undef"; eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; }; - like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), + like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), "wanted unsigned, got undef"; eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; }; - like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), + like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), "wanted signed, got undef"; eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), + like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), "wanted signed, got 'abc'"; eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), + like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), "wanted code, got 'abc'"; @@ -76,25 +76,25 @@ sub My::testParseParameters() if $Config{useithreads}; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; }; - like $@, mkErr("Parameter 'fred' not writable"), + like $@, mkErr("Parameter 'fred' not writable"), "wanted writable, got readonly"; - skip '\\ returns mutable value in 5.19.3', 1 + skip '\\ returns mutable value in 5.19.3', 1 if $] >= 5.019003; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; }; - like $@, mkErr("Parameter 'fred' not writable"), + like $@, mkErr("Parameter 'fred' not writable"), "wanted writable, got readonly"; } my @xx; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; }; - like $@, mkErr("Parameter 'fred' not a scalar reference"), + like $@, mkErr("Parameter 'fred' not a scalar reference"), "wanted scalar reference"; local *ABC; eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; }; - like $@, mkErr("Parameter 'fred' not a scalar"), + like $@, mkErr("Parameter 'fred' not a scalar"), "wanted scalar"; eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; }; @@ -137,58 +137,58 @@ sub My::testParseParameters() { my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ; is $got1, $got, "Same object"; - + ok $got1->parsed('fred'), "parsed" ; $xx_ref = $got1->getValue('fred'); - + $$xx_ref = 777 ; is $xx, 777; } - for my $type (Parse_unsigned, Parse_signed, Parse_any) + for my $type (Parse_unsigned, Parse_signed, Parse_any) { my $value = 0; my $got1 ; eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ; - + ok ! $@; ok $got1->parsed('fred'), "parsed ok" ; is $got1->getValue('fred'), 0; - } + } { # setValue/getValue my $value = 0; my $got1 ; eval { $got1 = ParseParameters(1, {'fred' => [Parse_any, 1]}, fred => $value) } ; - + ok ! $@; ok $got1->parsed('fred'), "parsed ok" ; is $got1->getValue('fred'), 0; $got1->setValue('fred' => undef); - is $got1->getValue('fred'), undef; - } - + is $got1->getValue('fred'), undef; + } + { # twice my $value = 0; - + my $got = IO::Compress::Base::Parameters::new(); - + ok $got->parse({'fred' => [Parse_any, 1]}, fred => $value) ; ok $got->parsed('fred'), "parsed ok" ; is $got->getValue('fred'), 0; - - ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ; + + ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ; ok $got->parsed('fred'), "parsed ok" ; - is $got->getValue('fred'), undef; - - ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ; + is $got->getValue('fred'), undef; + + ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ; ok $got->parsed('fred'), "parsed ok" ; - is $got->getValue('fred'), 7; - } + is $got->getValue('fred'), 7; + } } @@ -208,7 +208,7 @@ My::testParseParameters(); { title "whatIsInput" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open FH, ">$out_file" ; is whatIsInput(*FH), 'handle', "Match filehandle" ; close FH ; @@ -227,7 +227,7 @@ My::testParseParameters(); { title "whatIsOutput" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open FH, ">$out_file" ; is whatIsOutput(*FH), 'handle', "Match filehandle" ; close FH ; @@ -248,34 +248,34 @@ My::testParseParameters(); { title "U64" ; - my $x = new U64(); + my $x = U64->new(); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0, " getLow is 0"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(1,2); + $x = U64->new(1,2); is $x->getHigh, 1, " getHigh is 1"; is $x->getLow, 2, " getLow is 2"; ok $x->is64bit(), " is64bit"; - $x = new U64(0xFFFFFFFF,2); + $x = U64->new(0xFFFFFFFF,2); is $x->getHigh, 0xFFFFFFFF, " getHigh is 0xFFFFFFFF"; is $x->getLow, 2, " getLow is 2"; ok $x->is64bit(), " is64bit"; - $x = new U64(7, 0xFFFFFFFF); + $x = U64->new(7, 0xFFFFFFFF); is $x->getHigh, 7, " getHigh is 7"; is $x->getLow, 0xFFFFFFFF, " getLow is 0xFFFFFFFF"; ok $x->is64bit(), " is64bit"; - $x = new U64(666); + $x = U64->new(666); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 666, " getLow is 666"; ok ! $x->is64bit(), " ! is64bit"; title "U64 - add" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; @@ -285,7 +285,7 @@ My::testParseParameters(); is $x->getLow, 2, " getLow is 2"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(0, 0xFFFFFFFE); + $x = U64->new(0, 0xFFFFFFFE); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0xFFFFFFFE, " getLow is 0xFFFFFFFE"; is $x->get32bit(), 0xFFFFFFFE, " get32bit is 0xFFFFFFFE"; @@ -320,8 +320,8 @@ My::testParseParameters(); is $x->get64bit(), 0xFFFFFFFF+3, " get64bit is 0x100000002"; ok $x->is64bit(), " is64bit"; - $x = new U64(1, 0xFFFFFFFE); - my $y = new U64(2, 3); + $x = U64->new(1, 0xFFFFFFFE); + my $y = U64->new(2, 3); $x->add($y); is $x->getHigh, 4, " getHigh is 4"; @@ -330,7 +330,7 @@ My::testParseParameters(); title "U64 - subtract" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; @@ -340,7 +340,7 @@ My::testParseParameters(); is $x->getLow, 0, " getLow is 0"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(1, 0); + $x = U64->new(1, 0); is $x->getHigh, 1, " getHigh is 1"; is $x->getLow, 0, " getLow is 0"; is $x->get32bit(), 0, " get32bit is 0xFFFFFFFE"; @@ -354,16 +354,16 @@ My::testParseParameters(); is $x->get64bit(), 0xFFFFFFFF, " get64bit is 0xFFFFFFFF"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(2, 2); - $y = new U64(1, 3); + $x = U64->new(2, 2); + $y = U64->new(1, 3); $x->subtract($y); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 0xFFFFFFFF, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; - $x = new U64(0x01CADCE2, 0x4E815983); - $y = new U64(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta + $x = U64->new(0x01CADCE2, 0x4E815983); + $y = U64->new(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta $x->subtract($y); is $x->getHigh, 0x2D2B03, " getHigh is 2D2B03"; @@ -372,17 +372,17 @@ My::testParseParameters(); title "U64 - equal" ; - $x = new U64(0, 1); + $x = U64->new(0, 1); is $x->getHigh, 0, " getHigh is 0"; is $x->getLow, 1, " getLow is 1"; ok ! $x->is64bit(), " ! is64bit"; - $y = new U64(0, 1); + $y = U64->new(0, 1); is $y->getHigh, 0, " getHigh is 0"; is $y->getLow, 1, " getLow is 1"; ok ! $y->is64bit(), " ! is64bit"; - my $z = new U64(0, 2); + my $z = U64->new(0, 2); is $z->getHigh, 0, " getHigh is 0"; is $z->getLow, 2, " getLow is 2"; ok ! $z->is64bit(), " ! is64bit"; @@ -391,14 +391,14 @@ My::testParseParameters(); ok !$x->equal($z), " ! equal"; title "U64 - clone" ; - $x = new U64(21, 77); + $x = U64->new(21, 77); $z = U64::clone($x); is $z->getHigh, 21, " getHigh is 21"; is $z->getLow, 77, " getLow is 77"; title "U64 - cmp.gt" ; - $x = new U64 1; - $y = new U64 0; + $x = U64->new( 1 ); + $y = U64->new( 0 ); cmp_ok $x->cmp($y), '>', 0, " cmp > 0"; is $x->gt($y), 1, " gt"; cmp_ok $y->cmp($x), '<', 0, " cmp < 0"; diff --git a/cpan/IO-Compress/t/020isize.t b/cpan/IO-Compress/t/020isize.t index 825e46fc1a61..b24bb98d04c6 100644 --- a/cpan/IO-Compress/t/020isize.t +++ b/cpan/IO-Compress/t/020isize.t @@ -13,8 +13,8 @@ use bytes; use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} ; @@ -33,7 +33,7 @@ BEGIN use_ok('IO::Compress::Gzip::Constants'); } -my $compressed ; +my $compressed ; my $expected_crc ; for my $wrap (0 .. 2) @@ -59,7 +59,7 @@ for my $wrap (0 .. 2) else { $expected_isize = $offset - 1; } - + sub gzipClosure { my $gzip = shift ; @@ -70,7 +70,7 @@ for my $wrap (0 .. 2) my $buff = 'x' x $inc ; my $left = $max ; - return + return sub { if ($max == 0 && $index == 0) { @@ -113,16 +113,16 @@ for my $wrap (0 .. 2) }; } - my $gzip = new IO::Compress::Gzip \$compressed, + my $gzip = IO::Compress::Gzip->new( \$compressed, -Append => 0, - -HeaderCRC => 1; + -HeaderCRC => 1 ); ok $gzip, " Created IO::Compress::Gzip object"; - my $gunzip = new IO::Uncompress::Gunzip gzipClosure($gzip, $size), + my $gunzip = IO::Uncompress::Gunzip->new( gzipClosure($gzip, $size), -BlockSize => 1024 * 500 , -Append => 0, - -Strict => 1; + -Strict => 1 ); ok $gunzip, " Created IO::Uncompress::Gunzip object"; @@ -147,12 +147,11 @@ for my $wrap (0 .. 2) my $gunzip_hdr = $gunzip->getHeaderInfo(); - is $gunzip_hdr->{ISIZE}, $expected_isize, + is $gunzip_hdr->{ISIZE}, $expected_isize, sprintf(" ISIZE is $expected_isize [0x%X]", $expected_isize); - is $gunzip_hdr->{CRC32}, $expected_crc, + is $gunzip_hdr->{CRC32}, $expected_crc, sprintf(" CRC32 is $expected_crc [0x%X]", $expected_crc); $expected_crc = 0 ; } } - diff --git a/cpan/IO-Compress/t/050interop-gzip.t b/cpan/IO-Compress/t/050interop-gzip.t index ae019c87acf2..77b9d76c50e9 100644 --- a/cpan/IO-Compress/t/050interop-gzip.t +++ b/cpan/IO-Compress/t/050interop-gzip.t @@ -19,7 +19,7 @@ my $GZIP ; sub ExternalGzipWorks { - my $lex = new LexFile my $outfile; + my $lex = LexFile->new( my $outfile ); my $content = qq { Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia @@ -28,7 +28,7 @@ Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id writeWithGzip($outfile, $content) or return 0; - + my $got ; readWithGzip($outfile, $got) or return 0; @@ -46,14 +46,14 @@ sub readWithGzip { my $file = shift ; - my $lex = new LexFile my $outfile; + my $lex = LexFile->new( my $outfile ); my $comp = "$GZIP -d -c" ; if ( system("$comp $file >$outfile") == 0 ) { $_[0] = readFile($outfile); - return 1 + return 1 } diag "'$comp' failed: \$?=$? \$!=$!"; @@ -71,13 +71,13 @@ sub writeWithGzip my $content = shift ; my $options = shift || ''; - my $lex = new LexFile my $infile; + my $lex = LexFile->new( my $infile ); writeFile($infile, $content); unlink $file ; my $comp = "$GZIP -c $options $infile >$file" ; - return 1 + return 1 if system($comp) == 0 ; diag "'$comp' failed: \$?=$? \$!=$!"; @@ -90,14 +90,14 @@ BEGIN { my $name = $^O =~ /mswin/i ? 'gzip.exe' : 'gzip'; my $split = $^O =~ /mswin/i ? ";" : ":"; - for my $dir (reverse split $split, $ENV{PATH}) + for my $dir (reverse split $split, $ENV{PATH}) { $GZIP = File::Spec->catfile($dir,$name) if -x File::Spec->catfile($dir,$name) } - # Handle spaces in path to gzip - $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; + # Handle spaces in path to gzip + $GZIP = "\"$GZIP\"" if defined $GZIP && $GZIP =~ /\s/; plan(skip_all => "Cannot find $name") if ! $GZIP ; @@ -105,7 +105,7 @@ BEGIN { plan(skip_all => "$name doesn't work as expected") if ! ExternalGzipWorks(); - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -124,7 +124,7 @@ BEGIN { my $file; my $file1; - my $lex = new LexFile $file, $file1; + my $lex = LexFile->new( $file, $file1 ); my $content = qq { Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id dolor. Camelus perlus. Larrius in lumen numen. Dolor en quiquum filia @@ -143,5 +143,3 @@ Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Ut tempus odio id ok readWithGzip($file1, $got), "readWithGzip ok"; is $got, $content, "got content"; } - - diff --git a/cpan/IO-Compress/t/101truncate-bzip2.t b/cpan/IO-Compress/t/101truncate-bzip2.t index d533f237a0df..e8e452560859 100644 --- a/cpan/IO-Compress/t/101truncate-bzip2.t +++ b/cpan/IO-Compress/t/101truncate-bzip2.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-deflate.t b/cpan/IO-Compress/t/101truncate-deflate.t index 49f9ae41ca54..1e8b58e35f4f 100644 --- a/cpan/IO-Compress/t/101truncate-deflate.t +++ b/cpan/IO-Compress/t/101truncate-deflate.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-gzip.t b/cpan/IO-Compress/t/101truncate-gzip.t index 16b2d0796389..df5d877e3f8d 100644 --- a/cpan/IO-Compress/t/101truncate-gzip.t +++ b/cpan/IO-Compress/t/101truncate-gzip.t @@ -16,7 +16,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/101truncate-rawdeflate.t b/cpan/IO-Compress/t/101truncate-rawdeflate.t index 177a3d5b37f3..371ed5c4b078 100644 --- a/cpan/IO-Compress/t/101truncate-rawdeflate.t +++ b/cpan/IO-Compress/t/101truncate-rawdeflate.t @@ -15,7 +15,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -55,22 +55,22 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') my $Error = getErrorRef($UncompressClass); my $compressed ; - ok( my $x = new IO::Compress::RawDeflate \$compressed); + ok( my $x = IO::Compress::RawDeflate->new( \$compressed ) ); ok $x->write($hello) ; ok $x->close ; - + my $cc = $compressed ; my $gz ; - ok($gz = new $UncompressClass(\$cc, + ok($gz = $UncompressClass->can('new')->( $UncompressClass, \$cc, -Transparent => 0)) or diag "$$Error\n"; my $un; is $gz->read($un, length($hello)), length($hello); ok $gz->close(); is $un, $hello ; - + for my $trans (0 .. 1) { title "Testing $CompressClass, Transparent = $trans"; @@ -82,19 +82,19 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') ok 1, "Header size is $header_size" ; ok 1, "Trailer size is $trailer_size" ; - + title "Compressed Data Truncation"; foreach my $i (0 .. $blocksize) { - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + ok 1, "Length $i" ; my $part = substr($compressed, 0, $i); writeFile($name, $part); - my $gz = new $UncompressClass $name, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); if ($trans) { ok $gz; ok ! $gz->error() ; @@ -111,15 +111,15 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') foreach my $i ($blocksize+1 .. length($compressed)-1) { - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + ok 1, "Length $i" ; my $part = substr($compressed, 0, $i); writeFile($name, $part); - ok my $gz = new $UncompressClass $name, + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); my $un ; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; @@ -129,6 +129,5 @@ foreach my $CompressClass ( 'IO::Compress::RawDeflate') $gz->close(); } } - -} +} diff --git a/cpan/IO-Compress/t/101truncate-zip.t b/cpan/IO-Compress/t/101truncate-zip.t index 80a0aee27514..94d4a8da9bfa 100644 --- a/cpan/IO-Compress/t/101truncate-zip.t +++ b/cpan/IO-Compress/t/101truncate-zip.t @@ -16,7 +16,7 @@ BEGIN { plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 diff --git a/cpan/IO-Compress/t/105oneshot-gzip-only.t b/cpan/IO-Compress/t/105oneshot-gzip-only.t index 0382df8e33b1..ff42b4f8840a 100644 --- a/cpan/IO-Compress/t/105oneshot-gzip-only.t +++ b/cpan/IO-Compress/t/105oneshot-gzip-only.t @@ -42,11 +42,11 @@ sub gzipGetHeader my $got ; ok IO::Compress::Gzip::gzip($in, \$out, %opts), " gzip ok" ; - ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" + ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), " gunzip ok" or diag $GunzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Gunzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Gunzip->new( \$out, Strict => 0 ) or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; ok $gunz, " Created IO::Uncompress::Gunzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -57,13 +57,13 @@ sub gzipGetHeader ok $gunz->close, " closed ok" ; return $hdr ; - + } { title "Check gzip header default NAME & MTIME settings" ; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; my $hdr ; @@ -73,7 +73,7 @@ sub gzipGetHeader $mtime = (stat($file1))[9]; # make sure that the gzip file isn't created in the same # second as the input file - sleep 3 ; + sleep 3 ; $hdr = gzipGetHeader($file1, $content); is $hdr->{Name}, $file1, " Name is '$file1'"; @@ -83,7 +83,7 @@ sub gzipGetHeader writeFile($file1, $content); $mtime = (stat($file1))[9]; - sleep 3 ; + sleep 3 ; $hdr = gzipGetHeader($file1, $content, Name => "abcde"); is $hdr->{Name}, "abcde", " Name is 'abcde'" ; @@ -106,9 +106,9 @@ sub gzipGetHeader is $hdr->{Time}, 4321, " Time is 4321"; title "Filehandle doesn't have default Name or Time" ; - my $fh = new IO::File "< $file1" + my $fh = IO::File->new( "< $file1" ) or diag "Cannot open '$file1': $!\n" ; - sleep 3 ; + sleep 3 ; my $before = time ; $hdr = gzipGetHeader($fh, $content); my $after = time ; @@ -131,4 +131,3 @@ sub gzipGetHeader } # TODO add more error cases - diff --git a/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t b/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t index ed3f8c74dcb3..abeefa775376 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-bzip2-only.t @@ -18,8 +18,8 @@ BEGIN { if $] < 5.005 ; plan(skip_all => "IO::Compress::Bzip2 not available" ) - unless eval { require IO::Compress::Bzip2; - require IO::Uncompress::Bunzip2; + unless eval { require IO::Compress::Bzip2; + require IO::Uncompress::Bunzip2; 1 } ; @@ -48,11 +48,11 @@ sub zipGetHeader my $got ; ok zip($in, \$out, %opts), " zip ok" ; - ok unzip(\$out, \$got), " unzip ok" + ok unzip(\$out, \$got), " unzip ok" or diag $UnzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Unzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 ) or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ; ok $gunz, " Created IO::Uncompress::Unzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -63,7 +63,7 @@ sub zipGetHeader ok $gunz->close, " closed ok" ; return $hdr ; - + } @@ -79,8 +79,8 @@ for my $input (0, 1) { title "Input $input, Stream $stream, Zip64 $zip64, Method $method"; - my $lex1 = new LexFile my $file1; - my $lex2 = new LexFile my $file2; + my $lex1 = LexFile->new( my $file1 ); + my $lex2 = LexFile->new( my $file2 ); my $content = "hello "; my $in ; @@ -95,9 +95,9 @@ for my $input (0, 1) } - ok zip($in => $file1 , Method => $method, + ok zip($in => $file1 , Method => $method, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; my $got ; @@ -106,7 +106,7 @@ for my $input (0, 1) is $got, $content, " content ok"; - my $u = new IO::Uncompress::Unzip $file1 + my $u = IO::Uncompress::Unzip->new( $file1 ) or diag $ZipError ; my $hdr = $u->getHeaderInfo(); @@ -133,7 +133,7 @@ for my $stream (0, 1) my $file1; my $file2; my $zipfile; - my $lex = new LexFile $file1, $file2, $zipfile; + my $lex = LexFile->new( $file1, $file2, $zipfile ); my $content1 = "hello "; writeFile($file1, $content1); @@ -145,9 +145,9 @@ for my $stream (0, 1) $file2 => $content2, ); - ok zip([$file1, $file2] => $zipfile , Method => $method, + ok zip([$file1, $file2] => $zipfile , Method => $method, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; for my $file ($file1, $file2) @@ -163,4 +163,3 @@ for my $stream (0, 1) } # TODO add more error cases - diff --git a/cpan/IO-Compress/t/105oneshot-zip-only.t b/cpan/IO-Compress/t/105oneshot-zip-only.t index b0d6a4334c4e..ea7b1b25b54f 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-only.t @@ -46,7 +46,7 @@ sub zipGetHeader or diag $UnzipError ; is $got, $content, " got expected content" ; - my $gunz = new IO::Uncompress::Unzip \$out, Strict => 0 + my $gunz = IO::Uncompress::Unzip->new( \$out, Strict => 0 ) or diag "UnzipError is $IO::Uncompress::Unzip::UnzipError" ; ok $gunz, " Created IO::Uncompress::Unzip object"; my $hdr = $gunz->getHeaderInfo(); @@ -63,7 +63,7 @@ sub zipGetHeader { title "Check zip header default NAME & MTIME settings" ; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; my $hdr ; @@ -108,7 +108,7 @@ sub zipGetHeader is $hdr->{Time} >> 1 , $useTime >> 1 , " Time is $useTime"; title "Filehandle doesn't have default Name or Time" ; - my $fh = new IO::File "< $file1" + my $fh = IO::File->new( "< $file1" ) or diag "Cannot open '$file1': $!\n" ; sleep 3 ; my $before = time ; @@ -135,7 +135,7 @@ sub zipGetHeader { title "Check CanonicalName & FilterName"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello" ; writeFile($file1, $content); @@ -222,7 +222,7 @@ for my $stream (0, 1) title "Stream $stream, Zip64 $zip64, Method $method"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my $content = "hello "; #writeFile($file1, $content); @@ -241,7 +241,7 @@ for my $stream (0, 1) is $got, $content, " content ok"; - my $u = new IO::Uncompress::Unzip $file1 + my $u = IO::Uncompress::Unzip->new( $file1 ) or diag $ZipError ; my $hdr = $u->getHeaderInfo(); @@ -266,7 +266,7 @@ for my $stream (0, 1) my $file1; my $file2; my $zipfile; - my $lex = new LexFile $file1, $file2, $zipfile; + my $lex = LexFile->new( $file1, $file2, $zipfile ); my $content1 = "hello "; writeFile($file1, $content1); diff --git a/cpan/IO-Compress/t/105oneshot-zip-store-only.t b/cpan/IO-Compress/t/105oneshot-zip-store-only.t index 641fb609a8c8..a7a1eb109a32 100644 --- a/cpan/IO-Compress/t/105oneshot-zip-store-only.t +++ b/cpan/IO-Compress/t/105oneshot-zip-store-only.t @@ -22,8 +22,8 @@ BEGIN { unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; plan(skip_all => "IO::Compress::Bzip2 not available" ) - unless eval { require IO::Compress::Bzip2; - require IO::Uncompress::Bunzip2; + unless eval { require IO::Compress::Bzip2; + require IO::Uncompress::Bunzip2; 1 } ; @@ -86,7 +86,7 @@ for $content (@contents) ok zip(\$content => \$zipped , Method => ZIP_CM_STORE, Zip64 => $zip64, - Stream => $stream), " zip ok" + Stream => $stream), " zip ok" or diag $ZipError ; my $got ; @@ -99,4 +99,3 @@ for $content (@contents) } } } - diff --git a/cpan/IO-Compress/t/107multi-zip-only.t b/cpan/IO-Compress/t/107multi-zip-only.t index 40c7fef5e2ac..0a8e1ae0cb6b 100644 --- a/cpan/IO-Compress/t/107multi-zip-only.t +++ b/cpan/IO-Compress/t/107multi-zip-only.t @@ -49,9 +49,9 @@ EOM my $name = "n1"; -my $lex = new LexFile my $zipfile ; +my $lex = LexFile->new( my $zipfile ); -my $x = new IO::Compress::Zip($zipfile, Name => $name++, AutoClose => 1); +my $x = IO::Compress::Zip->new($zipfile, Name => $name++, AutoClose => 1); isa_ok $x, 'IO::Compress::Zip', ' $x' ; @@ -67,10 +67,10 @@ push @buffers, undef; { open F, ">>$zipfile"; print F "trailing"; - close F; + close F; } -my $u = new IO::Uncompress::Unzip $zipfile, Transparent => 1, MultiStream => 0 +my $u = IO::Uncompress::Unzip->new( $zipfile, Transparent => 1, MultiStream => 0 ) or die "Cannot open $zipfile: $UnzipError"; my @names ; diff --git a/cpan/IO-Compress/t/108anyunc-transparent.t b/cpan/IO-Compress/t/108anyunc-transparent.t index 687b1f5cd251..8d79a4669eca 100644 --- a/cpan/IO-Compress/t/108anyunc-transparent.t +++ b/cpan/IO-Compress/t/108anyunc-transparent.t @@ -6,7 +6,7 @@ BEGIN { } use lib qw(t t/compress); - + use strict; use warnings; use bytes; @@ -38,7 +38,7 @@ EOM { title "AnyUncompress with Non-compressed data (File $file)" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -52,12 +52,12 @@ EOM my $unc ; my $keep = $buffer ; - $unc = new IO::Uncompress::AnyUncompress $input, -Transparent => 0 ; + $unc = IO::Uncompress::AnyUncompress->new( $input, -Transparent => 0 ); ok ! $unc," no AnyUncompress object when -Transparent => 0" ; is $buffer, $keep ; $buffer = $keep ; - $unc = new IO::Uncompress::AnyUncompress \$buffer, -Transparent => 1 ; + $unc = IO::Uncompress::AnyUncompress->new( \$buffer, -Transparent => 1 ); ok $unc, " AnyUncompress object when -Transparent => 1" ; my $uncomp ; diff --git a/cpan/IO-Compress/t/111const-deflate.t b/cpan/IO-Compress/t/111const-deflate.t index 82a441414979..bdb2eca0f70e 100644 --- a/cpan/IO-Compress/t/111const-deflate.t +++ b/cpan/IO-Compress/t/111const-deflate.t @@ -26,75 +26,74 @@ BEGIN { { use Compress::Raw::Zlib ; - + my %all; for my $symbol (@Compress::Raw::Zlib::DEFLATE_CONSTANTS) { eval "defined Compress::Raw::Zlib::$symbol" ; $all{$symbol} = ! $@ ; - } - + } + my $pkg = 1; - - for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) + + for my $module ( qw( Adapter::Deflate RawDeflate Deflate Gzip Zip )) { - ++ $pkg ; + ++ $pkg ; eval <new( my $file1 ); my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}', 'beta \N{GREEK SMALL LETTER BETA}', @@ -48,12 +48,12 @@ BEGIN { 'delta \N{GREEK SMALL LETTER DELTA}' ) ; - my @encoded = map { Encode::encode_utf8($_) } @names; + my @encoded = map { Encode::encode_utf8($_) } @names; my @n = @names; - my $zip = new IO::Compress::Zip $file1, - Name => $names[0], Efs => 1; + my $zip = IO::Compress::Zip->new( $file1, + Name => $names[0], Efs => 1 ); my $content = 'Hello, world!'; ok $zip->print($content), "print"; @@ -66,7 +66,7 @@ BEGIN { ok $zip->close(), "closed"; { - my $u = new IO::Uncompress::Unzip $file1, Efs => 1 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 1 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -88,7 +88,7 @@ BEGIN { } { - my $u = new IO::Uncompress::Unzip $file1, Efs => 0 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -107,14 +107,14 @@ BEGIN { or diag "Got " . Dumper(\@efs); is_deeply \@unzip_names, [@names], "Names round tripped" or diag "Got " . Dumper(\@unzip_names); - } + } } { title "Create a simple zip - language encoding flag not set"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); my @names = ( 'alpha \N{GREEK SMALL LETTER ALPHA}', 'beta \N{GREEK SMALL LETTER BETA}', @@ -124,8 +124,8 @@ BEGIN { my @n = @names; - my $zip = new IO::Compress::Zip $file1, - Name => $names[0], Efs => 0; + my $zip = IO::Compress::Zip->new( $file1, + Name => $names[0], Efs => 0 ); my $content = 'Hello, world!'; ok $zip->print($content), "print"; @@ -137,7 +137,7 @@ BEGIN { ok $zip->print($content), "print"; ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1, Efs => 0 + my $u = IO::Uncompress::Unzip->new( $file1, Efs => 0 ) or die "Cannot open $file1: $UnzipError"; my $status; @@ -161,19 +161,19 @@ BEGIN { { title "zip: EFS => 0 filename not valid utf8 - language encoding flag not set"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); # Invalid UTF8 my $name = "a\xFF\x{100}"; - - my $zip = new IO::Compress::Zip $file1, - Name => $name, Efs => 0 ; + + my $zip = IO::Compress::Zip->new( $file1, + Name => $name, Efs => 0 ); ok $zip->print("abcd"), "print"; ok $zip->close(), "closed"; - my $u = new IO::Uncompress::Unzip $file1 - or die "Cannot open $file1: $UnzipError"; + my $u = IO::Uncompress::Unzip->new( $file1 ) + or die "Cannot open $file1: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; } @@ -184,8 +184,8 @@ BEGIN { my $filename = "t/files/bad-efs.zip" ; my $name = "\xF0\xA4\xAD"; - my $u = new IO::Uncompress::Unzip $filename, efs => 0 - or die "Cannot open $filename: $UnzipError"; + my $u = IO::Uncompress::Unzip->new( $filename, efs => 0 ) + or die "Cannot open $filename: $UnzipError"; ok $u->getHeaderInfo()->{Name} eq $name, "got bad filename"; } @@ -195,8 +195,8 @@ BEGIN { my $filename = "t/files/bad-efs.zip" ; my $name = "\xF0\xA4\xAD"; - - eval { my $u = new IO::Uncompress::Unzip $filename, efs => 1 + + eval { my $u = IO::Uncompress::Unzip->new( $filename, efs => 1 ) or die "Cannot open $filename: $UnzipError" }; like $@, qr/Zip Filename not UTF-8/, @@ -207,14 +207,14 @@ BEGIN { { title "EFS => 1 - filename not valid utf8 - catch bad content writing to zip"; - my $lex = new LexFile my $file1; + my $lex = LexFile->new( my $file1 ); # Invalid UTF8 my $name = "a\xFF\x{100}"; - - eval { my $zip = new IO::Compress::Zip $file1, - Name => $name, Efs => 1 } ; - like $@, qr/Wide character in zip filename/, + eval { my $zip = IO::Compress::Zip->new( $file1, + Name => $name, Efs => 1 ) } ; + + like $@, qr/Wide character in zip filename/, " wide characters in zip filename"; } \ No newline at end of file diff --git a/cpan/IO-Compress/t/compress/CompTestUtils.pm b/cpan/IO-Compress/t/compress/CompTestUtils.pm index c506632f90e3..61658c9296b6 100644 --- a/cpan/IO-Compress/t/compress/CompTestUtils.pm +++ b/cpan/IO-Compress/t/compress/CompTestUtils.pm @@ -9,13 +9,13 @@ use bytes; #use lib qw(t t/compress); use Carp ; -#use Test::More ; +#use Test::More ; sub title { - #diag "" ; + #diag "" ; ok(1, $_[0]) ; #diag "" ; } @@ -26,7 +26,7 @@ sub like_eval } BEGIN { - eval { + eval { require File::Temp; } ; @@ -38,7 +38,7 @@ BEGIN { our ($index); $index = '00000'; - + sub new { my $self = shift ; @@ -72,7 +72,7 @@ BEGIN { $index = '00000'; our ($useTempFile); our ($useTempDir); - + sub new { my $self = shift ; @@ -115,11 +115,11 @@ BEGIN { # autogenerate the name if none supplied $_ = "tmpdir" . $$ . "X" . $index ++ . ".tmp" ; } - foreach (@_) - { + foreach (@_) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_; - mkdir $_, 0777 + if -d $_; + mkdir $_, 0777 } bless [ @_ ], $self ; } @@ -131,10 +131,10 @@ BEGIN { if (! $useTempFile) { my $self = shift ; - foreach (@$self) - { + foreach (@$self) + { rmtree $_, {verbose => 0, safe => 1} - if -d $_ ; + if -d $_ ; } } } @@ -150,15 +150,15 @@ sub readFile { my $pos = tell($f); seek($f, 0,0); - @strings = <$f> ; + @strings = <$f> ; seek($f, 0, $pos); } else { - open (F, "<$f") + open (F, "<$f") or croak "Cannot open $f: $!\n" ; binmode F; - @strings = ; + @strings = ; close F ; } @@ -175,7 +175,7 @@ sub writeFile { my($filename, @strings) = @_ ; 1 while unlink $filename ; - open (F, ">$filename") + open (F, ">$filename") or croak "Cannot open $filename: $!\n" ; binmode F; foreach (@strings) { @@ -191,10 +191,10 @@ sub GZreadFile my ($uncomp) = "" ; my $line = "" ; - my $fil = gzopen($filename, "rb") + my $fil = gzopen($filename, "rb") or croak "Cannopt open '$filename': $Compress::Zlib::gzerrno" ; - $uncomp .= $line + $uncomp .= $line while $fil->gzread($line) > 0; $fil->gzclose ; @@ -248,14 +248,14 @@ sub readHeaderInfo some text EOM - ok my $x = new IO::Compress::Gzip $name, %opts + ok my $x = IO::Compress::Gzip->new( $name, %opts ) or diag "GzipError is $IO::Compress::Gzip::GzipError" ; ok $x->write($string) ; ok $x->close ; #is GZreadFile($name), $string ; - ok my $gunz = new IO::Uncompress::Gunzip $name, Strict => 0 + ok my $gunz = IO::Uncompress::Gunzip->new( $name, Strict => 0 ) or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ; ok my $hdr = $gunz->getHeaderInfo(); my $uncomp ; @@ -562,12 +562,13 @@ sub anyUncompress } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - Append => 1, - Transparent => 0, + my $o = IO::Uncompress::AnyUncompress->new( \$data, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts + ) or croak "Cannot open buffer/file: $AnyUncompressError" ; 1 while $o->read($out) > 0 ; @@ -622,13 +623,14 @@ sub getHeaders } my $out = ''; - my $o = new IO::Uncompress::AnyUncompress \$data, - MultiStream => 1, - Append => 1, - Transparent => 0, + my $o = IO::Uncompress::AnyUncompress->new( \$data, + MultiStream => 1, + Append => 1, + Transparent => 0, RawInflate => 1, UnLzma => 1, @opts + ) or croak "Cannot open buffer/file: $AnyUncompressError" ; 1 while $o->read($out) > 0 ; @@ -667,7 +669,7 @@ sub mkComplete ); } - my $z = new $class( \$buffer, %params) + my $z = $class->can('new')->( $class, \$buffer, %params) or croak "Cannot create $class object: $$Error"; $z->write($data); $z->close(); @@ -675,7 +677,7 @@ sub mkComplete my $unc = getInverse($class); anyUncompress(\$buffer) eq $data or die "bad bad bad"; - my $u = new $unc( \$buffer); + my $u = $unc->can('new')->( $unc, \$buffer); my $info = $u->getHeaderInfo() ; diff --git a/cpan/IO-Compress/t/compress/any.pl b/cpan/IO-Compress/t/compress/any.pl index c0da133ebedd..0569b5af10f2 100644 --- a/cpan/IO-Compress/t/compress/any.pl +++ b/cpan/IO-Compress/t/compress/any.pl @@ -1,6 +1,6 @@ use lib 't'; - + use strict; use warnings; use bytes; @@ -41,12 +41,12 @@ sub run my $string = "some text" x 100 ; my $buffer ; - my $x = new $CompressClass(\$buffer) ; + my $x = $CompressClass->can('new')->($CompressClass, \$buffer) ; ok $x, " create $CompressClass object" ; ok $x->write($string), " write to object" ; ok $x->close, " close ok" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -58,16 +58,16 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, RawInflate => 1, @anyUnLz, - Append => 1 ; + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; @@ -78,16 +78,16 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, RawInflate => 1, @anyUnLz, - Append => 1 ; + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp, 100) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; diff --git a/cpan/IO-Compress/t/compress/anyunc.pl b/cpan/IO-Compress/t/compress/anyunc.pl index 2860e2571c70..8be9c7063e82 100644 --- a/cpan/IO-Compress/t/compress/anyunc.pl +++ b/cpan/IO-Compress/t/compress/anyunc.pl @@ -1,6 +1,6 @@ use lib 't'; - + use strict; use warnings; use bytes; @@ -37,12 +37,12 @@ sub run my $string = "some text" x 100 ; my $buffer ; - my $x = new $CompressClass(\$buffer) ; + my $x = $CompressClass->can('new')->( $CompressClass, \$buffer) ; ok $x, " create $CompressClass object" ; ok $x->write($string), " write to object" ; ok $x->close, " close ok" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); my $input ; if ($file) { @@ -54,14 +54,14 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans - Append => 1 ; + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans + Append => 1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp) > 0 ; - #ok $unc->read($uncomp) > 0 + #ok $unc->read($uncomp) > 0 # or print "# $$AnyError\n"; my $y; is $unc->read($y, 1), 0, " at eof" ; @@ -72,10 +72,10 @@ sub run } { - my $unc = new $AnyConstruct $input, Transparent => $trans, - Append =>1 ; + my $unc = $AnyConstruct->can('new')->( $AnyConstruct, $input, Transparent => $trans, + Append =>1 ); - ok $unc, " Created $AnyClass object" + ok $unc, " Created $AnyClass object" or print "# $$AnyError\n"; my $uncomp ; 1 while $unc->read($uncomp, 10) > 0 ; diff --git a/cpan/IO-Compress/t/compress/destroy.pl b/cpan/IO-Compress/t/compress/destroy.pl index 186520df1621..3882e2468d71 100644 --- a/cpan/IO-Compress/t/compress/destroy.pl +++ b/cpan/IO-Compress/t/compress/destroy.pl @@ -35,7 +35,7 @@ sub run { # Check that the class destructor will call close - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = < 1 ; + ok my $x = $CompressClass->can('new')->( $CompressClass, $name, -AutoClose => 1 ); ok $x->write($hello) ; } @@ -56,59 +56,59 @@ sub run # Tied filehandle destructor - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = < $name" ; + my $fh = IO::File->new( "> $name" ); { - ok my $x = new $CompressClass $fh, -AutoClose => 1 ; + ok my $x = $CompressClass->can('new')->( $CompressClass, $fh, -AutoClose => 1 ); $x->write($hello) ; } ok anyUncompress($name) eq $hello ; } - + { title "Testing DESTROY doesn't clobber \$! etc "; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $out; my $result; - + { - ok my $z = new $CompressClass($name); + ok my $z = $CompressClass->can('new')->( $CompressClass, $name ); $z->write("abc") ; $! = 22 ; cmp_ok $!, '==', 22, ' $! is 22'; } - + cmp_ok $!, '==', 22, " \$! has not been changed by $CompressClass destructor"; - + { my $uncomp; - ok my $x = new $UncompressClass($name, -Append => 1) ; - + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1) ; + my $len ; 1 while ($len = $x->read($result)) > 0 ; - + $! = 22 ; cmp_ok $!, '==', 22, ' $! is 22'; - } - + } + cmp_ok $!, '==', 22, " \$! has not been changed by $UncompressClass destructor"; - + is $result, "abc", " Got uncompressed content ok"; - + } } diff --git a/cpan/IO-Compress/t/compress/encode.pl b/cpan/IO-Compress/t/compress/encode.pl index 860d0e46ce1b..a6ab50ec70f7 100644 --- a/cpan/IO-Compress/t/compress/encode.pl +++ b/cpan/IO-Compress/t/compress/encode.pl @@ -6,8 +6,8 @@ use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan skip_all => "Encode is not available" if $] < 5.006 ; @@ -15,7 +15,7 @@ BEGIN plan skip_all => "Encode is not available" if $@ ; - + # use Test::NoWarnings, if available my $extra = 0 ; @@ -34,16 +34,16 @@ sub run my $UnError = getErrorRef($UncompressClass); - my $string = "\x{df}\x{100}\x80"; + my $string = "\x{df}\x{100}\x80"; my $encString = Encode::encode_utf8($string); my $buffer = $encString; #for my $from ( qw(filename filehandle buffer) ) { # my $input ; -# my $lex = new LexFile my $name ; +# my $lex = LexFile->new( my $name ); +# # -# # if ($from eq 'buffer') # { $input = \$buffer } # elsif ($from eq 'filename') @@ -53,14 +53,14 @@ sub run # } # elsif ($from eq 'filehandle') # { -# $input = new IO::File "<$name" ; +# $input = IO::File->new( "<$name" ); # } for my $to ( qw(filehandle buffer)) { title "OO Mode: To $to, Encode by hand"; - my $lex2 = new LexFile my $name2 ; + my $lex2 = LexFile->new( my $name2 ); my $output; my $buffer; @@ -72,29 +72,29 @@ sub run } elsif ($to eq 'filehandle') { - $output = new IO::File ">$name2" ; + $output = IO::File->new( ">$name2" ); } my $out ; - my $cs = new $CompressClass($output, AutoClose =>1); + my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1); $cs->print($encString); $cs->close(); my $input; if ($to eq 'buffer') { $input = \$buffer } - else + else { $input = $name2 ; } - my $ucs = new $UncompressClass($input, Append => 1); + my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1); my $got; 1 while $ucs->read($got) > 0 ; - + is $got, $encString, " Expected output"; - + my $decode = Encode::decode_utf8($got); @@ -108,36 +108,36 @@ sub run title "Catch wide characters"; my $out; - my $cs = new $CompressClass(\$out); + my $cs = $CompressClass->can('new')->( $CompressClass, \$out); my $a = "a\xFF\x{100}"; eval { $cs->syswrite($a) }; - like($@, qr/Wide character in ${CompressClass}::write/, + like($@, qr/Wide character in ${CompressClass}::write/, " wide characters in ${CompressClass}::write"); } - + { title "Unknown encoding"; my $output; - eval { my $cs = new $CompressClass(\$output, Encode => 'fred'); } ; - like($@, qr/${CompressClass}: Encoding 'fred' is not available/, + eval { my $cs = $CompressClass->can('new')->( $CompressClass, \$output, Encode => 'fred'); } ; + like($@, qr/${CompressClass}: Encoding 'fred' is not available/, " Encoding 'fred' is not available"); } - + { title "Encode option"; - + for my $to ( qw(filehandle filename buffer)) { title "Encode: To $to, Encode option"; - my $lex2 = new LexFile my $name2 ; + my $lex2 = LexFile->new( my $name2 ); my $output; my $buffer; if ($to eq 'buffer') - { - $output = \$buffer + { + $output = \$buffer } elsif ($to eq 'filename') { @@ -145,18 +145,18 @@ sub run } elsif ($to eq 'filehandle') { - $output = new IO::File ">$name2" ; + $output = IO::File->new( ">$name2" ); } my $out ; - my $cs = new $CompressClass($output, AutoClose =>1, Encode => 'utf8'); + my $cs = $CompressClass->can('new')->( $CompressClass, $output, AutoClose =>1, Encode => 'utf8'); ok $cs->print($string); ok $cs->close(); my $input; if ($to eq 'buffer') - { - $input = \$buffer + { + $input = \$buffer } elsif ($to eq 'filename') { @@ -164,35 +164,34 @@ sub run } else { - $input = new IO::File "<$name2" ; + $input = IO::File->new( "<$name2" ); } - + { - my $ucs = new $UncompressClass($input, AutoClose =>1, Append => 1); + my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, AutoClose =>1, Append => 1); my $got; 1 while $ucs->read($got) > 0 ; ok length($got) > 0; is $got, $encString, " Expected output"; - + my $decode = Encode::decode_utf8($got); - + is $decode, $string, " Expected output"; } - - + + # { -# my $ucs = new $UncompressClass($input, Append => 1, Decode => 'utf8'); +# my $ucs = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1, Decode => 'utf8'); # my $got; # 1 while $ucs->read($got) > 0 ; -# ok length($got) > 0; +# ok length($got) > 0; # is $got, $string, " Expected output"; -# } - } +# } + } } } - -1; +1; diff --git a/cpan/IO-Compress/t/compress/generic.pl b/cpan/IO-Compress/t/compress/generic.pl index d9695e88dced..2c24bb85e532 100644 --- a/cpan/IO-Compress/t/compress/generic.pl +++ b/cpan/IO-Compress/t/compress/generic.pl @@ -9,8 +9,8 @@ use CompTestUtils; our ($UncompressClass); -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; @@ -27,10 +27,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 0, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -53,13 +53,13 @@ sub run title "Testing $CompressClass Errors"; # Buffer not writable - eval qq[\$a = new $CompressClass(\\1) ;] ; + eval qq[\$a = $CompressClass->new(\\1) ;] ; like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ; - + my($out, $gz); - + my $x ; - $gz = new $CompressClass(\$x); + $gz = $CompressClass->can('new')->($CompressClass, \$x); foreach my $name (qw(read readline getc)) { @@ -83,20 +83,20 @@ sub run my $out = "" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok ! -e $name, " $name does not exist"; - - $a = new $UncompressClass "$name" ; + + $a = $UncompressClass->can('new')->( $UncompressClass, "$name" ); is $a, undef; my $gc ; - my $guz = new $CompressClass(\$gc); + my $guz = $CompressClass->can('new')->( $CompressClass, \$gc); $guz->write("abc") ; $guz->close(); my $x ; - my $gz = new $UncompressClass(\$gc); + my $gz = $UncompressClass->can('new')->( $UncompressClass, \$gc); foreach my $name (qw(print printf write)) { @@ -114,14 +114,14 @@ sub run my ($a, $x, @x) = ("","","") ; # Buffer not a scalar reference - eval qq[\$a = new $CompressClass \\\@x ;] ; + eval qq[\$a = $CompressClass->new( \\\@x );] ; like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref"); - + # Buffer not a scalar reference - eval qq[\$a = new $UncompressClass \\\@x ;] ; + eval qq[\$a = $UncompressClass->new( \\\@x );] ; like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref"); } - + foreach my $Type ( $CompressClass, $UncompressClass) { # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate @@ -129,27 +129,27 @@ sub run my ($a, $x, @x) = ("","","") ; # Odd number of parameters - eval qq[\$a = new $Type "abc", -Output ] ; + eval qq[\$a = $Type->new( "abc", -Output ) ] ; like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1"); # Unknown parameter - eval qq[\$a = new $Type "anc", -Fred => 123 ;] ; + eval qq[\$a = $Type->new( "anc", -Fred => 123 );] ; like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred"); # no in or out param - eval qq[\$a = new $Type ;] ; + eval qq[\$a = $Type->new();] ; like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter"); - } + } { - # write a very simple compressed file - # and read back + # write a very simple compressed file + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <can('new')->( $CompressClass, $name ); is $x->autoflush(1), 0, "autoflush"; is $x->autoflush(1), 1, "autoflush"; ok $x->opened(), "opened"; @@ -171,7 +171,7 @@ sub run { my $uncomp; - ok my $x = new $UncompressClass $name, -Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1 ); ok $x->opened(), "opened"; my $len ; @@ -187,12 +187,12 @@ sub run } { - # write a very simple compressed file - # and read back + # write a very simple compressed file + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <can('new')->( $CompressClass, $name ); is $x->write(''), 0, "Write empty string is ok"; is $x->write(undef), 0, "Write undef is ok"; @@ -211,7 +211,7 @@ sub run { my $uncomp; - my $x = new $UncompressClass $name ; + my $x = $UncompressClass->can('new')->( $UncompressClass, $name ); ok $x, "creates $UncompressClass $name" ; my $data = ''; @@ -225,11 +225,11 @@ sub run { # write a very simple file with using an IO filehandle - # and read back + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <$name" ; + my $fh = IO::File->new( ">$name" ); ok $fh, "opened file $name ok"; - my $x = new $CompressClass $fh ; + my $x = $CompressClass->can('new')->( $CompressClass, $fh ); ok $x, " created $CompressClass $fh" ; is $x->fileno(), fileno($fh), "fileno match" ; @@ -254,8 +254,8 @@ sub run my $uncomp; { my $x ; - ok my $fh1 = new IO::File "<$name" ; - ok $x = new $UncompressClass $fh1, -Append => 1 ; + ok my $fh1 = IO::File->new( "<$name" ); + ok $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, -Append => 1 ); ok $x->fileno() == fileno $fh1 ; 1 while $x->read($uncomp) > 0 ; @@ -268,11 +268,11 @@ sub run { # write a very simple file with using a glob filehandle - # and read back + # and read back #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); #my $name = "/tmp/fred"; my $hello = <$name" ; - - my $x = new $CompressClass *FH ; + + my $x = $CompressClass->can('new')->( $CompressClass, *FH ); ok $x, " create $CompressClass" ; is $x->fileno(), fileno(*FH), " fileno" ; @@ -299,10 +299,10 @@ sub run my $uncomp; { - title "$UncompressClass: Input from typeglob filehandle, append output"; + title "$UncompressClass: Input from typeglob filehandle, append output"; my $x ; ok open FH, "<$name" ; - ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0 + ok $x = $UncompressClass->can('new')->( $UncompressClass, *FH, -Append => 1, Transparent => 0 ) or diag $$UnError ; is $x->fileno(), fileno FH, " fileno ok" ; @@ -316,7 +316,7 @@ sub run } { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); #my $name = "/tmp/fred"; my $hello = <&STDOUT"); my $dummy = fileno SAVEOUT; open STDOUT, ">$name" ; - - my $x = new $CompressClass '-' ; + + my $x = $CompressClass->can('new')->( $CompressClass, '-' ); $x->write($hello); $x->close; @@ -343,7 +343,7 @@ sub run #hexDump($name); { - title "Input from stdin via filename '-'"; + title "Input from stdin via filename '-'"; my $x ; my $uncomp ; @@ -352,7 +352,7 @@ sub run open(SAVEIN, "<&STDIN"); ok open(STDIN, "<$name"), " redirect STDIN"; my $dummy = fileno SAVEIN; - $x = new $UncompressClass '-', Append => 1, Transparent => 0 + $x = $UncompressClass->can('new')->( $UncompressClass, '-', Append => 1, Transparent => 0 ) or diag $$UnError ; ok $x, " created object" ; is $x->fileno(), $stdinFileno, " fileno ok" ; @@ -366,12 +366,12 @@ sub run } { - # write a compressed file to memory - # and read back + # write a compressed file to memory + # and read back #======================================== #my $name = "test.gz" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <can('new')->( $CompressClass, \$buffer) ; + ok ! defined $x->autoflush(1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->fileno() ; @@ -391,7 +391,7 @@ sub run ok $x->write($hello) ; ok $x->flush(); ok $x->close ; - + writeFile($name, $buffer) ; #is anyUncompress(\$buffer), $hello, " any ok"; } @@ -400,7 +400,7 @@ sub run my $uncomp; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; ok ! defined $x->autoflush(1) ; ok ! defined $x->autoflush(1) ; @@ -422,17 +422,17 @@ sub run my $buffer = ''; { my $x ; - $x = new $CompressClass(\$buffer); + $x = $CompressClass->can('new')->( $CompressClass, \$buffer); ok $x, "new $CompressClass" ; ok $x->close, "close ok" ; - + } my $keep = $buffer ; my $uncomp= ''; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; 1 while $x->read($uncomp) > 0 ; @@ -449,7 +449,7 @@ sub run #======================================== - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <can('new')->( $CompressClass, $name ); ok $x, " created $CompressClass object"; ok $x->write($hello), " write ok" ; @@ -492,7 +492,7 @@ sub run skip "zstd doesn't support trailing data", 11 if $CompressClass =~ /zstd/i ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <$name" ; + ok $fh = IO::File->new( ">$name" ); print $fh $header ; my $x ; - ok $x = new $CompressClass $fh, - -AutoClose => 0 ; + ok $x = $CompressClass->can('new')->( $CompressClass, $fh, + -AutoClose => 0 ); ok $x->binmode(); ok $x->write($hello) ; @@ -519,12 +519,12 @@ sub run my ($fil, $uncomp) ; my $fh1 ; - ok $fh1 = new IO::File "<$name" ; + ok $fh1 = IO::File->new( "<$name" ); # skip leading junk my $line = <$fh1> ; ok $line eq $header ; - ok my $x = new $UncompressClass $fh1, Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, Append => 1 ); ok $x->binmode(); 1 while $x->read($uncomp) > 0 ; @@ -554,7 +554,7 @@ sub run my $compressed ; { - ok my $x = new $CompressClass(\$compressed); + ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed); ok $x->write($hello) ; ok $x->close ; @@ -562,7 +562,7 @@ sub run } my $uncomp; - ok my $x = new $UncompressClass(\$compressed, Append => 1) ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, \$compressed, Append => 1) ; 1 while $x->read($uncomp) > 0 ; ok $uncomp eq $hello ; @@ -574,7 +574,7 @@ sub run # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -604,7 +604,7 @@ sub run } my $foo = "1234567890"; - + is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" } @@ -643,22 +643,22 @@ sub run EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my %opts = () ; - my $iow = new $CompressClass $name, %opts; - is $iow->input_line_number, undef; + my $iow = $CompressClass->can('new')->( $CompressClass, $name, %opts ); + is $iow->input_line_number, undef; $iow->print($str) ; - is $iow->input_line_number, undef; + is $iow->input_line_number, undef; $iow->close ; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - - is $., 0; - is $io->input_line_number, 0; + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell 0" ; #my @lines = <$io>; @@ -667,10 +667,10 @@ sub run or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; - is $io->input_line_number, 6; + is $., 6; + is $io->input_line_number, 6; is $io->tell(), length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -679,44 +679,44 @@ sub run defined($io->getc) || $io->read($buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); - is $., 0, "line 0"; - is $io->input_line_number, 0; + is $., 0, "line 0"; + is $io->input_line_number, 0; ok ! $io->eof, "eof"; my @lines = $io->getlines; - is $., 1, "line 1"; - is $io->input_line_number, 1, "line number 1"; + is $., 1, "line 1"; + is $io->input_line_number, 1, "line number 1"; ok $io->eof, "eof" ; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = $io->getline(); ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., 2; - is $io->input_line_number, 2; + is $., 2; + is $io->input_line_number, 2; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { # Record mode my $reclen = 7 ; @@ -725,15 +725,15 @@ sub run local $/ = \$reclen; my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., $expected_records; - is $io->input_line_number, $expected_records; + is $., $expected_records; + is $io->input_line_number, $expected_records; ok $io->eof; - is @lines, $expected_records, + is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; @@ -751,26 +751,26 @@ sub run push(@lines, $a); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - is $., 3; - is $io->input_line_number, 3; - ok @lines == 3 + + is $., 3; + is $io->input_line_number, 3; + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + eval { $io->read(1) } ; like $@, mkErr("buffer parameter is read-only"); @@ -781,18 +781,18 @@ sub run is $io->read($buf, 3), 3 ; is $buf, "Thi"; - + is $io->sysread($buf, 3, 2), 3 ; is $buf, "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; - + # read the rest of the file $buf = ''; my $remain = length($str) - 9; @@ -812,15 +812,15 @@ sub run ok $io->eof; # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -837,25 +837,25 @@ sub run and a single line. EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $str); my @tmp; my $buf; { - my $io = new $UncompressClass $name, -Transparent => 1 ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 ); + isa_ok $io, $UncompressClass ; ok ! $io->eof, "eof"; is $io->tell(), 0, "tell == 0" ; my @lines = $io->getlines(); - is @lines, 6, "got 6 lines"; + is @lines, 6, "got 6 lines"; ok $lines[1] eq "of a paragraph\n" ; ok join('', @lines) eq $str ; - is $., 6; - is $io->input_line_number, 6; + is $., 6; + is $io->input_line_number, 6; ok $io->tell() == length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -864,42 +864,42 @@ sub run defined($io->getc) || $io->read($buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; - is $., 1; - is $io->input_line_number, 1; + is $., 1; + is $io->input_line_number, 1; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = $io->getline; - is $., 1; - is $io->input_line_number, 1; + is $., 1; + is $io->input_line_number, 1; is $line, $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = $io->getlines; - is $., 2; - is $io->input_line_number, 2; + is $., 2; + is $io->input_line_number, 2; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# [$lines[0]]\n" ; ok $lines[1] eq "and a single line.\n\n"; } - + { # Record mode my $reclen = 7 ; @@ -908,15 +908,15 @@ sub run local $/ = \$reclen; my $io = $UncompressClass->new($name); - is $., 0; - is $io->input_line_number, 0; + is $., 0; + is $io->input_line_number, 0; ok ! $io->eof; my @lines = $io->getlines(); - is $., $expected_records; - is $io->input_line_number, $expected_records; + is $., $expected_records; + is $io->input_line_number, $expected_records; ok $io->eof; - is @lines, $expected_records, + is @lines, $expected_records, "Got $expected_records records\n" ; ok $lines[0] eq substr($str, 0, $reclen) or print "# $lines[0]\n"; @@ -934,12 +934,12 @@ sub run push(@lines, $a); $err++ if $. != ++$no; } - - is $., 3; - is $io->input_line_number, 3; + + is $., 3; + is $io->input_line_number, 3; ok $err == 0 ; ok $io->eof; - + ok @lines == 3 ; ok join("-", @lines) eq @@ -947,30 +947,30 @@ sub run "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test Read - + { my $io = $UncompressClass->new($name); - + $buf = "abcd"; is $io->read($buf, 0), 0, "Requested 0 bytes" ; is $buf, "", "Buffer empty"; ok $io->read($buf, 3) == 3 ; ok $buf eq "Thi"; - + ok $io->sysread($buf, 3, 2) == 3 ; ok $buf eq "Ths i"; ok ! $io->eof; - + $buf = "ab" ; is $io->read($buf, 3, 4), 3 ; is $buf, "ab" . "\x00" x 2 . "s a" or print "# [$buf]\n" ;; ok ! $io->eof; - + # read the rest of the file $buf = ''; my $remain = length($str) - 9; @@ -990,15 +990,15 @@ sub run ok $io->eof; # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -1029,24 +1029,24 @@ sub run { title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); if ($trans) { writeFile($name, $str) ; } else { - my $iow = new $CompressClass $name; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); $iow->print($str) ; $iow->close ; } - - my $io = $UncompressClass->new($name, + + my $io = $UncompressClass->new($name, -Append => $append, -Transparent => $trans); - + my $buf; - + is $io->tell(), 0; if ($append) { @@ -1073,7 +1073,7 @@ sub run my $buffer ; my $buff ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; @@ -1095,7 +1095,7 @@ sub run $output = \$buffer; } - my $iow = new $CompressClass $output ; + my $iow = $CompressClass->can('new')->( $CompressClass, $output ); $iow->print($first) ; ok $iow->seek(5, SEEK_CUR) ; ok $iow->tell() == length($first)+5; @@ -1121,7 +1121,7 @@ sub run ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ; my $io = $UncompressClass->new($input, Strict => 1); - ok $io->seek(length($first), SEEK_CUR) + ok $io->seek(length($first), SEEK_CUR) or diag $$UnError ; ok ! $io->eof; is $io->tell(), length($first); @@ -1146,9 +1146,9 @@ sub run title "seek error cases" ; my $b ; - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; - ok ! $a->error() + ok ! $a->error() or die $a->error() ; eval { $a->seek(-1, 10) ; }; like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter"); @@ -1160,7 +1160,7 @@ sub run $a->close ; - my $u = new $UncompressClass(\$b) ; + my $u = $UncompressClass->can('new')->( $UncompressClass, \$b) ; eval { $u->seek(-1, 10) ; }; like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter"); @@ -1171,7 +1171,7 @@ sub run eval { $u->seek(-1, SEEK_CUR) ; }; like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards"); } - + foreach my $fb (qw(filename buffer filehandle)) { foreach my $append (0, 1) @@ -1179,7 +1179,7 @@ sub run { title "$CompressClass -- Append $append, Output to $fb" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $already = 'already'; my $buffer = $already; @@ -1194,17 +1194,17 @@ sub run } elsif ($fb eq 'filehandle') { - $output = new IO::File ">$name" ; + $output = IO::File->new( ">$name" ); print $output $buffer; } - my $a = new $CompressClass($output, Append => $append) ; + my $a = $CompressClass->can('new')->( $CompressClass, $output, Append => $append) ; ok $a, " Created $CompressClass"; my $string = "appended"; $a->write($string); $a->close ; - my $data ; + my $data ; if ($fb eq 'buffer') { $data = $buffer; @@ -1224,7 +1224,7 @@ sub run my $uncomp; - my $x = new $UncompressClass(\$data, Append => 1) ; + my $x = $UncompressClass->can('new')->( $UncompressClass, \$data, Append => 1) ; ok $x, " created $UncompressClass"; my $len ; @@ -1232,7 +1232,7 @@ sub run $x->close ; is $uncomp, $string, ' Got uncompressed data' ; - + } } } @@ -1243,13 +1243,13 @@ sub run { title "$UncompressClass -- InputLength, read from $type, good data => $good"; - my $compressed ; + my $compressed ; my $string = "some data"; my $appended = "append"; if ($good) { - my $c = new $CompressClass(\$compressed); + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->write($string); $c->close(); } @@ -1261,7 +1261,7 @@ sub run my $comp_len = length $compressed; $compressed .= $appended; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; writeFile ($name, $compressed); @@ -1275,12 +1275,12 @@ sub run } elsif ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass($input, + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, InputLength => $comp_len, Transparent => 1) ; ok $x, " created $UncompressClass"; @@ -1302,20 +1302,20 @@ sub run } - + foreach my $append (0, 1) { title "$UncompressClass -- Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $string = "appended"; - my $compressed ; - my $c = new $CompressClass(\$compressed); + my $compressed ; + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->write($string); $c->close(); - my $x = new $UncompressClass(\$compressed, Append => $append) ; + my $x = $UncompressClass->can('new')->( $UncompressClass, \$compressed, Append => $append) ; ok $x, " created $UncompressClass"; my $already = 'already'; @@ -1334,7 +1334,7 @@ sub run } is $output, $string, ' Got uncompressed data' ; } - + foreach my $file (0, 1) { @@ -1342,7 +1342,7 @@ sub run { title "ungetc, File $file, Transparent $trans" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $string = 'abcdeABCDE'; my $b ; @@ -1352,7 +1352,7 @@ sub run } else { - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; $a->write($string); $a->close ; } @@ -1399,7 +1399,7 @@ sub run ok ! $u->eof(); is $u->read($buff), length($extra) ; is $buff, $extra; - + is $u->read($buff, 1), 0; ok $u->eof() ; @@ -1413,19 +1413,19 @@ sub run { title "write tests - invalid data" ; - #my $lex = new LexFile my $name1 ; + #my $lex = LexFile->new( my $name1 ); my($Answer); #ok ! -e $name1, " File $name1 does not exist"; my @data = ( - [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], - [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], - [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], - [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], - #[ "not readable", 'xx' ], + [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], + [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], + [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], + #[ "not readable", 'xx' ], # same filehandle twice, 'xx' ) ; @@ -1435,7 +1435,7 @@ sub run title "${CompressClass}::write( $send )"; my($copy); eval "\$copy = $send"; - my $x = new $CompressClass(\$Answer); + my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); ok $x, " Created $CompressClass object"; eval { $x->write($copy) } ; #like $@, "/^$get/", " error - $get"; @@ -1443,8 +1443,8 @@ sub run } # @data = ( - # [ '[ $name1 ]', "input file '$name1' does not exist" ], - # #[ "not readable", 'xx' ], + # [ '[ $name1 ]', "input file '$name1' does not exist" ], + # #[ "not readable", 'xx' ], # # same filehandle twice, 'xx' # ) ; # @@ -1454,14 +1454,14 @@ sub run # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; - # my $x = new $CompressClass(\$Answer); + # my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); # ok $x, " Created $CompressClass object"; # ok ! $x->write($copy), " write fails" ; # like $$Error, "/^$get/", " error - $get"; # } #exit; - + } @@ -1495,17 +1495,17 @@ sub run # # if (! ref $_[0]) # { - # $_[0] = $to + # $_[0] = $to # if $_[0] eq $from ; - # return ; + # return ; # # } # # if (ref $_[0] eq 'SCALAR') # { - # $_[0] = \$to + # $_[0] = \$to # if defined ${ $_[0] } && ${ $_[0] } eq $from ; - # return ; + # return ; # # } # @@ -1526,7 +1526,7 @@ sub run # my $file1 = "file1" ; # my $file2 = "file2" ; # my $file3 = "file3" ; - # my $lex = new LexFile $file1, $file2, $file3 ; + # my $lex = LexFile->new( $file1, $file2, $file3 ); # # writeFile($file1, "F1"); # writeFile($file2, "F2"); @@ -1564,15 +1564,15 @@ sub run # { # my ($send, $get) = @$data ; # - # my $fh1 = new IO::File "< $file1" ; - # my $fh2 = new IO::File "< $file2" ; - # my $fh3 = new IO::File "< $file3" ; + # my $fh1 = IO::File->new( "< $file1" ); + # my $fh2 = IO::File->new( "< $file2" ); + # my $fh3 = IO::File->new( "< $file3" ); # # title "${CompressClass}::write( $send )"; # my $copy; # eval "\$copy = $send"; # my $Answer ; - # my $x = new $CompressClass(\$Answer); + # my $x = $CompressClass->can('new')->( $CompressClass, \$Answer); # ok $x, " Created $CompressClass object"; # my $len = length $get; # is $x->write($copy), length($get), " write $len bytes"; @@ -1583,7 +1583,7 @@ sub run # # # } - # + # # } } @@ -1599,15 +1599,15 @@ sub run my $appended = "append"; my $string = "some data"; - my $compressed ; + my $compressed ; - my $c = new $CompressClass(\$compressed); + my $c = $CompressClass->can('new')->( $CompressClass, \$compressed); $c->close(); my $comp_len = length $compressed; $compressed .= $appended if $append && $CompressClass !~ /zstd/i; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; writeFile ($name, $compressed); @@ -1621,7 +1621,7 @@ sub run } elsif ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } @@ -1632,7 +1632,7 @@ sub run # Check that readline returns undef - my $x = new $UncompressClass $input, Transparent => 0 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1648,12 +1648,12 @@ sub run # Check that read returns an empty string if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass $input, Transparent => 0 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1672,12 +1672,12 @@ sub run if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass $input, Transparent => 0, - Append => 1 + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Transparent => 0, + Append => 1 ) or diag "$$UnError" ; isa_ok $x, $UncompressClass; @@ -1694,11 +1694,11 @@ sub run if ($type eq 'filehandle') { - my $fh = new IO::File "<$name" ; + my $fh = IO::File->new( "<$name" ); ok $fh, "opened file $name ok"; $input = $fh ; } - my $x = new $UncompressClass($input, Append => 1 ); + my $x = $UncompressClass->can('new')->( $UncompressClass, $input, Append => 1 ); isa_ok $x, $UncompressClass; my $buffer = "123"; @@ -1718,30 +1718,30 @@ sub run my $original = join '', map { chr } 0x00 .. 0xff ; $original .= "data1\r\ndata2\r\ndata3\r\n" ; - - + + title "$UncompressClass -- round trip test"; my $string = $original; - my $lex = new LexFile( my $name, my $compressed) ; + my $lex = LexFile->new( my $name, my $compressed) ; my $input ; writeFile ($name, $original); - my $c = new $CompressClass($compressed); + my $c = $CompressClass->can('new')->( $CompressClass, $compressed); isa_ok $c, $CompressClass; $c->print($string); $c->close(); - my $u = new $UncompressClass $compressed, Transparent => 0 + my $u = $UncompressClass->can('new')->( $UncompressClass, $compressed, Transparent => 0 ) or diag "$$UnError" ; isa_ok $u, $UncompressClass; my $buffer; is $u->read($buffer), length($original), "read bytes"; is $buffer, $original, " round tripped ok"; - - } + + } } 1; diff --git a/cpan/IO-Compress/t/compress/merge.pl b/cpan/IO-Compress/t/compress/merge.pl index 9cb359c1097f..a0442ed04150 100644 --- a/cpan/IO-Compress/t/compress/merge.pl +++ b/cpan/IO-Compress/t/compress/merge.pl @@ -3,15 +3,15 @@ use warnings; use bytes; -use Test::More ; +use Test::More ; use CompTestUtils; use Compress::Raw::Zlib 2 ; -BEGIN -{ - plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " - . Compress::Raw::Zlib::zlib_version()) +BEGIN +{ + plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " + . Compress::Raw::Zlib::zlib_version()) if ZLIB_VERNUM() < 0x1210 ; # use Test::NoWarnings, if available @@ -32,7 +32,7 @@ sub run my $Error = getErrorRef($CompressClass); my $UnError = getErrorRef($UncompressClass); - # Tests + # Tests # destination is a file that doesn't exist -- should work ok unless AnyDeflate # destination isn't compressed at all # destination is compressed but wrong format @@ -43,7 +43,7 @@ sub run { title "Misc error cases"; - eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ; + eval { Compress::Raw::Zlib::InflateScan->new( Bufsize => 0 ) } ; like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ; @@ -58,23 +58,23 @@ sub run { if ($to_file) { title "$CompressClass - Merge to filename that isn't writable" } - else + else { title "$CompressClass - Merge to filehandle that isn't writable" } - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); # create empty file open F, ">$out_file" ; print F "x"; close F; ok -e $out_file, " file exists" ; ok !-z $out_file, " and is not empty" ; - + # make unwritable is chmod(0444, $out_file), 1, " chmod worked" ; ok -e $out_file, " still exists after chmod" ; SKIP: { - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if -w $out_file ; ok ! -w $out_file, " chmod made file unwritable" ; @@ -83,10 +83,10 @@ sub run if ($to_file) { $dest = $out_file } else - { $dest = new IO::File "<$out_file" } + { $dest = IO::File->new( "<$out_file" ) } my $gz = $CompressClass->new($dest, Merge => 1) ; - + ok ! $gz, " Did not create $CompressClass object"; ok $$Error, " Got error message" ; @@ -99,7 +99,7 @@ sub run # output is not compressed at all { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw(buffer file handle ) ) { @@ -120,7 +120,7 @@ sub run if ($to_file eq 'handle') { - $buffer = new IO::File "+<$out_file" + $buffer = IO::File->new( "+<$out_file" ) or die "# Cannot open $out_file: $!"; } else @@ -138,7 +138,7 @@ sub run # output is empty { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw(buffer file handle ) ) { @@ -159,7 +159,7 @@ sub run if ($to_file eq 'handle') { - $buffer = new IO::File "+<$out_file" + $buffer = IO::File->new( "+<$out_file" ) or die "# Cannot open $out_file: $!"; } else @@ -182,12 +182,12 @@ sub run { title "$CompressClass - Merge to file that doesn't exist"; - my $lex = new LexFile my $out_file ; - + my $lex = LexFile->new( my $out_file ); + ok ! -e $out_file, " Destination file, '$out_file', does not exist"; - ok my $gz1 = $CompressClass->new($out_file, Merge => 1) - or die "# $CompressClass->new failed: $$Error\n"; + ok my $gz1 = $CompressClass->can('new')->( $CompressClass, $out_file, Merge => 1) + or die "# $CompressClass->new(...) failed: $$Error\n"; #hexDump($buffer); $gz1->write("FGHI"); $gz1->close(); @@ -200,13 +200,13 @@ sub run { - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file ( qw( buffer file handle ) ) { foreach my $content (undef, '', 'x', 'abcde') { - #next if ! defined $content && $to_file; + #next if ! defined $content && $to_file; my $buffer ; my $disp_content = defined $content ? $content : '' ; @@ -245,10 +245,10 @@ sub run # #} - my $dest = $buffer ; + my $dest = $buffer ; if ($to_file eq 'handle') { - $dest = new IO::File "+<$buffer" ; + $dest = IO::File->new( "+<$buffer" ); } my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1) @@ -278,7 +278,7 @@ sub run my $buffer ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); foreach my $to_file (0, 1) { @@ -298,7 +298,7 @@ sub run $buffer = \$x ; title "$TopType to Buffer, content is '$disp_content'"; } - + ok $Func->(\$content, $buffer), " Compress content"; #hexDump($buffer); diff --git a/cpan/IO-Compress/t/compress/multi.pl b/cpan/IO-Compress/t/compress/multi.pl index 48129a7c4526..06d78b983a2f 100644 --- a/cpan/IO-Compress/t/compress/multi.pl +++ b/cpan/IO-Compress/t/compress/multi.pl @@ -47,7 +47,7 @@ sub run even more stuff EOM - my $b0length = length $buffers[0]; + my $b0length = length $buffers[0]; my $bufcount = @buffers; { @@ -55,7 +55,7 @@ sub run my $gz ; my $hsize ; my %headers = () ; - + foreach my $fb ( qw( file filehandle buffer ) ) { @@ -71,11 +71,11 @@ sub run Strict => 1, Comment => "this is a comment", ExtraField => ["so" => "me extra"], - HeaderCRC => 1); + HeaderCRC => 1); } - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $output ; if ($fb eq 'buffer') { @@ -84,14 +84,14 @@ sub run } elsif ($fb eq 'filehandle') { - $output = new IO::File ">$name" ; + $output = IO::File->new( ">$name" ); } else { $output = $name ; } - my $x = new $CompressClass($output, AutoClose => 1, %headers); + my $x = $CompressClass->can('new')->($CompressClass, $output, AutoClose => 1, %headers); isa_ok $x, $CompressClass, ' $x' ; foreach my $buffer (@buffs) { @@ -106,12 +106,12 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->($unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -142,12 +142,12 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->( $unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -183,12 +183,12 @@ sub run $cc = $output ; if ($fb eq 'filehandle') { - $cc = new IO::File "<$name" ; + $cc = IO::File->new( "<$name" ); } - my @opts = $unc ne $UncompressClass + my @opts = $unc ne $UncompressClass ? (RawInflate => 1) : (); - my $gz = new $unc($cc, + my $gz = $unc->can('new')->( $unc, $cc, @opts, Strict => 1, AutoClose => 1, @@ -210,13 +210,13 @@ sub run $un .= $_; } is $., $lines, " \$. is $lines"; - + ok ! $gz->error(), " ! error()" or diag "Error is " . $gz->error() ; ok $gz->eof(), " eof()"; is $gz->streamCount(), $stream, " streamCount is $stream" or diag "Stream count is " . $gz->streamCount(); - is $un, $buff, " expected output" + is $un, $buff, " expected output" or diag "Stream count is " . $gz->streamCount(); ; #is $gz->tell(), length $buff, " tell is ok"; is $gz->nextStream(), 1, " nextStream ok"; diff --git a/cpan/IO-Compress/t/compress/newtied.pl b/cpan/IO-Compress/t/compress/newtied.pl index 41861e90721c..e5ced1439748 100644 --- a/cpan/IO-Compress/t/compress/newtied.pl +++ b/cpan/IO-Compress/t/compress/newtied.pl @@ -7,12 +7,12 @@ use CompTestUtils; our ($BadPerl, $UncompressClass); - -BEGIN -{ + +BEGIN +{ plan(skip_all => "Extra Tied Filehandle needs Perl 5.6 or better - you have Perl $]" ) if $] < 5.006 ; - + my $tests ; $BadPerl = ($] >= 5.006 and $] <= 5.008) ; @@ -44,10 +44,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data ; $data = $init if defined $init ; @@ -75,7 +75,7 @@ sub run # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -101,7 +101,7 @@ sub run } my $foo = "1234567890"; - + ok syswrite($io, $foo, length($foo)) == length($foo) ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo } @@ -142,17 +142,17 @@ sub run EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + ok ! $io->eof; ok ! eof $io; is $io->tell(), 0 ; @@ -162,11 +162,11 @@ sub run or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; + is $., 6; #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ; is $io->tell(), length($str) ; is tell($io), length($str) ; - + ok $io->eof; ok eof $io; @@ -176,8 +176,8 @@ sub run defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -185,27 +185,27 @@ sub run my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -217,26 +217,26 @@ sub run push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - ok @lines == 3 + + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); ok $io, "opened ok" ; - + #eval { read($io, $buf, -1); } ; #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ; @@ -247,22 +247,22 @@ sub run ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -273,11 +273,11 @@ sub run { title "seek tests" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $first ; ok seek $iow, 10, SEEK_CUR ; is tell($iow), length($first)+10; @@ -305,7 +305,7 @@ sub run { # seek error cases my $b ; - my $a = new $CompressClass(\$b) ; + my $a = $CompressClass->can('new')->( $CompressClass, \$b) ; ok ! $a->error() ; eval { seek($a, -1, 10) ; }; @@ -318,7 +318,7 @@ sub run close $a ; - my $u = new $UncompressClass(\$b) ; + my $u = $UncompressClass->can('new')->( $UncompressClass, \$b) ; eval { seek($u, -1, 10) ; }; like $@, mkErr("seek: unknown value, 10, for whence parameter"); @@ -333,7 +333,7 @@ sub run { title 'fileno' ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <$name" ; + ok $fh = IO::File->new( ">$name" ); my $x ; - ok $x = new $CompressClass $fh ; + ok $x = $CompressClass->can('new')->( $CompressClass, $fh ); ok $x->fileno() == fileno($fh) ; ok $x->fileno() == fileno($x) ; @@ -356,8 +356,8 @@ sub run my $uncomp; { my $x ; - ok my $fh1 = new IO::File "<$name" ; - ok $x = new $UncompressClass $fh1, -Append => 1 ; + ok my $fh1 = IO::File->new( "<$name" ); + ok $x = $UncompressClass->can('new')->( $UncompressClass, $fh1, -Append => 1 ); ok $x->fileno() == fileno $fh1 ; ok $x->fileno() == fileno $x ; diff --git a/cpan/IO-Compress/t/compress/oneshot.pl b/cpan/IO-Compress/t/compress/oneshot.pl index 790d1b2b0c6c..7e59fe58edd9 100644 --- a/cpan/IO-Compress/t/compress/oneshot.pl +++ b/cpan/IO-Compress/t/compress/oneshot.pl @@ -73,16 +73,16 @@ sub run my $in ; eval { $a = $Func->($in, \$x) ;} ; - like $@, mkErr("^$TopType: input filename is undef or null string"), + like $@, mkErr("^$TopType: input filename is undef or null string"), ' Input filename undef' ; - $in = ''; + $in = ''; eval { $a = $Func->($in, \$x) ;} ; - like $@, mkErr("^$TopType: input filename is undef or null string"), + like $@, mkErr("^$TopType: input filename is undef or null string"), ' Input filename empty' ; { - my $lex1 = new LexFile my $in ; + my $lex1 = LexFile->new( my $in ); writeFile($in, "abc"); my $out = $in ; eval { $a = $Func->($in, $out) ;} ; @@ -92,7 +92,7 @@ sub run { my $dir ; - my $lex = new LexDir $dir ; + my $lex = LexDir->new( $dir ); my $d = quotemeta $dir; $a = $Func->("$dir", \$x) ; @@ -109,7 +109,7 @@ sub run eval { $a = $Func->(\$in, \$in) ;} ; like $@, mkErr("^$TopType: input and output buffer are identical"), ' Input and Output buffer are the same'; - + SKIP: { # Threaded 5.6.x seems to have a problem comparing filehandles. @@ -118,12 +118,12 @@ sub run skip 'Cannot compare filehandles with threaded $]', 2 if $] >= 5.006 && $] < 5.007 && $Config{useithreads}; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); open OUT, ">$out_file" ; eval { $a = $Func->(\*OUT, \*OUT) ;} ; like $@, mkErr("^$TopType: input and output handle are identical"), ' Input and Output handle are the same'; - + close OUT; is -s $out_file, 0, " File zero length" ; } @@ -137,12 +137,12 @@ sub run eval { $a = $Func->(\$x, $object) ;} ; like $@, mkErr("^$TopType: illegal output parameter"), ' Bad Output Param'; - + # Buffer not a scalar reference eval { $a = $Func->(\$x, \%x) ;} ; like $@, mkErr("^$TopType: illegal output parameter"), ' Bad Output Param'; - + eval { $a = $Func->(\%x, \$x) ;} ; like $@, mkErr("^$TopType: illegal input parameter"), @@ -159,13 +159,13 @@ sub run $a = $Func->($filename, \$x) ; is $a, undef, " $TopType returned undef"; like $$Error, "/^input file '$filename' does not exist\$/", " input File '$filename' does not exist"; - + $filename = '/tmp/abd/abc.def'; ok ! -e $filename, " output File '$filename' does not exist"; $a = $Func->(\$x, $filename) ; is $a, undef, " $TopType returned undef"; like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), " output File '$filename' does not exist"; - + eval { $a = $Func->(\$x, '') } ; like $$Error, "/Need input fileglob for outout fileglob/", ' Output fileglob with no input fileglob'; @@ -199,7 +199,7 @@ sub run skip '\\ returns mutable value in 5.19.3', 1 if $] >= 5.019003; - + eval { $a = $Func->(\$in, \$out, TrailingData => \"abc") ;} ; like $@, mkErr("^$TopType: Parameter 'TrailingData' not writable"), ' TrailingData output not writable'; @@ -335,7 +335,7 @@ sub run { title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ; - my $lex = new LexFile my $in_file ; + my $lex = LexFile->new( my $in_file ); writeFile($in_file, $buffer); my @output = ('first') ; my @input = ($in_file); @@ -350,7 +350,7 @@ sub run { title "$TopType - From Buff to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); @@ -365,11 +365,11 @@ sub run { title "$TopType - From Buff to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile my $out_file ; + my $lex = LexFile->new( my $out_file ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $of = new IO::File ">>$out_file" ; + my $of = IO::File->new( ">>$out_file" ); ok $of, " Created output filehandle" ; ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -384,7 +384,7 @@ sub run { title "$TopType - From Filename to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); ok ! -e $out_file, " Output file does not exist"; @@ -402,12 +402,12 @@ sub run { title "$TopType - From Filename to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $out = new IO::File ">>$out_file" ; + my $out = IO::File->new( ">>$out_file" ); ok &$Func($in_file, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -421,7 +421,7 @@ sub run { title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); my $out = $already; @@ -433,18 +433,18 @@ sub run is $got, $buffer, " Uncompressed matches original"; } - + { title "$TopType - From Handle to Filename content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - ok &$Func($in, $out_file, Append => $append), ' Compressed ok' + ok &$Func($in, $out_file, Append => $append), ' Compressed ok' or diag "error is $$Error" ; ok -e $out_file, " Created output file"; @@ -457,13 +457,13 @@ sub run { title "$TopType - From Handle to Handle content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok ! -e $out_file, " Output file does not exist"; writeFile($out_file, $already); - my $out = new IO::File ">>$out_file" ; + my $out = IO::File->new( ">>$out_file" ); ok &$Func($in, $out, AutoClose => 1, Append => $append), ' Compressed ok' ; @@ -477,9 +477,9 @@ sub run { title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); my $out = $already ; @@ -494,7 +494,7 @@ sub run { title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; writeFile($in_file, $buffer); open(SAVEIN, "<&STDIN"); @@ -503,7 +503,7 @@ sub run my $out = $already; - ok &$Func('-', \$out, Append => $append), ' Compressed ok' + ok &$Func('-', \$out, Append => $append), ' Compressed ok' or diag $$Error ; open(STDIN, "<&SAVEIN"); @@ -528,11 +528,11 @@ sub run my $FuncInverse = getTopFuncRef($TopTypeInverse); my $ErrorInverse = getErrorRef($TopTypeInverse); - my $lex = new LexFile(my $file1, my $file2) ; + my $lex = LexFile->new( my $file1, my $file2) ; writeFile($file1, $OriginalContent1); writeFile($file2, $OriginalContent2); - my $of = new IO::File "<$file1" ; + my $of = IO::File->new( "<$file1" ); ok $of, " Created output filehandle" ; #my @input = ( undef, "", $file2, \undef, \'', \"abcde", $of) ; @@ -574,7 +574,7 @@ sub run $of->open("<$file1") ; my $output ; - ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok' + ok &$Func(\@input, \$output, MultiStream => $ms, AutoClose => 0), ' Compressed ok' or diag $$Error; my $got = anyUncompress([ \$output, MultiStream => $ms ]); @@ -587,7 +587,7 @@ sub run { title "$TopType - From Array Ref to Filename, MultiStream $ms" ; - my $lex = new LexFile( my $file3) ; + my $lex = LexFile->new( my $file3) ; # rewind the filehandle $of->open("<$file1") ; @@ -605,9 +605,9 @@ sub run { title "$TopType - From Array Ref to Filehandle, MultiStream $ms" ; - my $lex = new LexFile(my $file3) ; + my $lex = LexFile->new( my $file3) ; - my $fh3 = new IO::File ">$file3"; + my $fh3 = IO::File->new( ">$file3" ); # rewind the filehandle $of->open("<$file1") ; @@ -667,7 +667,7 @@ sub run title 'Round trip binary data that happens to include \r\n' ; - my $lex = new LexFile(my $file1, my $file2, my $file3) ; + my $lex = LexFile->new( my $file1, my $file2, my $file3) ; my $original = join '', map { chr } 0x00 .. 0xff ; $original .= "data1\r\ndata2\r\ndata3\r\n" ; @@ -678,7 +678,7 @@ sub run ok &$Func($file1 => $file2), ' Compressed ok' ; ok &$FuncInverse($file2 => $file3), ' Uncompressed ok' ; is readFile($file3), $original, " round tripped ok"; - + } foreach my $bit ($UncompressClass, @@ -692,7 +692,7 @@ sub run my $C_Func = getTopFuncRef($CompressClass); - + my $data = "mary had a little lamb" ; my $keep = $data ; my $extra = "after the main event"; @@ -705,7 +705,7 @@ sub run skip "zstd doesn't support trailing data", 9 if $CompressClass =~ /zstd/i ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input ; my $compressed ; @@ -720,7 +720,7 @@ sub run { writeFile($name, $compressed); - $input = new IO::File "<$name" ; + $input = IO::File->new( "<$name" ); } my $trailing; @@ -735,7 +735,7 @@ sub run } is $trailing . $rest, $extra, " Got trailing data"; - + } } @@ -751,10 +751,10 @@ sub run # # my @inFiles = map { "in$_.tmp" } 1..4; # my @outFiles = map { "out$_.tmp" } 1..4; -# my $lex = new LexFile(@inFiles, @outFiles); +# my $lex = LexFile->new( @inFiles, @outFiles); # # writeFile($_, "data $_") foreach @inFiles ; -# +# # { # title "$TopType - Hash Ref: to filename" ; # @@ -791,8 +791,8 @@ sub run # my @buffer ; # my %hash = ( $inFiles[0] => undef, # $inFiles[1] => undef, -# $inFiles[2] => undef, -# ); +# $inFiles[2] => undef, +# ); # # ok &$Func( \%hash ), ' Compressed ok' ; # @@ -845,10 +845,10 @@ sub run # # my @inFiles = map { "in$_.tmp" } 1..4; # my @outFiles = map { "out$_.tmp" } 1..4; -# my $lex = new LexFile(@inFiles, @outFiles); +# my $lex = LexFile->new( @inFiles, @outFiles); # # writeFile($_, "data $_") foreach @inFiles ; -# +# # # # # if (0) @@ -888,7 +888,7 @@ sub run # # title "$TopType - From Array Ref to Filename" ; # # # # my ($file3) = ("file3"); -# # my $lex = new LexFile($file3) ; +# # my $lex = LexFile->new( $file3) ; # # # # # rewind the filehandle # # $of->open("<$file1") ; @@ -906,9 +906,9 @@ sub run # # title "$TopType - From Array Ref to Filehandle" ; # # # # my ($file3) = ("file3"); -# # my $lex = new LexFile($file3) ; +# # my $lex = LexFile->new( $file3) ; # # -# # my $fh3 = new IO::File ">$file3"; +# # my $fh3 = IO::File->new( ">$file3" ); # # # # # rewind the filehandle # # $of->open("<$file1") ; @@ -936,7 +936,7 @@ sub run my $tmpDir1 ; my $tmpDir2 ; - my $lex = new LexDir($tmpDir1, $tmpDir2) ; + my $lex = LexDir->new($tmpDir1, $tmpDir2) ; my $d1 = quotemeta $tmpDir1 ; my $d2 = quotemeta $tmpDir2 ; @@ -951,7 +951,7 @@ sub run { title "$TopType - From FileGlob to FileGlob files [@$files]" ; - ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), ' Compressed ok' or diag $$Error ; my @copy = @expected; @@ -967,7 +967,7 @@ sub run title "$TopType - From FileGlob to Array files [@$files]" ; my @buffer = ('first') ; - ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), ' Compressed ok' or diag $$Error ; is shift @buffer, 'first'; @@ -987,8 +987,8 @@ sub run title "$TopType - From FileGlob to Buffer files [@$files], MS $ms" ; my $buffer ; - ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, - MultiStream => $ms), ' Compressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer, + MultiStream => $ms), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1003,10 +1003,10 @@ sub run { title "$TopType - From FileGlob to Filename files [@$files], MS $ms" ; - my $lex = new LexFile(my $filename) ; - + my $lex = LexFile->new( my $filename) ; + ok &$Func("<$tmpDir1/a*.tmp>" => $filename, - MultiStream => $ms), ' Compressed ok' + MultiStream => $ms), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1021,11 +1021,11 @@ sub run { title "$TopType - From FileGlob to Filehandle files [@$files], MS $ms" ; - my $lex = new LexFile(my $filename) ; - my $fh = new IO::File ">$filename"; - - ok &$Func("<$tmpDir1/a*.tmp>" => $fh, - MultiStream => $ms, AutoClose => 1), ' Compressed ok' + my $lex = LexFile->new( my $filename) ; + my $fh = IO::File->new( ">$filename" ); + + ok &$Func("<$tmpDir1/a*.tmp>" => $fh, + MultiStream => $ms, AutoClose => 1), ' Compressed ok' or diag $$Error ; #hexDump(\$buffer); @@ -1050,7 +1050,7 @@ sub run my $TopType = getTopFuncName($bit); my $buffer = $OriginalContent1; - my $buffer2 = $OriginalContent2; + my $buffer2 = $OriginalContent2; my $keep_orig = $buffer; my $comp = compressBuffer($UncompressClass, $buffer) ; @@ -1096,7 +1096,7 @@ sub run { title "$TopType - From Buff to Filename, Append($append)" ; - my $lex = new LexFile(my $out_file) ; + my $lex = LexFile->new( my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else @@ -1114,15 +1114,15 @@ sub run { title "$TopType - From Buff to Handle, Append($append)" ; - my $lex = new LexFile(my $out_file) ; + my $lex = LexFile->new( my $out_file) ; my $of ; if ($append) { writeFile($out_file, $incumbent) ; - $of = new IO::File "+< $out_file" ; + $of = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $of = new IO::File "> $out_file" ; + $of = IO::File->new( "> $out_file" ); } isa_ok $of, 'IO::File', ' $of' ; @@ -1138,7 +1138,7 @@ sub run { title "$TopType - From Filename to Filename, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else @@ -1158,15 +1158,15 @@ sub run { title "$TopType - From Filename to Handle, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; if ($append) { writeFile($out_file, $incumbent) ; - $out = new IO::File "+< $out_file" ; + $out = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $out = new IO::File "> $out_file" ; + $out = IO::File->new( "> $out_file" ); } isa_ok $out, 'IO::File', ' $out' ; @@ -1184,7 +1184,7 @@ sub run { title "$TopType - From Filename to Buffer, Append($append)" ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); my $output ; @@ -1199,14 +1199,14 @@ sub run { title "$TopType - From Handle to Filename, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; if ($append) { writeFile($out_file, $incumbent) } else { ok ! -e $out_file, " Output file does not exist" } writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, $out_file, Append => $append, @opts), ' Uncompressed ok' ; @@ -1220,20 +1220,20 @@ sub run { title "$TopType - From Handle to Handle, Append($append)" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; if ($append) { writeFile($out_file, $incumbent) ; - $out = new IO::File "+< $out_file" ; + $out = IO::File->new( "+< $out_file" ); } else { ok ! -e $out_file, " Output file does not exist" ; - $out = new IO::File "> $out_file" ; + $out = IO::File->new( "> $out_file" ); } isa_ok $out, 'IO::File', ' $out' ; writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, $out, Append => $append, AutoClose => 1, @opts), ' Uncompressed ok' ; @@ -1247,9 +1247,9 @@ sub run { title "$TopType - From Filename to Buffer, Append($append)" ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); my $output ; $output = $incumbent if $append ; @@ -1263,7 +1263,7 @@ sub run { title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ; - my $lex = new LexFile(my $in_file) ; + my $lex = LexFile->new( my $in_file) ; writeFile($in_file, $comp); open(SAVEIN, "<&STDIN"); @@ -1273,7 +1273,7 @@ sub run my $output ; $output = $incumbent if $append ; - ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok' + ok &$Func('-', \$output, Append => $append, @opts), ' Uncompressed ok' or diag $$Error ; open(STDIN, "<&SAVEIN"); @@ -1286,14 +1286,14 @@ sub run { title "$TopType - From Handle to Buffer, InputLength" ; - my $lex = new LexFile(my $in_file, my $out_file) ; + my $lex = LexFile->new( my $in_file, my $out_file) ; my $out ; my $expected = $buffer ; my $appended = 'appended'; my $len_appended = length $appended; writeFile($in_file, $comp . $appended . $comp . $appended) ; - my $in = new IO::File "<$in_file" ; + my $in = IO::File->new( "<$in_file" ); ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' ; @@ -1317,7 +1317,7 @@ sub run { title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ; - my $lex = new LexFile my $in_file ; + my $lex = LexFile->new( my $in_file ); my $expected = $buffer ; my $appended = 'appended'; my $len_appended = length $appended; @@ -1329,7 +1329,7 @@ sub run my $output ; - ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' + ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp, @opts), ' Uncompressed ok' or diag $$Error ; my $buff ; @@ -1366,12 +1366,12 @@ sub run my $incumbent = "incumbent data" ; - my $lex = new LexFile(my $file1, my $file2) ; + my $lex = LexFile->new( my $file1, my $file2) ; writeFile($file1, compressBuffer($UncompressClass, $OriginalContent1)); writeFile($file2, compressBuffer($UncompressClass, $OriginalContent2)); - my $of = new IO::File "<$file1" ; + my $of = IO::File->new( "<$file1" ); ok $of, " Created output filehandle" ; #my @input = ($file2, \$undef, \$null, \$comp, $of) ; @@ -1393,7 +1393,7 @@ sub run { title "$TopType - From ArrayRef to Filename" ; - my $lex = new LexFile my $output; + my $lex = LexFile->new( my $output ); $of->open("<$file1") ; ok &$Func(\@input, $output, AutoClose => 0, @opts), ' UnCompressed ok' ; @@ -1404,8 +1404,8 @@ sub run { title "$TopType - From ArrayRef to Filehandle" ; - my $lex = new LexFile my $output; - my $fh = new IO::File ">$output" ; + my $lex = LexFile->new( my $output ); + my $fh = IO::File->new( ">$output" ); $of->open("<$file1") ; ok &$Func(\@input, $fh, AutoClose => 0, @opts), ' UnCompressed ok' ; @@ -1422,8 +1422,8 @@ sub run ok &$Func(\@input, \@output, AutoClose => 0, @opts), ' UnCompressed ok' ; is_deeply \@input, \@keep, " Input array not changed" ; - is_deeply [map { defined $$_ ? $$_ : "" } @output], - ['first', @expected], + is_deeply [map { defined $$_ ? $$_ : "" } @output], + ['first', @expected], " Got Expected uncompressed data"; } @@ -1441,7 +1441,7 @@ sub run my $tmpDir1 ; my $tmpDir2 ; - my $lex = new LexDir($tmpDir1, $tmpDir2) ; + my $lex = LexDir->new($tmpDir1, $tmpDir2) ; my $d1 = quotemeta $tmpDir1 ; my $d2 = quotemeta $tmpDir2 ; @@ -1460,7 +1460,7 @@ sub run { title "$TopType - From FileGlob to FileGlob" ; - ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>", @opts), ' UnCompressed ok' or diag $$Error ; my @copy = @expected; @@ -1476,7 +1476,7 @@ sub run title "$TopType - From FileGlob to Arrayref" ; my @output = (\'first'); - ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \@output, @opts), ' UnCompressed ok' or diag $$Error ; my @copy = ('first', @expected); @@ -1492,7 +1492,7 @@ sub run title "$TopType - From FileGlob to Buffer" ; my $output ; - ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => \$output, @opts), ' UnCompressed ok' or diag $$Error ; is $output, join('', @expected), " got expected uncompressed data"; @@ -1501,9 +1501,9 @@ sub run { title "$TopType - From FileGlob to Filename" ; - my $lex = new LexFile my $output ; + my $lex = LexFile->new( my $output ); ok ! -e $output, " $output does not exist" ; - ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok' + ok &$Func("<$tmpDir1/a*.tmp>" => $output, @opts), ' UnCompressed ok' or diag $$Error ; ok -e $output, " $output does exist" ; @@ -1513,9 +1513,9 @@ sub run { title "$TopType - From FileGlob to Filehandle" ; - my $lex = new LexFile my $output ; - my $fh = new IO::File ">$output" ; - ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' + my $lex = LexFile->new( my $output ); + my $fh = IO::File->new( ">$output" ); + ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1, @opts), ' UnCompressed ok' or diag $$Error ; ok -e $output, " $output does exist" ; @@ -1534,7 +1534,7 @@ sub run title "More write tests" ; - my $lex = new LexFile(my $file1, my $file2, my $file3) ; + my $lex = LexFile->new( my $file1, my $file2, my $file3) ; writeFile($file1, "F1"); writeFile($file2, "F2"); @@ -1551,9 +1551,9 @@ sub run # { # my ($send, $get) = @$data ; # -# my $fh1 = new IO::File "< $file1" ; -# my $fh2 = new IO::File "< $file2" ; -# my $fh3 = new IO::File "< $file3" ; +# my $fh1 = IO::File->new( "< $file1" ); +# my $fh2 = IO::File->new( "< $file2" ); +# my $fh3 = IO::File->new( "< $file3" ); # # title "$send"; # my ($copy); @@ -1587,9 +1587,9 @@ sub run { my ($send, $get) = @$data ; - my $fh1 = new IO::File "< $file1" ; - my $fh2 = new IO::File "< $file2" ; - my $fh3 = new IO::File "< $file3" ; + my $fh1 = IO::File->new( "< $file1" ); + my $fh2 = IO::File->new( "< $file2" ); + my $fh3 = IO::File->new( "< $file3" ); title "$send"; my($copy); @@ -1604,8 +1604,8 @@ sub run } @data = ( - '[""]', - '[undef]', + '[""]', + '[undef]', ) ; @@ -1616,7 +1616,7 @@ sub run eval "\$copy = $send"; my $Answer ; eval { &$Func($copy, \$Answer) } ; - like $@, mkErr("^$TopFuncName: input filename is undef or null string"), + like $@, mkErr("^$TopFuncName: input filename is undef or null string"), " got error message"; } @@ -1624,11 +1624,11 @@ sub run { - # check setting $\ + # check setting $\ my $CompFunc = getTopFuncRef($CompressClass); my $UncompFunc = getTopFuncRef($UncompressClass); - my $lex = new LexFile my $file ; + my $lex = LexFile->new( my $file ); local $\ = "\n" ; my $input = "hello world"; @@ -1664,7 +1664,7 @@ sub run is $output, $input, "round trip ok" ; } - + } # TODO add more error cases diff --git a/cpan/IO-Compress/t/compress/prime.pl b/cpan/IO-Compress/t/compress/prime.pl index cae424c7aed9..2b0af2835d7c 100644 --- a/cpan/IO-Compress/t/compress/prime.pl +++ b/cpan/IO-Compress/t/compress/prime.pl @@ -13,7 +13,7 @@ BEGIN plan skip_all => "Lengthy Tests Disabled\n" . "set COMPRESS_ZLIB_RUN_ALL or COMPRESS_ZLIB_RUN_MOST to run this test suite" unless defined $ENV{COMPRESS_ZLIB_RUN_ALL} or defined $ENV{COMPRESS_ZLIB_RUN_MOST}; - + # use Test::NoWarnings, if available $extra = 0 ; $extra = 1 @@ -54,11 +54,11 @@ sub run for my $useBuf (0 .. 1) { print "#\n# BlockSize $blocksize, Length $i, Buffer $useBuf\n#\n" ; - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my $prime = substr($compressed, 0, $i); my $rest = substr($compressed, $i); - + my $start ; if ($useBuf) { $start = \$rest ; @@ -68,20 +68,20 @@ sub run writeFile($name, $rest); } - #my $gz = new $UncompressClass $name, - my $gz = new $UncompressClass $start, + #my $gz = $UncompressClass->can('new')->( $UncompressClass, $name, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $start, -Append => 1, -BlockSize => $blocksize, -Prime => $prime, -Transparent => 0 - ; + ); ok $gz; ok ! $gz->error() ; my $un ; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; is $status, 0 ; - ok ! $gz->error() + ok ! $gz->error() or print "Error is '" . $gz->error() . "'\n"; is $un, $hello ; ok $gz->eof() ; @@ -90,5 +90,5 @@ sub run } } } - + 1; diff --git a/cpan/IO-Compress/t/compress/tied.pl b/cpan/IO-Compress/t/compress/tied.pl index 4552e1733ab4..98f9dcc4813d 100644 --- a/cpan/IO-Compress/t/compress/tied.pl +++ b/cpan/IO-Compress/t/compress/tied.pl @@ -8,9 +8,9 @@ use CompTestUtils; our ($BadPerl, $UncompressClass); - -BEGIN -{ + +BEGIN +{ plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" ) if $] < 5.005 ; @@ -32,10 +32,10 @@ BEGIN plan tests => $tests + $extra ; } - - + + use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); - + sub myGZreadFile @@ -44,10 +44,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data ; $data = $init if defined $init ; @@ -71,9 +71,9 @@ sub run title "Testing $CompressClass"; - + my $x ; - my $gz = new $CompressClass(\$x); + my $gz = $CompressClass->can('new')->( $CompressClass, \$x); my $buff ; @@ -95,12 +95,12 @@ sub run title "Testing $UncompressClass"; my $gc ; - my $guz = new $CompressClass(\$gc); + my $guz = $CompressClass->can('new')->( $CompressClass, \$gc); $guz->write("abc") ; $guz->close(); my $x ; - my $gz = new $UncompressClass(\$gc); + my $gz = $UncompressClass->can('new')->( $UncompressClass, \$gc); my $buff ; @@ -125,7 +125,7 @@ sub run # Write # these tests come almost 100% from IO::String - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $io = $CompressClass->new($name); @@ -148,7 +148,7 @@ sub run } my $foo = "1234567890"; - + ok syswrite($io, $foo, length($foo)) == length($foo) ; if ( $] < 5.6 ) { is $io->syswrite($foo, length $foo), length $foo } @@ -188,17 +188,17 @@ sub run EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; my @tmp; my $buf; { - my $io = new $UncompressClass $name ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); + ok ! $io->eof, " Not EOF"; is $io->tell(), 0, " Tell is 0" ; my @lines = <$io>; @@ -206,9 +206,9 @@ sub run or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; is $lines[1], "of a paragraph\n" ; is join('', @lines), $str ; - is $., 6; + is $., 6; is $io->tell(), length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -217,8 +217,8 @@ sub run defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -226,27 +226,27 @@ sub run my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# $lines[0]\n"; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -258,24 +258,24 @@ sub run push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - - ok @lines == 3 + + ok @lines == 3 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + if (! $BadPerl) { eval { read($io, $buf, -1) } ; @@ -286,22 +286,22 @@ sub run ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i" or print "# [$buf]\n" ;; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -319,24 +319,24 @@ sub run EOT - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, $str); my @tmp; my $buf; { - my $io = new $UncompressClass $name, -Transparent => 1 ; - + my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 ); + ok defined $io; ok ! $io->eof; ok $io->tell() == 0 ; my @lines = <$io>; - ok @lines == 6; + ok @lines == 6; ok $lines[1] eq "of a paragraph\n" ; ok join('', @lines) eq $str ; - ok $. == 6; + ok $. == 6; ok $io->tell() == length($str) ; - + ok $io->eof; ok ! ( defined($io->getline) || @@ -345,8 +345,8 @@ sub run defined($io->getc) || read($io, $buf, 100) != 0) ; } - - + + { local $/; # slurp mode my $io = $UncompressClass->new($name); @@ -354,27 +354,27 @@ sub run my @lines = $io->getlines; ok $io->eof; ok @lines == 1 && $lines[0] eq $str; - + $io = $UncompressClass->new($name); ok ! $io->eof; my $line = <$io>; ok $line eq $str; ok $io->eof; } - + { local $/ = ""; # paragraph mode my $io = $UncompressClass->new($name); ok ! $io->eof; my @lines = <$io>; ok $io->eof; - ok @lines == 2 + ok @lines == 2 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" or print "# [$lines[0]]\n" ; ok $lines[1] eq "and a single line.\n\n"; } - + { local $/ = "is"; my $io = $UncompressClass->new($name); @@ -386,40 +386,40 @@ sub run push(@lines, $_); $err++ if $. != ++$no; } - + ok $err == 0 ; ok $io->eof; - + ok @lines == 3 ; ok join("-", @lines) eq "This- is- an example\n" . "of a paragraph\n\n\n" . "and a single line.\n\n"; } - - + + # Test read - + { my $io = $UncompressClass->new($name); - + ok read($io, $buf, 3) == 3 ; ok $buf eq "Thi"; - + ok sysread($io, $buf, 3, 2) == 3 ; ok $buf eq "Ths i"; ok ! $io->eof; - + # $io->seek(-4, 2); - # + # # ok ! $io->eof; - # + # # ok read($io, $buf, 20) == 4 ; # ok $buf eq "e.\n\n"; - # + # # ok read($io, $buf, 20) == 0 ; # ok $buf eq ""; - # + # # ok ! $io->eof; } @@ -450,24 +450,24 @@ sub run { title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); if ($trans) { writeFile($name, $str) ; } else { - my $iow = new $CompressClass $name ; + my $iow = $CompressClass->can('new')->( $CompressClass, $name ); print $iow $str ; close $iow; } - - my $io = $UncompressClass->new($name, + + my $io = $UncompressClass->new($name, -Append => $append, -Transparent => $trans); - + my $buf; - + is $io->tell(), 0; if ($append) { diff --git a/cpan/IO-Compress/t/compress/truncate.pl b/cpan/IO-Compress/t/compress/truncate.pl index 24fe176ce8a1..555114dba7d4 100644 --- a/cpan/IO-Compress/t/compress/truncate.pl +++ b/cpan/IO-Compress/t/compress/truncate.pl @@ -13,7 +13,7 @@ sub run my $UncompressClass = getInverse($CompressClass); my $Error = getErrorRef($CompressClass); my $UnError = getErrorRef($UncompressClass); - + # my $hello = <new( my $name ); my $input; - + title "Fingerprint Truncation - length $i, Transparent $trans"; my $part = substr($compressed, 0, $i); @@ -68,9 +68,9 @@ sub run $input = \$part; } - my $gz = new $UncompressClass $input, + my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); if ($trans) { ok $gz; ok ! $gz->error() ; @@ -92,9 +92,9 @@ sub run # foreach my $i ($fingerprint_size .. $header_size -1) { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + title "Header Truncation - length $i, Source $fb, Transparent $trans"; my $part = substr($compressed, 0, $i); @@ -107,10 +107,10 @@ sub run { $input = \$part; } - - ok ! defined new $UncompressClass $input, + + ok ! defined $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, - -Transparent => $trans; + -Transparent => $trans ); #ok $gz->eof() ; } @@ -118,15 +118,15 @@ sub run # In this case the uncompression object will have been created, # so need to check that subsequent reads from the object fail if ($header_size > 0) - { + { for my $mode (qw(block line para record slurp)) { title "Corruption after header - Mode $mode, Source $fb, Transparent $trans"; - - my $lex = new LexFile my $name ; + + my $lex = LexFile->new( my $name ); my $input; - + my $part = substr($compressed, 0, $header_size); # Append corrupt data $part .= "\xFF" x 100 ; @@ -139,11 +139,11 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -Strict => 1, -BlockSize => $blocksize, - -Transparent => $trans + -Transparent => $trans ) or diag $$UnError; my $un ; @@ -184,19 +184,19 @@ sub run } # Back to truncation tests - + foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) { next if $i == 0 ; - + for my $mode (qw(block line)) { title "Compressed Data Truncation - length $i, MOde $mode, Source $fb, Transparent $trans"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + my $part = substr($compressed, 0, $i); if ($fb eq 'filehandle') { @@ -207,11 +207,11 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -Strict => 1, -BlockSize => $blocksize, - -Transparent => $trans + -Transparent => $trans ) or diag $$UnError; my $un ; @@ -227,12 +227,12 @@ sub run } ok $gz->error() ; cmp_ok $gz->errorNo(), '<', 0 ; - # ok $gz->eof() + # ok $gz->eof() # or die "EOF"; $gz->close(); } } - + # RawDeflate and Zstandard do not have a trailer next if $CompressClass eq 'IO::Compress::RawDeflate' ; next if $CompressClass eq 'IO::Compress::Zstd' ; @@ -242,9 +242,9 @@ sub run { foreach my $lax (0, 1) { - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $input; - + ok 1, "Compressed Trailer Truncation - Length $i, Lax $lax, Transparent $trans" ; my $part = substr($compressed, 0, $i); if ($fb eq 'filehandle') @@ -256,12 +256,12 @@ sub run { $input = \$part; } - - ok my $gz = new $UncompressClass $input, + + ok my $gz = $UncompressClass->can('new')->( $UncompressClass, $input, -BlockSize => $blocksize, -Strict => !$lax, - -Append => 1, - -Transparent => $trans; + -Append => 1, + -Transparent => $trans ); my $un = ''; my $status = 1 ; $status = $gz->read($un) while $status > 0 ; @@ -269,7 +269,7 @@ sub run if ($lax) { is $un, $hello; - is $status, 0 + is $status, 0 or diag "Status $status Error is " . $gz->error() ; ok $gz->eof() or diag "Status $status Error is " . $gz->error() ; @@ -277,13 +277,13 @@ sub run } else { - cmp_ok $status, "<", 0 + cmp_ok $status, "<", 0 or diag "Status $status Error is " . $gz->error() ; ok $gz->eof() or diag "Status $status Error is " . $gz->error() ; ok $gz->error() ; } - + $gz->close(); } } @@ -292,4 +292,3 @@ sub run } 1; - diff --git a/cpan/IO-Compress/t/compress/zlib-generic.pl b/cpan/IO-Compress/t/compress/zlib-generic.pl index 94e5da9f723b..5c4e3fc8210f 100644 --- a/cpan/IO-Compress/t/compress/zlib-generic.pl +++ b/cpan/IO-Compress/t/compress/zlib-generic.pl @@ -6,8 +6,8 @@ use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -32,10 +32,10 @@ sub myGZreadFile my $init = shift ; - my $fil = new $UncompressClass $filename, + my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, -Strict => 1, -Append => 1 - ; + ); my $data = ''; $data = $init if defined $init ; @@ -65,7 +65,7 @@ sub myGZreadFile title "flush" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = <can('new')->( $CompressClass, $name ); ok $x->write($hello), "write" ; ok $x->flush(Z_FINISH), "flush"; @@ -83,7 +83,7 @@ sub myGZreadFile { my $uncomp; - ok my $x = new $UncompressClass $name, -Append => 1 ; + ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1 ); my $len ; 1 while ($len = $x->read($uncomp)) > 0 ; @@ -104,16 +104,16 @@ sub myGZreadFile my $buffer = ''; { my $x ; - ok $x = new $CompressClass(\$buffer) ; + ok $x = $CompressClass->can('new')->( $CompressClass, \$buffer); ok $x->close ; - + } my $keep = $buffer ; my $uncomp= ''; { my $x ; - ok $x = new $UncompressClass(\$buffer, Append => 1) ; + ok $x = $UncompressClass->can('new')->( $UncompressClass, \$buffer, Append => 1) ; 1 while $x->read($uncomp) > 0 ; @@ -125,21 +125,21 @@ sub myGZreadFile } - + { title "inflateSync on plain file"; my $hello = "I am a HAL 9000 computer" x 2001 ; - my $k = new $UncompressClass(\$hello, Transparent => 1); + my $k = $UncompressClass->can('new')->( $UncompressClass, \$hello, Transparent => 1); ok $k ; - + # Skip to the flush point -- no-op for plain file my $status = $k->inflateSync(); - is $status, 1 + is $status, 1 or diag $k->error() ; - - my $rest; + + my $rest; is $k->read($rest, length($hello)), length($hello) or diag $k->error() ; ok $rest eq $hello ; @@ -156,23 +156,23 @@ sub myGZreadFile my $goodbye = "Will I dream?" x 2010; my ($x, $err, $answer, $X, $Z, $status); my $Answer ; - - ok ($x = new $CompressClass(\$Answer)); + + ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); ok $x ; - + is $x->write($hello), length($hello); - + # create a flush point ok $x->flush(Z_FULL_FLUSH) ; - + is $x->write($goodbye), length($goodbye); - + ok $x->close() ; - + my $k; - $k = new $UncompressClass(\$Answer, BlockSize => 1); + $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); ok $k ; - + my $initial; is $k->read($initial, 1), 1 ; is $initial, substr($hello, 0, 1); @@ -181,9 +181,9 @@ sub myGZreadFile $status = $k->inflateSync(); is $status, 1, " inflateSync returned 1" or diag $k->error() ; - - my $rest; - is $k->read($rest, length($hello) + length($goodbye)), + + my $rest; + is $k->read($rest, length($hello) + length($goodbye)), length($goodbye) or diag $k->error() ; ok $rest eq $goodbye, " got expected output" ; @@ -199,26 +199,26 @@ sub myGZreadFile my $hello = "I am a HAL 9000 computer" x 2001 ; my ($x, $err, $answer, $X, $Z, $status); my $Answer ; - - ok ($x = new $CompressClass(\$Answer)); + + ok ($x = $CompressClass->can('new')->( $CompressClass, \$Answer)); ok $x ; - + is $x->write($hello), length($hello); - + ok $x->close() ; - - my $k = new $UncompressClass(\$Answer, BlockSize => 1); + + my $k = $UncompressClass->can('new')->( $UncompressClass, \$Answer, BlockSize => 1); ok $k ; - + my $initial; is $k->read($initial, 1), 1 ; is $initial, substr($hello, 0, 1); # Skip to the flush point $status = $k->inflateSync(); - is $status, 0 + is $status, 0 or diag $k->error() ; - + ok $k->close(); is $k->inflateSync(), 0 ; } @@ -227,7 +227,3 @@ sub myGZreadFile 1; - - - - diff --git a/cpan/IO-Compress/t/cz-01version.t b/cpan/IO-Compress/t/cz-01version.t index ff10f32b106e..12574aa91cb8 100644 --- a/cpan/IO-Compress/t/cz-01version.t +++ b/cpan/IO-Compress/t/cz-01version.t @@ -11,8 +11,8 @@ use warnings ; use Test::More ; -BEGIN -{ +BEGIN +{ # use Test::NoWarnings, if available my $extra = 0 ; $extra = 1 @@ -20,13 +20,13 @@ BEGIN plan tests => 2 + $extra ; - use_ok('Compress::Zlib', 2) ; + use_ok('Compress::Zlib', 2) ; } # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; my $zlib_h = ZLIB_VERSION ; my $libz = Compress::Zlib::zlib_version; @@ -35,10 +35,10 @@ SKIP: { or diag < 1} ) ) ; ok $x ; ok $err == Z_OK ; - + my $Answer = ''; foreach (@hello) { @@ -158,20 +158,20 @@ foreach (@hello) $Answer .= $X ; } - + ok $status == Z_OK ; ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - - + + my @Answer = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; ok $k ; ok $err == Z_OK ; - + my $GOT = ''; my $Z; foreach (@Answer) @@ -179,9 +179,9 @@ foreach (@Answer) ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; @@ -190,11 +190,11 @@ title 'deflate/inflate - small buffer with a number'; # ============================== $hello = 6529 ; - + ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; ok $x ; ok $err == Z_OK ; - + ok !defined $x->msg() ; ok $x->total_in() == 0 ; ok $x->total_out() == 0 ; @@ -204,19 +204,19 @@ $Answer = ''; $Answer .= $X ; } - + ok $status == Z_OK ; ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + ok !defined $x->msg() ; ok $x->total_in() == length $hello ; ok $x->total_out() == length $Answer ; - + @Answer = split('', $Answer) ; - + ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; ok $k ; ok $err == Z_OK ; @@ -224,16 +224,16 @@ ok $err == Z_OK ; ok !defined $k->msg() ; ok $k->total_in() == 0 ; ok $k->total_out() == 0 ; - + $GOT = ''; foreach (@Answer) { ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; @@ -242,27 +242,27 @@ is $k->total_in(), length $Answer ; ok $k->total_out() == length $hello ; - + title 'deflate/inflate - larger buffer'; # ============================== ok $x = deflateInit() ; - + ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ; my $Y = $X ; - - + + ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; $Y .= $X ; - - - + + + ok $k = inflateInit() ; - + ($Z, $status) = $k->inflate($Y) ; - + ok $status == Z_STREAM_END ; ok $contents eq $Z ; @@ -272,7 +272,7 @@ title 'deflate/inflate - preset dictionary'; my $dictionary = "hello" ; ok $x = deflateInit({-Level => Z_BEST_COMPRESSION, -Dictionary => $dictionary}) ; - + my $dictID = $x->dict_adler() ; ($X, $status) = $x->deflate($hello) ; @@ -281,9 +281,9 @@ ok $status == Z_OK ; ok $status == Z_OK ; $X .= $Y ; $x = 0 ; - + ok $k = inflateInit(-Dictionary => $dictionary) ; - + ($Z, $status) = $k->inflate($X); ok $status == Z_STREAM_END ; ok $k->dict_adler() == $dictID; @@ -296,7 +296,7 @@ ok $hello eq $Z ; #print "status=[$status] hello=[$hello] Z=[$Z]\n"; #} #ok $status == Z_STREAM_END ; -#ok $hello eq $Z +#ok $hello eq $Z # or print "status=[$status] hello=[$hello] Z=[$Z]\n"; @@ -306,19 +306,19 @@ ok $hello eq $Z ; title 'inflate - check remaining buffer after Z_STREAM_END'; # =================================================== - + { ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ; - + ($X, $status) = $x->deflate($hello) ; ok $status == Z_OK ; ($Y, $status) = $x->flush() ; ok $status == Z_OK ; $X .= $Y ; $x = 0 ; - + ok $k = inflateInit() ; - + my $first = substr($X, 0, 2) ; my $last = substr($X, 2) ; ($Z, $status) = $k->inflate($first); @@ -337,9 +337,9 @@ title 'inflate - check remaining buffer after Z_STREAM_END'; title 'memGzip & memGunzip'; { my ($name, $name1, $name2, $name3); - my $lex = new LexFile $name, $name1, $name2, $name3 ; + my $lex = LexFile->new( $name, $name1, $name2, $name3 ); my $buffer = <gzread($uncomp, 0), 0 ; ok (($x = $fil->gzread($uncomp)) == $len) ; - + ok ! $fil->gzclose ; ok $uncomp eq $buffer ; - + #1 while unlink $name ; # now check that memGunzip can deal with it. @@ -376,10 +376,10 @@ EOM ok defined $ungzip ; ok $buffer eq $ungzip ; is $gzerrno, 0; - - # now do the same but use a reference - $dest = memGzip(\$buffer) ; + # now do the same but use a reference + + $dest = memGzip(\$buffer) ; ok length $dest ; is $gzerrno, 0; @@ -391,13 +391,13 @@ EOM # uncompress with gzopen ok $fil = gzopen($name1, "rb") ; - + ok (($x = $fil->gzread($uncomp)) == $len) ; - + ok ! $fil->gzclose ; ok $uncomp eq $buffer ; - + # now check that memGunzip can deal with it. my $keep = $dest; $ungzip = memGunzip(\$dest) ; @@ -459,7 +459,7 @@ EOM ok ! defined $ungzip ; cmp_ok $gzerrno, "==", Z_DATA_ERROR ; - + #1 while unlink $name ; # check corrupt header -- too short @@ -520,7 +520,7 @@ EOM { title "Check all bytes can be handled"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data = join '', map { chr } 0x00 .. 0xFF; $data .= "\r\nabd\r\n"; @@ -548,7 +548,7 @@ title 'memGunzip with a gzopen created file'; { my $name = "test.gz" ; my $buffer = < 1, -WindowBits => -MAX_WBITS() ) ) ; ok $x ; ok $err == Z_OK ; - + $Answer = ''; foreach (@hello) { ($X, $status) = $x->deflate($_) ; last unless $status == Z_OK ; - + $Answer .= $X ; } - + ok $status == Z_OK ; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - - + + @Answer = split('', $Answer) ; - # Undocumented corner -- extra byte needed to get inflate to return - # Z_STREAM_END when done. - push @Answer, " " ; - + # Undocumented corner -- extra byte needed to get inflate to return + # Z_STREAM_END when done. + push @Answer, " " ; + ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ; ok $k ; ok $err == Z_OK ; - + $GOT = ''; foreach (@Answer) { ($Z, $status) = $k->inflate($_) ; $GOT .= $Z ; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + ok $status == Z_STREAM_END ; ok $GOT eq $hello ; - + } { @@ -626,32 +626,32 @@ EOM my $hello = "I am a HAL 9000 computer" x 2001 ; my $goodbye = "Will I dream?" x 2010; my ($err, $answer, $X, $status, $Answer); - + ok (($x, $err) = deflateInit() ) ; ok $x ; ok $err == Z_OK ; - + ($Answer, $status) = $x->deflate($hello) ; ok $status == Z_OK ; - + # create a flush point ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ; $Answer .= $X ; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + my ($first, @Answer) = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($first) ; ok $status == Z_OK ; @@ -661,11 +661,11 @@ EOM my $byte = shift @Answer; $status = $k->inflateSync($byte) ; last unless $status == Z_DATA_ERROR; - + } ok $status == Z_OK; - + my $GOT = ''; my $Z = ''; foreach (@Answer) @@ -675,9 +675,9 @@ EOM $GOT .= $Z if defined $Z ; # print "x $status\n"; last if $status == Z_STREAM_END or $status != Z_OK ; - + } - + # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ; ok $GOT eq $goodbye ; @@ -687,19 +687,19 @@ EOM $Answer =~ /^(.)(.*)$/ ; my ($initial, $rest) = ($1, $2); - + ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($initial) ; ok $status == Z_OK ; $status = $k->inflateSync($rest) ; ok $status == Z_OK; - + ($GOT, $status) = $k->inflate($rest) ; - + ok $status == Z_DATA_ERROR ; ok $Z . $GOT eq $goodbye ; } @@ -710,7 +710,7 @@ EOM my $hello = "I am a HAL 9000 computer" x 2001 ; my $goodbye = "Will I dream?" x 2010; my ($input, $err, $answer, $X, $status, $Answer); - + ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION, -Strategy => Z_DEFAULT_STRATEGY) ) ; ok $x ; @@ -718,11 +718,11 @@ EOM ok $x->get_Level() == Z_BEST_COMPRESSION; ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; - + ($Answer, $status) = $x->deflate($hello) ; ok $status == Z_OK ; $input .= $hello; - + # error cases eval { $x->deflateParams() }; #like $@, mkErr("^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy"); @@ -736,56 +736,56 @@ EOM ok $x->get_Level() == Z_BEST_COMPRESSION; ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; - + # change both Level & Strategy $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_BEST_SPEED; ok $x->get_Strategy() == Z_HUFFMAN_ONLY; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - - # change only Level + + # change only Level $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_NO_COMPRESSION; ok $x->get_Strategy() == Z_HUFFMAN_ONLY; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - + # change only Strategy $status = $x->deflateParams(-Strategy => Z_FILTERED) ; ok $status == Z_OK ; - + ok $x->get_Level() == Z_NO_COMPRESSION; ok $x->get_Strategy() == Z_FILTERED; - + ($X, $status) = $x->deflate($goodbye) ; ok $status == Z_OK ; $Answer .= $X ; $input .= $goodbye; - + ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; $Answer .= $X ; - + my ($first, @Answer) = split('', $Answer) ; - + my $k; ok (($k, $err) = inflateInit()) ; ok $k ; ok $err == Z_OK ; - + ($Z, $status) = $k->inflate($Answer) ; - ok $status == Z_STREAM_END + ok $status == Z_STREAM_END or print "# status $status\n"; ok $Z eq $input ; } @@ -840,28 +840,28 @@ if ($] >= 5.005) # test inflate with a substr ok my $x = deflateInit() ; - + ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ; - + my $Y = $X ; - - + + ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; $Y .= $X ; - + my $append = "Appended" ; $Y .= $append ; - + ok $k = inflateInit() ; - + #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ; ($Z, $status) = $k->inflate(substr($Y, 0)) ; - + ok $status == Z_STREAM_END ; ok $contents eq $Z ; is $Y, $append; - + } if ($] >= 5.005) @@ -869,27 +869,27 @@ if ($] >= 5.005) # deflate/inflate in scalar context ok my $x = deflateInit() ; - + my $X = $x->deflate($contents); - + my $Y = $X ; - - + + $X = $x->flush(); $Y .= $X ; - + my $append = "Appended" ; $Y .= $append ; - + ok $k = inflateInit() ; - + $Z = $k->inflate(substr($Y, 0, -1)) ; #$Z = $k->inflate(substr($Y, 0)) ; - + ok $contents eq $Z ; is $Y, $append; - + } { @@ -897,8 +897,8 @@ if ($] >= 5.005) # CRC32 of this data should have the high bit set # value in ascii is ZgRNtjgSUW - my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; - my $expected_crc = 0xCF707A2B ; # 3480255019 + my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; + my $expected_crc = 0xCF707A2B ; # 3480255019 my $crc = crc32($data) ; is $crc, $expected_crc; @@ -912,7 +912,7 @@ if ($] >= 5.005) my $data = "\x6c\x70\x73\x63\x4f\x56\x73\x41\x4a\x69\x55\x66" . "\x4e\x43\x6f\x6d\x6b\x4f\x66\x57\x59\x42\x63\x50" . "\x68\x48\x5a\x5b\x62\x54"; - my $expected_crc = 0xAAD60AC7 ; # 2866154183 + my $expected_crc = 0xAAD60AC7 ; # 2866154183 my $crc = adler32($data) ; is $crc, $expected_crc; } @@ -930,11 +930,11 @@ if ($] >= 5.005) ok length $compressed > 4096 ; ok my $out = memGunzip(\$compressed) ; is $gzerrno, 0; - + ok $contents eq $out ; is length $out, length $contents ; - + } @@ -946,7 +946,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, Append => 1, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -996,8 +996,8 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0, - -ExtraField => "hello" x 10 ; + ok my $x = IO::Compress::Gzip->new( \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0, + -ExtraField => "hello" x 10 ); ok $x->write($string) ; ok $x->close ; @@ -1018,7 +1018,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name; + ok my $x = IO::Compress::Gzip->new( \$truncated, Append => 1, -Name => $Name ); ok $x->write($string) ; ok $x->close ; @@ -1037,7 +1037,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; + ok my $x = IO::Compress::Gzip->new( \$truncated, -Comment => $Comment ); ok $x->write($string) ; ok $x->close ; @@ -1054,7 +1054,7 @@ some text EOM my $truncated ; - ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; + ok my $x = IO::Compress::Gzip->new( \$truncated, -HeaderCRC => 1 ); ok $x->write($string) ; ok $x->close ; @@ -1071,19 +1071,19 @@ some text EOM my $buffer ; - ok my $x = new IO::Compress::Gzip \$buffer, + ok my $x = IO::Compress::Gzip->new( \$buffer, -Append => 1, -Strict => 0, -HeaderCRC => 1, -Name => "Fred", -ExtraField => "Extra", - -Comment => 'Comment'; + -Comment => 'Comment' ); ok $x->write($string) ; ok $x->close ; ok defined $buffer ; - ok my $got = memGunzip($buffer) + ok my $got = memGunzip($buffer) or diag "gzerrno is $gzerrno" ; is $got, $string ; is $gzerrno, 0; @@ -1098,7 +1098,7 @@ some text EOM my $good ; - ok my $x = new IO::Compress::Gzip \$good, Append => 1 ; + ok my $x = IO::Compress::Gzip->new( \$good, Append => 1 ); ok $x->write($string) ; ok $x->close ; @@ -1176,7 +1176,7 @@ sub trickle title "Append & MultiStream Tests"; # rt.24041 - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data1 = "the is the first"; my $data2 = "and this is the second"; my $trailing = "some trailing data"; @@ -1185,7 +1185,7 @@ sub trickle title "One file"; $fil = gzopen($name, "wb") ; - ok $fil, "opened first file"; + ok $fil, "opened first file"; is $fil->gzwrite($data1), length $data1, "write data1" ; ok ! $fil->gzclose(), "Closed"; @@ -1194,7 +1194,7 @@ sub trickle title "Two files"; $fil = gzopen($name, "ab") ; - ok $fil, "opened second file"; + ok $fil, "opened second file"; is $fil->gzwrite($data2), length $data2, "write data2" ; ok ! $fil->gzclose(), "Closed"; @@ -1214,12 +1214,12 @@ sub trickle title "gzclose & gzflush return codes"; # rt.29215 - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $data1 = "the is some text"; my $status; $fil = gzopen($name, "wb") ; - ok $fil, "opened first file"; + ok $fil, "opened first file"; is $fil->gzwrite($data1), length $data1, "write data1" ; $status = $fil->gzflush(0xfff); ok $status, "flush not ok" ; @@ -1233,17 +1233,17 @@ sub trickle { title "repeated calls to flush - no compression"; - my ($err, $x, $X, $status, $data); - + my ($err, $x, $X, $status, $data); + ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; is $data, "", "no output from second flush"; } @@ -1251,18 +1251,18 @@ sub trickle title "repeated calls to flush - after compression"; my $hello = "I am a HAL 9000 computer" ; - my ($err, $x, $X, $status, $data); - + my ($err, $x, $X, $status, $data); + ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; cmp_ok $err, '==', Z_OK, "status is Z_OK" ; - + ($data, $status) = $x->deflate($hello) ; cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; - + ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; - cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; + cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; is $data, "", "no output from second flush"; } diff --git a/cpan/IO-Compress/t/cz-06gzsetp.t b/cpan/IO-Compress/t/cz-06gzsetp.t index b2cc687f5ab4..e45fa4d8af32 100644 --- a/cpan/IO-Compress/t/cz-06gzsetp.t +++ b/cpan/IO-Compress/t/cz-06gzsetp.t @@ -9,10 +9,10 @@ use lib qw(t t/compress); use strict; use warnings; use bytes; - + use Test::More ; use CompTestUtils; - + use Compress::Zlib 2 ; use IO::Compress::Gzip ; @@ -26,9 +26,9 @@ use IO::Uncompress::RawInflate ; our ($extra); - -BEGIN -{ + +BEGIN +{ # use Test::NoWarnings, if available $extra = 0 ; $extra = 1 @@ -43,12 +43,12 @@ plan tests => 51 + $extra ; # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; } - + { # gzsetparams title "Testing gzsetparams"; @@ -59,13 +59,13 @@ SKIP: { my $len_goodbye = length $goodbye; my ($input, $err, $answer, $X, $status, $Answer); - - my $lex = new LexFile my $name ; + + my $lex = LexFile->new( my $name ); ok my $x = gzopen($name, "wb"); $input .= $hello; is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ; - + # Error cases eval { $x->gzsetparams() }; like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)'); @@ -73,14 +73,14 @@ SKIP: { # Change both Level & Strategy $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; cmp_ok $status, '==', Z_OK, "status is Z_OK"; - + $input .= $goodbye; is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ; - + ok ! $x->gzclose, "closed" ; ok my $k = gzopen($name, "rb") ; - + # calling gzsetparams on reading is not allowed. $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ; @@ -116,29 +116,29 @@ foreach my $CompressClass ('IO::Compress::Gzip', #my ($input, $err, $answer, $X, $status, $Answer); my $compressed; - ok my $x = new $CompressClass(\$compressed) ; + ok my $x = $CompressClass->can('new')->( $CompressClass, \$compressed) ; my $input .= $hello; is $x->write($hello), $len_hello, "wrote $len_hello bytes" ; - + # Change both Level & Strategy ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok"; $input .= $goodbye; is $x->write($goodbye), $len_goodbye, "wrote $len_goodbye bytes" ; - + ok $x->close, "closed $CompressClass object" ; - my $k = new $UncompressClass(\$compressed); + my $k = $UncompressClass->can('new')->( $UncompressClass, \$compressed); isa_ok $k, $UncompressClass; - + my $len = length $input ; my $uncompressed; - is $k->read($uncompressed, $len), $len + is $k->read($uncompressed, $len), $len or diag "$IO::Uncompress::Gunzip::GunzipError" ; - ok $uncompressed eq $input, "got expected uncompressed data" - or diag("unc len = " . length($uncompressed) . ", input len = " . + ok $uncompressed eq $input, "got expected uncompressed data" + or diag("unc len = " . length($uncompressed) . ", input len = " . length($input) . "\n") ; ok $k->eof, "eof" ; ok $k->close, "closed" ; diff --git a/cpan/IO-Compress/t/cz-08encoding.t b/cpan/IO-Compress/t/cz-08encoding.t index ed5971bc8acb..951efa44b513 100644 --- a/cpan/IO-Compress/t/cz-08encoding.t +++ b/cpan/IO-Compress/t/cz-08encoding.t @@ -38,7 +38,7 @@ BEGIN # Check zlib_version and ZLIB_VERSION are the same. SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; @@ -47,13 +47,13 @@ SKIP: { { title "memGzip" ; # length of this string is 2 characters - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $cs = memGzip(Encode::encode_utf8($s)); # length stored at end of gzip file should be 4 my ($crc, $len) = unpack ("VV", substr($cs, -8, 8)); - + is $len, 4, " length is 4"; } @@ -65,7 +65,7 @@ SKIP: { is memGunzip(my $x = $co), $s, " match uncompressed"; utf8::upgrade($co); - + my $un = memGunzip($co); ok $un, " got uncompressed"; @@ -75,7 +75,7 @@ SKIP: { { title "compress/uncompress"; - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $s_copy = $s ; my $ces = compress(Encode::encode_utf8($s_copy)); @@ -84,21 +84,21 @@ SKIP: { my $un = Encode::decode_utf8(uncompress($ces)); is $un, $s, " decode_utf8 ok"; - + utf8::upgrade($ces); $un = Encode::decode_utf8(uncompress($ces)); is $un, $s, " decode_utf8 ok"; - + } { title "gzopen" ; - my $s = "\x{df}\x{100}"; + my $s = "\x{df}\x{100}"; my $byte_len = length( Encode::encode_utf8($s) ); my ($uncomp) ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, " wrote $byte_len bytes" ; @@ -131,7 +131,7 @@ SKIP: { eval { uncompress($a) }; like($@, qr/Wide character in uncompress/, " wide characters in uncompress"); - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; eval { $fil->gzwrite($a); } ; @@ -139,4 +139,3 @@ SKIP: { ok ! $fil->gzclose, " gzclose ok" ; } - diff --git a/cpan/IO-Compress/t/cz-14gzopen.t b/cpan/IO-Compress/t/cz-14gzopen.t index 3d6a0626ee7c..59a4d82bec07 100644 --- a/cpan/IO-Compress/t/cz-14gzopen.t +++ b/cpan/IO-Compress/t/cz-14gzopen.t @@ -28,156 +28,156 @@ BEGIN { { SKIP: { - skip "TEST_SKIP_VERSION_CHECK is set", 1 + skip "TEST_SKIP_VERSION_CHECK is set", 1 if $ENV{TEST_SKIP_VERSION_CHECK}; # Check zlib_version and ZLIB_VERSION are the same. is Compress::Zlib::zlib_version, ZLIB_VERSION, "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; } } - + { # gzip tests #=========== - + #my $name = "test.gz" ; - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my $hello = <gzerror(), 0, "gzerror() returned 0"; - + is $fil->gztell(), 0, "gztell returned 0"; is $gzerrno, 0, 'gzerrno is 0'; - + is $fil->gzwrite($hello), $len ; is $gzerrno, 0, 'gzerrno is 0'; - + is $fil->gztell(), $len, "gztell returned $len"; is $gzerrno, 0, 'gzerrno is 0'; - + ok ! $fil->gzclose ; - + ok $fil = gzopen($name, "rb") ; - + ok ! $fil->gzeof() ; is $gzerrno, 0, 'gzerrno is 0'; is $fil->gztell(), 0; - - is $fil->gzread($uncomp), $len; - + + is $fil->gzread($uncomp), $len; + is $fil->gztell(), $len; ok $fil->gzeof() ; - + # gzread after eof bahavior - + my $xyz = "123" ; is $fil->gzread($xyz), 0, "gzread returns 0 on eof" ; is $xyz, "", "gzread on eof zaps the output buffer [Match 1,x behavior]" ; - + ok ! $fil->gzclose ; ok $fil->gzeof() ; - + ok $hello eq $uncomp ; } { title 'check that a number can be gzipped'; - my $lex = new LexFile my $name ; - - + my $lex = LexFile->new( my $name ); + + my $number = 7603 ; my $num_len = 4 ; - + ok my $fil = gzopen($name, "wb") ; - + is $gzerrno, 0; - + is $fil->gzwrite($number), $num_len, "gzwrite returned $num_len" ; is $gzerrno, 0, 'gzerrno is 0'; ok ! $fil->gzflush(Z_FINISH) ; - + is $gzerrno, 0, 'gzerrno is 0'; - + ok ! $fil->gzclose ; - + cmp_ok $gzerrno, '==', 0; - + ok $fil = gzopen($name, "rb") ; - + my $uncomp; ok ((my $x = $fil->gzread($uncomp)) == $num_len) ; - + ok $fil->gzerror() == 0 || $fil->gzerror() == Z_STREAM_END; ok $gzerrno == 0 || $gzerrno == Z_STREAM_END; ok $fil->gzeof() ; - + ok ! $fil->gzclose ; ok $fil->gzeof() ; - + ok $gzerrno == 0 or print "# gzerrno is $gzerrno\n" ; - + 1 while unlink $name ; - + ok $number == $uncomp ; ok $number eq $uncomp ; } { title "now a bigger gzip test"; - + my $text = 'text' ; - my $lex = new LexFile my $file ; - - + my $lex = LexFile->new( my $file ); + + ok my $f = gzopen($file, "wb") ; - + # generate a long random string my $contents = '' ; foreach (1 .. 5000) { $contents .= chr int rand 256 } - + my $len = length $contents ; - + is $f->gzwrite($contents), $len ; - + ok ! $f->gzclose ; - + ok $f = gzopen($file, "rb") ; - + ok ! $f->gzeof() ; - + my $uncompressed ; is $f->gzread($uncompressed, $len), $len ; - - is $contents, $uncompressed - - or print "# Length orig $len" . + + is $contents, $uncompressed + + or print "# Length orig $len" . ", Length uncompressed " . length($uncompressed) . "\n" ; - + ok $f->gzeof() ; ok ! $f->gzclose ; - + } { title "gzip - readline tests"; # ====================== - + # first create a small gzipped text file - my $lex = new LexFile my $name ; - + my $lex = LexFile->new( my $name ); + my @text = (<gzwrite($text), length($text) ; ok ! $fil->gzclose ; - + # now try to read it back in ok $fil = gzopen($name, "rb") ; ok ! $fil->gzeof() ; @@ -204,15 +204,15 @@ EOM is $line, $text[$i] ; ok ! $fil->gzeof() ; } - + # now read the last line ok $fil->gzreadline($line) > 0; is $line, $text[-1] ; ok $fil->gzeof() ; - + # read past the eof is $fil->gzreadline($line), 0; - + ok $fil->gzeof() ; ok ! $fil->gzclose ; ok $fil->gzeof() ; @@ -220,7 +220,7 @@ EOM { title "A text file with a very long line (bigger than the internal buffer)"; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ; my $line2 = "second line\n" ; @@ -228,7 +228,7 @@ EOM ok my $fil = gzopen($name, "wb"), " gzopen ok" ; is $fil->gzwrite($text), length $text, " gzwrite ok" ; ok ! $fil->gzclose, " gzclose" ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), " gzopen" ; ok ! $fil->gzeof(), "! eof" ; @@ -236,13 +236,13 @@ EOM my @got = (); my $line; while ($fil->gzreadline($line) > 0) { - $got[$i] = $line ; + $got[$i] = $line ; ++ $i ; } is $i, 2, " looped twice" ; is $got[0], $line1, " got line 1" ; is $got[1], $line2, " hot line 2" ; - + ok $fil->gzeof(), " gzeof" ; ok ! $fil->gzclose, " gzclose" ; ok $fil->gzeof(), " gzeof" ; @@ -250,30 +250,30 @@ EOM { title "a text file which is not terminated by an EOL"; - - my $lex = new LexFile my $name ; - + + my $lex = LexFile->new( my $name ); + my $line1 = "hello hello, I'm back again\n" ; my $line2 = "there is no end in sight" ; - + my $text = $line1 . $line2 ; ok my $fil = gzopen($name, "wb"), " gzopen" ; is $fil->gzwrite($text), length $text, " gzwrite" ; ok ! $fil->gzclose, " gzclose" ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), " gzopen" ; - my @got = () ; + my @got = () ; my $i = 0 ; my $line; while ($fil->gzreadline($line) > 0) { - $got[$i] = $line ; + $got[$i] = $line ; ++ $i ; } is $i, 2, " got 2 lines" ; is $got[0], $line1, " line 1 ok" ; is $got[1], $line2, " line 2 ok" ; - + ok $fil->gzeof(), " gzeof" ; ok ! $fil->gzclose, " gzclose" ; } @@ -281,23 +281,23 @@ EOM { title 'mix gzread and gzreadline'; - + # case 1: read a line, then a block. The block is # smaller than the internal block used by # gzreadline - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $line1 = "hello hello, I'm back again\n" ; - my $line2 = "abc" x 200 ; + my $line2 = "abc" x 200 ; my $line3 = "def" x 200 ; my $line; - + my $text = $line1 . $line2 . $line3 ; my $fil; ok $fil = gzopen($name, "wb"), ' gzopen for write ok' ; is $fil->gzwrite($text), length $text, ' gzwrite ok' ; is $fil->gztell(), length $text, ' gztell ok' ; ok ! $fil->gzclose, ' gzclose ok' ; - + # now try to read it back in ok $fil = gzopen($name, "rb"), ' gzopen for read ok' ; ok ! $fil->gzeof(), ' !gzeof' ; @@ -319,12 +319,12 @@ EOM { title "Pass gzopen a filehandle - use IO::File" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; - my $f = new IO::File ">$name" ; + my $f = IO::File->new( ">$name" ); ok $f; my $fil; @@ -334,11 +334,11 @@ EOM ok ! $fil->gzclose ; - $f = new IO::File "<$name" ; + $f = IO::File->new( "<$name" ); ok $fil = gzopen($name, "rb") ; my $uncomp; my $x; - ok (($x = $fil->gzread($uncomp)) == $len) + ok (($x = $fil->gzread($uncomp)) == $len) or print "# length $x, expected $len\n" ; ok $fil->gzeof() ; @@ -352,7 +352,7 @@ EOM { title "Pass gzopen a filehandle - use open" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; @@ -389,7 +389,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) title "Pass gzopen a filehandle - use $stdin" ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $hello = "hello" ; my $len = length $hello ; @@ -397,12 +397,12 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) ok open(SAVEOUT, ">&STDOUT"), " save STDOUT"; my $dummy = fileno SAVEOUT; ok open(STDOUT, ">$name"), " redirect STDOUT" ; - + my $status = 0 ; my $fil = gzopen($stdout, "wb") ; - $status = $fil && + $status = $fil && ($fil->gzwrite($hello) == $len) && ($fil->gzclose == 0) ; @@ -417,7 +417,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) ok $fil = gzopen($stdin, "rb") ; my $uncomp; my $x; - ok (($x = $fil->gzread($uncomp)) == $len) + ok (($x = $fil->gzread($uncomp)) == $len) or print "# length $x, expected $len\n" ; ok $fil->gzeof() ; @@ -433,7 +433,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'test parameters for gzopen'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $fil; @@ -462,7 +462,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'Read operations when opened for writing'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $fil; ok $fil = gzopen($name, "wb"), ' gzopen for writing' ; ok !$fil->gzeof(), ' !eof'; ; @@ -473,7 +473,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'write operations when opened for reading'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $text = "hello" ; my $fil; ok $fil = gzopen($name, "wb"), " gzopen for writing" ; @@ -489,22 +489,22 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) SKIP: { - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if $^O eq 'cygwin'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); writeFile($name, "abc"); - chmod 0444, $name + chmod 0444, $name or skip "Cannot create non-writable file", 3 ; - skip "Cannot create non-writable file", 3 + skip "Cannot create non-writable file", 3 if -w $name ; ok ! -w $name, " input file not writable"; my $fil = gzopen($name, "wb") ; ok !$fil, " gzopen returns undef" ; - ok $gzerrno, " gzerrno ok" or + ok $gzerrno, " gzerrno ok" or diag " gzerrno $gzerrno\n"; chmod 0777, $name ; @@ -512,14 +512,14 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) SKIP: { - my $lex = new LexFile my $name ; - skip "Cannot create non-readable file", 3 + my $lex = LexFile->new( my $name ); + skip "Cannot create non-readable file", 3 if $^O eq 'cygwin'; writeFile($name, "abc"); chmod 0222, $name ; - skip "Cannot create non-readable file", 3 + skip "Cannot create non-readable file", 3 if -r $name ; ok ! -r $name, " input file not readable"; @@ -536,7 +536,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) title "gzseek" ; my $buff ; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $first = "beginning" ; my $last = "the end" ; @@ -580,11 +580,11 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { # seek error cases - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); - ok ! $a->gzerror() + ok ! $a->gzerror() or print "# gzerrno is $Compress::Zlib::gzerrno \n" ; eval { $a->gzseek(-1, 10) ; }; like $@, mkErr("gzseek: unknown value, 10, for whence parameter"); @@ -610,7 +610,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title "gzread ver 1.x compat -- the output buffer is always zapped."; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); $a->gzwrite("fred"); @@ -632,7 +632,7 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzreadline does not support $/'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); my $a = gzopen($name, "w"); my $text = "fred\n"; @@ -656,12 +656,12 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzflush called twice with Z_SYNC_FLUSH - no compression'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $a = gzopen($name, "w"); - + + is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; - is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; } @@ -669,13 +669,13 @@ foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) { title 'gzflush called twice - after compression'; - my $lex = new LexFile my $name ; + my $lex = LexFile->new( my $name ); ok my $a = gzopen($name, "w"); my $text = "fred\n"; my $len = length $text; is $a->gzwrite($text), length($text), "gzwrite ok"; - + + is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; - is $a->gzflush(Z_SYNC_FLUSH), Z_OK, "gzflush returns Z_OK"; } diff --git a/cpan/IO-Compress/t/globmapper.t b/cpan/IO-Compress/t/globmapper.t index 0c60aa6b21d2..c97beb610a35 100644 --- a/cpan/IO-Compress/t/globmapper.t +++ b/cpan/IO-Compress/t/globmapper.t @@ -13,8 +13,8 @@ use Test::More ; use CompTestUtils; -BEGIN -{ +BEGIN +{ plan(skip_all => "File::GlobMapper needs Perl 5.005 or better - you have Perl $]" ) if $] < 5.005 ; @@ -26,7 +26,7 @@ Perl $]" ) plan tests => 68 + $extra ; - use_ok('File::GlobMapper') ; + use_ok('File::GlobMapper') ; } { @@ -36,21 +36,21 @@ Perl $]" ) for my $delim ( qw/ ( ) { } [ ] / ) { - $gm = new File::GlobMapper("${delim}abc", '*.X'); + $gm = File::GlobMapper->new("${delim}abc", '*.X'); ok ! $gm, " new failed" ; - is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", + is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", " catch unmatched $delim"; } for my $delim ( qw/ ( ) [ ] / ) { - $gm = new File::GlobMapper("{${delim}abc}", '*.X'); + $gm = File::GlobMapper->new("{${delim}abc}", '*.X'); ok ! $gm, " new failed" ; - is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", + is $File::GlobMapper::Error, "Unmatched $delim in input fileglob", " catch unmatched $delim inside {}"; } - + } { @@ -58,10 +58,10 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); my $d = quotemeta $tmpDir; - my $gm = new File::GlobMapper("$d/Z*", '*.X'); + my $gm = File::GlobMapper->new("$d/Z*", '*.X'); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -77,12 +77,12 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/ab*.tmp", "*X"); + my $gm = File::GlobMapper->new("$tmpDir/ab*.tmp", "*X"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -106,12 +106,12 @@ Perl $]" ) #my $tmpDir = 'td'; my $tmpDir ; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp"); + my $gm = File::GlobMapper->new("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -130,12 +130,12 @@ Perl $]" ) title 'test wildcard mapping of {} in destination'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "*.X"); + my $gm = File::GlobMapper->new("$tmpDir/abc{1,3}.tmp", "*.X"); #diag "Input pattern is $gm->{InputPattern}"; ok $gm, " created GlobMapper object" ; @@ -146,7 +146,7 @@ Perl $]" ) [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmp.X)], ], " got mapping"; - $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X") + $gm = File::GlobMapper->new("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X") or diag $File::GlobMapper::Error ; #diag "Input pattern is $gm->{InputPattern}"; ok $gm, " created GlobMapper object" ; @@ -165,13 +165,13 @@ Perl $]" ) title 'test wildcard mapping of multiple * to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X"); - ok $gm, " created GlobMapper object" + my $gm = File::GlobMapper->new("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X"); + ok $gm, " created GlobMapper object" or diag $File::GlobMapper::Error ; my $map = $gm->getFileMap() ; @@ -187,12 +187,12 @@ Perl $]" ) title 'test wildcard mapping of multiple ? to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X"); + my $gm = File::GlobMapper->new("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X"); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -208,12 +208,12 @@ Perl $]" ) title 'test wildcard mapping of multiple ?,* and [] to #'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; - my $gm = new File::GlobMapper("$tmpDir/?b[a-z]*.tmp", "$tmpDir/X-#3-#2-#1-X"); + my $gm = File::GlobMapper->new("$tmpDir/?b[a-z]*.tmp", "$tmpDir/X-#3-#2-#1-X"); ok $gm, " created GlobMapper object" ; #diag "Input pattern is $gm->{InputPattern}"; @@ -230,12 +230,12 @@ Perl $]" ) title 'input glob matches a file multiple times'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch "$tmpDir/abc.tmp"; - my $gm = new File::GlobMapper("$tmpDir/{a*,*c}.tmp", '*.X'); + my $gm = File::GlobMapper->new("$tmpDir/{a*,*c}.tmp", '*.X'); ok $gm, " created GlobMapper object" ; my $map = $gm->getFileMap() ; @@ -253,12 +253,12 @@ Perl $]" ) title 'multiple input files map to one output file'; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc def) ; - my $gm = new File::GlobMapper("$tmpDir/*.tmp", "$tmpDir/fred"); + my $gm = File::GlobMapper->new("$tmpDir/*.tmp", "$tmpDir/fred"); ok ! $gm, " did not create GlobMapper object" ; is $File::GlobMapper::Error, 'multiple input files map to one output file', " Error is expected" ; @@ -273,13 +273,13 @@ Perl $]" ) title "globmap" ; my $tmpDir ;#= 'td'; - my $lex = new LexDir $tmpDir; + my $lex = LexDir->new( $tmpDir ); #mkdir $tmpDir, 0777 ; touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ; my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-#2-#1-X"); - ok $map, " got map" + ok $map, " got map" or diag $File::GlobMapper::Error ; is @{ $map }, 3, " returned 3 maps"; @@ -305,4 +305,3 @@ Perl $]" ) # {} and {,} are special cases # {ab*,de*} # {abc,{},{de,f}} => abc {} de f - From b1846e36c303aefcfd6b0560936088badcbab8e0 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Mon, 18 Jan 2021 02:39:46 +0000 Subject: [PATCH 439/503] Upgrade Socket from 2.030 to 2.031 --- Porting/Maintainers.pl | 2 +- cpan/Socket/Makefile.PL | 6 +- cpan/Socket/Socket.pm | 26 +++-- cpan/Socket/Socket.xs | 37 +++++-- cpan/Socket/t/sockaddr.t | 28 +++-- cpan/Socket/t/socketpair.t | 205 +++++++++++++++++++------------------ 6 files changed, 174 insertions(+), 130 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index ab5ab5e313d9..49cf75a29972 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -1002,7 +1002,7 @@ package Maintainers; }, 'Socket' => { - 'DISTRIBUTION' => 'PEVANS/Socket-2.030.tar.gz', + 'DISTRIBUTION' => 'PEVANS/Socket-2.031.tar.gz', 'FILES' => q[cpan/Socket], }, diff --git a/cpan/Socket/Makefile.PL b/cpan/Socket/Makefile.PL index b69f50c9c789..3250737ac94d 100644 --- a/cpan/Socket/Makefile.PL +++ b/cpan/Socket/Makefile.PL @@ -170,8 +170,7 @@ my @names = ( AF_WAN AF_X25 AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN - AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST - AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED + AI_NUMERICHOST AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM @@ -198,8 +197,7 @@ my @names = ( MSG_MCAST MSG_NOSIGNAL MSG_RST MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE - NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES - NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV + NI_DGRAM NI_IDN NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6 diff --git a/cpan/Socket/Socket.pm b/cpan/Socket/Socket.pm index f156699d0516..fe47ef67ec0a 100644 --- a/cpan/Socket/Socket.pm +++ b/cpan/Socket/Socket.pm @@ -3,7 +3,7 @@ package Socket; use strict; { use v5.6.1; } -our $VERSION = '2.030'; +our $VERSION = '2.031'; =head1 NAME @@ -110,7 +110,7 @@ level. =head2 IP_PMTUDISC_WANT, IP_PMTUDISC_DONT, ... -Socket option value contants for C socket option. +Socket option value constants for C socket option. =head2 IPTOS_LOWDELAY, IPTOS_THROUGHPUT, IPTOS_RELIABILITY, ... @@ -837,6 +837,14 @@ BEGIN { *LF = \LF(); *CRLF = \CRLF(); +# The four deprecated addrinfo constants +foreach my $name (qw( AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES )) { + no strict 'refs'; + *$name = sub { + croak "The addrinfo constant $name is deprecated"; + }; +} + sub sockaddr_in { if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die my($af, $port, @quad) = @_; @@ -916,13 +924,9 @@ if( defined &getaddrinfo ) { # Constants we don't support. Export them, but croak if anyone tries to # use them - AI_IDN => 64, - AI_CANONIDN => 128, - AI_IDN_ALLOW_UNASSIGNED => 256, - AI_IDN_USE_STD3_ASCII_RULES => 512, - NI_IDN => 32, - NI_IDN_ALLOW_UNASSIGNED => 64, - NI_IDN_USE_STD3_ASCII_RULES => 128, + AI_IDN => 64, + AI_CANONIDN => 128, + NI_IDN => 32, # Error constants we'll never return, so it doesn't matter what value # these have, nor that we don't provide strings for them @@ -992,7 +996,7 @@ sub fake_getaddrinfo # to talk AF_INET. If not we'd have to return no addresses at all. :) $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG()); - $flags & (AI_IDN()|AI_CANONIDN()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) and + $flags & (AI_IDN()|AI_CANONIDN()) and croak "Socket::getaddrinfo() does not support IDN"; $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); @@ -1090,7 +1094,7 @@ sub fake_getnameinfo my $flag_namereqd = $flags & NI_NAMEREQD(); $flags &= ~NI_NAMEREQD(); my $flag_dgram = $flags & NI_DGRAM() ; $flags &= ~NI_DGRAM(); - $flags & (NI_IDN()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) and + $flags & NI_IDN() and croak "Socket::getnameinfo() does not support IDN"; $flags == 0 or return fake_makeerr( EAI_BADFLAGS() ); diff --git a/cpan/Socket/Socket.xs b/cpan/Socket/Socket.xs index e46c93e17192..31ffdf0670b9 100644 --- a/cpan/Socket/Socket.xs +++ b/cpan/Socket/Socket.xs @@ -764,20 +764,33 @@ inet_aton(host) char * host CODE: { +#ifdef HAS_GETADDRINFO + struct addrinfo *res; + struct addrinfo hints = {0}; + hints.ai_family = AF_INET; + if (!getaddrinfo(host, NULL, &hints, &res)) { + ST(0) = sv_2mortal(newSVpvn( + (char *)&(((struct sockaddr_in *)res->ai_addr)->sin_addr.s_addr), + 4)); + freeaddrinfo(res); + XSRETURN(1); + } +#else struct in_addr ip_address; struct hostent * phe; - if ((*host != '\0') && inet_aton(host, &ip_address)) { ST(0) = sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address))); XSRETURN(1); } #ifdef HAS_GETHOSTBYNAME + /* gethostbyname is not thread-safe */ phe = gethostbyname(host); if (phe && phe->h_addrtype == AF_INET && phe->h_length == 4) { ST(0) = sv_2mortal(newSVpvn((char *)phe->h_addr, phe->h_length)); XSRETURN(1); } -#endif +#endif /* HAS_GETHOSTBYNAME */ +#endif /* HAS_GETADDRINFO */ XSRETURN_UNDEF; } @@ -794,10 +807,10 @@ inet_ntoa(ip_address_sv) ip_address = SvPVbyte(ip_address_sv, addrlen); if (addrlen == sizeof(addr) || addrlen == 4) addr.s_addr = - (ip_address[0] & 0xFF) << 24 | - (ip_address[1] & 0xFF) << 16 | - (ip_address[2] & 0xFF) << 8 | - (ip_address[3] & 0xFF); + (unsigned long)(ip_address[0] & 0xFF) << 24 | + (unsigned long)(ip_address[1] & 0xFF) << 16 | + (unsigned long)(ip_address[2] & 0xFF) << 8 | + (unsigned long)(ip_address[3] & 0xFF); else croak("Bad arg length for %s, length is %" UVuf ", should be %" UVuf, @@ -974,8 +987,12 @@ pack_sockaddr_in(port_sv, ip_address_sv) STRLEN addrlen; unsigned short port = 0; char * ip_address; - if (SvOK(port_sv)) + if (SvOK(port_sv)) { port = SvUV(port_sv); + if (SvUV(port_sv) > 0xFFFF) + warn("Port number above 0xFFFF, will be truncated to %d for %s", + port, "Socket::pack_sockaddr_in"); + } if (!SvOK(ip_address_sv)) croak("Undefined address for %s", "Socket::pack_sockaddr_in"); if (DO_UTF8(ip_address_sv) && !sv_utf8_downgrade(ip_address_sv, 1)) @@ -1049,8 +1066,12 @@ pack_sockaddr_in6(port_sv, sin6_addr, scope_id=0, flowinfo=0) struct sockaddr_in6 sin6; char * addrbytes; STRLEN addrlen; - if (SvOK(port_sv)) + if (SvOK(port_sv)) { port = SvUV(port_sv); + if (SvUV(port_sv) > 0xFFFF) + warn("Port number above 0xFFFF, will be truncated to %d for %s", + port, "Socket::pack_sockaddr_in6"); + } if (!SvOK(sin6_addr)) croak("Undefined address for %s", "Socket::pack_sockaddr_in6"); if (DO_UTF8(sin6_addr) && !sv_utf8_downgrade(sin6_addr, 1)) diff --git a/cpan/Socket/t/sockaddr.t b/cpan/Socket/t/sockaddr.t index 395d96af7fbd..b95d2c296150 100644 --- a/cpan/Socket/t/sockaddr.t +++ b/cpan/Socket/t/sockaddr.t @@ -12,7 +12,7 @@ use Socket qw( sockaddr_family sockaddr_un ); -use Test::More tests => 46; +use Test::More tests => 50; # inet_aton, inet_ntoa { @@ -83,8 +83,8 @@ SKIP: { is(sockaddr_family(scalar sockaddr_in(200,v10.30.50.70)), AF_INET, 'sockaddr_in in scalar context packs'); - my $warnings = 0; - local $SIG{__WARN__} = sub { $warnings++ }; + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; ok( !eval { pack_sockaddr_in 0, undef; 1 }, 'pack_sockaddr_in undef addr is fatal' ); ok( !eval { unpack_sockaddr_in undef; 1 }, @@ -93,14 +93,19 @@ SKIP: { ok( eval { pack_sockaddr_in undef, "\0\0\0\0"; 1 }, 'pack_sockaddr_in undef port is allowed' ); - is( $warnings, 0, 'undefined values produced no warnings' ); + is( $warnings, "", 'undefined values produced no warnings' ); + + ok( eval { pack_sockaddr_in 98765, "\0\0\0\0"; 1 }, + 'pack_sockaddr_in oversized port is allowed' ); + like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in at /, + 'pack_sockaddr_in oversized port warning' ); } # pack_sockaddr_in6, unpack_sockaddr_in6 # sockaddr_in6 SKIP: { - skip "No AF_INET6", 13 unless my $AF_INET6 = eval { Socket::AF_INET6() }; - skip "Cannot pack_sockaddr_in6()", 13 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; + skip "No AF_INET6", 15 unless my $AF_INET6 = eval { Socket::AF_INET6() }; + skip "Cannot pack_sockaddr_in6()", 15 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; ok(defined $sin6, 'pack_sockaddr_in6 defined'); @@ -119,8 +124,8 @@ SKIP: { is(sockaddr_family(scalar Socket::sockaddr_in6(0x1357, "02468ace13579bdf")), $AF_INET6, 'sockaddr_in6 in scalar context packs' ); - my $warnings = 0; - local $SIG{__WARN__} = sub { $warnings++ }; + my $warnings = ""; + local $SIG{__WARN__} = sub { $warnings .= $_[0]; }; ok( !eval { Socket::pack_sockaddr_in6( 0, undef ); 1 }, 'pack_sockaddr_in6 undef addr is fatal' ); ok( !eval { Socket::unpack_sockaddr_in6( undef ); 1 }, @@ -129,7 +134,12 @@ SKIP: { ok( eval { Socket::pack_sockaddr_in6( undef, "\0"x16 ); 1 }, 'pack_sockaddr_in6 undef port is allowed' ); - is( $warnings, 0, 'undefined values produced no warnings' ); + is( $warnings, "", 'undefined values produced no warnings' ); + + ok( eval { Socket::pack_sockaddr_in6( 98765, "\0"x16 ); 1 }, + 'pack_sockaddr_in6 oversized port is allowed' ); + like( $warnings, qr/^Port number above 0xFFFF, will be truncated to 33229 for Socket::pack_sockaddr_in6 at /, + 'pack_sockaddr_in6 oversized port warning' ); } # sockaddr_un on abstract paths diff --git a/cpan/Socket/t/socketpair.t b/cpan/Socket/t/socketpair.t index 29c5f74ccebd..a803302db93f 100644 --- a/cpan/Socket/t/socketpair.t +++ b/cpan/Socket/t/socketpair.t @@ -68,8 +68,9 @@ if( !$Config{d_alarm} ) { } elsif( !$can_fork ) { plan skip_all => "fork() not implemented on this platform"; } else { + my ($lefth, $righth); # This should fail but not die if there is real socketpair - eval {socketpair LEFT, RIGHT, -1, -1, -1}; + eval {socketpair $lefth, $righth, -1, -1, -1}; if ($@ =~ /^Unsupported socket function "socketpair" called/ || $! =~ /^The operation requested is not supported./) { # Stratus VOS plan skip_all => 'No socketpair (real or emulated)'; @@ -86,90 +87,95 @@ if( !$Config{d_alarm} ) { # But we'll install an alarm handler in case any of the races below fail. $SIG{ALRM} = sub {die "Unexpected alarm during testing"}; -ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC), - "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_STREAM, PF_UNSPEC)") - or print STDERR "# \$\! = $!\n"; - -if ($has_perlio) { - binmode(LEFT, ":bytes"); - binmode(RIGHT, ":bytes"); -} - my @left = ("hello ", "world\n"); my @right = ("perl ", "rules!"); # Not like I'm trying to bias any survey here. -foreach (@left) { - # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); - is (syswrite (LEFT, $_), length $_, "syswrite to left"); -} -foreach (@right) { - # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); -} - -# stream socket, so our writes will become joined: -my ($buffer, $expect); -$expect = join '', @right; -undef $buffer; -is (read (LEFT, $buffer, length $expect), length $expect, "read on left"); -is ($buffer, $expect, "content what we expected?"); -$expect = join '', @left; -undef $buffer; -is (read (RIGHT, $buffer, length $expect), length $expect, "read on right"); -is ($buffer, $expect, "content what we expected?"); - -ok (shutdown(LEFT, SHUT_WR), "shutdown left for writing"); -# This will hang forever if eof is buggy, and alarm doesn't interrupt system -# Calls. Hence the child process minder. -SKIP: { - skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/; - local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" }; - local $TODO = "Known problems with unix sockets on $^O" - if $^O eq 'hpux' || $^O eq 'super-ux'; - alarm 3; - $! = 0; - ok (eof RIGHT, "right is at EOF"); - local $TODO = "Known problems with unix sockets on $^O" - if $^O eq 'unicos' || $^O eq 'unicosmk'; - is ($!, '', 'and $! should report no error'); - alarm 60; -} +my @gripping = (chr 255, chr 127); -my $err = $!; -$SIG{PIPE} = 'IGNORE'; -{ - local $SIG{ALRM} = - sub { warn "syswrite to left didn't fail within 3 seconds" }; - alarm 3; - # Split the system call from the is() - is() does IO so - # (say) a flush may do a seek which on a pipe may disturb errno - my $ans = syswrite (LEFT, "void"); - $err = $!; - is ($ans, undef, "syswrite to shutdown left should fail"); - alarm 60; -} { - # This may need skipping on some OSes - restoring value saved above - # should help - $! = $err; - ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN') - or printf STDERR "# \$\! = %d (%s)\n", $err, $err; -} + my ($lefth, $righth); -my @gripping = (chr 255, chr 127); -foreach (@gripping) { - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); -} + ok (socketpair ($lefth, $righth, AF_UNIX, SOCK_STREAM, PF_UNSPEC), + "socketpair (\$lefth, \$righth, AF_UNIX, SOCK_STREAM, PF_UNSPEC)") + or print STDERR "# \$\! = $!\n"; + + if ($has_perlio) { + binmode($lefth, ":bytes"); + binmode($righth, ":bytes"); + } + + foreach (@left) { + # is (syswrite ($lefth, $_), length $_, "write " . _qq ($_) . " to left"); + is (syswrite ($lefth, $_), length $_, "syswrite to left"); + } + foreach (@right) { + # is (syswrite ($righth, $_), length $_, "write " . _qq ($_) . " to right"); + is (syswrite ($righth, $_), length $_, "syswrite to right"); + } + + # stream socket, so our writes will become joined: + my ($buffer, $expect); + $expect = join '', @right; + undef $buffer; + is (read ($lefth, $buffer, length $expect), length $expect, "read on left"); + is ($buffer, $expect, "content what we expected?"); + $expect = join '', @left; + undef $buffer; + is (read ($righth, $buffer, length $expect), length $expect, "read on right"); + is ($buffer, $expect, "content what we expected?"); + + ok (shutdown($lefth, SHUT_WR), "shutdown left for writing"); + # This will hang forever if eof is buggy, and alarm doesn't interrupt system + # Calls. Hence the child process minder. + SKIP: { + skip "SCO Unixware / OSR have a bug with shutdown",2 if $^O =~ /^(?:svr|sco)/; + local $SIG{ALRM} = sub { warn "EOF on right took over 3 seconds" }; + local $TODO = "Known problems with unix sockets on $^O" + if $^O eq 'hpux' || $^O eq 'super-ux'; + alarm 3; + $! = 0; + ok (eof $righth, "right is at EOF"); + local $TODO = "Known problems with unix sockets on $^O" + if $^O eq 'unicos' || $^O eq 'unicosmk'; + is ($!, '', 'and $! should report no error'); + alarm 60; + } + + my $err = $!; + $SIG{PIPE} = 'IGNORE'; + { + local $SIG{ALRM} = + sub { warn "syswrite to left didn't fail within 3 seconds" }; + alarm 3; + # Split the system call from the is() - is() does IO so + # (say) a flush may do a seek which on a pipe may disturb errno + my $ans = syswrite ($lefth, "void"); + $err = $!; + is ($ans, undef, "syswrite to shutdown left should fail"); + alarm 60; + } + { + # This may need skipping on some OSes - restoring value saved above + # should help + $! = $err; + ok (($!{EPIPE} or $!{ESHUTDOWN}), '$! should be EPIPE or ESHUTDOWN') + or printf STDERR "# \$\! = %d (%s)\n", $err, $err; + } + + foreach (@gripping) { + is (syswrite ($righth, $_), length $_, "syswrite to right"); + } -ok (!eof LEFT, "left is not at EOF"); + ok (!eof $lefth, "left is not at EOF"); -$expect = join '', @gripping; -undef $buffer; -is (read (LEFT, $buffer, length $expect), length $expect, "read on left"); -is ($buffer, $expect, "content what we expected?"); + $expect = join '', @gripping; + undef $buffer; + is (read ($lefth, $buffer, length $expect), length $expect, "read on left"); + is ($buffer, $expect, "content what we expected?"); -ok (close LEFT, "close left"); -ok (close RIGHT, "close right"); + ok (close $lefth, "close left"); + ok (close $righth, "close right"); +} # And now datagrams @@ -177,44 +183,49 @@ ok (close RIGHT, "close right"); # guarantee that the stack won't drop a UDP packet, even if it is for localhost. SKIP: { - skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/); skip "alarm doesn't interrupt I/O on this Perl", 24 if "$]" < 5.008; + + my $success = socketpair my $lefth, my $righth, AF_UNIX, SOCK_DGRAM, PF_UNSPEC; + + skip "No useable SOCK_DGRAM for socketpair", 24 if !$success and + ($!{EAFNOSUPPORT} or $!{EOPNOTSUPP} or $!{EPROTONOSUPPORT} or $!{EPROTOTYPE}); + # Maybe this test is redundant now? + skip "No usable SOCK_DGRAM for socketpair", 24 if ($^O =~ /^(MSWin32|os2)\z/); local $TODO = "socketpair not supported on $^O" if $^O eq 'nto'; - ok (socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC), - "socketpair (LEFT, RIGHT, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)") + ok ($success, "socketpair (\$left, \$righth, AF_UNIX, SOCK_DGRAM, PF_UNSPEC)") or print STDERR "# \$\! = $!\n"; if ($has_perlio) { - binmode(LEFT, ":bytes"); - binmode(RIGHT, ":bytes"); + binmode($lefth, ":bytes"); + binmode($righth, ":bytes"); } foreach (@left) { - # is (syswrite (LEFT, $_), length $_, "write " . _qq ($_) . " to left"); - is (syswrite (LEFT, $_), length $_, "syswrite to left"); + # is (syswrite ($lefth, $_), length $_, "write " . _qq ($_) . " to left"); + is (syswrite ($lefth, $_), length $_, "syswrite to left"); } foreach (@right) { - # is (syswrite (RIGHT, $_), length $_, "write " . _qq ($_) . " to right"); - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + # is (syswrite ($righth, $_), length $_, "write " . _qq ($_) . " to right"); + is (syswrite ($righth, $_), length $_, "syswrite to right"); } # stream socket, so our writes will become joined: - my ($total); + my ($total, $buffer); $total = join '', @right; - foreach $expect (@right) { + foreach my $expect (@right) { undef $buffer; - is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); + is (sysread ($lefth, $buffer, length $total), length $expect, "read on left"); is ($buffer, $expect, "content what we expected?"); } $total = join '', @left; - foreach $expect (@left) { + foreach my $expect (@left) { undef $buffer; - is (sysread (RIGHT, $buffer, length $total), length $expect, "read on right"); + is (sysread ($righth, $buffer, length $total), length $expect, "read on right"); is ($buffer, $expect, "content what we expected?"); } - ok (shutdown(LEFT, 1), "shutdown left for writing"); + ok (shutdown($lefth, 1), "shutdown left for writing"); # eof uses buffering. eof is indicated by a sysread of zero. # but for a datagram socket there's no way it can know nothing will ever be @@ -227,7 +238,7 @@ SKIP: { print "# Approximate forever as 3 seconds. Wait 'forever'...\n"; alarm 3; undef $buffer; - is (sysread (RIGHT, $buffer, 1), undef, + is (sysread ($righth, $buffer, 1), undef, "read on right should be interrupted"); is ($alarmed, 1, "alarm should have fired"); } @@ -235,18 +246,18 @@ SKIP: { alarm 30; foreach (@gripping) { - is (syswrite (RIGHT, $_), length $_, "syswrite to right"); + is (syswrite ($righth, $_), length $_, "syswrite to right"); } $total = join '', @gripping; - foreach $expect (@gripping) { + foreach my $expect (@gripping) { undef $buffer; - is (sysread (LEFT, $buffer, length $total), length $expect, "read on left"); + is (sysread ($lefth, $buffer, length $total), length $expect, "read on left"); is ($buffer, $expect, "content what we expected?"); } - ok (close LEFT, "close left"); - ok (close RIGHT, "close right"); + ok (close $lefth, "close left"); + ok (close $righth, "close right"); } # end of DGRAM SKIP From fecc0102dc276d1350aabfcdf4942d81c5620c7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20B=C3=B6hmer?= Date: Mon, 18 Jan 2021 06:52:27 +0100 Subject: [PATCH 440/503] Fix POD for $Carp::RefArgFormatter - Data::Dumper::Dump() MUST be called as class method - indent example for code markup Also added myself to AUTHORS as requested: Ran './Porting/checkAUTHORS.pl --update --from=v5.30.0' and fixed the entry by hand because of broken Unicode chars. --- AUTHORS | 1 + dist/Carp/lib/Carp.pm | 10 +++++----- dist/Carp/lib/Carp/Heavy.pm | 2 +- 3 files changed, 7 insertions(+), 6 deletions(-) diff --git a/AUTHORS b/AUTHORS index c084ef712ac2..226b3eb1184e 100644 --- a/AUTHORS +++ b/AUTHORS @@ -295,6 +295,7 @@ Dan Kogai Dan Schmidt Dan Sugalski Daniel Berger +Daniel Böhmer Daniel Chetlin Daniel Dragan Daniel Frederick Crisman diff --git a/dist/Carp/lib/Carp.pm b/dist/Carp/lib/Carp.pm index 941f59db4b07..df563d06a251 100644 --- a/dist/Carp/lib/Carp.pm +++ b/dist/Carp/lib/Carp.pm @@ -211,7 +211,7 @@ BEGIN { } -our $VERSION = '1.51'; +our $VERSION = '1.52'; $VERSION =~ tr/_//d; our $MaxEvalLen = 0; @@ -944,10 +944,10 @@ This variable sets a general argument formatter to display references. Plain scalars and objects that implement C will not go through this formatter. Calling C from within this function is not supported. -local $Carp::RefArgFormatter = sub { - require Data::Dumper; - Data::Dumper::Dump($_[0]); # not necessarily safe -}; + local $Carp::RefArgFormatter = sub { + require Data::Dumper; + Data::Dumper->Dump($_[0]); # not necessarily safe + }; =head2 @CARP_NOT diff --git a/dist/Carp/lib/Carp/Heavy.pm b/dist/Carp/lib/Carp/Heavy.pm index 028d2a206e99..fdb3e52ef616 100644 --- a/dist/Carp/lib/Carp/Heavy.pm +++ b/dist/Carp/lib/Carp/Heavy.pm @@ -2,7 +2,7 @@ package Carp::Heavy; use Carp (); -our $VERSION = '1.51'; +our $VERSION = '1.52'; $VERSION =~ tr/_//d; # Carp::Heavy was merged into Carp in version 1.12. Any mismatched versions From 6258b1f37458b7c3a69678f721e12eea6a1b2b4e Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 19 Jan 2021 01:18:11 +0000 Subject: [PATCH 441/503] Upgrade libnet from 3.12 to 3.13 --- Porting/Maintainers.pl | 2 +- cpan/libnet/Makefile.PL | 2 +- cpan/libnet/lib/Net/Cmd.pm | 32 +++++++---------------------- cpan/libnet/lib/Net/Config.pm | 6 +++--- cpan/libnet/lib/Net/Domain.pm | 6 +++--- cpan/libnet/lib/Net/FTP.pm | 6 +++--- cpan/libnet/lib/Net/FTP/A.pm | 2 +- cpan/libnet/lib/Net/FTP/E.pm | 2 +- cpan/libnet/lib/Net/FTP/I.pm | 2 +- cpan/libnet/lib/Net/FTP/L.pm | 2 +- cpan/libnet/lib/Net/FTP/dataconn.pm | 6 +++--- cpan/libnet/lib/Net/NNTP.pm | 6 +++--- cpan/libnet/lib/Net/Netrc.pm | 6 +++--- cpan/libnet/lib/Net/POP3.pm | 6 +++--- cpan/libnet/lib/Net/SMTP.pm | 6 +++--- cpan/libnet/lib/Net/Time.pm | 6 +++--- 16 files changed, 40 insertions(+), 58 deletions(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 49cf75a29972..209d2180019f 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -692,7 +692,7 @@ package Maintainers; }, 'libnet' => { - 'DISTRIBUTION' => 'SHAY/libnet-3.12.tar.gz', + 'DISTRIBUTION' => 'SHAY/libnet-3.13.tar.gz', 'FILES' => q[cpan/libnet], 'EXCLUDED' => [ qw( Configure diff --git a/cpan/libnet/Makefile.PL b/cpan/libnet/Makefile.PL index 477739068d28..df525269b217 100644 --- a/cpan/libnet/Makefile.PL +++ b/cpan/libnet/Makefile.PL @@ -66,7 +66,7 @@ MAIN: { ABSTRACT => 'Collection of network protocol modules', AUTHOR => 'Graham Barr , Steve Hay ', LICENSE => 'perl_5', - VERSION => '3.12', + VERSION => '3.13', META_MERGE => { 'meta-spec' => { diff --git a/cpan/libnet/lib/Net/Cmd.pm b/cpan/libnet/lib/Net/Cmd.pm index 650f23be96f9..41df8a264ac7 100644 --- a/cpan/libnet/lib/Net/Cmd.pm +++ b/cpan/libnet/lib/Net/Cmd.pm @@ -26,7 +26,7 @@ BEGIN { } } -our $VERSION = "3.12"; +our $VERSION = "3.13"; our @ISA = qw(Exporter); our @EXPORT = qw(CMD_INFO CMD_OK CMD_MORE CMD_REJECT CMD_ERROR CMD_PENDING); @@ -335,19 +335,15 @@ sub getline { my $rin = ""; vec($rin, $fd, 1) = 1; - my $timeout = $cmd->timeout || undef; - my $initial = time; - my $pending = $timeout; - my $buf; until (scalar(@{${*$cmd}{'net_cmd_lines'}})) { + my $timeout = $cmd->timeout || undef; my $rout; - my $select_ret = select($rout = $rin, undef, undef, $pending); - if (defined $select_ret and $select_ret > 0) { - my $r = sysread($cmd, $buf = "", 1024); - if (! defined($r) ) { + my $select_ret = select($rout = $rin, undef, undef, $timeout); + if ($select_ret > 0) { + unless (sysread($cmd, $buf = "", 1024)) { my $err = $!; $cmd->close; $cmd->_set_status_closed($err); @@ -363,20 +359,6 @@ sub getline { push(@{${*$cmd}{'net_cmd_lines'}}, map {"$_\n"} @buf); } - elsif (defined $select_ret && $select_ret == -1) { - if ( $! == EINTR ) { - if ( defined($timeout) ) { - redo if ($pending = $timeout - ( time - $initial ) ) > 0; - $cmd->_set_status_timeout; - return; - } - redo; - } - my $err = $!; - $cmd->close; - $cmd->_set_status_closed($err); - return; - } else { $cmd->_set_status_timeout; return; @@ -915,11 +897,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/Config.pm b/cpan/libnet/lib/Net/Config.pm index 365cb49b16c9..2f8417f01a59 100644 --- a/cpan/libnet/lib/Net/Config.pm +++ b/cpan/libnet/lib/Net/Config.pm @@ -18,7 +18,7 @@ use Socket qw(inet_aton inet_ntoa); our @EXPORT = qw(%NetConfig); our @ISA = qw(Net::LocalCfg Exporter); -our $VERSION = "3.12"; +our $VERSION = "3.13"; our($CONFIGURE, $LIBNET_CFG); @@ -368,11 +368,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/Domain.pm b/cpan/libnet/lib/Net/Domain.pm index f4c93eafdbb1..d69ac5ba8051 100644 --- a/cpan/libnet/lib/Net/Domain.pm +++ b/cpan/libnet/lib/Net/Domain.pm @@ -19,7 +19,7 @@ use Net::Config; our @ISA = qw(Exporter); our @EXPORT_OK = qw(hostname hostdomain hostfqdn domainname); -our $VERSION = "3.12"; +our $VERSION = "3.13"; my ($host, $domain, $fqdn) = (undef, undef, undef); @@ -395,11 +395,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/FTP.pm b/cpan/libnet/lib/Net/FTP.pm index b195c9c92cfa..37836bf6578b 100644 --- a/cpan/libnet/lib/Net/FTP.pm +++ b/cpan/libnet/lib/Net/FTP.pm @@ -23,7 +23,7 @@ use Net::Config; use Socket; use Time::Local; -our $VERSION = '3.12'; +our $VERSION = '3.13'; our $IOCLASS; my $family_key; @@ -2044,11 +2044,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/FTP/A.pm b/cpan/libnet/lib/Net/FTP/A.pm index f22c974ba9c1..53446386c180 100644 --- a/cpan/libnet/lib/Net/FTP/A.pm +++ b/cpan/libnet/lib/Net/FTP/A.pm @@ -13,7 +13,7 @@ use Carp; use Net::FTP::dataconn; our @ISA = qw(Net::FTP::dataconn); -our $VERSION = "3.12"; +our $VERSION = "3.13"; our $buf; diff --git a/cpan/libnet/lib/Net/FTP/E.pm b/cpan/libnet/lib/Net/FTP/E.pm index df281c05b9e6..9b1370778a8d 100644 --- a/cpan/libnet/lib/Net/FTP/E.pm +++ b/cpan/libnet/lib/Net/FTP/E.pm @@ -8,6 +8,6 @@ use warnings; use Net::FTP::I; our @ISA = qw(Net::FTP::I); -our $VERSION = "3.12"; +our $VERSION = "3.13"; 1; diff --git a/cpan/libnet/lib/Net/FTP/I.pm b/cpan/libnet/lib/Net/FTP/I.pm index 8f85e0e1cf3d..726cba197c33 100644 --- a/cpan/libnet/lib/Net/FTP/I.pm +++ b/cpan/libnet/lib/Net/FTP/I.pm @@ -13,7 +13,7 @@ use Carp; use Net::FTP::dataconn; our @ISA = qw(Net::FTP::dataconn); -our $VERSION = "3.12"; +our $VERSION = "3.13"; our $buf; diff --git a/cpan/libnet/lib/Net/FTP/L.pm b/cpan/libnet/lib/Net/FTP/L.pm index 9eda6107d1d2..ac5e27ebadcd 100644 --- a/cpan/libnet/lib/Net/FTP/L.pm +++ b/cpan/libnet/lib/Net/FTP/L.pm @@ -8,6 +8,6 @@ use warnings; use Net::FTP::I; our @ISA = qw(Net::FTP::I); -our $VERSION = "3.12"; +our $VERSION = "3.13"; 1; diff --git a/cpan/libnet/lib/Net/FTP/dataconn.pm b/cpan/libnet/lib/Net/FTP/dataconn.pm index 51e9c2f2d295..5a257e677ffa 100644 --- a/cpan/libnet/lib/Net/FTP/dataconn.pm +++ b/cpan/libnet/lib/Net/FTP/dataconn.pm @@ -13,7 +13,7 @@ use Carp; use Errno; use Net::Cmd; -our $VERSION = '3.12'; +our $VERSION = '3.13'; $Net::FTP::IOCLASS or die "please load Net::FTP before Net::FTP::dataconn"; our @ISA = $Net::FTP::IOCLASS; @@ -224,11 +224,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/NNTP.pm b/cpan/libnet/lib/Net/NNTP.pm index 9289b59432cc..3187f519619f 100644 --- a/cpan/libnet/lib/Net/NNTP.pm +++ b/cpan/libnet/lib/Net/NNTP.pm @@ -19,7 +19,7 @@ use Net::Cmd; use Net::Config; use Time::Local; -our $VERSION = "3.12"; +our $VERSION = "3.13"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -1308,11 +1308,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/Netrc.pm b/cpan/libnet/lib/Net/Netrc.pm index b66eb82d8b7f..50688eefd62f 100644 --- a/cpan/libnet/lib/Net/Netrc.pm +++ b/cpan/libnet/lib/Net/Netrc.pm @@ -16,7 +16,7 @@ use warnings; use Carp; use FileHandle; -our $VERSION = "3.12"; +our $VERSION = "3.13"; our $TESTING; @@ -353,11 +353,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/POP3.pm b/cpan/libnet/lib/Net/POP3.pm index fb442ad3c1cc..55f7be1342e3 100644 --- a/cpan/libnet/lib/Net/POP3.pm +++ b/cpan/libnet/lib/Net/POP3.pm @@ -18,7 +18,7 @@ use IO::Socket; use Net::Cmd; use Net::Config; -our $VERSION = "3.12"; +our $VERSION = "3.13"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -869,11 +869,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/SMTP.pm b/cpan/libnet/lib/Net/SMTP.pm index fd81d0be9757..354ed8e38f32 100644 --- a/cpan/libnet/lib/Net/SMTP.pm +++ b/cpan/libnet/lib/Net/SMTP.pm @@ -19,7 +19,7 @@ use Net::Cmd; use Net::Config; use Socket; -our $VERSION = "3.12"; +our $VERSION = "3.13"; # Code for detecting if we can use SSL my $ssl_class = eval { @@ -1052,11 +1052,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY diff --git a/cpan/libnet/lib/Net/Time.pm b/cpan/libnet/lib/Net/Time.pm index 4ce1daf120a2..7f0a724cd3a4 100644 --- a/cpan/libnet/lib/Net/Time.pm +++ b/cpan/libnet/lib/Net/Time.pm @@ -22,7 +22,7 @@ use Net::Config; our @ISA = qw(Exporter); our @EXPORT_OK = qw(inet_time inet_daytime); -our $VERSION = "3.12"; +our $VERSION = "3.13"; our $TIMEOUT = 120; @@ -190,11 +190,11 @@ License or the Artistic License, as specified in the F file. =head1 VERSION -Version 3.12 +Version 3.13 =head1 DATE -09 Dec 2020 +23 Dec 2020 =head1 HISTORY From 7365f8f7fa7940e5e4422c10fc07c18aa0447ee3 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 23 Dec 2020 20:48:48 -0700 Subject: [PATCH 442/503] perlxs.pod; rpc is considered obsolete --- dist/ExtUtils-ParseXS/lib/perlxs.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/dist/ExtUtils-ParseXS/lib/perlxs.pod b/dist/ExtUtils-ParseXS/lib/perlxs.pod index 2dfbf7df40fb..4a339ddfd998 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxs.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxs.pod @@ -2103,8 +2103,8 @@ File C: Interface to some ONC+ RPC bind library functions. #include "perl.h" #include "XSUB.h" - /* On some systems this should be */ - #include + /* Note: On glibc 2.13 and earlier, this needs be */ + #include typedef struct netconfig Netconfig; From a650715adfa56c4a6ae98b801bda0eed3ca30aa3 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 19 Jan 2021 22:56:06 +0000 Subject: [PATCH 443/503] Non-final updates to perldelta.pod ahead of 5.33.6 --- pod/perldelta.pod | 344 ++++++++++++---------------------------------- 1 file changed, 88 insertions(+), 256 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index de73568d74b0..007a03660263 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,177 +2,79 @@ =head1 NAME -[ this is a template for a new perldelta file. Any text flagged as XXX needs -to be processed before release. ] - perldelta - what is new for perl v5.33.6 =head1 DESCRIPTION -This document describes differences between the 5.33.5 release and the 5.33.6 -release. +This document describes differences between the 5.33.5 release and the +5.33.6 release. If you are upgrading from an earlier release such as 5.33.4, first read L, which describes differences between 5.33.4 and 5.33.5. -=head1 Notice - -XXX Any important notices here - -=head1 Core Enhancements - -XXX New core language features go here. Summarize user-visible core language -enhancements. Particularly prominent performance optimisations could go -here, but most should go in the L section. - -[ List each enhancement as a =head2 entry ] - -=head1 Security - -XXX Any security-related notices go here. In particular, any security -vulnerabilities closed should be noted here rather than in the -L section. - -[ List each security issue as a =head2 entry ] - -=head1 Incompatible Changes - -XXX For a release on a stable branch, this section aspires to be: - - There are no changes intentionally incompatible with 5.XXX.XXX - If any exist, they are bugs, and we request that you submit a - report. See L below. - -[ List each incompatible change as a =head2 entry ] - -=head1 Deprecations - -XXX Any deprecated features, syntax, modules etc. should be listed here. - -=head2 Module removals - -XXX Remove this section if not applicable. - -The following modules will be removed from the core distribution in a -future release, and will at that time need to be installed from CPAN. -Distributions on CPAN which require these modules will need to list them as -prerequisites. - -The core versions of these modules will now issue C<"deprecated">-category -warnings to alert you to this fact. To silence these deprecation warnings, -install the modules in question from CPAN. - -Note that these are (with rare exceptions) fine modules that you are encouraged -to continue to use. Their disinclusion from core primarily hinges on their -necessity to bootstrapping a fully functional, CPAN-capable Perl installation, -not usually on concerns over their design. - -=over - -=item XXX - -XXX Note that deprecated modules should be listed here even if they are listed -as an updated module in the L section. - -=back - -[ List each other deprecation as a =head2 entry ] - -=head1 Performance Enhancements - -XXX Changes which enhance performance without changing behaviour go here. -There may well be none in a stable release. +=head1 Modules and Pragmata -[ List each enhancement as an =item entry ] +=head2 Updated Modules and Pragmata =over 4 =item * -XXX +L has been upgraded from version 1.61 to 1.62. -=back +Added the default enabled C feature. -=head1 Modules and Pragmata +=back -XXX All changes to installed files in F, F, F and F -go here. If Module::CoreList is updated, generate an initial draft of the -following sections using F. A paragraph summary -for important changes should then be added by hand. In an ideal world, -dual-life modules would have a F file that could be cribbed. +=head1 Documentation -The list of new and updated modules is modified automatically as part of -preparing a Perl release, so the only reason to manually add entries here is if -you're summarising the important changes in the module update. (Also, if the -manually-added details don't match the automatically-generated ones, the -release manager will have to investigate the situation carefully.) +=head2 New Documentation -[ Within each section, list entries as an =item entry ] +=head3 L -=head2 New Modules and Pragmata +This document describes the goals, scope, system, and rules for Perl's new +governance model. -=over 4 +Other pod files, most notably L, were amended to reflect +its adoption. -=item * +=head2 Changes to Existing Documentation -XXX Remove this section if not applicable. +We have attempted to update the documentation to reflect the changes +listed in this document. If you find any we have missed, open an issue +at L. -=back +Additionally, the following selected changes have been made: -=head2 Updated Modules and Pragmata +=head3 L =over 4 =item * -L has been upgraded from version 1.61 to 1.62. - -Added the default enabled C feature. +The freenode IRC URL has been updated. =back -=head2 Removed Modules and Pragmata +=head3 L =over 4 =item * -XXX +The L entry has been improved and now +also states that the result of the function is always in English. =back -=head1 Documentation - -XXX Changes to files in F go here. Consider grouping entries by -file and be sure to link to the appropriate page, e.g. L. - -=head2 New Documentation - -XXX Changes which create B files in F go here. - -=head3 L - -XXX Description of the purpose of the new file here - -=head2 Changes to Existing Documentation - -We have attempted to update the documentation to reflect the changes -listed in this document. If you find any we have missed, open an issue -at L. - -XXX Changes which significantly change existing files in F go here. -However, any changes to F should go in the L -section. - -Additionally, the following selected changes have been made: - -=head3 L +=head3 L =over 4 =item * -XXX Description of the change here +A new example shows how a lexical 'my' variable can be declared +during the initialization of a 'for' loop. =back @@ -182,42 +84,35 @@ The following additions or changes have been made to diagnostic output, including warnings and fatal error messages. For the complete list of diagnostic messages, see L. -XXX New or changed warnings emitted by the core's C code go here. Also -include any changes in L that reconcile it to the C code. - =head2 New Diagnostics -XXX Newly added diagnostic messages go under here, separated into New Errors -and New Warnings - =head3 New Errors =over 4 =item * -XXX L +L + +This accompanies the new L feature. =back -=head3 New Warnings +=head2 Changes to Existing Diagnostics =over 4 =item * -XXX L - -=back - -=head2 Changes to Existing Diagnostics - -XXX Changes (i.e. rewording) of diagnostic messages go here +L -=over 4 +Subroutine argument-count mismatch errors now include the number of +given and expected arguments. =item * +L + Subroutine argument-count mismatch errors now include the number of given and expected arguments. @@ -225,8 +120,8 @@ given and expected arguments. L -This warning was only issued for positive too-large values when incrementing, -and only for negative ones when decrementing. +This warning was only issued for positive too-large values when +incrementing, and only for negative ones when decrementing. It is now issued for both of positive or negative too-large values. [L] @@ -234,180 +129,117 @@ It is now issued for both of positive or negative too-large values. =head1 Utility Changes -XXX Changes to installed programs such as F and F go here. -Most of these are built within the directory F. - -[ List utility changes as a =head2 entry for each utility and =item -entries for each change -Use L with program names to get proper documentation linking. ] - -=head2 L +=head2 L =over 4 -=item * +=item * pl2bat.pl now needs access to ExtUtils::PL2Bat -XXX +This could cause failures in parallel builds. =back =head1 Configuration and Compilation -XXX Changes to F, F, F, and analogous tools -go here. Any other changes to the Perl build process should be listed here. -However, any platform-specific changes should be listed in the -L section, instead. - -[ List changes as an =item entry ]. - =over 4 -=item * +=item * Configure -XXX +A new probe tests for buggy implementations of the gcvt/qgcvt functions. +[L] =back =head1 Testing -XXX Any significant changes to the testing of a freshly built perl should be -listed here. Changes which create B files in F go here as do any -large changes to the testing harness (e.g. when parallel testing was added). -Changes to existing files in F aren't worth summarizing, although the bugs -that they represent may be covered elsewhere. - -XXX If there were no significant test changes, say this: - -Tests were added and changed to reflect the other additions and changes -in this release. - -XXX If instead there were significant changes, say this: - Tests were added and changed to reflect the other additions and changes in this release. Furthermore, these significant changes were made: -[ List each test improvement as an =item entry ] - =over 4 =item * -XXX - -=back - -=head1 Platform Support - -XXX Any changes to platform support should be listed in the sections below. - -[ Within the sections, list each platform as an =item entry with specific -changes as paragraphs below it. ] - -=head2 New Platforms - -XXX List any platforms that this version of perl compiles on, that previous -versions did not. These will either be enabled by new files in the F -directories, or new subdirectories and F files at the top level of the -source tree. +t/re/opt.t was added, providing a test harness for regexp optimization. +[L] -=over 4 - -=item XXX-some-platform +=item * -XXX +A workaround for CPAN distributions needing dot in @INC has been removed +[L]. +All distributions that previously required the workaround have now been +adapted. =back -=head2 Discontinued Platforms - -XXX List any platforms that this version of perl no longer compiles on. - -=over 4 - -=item XXX-some-platform - -XXX - -=back +=head1 Platform Support =head2 Platform-Specific Notes -XXX List any changes for specific platforms. This could include configuration -and compilation changes or changes in portability/compatibility. However, -changes within modules for platforms should generally be listed in the -L section. - =over 4 -=item XXX-some-platform - -XXX - -=back - -=head1 Internal Changes +=item Mac OS X -XXX Changes which affect the interface available to C code go here. Other -significant internal changes for future core maintainers should be noted as -well. +A number of system libraries no longer exist as actual files on Big Sur, +even though dlopen will pretend they do, so now we fall back to dlopen +if a library file can not be found. +[L] -[ List each change as an =item entry ] +=item MS Windows -=over 4 - -=item * - -XXX +perl can now be built with USE_QUADMATH on MS Windows using +(32-bit and 64-bit) mingw-w64 ports of gcc. +[L] =back =head1 Selected Bug Fixes -XXX Important bug fixes in the core language are summarized here. Bug fixes in -files in F and F are best summarized in L. - -[ List each fix as an =item entry ] - =over 4 =item * -XXX +Skip trying to constant fold an incomplete op tree +[L] -=back +Constant folding of chained comparison op trees could fail under certain +conditions, causing perl to crash. As a quick fix, constant folding is +now skipped for such op trees. This also addresses +[L]. -=head1 Known Problems +=item * -XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any -tests that had to be Ced for the release would be noted here. Unfixed -platform specific bugs also go here. +%g formatting broken on Ubuntu-18.04, NVSIZE == 8 +[L] -[ List each fix as an =item entry ] +Buggy libc implementations of the C and C functions +caused (s)printf to incorrectly truncated %g formatted numbers. A new +Configure probe now checks for this, with the result that the libc +C will be used in place of C and C. -=over 4 +Tests added as part of this fix also revealed related problems in +some Windows builds. The makefiles for MINGW builds on Windows have +thus been adjusted to use USE_MINGW_ANSI_STDIO by default, ensuring +that such builds also provide correct (s)printf formatting of numbers. =item * -XXX - -=back - -=head1 Errata From Previous Releases +op.c: croak on "my $_" when "use utf8" is in effect +[L] -=over 4 +The lexical topic () feature experiment was removed in Perl v5.24 and +declaring C became a compile time error. However, it was still +possible to make this declaration if utf8 was in effect. =item * -XXX Add anything here that we forgot to add, or were mistaken about, in -the perldelta of a previous release. - -=back +regexec.c: Fix assertion failure +[L] -=head1 Obituary +Fuzzing triggered an assertion failure when too many characters were +copied into a buffer. -XXX If any significant core contributor or member of the CPAN community has -died, add a short obituary here. +=back =head1 Acknowledgements From 4e431ee62f2d9b42dbab578efc842a76473ac80a Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Tue, 19 Jan 2021 23:09:00 +0000 Subject: [PATCH 444/503] perldelta.pod - move mention of pl2bat.pl --- pod/perldelta.pod | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 007a03660263..b7f676bea999 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -127,18 +127,6 @@ It is now issued for both of positive or negative too-large values. =back -=head1 Utility Changes - -=head2 L - -=over 4 - -=item * pl2bat.pl now needs access to ExtUtils::PL2Bat - -This could cause failures in parallel builds. - -=back - =head1 Configuration and Compilation =over 4 @@ -191,6 +179,9 @@ perl can now be built with USE_QUADMATH on MS Windows using (32-bit and 64-bit) mingw-w64 ports of gcc. [L] +THe pl2bat.pl utility now needs access to ExtUtils::PL2Bat. This could +cause failures in parallel builds. + =back =head1 Selected Bug Fixes From 27a1b63db3d47055da3bf36b5ac9f25948d0ef02 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 00:06:53 +0000 Subject: [PATCH 445/503] perldelta.pod - correct broken links --- pod/perldelta.pod | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b7f676bea999..54089b8e0b6e 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -62,7 +62,7 @@ The freenode IRC URL has been updated. =item * -The L entry has been improved and now +The L entry has been improved and now also states that the result of the function is always in English. =back @@ -92,7 +92,7 @@ diagnostic messages, see L. =item * -L +L This accompanies the new L feature. From 012ac233b0f87e11d3ffed84dbca75e927e854aa Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 07:32:25 -0700 Subject: [PATCH 446/503] perlrebackslash: A few tweaks Some white-space changes for vertical alignment, a new example, and a couple of clarifications. --- pod/perlrebackslash.pod | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/pod/perlrebackslash.pod b/pod/perlrebackslash.pod index 94fb99d96e44..9500bef527b8 100644 --- a/pod/perlrebackslash.pod +++ b/pod/perlrebackslash.pod @@ -218,7 +218,7 @@ meaning by the regex engine, and will match "as is". =head3 Octal escapes There are two forms of octal escapes. Each is used to specify a character by -its code point specified in octal notation. +its code point specified in base 8. One form, available starting in Perl 5.14 looks like C<\o{...}>, where the dots represent one or more octal digits. It can be used for any Unicode character. @@ -440,7 +440,8 @@ Mnemonic: Iroup. /(\w+) \g1/; # Finds a duplicated word, (e.g. "cat cat"). /(\w+) \1/; # Same thing; written old-style. - /(.)(.)\g2\g1/; # Match a four letter palindrome (e.g. "ABBA"). + /(\w+) \g{1}/; # Same, using the safer braced notation + /(.)(.)\g2\g1/; # Match a four letter palindrome (e.g. "ABBA"). =head3 Relative referencing @@ -480,11 +481,11 @@ hyphen. =head4 Examples - /(?\w+) \g{word}/ # Finds duplicated word, (e.g. "cat cat") - /(?\w+) \k{word}/ # Same. - /(?\w+) \k/ # Same. + /(?\w+) \g{word}/ # Finds duplicated word, (e.g. "cat cat") + /(?\w+) \k{word}/ # Same. /(?.)(?.)\g{letter2}\g{letter1}/ - # Match a four letter palindrome (e.g. "ABBA") + # Match a four letter palindrome (e.g. + # "ABBA") =head2 Assertions @@ -540,7 +541,8 @@ boundary type specified inside the braces. The boundary types are given a few paragraphs below. C<\B{...}> matches at any place between characters where C<\b{...}> of the same type doesn't match. -C<\b> when not immediately followed by a C<"{"> matches at any place +C<\b> when not immediately followed by a C<"{"> is available in all +Perls. It matches at any place between a word (something matched by C<\w>) and a non-word character (C<\W>); C<\B> when not immediately followed by a C<"{"> matches at any place between characters where C<\b> doesn't match. To get better From a7b8d88a7db0f93e2ec0bef63f0460d0d3247b10 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 15 Nov 2020 21:06:11 -0700 Subject: [PATCH 447/503] regcomp.c: Change names of 2 macros for mnemonics The new names are more understandable to me. This also adds a second parameter to one macro, that is unused until the next commit in the series. --- regcomp.c | 5255 +++++++++++++++++++++++++++-------------------------- 1 file changed, 2628 insertions(+), 2627 deletions(-) diff --git a/regcomp.c b/regcomp.c index bf9e2742ef6c..7e8425f392b7 100644 --- a/regcomp.c +++ b/regcomp.c @@ -224,11 +224,11 @@ struct RExC_state_t { regnode *end_op; /* END node in program */ I32 utf8; /* whether the pattern is utf8 or not */ I32 orig_utf8; /* whether the pattern was originally in utf8 */ - /* XXX use this for future optimisation of case - * where pattern must be upgraded to utf8. */ + /* XXX use this for future optimisation of case + * where pattern must be upgraded to utf8. */ I32 uni_semantics; /* If a d charset modifier should use unicode - rules, even if the pattern is not in - utf8 */ + rules, even if the pattern is not in + utf8 */ I32 recurse_count; /* Number of recurse regops we have generated */ regnode **recurse; /* Recurse regops */ @@ -242,7 +242,7 @@ struct RExC_state_t { I32 in_multi_char_class; int code_index; /* next code_blocks[] slot */ struct reg_code_blocks *code_blocks;/* positions of literal (?{}) - within pattern */ + within pattern */ SSize_t maxlen; /* mininum possible number of chars in string to match */ scan_frame *frame_head; scan_frame *frame_last; @@ -360,8 +360,9 @@ struct RExC_state_t { if (RExC_naughty < TOO_NAUGHTY) \ RExC_naughty += RExC_naughty / (exp) + (add) -#define ISMULT1(c) ((c) == '*' || (c) == '+' || (c) == '?') -#define ISMULT2(s) (ISMULT1(*s) || ((*s) == '{' && regcurly(s))) +#define isNON_BRACE_QUANTIFIER(c) ((c) == '*' || (c) == '+' || (c) == '?') +#define isQUANTIFIER(s,e) ( isNON_BRACE_QUANTIFIER(*s) \ + || ((*s) == '{' && regcurly(s))) /* * Flags to be passed up and down. @@ -801,23 +802,23 @@ static const scan_data_t zero_scan_data = { #define _FAIL(code) STMT_START { \ const char *ellipses = ""; \ IV len = RExC_precomp_end - RExC_precomp; \ - \ + \ PREPARE_TO_DIE; \ if (len > RegexLengthToShowInErrorMessages) { \ - /* chop 10 shorter than the max, to ensure meaning of "..." */ \ - len = RegexLengthToShowInErrorMessages - 10; \ - ellipses = "..."; \ + /* chop 10 shorter than the max, to ensure meaning of "..." */ \ + len = RegexLengthToShowInErrorMessages - 10; \ + ellipses = "..."; \ } \ code; \ } STMT_END #define FAIL(msg) _FAIL( \ Perl_croak(aTHX_ "%s in regex m/%" UTF8f "%s/", \ - msg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) + msg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) #define FAIL2(msg,arg) _FAIL( \ Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ - arg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) + arg, UTF8fARG(UTF, len, RExC_precomp), ellipses)) #define FAIL3(msg,arg1,arg2) _FAIL( \ Perl_croak(aTHX_ msg " in regex m/%" UTF8f "%s/", \ @@ -828,7 +829,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL(m) STMT_START { \ Perl_croak(aTHX_ "%s" REPORT_LOCATION, \ - m, REPORT_LOCATION_ARGS(RExC_parse)); \ + m, REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END /* @@ -861,7 +862,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL3(m, a1, a2) STMT_START { \ S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ + REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END /* @@ -877,7 +878,7 @@ static const scan_data_t zero_scan_data = { */ #define Simple_vFAIL4(m, a1, a2, a3) STMT_START { \ S_re_croak(aTHX_ UTF, m REPORT_LOCATION, a1, a2, a3, \ - REPORT_LOCATION_ARGS(RExC_parse)); \ + REPORT_LOCATION_ARGS(RExC_parse)); \ } STMT_END #define vFAIL4(m,a1,a2,a3) STMT_START { \ @@ -968,7 +969,7 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + REPORT_LOCATION_ARGS(loc))) #define vWARN(loc, m) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ @@ -980,26 +981,26 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ Perl_warner(aTHX_ packWARN(WARN_DEPRECATED), \ m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + REPORT_LOCATION_ARGS(loc))) #define ckWARNdep(loc,m) \ _WARN_HELPER(loc, packWARN(WARN_DEPRECATED), \ Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))) #define ckWARNregdep(loc,m) \ _WARN_HELPER(loc, packWARN2(WARN_DEPRECATED, WARN_REGEXP), \ Perl_ck_warner_d(aTHX_ packWARN2(WARN_DEPRECATED, \ WARN_REGEXP), \ - m REPORT_LOCATION, \ - REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + REPORT_LOCATION_ARGS(loc))) #define ckWARN2reg_d(loc,m, a1) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner_d(aTHX_ packWARN(WARN_REGEXP), \ - m REPORT_LOCATION, \ - a1, REPORT_LOCATION_ARGS(loc))) + m REPORT_LOCATION, \ + a1, REPORT_LOCATION_ARGS(loc))) #define ckWARN2reg(loc, m, a1) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ @@ -1011,34 +1012,34 @@ static const scan_data_t zero_scan_data = { _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, REPORT_LOCATION_ARGS(loc))) + a1, a2, REPORT_LOCATION_ARGS(loc))) #define ckWARN3reg(loc, m, a1, a2) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, \ + a1, a2, \ REPORT_LOCATION_ARGS(loc))) #define vWARN4(loc, m, a1, a2, a3) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) #define ckWARN4reg(loc, m, a1, a2, a3) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, \ + a1, a2, a3, \ REPORT_LOCATION_ARGS(loc))) #define vWARN5(loc, m, a1, a2, a3, a4) \ _WARN_HELPER(loc, packWARN(WARN_REGEXP), \ Perl_warner(aTHX_ packWARN(WARN_REGEXP), \ m REPORT_LOCATION, \ - a1, a2, a3, a4, \ + a1, a2, a3, a4, \ REPORT_LOCATION_ARGS(loc))) #define ckWARNexperimental(loc, class, m) \ @@ -1080,14 +1081,14 @@ static const scan_data_t zero_scan_data = { #define ProgLen(ri) ri->u.offsets[0] #define SetProgLen(ri,x) ri->u.offsets[0] = x #define Set_Node_Offset_To_R(offset,byte) STMT_START { \ - MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \ - __LINE__, (int)(offset), (int)(byte))); \ - if((offset) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Offset macro", \ + MJD_OFFSET_DEBUG(("** (%d) offset of node %d is %d.\n", \ + __LINE__, (int)(offset), (int)(byte))); \ + if((offset) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Offset macro", \ (int)(offset)); \ - } else { \ + } else { \ RExC_offsets[2*(offset)-1] = (byte); \ - } \ + } \ } STMT_END #define Set_Node_Offset(node,byte) \ @@ -1095,14 +1096,14 @@ static const scan_data_t zero_scan_data = { #define Set_Cur_Node_Offset Set_Node_Offset(RExC_emit, RExC_parse) #define Set_Node_Length_To_R(node,len) STMT_START { \ - MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \ - __LINE__, (int)(node), (int)(len))); \ - if((node) < 0) { \ - Perl_croak(aTHX_ "value of node is %d in Length macro", \ + MJD_OFFSET_DEBUG(("** (%d) size of node %d is %d.\n", \ + __LINE__, (int)(node), (int)(len))); \ + if((node) < 0) { \ + Perl_croak(aTHX_ "value of node is %d in Length macro", \ (int)(node)); \ - } else { \ - RExC_offsets[2*(node)] = (len); \ - } \ + } else { \ + RExC_offsets[2*(node)] = (len); \ + } \ } STMT_END #define Set_Node_Length(node,len) \ @@ -1476,13 +1477,13 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, if ((l >= old_l) && ((l > old_l) || (data->flags & SF_BEFORE_EOL))) { const U8 i = data->cur_is_floating; - SvSetMagicSV(longest_sv, data->last_found); + SvSetMagicSV(longest_sv, data->last_found); data->substrs[i].min_offset = l ? data->last_start_min : data->pos_min; - if (!i) /* fixed */ - data->substrs[0].max_offset = data->substrs[0].min_offset; - else { /* float */ - data->substrs[1].max_offset = + if (!i) /* fixed */ + data->substrs[0].max_offset = data->substrs[0].min_offset; + else { /* float */ + data->substrs[1].max_offset = (is_inf) ? OPTIMIZE_INFTY : (l @@ -1490,8 +1491,8 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, /* temporary underflow guard for 5.32 */ : data->pos_delta < 0 ? OPTIMIZE_INFTY : (data->pos_delta > OPTIMIZE_INFTY - data->pos_min - ? OPTIMIZE_INFTY - : data->pos_min + data->pos_delta)); + ? OPTIMIZE_INFTY + : data->pos_min + data->pos_delta)); } data->substrs[i].flags &= ~SF_BEFORE_EOL; @@ -1502,12 +1503,12 @@ S_scan_commit(pTHX_ const RExC_state_t *pRExC_state, scan_data_t *data, SvCUR_set(data->last_found, 0); { - SV * const sv = data->last_found; - if (SvUTF8(sv) && SvMAGICAL(sv)) { - MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8); - if (mg) - mg->mg_len = 0; - } + SV * const sv = data->last_found; + if (SvUTF8(sv) && SvMAGICAL(sv)) { + MAGIC * const mg = mg_find(sv, PERL_MAGIC_utf8); + if (mg) + mg->mg_len = 0; + } } data->last_end = -1; data->flags &= ~SF_BEFORE_EOL; @@ -1596,10 +1597,10 @@ S_ssc_init(pTHX_ const RExC_state_t *pRExC_state, regnode_ssc *ssc) * test cases for locale, many parts of it may not work properly, it is * safest to avoid locale unless necessary. */ if (RExC_contains_locale) { - ANYOF_POSIXL_SETALL(ssc); + ANYOF_POSIXL_SETALL(ssc); } else { - ANYOF_POSIXL_ZERO(ssc); + ANYOF_POSIXL_ZERO(ssc); } } @@ -2254,7 +2255,7 @@ S_ssc_finalize(pTHX_ RExC_state_t *pRExC_state, regnode_ssc *ssc) STATIC void S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, - AV *revcharmap, U32 depth) + AV *revcharmap, U32 depth) { U32 state; SV *sv=sv_newmortal(); @@ -2268,14 +2269,14 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, depth+1, "Match","Base","Ofs" ); for( state = 0 ; state < trie->uniquecharcount ; state++ ) { - SV ** const tmp = av_fetch( revcharmap, state, 0); + SV ** const tmp = av_fetch( revcharmap, state, 0); if ( tmp ) { Perl_re_printf( aTHX_ "%*s", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); } @@ -2288,7 +2289,7 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, Perl_re_printf( aTHX_ "\n"); for( state = 1 ; state < trie->statecount ; state++ ) { - const U32 base = trie->states[ state ].trans.base; + const U32 base = trie->states[ state ].trans.base; Perl_re_indentf( aTHX_ "#%4" UVXf "|", depth+1, (UV)state); @@ -2335,8 +2336,8 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, depth); for (word=1; word <= trie->wordcount; word++) { Perl_re_printf( aTHX_ " %d:(%d,%d)", - (int)word, (int)(trie->wordinfo[word].prev), - (int)(trie->wordinfo[word].len)); + (int)word, (int)(trie->wordinfo[word].prev), + (int)(trie->wordinfo[word].len)); } Perl_re_printf( aTHX_ "\n" ); } @@ -2348,8 +2349,8 @@ S_dump_trie(pTHX_ const struct _reg_trie_data *trie, HV *widecharmap, */ STATIC void S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, - HV *widecharmap, AV *revcharmap, U32 next_alloc, - U32 depth) + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; SV *sv=sv_newmortal(); @@ -2377,9 +2378,9 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, ); } for( charid = 1 ; charid <= TRIE_LIST_USED( state ) ; charid++ ) { - SV ** const tmp = av_fetch( revcharmap, + SV ** const tmp = av_fetch( revcharmap, TRIE_LIST_ITEM(state, charid).forid, 0); - if ( tmp ) { + if ( tmp ) { Perl_re_printf( aTHX_ "%*s:%3X=%4" UVXf " | ", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), @@ -2408,8 +2409,8 @@ S_dump_trie_interim_list(pTHX_ const struct _reg_trie_data *trie, */ STATIC void S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, - HV *widecharmap, AV *revcharmap, U32 next_alloc, - U32 depth) + HV *widecharmap, AV *revcharmap, U32 next_alloc, + U32 depth) { U32 state; U16 charid; @@ -2427,14 +2428,14 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, Perl_re_indentf( aTHX_ "Char : ", depth+1 ); for( charid = 0 ; charid < trie->uniquecharcount ; charid++ ) { - SV ** const tmp = av_fetch( revcharmap, charid, 0); + SV ** const tmp = av_fetch( revcharmap, charid, 0); if ( tmp ) { Perl_re_printf( aTHX_ "%*s", colwidth, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), colwidth, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); } @@ -2479,9 +2480,9 @@ S_dump_trie_interim_table(pTHX_ const struct _reg_trie_data *trie, /* make_trie(startbranch,first,last,tail,word_count,flags,depth) startbranch: the first branch in the whole branch sequence first : start branch of sequence of branch-exact nodes. - May be the same as startbranch + May be the same as startbranch last : Thing following the last branch. - May be the same as tail. + May be the same as tail. tail : item following the branch sequence count : words in the sequence flags : currently the OP() type we will be building one of /EXACT(|F|FA|FU|FU_SS|L|FLU8)/ @@ -2557,10 +2558,10 @@ and should turn into: 1: CURLYM[1] {1,32767}(18) 5: TRIE(16) - [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1] - - - + [Words:3 Chars Stored:6 Unique Chars:4 States:5 NCP:1] + + + 16: SUCCEED(0) 17: NOTHING(18) 18: END(0) @@ -2580,8 +2581,8 @@ and would end up looking like: 1: TRIE(8) [Words:2 Chars Stored:6 Unique Chars:5 States:7 NCP:1] - - + + 7: TAIL(8) 8: EXACT (10) 10: END(0) @@ -2595,19 +2596,19 @@ is the recommended Unicode-aware way of saying #define TRIE_STORE_REVCHAR(val) \ STMT_START { \ - if (UTF) { \ + if (UTF) { \ SV *zlopp = newSV(UTF8_MAXBYTES); \ - unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \ + unsigned char *flrbbbbb = (unsigned char *) SvPVX(zlopp); \ unsigned char *const kapow = uvchr_to_utf8(flrbbbbb, val); \ *kapow = '\0'; \ - SvCUR_set(zlopp, kapow - flrbbbbb); \ - SvPOK_on(zlopp); \ - SvUTF8_on(zlopp); \ - av_push(revcharmap, zlopp); \ - } else { \ + SvCUR_set(zlopp, kapow - flrbbbbb); \ + SvPOK_on(zlopp); \ + SvUTF8_on(zlopp); \ + av_push(revcharmap, zlopp); \ + } else { \ char ooooff = (char)val; \ - av_push(revcharmap, newSVpvn(&ooooff, 1)); \ - } \ + av_push(revcharmap, newSVpvn(&ooooff, 1)); \ + } \ } STMT_END /* This gets the next character from the input, folding it if not already @@ -2638,8 +2639,8 @@ is the recommended Unicode-aware way of saying #define TRIE_LIST_PUSH(state,fid,ns) STMT_START { \ if ( TRIE_LIST_CUR( state ) >=TRIE_LIST_LEN( state ) ) { \ - U32 ging = TRIE_LIST_LEN( state ) * 2; \ - Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \ + U32 ging = TRIE_LIST_LEN( state ) * 2; \ + Renew( trie->states[ state ].trans.list, ging, reg_trie_trans_le ); \ TRIE_LIST_LEN( state ) = ging; \ } \ TRIE_LIST_ITEM( state, TRIE_LIST_CUR( state ) ).forid = fid; \ @@ -2649,7 +2650,7 @@ is the recommended Unicode-aware way of saying #define TRIE_LIST_NEW(state) STMT_START { \ Newx( trie->states[ state ].trans.list, \ - 4, reg_trie_trans_le ); \ + 4, reg_trie_trans_le ); \ TRIE_LIST_CUR( state ) = 1; \ TRIE_LIST_LEN( state ) = 4; \ } STMT_END @@ -2688,8 +2689,8 @@ is the recommended Unicode-aware way of saying /* It's a dupe. Pre-insert into the wordinfo[].prev */\ /* chain, so that when the bits of chain are later */\ /* linked together, the dups appear in the chain */\ - trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \ - trie->wordinfo[dupe].prev = curword; \ + trie->wordinfo[curword].prev = trie->wordinfo[dupe].prev; \ + trie->wordinfo[dupe].prev = curword; \ } else { \ /* we haven't inserted this word yet. */ \ trie->states[ state ].wordnum = curword; \ @@ -2769,11 +2770,11 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, switch (flags) { case EXACT: case EXACT_REQ8: case EXACTL: break; - case EXACTFAA: + case EXACTFAA: case EXACTFUP: - case EXACTFU: - case EXACTFLU8: folder = PL_fold_latin1; break; - case EXACTF: folder = PL_fold; break; + case EXACTFU: + case EXACTFLU8: folder = PL_fold_latin1; break; + case EXACTF: folder = PL_fold; break; default: Perl_croak( aTHX_ "panic! In trie construction, unknown node type %u %s", (unsigned) flags, PL_reg_name[flags] ); } @@ -2784,7 +2785,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, RExC_rxi->data->data[ data_slot ] = (void*)trie; trie->charmap = (U16 *) PerlMemShared_calloc( 256, sizeof(U16) ); if (flags == EXACT || flags == EXACT_REQ8 || flags == EXACTL) - trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 ); + trie->bitmap = (char *) PerlMemShared_calloc( ANYOF_BITMAP_SIZE, 1 ); trie->wordinfo = (reg_trie_wordinfo *) PerlMemShared_calloc( trie->wordcount+1, sizeof(reg_trie_wordinfo)); @@ -2964,8 +2965,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, TRIE_STORE_REVCHAR( uvc ); } if ( set_bit ) { - /* store the codepoint in the bitmap, and its folded - * equivalent. */ + /* store the codepoint in the bitmap, and its folded + * equivalent. */ TRIE_BITMAP_SET_FOLDED(trie, uvc, folder); set_bit = 0; /* We've done our bit :-) */ } @@ -3010,8 +3011,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, "TRIE(%s): W:%d C:%d Uq:%d Min:%d Max:%d\n", depth+1, ( widecharmap ? "UTF8" : "NATIVE" ), (int)word_count, - (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, - (int)trie->minlen, (int)trie->maxlen ) + (int)TRIE_CHARCOUNT(trie), trie->uniquecharcount, + (int)trie->minlen, (int)trie->maxlen ) ); /* @@ -3059,17 +3060,17 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using list compiler\n", depth+1)); - trie->states = (reg_trie_state *) - PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, - sizeof(reg_trie_state) ); + trie->states = (reg_trie_state *) + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); TRIE_LIST_NEW(1); next_alloc = 2; for ( cur = first ; cur < last ; cur = regnext( cur ) ) { regnode *noper = NEXTOPER( cur ); - U32 state = 1; /* required init */ - U16 charid = 0; /* sanity init */ + U32 state = 1; /* required init */ + U16 charid = 0; /* sanity init */ U32 wordlen = 0; /* required init */ if (OP(noper) == NOTHING) { @@ -3096,7 +3097,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( uvc < 256 ) { charid = trie->charmap[ uvc ]; - } else { + } else { SV** const svpp = hv_fetch( widecharmap, (char*)&uvc, sizeof( UV ), @@ -3106,7 +3107,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } else { charid=(U16)SvIV( *svpp ); } - } + } /* charid is now 0 if we dont know the char read, or * nonzero if we do */ if ( charid ) { @@ -3117,7 +3118,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, charid--; if ( !trie->states[ state ].trans.list ) { TRIE_LIST_NEW( state ); - } + } for ( check = 1; check <= TRIE_LIST_USED( state ); check++ ) @@ -3131,15 +3132,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } if ( ! newstate ) { newstate = next_alloc++; - prev_states[newstate] = state; + prev_states[newstate] = state; TRIE_LIST_PUSH( state, charid, newstate ); transcount++; } state = newstate; } else { Perl_croak( aTHX_ "panic! In trie construction, no char mapping for %" IVdf, uvc ); - } - } + } + } } else { /* If we end up here it is because we skipped past a NOTHING, but did not end up * on a trieable type. So we need to reset noper back to point at the first regop @@ -3154,18 +3155,18 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, /* next alloc is the NEXT state to be allocated */ trie->statecount = next_alloc; trie->states = (reg_trie_state *) - PerlMemShared_realloc( trie->states, - next_alloc - * sizeof(reg_trie_state) ); + PerlMemShared_realloc( trie->states, + next_alloc + * sizeof(reg_trie_state) ); /* and now dump it out before we compress it */ DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_list(trie, widecharmap, - revcharmap, next_alloc, - depth+1) + revcharmap, next_alloc, + depth+1) ); trie->trans = (reg_trie_trans *) - PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) ); + PerlMemShared_calloc( transcount, sizeof(reg_trie_trans) ); { U32 state; U32 tp = 0; @@ -3184,22 +3185,22 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if (trie->states[state].trans.list) { U16 minid=TRIE_LIST_ITEM( state, 1).forid; U16 maxid=minid; - U16 idx; + U16 idx; for( idx = 2 ; idx <= TRIE_LIST_USED( state ) ; idx++ ) { - const U16 forid = TRIE_LIST_ITEM( state, idx).forid; - if ( forid < minid ) { - minid=forid; - } else if ( forid > maxid ) { - maxid=forid; - } + const U16 forid = TRIE_LIST_ITEM( state, idx).forid; + if ( forid < minid ) { + minid=forid; + } else if ( forid > maxid ) { + maxid=forid; + } } if ( transcount < tp + maxid - minid + 1) { transcount *= 2; - trie->trans = (reg_trie_trans *) - PerlMemShared_realloc( trie->trans, - transcount - * sizeof(reg_trie_trans) ); + trie->trans = (reg_trie_trans *) + PerlMemShared_realloc( trie->trans, + transcount + * sizeof(reg_trie_trans) ); Zero( trie->trans + (transcount / 2), transcount / 2, reg_trie_trans ); @@ -3285,13 +3286,13 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Compiling trie using table compiler\n", depth+1)); - trie->trans = (reg_trie_trans *) - PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 ) - * trie->uniquecharcount + 1, - sizeof(reg_trie_trans) ); + trie->trans = (reg_trie_trans *) + PerlMemShared_calloc( ( TRIE_CHARCOUNT(trie) + 1 ) + * trie->uniquecharcount + 1, + sizeof(reg_trie_trans) ); trie->states = (reg_trie_state *) - PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, - sizeof(reg_trie_state) ); + PerlMemShared_calloc( TRIE_CHARCOUNT(trie) + 2, + sizeof(reg_trie_state) ); next_alloc = trie->uniquecharcount + 1; @@ -3342,8 +3343,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if ( !trie->trans[ state + charid ].next ) { trie->trans[ state + charid ].next = next_alloc; trie->trans[ state ].check++; - prev_states[TRIE_NODENUM(next_alloc)] - = TRIE_NODENUM(state); + prev_states[TRIE_NODENUM(next_alloc)] + = TRIE_NODENUM(state); next_alloc += trie->uniquecharcount; } state = trie->trans[ state + charid ].next; @@ -3367,8 +3368,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, /* and now dump it out before we compress it */ DEBUG_TRIE_COMPILE_MORE_r(dump_trie_interim_table(trie, widecharmap, - revcharmap, - next_alloc, depth+1)); + revcharmap, + next_alloc, depth+1)); { /* @@ -3433,15 +3434,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, demq */ const U32 laststate = TRIE_NODENUM( next_alloc ); - U32 state, charid; + U32 state, charid; U32 pos = 0, zp=0; trie->statecount = laststate; for ( state = 1 ; state < laststate ; state++ ) { U8 flag = 0; - const U32 stateidx = TRIE_NODEIDX( state ); - const U32 o_used = trie->trans[ stateidx ].check; - U32 used = trie->trans[ stateidx ].check; + const U32 stateidx = TRIE_NODEIDX( state ); + const U32 o_used = trie->trans[ stateidx ].check; + U32 used = trie->trans[ stateidx ].check; trie->trans[ stateidx ].check = 0; for ( charid = 0; @@ -3484,8 +3485,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, } trie->lasttrans = pos + 1; trie->states = (reg_trie_state *) - PerlMemShared_realloc( trie->states, laststate - * sizeof(reg_trie_state) ); + PerlMemShared_realloc( trie->states, laststate + * sizeof(reg_trie_state) ); DEBUG_TRIE_COMPILE_MORE_r( Perl_re_indentf( aTHX_ "Alloc: %d Orig: %" IVdf " elements, Final:%" IVdf ". Savings of %%%5.2f\n", depth+1, @@ -3506,8 +3507,8 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, ); /* resize the trans array to remove unused space */ trie->trans = (reg_trie_trans *) - PerlMemShared_realloc( trie->trans, trie->lasttrans - * sizeof(reg_trie_trans) ); + PerlMemShared_realloc( trie->trans, trie->lasttrans + * sizeof(reg_trie_trans) ); { /* Modify the program and insert the new TRIE node */ U8 nodetype =(U8)(flags & 0xFF); @@ -3602,20 +3603,20 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, (UV)state)); if (first_ofs >= 0) { SV ** const tmp = av_fetch( revcharmap, first_ofs, 0); - const U8 * const ch = (U8*)SvPV_nolen_const( *tmp ); + const U8 * const ch = (U8*)SvPV_nolen_const( *tmp ); TRIE_BITMAP_SET_FOLDED(trie,*ch, folder); DEBUG_OPTIMISE_r( Perl_re_printf( aTHX_ "%s", (char*)ch) ); - } - } + } + } /* store the current firstchar in the bitmap */ TRIE_BITMAP_SET_FOLDED(trie,*ch, folder); DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "%s", ch)); - } + } first_ofs = ofs; - } + } } if ( count == 1 ) { /* This state has only one transition, its transition is part @@ -3630,9 +3631,9 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, depth+1, (UV)state, (UV)first_ofs, pv_pretty(sv, SvPV_nolen_const(*tmp), SvCUR(*tmp), 6, - PL_colors[0], PL_colors[1], - (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | - PERL_PV_ESCAPE_FIRSTCHAR + PL_colors[0], PL_colors[1], + (SvUTF8(*tmp) ? PERL_PV_ESCAPE_UNI : 0) | + PERL_PV_ESCAPE_FIRSTCHAR ) ); }); @@ -3645,15 +3646,15 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, setSTR_LEN(convert, (U8)(STR_LEN(convert) + len)); while (len--) *str++ = *ch++; - } else { + } else { #ifdef DEBUGGING - if (state>1) + if (state>1) DEBUG_OPTIMISE_r(Perl_re_printf( aTHX_ "]\n")); #endif - break; - } - } - trie->prefixlen = (state-1); + break; + } + } + trie->prefixlen = (state-1); if (str) { regnode *n = convert+NODE_SZ_STR(convert); assert( NODE_SZ_STR(convert) <= U16_MAX ); @@ -3694,7 +3695,7 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, #endif if (trie->maxlen) { convert = n; - } else { + } else { NEXT_OFF(convert) = (U16)(tail - convert); DEBUG_r(optimize= n); } @@ -3703,23 +3704,23 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, if (!jumper) jumper = last; if ( trie->maxlen ) { - NEXT_OFF( convert ) = (U16)(tail - convert); - ARG_SET( convert, data_slot ); - /* Store the offset to the first unabsorbed branch in - jump[0], which is otherwise unused by the jump logic. - We use this when dumping a trie and during optimisation. */ - if (trie->jump) - trie->jump[0] = (U16)(nextbranch - convert); + NEXT_OFF( convert ) = (U16)(tail - convert); + ARG_SET( convert, data_slot ); + /* Store the offset to the first unabsorbed branch in + jump[0], which is otherwise unused by the jump logic. + We use this when dumping a trie and during optimisation. */ + if (trie->jump) + trie->jump[0] = (U16)(nextbranch - convert); /* If the start state is not accepting (meaning there is no empty string/NOTHING) - * and there is a bitmap - * and the first "jump target" node we found leaves enough room - * then convert the TRIE node into a TRIEC node, with the bitmap - * embedded inline in the opcode - this is hypothetically faster. - */ + * and there is a bitmap + * and the first "jump target" node we found leaves enough room + * then convert the TRIE node into a TRIEC node, with the bitmap + * embedded inline in the opcode - this is hypothetically faster. + */ if ( !trie->states[trie->startstate].wordnum - && trie->bitmap - && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) ) + && trie->bitmap + && ( (char *)jumper - (char *)convert) >= (int)sizeof(struct regnode_charclass) ) { OP( convert ) = TRIEC; Copy(trie->bitmap, ((struct regnode_charclass *)convert)->bitmap, ANYOF_BITMAP_SIZE, char); @@ -3768,26 +3769,26 @@ S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, * already linked up earlier. */ { - U16 word; - U32 state; - U16 prev; - - for (word=1; word <= trie->wordcount; word++) { - prev = 0; - if (trie->wordinfo[word].prev) - continue; - state = trie->wordinfo[word].accept; - while (state) { - state = prev_states[state]; - if (!state) - break; - prev = trie->states[state].wordnum; - if (prev) - break; - } - trie->wordinfo[word].prev = prev; - } - Safefree(prev_states); + U16 word; + U32 state; + U16 prev; + + for (word=1; word <= trie->wordcount; word++) { + prev = 0; + if (trie->wordinfo[word].prev) + continue; + state = trie->wordinfo[word].accept; + while (state) { + state = prev_states[state]; + if (!state) + break; + prev = trie->states[state].wordnum; + if (prev) + break; + } + trie->wordinfo[word].prev = prev; + } + Safefree(prev_states); } @@ -3884,20 +3885,20 @@ S_construct_ahocorasick_from_trie(pTHX_ RExC_state_t *pRExC_state, regnode *sour fail[ 0 ] = fail[ 1 ] = 1; for ( charid = 0; charid < ucharcount ; charid++ ) { - const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 ); - if ( newstate ) { + const U32 newstate = TRIE_TRANS_STATE( 1, base, ucharcount, charid, 0 ); + if ( newstate ) { q[ q_write ] = newstate; /* set to point at the root */ fail[ q[ q_write++ ] ]=1; } } while ( q_read < q_write) { - const U32 cur = q[ q_read++ % numstates ]; + const U32 cur = q[ q_read++ % numstates ]; base = trie->states[ cur ].trans.base; for ( charid = 0 ; charid < ucharcount ; charid++ ) { - const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 ); - if (ch_state) { + const U32 ch_state = TRIE_TRANS_STATE( cur, base, ucharcount, charid, 1 ); + if (ch_state) { U32 fail_state = cur; U32 fail_base; do { @@ -4259,16 +4260,16 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, } #ifdef EXPERIMENTAL_INPLACESCAN - if (flags && !NEXT_OFF(n)) { - DEBUG_PEEP("atch", val, depth, 0); - if (reg_off_by_arg[OP(n)]) { - ARG_SET(n, val - n); - } - else { - NEXT_OFF(n) = val - n; - } - stopnow = 1; - } + if (flags && !NEXT_OFF(n)) { + DEBUG_PEEP("atch", val, depth, 0); + if (reg_off_by_arg[OP(n)]) { + ARG_SET(n, val - n); + } + else { + NEXT_OFF(n) = val - n; + } + stopnow = 1; + } #endif } @@ -4294,11 +4295,11 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, int total_count_delta = 0; /* Total delta number of characters that multi-char folds expand to */ - /* One pass is made over the node's string looking for all the - * possibilities. To avoid some tests in the loop, there are two main - * cases, for UTF-8 patterns (which can't have EXACTF nodes) and - * non-UTF-8 */ - if (UTF) { + /* One pass is made over the node's string looking for all the + * possibilities. To avoid some tests in the loop, there are two main + * cases, for UTF-8 patterns (which can't have EXACTF nodes) and + * non-UTF-8 */ + if (UTF) { U8* folded = NULL; if (OP(scan) == EXACTFL) { @@ -4355,7 +4356,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * executed */ while (s < s_end - 1) /* Can stop 1 before the end, as minimum length sequence we are looking for is 2 */ - { + { int count = 0; /* How many characters in a multi-char fold */ int len = is_MULTI_CHAR_FOLD_utf8_safe(s, s_end); if (! len) { /* Not a multi-char fold: get next char */ @@ -4391,7 +4392,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * the character that folds to the sequence is) */ total_count_delta += count - 1; next_iteration: ; - } + } /* We created a temporary folded copy of the string in EXACTFL * nodes. Therefore we need to be sure it doesn't go below zero, @@ -4406,8 +4407,8 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, *min_subtract += total_count_delta; Safefree(folded); - } - else if (OP(scan) == EXACTFAA) { + } + else if (OP(scan) == EXACTFAA) { /* Non-UTF-8 pattern, EXACTFAA node. There can't be a multi-char * fold to the ASCII range (and there are no existing ones in the @@ -4418,7 +4419,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, #if UNICODE_MAJOR_VERSION > 3 /* no multifolds in early Unicode */ \ || (UNICODE_MAJOR_VERSION == 3 && ( UNICODE_DOT_VERSION > 0) \ || UNICODE_DOT_DOT_VERSION > 0) - while (s < s_end) { + while (s < s_end) { if (*s == LATIN_SMALL_LETTER_SHARP_S) { OP(scan) = EXACTFAA_NO_TRIE; *unfolded_multi_char = TRUE; @@ -4427,7 +4428,7 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, s++; } } - else if (OP(scan) != EXACTFAA_NO_TRIE) { + else if (OP(scan) != EXACTFAA_NO_TRIE) { /* Non-UTF-8 pattern, not EXACTFAA node. Look for the multi-char * folds that are all Latin1. As explained in the comments @@ -4435,11 +4436,11 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * and EXACTFL nodes; it can be in the final position. Otherwise * we can stop looking 1 byte earlier because have to find at least * two characters for a multi-fold */ - const U8* upper = (OP(scan) == EXACTF || OP(scan) == EXACTFL) + const U8* upper = (OP(scan) == EXACTF || OP(scan) == EXACTFL) ? s_end : s_end -1; - while (s < upper) { + while (s < upper) { int len = is_MULTI_CHAR_FOLD_latin1_safe(s, s_end); if (! len) { /* Not a multi-char fold. */ if (*s == LATIN_SMALL_LETTER_SHARP_S @@ -4465,13 +4466,13 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, if (OP(scan) != EXACTF && OP(scan) != EXACTFL) { OP(scan) = EXACTFUP; } - } + } *min_subtract += len - 1; s += len; - } + } #endif - } + } } #ifdef DEBUGGING @@ -4479,9 +4480,9 @@ S_join_exact(pTHX_ RExC_state_t *pRExC_state, regnode *scan, * ops and/or strings with fake optimized ops */ n = scan + NODE_SZ_STR(scan); while (n <= stop) { - OP(n) = OPTIMIZED; - FLAGS(n) = 0; - NEXT_OFF(n) = 0; + OP(n) = OPTIMIZED; + FLAGS(n) = 0; + NEXT_OFF(n) = 0; n++; } #endif @@ -4552,19 +4553,19 @@ S_rck_elide_nothing(pTHX_ regnode *node) STATIC SSize_t S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, SSize_t *minlenp, SSize_t *deltap, - regnode *last, - scan_data_t *data, - I32 stopparen, + regnode *last, + scan_data_t *data, + I32 stopparen, U32 recursed_depth, - regnode_ssc *and_withp, - U32 flags, U32 depth, bool was_mutate_ok) - /* scanp: Start here (read-write). */ - /* deltap: Write maxlen-minlen here. */ - /* last: Stop before this one. */ - /* data: string data about the pattern */ - /* stopparen: treat close N as END */ - /* recursed: which subroutines have we recursed into */ - /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */ + regnode_ssc *and_withp, + U32 flags, U32 depth, bool was_mutate_ok) + /* scanp: Start here (read-write). */ + /* deltap: Write maxlen-minlen here. */ + /* last: Stop before this one. */ + /* data: string data about the pattern */ + /* stopparen: treat close N as END */ + /* recursed: which subroutines have we recursed into */ + /* and_withp: Valid if flags & SCF_DO_STCLASS_OR */ { SSize_t final_minlen; /* There must be at least this number of characters to match */ @@ -4627,12 +4628,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, UV min_subtract = 0; /* How mmany chars to subtract from the minimum node length to get a real minimum (because the folded version may be shorter) */ - bool unfolded_multi_char = FALSE; + bool unfolded_multi_char = FALSE; /* avoid mutating ops if we are anywhere within the recursed or * enframed handling for a GOSUB: the outermost level will handle it. */ bool mutate_ok = was_mutate_ok && !(frame && frame->in_gosub); - /* Peephole optimizer: */ + /* Peephole optimizer: */ DEBUG_STUDYDATA("Peep", data, depth, is_inf); DEBUG_PEEP("Peep", scan, depth, flags); @@ -4690,21 +4691,21 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, OP(scan) == BRANCHJ || OP(scan) == IFTHEN ) { - next = regnext(scan); - code = OP(scan); + next = regnext(scan); + code = OP(scan); /* The op(next)==code check below is to see if we * have "BRANCH-BRANCH", "BRANCHJ-BRANCHJ", "IFTHEN-IFTHEN" * IFTHEN is special as it might not appear in pairs. * Not sure whether BRANCH-BRANCHJ is possible, regardless * we dont handle it cleanly. */ - if (OP(next) == code || code == IFTHEN) { + if (OP(next) == code || code == IFTHEN) { /* NOTE - There is similar code to this block below for * handling TRIE nodes on a re-study. If you change stuff here * check there too. */ - SSize_t max1 = 0, min1 = OPTIMIZE_INFTY, num = 0; - regnode_ssc accum; - regnode * const startbranch=scan; + SSize_t max1 = 0, min1 = OPTIMIZE_INFTY, num = 0; + regnode_ssc accum; + regnode * const startbranch=scan; if (flags & SCF_DO_SUBSTR) { /* Cannot merge strings after this. */ @@ -4712,164 +4713,164 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } if (flags & SCF_DO_STCLASS) - ssc_init_zero(pRExC_state, &accum); + ssc_init_zero(pRExC_state, &accum); - while (OP(scan) == code) { - SSize_t deltanext, minnext, fake; - I32 f = 0; - regnode_ssc this_class; + while (OP(scan) == code) { + SSize_t deltanext, minnext, fake; + I32 f = 0; + regnode_ssc this_class; DEBUG_PEEP("Branch", scan, depth, flags); - num++; + num++; StructCopy(&zero_scan_data, &data_fake, scan_data_t); - if (data) { - data_fake.whilem_c = data->whilem_c; - data_fake.last_closep = data->last_closep; - } - else - data_fake.last_closep = &fake; + if (data) { + data_fake.whilem_c = data->whilem_c; + data_fake.last_closep = data->last_closep; + } + else + data_fake.last_closep = &fake; - data_fake.pos_delta = delta; - next = regnext(scan); + data_fake.pos_delta = delta; + next = regnext(scan); scan = NEXTOPER(scan); /* everything */ if (code != BRANCH) /* everything but BRANCH */ - scan = NEXTOPER(scan); + scan = NEXTOPER(scan); - if (flags & SCF_DO_STCLASS) { - ssc_init(pRExC_state, &this_class); - data_fake.start_class = &this_class; - f = SCF_DO_STCLASS_AND; - } - if (flags & SCF_WHILEM_VISITED_POS) - f |= SCF_WHILEM_VISITED_POS; + if (flags & SCF_DO_STCLASS) { + ssc_init(pRExC_state, &this_class); + data_fake.start_class = &this_class; + f = SCF_DO_STCLASS_AND; + } + if (flags & SCF_WHILEM_VISITED_POS) + f |= SCF_WHILEM_VISITED_POS; - /* we suppose the run is continuous, last=next...*/ + /* we suppose the run is continuous, last=next...*/ /* recurse study_chunk() for each BRANCH in an alternation */ - minnext = study_chunk(pRExC_state, &scan, minlenp, + minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, next, &data_fake, stopparen, recursed_depth, NULL, f, depth+1, mutate_ok); - if (min1 > minnext) - min1 = minnext; - if (deltanext == OPTIMIZE_INFTY) { - is_inf = is_inf_internal = 1; - max1 = OPTIMIZE_INFTY; - } else if (max1 < minnext + deltanext) - max1 = minnext + deltanext; - scan = next; - if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) - pars++; - if (data_fake.flags & SCF_SEEN_ACCEPT) { - if ( stopmin > minnext) - stopmin = min + min1; - flags &= ~SCF_DO_SUBSTR; - if (data) - data->flags |= SCF_SEEN_ACCEPT; - } - if (data) { - if (data_fake.flags & SF_HAS_EVAL) - data->flags |= SF_HAS_EVAL; - data->whilem_c = data_fake.whilem_c; - } - if (flags & SCF_DO_STCLASS) - ssc_or(pRExC_state, &accum, (regnode_charclass*)&this_class); - } - if (code == IFTHEN && num < 2) /* Empty ELSE branch */ - min1 = 0; - if (flags & SCF_DO_SUBSTR) { - data->pos_min += min1; - if (data->pos_delta >= OPTIMIZE_INFTY - (max1 - min1)) - data->pos_delta = OPTIMIZE_INFTY; - else - data->pos_delta += max1 - min1; - if (max1 != min1 || is_inf) - data->cur_is_floating = 1; - } - min += min1; - if (delta == OPTIMIZE_INFTY - || OPTIMIZE_INFTY - delta - (max1 - min1) < 0) - delta = OPTIMIZE_INFTY; - else - delta += max1 - min1; - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass*) &accum); - if (min1) { - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - flags &= ~SCF_DO_STCLASS; - } - } - else if (flags & SCF_DO_STCLASS_AND) { - if (min1) { - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &accum); - flags &= ~SCF_DO_STCLASS; - } - else { - /* Switch to OR mode: cache the old value of - * data->start_class */ - INIT_AND_WITHP; - StructCopy(data->start_class, and_withp, regnode_ssc); - flags &= ~SCF_DO_STCLASS_AND; - StructCopy(&accum, data->start_class, regnode_ssc); - flags |= SCF_DO_STCLASS_OR; - } - } + if (min1 > minnext) + min1 = minnext; + if (deltanext == OPTIMIZE_INFTY) { + is_inf = is_inf_internal = 1; + max1 = OPTIMIZE_INFTY; + } else if (max1 < minnext + deltanext) + max1 = minnext + deltanext; + scan = next; + if (data_fake.flags & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (data_fake.flags & SCF_SEEN_ACCEPT) { + if ( stopmin > minnext) + stopmin = min + min1; + flags &= ~SCF_DO_SUBSTR; + if (data) + data->flags |= SCF_SEEN_ACCEPT; + } + if (data) { + if (data_fake.flags & SF_HAS_EVAL) + data->flags |= SF_HAS_EVAL; + data->whilem_c = data_fake.whilem_c; + } + if (flags & SCF_DO_STCLASS) + ssc_or(pRExC_state, &accum, (regnode_charclass*)&this_class); + } + if (code == IFTHEN && num < 2) /* Empty ELSE branch */ + min1 = 0; + if (flags & SCF_DO_SUBSTR) { + data->pos_min += min1; + if (data->pos_delta >= OPTIMIZE_INFTY - (max1 - min1)) + data->pos_delta = OPTIMIZE_INFTY; + else + data->pos_delta += max1 - min1; + if (max1 != min1 || is_inf) + data->cur_is_floating = 1; + } + min += min1; + if (delta == OPTIMIZE_INFTY + || OPTIMIZE_INFTY - delta - (max1 - min1) < 0) + delta = OPTIMIZE_INFTY; + else + delta += max1 - min1; + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass*) &accum); + if (min1) { + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + flags &= ~SCF_DO_STCLASS; + } + } + else if (flags & SCF_DO_STCLASS_AND) { + if (min1) { + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &accum); + flags &= ~SCF_DO_STCLASS; + } + else { + /* Switch to OR mode: cache the old value of + * data->start_class */ + INIT_AND_WITHP; + StructCopy(data->start_class, and_withp, regnode_ssc); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&accum, data->start_class, regnode_ssc); + flags |= SCF_DO_STCLASS_OR; + } + } if (PERL_ENABLE_TRIE_OPTIMISATION && OP(startbranch) == BRANCH && mutate_ok ) { - /* demq. + /* demq. Assuming this was/is a branch we are dealing with: 'scan' now points at the item that follows the branch sequence, whatever it is. We now start at the beginning of the sequence and look for subsequences of - BRANCH->EXACT=>x1 - BRANCH->EXACT=>x2 - tail + BRANCH->EXACT=>x1 + BRANCH->EXACT=>x2 + tail which would be constructed from a pattern like /A|LIST|OF|WORDS/ - If we can find such a subsequence we need to turn the first - element into a trie and then add the subsequent branch exact - strings to the trie. + If we can find such a subsequence we need to turn the first + element into a trie and then add the subsequent branch exact + strings to the trie. - We have two cases + We have two cases 1. patterns where the whole set of branches can be converted. - 2. patterns where only a subset can be converted. + 2. patterns where only a subset can be converted. - In case 1 we can replace the whole set with a single regop - for the trie. In case 2 we need to keep the start and end - branches so + In case 1 we can replace the whole set with a single regop + for the trie. In case 2 we need to keep the start and end + branches so - 'BRANCH EXACT; BRANCH EXACT; BRANCH X' - becomes BRANCH TRIE; BRANCH X; + 'BRANCH EXACT; BRANCH EXACT; BRANCH X' + becomes BRANCH TRIE; BRANCH X; - There is an additional case, that being where there is a - common prefix, which gets split out into an EXACT like node - preceding the TRIE node. + There is an additional case, that being where there is a + common prefix, which gets split out into an EXACT like node + preceding the TRIE node. - If x(1..n)==tail then we can do a simple trie, if not we make - a "jump" trie, such that when we match the appropriate word - we "jump" to the appropriate tail node. Essentially we turn - a nested if into a case structure of sorts. + If x(1..n)==tail then we can do a simple trie, if not we make + a "jump" trie, such that when we match the appropriate word + we "jump" to the appropriate tail node. Essentially we turn + a nested if into a case structure of sorts. - */ + */ - int made=0; - if (!re_trie_maxbuff) { - re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1); - if (!SvIOK(re_trie_maxbuff)) - sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT); - } + int made=0; + if (!re_trie_maxbuff) { + re_trie_maxbuff = get_sv(RE_TRIE_MAXBUF_NAME, 1); + if (!SvIOK(re_trie_maxbuff)) + sv_setiv(re_trie_maxbuff, RE_TRIE_MAXBUF_INIT); + } if ( SvIV(re_trie_maxbuff)>=0 ) { regnode *cur; regnode *first = (regnode *)NULL; @@ -5005,8 +5006,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } Perl_re_printf( aTHX_ "(First==%d,Last==%d,Cur==%d,tt==%s,ntt==%s,nntt==%s)\n", REG_NODE_NUM(first), REG_NODE_NUM(prev), REG_NODE_NUM(cur), - PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype] - ); + PL_reg_name[trietype], PL_reg_name[noper_trietype], PL_reg_name[noper_next_trietype] + ); }); /* Is noper a trieable nodetype that can be merged @@ -5029,15 +5030,15 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, * otherwise we update the end pointer. */ if ( !first ) { first = cur; - if ( noper_trietype == NOTHING ) { + if ( noper_trietype == NOTHING ) { #if !defined(DEBUGGING) && !defined(NOJUMPTRIE) - regnode * const noper_next = regnext( noper ); + regnode * const noper_next = regnext( noper ); U8 noper_next_type = (noper_next && noper_next < tail) ? OP(noper_next) : 0; - U8 noper_next_trietype = noper_next_type ? TRIE_TYPE( noper_next_type ) :0; + U8 noper_next_trietype = noper_next_type ? TRIE_TYPE( noper_next_type ) :0; #endif if ( noper_next_trietype ) { - trietype = noper_next_trietype; + trietype = noper_next_trietype; } else if (noper_next_type) { /* a NOTHING regop is 1 regop wide. * We need at least two for a trie @@ -5052,8 +5053,8 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, trietype = noper_trietype; prev = cur; } - if (first) - count++; + if (first) + count++; } /* end handle mergable triable node */ else { /* handle unmergable node - @@ -5156,12 +5157,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, } /* TRIE_MAXBUF is non zero */ } /* do trie */ - } - else if ( code == BRANCHJ ) { /* single branch is optimized. */ - scan = NEXTOPER(NEXTOPER(scan)); - } else /* single branch is optimized. */ - scan = NEXTOPER(scan); - continue; + } + else if ( code == BRANCHJ ) { /* single branch is optimized. */ + scan = NEXTOPER(NEXTOPER(scan)); + } else /* single branch is optimized. */ + scan = NEXTOPER(scan); + continue; } else if (OP(scan) == SUSPEND || OP(scan) == GOSUB) { I32 paren = 0; regnode *start = NULL; @@ -5249,12 +5250,12 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, flags &= ~SCF_DO_STCLASS; start= NULL; /* reset start so we dont recurse later on. */ - } + } } else { - paren = stopparen; + paren = stopparen; start = scan + 2; - end = regnext(scan); - } + end = regnext(scan); + } if (start) { scan_frame *newframe; assert(end); @@ -5285,73 +5286,73 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, DEBUG_STUDYDATA("frame-new", data, depth, is_inf); DEBUG_PEEP("fnew", scan, depth, flags); - frame = newframe; - scan = start; - stopparen = paren; - last = end; + frame = newframe; + scan = start; + stopparen = paren; + last = end; depth = depth + 1; recursed_depth= my_recursed_depth; - continue; - } - } - else if (PL_regkind[OP(scan)] == EXACT && ! isEXACTFish(OP(scan))) { - SSize_t bytelen = STR_LEN(scan), charlen; - UV uc; + continue; + } + } + else if (PL_regkind[OP(scan)] == EXACT && ! isEXACTFish(OP(scan))) { + SSize_t bytelen = STR_LEN(scan), charlen; + UV uc; assert(bytelen); - if (UTF) { - const U8 * const s = (U8*)STRING(scan); - uc = utf8_to_uvchr_buf(s, s + bytelen, NULL); - charlen = utf8_length(s, s + bytelen); - } else { - uc = *((U8*)STRING(scan)); + if (UTF) { + const U8 * const s = (U8*)STRING(scan); + uc = utf8_to_uvchr_buf(s, s + bytelen, NULL); + charlen = utf8_length(s, s + bytelen); + } else { + uc = *((U8*)STRING(scan)); charlen = bytelen; - } - min += charlen; - if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ - /* The code below prefers earlier match for fixed - offset, later match for variable offset. */ - if (data->last_end == -1) { /* Update the start info. */ - data->last_start_min = data->pos_min; + } + min += charlen; + if (flags & SCF_DO_SUBSTR) { /* Update longest substr. */ + /* The code below prefers earlier match for fixed + offset, later match for variable offset. */ + if (data->last_end == -1) { /* Update the start info. */ + data->last_start_min = data->pos_min; data->last_start_max = is_inf ? OPTIMIZE_INFTY : (data->pos_delta > OPTIMIZE_INFTY - data->pos_min) ? OPTIMIZE_INFTY : data->pos_min + data->pos_delta; - } - sv_catpvn(data->last_found, STRING(scan), bytelen); - if (UTF) - SvUTF8_on(data->last_found); - { - SV * const sv = data->last_found; - MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - if (mg && mg->mg_len >= 0) - mg->mg_len += charlen; - } - data->last_end = data->pos_min + charlen; - data->pos_min += charlen; /* As in the first entry. */ - data->flags &= ~SF_BEFORE_EOL; - } + } + sv_catpvn(data->last_found, STRING(scan), bytelen); + if (UTF) + SvUTF8_on(data->last_found); + { + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + if (mg && mg->mg_len >= 0) + mg->mg_len += charlen; + } + data->last_end = data->pos_min + charlen; + data->pos_min += charlen; /* As in the first entry. */ + data->flags &= ~SF_BEFORE_EOL; + } /* ANDing the code point leaves at most it, and not in locale, and * can't match null string */ - if (flags & SCF_DO_STCLASS_AND) { + if (flags & SCF_DO_STCLASS_AND) { ssc_cp_and(data->start_class, uc); ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; ssc_clear_locale(data->start_class); - } - else if (flags & SCF_DO_STCLASS_OR) { + } + else if (flags & SCF_DO_STCLASS_OR) { ssc_add_cp(data->start_class, uc); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; - } - flags &= ~SCF_DO_STCLASS; - } + } + flags &= ~SCF_DO_STCLASS; + } else if (PL_regkind[OP(scan)] == EXACT) { /* But OP != EXACT!, so is EXACTFish */ - SSize_t bytelen = STR_LEN(scan), charlen; + SSize_t bytelen = STR_LEN(scan), charlen; const U8 * s = (U8*)STRING(scan); /* Replace a length 1 ASCII fold pair node with an ANYOFM node, @@ -5374,28 +5375,28 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, continue; } - /* Search for fixed substrings supports EXACT only. */ - if (flags & SCF_DO_SUBSTR) { - assert(data); + /* Search for fixed substrings supports EXACT only. */ + if (flags & SCF_DO_SUBSTR) { + assert(data); scan_commit(pRExC_state, data, minlenp, is_inf); - } + } charlen = UTF ? (SSize_t) utf8_length(s, s + bytelen) : bytelen; - if (unfolded_multi_char) { + if (unfolded_multi_char) { RExC_seen |= REG_UNFOLDED_MULTI_SEEN; - } - min += charlen - min_subtract; + } + min += charlen - min_subtract; assert (min >= 0); delta += min_subtract; - if (flags & SCF_DO_SUBSTR) { - data->pos_min += charlen - min_subtract; - if (data->pos_min < 0) { + if (flags & SCF_DO_SUBSTR) { + data->pos_min += charlen - min_subtract; + if (data->pos_min < 0) { data->pos_min = 0; } data->pos_delta += min_subtract; - if (min_subtract) { - data->cur_is_floating = 1; /* float */ - } - } + if (min_subtract) { + data->cur_is_floating = 1; /* float */ + } + } if (flags & SCF_DO_STCLASS) { SV* EXACTF_invlist = make_exactf_invlist(pRExC_state, scan); @@ -5418,41 +5419,41 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, flags &= ~SCF_DO_STCLASS; SvREFCNT_dec(EXACTF_invlist); } - } - else if (REGNODE_VARIES(OP(scan))) { - SSize_t mincount, maxcount, minnext, deltanext, pos_before = 0; - I32 fl = 0, f = flags; - regnode * const oscan = scan; - regnode_ssc this_class; - regnode_ssc *oclass = NULL; - I32 next_is_eval = 0; - - switch (PL_regkind[OP(scan)]) { - case WHILEM: /* End of (?:...)* . */ - scan = NEXTOPER(scan); - goto finish; - case PLUS: - if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { - next = NEXTOPER(scan); - if ( ( PL_regkind[OP(next)] == EXACT + } + else if (REGNODE_VARIES(OP(scan))) { + SSize_t mincount, maxcount, minnext, deltanext, pos_before = 0; + I32 fl = 0, f = flags; + regnode * const oscan = scan; + regnode_ssc this_class; + regnode_ssc *oclass = NULL; + I32 next_is_eval = 0; + + switch (PL_regkind[OP(scan)]) { + case WHILEM: /* End of (?:...)* . */ + scan = NEXTOPER(scan); + goto finish; + case PLUS: + if (flags & (SCF_DO_SUBSTR | SCF_DO_STCLASS)) { + next = NEXTOPER(scan); + if ( ( PL_regkind[OP(next)] == EXACT && ! isEXACTFish(OP(next))) || (flags & SCF_DO_STCLASS)) { - mincount = 1; - maxcount = REG_INFTY; - next = regnext(scan); - scan = NEXTOPER(scan); - goto do_curly; - } - } - if (flags & SCF_DO_SUBSTR) - data->pos_min++; + mincount = 1; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } + } + if (flags & SCF_DO_SUBSTR) + data->pos_min++; /* This will bypass the formal 'min += minnext * mincount' * calculation in the do_curly path, so assumes min width * of the PLUS payload is exactly one. */ - min++; - /* FALLTHROUGH */ - case STAR: + min++; + /* FALLTHROUGH */ + case STAR: next = NEXTOPER(scan); /* This temporary node can now be turned into EXACTFU, and @@ -5483,121 +5484,121 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, FLAGS(next) = mask; } - if (flags & SCF_DO_STCLASS) { - mincount = 0; - maxcount = REG_INFTY; - next = regnext(scan); - scan = NEXTOPER(scan); - goto do_curly; - } - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_STCLASS) { + mincount = 0; + maxcount = REG_INFTY; + next = regnext(scan); + scan = NEXTOPER(scan); + goto do_curly; + } + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); /* Cannot extend fixed substrings */ - data->cur_is_floating = 1; /* float */ - } + data->cur_is_floating = 1; /* float */ + } is_inf = is_inf_internal = 1; scan = regnext(scan); - goto optimize_curly_tail; - case CURLY: - if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM) - && (scan->flags == stopparen)) - { - mincount = 1; - maxcount = 1; - } else { - mincount = ARG1(scan); - maxcount = ARG2(scan); - } - next = regnext(scan); - if (OP(scan) == CURLYX) { - I32 lp = (data ? *(data->last_closep) : 0); - scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX); - } - scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; - next_is_eval = (OP(scan) == EVAL); - do_curly: - if (flags & SCF_DO_SUBSTR) { + goto optimize_curly_tail; + case CURLY: + if (stopparen>0 && (OP(scan)==CURLYN || OP(scan)==CURLYM) + && (scan->flags == stopparen)) + { + mincount = 1; + maxcount = 1; + } else { + mincount = ARG1(scan); + maxcount = ARG2(scan); + } + next = regnext(scan); + if (OP(scan) == CURLYX) { + I32 lp = (data ? *(data->last_closep) : 0); + scan->flags = ((lp <= (I32)U8_MAX) ? (U8)lp : U8_MAX); + } + scan = NEXTOPER(scan) + EXTRA_STEP_2ARGS; + next_is_eval = (OP(scan) == EVAL); + do_curly: + if (flags & SCF_DO_SUBSTR) { if (mincount == 0) scan_commit(pRExC_state, data, minlenp, is_inf); /* Cannot extend fixed substrings */ - pos_before = data->pos_min; - } - if (data) { - fl = data->flags; - data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL); - if (is_inf) - data->flags |= SF_IS_INF; - } - if (flags & SCF_DO_STCLASS) { - ssc_init(pRExC_state, &this_class); - oclass = data->start_class; - data->start_class = &this_class; - f |= SCF_DO_STCLASS_AND; - f &= ~SCF_DO_STCLASS_OR; - } - /* Exclude from super-linear cache processing any {n,m} - regops for which the combination of input pos and regex - pos is not enough information to determine if a match - will be possible. - - For example, in the regex /foo(bar\s*){4,8}baz/ with the - regex pos at the \s*, the prospects for a match depend not - only on the input position but also on how many (bar\s*) - repeats into the {4,8} we are. */ + pos_before = data->pos_min; + } + if (data) { + fl = data->flags; + data->flags &= ~(SF_HAS_PAR|SF_IN_PAR|SF_HAS_EVAL); + if (is_inf) + data->flags |= SF_IS_INF; + } + if (flags & SCF_DO_STCLASS) { + ssc_init(pRExC_state, &this_class); + oclass = data->start_class; + data->start_class = &this_class; + f |= SCF_DO_STCLASS_AND; + f &= ~SCF_DO_STCLASS_OR; + } + /* Exclude from super-linear cache processing any {n,m} + regops for which the combination of input pos and regex + pos is not enough information to determine if a match + will be possible. + + For example, in the regex /foo(bar\s*){4,8}baz/ with the + regex pos at the \s*, the prospects for a match depend not + only on the input position but also on how many (bar\s*) + repeats into the {4,8} we are. */ if ((mincount > 1) || (maxcount > 1 && maxcount != REG_INFTY)) - f &= ~SCF_WHILEM_VISITED_POS; + f &= ~SCF_WHILEM_VISITED_POS; - /* This will finish on WHILEM, setting scan, or on NULL: */ + /* This will finish on WHILEM, setting scan, or on NULL: */ /* recurse study_chunk() on loop bodies */ - minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, + minnext = study_chunk(pRExC_state, &scan, minlenp, &deltanext, last, data, stopparen, recursed_depth, NULL, (mincount == 0 ? (f & ~SCF_DO_SUBSTR) : f) , depth+1, mutate_ok); - if (flags & SCF_DO_STCLASS) - data->start_class = oclass; - if (mincount == 0 || minnext == 0) { - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - } - else if (flags & SCF_DO_STCLASS_AND) { - /* Switch to OR mode: cache the old value of - * data->start_class */ - INIT_AND_WITHP; - StructCopy(data->start_class, and_withp, regnode_ssc); - flags &= ~SCF_DO_STCLASS_AND; - StructCopy(&this_class, data->start_class, regnode_ssc); - flags |= SCF_DO_STCLASS_OR; + if (flags & SCF_DO_STCLASS) + data->start_class = oclass; + if (mincount == 0 || minnext == 0) { + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + } + else if (flags & SCF_DO_STCLASS_AND) { + /* Switch to OR mode: cache the old value of + * data->start_class */ + INIT_AND_WITHP; + StructCopy(data->start_class, and_withp, regnode_ssc); + flags &= ~SCF_DO_STCLASS_AND; + StructCopy(&this_class, data->start_class, regnode_ssc); + flags |= SCF_DO_STCLASS_OR; ANYOF_FLAGS(data->start_class) |= SSC_MATCHES_EMPTY_STRING; - } - } else { /* Non-zero len */ - if (flags & SCF_DO_STCLASS_OR) { - ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - } - else if (flags & SCF_DO_STCLASS_AND) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &this_class); - flags &= ~SCF_DO_STCLASS; - } - if (!scan) /* It was not CURLYX, but CURLY. */ - scan = next; - if (((flags & (SCF_TRIE_DOING_RESTUDY|SCF_DO_SUBSTR))==SCF_DO_SUBSTR) - /* ? quantifier ok, except for (?{ ... }) */ - && (next_is_eval || !(mincount == 0 && maxcount == 1)) - && (minnext == 0) && (deltanext == 0) - && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) + } + } else { /* Non-zero len */ + if (flags & SCF_DO_STCLASS_OR) { + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + } + else if (flags & SCF_DO_STCLASS_AND) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &this_class); + flags &= ~SCF_DO_STCLASS; + } + if (!scan) /* It was not CURLYX, but CURLY. */ + scan = next; + if (((flags & (SCF_TRIE_DOING_RESTUDY|SCF_DO_SUBSTR))==SCF_DO_SUBSTR) + /* ? quantifier ok, except for (?{ ... }) */ + && (next_is_eval || !(mincount == 0 && maxcount == 1)) + && (minnext == 0) && (deltanext == 0) + && data && !(data->flags & (SF_HAS_PAR|SF_IN_PAR)) && maxcount <= REG_INFTY/3) /* Complement check for big count */ - { - _WARN_HELPER(RExC_precomp_end, packWARN(WARN_REGEXP), + { + _WARN_HELPER(RExC_precomp_end, packWARN(WARN_REGEXP), Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP), "Quantifier unexpected on zero-length expression " "in regex m/%" UTF8f "/", - UTF8fARG(UTF, RExC_precomp_end - RExC_precomp, - RExC_precomp))); + UTF8fARG(UTF, RExC_precomp_end - RExC_precomp, + RExC_precomp))); } if ( ( minnext > 0 && mincount >= SSize_t_MAX / minnext ) @@ -5606,146 +5607,146 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, FAIL("Regexp out of space"); } - min += minnext * mincount; - is_inf_internal |= deltanext == OPTIMIZE_INFTY + min += minnext * mincount; + is_inf_internal |= deltanext == OPTIMIZE_INFTY || (maxcount == REG_INFTY && minnext + deltanext > 0); - is_inf |= is_inf_internal; + is_inf |= is_inf_internal; if (is_inf) { - delta = OPTIMIZE_INFTY; + delta = OPTIMIZE_INFTY; } else { - delta += (minnext + deltanext) * maxcount + delta += (minnext + deltanext) * maxcount - minnext * mincount; } - /* Try powerful optimization CURLYX => CURLYN. */ - if ( OP(oscan) == CURLYX && data - && data->flags & SF_IN_PAR - && !(data->flags & SF_HAS_EVAL) - && !deltanext && minnext == 1 + /* Try powerful optimization CURLYX => CURLYN. */ + if ( OP(oscan) == CURLYX && data + && data->flags & SF_IN_PAR + && !(data->flags & SF_HAS_EVAL) + && !deltanext && minnext == 1 && mutate_ok ) { - /* Try to optimize to CURLYN. */ - regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; - regnode * const nxt1 = nxt; + /* Try to optimize to CURLYN. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; + regnode * const nxt1 = nxt; #ifdef DEBUGGING - regnode *nxt2; + regnode *nxt2; #endif - /* Skip open. */ - nxt = regnext(nxt); - if (!REGNODE_SIMPLE(OP(nxt)) - && !(PL_regkind[OP(nxt)] == EXACT - && STR_LEN(nxt) == 1)) - goto nogo; + /* Skip open. */ + nxt = regnext(nxt); + if (!REGNODE_SIMPLE(OP(nxt)) + && !(PL_regkind[OP(nxt)] == EXACT + && STR_LEN(nxt) == 1)) + goto nogo; #ifdef DEBUGGING - nxt2 = nxt; + nxt2 = nxt; #endif - nxt = regnext(nxt); - if (OP(nxt) != CLOSE) - goto nogo; - if (RExC_open_parens) { + nxt = regnext(nxt); + if (OP(nxt) != CLOSE) + goto nogo; + if (RExC_open_parens) { /*open->CURLYM*/ RExC_open_parens[ARG(nxt1)] = REGNODE_OFFSET(oscan); /*close->while*/ RExC_close_parens[ARG(nxt1)] = REGNODE_OFFSET(nxt) + 2; - } - /* Now we know that nxt2 is the only contents: */ - oscan->flags = (U8)ARG(nxt); - OP(oscan) = CURLYN; - OP(nxt1) = NOTHING; /* was OPEN. */ + } + /* Now we know that nxt2 is the only contents: */ + oscan->flags = (U8)ARG(nxt); + OP(oscan) = CURLYN; + OP(nxt1) = NOTHING; /* was OPEN. */ #ifdef DEBUGGING - OP(nxt1 + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */ - NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */ - OP(nxt) = OPTIMIZED; /* was CLOSE. */ - OP(nxt + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */ + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1+ 1) = 0; /* just for consistency. */ + NEXT_OFF(nxt2) = 0; /* just for consistency with CURLY. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt+ 1) = 0; /* just for consistency. */ #endif - } - nogo: - - /* Try optimization CURLYX => CURLYM. */ - if ( OP(oscan) == CURLYX && data - && !(data->flags & SF_HAS_PAR) - && !(data->flags & SF_HAS_EVAL) - && !deltanext /* atom is fixed width */ - && minnext != 0 /* CURLYM can't handle zero width */ + } + nogo: + + /* Try optimization CURLYX => CURLYM. */ + if ( OP(oscan) == CURLYX && data + && !(data->flags & SF_HAS_PAR) + && !(data->flags & SF_HAS_EVAL) + && !deltanext /* atom is fixed width */ + && minnext != 0 /* CURLYM can't handle zero width */ /* Nor characters whose fold at run-time may be * multi-character */ && ! (RExC_seen & REG_UNFOLDED_MULTI_SEEN) && mutate_ok - ) { - /* XXXX How to optimize if data == 0? */ - /* Optimize to a simpler form. */ - regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */ - regnode *nxt2; - - OP(oscan) = CURLYM; - while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ - && (OP(nxt2) != WHILEM)) - nxt = nxt2; - OP(nxt2) = SUCCEED; /* Whas WHILEM */ - /* Need to optimize away parenths. */ - if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) { - /* Set the parenth number. */ - regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ - - oscan->flags = (U8)ARG(nxt); - if (RExC_open_parens) { + ) { + /* XXXX How to optimize if data == 0? */ + /* Optimize to a simpler form. */ + regnode *nxt = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN */ + regnode *nxt2; + + OP(oscan) = CURLYM; + while ( (nxt2 = regnext(nxt)) /* skip over embedded stuff*/ + && (OP(nxt2) != WHILEM)) + nxt = nxt2; + OP(nxt2) = SUCCEED; /* Whas WHILEM */ + /* Need to optimize away parenths. */ + if ((data->flags & SF_IN_PAR) && OP(nxt) == CLOSE) { + /* Set the parenth number. */ + regnode *nxt1 = NEXTOPER(oscan) + EXTRA_STEP_2ARGS; /* OPEN*/ + + oscan->flags = (U8)ARG(nxt); + if (RExC_open_parens) { /*open->CURLYM*/ RExC_open_parens[ARG(nxt1)] = REGNODE_OFFSET(oscan); /*close->NOTHING*/ RExC_close_parens[ARG(nxt1)] = REGNODE_OFFSET(nxt2) + 1; - } - OP(nxt1) = OPTIMIZED; /* was OPEN. */ - OP(nxt) = OPTIMIZED; /* was CLOSE. */ + } + OP(nxt1) = OPTIMIZED; /* was OPEN. */ + OP(nxt) = OPTIMIZED; /* was CLOSE. */ #ifdef DEBUGGING - OP(nxt1 + 1) = OPTIMIZED; /* was count. */ - OP(nxt + 1) = OPTIMIZED; /* was count. */ - NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */ - NEXT_OFF(nxt + 1) = 0; /* just for consistency. */ + OP(nxt1 + 1) = OPTIMIZED; /* was count. */ + OP(nxt + 1) = OPTIMIZED; /* was count. */ + NEXT_OFF(nxt1 + 1) = 0; /* just for consistency. */ + NEXT_OFF(nxt + 1) = 0; /* just for consistency. */ #endif #if 0 - while ( nxt1 && (OP(nxt1) != WHILEM)) { - regnode *nnxt = regnext(nxt1); - if (nnxt == nxt) { - if (reg_off_by_arg[OP(nxt1)]) - ARG_SET(nxt1, nxt2 - nxt1); - else if (nxt2 - nxt1 < U16_MAX) - NEXT_OFF(nxt1) = nxt2 - nxt1; - else - OP(nxt) = NOTHING; /* Cannot beautify */ - } - nxt1 = nnxt; - } + while ( nxt1 && (OP(nxt1) != WHILEM)) { + regnode *nnxt = regnext(nxt1); + if (nnxt == nxt) { + if (reg_off_by_arg[OP(nxt1)]) + ARG_SET(nxt1, nxt2 - nxt1); + else if (nxt2 - nxt1 < U16_MAX) + NEXT_OFF(nxt1) = nxt2 - nxt1; + else + OP(nxt) = NOTHING; /* Cannot beautify */ + } + nxt1 = nnxt; + } #endif - /* Optimize again: */ + /* Optimize again: */ /* recurse study_chunk() on optimised CURLYX => CURLYM */ - study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, + study_chunk(pRExC_state, &nxt1, minlenp, &deltanext, nxt, NULL, stopparen, recursed_depth, NULL, 0, depth+1, mutate_ok); - } - else - oscan->flags = 0; - } - else if ((OP(oscan) == CURLYX) - && (flags & SCF_WHILEM_VISITED_POS) - /* See the comment on a similar expression above. - However, this time it's not a subexpression - we care about, but the expression itself. */ - && (maxcount == REG_INFTY) - && data) { - /* This stays as CURLYX, we can put the count/of pair. */ - /* Find WHILEM (as in regexec.c) */ - regnode *nxt = oscan + NEXT_OFF(oscan); - - if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */ - nxt += ARG(nxt); + } + else + oscan->flags = 0; + } + else if ((OP(oscan) == CURLYX) + && (flags & SCF_WHILEM_VISITED_POS) + /* See the comment on a similar expression above. + However, this time it's not a subexpression + we care about, but the expression itself. */ + && (maxcount == REG_INFTY) + && data) { + /* This stays as CURLYX, we can put the count/of pair. */ + /* Find WHILEM (as in regexec.c) */ + regnode *nxt = oscan + NEXT_OFF(oscan); + + if (OP(PREVOPER(nxt)) == NOTHING) /* LONGJMP */ + nxt += ARG(nxt); nxt = PREVOPER(nxt); if (nxt->flags & 0xf) { /* we've already set whilem count on this node */ @@ -5754,68 +5755,68 @@ S_study_chunk(pTHX_ RExC_state_t *pRExC_state, regnode **scanp, nxt->flags = (U8)(data->whilem_c | (RExC_whilem_seen << 4)); /* On WHILEM */ } - } - if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) - pars++; - if (flags & SCF_DO_SUBSTR) { - SV *last_str = NULL; + } + if (data && fl & (SF_HAS_PAR|SF_IN_PAR)) + pars++; + if (flags & SCF_DO_SUBSTR) { + SV *last_str = NULL; STRLEN last_chrs = 0; - int counted = mincount != 0; + int counted = mincount != 0; if (data->last_end > 0 && mincount != 0) { /* Ends with a string. */ - SSize_t b = pos_before >= data->last_start_min - ? pos_before : data->last_start_min; - STRLEN l; - const char * const s = SvPV_const(data->last_found, l); - SSize_t old = b - data->last_start_min; + SSize_t b = pos_before >= data->last_start_min + ? pos_before : data->last_start_min; + STRLEN l; + const char * const s = SvPV_const(data->last_found, l); + SSize_t old = b - data->last_start_min; assert(old >= 0); - if (UTF) - old = utf8_hop_forward((U8*)s, old, + if (UTF) + old = utf8_hop_forward((U8*)s, old, (U8 *) SvEND(data->last_found)) - (U8*)s; - l -= old; - /* Get the added string: */ - last_str = newSVpvn_utf8(s + old, l, UTF); + l -= old; + /* Get the added string: */ + last_str = newSVpvn_utf8(s + old, l, UTF); last_chrs = UTF ? utf8_length((U8*)(s + old), (U8*)(s + old + l)) : l; - if (deltanext == 0 && pos_before == b) { - /* What was added is a constant string */ - if (mincount > 1) { + if (deltanext == 0 && pos_before == b) { + /* What was added is a constant string */ + if (mincount > 1) { - SvGROW(last_str, (mincount * l) + 1); - repeatcpy(SvPVX(last_str) + l, - SvPVX_const(last_str), l, + SvGROW(last_str, (mincount * l) + 1); + repeatcpy(SvPVX(last_str) + l, + SvPVX_const(last_str), l, mincount - 1); - SvCUR_set(last_str, SvCUR(last_str) * mincount); - /* Add additional parts. */ - SvCUR_set(data->last_found, - SvCUR(data->last_found) - l); - sv_catsv(data->last_found, last_str); - { - SV * sv = data->last_found; - MAGIC *mg = - SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - if (mg && mg->mg_len >= 0) - mg->mg_len += last_chrs * (mincount-1); - } + SvCUR_set(last_str, SvCUR(last_str) * mincount); + /* Add additional parts. */ + SvCUR_set(data->last_found, + SvCUR(data->last_found) - l); + sv_catsv(data->last_found, last_str); + { + SV * sv = data->last_found; + MAGIC *mg = + SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + if (mg && mg->mg_len >= 0) + mg->mg_len += last_chrs * (mincount-1); + } last_chrs *= mincount; - data->last_end += l * (mincount - 1); - } - } else { - /* start offset must point into the last copy */ - data->last_start_min += minnext * (mincount - 1); - data->last_start_max = + data->last_end += l * (mincount - 1); + } + } else { + /* start offset must point into the last copy */ + data->last_start_min += minnext * (mincount - 1); + data->last_start_max = is_inf ? OPTIMIZE_INFTY - : data->last_start_max + + : data->last_start_max + (maxcount - 1) * (minnext + data->pos_delta); - } - } - /* It is counted once already... */ - data->pos_min += minnext * (mincount - counted); + } + } + /* It is counted once already... */ + data->pos_min += minnext * (mincount - counted); #if 0 Perl_re_printf( aTHX_ "counted=%" UVuf " deltanext=%" UVuf " OPTIMIZE_INFTY=%" UVuf " minnext=%" UVuf @@ -5827,52 +5828,52 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", (UV)(-counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount), (UV)(OPTIMIZE_INFTY - data->pos_delta)); #endif - if (deltanext == OPTIMIZE_INFTY + if (deltanext == OPTIMIZE_INFTY || -counted * deltanext + (minnext + deltanext) * maxcount - minnext * mincount >= OPTIMIZE_INFTY - data->pos_delta) - data->pos_delta = OPTIMIZE_INFTY; - else - data->pos_delta += - counted * deltanext + - (minnext + deltanext) * maxcount - minnext * mincount; - if (mincount != maxcount) { - /* Cannot extend fixed substrings found inside - the group. */ + data->pos_delta = OPTIMIZE_INFTY; + else + data->pos_delta += - counted * deltanext + + (minnext + deltanext) * maxcount - minnext * mincount; + if (mincount != maxcount) { + /* Cannot extend fixed substrings found inside + the group. */ scan_commit(pRExC_state, data, minlenp, is_inf); - if (mincount && last_str) { - SV * const sv = data->last_found; - MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? - mg_find(sv, PERL_MAGIC_utf8) : NULL; - - if (mg) - mg->mg_len = -1; - sv_setsv(sv, last_str); - data->last_end = data->pos_min; - data->last_start_min = data->pos_min - last_chrs; - data->last_start_max = is_inf - ? OPTIMIZE_INFTY - : data->pos_min + data->pos_delta - last_chrs; - } - data->cur_is_floating = 1; /* float */ - } - SvREFCNT_dec(last_str); - } - if (data && (fl & SF_HAS_EVAL)) - data->flags |= SF_HAS_EVAL; - optimize_curly_tail: - rck_elide_nothing(oscan); - continue; - - default: + if (mincount && last_str) { + SV * const sv = data->last_found; + MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? + mg_find(sv, PERL_MAGIC_utf8) : NULL; + + if (mg) + mg->mg_len = -1; + sv_setsv(sv, last_str); + data->last_end = data->pos_min; + data->last_start_min = data->pos_min - last_chrs; + data->last_start_max = is_inf + ? OPTIMIZE_INFTY + : data->pos_min + data->pos_delta - last_chrs; + } + data->cur_is_floating = 1; /* float */ + } + SvREFCNT_dec(last_str); + } + if (data && (fl & SF_HAS_EVAL)) + data->flags |= SF_HAS_EVAL; + optimize_curly_tail: + rck_elide_nothing(oscan); + continue; + + default: Perl_croak(aTHX_ "panic: unexpected varying REx opcode %d", OP(scan)); case REF: case CLUMP: - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_SUBSTR) { /* Cannot expect anything... */ scan_commit(pRExC_state, data, minlenp, is_inf); - data->cur_is_floating = 1; /* float */ - } - is_inf = is_inf_internal = 1; - if (flags & SCF_DO_STCLASS_OR) { + data->cur_is_floating = 1; /* float */ + } + is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) { if (OP(scan) == CLUMP) { /* Actually is any start char, but very few code points * aren't start characters */ @@ -5882,12 +5883,12 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_anything(data->start_class); } } - flags &= ~SCF_DO_STCLASS; - break; - } - } - else if (OP(scan) == LNBREAK) { - if (flags & SCF_DO_STCLASS) { + flags &= ~SCF_DO_STCLASS; + break; + } + } + else if (OP(scan) == LNBREAK) { + if (flags & SCF_DO_STCLASS) { if (flags & SCF_DO_STCLASS_AND) { ssc_intersection(data->start_class, PL_XPosix_ptrs[_CC_VERTSPACE], FALSE); @@ -5899,16 +5900,16 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_union(data->start_class, PL_XPosix_ptrs[_CC_VERTSPACE], FALSE); - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); /* See commit msg for * 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; } - flags &= ~SCF_DO_STCLASS; + flags &= ~SCF_DO_STCLASS; } - min++; + min++; if (delta != OPTIMIZE_INFTY) delta++; /* Because of the 2 char string cr-lf */ if (flags & SCF_DO_SUBSTR) { @@ -5918,17 +5919,17 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", if (data->pos_delta != OPTIMIZE_INFTY) { data->pos_delta += 1; } - data->cur_is_floating = 1; /* float */ + data->cur_is_floating = 1; /* float */ } - } - else if (REGNODE_SIMPLE(OP(scan))) { + } + else if (REGNODE_SIMPLE(OP(scan))) { - if (flags & SCF_DO_SUBSTR) { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - data->pos_min++; - } - min++; - if (flags & SCF_DO_STCLASS) { + data->pos_min++; + } + min++; + if (flags & SCF_DO_STCLASS) { bool invert = 0; SV* my_invlist = NULL; U8 namedclass; @@ -5936,21 +5937,21 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", /* See commit msg 749e076fceedeb708a624933726e7989f2302f6a */ ANYOF_FLAGS(data->start_class) &= ~SSC_MATCHES_EMPTY_STRING; - /* Some of the logic below assumes that switching - locale on will only add false positives. */ - switch (OP(scan)) { + /* Some of the logic below assumes that switching + locale on will only add false positives. */ + switch (OP(scan)) { - default: + default: #ifdef DEBUGGING Perl_croak(aTHX_ "panic: unexpected simple REx opcode %d", OP(scan)); #endif - case SANY: - if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ - ssc_match_all_cp(data->start_class); - break; + case SANY: + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + ssc_match_all_cp(data->start_class); + break; - case REG_ANY: + case REG_ANY: { SV* REG_ANY_invlist = _new_invlist(2); REG_ANY_invlist = add_cp_to_invlist(REG_ANY_invlist, @@ -5970,8 +5971,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_clear_locale(data->start_class); } SvREFCNT_dec_NN(REG_ANY_invlist); - } - break; + } + break; case ANYOFD: case ANYOFL: @@ -5981,13 +5982,13 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", case ANYOFHr: case ANYOFHs: case ANYOF: - if (flags & SCF_DO_STCLASS_AND) - ssc_and(pRExC_state, data->start_class, + if (flags & SCF_DO_STCLASS_AND) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) scan); - else - ssc_or(pRExC_state, data->start_class, + else + ssc_or(pRExC_state, data->start_class, (regnode_charclass *) scan); - break; + break; case NANYOFM: /* NANYOFM already contains the inversion of the input ANYOF data, so, unlike things like @@ -6028,11 +6029,11 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", break; } - case NPOSIXL: + case NPOSIXL: invert = 1; /* FALLTHROUGH */ - case POSIXL: + case POSIXL: namedclass = classnum_to_namedclass(FLAGS(scan)) + invert; if (flags & SCF_DO_STCLASS_AND) { bool was_there = cBOOL( @@ -6072,16 +6073,16 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", what's matched */ invert = 1; /* FALLTHROUGH */ - case POSIXA: + case POSIXA: my_invlist = invlist_clone(PL_Posix_ptrs[FLAGS(scan)], NULL); goto join_posix_and_ascii; - case NPOSIXD: - case NPOSIXU: + case NPOSIXD: + case NPOSIXU: invert = 1; /* FALLTHROUGH */ - case POSIXD: - case POSIXU: + case POSIXD: + case POSIXU: my_invlist = invlist_clone(PL_XPosix_ptrs[FLAGS(scan)], NULL); /* NPOSIXD matches all upper Latin1 code points unless the @@ -6105,23 +6106,23 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", ssc_union(data->start_class, my_invlist, invert); } SvREFCNT_dec(my_invlist); - } - if (flags & SCF_DO_STCLASS_OR) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); - flags &= ~SCF_DO_STCLASS; - } - } - else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { - data->flags |= (OP(scan) == MEOL - ? SF_BEFORE_MEOL - : SF_BEFORE_SEOL); + } + if (flags & SCF_DO_STCLASS_OR) + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + flags &= ~SCF_DO_STCLASS; + } + } + else if (PL_regkind[OP(scan)] == EOL && flags & SCF_DO_SUBSTR) { + data->flags |= (OP(scan) == MEOL + ? SF_BEFORE_MEOL + : SF_BEFORE_SEOL); scan_commit(pRExC_state, data, minlenp, is_inf); - } - else if ( PL_regkind[OP(scan)] == BRANCHJ - /* Lookbehind, or need to calculate parens/evals/stclass: */ - && (scan->flags || data || (flags & SCF_DO_STCLASS)) - && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) + } + else if ( PL_regkind[OP(scan)] == BRANCHJ + /* Lookbehind, or need to calculate parens/evals/stclass: */ + && (scan->flags || data || (flags & SCF_DO_STCLASS)) + && (OP(scan) == IFMATCH || OP(scan) == UNLESSM)) { if ( !PERL_ENABLE_POSITIVE_ASSERTION_STUDY || OP(scan) == UNLESSM ) @@ -6139,16 +6140,16 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", if (data) { data_fake.whilem_c = data->whilem_c; data_fake.last_closep = data->last_closep; - } + } else data_fake.last_closep = &fake; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if ( flags & SCF_DO_STCLASS && !scan->flags && OP(scan) == IFMATCH ) { /* Lookahead */ ssc_init(pRExC_state, &intrnl); data_fake.start_class = &intrnl; f |= SCF_DO_STCLASS_AND; - } + } if (flags & SCF_WHILEM_VISITED_POS) f |= SCF_WHILEM_VISITED_POS; next = regnext(scan); @@ -6165,7 +6166,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", || minnext > (I32)U8_MAX || minnext + deltanext > (I32)U8_MAX) { - FAIL2("Lookbehind longer than %" UVuf " not implemented", + FAIL2("Lookbehind longer than %" UVuf " not implemented", (UV)U8_MAX); } @@ -6190,24 +6191,24 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", data->whilem_c = data_fake.whilem_c; } if (f & SCF_DO_STCLASS_AND) { - if (flags & SCF_DO_STCLASS_OR) { - /* OR before, AND after: ideally we would recurse with - * data_fake to get the AND applied by study of the - * remainder of the pattern, and then derecurse; - * *** HACK *** for now just treat as "no information". - * See [perl #56690]. - */ - ssc_init(pRExC_state, data->start_class); - } else { + if (flags & SCF_DO_STCLASS_OR) { + /* OR before, AND after: ideally we would recurse with + * data_fake to get the AND applied by study of the + * remainder of the pattern, and then derecurse; + * *** HACK *** for now just treat as "no information". + * See [perl #56690]. + */ + ssc_init(pRExC_state, data->start_class); + } else { /* AND before and after: combine and continue. These * assertions are zero-length, so can match an EMPTY * string */ - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) &intrnl); ANYOF_FLAGS(data->start_class) |= SSC_MATCHES_EMPTY_STRING; - } + } } - } + } #if PERL_ENABLE_POSITIVE_ASSERTION_STUDY else { /* Positive Lookahead/lookbehind @@ -6245,9 +6246,9 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", data_fake.flags = 0; data_fake.substrs[0].flags = 0; data_fake.substrs[1].flags = 0; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if (is_inf) - data_fake.flags |= SF_IS_INF; + data_fake.flags |= SF_IS_INF; if ( flags & SCF_DO_STCLASS && !scan->flags && OP(scan) == IFMATCH ) { /* Lookahead */ ssc_init(pRExC_state, &intrnl); @@ -6272,7 +6273,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", || *minnextp > (I32)U8_MAX || *minnextp + deltanext > (I32)U8_MAX) { - FAIL2("Lookbehind longer than %" UVuf " not implemented", + FAIL2("Lookbehind longer than %" UVuf " not implemented", (UV)U8_MAX); } @@ -6314,65 +6315,65 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", } } } - } + } #endif - } - else if (OP(scan) == OPEN) { - if (stopparen != (I32)ARG(scan)) - pars++; - } - else if (OP(scan) == CLOSE) { - if (stopparen == (I32)ARG(scan)) { - break; - } - if ((I32)ARG(scan) == is_par) { - next = regnext(scan); - - if ( next && (OP(next) != WHILEM) && next < last) - is_par = 0; /* Disable optimization */ - } - if (data) - *(data->last_closep) = ARG(scan); - } - else if (OP(scan) == EVAL) { - if (data) - data->flags |= SF_HAS_EVAL; - } - else if ( PL_regkind[OP(scan)] == ENDLIKE ) { - if (flags & SCF_DO_SUBSTR) { + } + else if (OP(scan) == OPEN) { + if (stopparen != (I32)ARG(scan)) + pars++; + } + else if (OP(scan) == CLOSE) { + if (stopparen == (I32)ARG(scan)) { + break; + } + if ((I32)ARG(scan) == is_par) { + next = regnext(scan); + + if ( next && (OP(next) != WHILEM) && next < last) + is_par = 0; /* Disable optimization */ + } + if (data) + *(data->last_closep) = ARG(scan); + } + else if (OP(scan) == EVAL) { + if (data) + data->flags |= SF_HAS_EVAL; + } + else if ( PL_regkind[OP(scan)] == ENDLIKE ) { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - flags &= ~SCF_DO_SUBSTR; - } - if (data && OP(scan)==ACCEPT) { - data->flags |= SCF_SEEN_ACCEPT; - if (stopmin > min) - stopmin = min; - } - } - else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */ - { - if (flags & SCF_DO_SUBSTR) { + flags &= ~SCF_DO_SUBSTR; + } + if (data && OP(scan)==ACCEPT) { + data->flags |= SCF_SEEN_ACCEPT; + if (stopmin > min) + stopmin = min; + } + } + else if (OP(scan) == LOGICAL && scan->flags == 2) /* Embedded follows */ + { + if (flags & SCF_DO_SUBSTR) { scan_commit(pRExC_state, data, minlenp, is_inf); - data->cur_is_floating = 1; /* float */ - } - is_inf = is_inf_internal = 1; - if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ - ssc_anything(data->start_class); - flags &= ~SCF_DO_STCLASS; - } - else if (OP(scan) == GPOS) { + data->cur_is_floating = 1; /* float */ + } + is_inf = is_inf_internal = 1; + if (flags & SCF_DO_STCLASS_OR) /* Allow everything */ + ssc_anything(data->start_class); + flags &= ~SCF_DO_STCLASS; + } + else if (OP(scan) == GPOS) { if (!(RExC_rx->intflags & PREGf_GPOS_FLOAT) && - !(delta || is_inf || (data && data->pos_delta))) - { + !(delta || is_inf || (data && data->pos_delta))) + { if (!(RExC_rx->intflags & PREGf_ANCH) && (flags & SCF_DO_SUBSTR)) RExC_rx->intflags |= PREGf_ANCH_GPOS; - if (RExC_rx->gofs < (STRLEN)min) - RExC_rx->gofs = min; + if (RExC_rx->gofs < (STRLEN)min) + RExC_rx->gofs = min; } else { RExC_rx->intflags |= PREGf_GPOS_FLOAT; RExC_rx->gofs = 0; } - } + } #ifdef TRIE_STUDY_OPT #ifdef FULL_TRIE_STUDY else if (PL_regkind[OP(scan)] == TRIE) { @@ -6411,7 +6412,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", } else data_fake.last_closep = &fake; - data_fake.pos_delta = delta; + data_fake.pos_delta = delta; if (flags & SCF_DO_STCLASS) { ssc_init(pRExC_state, &this_class); data_fake.start_class = &this_class; @@ -6448,11 +6449,11 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", pars++; if (data_fake.flags & SCF_SEEN_ACCEPT) { if ( stopmin > min + min1) - stopmin = min + min1; - flags &= ~SCF_DO_SUBSTR; - if (data) - data->flags |= SCF_SEEN_ACCEPT; - } + stopmin = min + min1; + flags &= ~SCF_DO_SUBSTR; + if (data) + data->flags |= SCF_SEEN_ACCEPT; + } if (data) { if (data_fake.flags & SF_HAS_EVAL) data->flags |= SF_HAS_EVAL; @@ -6490,7 +6491,7 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", else { /* Switch to OR mode: cache the old value of * data->start_class */ - INIT_AND_WITHP; + INIT_AND_WITHP; StructCopy(data->start_class, and_withp, regnode_ssc); flags &= ~SCF_DO_STCLASS_AND; StructCopy(&accum, data->start_class, regnode_ssc); @@ -6501,24 +6502,24 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", continue; } #else - else if (PL_regkind[OP(scan)] == TRIE) { - reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ]; - U8*bang=NULL; + else if (PL_regkind[OP(scan)] == TRIE) { + reg_trie_data *trie = (reg_trie_data*)RExC_rxi->data->data[ ARG(scan) ]; + U8*bang=NULL; - min += trie->minlen; - delta += (trie->maxlen - trie->minlen); - flags &= ~SCF_DO_STCLASS; /* xxx */ + min += trie->minlen; + delta += (trie->maxlen - trie->minlen); + flags &= ~SCF_DO_STCLASS; /* xxx */ if (flags & SCF_DO_SUBSTR) { /* Cannot expect anything... */ scan_commit(pRExC_state, data, minlenp, is_inf); data->pos_min += trie->minlen; data->pos_delta += (trie->maxlen - trie->minlen); - if (trie->maxlen != trie->minlen) - data->cur_is_floating = 1; /* float */ + if (trie->maxlen != trie->minlen) + data->cur_is_floating = 1; /* float */ } if (trie->jump) /* no more substrings -- for now /grr*/ flags &= ~SCF_DO_SUBSTR; - } + } else if (OP(scan) == REGEX_SET) { Perl_croak(aTHX_ "panic: %s regnode should be resolved" " before optimization", reg_name[REGEX_SET]); @@ -6527,8 +6528,8 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", #endif /* old or new */ #endif /* TRIE_STUDY_OPT */ - /* Else: zero-length, ignore. */ - scan = regnext(scan); + /* Else: zero-length, ignore. */ + scan = regnext(scan); } finish: @@ -6557,19 +6558,19 @@ Perl_re_printf( aTHX_ "LHS=%" UVuf " RHS=%" UVuf "\n", *deltap = is_inf_internal ? OPTIMIZE_INFTY : delta; if (flags & SCF_DO_SUBSTR && is_inf) - data->pos_delta = OPTIMIZE_INFTY - data->pos_min; + data->pos_delta = OPTIMIZE_INFTY - data->pos_min; if (is_par > (I32)U8_MAX) - is_par = 0; + is_par = 0; if (is_par && pars==1 && data) { - data->flags |= SF_IN_PAR; - data->flags &= ~SF_HAS_PAR; + data->flags |= SF_IN_PAR; + data->flags &= ~SF_HAS_PAR; } else if (pars && data) { - data->flags |= SF_HAS_PAR; - data->flags &= ~SF_IN_PAR; + data->flags |= SF_HAS_PAR; + data->flags &= ~SF_IN_PAR; } if (flags & SCF_DO_STCLASS_OR) - ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); + ssc_and(pRExC_state, data->start_class, (regnode_charclass *) and_withp); if (flags & SCF_TRIE_RESTUDY) data->flags |= SCF_TRIE_RESTUDY; @@ -6595,12 +6596,12 @@ S_add_data(RExC_state_t* const pRExC_state, const char* const s, const U32 n) PERL_ARGS_ASSERT_ADD_DATA; Renewc(RExC_rxi->data, - sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), - char, struct reg_data); + sizeof(*RExC_rxi->data) + sizeof(void*) * (count + n - 1), + char, struct reg_data); if(count) - Renew(RExC_rxi->data->what, count + n, U8); + Renew(RExC_rxi->data->what, count + n, U8); else - Newx(RExC_rxi->data->what, n, U8); + Newx(RExC_rxi->data->what, n, U8); RExC_rxi->data->count = count + n; Copy(s, RExC_rxi->data->what + count, n, U8); return count; @@ -6614,22 +6615,22 @@ Perl_reginitcolors(pTHX) { const char * const s = PerlEnv_getenv("PERL_RE_COLORS"); if (s) { - char *t = savepv(s); - int i = 0; - PL_colors[0] = t; - while (++i < 6) { - t = strchr(t, '\t'); - if (t) { - *t = '\0'; - PL_colors[i] = ++t; - } - else - PL_colors[i] = t = (char *)""; - } + char *t = savepv(s); + int i = 0; + PL_colors[0] = t; + while (++i < 6) { + t = strchr(t, '\t'); + if (t) { + *t = '\0'; + PL_colors[i] = ++t; + } + else + PL_colors[i] = t = (char *)""; + } } else { - int i = 0; - while (i < 6) - PL_colors[i++] = (char *)""; + int i = 0; + while (i < 6) + PL_colors[i++] = (char *)""; } PL_colorset = 1; } @@ -6666,24 +6667,24 @@ regexp_engine const * Perl_current_re_engine(pTHX) { if (IN_PERL_COMPILETIME) { - HV * const table = GvHV(PL_hintgv); - SV **ptr; + HV * const table = GvHV(PL_hintgv); + SV **ptr; - if (!table || !(PL_hints & HINT_LOCALIZE_HH)) - return &PL_core_reg_engine; - ptr = hv_fetchs(table, "regcomp", FALSE); - if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr))) - return &PL_core_reg_engine; - return INT2PTR(regexp_engine*, SvIV(*ptr)); + if (!table || !(PL_hints & HINT_LOCALIZE_HH)) + return &PL_core_reg_engine; + ptr = hv_fetchs(table, "regcomp", FALSE); + if ( !(ptr && SvIOK(*ptr) && SvIV(*ptr))) + return &PL_core_reg_engine; + return INT2PTR(regexp_engine*, SvIV(*ptr)); } else { - SV *ptr; - if (!PL_curcop->cop_hints_hash) - return &PL_core_reg_engine; - ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0); - if ( !(ptr && SvIOK(ptr) && SvIV(ptr))) - return &PL_core_reg_engine; - return INT2PTR(regexp_engine*, SvIV(ptr)); + SV *ptr; + if (!PL_curcop->cop_hints_hash) + return &PL_core_reg_engine; + ptr = cop_hints_fetch_pvs(PL_curcop, "regcomp", 0); + if ( !(ptr && SvIOK(ptr) && SvIV(ptr))) + return &PL_core_reg_engine; + return INT2PTR(regexp_engine*, SvIV(ptr)); } } @@ -6699,7 +6700,7 @@ Perl_pregcomp(pTHX_ SV * const pattern, const U32 flags) /* Dispatch a request to compile a regexp to correct regexp engine. */ DEBUG_COMPILE_r({ Perl_re_printf( aTHX_ "Using engine %" UVxf "\n", - PTR2UV(eng)); + PTR2UV(eng)); }); return CALLREGCOMP_ENG(eng, pattern, flags); } @@ -6770,7 +6771,7 @@ S_alloc_code_blocks(pTHX_ int ncode) static void S_pat_upgrade_to_utf8(pTHX_ RExC_state_t * const pRExC_state, - char **pat_p, STRLEN *plen_p, int num_code_blocks) + char **pat_p, STRLEN *plen_p, int num_code_blocks) { U8 *const src = (U8*)*pat_p; U8 *dst, *d; @@ -6929,7 +6930,7 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state, oplist = OpSIBLING(oplist);; } - /* apply magic and QR overloading to arg */ + /* apply magic and QR overloading to arg */ SvGETMAGIC(msv); if (SvROK(msv) && SvAMAGIC(msv)) { @@ -7061,7 +7062,7 @@ S_concat_pat(pTHX_ RExC_state_t * const pRExC_state, static bool S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, - char *pat, STRLEN plen) + char *pat, STRLEN plen) { int n = 0; STRLEN s; @@ -7069,21 +7070,21 @@ S_has_runtime_code(pTHX_ RExC_state_t * const pRExC_state, PERL_UNUSED_CONTEXT; for (s = 0; s < plen; s++) { - if ( pRExC_state->code_blocks + if ( pRExC_state->code_blocks && n < pRExC_state->code_blocks->count - && s == pRExC_state->code_blocks->cb[n].start) - { - s = pRExC_state->code_blocks->cb[n].end; - n++; - continue; - } - /* TODO ideally should handle [..], (#..), /#.../x to reduce false - * positives here */ - if (pat[s] == '(' && s+2 <= plen && pat[s+1] == '?' && - (pat[s+2] == '{' + && s == pRExC_state->code_blocks->cb[n].start) + { + s = pRExC_state->code_blocks->cb[n].end; + n++; + continue; + } + /* TODO ideally should handle [..], (#..), /#.../x to reduce false + * positives here */ + if (pat[s] == '(' && s+2 <= plen && pat[s+1] == '?' && + (pat[s+2] == '{' || (s + 2 <= plen && pat[s+2] == '?' && pat[s+3] == '{')) - ) - return 1; + ) + return 1; } return 0; } @@ -7120,39 +7121,39 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, DECLARE_AND_GET_RE_DEBUG_FLAGS; if (pRExC_state->runtime_code_qr) { - /* this is the second time we've been called; this should - * only happen if the main pattern got upgraded to utf8 - * during compilation; re-use the qr we compiled first time - * round (which should be utf8 too) - */ - qr = pRExC_state->runtime_code_qr; - pRExC_state->runtime_code_qr = NULL; - assert(RExC_utf8 && SvUTF8(qr)); + /* this is the second time we've been called; this should + * only happen if the main pattern got upgraded to utf8 + * during compilation; re-use the qr we compiled first time + * round (which should be utf8 too) + */ + qr = pRExC_state->runtime_code_qr; + pRExC_state->runtime_code_qr = NULL; + assert(RExC_utf8 && SvUTF8(qr)); } else { - int n = 0; - STRLEN s; - char *p, *newpat; - int newlen = plen + 7; /* allow for "qr''xx\0" extra chars */ - SV *sv, *qr_ref; - dSP; - - /* determine how many extra chars we need for ' and \ escaping */ - for (s = 0; s < plen; s++) { - if (pat[s] == '\'' || pat[s] == '\\') - newlen++; - } - - Newx(newpat, newlen, char); - p = newpat; - *p++ = 'q'; *p++ = 'r'; *p++ = '\''; - - for (s = 0; s < plen; s++) { - if ( pRExC_state->code_blocks - && n < pRExC_state->code_blocks->count - && s == pRExC_state->code_blocks->cb[n].start) - { - /* blank out literal code block so that they aren't + int n = 0; + STRLEN s; + char *p, *newpat; + int newlen = plen + 7; /* allow for "qr''xx\0" extra chars */ + SV *sv, *qr_ref; + dSP; + + /* determine how many extra chars we need for ' and \ escaping */ + for (s = 0; s < plen; s++) { + if (pat[s] == '\'' || pat[s] == '\\') + newlen++; + } + + Newx(newpat, newlen, char); + p = newpat; + *p++ = 'q'; *p++ = 'r'; *p++ = '\''; + + for (s = 0; s < plen; s++) { + if ( pRExC_state->code_blocks + && n < pRExC_state->code_blocks->count + && s == pRExC_state->code_blocks->cb[n].start) + { + /* blank out literal code block so that they aren't * recompiled: eg change from/to: * /(?{xyz})/ * /(?=====)/ @@ -7163,76 +7164,76 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, * /(?(?{xyz}))/ * /(?(?=====))/ */ - assert(pat[s] == '('); - assert(pat[s+1] == '?'); + assert(pat[s] == '('); + assert(pat[s+1] == '?'); *p++ = '('; *p++ = '?'; s += 2; - while (s < pRExC_state->code_blocks->cb[n].end) { - *p++ = '='; - s++; - } + while (s < pRExC_state->code_blocks->cb[n].end) { + *p++ = '='; + s++; + } *p++ = ')'; - n++; - continue; - } - if (pat[s] == '\'' || pat[s] == '\\') - *p++ = '\\'; - *p++ = pat[s]; - } - *p++ = '\''; - if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) { - *p++ = 'x'; + n++; + continue; + } + if (pat[s] == '\'' || pat[s] == '\\') + *p++ = '\\'; + *p++ = pat[s]; + } + *p++ = '\''; + if (pRExC_state->pm_flags & RXf_PMf_EXTENDED) { + *p++ = 'x'; if (pRExC_state->pm_flags & RXf_PMf_EXTENDED_MORE) { *p++ = 'x'; } } - *p++ = '\0'; - DEBUG_COMPILE_r({ + *p++ = '\0'; + DEBUG_COMPILE_r({ Perl_re_printf( aTHX_ - "%sre-parsing pattern for runtime code:%s %s\n", - PL_colors[4], PL_colors[5], newpat); - }); + "%sre-parsing pattern for runtime code:%s %s\n", + PL_colors[4], PL_colors[5], newpat); + }); - sv = newSVpvn_flags(newpat, p-newpat-1, RExC_utf8 ? SVf_UTF8 : 0); - Safefree(newpat); + sv = newSVpvn_flags(newpat, p-newpat-1, RExC_utf8 ? SVf_UTF8 : 0); + Safefree(newpat); - ENTER; - SAVETMPS; - save_re_context(); - PUSHSTACKi(PERLSI_REQUIRE); + ENTER; + SAVETMPS; + save_re_context(); + PUSHSTACKi(PERLSI_REQUIRE); /* G_RE_REPARSING causes the toker to collapse \\ into \ when * parsing qr''; normally only q'' does this. It also alters * hints handling */ - eval_sv(sv, G_SCALAR|G_RE_REPARSING); - SvREFCNT_dec_NN(sv); - SPAGAIN; - qr_ref = POPs; - PUTBACK; - { - SV * const errsv = ERRSV; - if (SvTRUE_NN(errsv)) + eval_sv(sv, G_SCALAR|G_RE_REPARSING); + SvREFCNT_dec_NN(sv); + SPAGAIN; + qr_ref = POPs; + PUTBACK; + { + SV * const errsv = ERRSV; + if (SvTRUE_NN(errsv)) /* use croak_sv ? */ - Perl_croak_nocontext("%" SVf, SVfARG(errsv)); - } - assert(SvROK(qr_ref)); - qr = SvRV(qr_ref); - assert(SvTYPE(qr) == SVt_REGEXP && RX_ENGINE((REGEXP*)qr)->op_comp); - /* the leaving below frees the tmp qr_ref. - * Give qr a life of its own */ - SvREFCNT_inc(qr); - POPSTACK; - FREETMPS; - LEAVE; + Perl_croak_nocontext("%" SVf, SVfARG(errsv)); + } + assert(SvROK(qr_ref)); + qr = SvRV(qr_ref); + assert(SvTYPE(qr) == SVt_REGEXP && RX_ENGINE((REGEXP*)qr)->op_comp); + /* the leaving below frees the tmp qr_ref. + * Give qr a life of its own */ + SvREFCNT_inc(qr); + POPSTACK; + FREETMPS; + LEAVE; } if (!RExC_utf8 && SvUTF8(qr)) { - /* first time through; the pattern got upgraded; save the - * qr for the next time through */ - assert(!pRExC_state->runtime_code_qr); - pRExC_state->runtime_code_qr = qr; - return 0; + /* first time through; the pattern got upgraded; save the + * qr for the next time through */ + assert(!pRExC_state->runtime_code_qr); + pRExC_state->runtime_code_qr = qr; + return 0; } @@ -7241,17 +7242,17 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, /* merge the main (r1) and run-time (r2) code blocks into one */ { - RXi_GET_DECL(ReANY((REGEXP *)qr), r2); - struct reg_code_block *new_block, *dst; - RExC_state_t * const r1 = pRExC_state; /* convenient alias */ - int i1 = 0, i2 = 0; + RXi_GET_DECL(ReANY((REGEXP *)qr), r2); + struct reg_code_block *new_block, *dst; + RExC_state_t * const r1 = pRExC_state; /* convenient alias */ + int i1 = 0, i2 = 0; int r1c, r2c; - if (!r2->code_blocks || !r2->code_blocks->count) /* we guessed wrong */ - { - SvREFCNT_dec_NN(qr); - return 1; - } + if (!r2->code_blocks || !r2->code_blocks->count) /* we guessed wrong */ + { + SvREFCNT_dec_NN(qr); + return 1; + } if (!r1->code_blocks) r1->code_blocks = S_alloc_code_blocks(aTHX_ 0); @@ -7259,46 +7260,46 @@ S_compile_runtime_code(pTHX_ RExC_state_t * const pRExC_state, r1c = r1->code_blocks->count; r2c = r2->code_blocks->count; - Newx(new_block, r1c + r2c, struct reg_code_block); - - dst = new_block; - - while (i1 < r1c || i2 < r2c) { - struct reg_code_block *src; - bool is_qr = 0; - - if (i1 == r1c) { - src = &r2->code_blocks->cb[i2++]; - is_qr = 1; - } - else if (i2 == r2c) - src = &r1->code_blocks->cb[i1++]; - else if ( r1->code_blocks->cb[i1].start - < r2->code_blocks->cb[i2].start) - { - src = &r1->code_blocks->cb[i1++]; - assert(src->end < r2->code_blocks->cb[i2].start); - } - else { - assert( r1->code_blocks->cb[i1].start - > r2->code_blocks->cb[i2].start); - src = &r2->code_blocks->cb[i2++]; - is_qr = 1; - assert(src->end < r1->code_blocks->cb[i1].start); - } - - assert(pat[src->start] == '('); - assert(pat[src->end] == ')'); - dst->start = src->start; - dst->end = src->end; - dst->block = src->block; - dst->src_regex = is_qr ? (REGEXP*) SvREFCNT_inc( (SV*) qr) - : src->src_regex; - dst++; - } - r1->code_blocks->count += r2c; - Safefree(r1->code_blocks->cb); - r1->code_blocks->cb = new_block; + Newx(new_block, r1c + r2c, struct reg_code_block); + + dst = new_block; + + while (i1 < r1c || i2 < r2c) { + struct reg_code_block *src; + bool is_qr = 0; + + if (i1 == r1c) { + src = &r2->code_blocks->cb[i2++]; + is_qr = 1; + } + else if (i2 == r2c) + src = &r1->code_blocks->cb[i1++]; + else if ( r1->code_blocks->cb[i1].start + < r2->code_blocks->cb[i2].start) + { + src = &r1->code_blocks->cb[i1++]; + assert(src->end < r2->code_blocks->cb[i2].start); + } + else { + assert( r1->code_blocks->cb[i1].start + > r2->code_blocks->cb[i2].start); + src = &r2->code_blocks->cb[i2++]; + is_qr = 1; + assert(src->end < r1->code_blocks->cb[i1].start); + } + + assert(pat[src->start] == '('); + assert(pat[src->end] == ')'); + dst->start = src->start; + dst->end = src->end; + dst->block = src->block; + dst->src_regex = is_qr ? (REGEXP*) SvREFCNT_inc( (SV*) qr) + : src->src_regex; + dst++; + } + r1->code_blocks->count += r2c; + Safefree(r1->code_blocks->cb); + r1->code_blocks->cb = new_block; } SvREFCNT_dec_NN(qr); @@ -7506,8 +7507,8 @@ S_set_regex_pv(pTHX_ RExC_state_t *pRExC_state, REGEXP *Rx) REGEXP * Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, - OP *expr, const regexp_engine* eng, REGEXP *old_re, - bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags) + OP *expr, const regexp_engine* eng, REGEXP *old_re, + bool *is_bare_re, const U32 orig_rx_flags, const U32 pm_flags) { REGEXP *Rx; /* Capital 'R' means points to a REGEXP */ STRLEN plen; @@ -7548,19 +7549,19 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, pRExC_state->code_blocks = NULL; if (is_bare_re) - *is_bare_re = FALSE; + *is_bare_re = FALSE; if (expr && (expr->op_type == OP_LIST || - (expr->op_type == OP_NULL && expr->op_targ == OP_LIST))) { - /* allocate code_blocks if needed */ - OP *o; - int ncode = 0; + (expr->op_type == OP_NULL && expr->op_targ == OP_LIST))) { + /* allocate code_blocks if needed */ + OP *o; + int ncode = 0; - for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) - if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) - ncode++; /* count of DO blocks */ + for (o = cLISTOPx(expr)->op_first; o; o = OpSIBLING(o)) + if (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)) + ncode++; /* count of DO blocks */ - if (ncode) + if (ncode) pRExC_state->code_blocks = S_alloc_code_blocks(aTHX_ ncode); } @@ -7638,15 +7639,15 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, exp = SvPV_nomg(pat, plen); if (!eng->op_comp) { - if ((SvUTF8(pat) && IN_BYTES) - || SvGMAGICAL(pat) || SvAMAGIC(pat)) - { - /* make a temporary copy; either to convert to bytes, - * or to avoid repeating get-magic / overloaded stringify */ - pat = newSVpvn_flags(exp, plen, SVs_TEMP | - (IN_BYTES ? 0 : SvUTF8(pat))); - } - return CALLREGCOMP_ENG(eng, pat, orig_rx_flags); + if ((SvUTF8(pat) && IN_BYTES) + || SvGMAGICAL(pat) || SvAMAGIC(pat)) + { + /* make a temporary copy; either to convert to bytes, + * or to avoid repeating get-magic / overloaded stringify */ + pat = newSVpvn_flags(exp, plen, SVs_TEMP | + (IN_BYTES ? 0 : SvUTF8(pat))); + } + return CALLREGCOMP_ENG(eng, pat, orig_rx_flags); } /* ignore the utf8ness if the pattern is 0 length */ @@ -7690,11 +7691,11 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, * to utf8 */ if ((pm_flags & PMf_USE_RE_EVAL) - /* this second condition covers the non-regex literal case, - * i.e. $foo =~ '(?{})'. */ - || (IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) + /* this second condition covers the non-regex literal case, + * i.e. $foo =~ '(?{})'. */ + || (IN_PERL_COMPILETIME && (PL_hints & HINT_RE_EVAL)) ) - runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen); + runtime_code = S_has_runtime_code(aTHX_ pRExC_state, exp, plen); redo_parse: /* return old regex if pattern hasn't changed */ @@ -7708,10 +7709,10 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, && !recompile && !!RX_UTF8(old_re) == !!RExC_utf8 && ( RX_COMPFLAGS(old_re) == ( orig_rx_flags & RXf_PMf_FLAGCOPYMASK ) ) - && RX_PRECOMP(old_re) - && RX_PRELEN(old_re) == plen + && RX_PRECOMP(old_re) + && RX_PRELEN(old_re) == plen && memEQ(RX_PRECOMP(old_re), exp, plen) - && !runtime_code /* with runtime code, always recompile */ ) + && !runtime_code /* with runtime code, always recompile */ ) { DEBUG_COMPILE_r({ SV *dsv= sv_newmortal(); @@ -7734,9 +7735,9 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, && initial_charset == REGEX_DEPENDS_CHARSET) { - /* Set to use unicode semantics if the pattern is in utf8 and has the - * 'depends' charset specified, as it means unicode when utf8 */ - set_regex_charset(&rx_flags, REGEX_UNICODE_CHARSET); + /* Set to use unicode semantics if the pattern is in utf8 and has the + * 'depends' charset specified, as it means unicode when utf8 */ + set_regex_charset(&rx_flags, REGEX_UNICODE_CHARSET); RExC_uni_semantics = 1; } @@ -7744,16 +7745,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if (runtime_code) { assert(TAINTING_get || !TAINT_get); - if (TAINT_get) - Perl_croak(aTHX_ "Eval-group in insecure regular expression"); + if (TAINT_get) + Perl_croak(aTHX_ "Eval-group in insecure regular expression"); - if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) { - /* whoops, we have a non-utf8 pattern, whilst run-time code - * got compiled as utf8. Try again with a utf8 pattern */ + if (!S_compile_runtime_code(aTHX_ pRExC_state, exp, plen)) { + /* whoops, we have a non-utf8 pattern, whilst run-time code + * got compiled as utf8. Try again with a utf8 pattern */ S_pat_upgrade_to_utf8(aTHX_ pRExC_state, &exp, &plen, pRExC_state->code_blocks ? pRExC_state->code_blocks->count : 0); goto redo_parse; - } + } } assert(!pRExC_state->runtime_code_qr); @@ -7828,7 +7829,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RXp_COMPFLAGS(RExC_rx) = orig_rx_flags & RXf_PMf_FLAGCOPYMASK; if (pm_flags & PMf_IS_QR) { - RExC_rxi->code_blocks = pRExC_state->code_blocks; + RExC_rxi->code_blocks = pRExC_state->code_blocks; if (RExC_rxi->code_blocks) { RExC_rxi->code_blocks->refcnt++; } @@ -7870,7 +7871,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_total_parens = RExC_npar; } else if (! MUST_RESTART(flags)) { - ReREFCNT_dec(Rx); + ReREFCNT_dec(Rx); Perl_croak(aTHX_ "panic: reg returned failure to re_op_compile, flags=%#" UVxf, (UV) flags); } @@ -8032,7 +8033,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN; else RExC_seen &= ~REG_TOP_LEVEL_BRANCHES_SEEN; - StructCopy(&zero_scan_data, &data, scan_data_t); + StructCopy(&zero_scan_data, &data, scan_data_t); } #else StructCopy(&zero_scan_data, &data, scan_data_t); @@ -8043,171 +8044,171 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, /*dmq: removed as part of de-PMOP: pm->op_pmflags = RExC_flags; */ if (UTF) - SvUTF8_on(Rx); /* Unicode in it? */ + SvUTF8_on(Rx); /* Unicode in it? */ RExC_rxi->regstclass = NULL; if (RExC_naughty >= TOO_NAUGHTY) /* Probably an expensive pattern. */ - RExC_rx->intflags |= PREGf_NAUGHTY; + RExC_rx->intflags |= PREGf_NAUGHTY; scan = RExC_rxi->program + 1; /* First BRANCH. */ /* testing for BRANCH here tells us whether there is "must appear" data in the pattern. If there is then we can use it for optimisations */ if (!(RExC_seen & REG_TOP_LEVEL_BRANCHES_SEEN)) { /* Only one top-level choice. */ - SSize_t fake; - STRLEN longest_length[2]; - regnode_ssc ch_class; /* pointed to by data */ - int stclass_flag; - SSize_t last_close = 0; /* pointed to by data */ + SSize_t fake; + STRLEN longest_length[2]; + regnode_ssc ch_class; /* pointed to by data */ + int stclass_flag; + SSize_t last_close = 0; /* pointed to by data */ regnode *first= scan; regnode *first_next= regnext(first); int i; - /* - * Skip introductions and multiplicators >= 1 - * so that we can extract the 'meat' of the pattern that must - * match in the large if() sequence following. - * NOTE that EXACT is NOT covered here, as it is normally - * picked up by the optimiser separately. - * - * This is unfortunate as the optimiser isnt handling lookahead - * properly currently. - * - */ - while ((OP(first) == OPEN && (sawopen = 1)) || - /* An OR of *one* alternative - should not happen now. */ - (OP(first) == BRANCH && OP(first_next) != BRANCH) || - /* for now we can't handle lookbehind IFMATCH*/ - (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) || - (OP(first) == PLUS) || - (OP(first) == MINMOD) || - /* An {n,m} with n>0 */ - (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) || - (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END )) - { - /* - * the only op that could be a regnode is PLUS, all the rest - * will be regnode_1 or regnode_2. - * + /* + * Skip introductions and multiplicators >= 1 + * so that we can extract the 'meat' of the pattern that must + * match in the large if() sequence following. + * NOTE that EXACT is NOT covered here, as it is normally + * picked up by the optimiser separately. + * + * This is unfortunate as the optimiser isnt handling lookahead + * properly currently. + * + */ + while ((OP(first) == OPEN && (sawopen = 1)) || + /* An OR of *one* alternative - should not happen now. */ + (OP(first) == BRANCH && OP(first_next) != BRANCH) || + /* for now we can't handle lookbehind IFMATCH*/ + (OP(first) == IFMATCH && !first->flags && (sawlookahead = 1)) || + (OP(first) == PLUS) || + (OP(first) == MINMOD) || + /* An {n,m} with n>0 */ + (PL_regkind[OP(first)] == CURLY && ARG1(first) > 0) || + (OP(first) == NOTHING && PL_regkind[OP(first_next)] != END )) + { + /* + * the only op that could be a regnode is PLUS, all the rest + * will be regnode_1 or regnode_2. + * * (yves doesn't think this is true) - */ - if (OP(first) == PLUS) - sawplus = 1; + */ + if (OP(first) == PLUS) + sawplus = 1; else { if (OP(first) == MINMOD) sawminmod = 1; - first += regarglen[OP(first)]; + first += regarglen[OP(first)]; } - first = NEXTOPER(first); - first_next= regnext(first); - } + first = NEXTOPER(first); + first_next= regnext(first); + } - /* Starting-point info. */ + /* Starting-point info. */ again: DEBUG_PEEP("first:", first, 0, 0); /* Ignore EXACT as we deal with it later. */ - if (PL_regkind[OP(first)] == EXACT) { - if (! isEXACTFish(OP(first))) { - NOOP; /* Empty, get anchored substr later. */ + if (PL_regkind[OP(first)] == EXACT) { + if (! isEXACTFish(OP(first))) { + NOOP; /* Empty, get anchored substr later. */ } - else - RExC_rxi->regstclass = first; - } + else + RExC_rxi->regstclass = first; + } #ifdef TRIE_STCLASS - else if (PL_regkind[OP(first)] == TRIE && - ((reg_trie_data *)RExC_rxi->data->data[ ARG(first) ])->minlen>0) - { + else if (PL_regkind[OP(first)] == TRIE && + ((reg_trie_data *)RExC_rxi->data->data[ ARG(first) ])->minlen>0) + { /* this can happen only on restudy */ RExC_rxi->regstclass = construct_ahocorasick_from_trie(pRExC_state, (regnode *)first, 0); - } + } #endif - else if (REGNODE_SIMPLE(OP(first))) - RExC_rxi->regstclass = first; - else if (PL_regkind[OP(first)] == BOUND || - PL_regkind[OP(first)] == NBOUND) - RExC_rxi->regstclass = first; - else if (PL_regkind[OP(first)] == BOL) { + else if (REGNODE_SIMPLE(OP(first))) + RExC_rxi->regstclass = first; + else if (PL_regkind[OP(first)] == BOUND || + PL_regkind[OP(first)] == NBOUND) + RExC_rxi->regstclass = first; + else if (PL_regkind[OP(first)] == BOL) { RExC_rx->intflags |= (OP(first) == MBOL ? PREGf_ANCH_MBOL : PREGf_ANCH_SBOL); - first = NEXTOPER(first); - goto again; - } - else if (OP(first) == GPOS) { + first = NEXTOPER(first); + goto again; + } + else if (OP(first) == GPOS) { RExC_rx->intflags |= PREGf_ANCH_GPOS; - first = NEXTOPER(first); - goto again; - } - else if ((!sawopen || !RExC_sawback) && + first = NEXTOPER(first); + goto again; + } + else if ((!sawopen || !RExC_sawback) && !sawlookahead && - (OP(first) == STAR && - PL_regkind[OP(NEXTOPER(first))] == REG_ANY) && + (OP(first) == STAR && + PL_regkind[OP(NEXTOPER(first))] == REG_ANY) && !(RExC_rx->intflags & PREGf_ANCH) && !pRExC_state->code_blocks) - { - /* turn .* into ^.* with an implied $*=1 */ - const int type = - (OP(NEXTOPER(first)) == REG_ANY) + { + /* turn .* into ^.* with an implied $*=1 */ + const int type = + (OP(NEXTOPER(first)) == REG_ANY) ? PREGf_ANCH_MBOL : PREGf_ANCH_SBOL; RExC_rx->intflags |= (type | PREGf_IMPLICIT); - first = NEXTOPER(first); - goto again; - } + first = NEXTOPER(first); + goto again; + } if (sawplus && !sawminmod && !sawlookahead && (!sawopen || !RExC_sawback) - && !pRExC_state->code_blocks) /* May examine pos and $& */ - /* x+ must match at the 1st pos of run of x's */ - RExC_rx->intflags |= PREGf_SKIP; + && !pRExC_state->code_blocks) /* May examine pos and $& */ + /* x+ must match at the 1st pos of run of x's */ + RExC_rx->intflags |= PREGf_SKIP; - /* Scan is after the zeroth branch, first is atomic matcher. */ + /* Scan is after the zeroth branch, first is atomic matcher. */ #ifdef TRIE_STUDY_OPT - DEBUG_PARSE_r( - if (!restudied) + DEBUG_PARSE_r( + if (!restudied) Perl_re_printf( aTHX_ "first at %" IVdf "\n", - (IV)(first - scan + 1)) + (IV)(first - scan + 1)) ); #else - DEBUG_PARSE_r( + DEBUG_PARSE_r( Perl_re_printf( aTHX_ "first at %" IVdf "\n", - (IV)(first - scan + 1)) + (IV)(first - scan + 1)) ); #endif - /* - * If there's something expensive in the r.e., find the - * longest literal string that must appear and make it the - * regmust. Resolve ties in favor of later strings, since - * the regstart check works with the beginning of the r.e. - * and avoiding duplication strengthens checking. Not a - * strong reason, but sufficient in the absence of others. - * [Now we resolve ties in favor of the earlier string if - * it happens that c_offset_min has been invalidated, since the - * earlier string may buy us something the later one won't.] - */ - - data.substrs[0].str = newSVpvs(""); - data.substrs[1].str = newSVpvs(""); - data.last_found = newSVpvs(""); - data.cur_is_floating = 0; /* initially any found substring is fixed */ - ENTER_with_name("study_chunk"); - SAVEFREESV(data.substrs[0].str); - SAVEFREESV(data.substrs[1].str); - SAVEFREESV(data.last_found); - first = scan; - if (!RExC_rxi->regstclass) { - ssc_init(pRExC_state, &ch_class); - data.start_class = &ch_class; - stclass_flag = SCF_DO_STCLASS_AND; - } else /* XXXX Check for BOUND? */ - stclass_flag = 0; - data.last_closep = &last_close; + /* + * If there's something expensive in the r.e., find the + * longest literal string that must appear and make it the + * regmust. Resolve ties in favor of later strings, since + * the regstart check works with the beginning of the r.e. + * and avoiding duplication strengthens checking. Not a + * strong reason, but sufficient in the absence of others. + * [Now we resolve ties in favor of the earlier string if + * it happens that c_offset_min has been invalidated, since the + * earlier string may buy us something the later one won't.] + */ + + data.substrs[0].str = newSVpvs(""); + data.substrs[1].str = newSVpvs(""); + data.last_found = newSVpvs(""); + data.cur_is_floating = 0; /* initially any found substring is fixed */ + ENTER_with_name("study_chunk"); + SAVEFREESV(data.substrs[0].str); + SAVEFREESV(data.substrs[1].str); + SAVEFREESV(data.last_found); + first = scan; + if (!RExC_rxi->regstclass) { + ssc_init(pRExC_state, &ch_class); + data.start_class = &ch_class; + stclass_flag = SCF_DO_STCLASS_AND; + } else /* XXXX Check for BOUND? */ + stclass_flag = 0; + data.last_closep = &last_close; DEBUG_RExC_seen(); /* * MAIN ENTRY FOR study_chunk() FOR m/PATTERN/ * (NO top level branches) */ - minlen = study_chunk(pRExC_state, &first, &minlen, &fake, + minlen = study_chunk(pRExC_state, &first, &minlen, &fake, scan + RExC_size, /* Up to end */ &data, -1, 0, NULL, SCF_DO_SUBSTR | SCF_WHILEM_VISITED_POS | stclass_flag @@ -8218,15 +8219,15 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, CHECK_RESTUDY_GOTO_butfirst(LEAVE_with_name("study_chunk")); - if ( RExC_total_parens == 1 && !data.cur_is_floating - && data.last_start_min == 0 && data.last_end > 0 - && !RExC_seen_zerolen + if ( RExC_total_parens == 1 && !data.cur_is_floating + && data.last_start_min == 0 && data.last_end > 0 + && !RExC_seen_zerolen && !(RExC_seen & REG_VERBARG_SEEN) && !(RExC_seen & REG_GPOS_SEEN) ){ - RExC_rx->extflags |= RXf_CHECK_ALL; + RExC_rx->extflags |= RXf_CHECK_ALL; } - scan_commit(pRExC_state, &data,&minlen, 0); + scan_commit(pRExC_state, &data,&minlen, 0); /* XXX this is done in reverse order because that's the way the @@ -8263,39 +8264,39 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, } } - LEAVE_with_name("study_chunk"); + LEAVE_with_name("study_chunk"); - if (RExC_rxi->regstclass - && (OP(RExC_rxi->regstclass) == REG_ANY || OP(RExC_rxi->regstclass) == SANY)) - RExC_rxi->regstclass = NULL; + if (RExC_rxi->regstclass + && (OP(RExC_rxi->regstclass) == REG_ANY || OP(RExC_rxi->regstclass) == SANY)) + RExC_rxi->regstclass = NULL; - if ((!(RExC_rx->substrs->data[0].substr || RExC_rx->substrs->data[0].utf8_substr) + if ((!(RExC_rx->substrs->data[0].substr || RExC_rx->substrs->data[0].utf8_substr) || RExC_rx->substrs->data[0].min_offset) - && stclass_flag + && stclass_flag && ! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING) - && is_ssc_worth_it(pRExC_state, data.start_class)) - { - const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); + && is_ssc_worth_it(pRExC_state, data.start_class)) + { + const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); ssc_finalize(pRExC_state, data.start_class); - Newx(RExC_rxi->data->data[n], 1, regnode_ssc); - StructCopy(data.start_class, - (regnode_ssc*)RExC_rxi->data->data[n], - regnode_ssc); - RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; - RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ - DEBUG_COMPILE_r({ SV *sv = sv_newmortal(); + Newx(RExC_rxi->data->data[n], 1, regnode_ssc); + StructCopy(data.start_class, + (regnode_ssc*)RExC_rxi->data->data[n], + regnode_ssc); + RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; + RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ + DEBUG_COMPILE_r({ SV *sv = sv_newmortal(); regprop(RExC_rx, sv, (regnode*)data.start_class, NULL, pRExC_state); Perl_re_printf( aTHX_ - "synthetic stclass \"%s\".\n", - SvPVX_const(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); data.start_class = NULL; - } + } /* A temporary algorithm prefers floated substr to fixed one of * same length to dig more info. */ - i = (longest_length[0] <= longest_length[1]); + i = (longest_length[0] <= longest_length[1]); RExC_rx->substrs->check_ix = i; RExC_rx->check_end_shift = RExC_rx->substrs->data[i].end_shift; RExC_rx->check_substr = RExC_rx->substrs->data[i].substr; @@ -8305,38 +8306,38 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, if (!i && (RExC_rx->intflags & (PREGf_ANCH_SBOL|PREGf_ANCH_GPOS))) RExC_rx->intflags |= PREGf_NOSCAN; - if ((RExC_rx->check_substr || RExC_rx->check_utf8) ) { - RExC_rx->extflags |= RXf_USE_INTUIT; - if (SvTAIL(RExC_rx->check_substr ? RExC_rx->check_substr : RExC_rx->check_utf8)) - RExC_rx->extflags |= RXf_INTUIT_TAIL; - } + if ((RExC_rx->check_substr || RExC_rx->check_utf8) ) { + RExC_rx->extflags |= RXf_USE_INTUIT; + if (SvTAIL(RExC_rx->check_substr ? RExC_rx->check_substr : RExC_rx->check_utf8)) + RExC_rx->extflags |= RXf_INTUIT_TAIL; + } - /* XXX Unneeded? dmq (shouldn't as this is handled elsewhere) - if ( (STRLEN)minlen < longest_length[1] ) + /* XXX Unneeded? dmq (shouldn't as this is handled elsewhere) + if ( (STRLEN)minlen < longest_length[1] ) minlen= longest_length[1]; if ( (STRLEN)minlen < longest_length[0] ) minlen= longest_length[0]; */ } else { - /* Several toplevels. Best we can is to set minlen. */ - SSize_t fake; - regnode_ssc ch_class; - SSize_t last_close = 0; + /* Several toplevels. Best we can is to set minlen. */ + SSize_t fake; + regnode_ssc ch_class; + SSize_t last_close = 0; DEBUG_PARSE_r(Perl_re_printf( aTHX_ "\nMulti Top Level\n")); - scan = RExC_rxi->program + 1; - ssc_init(pRExC_state, &ch_class); - data.start_class = &ch_class; - data.last_closep = &last_close; + scan = RExC_rxi->program + 1; + ssc_init(pRExC_state, &ch_class); + data.start_class = &ch_class; + data.last_closep = &last_close; DEBUG_RExC_seen(); /* * MAIN ENTRY FOR study_chunk() FOR m/P1|P2|.../ * (patterns WITH top level branches) */ - minlen = study_chunk(pRExC_state, + minlen = study_chunk(pRExC_state, &scan, &minlen, &fake, scan + RExC_size, &data, -1, 0, NULL, SCF_DO_STCLASS_AND|SCF_WHILEM_VISITED_POS|(restudied ? SCF_TRIE_DOING_RESTUDY @@ -8345,7 +8346,7 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, CHECK_RESTUDY_GOTO_butfirst(NOOP); - RExC_rx->check_substr = NULL; + RExC_rx->check_substr = NULL; RExC_rx->check_utf8 = NULL; RExC_rx->substrs->data[0].substr = NULL; RExC_rx->substrs->data[0].utf8_substr = NULL; @@ -8353,25 +8354,25 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_rx->substrs->data[1].utf8_substr = NULL; if (! (ANYOF_FLAGS(data.start_class) & SSC_MATCHES_EMPTY_STRING) - && is_ssc_worth_it(pRExC_state, data.start_class)) + && is_ssc_worth_it(pRExC_state, data.start_class)) { - const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); + const U32 n = add_data(pRExC_state, STR_WITH_LEN("f")); ssc_finalize(pRExC_state, data.start_class); - Newx(RExC_rxi->data->data[n], 1, regnode_ssc); - StructCopy(data.start_class, - (regnode_ssc*)RExC_rxi->data->data[n], - regnode_ssc); - RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; - RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ - DEBUG_COMPILE_r({ SV* sv = sv_newmortal(); + Newx(RExC_rxi->data->data[n], 1, regnode_ssc); + StructCopy(data.start_class, + (regnode_ssc*)RExC_rxi->data->data[n], + regnode_ssc); + RExC_rxi->regstclass = (regnode*)RExC_rxi->data->data[n]; + RExC_rx->intflags &= ~PREGf_SKIP; /* Used in find_byclass(). */ + DEBUG_COMPILE_r({ SV* sv = sv_newmortal(); regprop(RExC_rx, sv, (regnode*)data.start_class, NULL, pRExC_state); Perl_re_printf( aTHX_ - "synthetic stclass \"%s\".\n", - SvPVX_const(sv));}); + "synthetic stclass \"%s\".\n", + SvPVX_const(sv));}); data.start_class = NULL; - } + } } if (RExC_seen & REG_UNBOUNDED_QUANTIFIER_SEEN) { @@ -8402,16 +8403,16 @@ Perl_re_op_compile(pTHX_ SV ** const patternp, int pat_count, RExC_rx->extflags |= RXf_NO_INPLACE_SUBST; /* inplace might break the lookbehind */ if (pRExC_state->code_blocks) - RExC_rx->extflags |= RXf_EVAL_SEEN; + RExC_rx->extflags |= RXf_EVAL_SEEN; if (RExC_seen & REG_VERBARG_SEEN) { - RExC_rx->intflags |= PREGf_VERBARG_SEEN; + RExC_rx->intflags |= PREGf_VERBARG_SEEN; RExC_rx->extflags |= RXf_NO_INPLACE_SUBST; /* don't understand this! Yves */ } if (RExC_seen & REG_CUTGROUP_SEEN) - RExC_rx->intflags |= PREGf_CUTGROUP_SEEN; + RExC_rx->intflags |= PREGf_CUTGROUP_SEEN; if (pm_flags & PMf_USE_RE_EVAL) - RExC_rx->intflags |= PREGf_USE_RE_EVAL; + RExC_rx->intflags |= PREGf_USE_RE_EVAL; if (RExC_paren_names) RXp_PAREN_NAMES(RExC_rx) = MUTABLE_HV(SvREFCNT_inc(RExC_paren_names)); else @@ -8567,7 +8568,7 @@ Perl_reg_named_buff_iter(pTHX_ REGEXP * const rx, const SV * const lastkey, SV* Perl_reg_named_buff_fetch(pTHX_ REGEXP * const r, SV * const namesv, - const U32 flags) + const U32 flags) { SV *ret; struct regexp *const rx = ReANY(r); @@ -8616,9 +8617,9 @@ Perl_reg_named_buff_exists(pTHX_ REGEXP * const r, SV * const key, if (flags & RXapif_ALL) { return hv_exists_ent(RXp_PAREN_NAMES(rx), key, 0); } else { - SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); + SV *sv = CALLREG_NAMED_BUFF_FETCH(r, key, flags); if (sv) { - SvREFCNT_dec_NN(sv); + SvREFCNT_dec_NN(sv); return TRUE; } else { return FALSE; @@ -8637,11 +8638,11 @@ Perl_reg_named_buff_firstkey(pTHX_ REGEXP * const r, const U32 flags) PERL_ARGS_ASSERT_REG_NAMED_BUFF_FIRSTKEY; if ( rx && RXp_PAREN_NAMES(rx) ) { - (void)hv_iterinit(RXp_PAREN_NAMES(rx)); + (void)hv_iterinit(RXp_PAREN_NAMES(rx)); - return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY); + return CALLREG_NAMED_BUFF_NEXTKEY(r, NULL, flags & ~RXapif_FIRSTKEY); } else { - return FALSE; + return FALSE; } } @@ -8671,7 +8672,7 @@ Perl_reg_named_buff_nextkey(pTHX_ REGEXP * const r, const U32 flags) } } if (parno || flags & RXapif_ALL) { - return newSVhek(HeKEY_hek(temphe)); + return newSVhek(HeKEY_hek(temphe)); } } } @@ -8695,7 +8696,7 @@ Perl_reg_named_buff_scalar(pTHX_ REGEXP * const r, const U32 flags) ret = CALLREG_NAMED_BUFF_ALL(r, (flags | RXapif_REGNAMES)); av = MUTABLE_AV(SvRV(ret)); length = av_count(av); - SvREFCNT_dec_NN(ret); + SvREFCNT_dec_NN(ret); return newSViv(length); } else { Perl_croak(aTHX_ "panic: Unknown flags %d in named_buff_scalar", @@ -8743,7 +8744,7 @@ Perl_reg_named_buff_all(pTHX_ REGEXP * const r, const U32 flags) void Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, - SV * const sv) + SV * const sv) { struct regexp *const rx = ReANY(r); char *s = NULL; @@ -8782,16 +8783,16 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, && rx->offs[0].start != -1) { /* $`, ${^PREMATCH} */ - i = rx->offs[0].start; - s = rx->subbeg; + i = rx->offs[0].start; + s = rx->subbeg; } else if ((n == RX_BUFF_IDX_POSTMATCH || n == RX_BUFF_IDX_CARET_POSTMATCH) && rx->offs[0].end != -1) { /* $', ${^POSTMATCH} */ - s = rx->subbeg - rx->suboffset + rx->offs[0].end; - i = rx->sublen + rx->suboffset - rx->offs[0].end; + s = rx->subbeg - rx->suboffset + rx->offs[0].end; + i = rx->sublen + rx->suboffset - rx->offs[0].end; } else if (inRANGE(n, 0, (I32)rx->nparens) && @@ -8848,7 +8849,7 @@ Perl_reg_numbered_buff_fetch(pTHX_ REGEXP * const r, const I32 paren, void Perl_reg_numbered_buff_store(pTHX_ REGEXP * const rx, const I32 paren, - SV const * const value) + SV const * const value) { PERL_ARGS_ASSERT_REG_NUMBERED_BUFF_STORE; @@ -8893,32 +8894,32 @@ Perl_reg_numbered_buff_length(pTHX_ REGEXP * const r, const SV * const sv, case RX_BUFF_IDX_CARET_PREMATCH: /* ${^PREMATCH} */ case RX_BUFF_IDX_PREMATCH: /* $` */ if (rx->offs[0].start != -1) { - i = rx->offs[0].start; - if (i > 0) { - s1 = 0; - t1 = i; - goto getlen; - } - } + i = rx->offs[0].start; + if (i > 0) { + s1 = 0; + t1 = i; + goto getlen; + } + } return 0; case RX_BUFF_IDX_CARET_POSTMATCH: /* ${^POSTMATCH} */ case RX_BUFF_IDX_POSTMATCH: /* $' */ - if (rx->offs[0].end != -1) { - i = rx->sublen - rx->offs[0].end; - if (i > 0) { - s1 = rx->offs[0].end; - t1 = rx->sublen; - goto getlen; - } - } + if (rx->offs[0].end != -1) { + i = rx->sublen - rx->offs[0].end; + if (i > 0) { + s1 = rx->offs[0].end; + t1 = rx->sublen; + goto getlen; + } + } return 0; default: /* $& / ${^MATCH}, $1, $2, ... */ - if (paren <= (I32)rx->nparens && + if (paren <= (I32)rx->nparens && (s1 = rx->offs[paren].start) != -1 && (t1 = rx->offs[paren].end) != -1) - { + { i = t1 - s1; goto getlen; } else { @@ -8945,11 +8946,11 @@ SV* Perl_reg_qr_package(pTHX_ REGEXP * const rx) { PERL_ARGS_ASSERT_REG_QR_PACKAGE; - PERL_UNUSED_ARG(rx); - if (0) - return NULL; - else - return newSVpvs("Regexp"); + PERL_UNUSED_ARG(rx); + if (0) + return NULL; + else + return newSVpvs("Regexp"); } /* Scans the name of a named buffer from the pattern. @@ -8977,22 +8978,22 @@ S_reg_scan_name(pTHX_ RExC_state_t *pRExC_state, U32 flags) else if (isIDFIRST_lazy_if_safe(RExC_parse, RExC_end, UTF)) { /* Note that the code here assumes well-formed UTF-8. Skip IDFIRST by * using do...while */ - if (UTF) - do { - RExC_parse += UTF8SKIP(RExC_parse); - } while ( RExC_parse < RExC_end + if (UTF) + do { + RExC_parse += UTF8SKIP(RExC_parse); + } while ( RExC_parse < RExC_end && isWORDCHAR_utf8_safe((U8*)RExC_parse, (U8*) RExC_end)); - else - do { - RExC_parse++; - } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse)); + else + do { + RExC_parse++; + } while (RExC_parse < RExC_end && isWORDCHAR(*RExC_parse)); } else { RExC_parse++; /* so the <- from the vFAIL is after the offending character */ vFAIL("Group name must start with a non-digit word character"); } sv_name = newSVpvn_flags(name_start, (int)(RExC_parse - name_start), - SVs_TEMP | (UTF ? SVf_UTF8 : 0)); + SVs_TEMP | (UTF ? SVf_UTF8 : 0)); if ( flags == REG_RSN_RETURN_NAME) return sv_name; else if (flags==REG_RSN_RETURN_DATA) { @@ -9312,7 +9313,7 @@ Perl__new_invlist(pTHX_ IV initial_size) SV* new_list; if (initial_size < 0) { - initial_size = 10; + initial_size = 10; } new_list = newSV_type(SVt_INVLIST); @@ -9358,7 +9359,7 @@ Perl__new_invlist_C_array(pTHX_ const UV* const list) SvPV_set(invlist, (char *) (list + HEADER_LENGTH)); SvLEN_set(invlist, 0); /* Means we own the contents, and the system - shouldn't touch it */ + shouldn't touch it */ *(get_invlist_offset_addr(invlist)) = offset; @@ -9398,39 +9399,39 @@ S__append_range_to_invlist(pTHX_ SV* const invlist, array = _invlist_array_init(invlist, ! offset); } else { - /* Here, the existing list is non-empty. The current max entry in the - * list is generally the first value not in the set, except when the - * set extends to the end of permissible values, in which case it is - * the first entry in that final set, and so this call is an attempt to - * append out-of-order */ - - UV final_element = len - 1; - array = invlist_array(invlist); - if ( array[final_element] > start - || ELEMENT_RANGE_MATCHES_INVLIST(final_element)) - { - Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%" UVuf ", start=%" UVuf ", match=%c", - array[final_element], start, - ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f'); - } + /* Here, the existing list is non-empty. The current max entry in the + * list is generally the first value not in the set, except when the + * set extends to the end of permissible values, in which case it is + * the first entry in that final set, and so this call is an attempt to + * append out-of-order */ + + UV final_element = len - 1; + array = invlist_array(invlist); + if ( array[final_element] > start + || ELEMENT_RANGE_MATCHES_INVLIST(final_element)) + { + Perl_croak(aTHX_ "panic: attempting to append to an inversion list, but wasn't at the end of the list, final=%" UVuf ", start=%" UVuf ", match=%c", + array[final_element], start, + ELEMENT_RANGE_MATCHES_INVLIST(final_element) ? 't' : 'f'); + } /* Here, it is a legal append. If the new range begins 1 above the end * of the range below it, it is extending the range below it, so the * new first value not in the set is one greater than the newly * extended range. */ offset = *get_invlist_offset_addr(invlist); - if (array[final_element] == start) { - if (end != UV_MAX) { - array[final_element] = end + 1; - } - else { - /* But if the end is the maximum representable on the machine, + if (array[final_element] == start) { + if (end != UV_MAX) { + array[final_element] = end + 1; + } + else { + /* But if the end is the maximum representable on the machine, * assume that infinity was actually what was meant. Just let * the range that this would extend to have no end */ - invlist_set_len(invlist, len - 1, offset); - } - return; - } + invlist_set_len(invlist, len - 1, offset); + } + return; + } } /* Here the new range doesn't extend any existing set. Add it */ @@ -9440,27 +9441,27 @@ S__append_range_to_invlist(pTHX_ SV* const invlist, /* If wll overflow the existing space, extend, which may cause the array to * be moved */ if (max < len) { - invlist_extend(invlist, len); + invlist_extend(invlist, len); /* Have to set len here to avoid assert failure in invlist_array() */ invlist_set_len(invlist, len, offset); - array = invlist_array(invlist); + array = invlist_array(invlist); } else { - invlist_set_len(invlist, len, offset); + invlist_set_len(invlist, len, offset); } /* The next item on the list starts the range, the one after that is * one past the new range. */ array[len - 2] = start; if (end != UV_MAX) { - array[len - 1] = end + 1; + array[len - 1] = end + 1; } else { - /* But if the end is the maximum representable on the machine, just let - * the range have no end */ - invlist_set_len(invlist, len - 1, offset); + /* But if the end is the maximum representable on the machine, just let + * the range have no end */ + invlist_set_len(invlist, len - 1, offset); } } @@ -9484,7 +9485,7 @@ Perl__invlist_search(SV* const invlist, const UV cp) /* If list is empty, return failure. */ if (high == 0) { - return -1; + return -1; } /* (We can't get the array unless we know the list is non-empty) */ @@ -9535,20 +9536,20 @@ Perl__invlist_search(SV* const invlist, const UV cp) * The loop below converges on the i+1. Note that there may not be an * (i+1)th element in the array, and things work nonetheless */ while (low < high) { - mid = (low + high) / 2; + mid = (low + high) / 2; assert(mid <= highest_element); - if (array[mid] <= cp) { /* cp >= array[mid] */ - low = mid + 1; + if (array[mid] <= cp) { /* cp >= array[mid] */ + low = mid + 1; - /* We could do this extra test to exit the loop early. - if (cp < array[low]) { - return mid; - } - */ - } - else { /* cp < array[mid] */ - high = mid; - } + /* We could do this extra test to exit the loop early. + if (cp < array[low]) { + return mid; + } + */ + } + else { /* cp < array[mid] */ + high = mid; + } } found_entry: @@ -9681,7 +9682,7 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, SvREFCNT_dec_NN(u); } - return; + return; } /* Here both lists exist and are non-empty */ @@ -9692,8 +9693,8 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * up so are looking at b's complement. */ if (complement_b) { - /* To complement, we invert: if the first element is 0, remove it. To - * do this, we just pretend the array starts one later */ + /* To complement, we invert: if the first element is 0, remove it. To + * do this, we just pretend the array starts one later */ if (array_b[0] == 0) { array_b++; len_b--; @@ -9718,11 +9719,11 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* Go through each input list item by item, stopping when have exhausted * one of them */ while (i_a < len_a && i_b < len_b) { - UV cp; /* The element to potentially add to the union's array */ - bool cp_in_set; /* is it in the input list's set or not */ + UV cp; /* The element to potentially add to the union's array */ + bool cp_in_set; /* is it in the input list's set or not */ - /* We need to take one or the other of the two inputs for the union. - * Since we are merging two sorted lists, we take the smaller of the + /* We need to take one or the other of the two inputs for the union. + * Since we are merging two sorted lists, we take the smaller of the * next items. In case of a tie, we take first the one that is in its * set. If we first took the one not in its set, it would decrement * the count, possibly to 0 which would cause it to be output as ending @@ -9732,33 +9733,33 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * momentarily decremented to 0, and thus the two adjoining ranges will * be seamlessly merged. (In a tie and both are in the set or both not * in the set, it doesn't matter which we take first.) */ - if ( array_a[i_a] < array_b[i_b] - || ( array_a[i_a] == array_b[i_b] - && ELEMENT_RANGE_MATCHES_INVLIST(i_a))) - { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); - cp = array_a[i_a++]; - } - else { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); - cp = array_b[i_b++]; - } - - /* Here, have chosen which of the two inputs to look at. Only output - * if the running count changes to/from 0, which marks the - * beginning/end of a range that's in the set */ - if (cp_in_set) { - if (count == 0) { - array_u[i_u++] = cp; - } - count++; - } - else { - count--; - if (count == 0) { - array_u[i_u++] = cp; - } - } + if ( array_a[i_a] < array_b[i_b] + || ( array_a[i_a] == array_b[i_b] + && ELEMENT_RANGE_MATCHES_INVLIST(i_a))) + { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); + cp = array_a[i_a++]; + } + else { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); + cp = array_b[i_b++]; + } + + /* Here, have chosen which of the two inputs to look at. Only output + * if the running count changes to/from 0, which marks the + * beginning/end of a range that's in the set */ + if (cp_in_set) { + if (count == 0) { + array_u[i_u++] = cp; + } + count++; + } + else { + count--; + if (count == 0) { + array_u[i_u++] = cp; + } + } } @@ -9769,9 +9770,9 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * that list is in its set. (i_a and i_b each currently index the element * beyond the one we care about.) */ if ( (i_a != len_a && PREV_RANGE_MATCHES_INVLIST(i_a)) - || (i_b != len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) + || (i_b != len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) { - count--; + count--; } /* Above we decremented 'count' if the list that had unexamined elements in @@ -9801,11 +9802,11 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, else { IV copy_count = len_a - i_a; if (copy_count > 0) { /* The non-exhausted input is 'a' */ - Copy(array_a + i_a, array_u + i_u, copy_count, UV); + Copy(array_a + i_a, array_u + i_u, copy_count, UV); } else { /* The non-exhausted input is b */ copy_count = len_b - i_b; - Copy(array_b + i_b, array_u + i_u, copy_count, UV); + Copy(array_b + i_b, array_u + i_u, copy_count, UV); } len_u = i_u + copy_count; } @@ -9814,9 +9815,9 @@ Perl__invlist_union_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * array_u, so re-find it. (Note that it is unlikely that this will * change, as we are shrinking the space, not enlarging it) */ if (len_u != _invlist_len(u)) { - invlist_set_len(u, len_u, *get_invlist_offset_addr(u)); - invlist_trim(u); - array_u = invlist_array(u); + invlist_set_len(u, len_u, *get_invlist_offset_addr(u)); + invlist_trim(u); + array_u = invlist_array(u); } if (*output == NULL) { /* Simply return the new inversion list */ @@ -9914,7 +9915,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, } invlist_clear(*i); - return; + return; } /* Here both lists exist and are non-empty */ @@ -9925,8 +9926,8 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * up so are looking at b's complement. */ if (complement_b) { - /* To complement, we invert: if the first element is 0, remove it. To - * do this, we just pretend the array starts one later */ + /* To complement, we invert: if the first element is 0, remove it. To + * do this, we just pretend the array starts one later */ if (array_b[0] == 0) { array_b++; len_b--; @@ -9951,12 +9952,12 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, /* Go through each list item by item, stopping when have exhausted one of * them */ while (i_a < len_a && i_b < len_b) { - UV cp; /* The element to potentially add to the intersection's - array */ - bool cp_in_set; /* Is it in the input list's set or not */ + UV cp; /* The element to potentially add to the intersection's + array */ + bool cp_in_set; /* Is it in the input list's set or not */ - /* We need to take one or the other of the two inputs for the - * intersection. Since we are merging two sorted lists, we take the + /* We need to take one or the other of the two inputs for the + * intersection. Since we are merging two sorted lists, we take the * smaller of the next items. In case of a tie, we take first the one * that is not in its set (a difference from the union algorithm). If * we first took the one in its set, it would increment the count, @@ -9966,33 +9967,33 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * opposite of this, there is no possibility that the count will be * momentarily incremented to 2. (In a tie and both are in the set or * both not in the set, it doesn't matter which we take first.) */ - if ( array_a[i_a] < array_b[i_b] - || ( array_a[i_a] == array_b[i_b] - && ! ELEMENT_RANGE_MATCHES_INVLIST(i_a))) - { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); - cp = array_a[i_a++]; - } - else { - cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); - cp= array_b[i_b++]; - } - - /* Here, have chosen which of the two inputs to look at. Only output - * if the running count changes to/from 2, which marks the - * beginning/end of a range that's in the intersection */ - if (cp_in_set) { - count++; - if (count == 2) { - array_r[i_r++] = cp; - } - } - else { - if (count == 2) { - array_r[i_r++] = cp; - } - count--; - } + if ( array_a[i_a] < array_b[i_b] + || ( array_a[i_a] == array_b[i_b] + && ! ELEMENT_RANGE_MATCHES_INVLIST(i_a))) + { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_a); + cp = array_a[i_a++]; + } + else { + cp_in_set = ELEMENT_RANGE_MATCHES_INVLIST(i_b); + cp= array_b[i_b++]; + } + + /* Here, have chosen which of the two inputs to look at. Only output + * if the running count changes to/from 2, which marks the + * beginning/end of a range that's in the intersection */ + if (cp_in_set) { + count++; + if (count == 2) { + array_r[i_r++] = cp; + } + } + else { + if (count == 2) { + array_r[i_r++] = cp; + } + count--; + } } @@ -10005,7 +10006,7 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, if ( (i_a == len_a && PREV_RANGE_MATCHES_INVLIST(i_a)) || (i_b == len_b && PREV_RANGE_MATCHES_INVLIST(i_b))) { - count++; + count++; } /* Above we incremented 'count' if the exhausted list was in its set. This @@ -10035,11 +10036,11 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, else { /* copy the non-exhausted list, unchanged. */ IV copy_count = len_a - i_a; if (copy_count > 0) { /* a is the one with stuff left */ - Copy(array_a + i_a, array_r + i_r, copy_count, UV); + Copy(array_a + i_a, array_r + i_r, copy_count, UV); } else { /* b is the one with stuff left */ copy_count = len_b - i_b; - Copy(array_b + i_b, array_r + i_r, copy_count, UV); + Copy(array_b + i_b, array_r + i_r, copy_count, UV); } len_r = i_r + copy_count; } @@ -10048,9 +10049,9 @@ Perl__invlist_intersection_maybe_complement_2nd(pTHX_ SV* const a, SV* const b, * array_r, so re-find it. (Note that it is unlikely that this will * change, as we are shrinking the space, not enlarging it) */ if (len_r != _invlist_len(r)) { - invlist_set_len(r, len_r, *get_invlist_offset_addr(r)); - invlist_trim(r); - array_r = invlist_array(r); + invlist_set_len(r, len_r, *get_invlist_offset_addr(r)); + invlist_trim(r); + array_r = invlist_array(r); } if (*i == NULL) { /* Simply return the calculated intersection */ @@ -10099,7 +10100,7 @@ Perl__add_range_to_invlist(pTHX_ SV* invlist, UV start, UV end) /* This range becomes the whole inversion list if none already existed */ if (invlist == NULL) { - invlist = _new_invlist(2); + invlist = _new_invlist(2); _append_range_to_invlist(invlist, start, end); return invlist; } @@ -10378,8 +10379,8 @@ Perl__invlist_invert(pTHX_ SV* const invlist) /* The inverse of matching nothing is matching everything */ if (_invlist_len(invlist) == 0) { - _append_range_to_invlist(invlist, 0, UV_MAX); - return; + _append_range_to_invlist(invlist, 0, UV_MAX); + return; } *get_invlist_offset_addr(invlist) = ! *get_invlist_offset_addr(invlist); @@ -10463,21 +10464,21 @@ S_invlist_contents(pTHX_ SV* const invlist, const bool traditional_style) invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { - if (end == UV_MAX) { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%cINFTY%c", + if (end == UV_MAX) { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%cINFTY%c", start, intra_range_delimiter, inter_range_delimiter); - } - else if (end != start) { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c%04" UVXf "%c", - start, + } + else if (end != start) { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c%04" UVXf "%c", + start, intra_range_delimiter, end, inter_range_delimiter); - } - else { - Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c", + } + else { + Perl_sv_catpvf(aTHX_ output, "%04" UVXf "%c", start, inter_range_delimiter); - } + } } if (SvCUR(output) && ! traditional_style) {/* Get rid of trailing blank */ @@ -10520,20 +10521,20 @@ Perl__invlist_dump(pTHX_ PerlIO *file, I32 level, invlist_iterinit(invlist); while (invlist_iternext(invlist, &start, &end)) { - if (end == UV_MAX) { - Perl_dump_indent(aTHX_ level, file, + if (end == UV_MAX) { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf " .. INFTY\n", indent, (UV)count, start); - } - else if (end != start) { - Perl_dump_indent(aTHX_ level, file, + } + else if (end != start) { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf " .. 0x%04" UVXf "\n", - indent, (UV)count, start, end); - } - else { - Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf "\n", + indent, (UV)count, start, end); + } + else { + Perl_dump_indent(aTHX_ level, file, "%s[%" UVuf "] 0x%04" UVXf "\n", indent, (UV)count, start); - } + } count += 2; } } @@ -10939,7 +10940,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) : WASTED_G; if (! (wastedflags & wflagbit) ) { wastedflags |= wflagbit; - /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ vWARN5( RExC_parse + 1, "Useless (%s%c) - %suse /%c modifier", @@ -10959,7 +10960,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) if (ckWARN(WARN_REGEXP)) { if (! (wastedflags & WASTED_C) ) { wastedflags |= WASTED_GC; - /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Useless (?-%s) - don't use /%s modifier in regex; marked by <-- HERE in m/%s/ */ vWARN3( RExC_parse + 1, "Useless (%sc) - %suse /gc modifier", @@ -11020,7 +11021,7 @@ S_parse_lparen_question_flags(pTHX_ RExC_state_t *pRExC_state) default: fail_modifiers: RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); - /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f("Sequence (%" UTF8f "...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); NOT_REACHED; /*NOTREACHED*/ @@ -11171,7 +11172,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) && *(RExC_parse - 1) != '('; if (RExC_parse >= RExC_end) { - vFAIL("Unmatched ("); + vFAIL("Unmatched ("); } if (paren == 'r') { /* Atomic script run */ @@ -11179,10 +11180,10 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) goto parse_rest; } else if ( *RExC_parse == '*') { /* (*VERB:ARG), (*construct:...) */ - char *start_verb = RExC_parse + 1; - STRLEN verb_len; - char *start_arg = NULL; - unsigned char op = 0; + char *start_verb = RExC_parse + 1; + STRLEN verb_len; + char *start_arg = NULL; + unsigned char op = 0; int arg_required = 0; int internal_argval = -1; /* if >-1 we are not allowed an argument*/ bool has_upper = FALSE; @@ -11199,11 +11200,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("In '(*...)', the '(' and '*' must be adjacent"); } } - while (RExC_parse < RExC_end && *RExC_parse != ')' ) { - if ( *RExC_parse == ':' ) { - start_arg = RExC_parse + 1; - break; - } + while (RExC_parse < RExC_end && *RExC_parse != ')' ) { + if ( *RExC_parse == ':' ) { + start_arg = RExC_parse + 1; + break; + } else if (! UTF) { if (isUPPER(*RExC_parse)) { has_upper = TRUE; @@ -11213,18 +11214,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) else { RExC_parse += UTF8SKIP(RExC_parse); } - } - verb_len = RExC_parse - start_verb; - if ( start_arg ) { + } + verb_len = RExC_parse - start_verb; + if ( start_arg ) { if (RExC_parse >= RExC_end) { goto unterminated_verb_pattern; } - RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; - while ( RExC_parse < RExC_end && *RExC_parse != ')' ) { + RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; + while ( RExC_parse < RExC_end && *RExC_parse != ')' ) { RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; } - if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { + if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { unterminated_verb_pattern: if (has_upper) { vFAIL("Unterminated verb pattern argument"); @@ -11233,8 +11234,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("Unterminated '(*...' argument"); } } - } else { - if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { + } else { + if ( RExC_parse >= RExC_end || *RExC_parse != ')' ) { if (has_upper) { vFAIL("Unterminated verb pattern"); } @@ -11242,29 +11243,29 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("Unterminated '(*...' construct"); } } - } + } /* Here, we know that RExC_parse < RExC_end */ - switch ( *start_verb ) { + switch ( *start_verb ) { case 'A': /* (*ACCEPT) */ if ( memEQs(start_verb, verb_len,"ACCEPT") ) { - op = ACCEPT; - internal_argval = RExC_nestroot; - } - break; + op = ACCEPT; + internal_argval = RExC_nestroot; + } + break; case 'C': /* (*COMMIT) */ if ( memEQs(start_verb, verb_len,"COMMIT") ) op = COMMIT; break; case 'F': /* (*FAIL) */ if ( verb_len==1 || memEQs(start_verb, verb_len,"FAIL") ) { - op = OPFAIL; - } - break; + op = OPFAIL; + } + break; case ':': /* (*:NAME) */ - case 'M': /* (*MARK:NAME) */ - if ( verb_len==0 || memEQs(start_verb, verb_len,"MARK") ) { + case 'M': /* (*MARK:NAME) */ + if ( verb_len==0 || memEQs(start_verb, verb_len,"MARK") ) { op = MARKPOINT; arg_required = 1; } @@ -11421,7 +11422,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret=reganode(pRExC_state, OPFAIL, 0); nextchar(pRExC_state); return ret; - } + } RExC_parse = start_arg; goto parse_rest; @@ -11430,11 +11431,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL2utf8f( "'(*%" UTF8f "' requires a terminating ':'", UTF8fARG(UTF, verb_len, start_verb)); - NOT_REACHED; /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ - } /* End of switch */ - if ( ! op ) { - RExC_parse += UTF + } /* End of switch */ + if ( ! op ) { + RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; if (has_upper || verb_len == 0) { @@ -11447,7 +11448,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) "Unknown '(*...)' construct '%" UTF8f "'", UTF8fARG(UTF, verb_len, start_verb)); } - } + } if ( RExC_parse == start_arg ) { start_arg = NULL; } @@ -11473,12 +11474,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } if ( internal_argval != -1 ) ARG2L_SET(REGNODE_p(ret), internal_argval); - nextchar(pRExC_state); - return ret; + nextchar(pRExC_state); + return ret; } else if (*RExC_parse == '?') { /* (?...) */ - bool is_logical = 0; - const char * const seqstart = RExC_parse; + bool is_logical = 0; + const char * const seqstart = RExC_parse; const char * endptr; const char non_existent_group_msg[] = "Reference to nonexistent group"; @@ -11489,24 +11490,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) vFAIL("In '(?...)', the '(' and '?' must be adjacent"); } - RExC_parse++; /* past the '?' */ + RExC_parse++; /* past the '?' */ paren = *RExC_parse; /* might be a trailing NUL, if not well-formed */ RExC_parse += UTF ? UTF8SKIP(RExC_parse) : 1; if (RExC_parse > RExC_end) { paren = '\0'; } - ret = 0; /* For look-ahead/behind. */ - switch (paren) { + ret = 0; /* For look-ahead/behind. */ + switch (paren) { - case 'P': /* (?P...) variants for those used to PCRE/Python */ - paren = *RExC_parse; - if ( paren == '<') { /* (?P<...>) named capture */ + case 'P': /* (?P...) variants for those used to PCRE/Python */ + paren = *RExC_parse; + if ( paren == '<') { /* (?P<...>) named capture */ RExC_parse++; if (RExC_parse >= RExC_end) { vFAIL("Sequence (?P<... not terminated"); } - goto named_capture; + goto named_capture; } else if (paren == '>') { /* (?P>name) named recursion */ RExC_parse++; @@ -11522,33 +11523,33 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ - vFAIL3("Sequence (%.*s...) not recognized", + vFAIL3("Sequence (%.*s...) not recognized", (int) (RExC_parse - seqstart), seqstart); - NOT_REACHED; /*NOTREACHED*/ + NOT_REACHED; /*NOTREACHED*/ case '<': /* (?<...) */ /* If you want to support (?<*...), first reconcile with GH #17363 */ - if (*RExC_parse == '!') - paren = ','; - else if (*RExC_parse != '=') + if (*RExC_parse == '!') + paren = ','; + else if (*RExC_parse != '=') named_capture: - { /* (?<...>) */ - char *name_start; - SV *svname; - paren= '>'; + { /* (?<...>) */ + char *name_start; + SV *svname; + paren= '>'; /* FALLTHROUGH */ case '\'': /* (?'...') */ name_start = RExC_parse; svname = reg_scan_name(pRExC_state, REG_RSN_RETURN_NAME); - if ( RExC_parse == name_start + if ( RExC_parse == name_start || RExC_parse >= RExC_end || *RExC_parse != paren) { - vFAIL2("Sequence (?%c... not terminated", - paren=='>' ? '<' : (char) paren); + vFAIL2("Sequence (?%c... not terminated", + paren=='>' ? '<' : (char) paren); } - { - HE *he_str; - SV *sv_dat = NULL; + { + HE *he_str; + SV *sv_dat = NULL; if (!svname) /* shouldn't happen */ Perl_croak(aTHX_ "panic: reg_scan_name returned NULL"); @@ -11607,56 +11608,56 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) /*sv_dump(sv_dat);*/ } nextchar(pRExC_state); - paren = 1; - goto capturing_parens; - } + paren = 1; + goto capturing_parens; + } RExC_seen |= REG_LOOKBEHIND_SEEN; - RExC_in_lookaround++; - RExC_parse++; + RExC_in_lookaround++; + RExC_parse++; if (RExC_parse >= RExC_end) { vFAIL("Sequence (?... not terminated"); } RExC_seen_zerolen++; break; - case '=': /* (?=...) */ - RExC_seen_zerolen++; + case '=': /* (?=...) */ + RExC_seen_zerolen++; RExC_in_lookaround++; break; - case '!': /* (?!...) */ - RExC_seen_zerolen++; - /* check if we're really just a "FAIL" assertion */ + case '!': /* (?!...) */ + RExC_seen_zerolen++; + /* check if we're really just a "FAIL" assertion */ skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); - if (*RExC_parse == ')') { + if (*RExC_parse == ')') { ret=reganode(pRExC_state, OPFAIL, 0); - nextchar(pRExC_state); - return ret; - } + nextchar(pRExC_state); + return ret; + } RExC_in_lookaround++; - break; - case '|': /* (?|...) */ - /* branch reset, behave like a (?:...) except that - buffers in alternations share the same numbers */ - paren = ':'; - after_freeze = freeze_paren = RExC_npar; + break; + case '|': /* (?|...) */ + /* branch reset, behave like a (?:...) except that + buffers in alternations share the same numbers */ + paren = ':'; + after_freeze = freeze_paren = RExC_npar; /* XXX This construct currently requires an extra pass. * Investigation would be required to see if that could be * changed */ REQUIRE_PARENS_PASS; - break; - case ':': /* (?:...) */ - case '>': /* (?>...) */ - break; - case '$': /* (?$...) */ - case '@': /* (?@...) */ - vFAIL2("Sequence (?%c...) not implemented", (int)paren); - break; - case '0' : /* (?0) */ - case 'R' : /* (?R) */ + break; + case ':': /* (?:...) */ + case '>': /* (?>...) */ + break; + case '$': /* (?$...) */ + case '@': /* (?@...) */ + vFAIL2("Sequence (?%c...) not implemented", (int)paren); + break; + case '0' : /* (?0) */ + case 'R' : /* (?R) */ if (RExC_parse == RExC_end || *RExC_parse != ')') - FAIL("Sequence (?R) not terminated"); + FAIL("Sequence (?R) not terminated"); num = 0; RExC_seen |= REG_RECURSE_SEEN; @@ -11664,9 +11665,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) * It probably could be changed */ REQUIRE_PARENS_PASS; - *flagp |= POSTPONED; + *flagp |= POSTPONED; goto gen_recurse_regop; - /*notreached*/ + /*notreached*/ /* named and numeric backreferences */ case '&': /* (?&NAME) */ parse_start = RExC_parse - 1; @@ -11694,8 +11695,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '1': case '2': case '3': case '4': /* (?1) */ - case '5': case '6': case '7': case '8': case '9': - RExC_parse = (char *) seqstart + 1; /* Point to the digit */ + case '5': case '6': case '7': case '8': case '9': + RExC_parse = (char *) seqstart + 1; /* Point to the digit */ parse_recursion: { bool is_neg = FALSE; @@ -11725,8 +11726,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) num = -num; } } - if (*RExC_parse!=')') - vFAIL("Expecting close bracket"); + if (*RExC_parse!=')') + vFAIL("Expecting close bracket"); gen_recurse_regop: if (paren == '-' || paren == '+') { @@ -11801,7 +11802,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), 1 + regarglen[OP(REGNODE_p(ret))]); /* MJD */ - Set_Node_Offset(REGNODE_p(ret), parse_start); /* MJD */ + Set_Node_Offset(REGNODE_p(ret), parse_start); /* MJD */ *flagp |= POSTPONED; assert(*RExC_parse == ')'); @@ -11810,43 +11811,43 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) /* NOTREACHED */ - case '?': /* (??...) */ - is_logical = 1; - if (*RExC_parse != '{') { + case '?': /* (??...) */ + is_logical = 1; + if (*RExC_parse != '{') { RExC_parse += SKIP_IF_CHAR(RExC_parse, RExC_end); /* diag_listed_as: Sequence (?%s...) not recognized in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f( "Sequence (%" UTF8f "...) not recognized", UTF8fARG(UTF, RExC_parse-seqstart, seqstart)); - NOT_REACHED; /*NOTREACHED*/ - } - *flagp |= POSTPONED; - paren = '{'; + NOT_REACHED; /*NOTREACHED*/ + } + *flagp |= POSTPONED; + paren = '{'; RExC_parse++; - /* FALLTHROUGH */ - case '{': /* (?{...}) */ - { - U32 n = 0; - struct reg_code_block *cb; + /* FALLTHROUGH */ + case '{': /* (?{...}) */ + { + U32 n = 0; + struct reg_code_block *cb; OP * o; - RExC_seen_zerolen++; + RExC_seen_zerolen++; - if ( !pRExC_state->code_blocks - || pRExC_state->code_index + if ( !pRExC_state->code_blocks + || pRExC_state->code_index >= pRExC_state->code_blocks->count - || pRExC_state->code_blocks->cb[pRExC_state->code_index].start - != (STRLEN)((RExC_parse -3 - (is_logical ? 1 : 0)) - - RExC_start) - ) { - if (RExC_pm_flags & PMf_USE_RE_EVAL) - FAIL("panic: Sequence (?{...}): no code block found\n"); - FAIL("Eval-group not allowed at runtime, use re 'eval'"); - } - /* this is a pre-compiled code block (?{...}) */ - cb = &pRExC_state->code_blocks->cb[pRExC_state->code_index]; - RExC_parse = RExC_start + cb->end; - o = cb->block; + || pRExC_state->code_blocks->cb[pRExC_state->code_index].start + != (STRLEN)((RExC_parse -3 - (is_logical ? 1 : 0)) + - RExC_start) + ) { + if (RExC_pm_flags & PMf_USE_RE_EVAL) + FAIL("panic: Sequence (?{...}): no code block found\n"); + FAIL("Eval-group not allowed at runtime, use re 'eval'"); + } + /* this is a pre-compiled code block (?{...}) */ + cb = &pRExC_state->code_blocks->cb[pRExC_state->code_index]; + RExC_parse = RExC_start + cb->end; + o = cb->block; if (cb->src_regex) { n = add_data(pRExC_state, STR_WITH_LEN("rl")); RExC_rxi->data->data[n] = @@ -11858,12 +11859,12 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) (RExC_pm_flags & PMf_HAS_CV) ? "L" : "l", 1); RExC_rxi->data->data[n] = (void*)o; } - pRExC_state->code_index++; - nextchar(pRExC_state); + pRExC_state->code_index++; + nextchar(pRExC_state); - if (is_logical) { + if (is_logical) { regnode_offset eval; - ret = reg_node(pRExC_state, LOGICAL); + ret = reg_node(pRExC_state, LOGICAL); eval = reg2Lanode(pRExC_state, EVAL, n, @@ -11877,24 +11878,24 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) REQUIRE_BRANCHJ(flagp, 0); } /* deal with the length of this later - MJD */ - return ret; - } - ret = reg2Lanode(pRExC_state, EVAL, n, 0); - Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); - Set_Node_Offset(REGNODE_p(ret), parse_start); - return ret; - } - case '(': /* (?(?{...})...) and (?(?=...)...) */ - { - int is_define= 0; + return ret; + } + ret = reg2Lanode(pRExC_state, EVAL, n, 0); + Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); + Set_Node_Offset(REGNODE_p(ret), parse_start); + return ret; + } + case '(': /* (?(?{...})...) and (?(?=...)...) */ + { + int is_define= 0; const int DEFINE_len = sizeof("DEFINE") - 1; - if ( RExC_parse < RExC_end - 1 + if ( RExC_parse < RExC_end - 1 && ( ( RExC_parse[0] == '?' /* (?(?...)) */ && ( RExC_parse[1] == '=' || RExC_parse[1] == '!' || RExC_parse[1] == '<' || RExC_parse[1] == '{')) - || ( RExC_parse[0] == '*' /* (?(*...)) */ + || ( RExC_parse[0] == '*' /* (?(*...)) */ && ( memBEGINs(RExC_parse + 1, (Size_t) (RExC_end - (RExC_parse + 1)), "pla:") @@ -11933,14 +11934,14 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } goto insert_if; } - else if ( RExC_parse[0] == '<' /* (?()...) */ - || RExC_parse[0] == '\'' ) /* (?('NAME')...) */ - { - char ch = RExC_parse[0] == '<' ? '>' : '\''; - char *name_start= RExC_parse++; - U32 num = 0; - SV *sv_dat=reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); - if ( RExC_parse == name_start + else if ( RExC_parse[0] == '<' /* (?()...) */ + || RExC_parse[0] == '\'' ) /* (?('NAME')...) */ + { + char ch = RExC_parse[0] == '<' ? '>' : '\''; + char *name_start= RExC_parse++; + U32 num = 0; + SV *sv_dat=reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); + if ( RExC_parse == name_start || RExC_parse >= RExC_end || *RExC_parse != ch) { @@ -11955,23 +11956,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } ret = reganode(pRExC_state, GROUPPN, num); goto insert_if_check_paren; - } - else if (memBEGINs(RExC_parse, + } + else if (memBEGINs(RExC_parse, (STRLEN) (RExC_end - RExC_parse), "DEFINE")) { - ret = reganode(pRExC_state, DEFINEP, 0); - RExC_parse += DEFINE_len; - is_define = 1; - goto insert_if_check_paren; - } - else if (RExC_parse[0] == 'R') { - RExC_parse++; + ret = reganode(pRExC_state, DEFINEP, 0); + RExC_parse += DEFINE_len; + is_define = 1; + goto insert_if_check_paren; + } + else if (RExC_parse[0] == 'R') { + RExC_parse++; /* parno == 0 => /(?(R)YES|NO)/ "in any form of recursion OR eval" * parno == 1 => /(?(R0)YES|NO)/ "in GOSUB (?0) / (?R)" * parno == 2 => /(?(R1)YES|NO)/ "in GOSUB (?1) (parno-1)" */ - parno = 0; + parno = 0; if (RExC_parse[0] == '0') { parno = 1; RExC_parse++; @@ -11986,20 +11987,20 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) RExC_parse = (char*)endptr; } /* else "Switch condition not recognized" below */ - } else if (RExC_parse[0] == '&') { - SV *sv_dat; - RExC_parse++; - sv_dat = reg_scan_name(pRExC_state, + } else if (RExC_parse[0] == '&') { + SV *sv_dat; + RExC_parse++; + sv_dat = reg_scan_name(pRExC_state, REG_RSN_RETURN_DATA); if (sv_dat) parno = 1 + *((I32 *)SvPVX(sv_dat)); - } - ret = reganode(pRExC_state, INSUBP, parno); - goto insert_if_check_paren; - } + } + ret = reganode(pRExC_state, INSUBP, parno); + goto insert_if_check_paren; + } else if (inRANGE(RExC_parse[0], '1', '9')) { /* (?(1)...) */ - char c; + char c; UV uv; endptr = RExC_end; if (grok_atoUV(RExC_parse, &uv, &endptr) @@ -12014,21 +12015,21 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret = reganode(pRExC_state, GROUPP, parno); insert_if_check_paren: - if (UCHARAT(RExC_parse) != ')') { + if (UCHARAT(RExC_parse) != ')') { RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; - vFAIL("Switch condition not recognized"); - } - nextchar(pRExC_state); - insert_if: + vFAIL("Switch condition not recognized"); + } + nextchar(pRExC_state); + insert_if: if (! REGTAIL(pRExC_state, ret, reganode(pRExC_state, IFTHEN, 0))) { REQUIRE_BRANCHJ(flagp, 0); } br = regbranch(pRExC_state, &flags, 1, depth+1); - if (br == 0) { + if (br == 0) { RETURN_FAIL_ON_RESTART(flags,flagp); FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); @@ -12038,13 +12039,13 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) { REQUIRE_BRANCHJ(flagp, 0); } - c = UCHARAT(RExC_parse); + c = UCHARAT(RExC_parse); nextchar(pRExC_state); - if (flags&HASWIDTH) - *flagp |= HASWIDTH; - if (c == '|') { - if (is_define) - vFAIL("(?(DEFINE)....) does not allow branches"); + if (flags&HASWIDTH) + *flagp |= HASWIDTH; + if (c == '|') { + if (is_define) + vFAIL("(?(DEFINE)....) does not allow branches"); /* Fake one for optimizer. */ lastbr = reganode(pRExC_state, IFTHEN, 0); @@ -12058,23 +12059,23 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) REQUIRE_BRANCHJ(flagp, 0); } if (flags&HASWIDTH) - *flagp |= HASWIDTH; + *flagp |= HASWIDTH; c = UCHARAT(RExC_parse); nextchar(pRExC_state); - } - else - lastbr = 0; + } + else + lastbr = 0; if (c != ')') { if (RExC_parse >= RExC_end) vFAIL("Switch (?(condition)... not terminated"); else vFAIL("Switch (?(condition)... contains too many branches"); } - ender = reg_node(pRExC_state, TAIL); + ender = reg_node(pRExC_state, TAIL); if (! REGTAIL(pRExC_state, br, ender)) { REQUIRE_BRANCHJ(flagp, 0); } - if (lastbr) { + if (lastbr) { if (! REGTAIL(pRExC_state, lastbr, ender)) { REQUIRE_BRANCHJ(flagp, 0); } @@ -12086,8 +12087,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) { REQUIRE_BRANCHJ(flagp, 0); } - } - else + } + else if (! REGTAIL(pRExC_state, ret, ender)) { REQUIRE_BRANCHJ(flagp, 0); } @@ -12096,18 +12097,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) For large programs it seems to be required but I can't figure out why. -- dmq*/ #endif - return ret; - } + return ret; + } RExC_parse += UTF ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; vFAIL("Unknown switch condition (?(...))"); - } - case '[': /* (?[ ... ]) */ + } + case '[': /* (?[ ... ]) */ return handle_regex_sets(pRExC_state, NULL, flagp, depth+1, oregcomp_parse); case 0: /* A NUL */ - RExC_parse--; /* for vFAIL to print correctly */ + RExC_parse--; /* for vFAIL to print correctly */ vFAIL("Sequence (? incomplete"); break; @@ -12117,11 +12118,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '*': /* If you want to support (?*...), first reconcile with GH #17363 */ - /* FALLTHROUGH */ - default: /* e.g., (?i) */ - RExC_parse = (char *) seqstart + 1; + /* FALLTHROUGH */ + default: /* e.g., (?i) */ + RExC_parse = (char *) seqstart + 1; parse_flags: - parse_lparen_question_flags(pRExC_state); + parse_lparen_question_flags(pRExC_state); if (UCHARAT(RExC_parse) != ':') { if (RExC_parse < RExC_end) nextchar(pRExC_state); @@ -12133,11 +12134,11 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) ret = 0; goto parse_rest; } /* end switch */ - } + } else if (!(RExC_flags & RXf_PMf_NOCAPTURE)) { /* (...) */ - capturing_parens: - parno = RExC_npar; - RExC_npar++; + capturing_parens: + parno = RExC_npar; + RExC_npar++; if (! ALL_PARENS_COUNTED) { /* If we are in our first pass through (and maybe only pass), * we need to allocate memory for the capturing parentheses @@ -12182,7 +12183,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } } - ret = reganode(pRExC_state, OPEN, parno); + ret = reganode(pRExC_state, OPEN, parno); if (!RExC_nestroot) RExC_nestroot = parno; if (RExC_open_parens && !RExC_open_parens[parno]) @@ -12196,15 +12197,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ Set_Node_Offset(REGNODE_p(ret), RExC_parse); /* MJD */ - is_open = 1; - } else { + is_open = 1; + } else { /* with RXf_PMf_NOCAPTURE treat (...) as (?:...) */ paren = ':'; - ret = 0; + ret = 0; } } else /* ! paren */ - ret = 0; + ret = 0; parse_rest: /* Pick up the branches, linking them together. */ @@ -12218,18 +12219,18 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); } if (*RExC_parse == '|') { - if (RExC_use_BRANCHJ) { - reginsert(pRExC_state, BRANCHJ, br, depth+1); - } - else { /* MJD */ - reginsert(pRExC_state, BRANCH, br, depth+1); + if (RExC_use_BRANCHJ) { + reginsert(pRExC_state, BRANCHJ, br, depth+1); + } + else { /* MJD */ + reginsert(pRExC_state, BRANCH, br, depth+1); Set_Node_Length(REGNODE_p(br), paren != 0); Set_Node_Offset_To_R(br, parse_start-RExC_start); } - have_branch = 1; + have_branch = 1; } else if (paren == ':') { - *flagp |= flags&SIMPLE; + *flagp |= flags&SIMPLE; } if (is_open) { /* Starts with OPEN. */ if (! REGTAIL(pRExC_state, ret, br)) { /* OPEN -> first. */ @@ -12237,82 +12238,82 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) } } else if (paren != '?') /* Not Conditional */ - ret = br; + ret = br; *flagp |= flags & (HASWIDTH | POSTPONED); lastbr = br; while (*RExC_parse == '|') { - if (RExC_use_BRANCHJ) { + if (RExC_use_BRANCHJ) { bool shut_gcc_up; - ender = reganode(pRExC_state, LONGJMP, 0); + ender = reganode(pRExC_state, LONGJMP, 0); /* Append to the previous. */ shut_gcc_up = REGTAIL(pRExC_state, REGNODE_OFFSET(NEXTOPER(NEXTOPER(REGNODE_p(lastbr)))), ender); - PERL_UNUSED_VAR(shut_gcc_up); - } - nextchar(pRExC_state); - if (freeze_paren) { - if (RExC_npar > after_freeze) - after_freeze = RExC_npar; + PERL_UNUSED_VAR(shut_gcc_up); + } + nextchar(pRExC_state); + if (freeze_paren) { + if (RExC_npar > after_freeze) + after_freeze = RExC_npar; RExC_npar = freeze_paren; } br = regbranch(pRExC_state, &flags, 0, depth+1); - if (br == 0) { + if (br == 0) { RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: regbranch returned failure, flags=%#" UVxf, (UV) flags); } if (! REGTAIL(pRExC_state, lastbr, br)) { /* BRANCH -> BRANCH. */ REQUIRE_BRANCHJ(flagp, 0); } - lastbr = br; - *flagp |= flags & (HASWIDTH | POSTPONED); + lastbr = br; + *flagp |= flags & (HASWIDTH | POSTPONED); } if (have_branch || paren != ':') { regnode * br; - /* Make a closing node, and hook it on the end. */ - switch (paren) { - case ':': - ender = reg_node(pRExC_state, TAIL); - break; - case 1: case 2: - ender = reganode(pRExC_state, CLOSE, parno); + /* Make a closing node, and hook it on the end. */ + switch (paren) { + case ':': + ender = reg_node(pRExC_state, TAIL); + break; + case 1: case 2: + ender = reganode(pRExC_state, CLOSE, parno); if ( RExC_close_parens ) { DEBUG_OPTIMISE_MORE_r(Perl_re_printf( aTHX_ "%*s%*s Setting close paren #%" IVdf " to %zu\n", 22, "| |", (int)(depth * 2 + 1), "", (IV)parno, ender)); RExC_close_parens[parno]= ender; - if (RExC_nestroot == parno) - RExC_nestroot = 0; - } + if (RExC_nestroot == parno) + RExC_nestroot = 0; + } Set_Node_Offset(REGNODE_p(ender), RExC_parse+1); /* MJD */ Set_Node_Length(REGNODE_p(ender), 1); /* MJD */ - break; - case 's': - ender = reg_node(pRExC_state, SRCLOSE); + break; + case 's': + ender = reg_node(pRExC_state, SRCLOSE); RExC_in_script_run = 0; - break; - case '<': + break; + case '<': case 'a': case 'A': case 'b': case 'B': - case ',': - case '=': - case '!': - *flagp &= ~HASWIDTH; - /* FALLTHROUGH */ + case ',': + case '=': + case '!': + *flagp &= ~HASWIDTH; + /* FALLTHROUGH */ case 't': /* aTomic */ - case '>': - ender = reg_node(pRExC_state, SUCCEED); - break; - case 0: - ender = reg_node(pRExC_state, END); + case '>': + ender = reg_node(pRExC_state, SUCCEED); + break; + case 0: + ender = reg_node(pRExC_state, END); assert(!RExC_end_op); /* there can only be one! */ RExC_end_op = REGNODE_p(ender); if (RExC_close_parens) { @@ -12323,8 +12324,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) RExC_close_parens[0]= ender; } - break; - } + break; + } DEBUG_PARSE_r({ DEBUG_PARSE_MSG("lsbr"); regprop(RExC_rx, RExC_mysv1, REGNODE_p(lastbr), NULL, pRExC_state); @@ -12341,15 +12342,15 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) REQUIRE_BRANCHJ(flagp, 0); } - if (have_branch) { + if (have_branch) { char is_nothing= 1; - if (depth==1) + if (depth==1) RExC_seen |= REG_TOP_LEVEL_BRANCHES_SEEN; - /* Hook the tails of the branches to the closing node. */ - for (br = REGNODE_p(ret); br; br = regnext(br)) { - const U8 op = PL_regkind[OP(br)]; - if (op == BRANCH) { + /* Hook the tails of the branches to the closing node. */ + for (br = REGNODE_p(ret); br; br = regnext(br)) { + const U8 op = PL_regkind[OP(br)]; + if (op == BRANCH) { if (! REGTAIL_STUDY(pRExC_state, REGNODE_OFFSET(NEXTOPER(br)), ender)) @@ -12359,8 +12360,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) if ( OP(NEXTOPER(br)) != NOTHING || regnext(NEXTOPER(br)) != REGNODE_p(ender)) is_nothing= 0; - } - else if (op == BRANCHJ) { + } + else if (op == BRANCHJ) { bool shut_gcc_up = REGTAIL_STUDY(pRExC_state, REGNODE_OFFSET(NEXTOPER(NEXTOPER(br))), ender); @@ -12370,8 +12371,8 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) || regnext(NEXTOPER(NEXTOPER(br))) != REGNODE_p(ender)) */ is_nothing= 0; - } - } + } + } if (is_nothing) { regnode * ret_as_regnode = REGNODE_p(ret); br= PL_regkind[OP(ret_as_regnode)] != BRANCH @@ -12402,7 +12403,7 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) NEXT_OFF(br)= REGNODE_p(ender) - br; } } - } + } } { @@ -12411,47 +12412,47 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth) static const char parens[] = "=!aA<,>Bbt"; /* flag below is set to 0 up through 'A'; 1 for larger */ - if (paren && (p = strchr(parens, paren))) { - U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH; - int flag = (p - parens) > 3; + if (paren && (p = strchr(parens, paren))) { + U8 node = ((p - parens) % 2) ? UNLESSM : IFMATCH; + int flag = (p - parens) > 3; - if (paren == '>' || paren == 't') { - node = SUSPEND, flag = 0; + if (paren == '>' || paren == 't') { + node = SUSPEND, flag = 0; } - reginsert(pRExC_state, node, ret, depth+1); + reginsert(pRExC_state, node, ret, depth+1); Set_Node_Cur_Length(REGNODE_p(ret), parse_start); - Set_Node_Offset(REGNODE_p(ret), parse_start + 1); - FLAGS(REGNODE_p(ret)) = flag; + Set_Node_Offset(REGNODE_p(ret), parse_start + 1); + FLAGS(REGNODE_p(ret)) = flag; if (! REGTAIL_STUDY(pRExC_state, ret, reg_node(pRExC_state, TAIL))) { REQUIRE_BRANCHJ(flagp, 0); } - } + } } /* Check for proper termination. */ if (paren) { /* restore original flags, but keep (?p) and, if we've encountered * something in the parse that changes /d rules into /u, keep the /u */ - RExC_flags = oregflags | (RExC_flags & RXf_PMf_KEEPCOPY); + RExC_flags = oregflags | (RExC_flags & RXf_PMf_KEEPCOPY); if (DEPENDS_SEMANTICS && toUSE_UNI_CHARSET_NOT_DEPENDS) { set_regex_charset(&RExC_flags, REGEX_UNICODE_CHARSET); } - if (RExC_parse >= RExC_end || UCHARAT(RExC_parse) != ')') { - RExC_parse = oregcomp_parse; - vFAIL("Unmatched ("); - } - nextchar(pRExC_state); + if (RExC_parse >= RExC_end || UCHARAT(RExC_parse) != ')') { + RExC_parse = oregcomp_parse; + vFAIL("Unmatched ("); + } + nextchar(pRExC_state); } else if (!paren && RExC_parse < RExC_end) { - if (*RExC_parse == ')') { - RExC_parse++; - vFAIL("Unmatched )"); - } - else - FAIL("Junk on end of regexp"); /* "Can't happen". */ - NOT_REACHED; /* NOTREACHED */ + if (*RExC_parse == ')') { + RExC_parse++; + vFAIL("Unmatched )"); + } + else + FAIL("Junk on end of regexp"); /* "Can't happen". */ + NOT_REACHED; /* NOTREACHED */ } if (after_freeze > RExC_npar) @@ -12488,12 +12489,12 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) DEBUG_PARSE("brnc"); if (first) - ret = 0; + ret = 0; else { - if (RExC_use_BRANCHJ) - ret = reganode(pRExC_state, BRANCHJ, 0); - else { - ret = reg_node(pRExC_state, BRANCH); + if (RExC_use_BRANCHJ) + ret = reganode(pRExC_state, BRANCHJ, 0); + else { + ret = reg_node(pRExC_state, BRANCH); Set_Node_Length(REGNODE_p(ret), 1); } } @@ -12503,38 +12504,38 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); while (RExC_parse < RExC_end && *RExC_parse != '|' && *RExC_parse != ')') { - flags &= ~TRYAGAIN; + flags &= ~TRYAGAIN; latest = regpiece(pRExC_state, &flags, depth+1); - if (latest == 0) { - if (flags & TRYAGAIN) - continue; + if (latest == 0) { + if (flags & TRYAGAIN) + continue; RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: regpiece returned failure, flags=%#" UVxf, (UV) flags); - } - else if (ret == 0) + } + else if (ret == 0) ret = latest; - *flagp |= flags&(HASWIDTH|POSTPONED); - if (chain != 0) { - /* FIXME adding one for every branch after the first is probably - * excessive now we have TRIE support. (hv) */ - MARK_NAUGHTY(1); + *flagp |= flags&(HASWIDTH|POSTPONED); + if (chain != 0) { + /* FIXME adding one for every branch after the first is probably + * excessive now we have TRIE support. (hv) */ + MARK_NAUGHTY(1); if (! REGTAIL(pRExC_state, chain, latest)) { /* XXX We could just redo this branch, but figuring out what * bookkeeping needs to be reset is a pain, and it's likely * that other branches that goto END will also be too large */ REQUIRE_BRANCHJ(flagp, 0); } - } - chain = latest; - c++; + } + chain = latest; + c++; } if (chain == 0) { /* Loop ran zero times. */ - chain = reg_node(pRExC_state, NOTHING); - if (ret == 0) - ret = chain; + chain = reg_node(pRExC_state, NOTHING); + if (ret == 0) + ret = chain; } if (c == 1) { - *flagp |= flags&SIMPLE; + *flagp |= flags&SIMPLE; } return ret; @@ -12551,15 +12552,15 @@ Perl_regcurly(const char *s) PERL_ARGS_ASSERT_REGCURLY; if (*s++ != '{') - return FALSE; + return FALSE; if (!isDIGIT(*s)) - return FALSE; + return FALSE; while (isDIGIT(*s)) - s++; + s++; if (*s == ',') { - s++; - while (isDIGIT(*s)) - s++; + s++; + while (isDIGIT(*s)) + s++; } return *s == '}'; @@ -12842,7 +12843,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } /* Forbid extra quantifiers */ - if (ISMULT2(RExC_parse)) { + if (isQUANTIFIER(RExC_parse, RExC_end)) { RExC_parse++; vFAIL("Nested quantifiers"); } @@ -13351,7 +13352,7 @@ S_new_regcurly(const char *s, const char *e) PERL_ARGS_ASSERT_NEW_REGCURLY; if (s >= e || *s++ != '{') - return FALSE; + return FALSE; while (s < e && isSPACE(*s)) { s++; @@ -13365,7 +13366,7 @@ S_new_regcurly(const char *s, const char *e) } if (*s == ',') { - s++; + s++; while (s < e && isSPACE(*s)) { s++; } @@ -13423,36 +13424,36 @@ S_backref_value(char *p, char *e) A summary of the code structure is: switch (first_byte) { - cases for each special: - handle this special; - break; - case '\\': - switch (2nd byte) { - cases for each unambiguous special: - handle this special; - break; - cases for each ambigous special/literal: - disambiguate; - if (special) handle here - else goto defchar; - default: // unambiguously literal: - goto defchar; - } - default: // is a literal char - // FALL THROUGH - defchar: - create EXACTish node for literal; - while (more input and node isn't full) { - switch (input_byte) { - cases for each special; + cases for each special: + handle this special; + break; + case '\\': + switch (2nd byte) { + cases for each unambiguous special: + handle this special; + break; + cases for each ambigous special/literal: + disambiguate; + if (special) handle here + else goto defchar; + default: // unambiguously literal: + goto defchar; + } + default: // is a literal char + // FALL THROUGH + defchar: + create EXACTish node for literal; + while (more input and node isn't full) { + switch (input_byte) { + cases for each special; make sure parse pointer is set so that the next call to regatom will see this special first goto loopdone; // EXACTish node terminated by prev. char - default: - append char to EXACTISH node; - } - get next input byte; - } + default: + append char to EXACTISH node; + } + get next input byte; + } loopdone: } return the generated node; @@ -13486,37 +13487,37 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) assert(RExC_parse < RExC_end); switch ((U8)*RExC_parse) { case '^': - RExC_seen_zerolen++; - nextchar(pRExC_state); - if (RExC_flags & RXf_PMf_MULTILINE) - ret = reg_node(pRExC_state, MBOL); - else - ret = reg_node(pRExC_state, SBOL); + RExC_seen_zerolen++; + nextchar(pRExC_state); + if (RExC_flags & RXf_PMf_MULTILINE) + ret = reg_node(pRExC_state, MBOL); + else + ret = reg_node(pRExC_state, SBOL); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '$': - nextchar(pRExC_state); - if (*RExC_parse) - RExC_seen_zerolen++; - if (RExC_flags & RXf_PMf_MULTILINE) - ret = reg_node(pRExC_state, MEOL); - else - ret = reg_node(pRExC_state, SEOL); + nextchar(pRExC_state); + if (*RExC_parse) + RExC_seen_zerolen++; + if (RExC_flags & RXf_PMf_MULTILINE) + ret = reg_node(pRExC_state, MEOL); + else + ret = reg_node(pRExC_state, SEOL); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '.': - nextchar(pRExC_state); - if (RExC_flags & RXf_PMf_SINGLELINE) - ret = reg_node(pRExC_state, SANY); - else - ret = reg_node(pRExC_state, REG_ANY); - *flagp |= HASWIDTH|SIMPLE; - MARK_NAUGHTY(1); + nextchar(pRExC_state); + if (RExC_flags & RXf_PMf_SINGLELINE) + ret = reg_node(pRExC_state, SANY); + else + ret = reg_node(pRExC_state, REG_ANY); + *flagp |= HASWIDTH|SIMPLE; + MARK_NAUGHTY(1); Set_Node_Length(REGNODE_p(ret), 1); /* MJD */ - break; + break; case '[': { - char * const oregcomp_parse = ++RExC_parse; + char * const oregcomp_parse = ++RExC_parse; ret = regclass(pRExC_state, flagp, depth+1, FALSE, /* means parse the whole char class */ TRUE, /* allow multi-char folds */ @@ -13529,65 +13530,65 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) FAIL2("panic: regclass returned failure to regatom, flags=%#" UVxf, (UV) *flagp); } - if (*RExC_parse != ']') { - RExC_parse = oregcomp_parse; - vFAIL("Unmatched ["); - } - nextchar(pRExC_state); + if (*RExC_parse != ']') { + RExC_parse = oregcomp_parse; + vFAIL("Unmatched ["); + } + nextchar(pRExC_state); Set_Node_Length(REGNODE_p(ret), RExC_parse - oregcomp_parse + 1); /* MJD */ - break; + break; } case '(': - nextchar(pRExC_state); + nextchar(pRExC_state); ret = reg(pRExC_state, 2, &flags, depth+1); - if (ret == 0) { - if (flags & TRYAGAIN) { - if (RExC_parse >= RExC_end) { - /* Make parent create an empty node if needed. */ - *flagp |= TRYAGAIN; - return(0); - } - goto tryagain; - } + if (ret == 0) { + if (flags & TRYAGAIN) { + if (RExC_parse >= RExC_end) { + /* Make parent create an empty node if needed. */ + *flagp |= TRYAGAIN; + return(0); + } + goto tryagain; + } RETURN_FAIL_ON_RESTART(flags, flagp); FAIL2("panic: reg returned failure to regatom, flags=%#" UVxf, (UV) flags); - } - *flagp |= flags&(HASWIDTH|SIMPLE|POSTPONED); - break; + } + *flagp |= flags&(HASWIDTH|SIMPLE|POSTPONED); + break; case '|': case ')': - if (flags & TRYAGAIN) { - *flagp |= TRYAGAIN; - return 0; - } - vFAIL("Internal urp"); - /* Supposed to be caught earlier. */ - break; + if (flags & TRYAGAIN) { + *flagp |= TRYAGAIN; + return 0; + } + vFAIL("Internal urp"); + /* Supposed to be caught earlier. */ + break; case '?': case '+': case '*': - RExC_parse++; - vFAIL("Quantifier follows nothing"); - break; + RExC_parse++; + vFAIL("Quantifier follows nothing"); + break; case '\\': - /* Special Escapes - - This switch handles escape sequences that resolve to some kind - of special regop and not to literal text. Escape sequences that - resolve to literal text are handled below in the switch marked - "Literal Escapes". - - Every entry in this switch *must* have a corresponding entry - in the literal escape switch. However, the opposite is not - required, as the default for this switch is to jump to the - literal text handling code. - */ - RExC_parse++; - switch ((U8)*RExC_parse) { - /* Special Escapes */ - case 'A': - RExC_seen_zerolen++; + /* Special Escapes + + This switch handles escape sequences that resolve to some kind + of special regop and not to literal text. Escape sequences that + resolve to literal text are handled below in the switch marked + "Literal Escapes". + + Every entry in this switch *must* have a corresponding entry + in the literal escape switch. However, the opposite is not + required, as the default for this switch is to jump to the + literal text handling code. + */ + RExC_parse++; + switch ((U8)*RExC_parse) { + /* Special Escapes */ + case 'A': + RExC_seen_zerolen++; /* Under wildcards, this is changed to match \n; should be * invisible to the user, as they have to compile under /m */ if (RExC_pm_flags & PMf_WILDCARD) { @@ -13599,8 +13600,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * /\A/ from /^/ in split. */ FLAGS(REGNODE_p(ret)) = 1; } - goto finish_meta_pat; - case 'G': + goto finish_meta_pat; + case 'G': if (RExC_pm_flags & PMf_WILDCARD) { RExC_parse++; /* diag_listed_as: Use of %s is not allowed in Unicode property @@ -13609,10 +13610,10 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL("Use of '\\G' is not allowed in Unicode property" " wildcard subpatterns"); } - ret = reg_node(pRExC_state, GPOS); + ret = reg_node(pRExC_state, GPOS); RExC_seen |= REG_GPOS_SEEN; - goto finish_meta_pat; - case 'K': + goto finish_meta_pat; + case 'K': if (!RExC_in_lookaround) { RExC_seen_zerolen++; ret = reg_node(pRExC_state, KEEPS); @@ -13627,7 +13628,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ++RExC_parse; /* advance past the 'K' */ vFAIL("\\K not permitted in lookahead/lookbehind"); } - case 'Z': + case 'Z': if (RExC_pm_flags & PMf_WILDCARD) { /* See comment under \A above */ ret = reg_node(pRExC_state, MEOL); @@ -13635,9 +13636,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { ret = reg_node(pRExC_state, SEOL); } - RExC_seen_zerolen++; /* Do not optimize RE away */ - goto finish_meta_pat; - case 'z': + RExC_seen_zerolen++; /* Do not optimize RE away */ + goto finish_meta_pat; + case 'z': if (RExC_pm_flags & PMf_WILDCARD) { /* See comment under \A above */ ret = reg_node(pRExC_state, MEOL); @@ -13645,28 +13646,28 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { ret = reg_node(pRExC_state, EOS); } - RExC_seen_zerolen++; /* Do not optimize RE away */ - goto finish_meta_pat; - case 'C': - vFAIL("\\C no longer supported"); - case 'X': - ret = reg_node(pRExC_state, CLUMP); - *flagp |= HASWIDTH; - goto finish_meta_pat; + RExC_seen_zerolen++; /* Do not optimize RE away */ + goto finish_meta_pat; + case 'C': + vFAIL("\\C no longer supported"); + case 'X': + ret = reg_node(pRExC_state, CLUMP); + *flagp |= HASWIDTH; + goto finish_meta_pat; - case 'B': + case 'B': invert = 1; /* FALLTHROUGH */ - case 'b': + case 'b': { U8 flags = 0; - regex_charset charset = get_regex_charset(RExC_flags); + regex_charset charset = get_regex_charset(RExC_flags); - RExC_seen_zerolen++; + RExC_seen_zerolen++; RExC_seen |= REG_LOOKBEHIND_SEEN; - op = BOUND + charset; + op = BOUND + charset; - if (RExC_parse >= RExC_end || *(RExC_parse + 1) != '{') { + if (RExC_parse >= RExC_end || *(RExC_parse + 1) != '{') { flags = TRADITIONAL_BOUND; if (op > BOUNDA) { /* /aa is same as /a */ op = BOUNDA; @@ -13726,9 +13727,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) default: bad_bound_type: RExC_parse = endbrace; - vFAIL2utf8f( + vFAIL2utf8f( "'%" UTF8f "' is an unknown bound type", - UTF8fARG(UTF, length, endbrace - length)); + UTF8fARG(UTF, length, endbrace - length)); NOT_REACHED; /*NOTREACHED*/ } RExC_parse = endbrace; @@ -13751,7 +13752,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ? ASCII_RESTRICT_PAT_MODS : ASCII_MORE_RESTRICT_PAT_MODS); } - } + } if (op == BOUND) { RExC_seen_d_op = TRUE; @@ -13764,29 +13765,29 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) op += NBOUND - BOUND; } - ret = reg_node(pRExC_state, op); + ret = reg_node(pRExC_state, op); FLAGS(REGNODE_p(ret)) = flags; - goto finish_meta_pat; + goto finish_meta_pat; } - case 'R': - ret = reg_node(pRExC_state, LNBREAK); - *flagp |= HASWIDTH|SIMPLE; - goto finish_meta_pat; - - case 'd': - case 'D': - case 'h': - case 'H': - case 'p': - case 'P': - case 's': - case 'S': - case 'v': - case 'V': - case 'w': - case 'W': + case 'R': + ret = reg_node(pRExC_state, LNBREAK); + *flagp |= HASWIDTH|SIMPLE; + goto finish_meta_pat; + + case 'd': + case 'D': + case 'h': + case 'H': + case 'p': + case 'P': + case 's': + case 'S': + case 'v': + case 'V': + case 'w': + case 'W': /* These all have the same meaning inside [brackets], and it knows * how to do the best optimizations for them. So, pretend we found * these within brackets, and let it do the work */ @@ -13824,7 +13825,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Offset(REGNODE_p(ret), parse_start); Set_Node_Length(REGNODE_p(ret), RExC_parse - parse_start + 1); /* MJD */ nextchar(pRExC_state); - break; + break; case 'N': /* Handle \N, \N{} and \N{NAMED SEQUENCE} (the latter meaning the * \N{...} evaluates to a sequence of more than one code points). @@ -13857,7 +13858,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) RExC_parse = parse_start; goto defchar; - case 'k': /* Handle \k and \k'NAME' */ + case 'k': /* Handle \k and \k'NAME' */ parse_named_seq: { char ch; @@ -13866,11 +13867,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) && ch != '\'' && ch != '{')) { - RExC_parse++; - /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */ - vFAIL2("Sequence %.2s... not terminated", parse_start); - } else { - RExC_parse += 2; + RExC_parse++; + /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */ + vFAIL2("Sequence %.2s... not terminated", parse_start); + } else { + RExC_parse += 2; ret = handle_named_backref(pRExC_state, flagp, parse_start, @@ -13881,30 +13882,30 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) : '\''); } break; - } - case 'g': - case '1': case '2': case '3': case '4': - case '5': case '6': case '7': case '8': case '9': - { - I32 num; - bool hasbrace = 0; - - if (*RExC_parse == 'g') { + } + case 'g': + case '1': case '2': case '3': case '4': + case '5': case '6': case '7': case '8': case '9': + { + I32 num; + bool hasbrace = 0; + + if (*RExC_parse == 'g') { bool isrel = 0; - RExC_parse++; - if (*RExC_parse == '{') { - RExC_parse++; - hasbrace = 1; - } - if (*RExC_parse == '-') { - RExC_parse++; - isrel = 1; - } - if (hasbrace && !isDIGIT(*RExC_parse)) { - if (isrel) RExC_parse--; + RExC_parse++; + if (*RExC_parse == '{') { + RExC_parse++; + hasbrace = 1; + } + if (*RExC_parse == '-') { + RExC_parse++; + isrel = 1; + } + if (hasbrace && !isDIGIT(*RExC_parse)) { + if (isrel) RExC_parse--; RExC_parse -= 2; - goto parse_named_seq; + goto parse_named_seq; } if (RExC_parse >= RExC_end) { @@ -13915,7 +13916,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL("Reference to invalid group 0"); else if (num == I32_MAX) { if (isDIGIT(*RExC_parse)) - vFAIL("Reference to nonexistent group"); + vFAIL("Reference to nonexistent group"); else unterminated_g: vFAIL("Unterminated \\g... pattern"); @@ -14001,48 +14002,48 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Cur_Length(REGNODE_p(ret), parse_start-1); skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); - } - break; - case '\0': - if (RExC_parse >= RExC_end) - FAIL("Trailing \\"); - /* FALLTHROUGH */ - default: - /* Do not generate "unrecognized" warnings here, we fall - back into the quick-grab loop below */ + } + break; + case '\0': + if (RExC_parse >= RExC_end) + FAIL("Trailing \\"); + /* FALLTHROUGH */ + default: + /* Do not generate "unrecognized" warnings here, we fall + back into the quick-grab loop below */ RExC_parse = parse_start; - goto defchar; - } /* end of switch on a \foo sequence */ - break; + goto defchar; + } /* end of switch on a \foo sequence */ + break; case '#': /* '#' comments should have been spaced over before this function was * called */ assert((RExC_flags & RXf_PMf_EXTENDED) == 0); - /* + /* if (RExC_flags & RXf_PMf_EXTENDED) { - RExC_parse = reg_skipcomment( pRExC_state, RExC_parse ); - if (RExC_parse < RExC_end) - goto tryagain; - } + RExC_parse = reg_skipcomment( pRExC_state, RExC_parse ); + if (RExC_parse < RExC_end) + goto tryagain; + } */ - /* FALLTHROUGH */ + /* FALLTHROUGH */ default: - defchar: { + defchar: { /* Here, we have determined that the next thing is probably a * literal character. RExC_parse points to the first byte of its * definition. (It still may be an escape sequence that evaluates * to a single character) */ - STRLEN len = 0; - UV ender = 0; - char *p; - char *s, *old_s = NULL, *old_old_s = NULL; - char *s0; + STRLEN len = 0; + UV ender = 0; + char *p; + char *s, *old_s = NULL, *old_old_s = NULL; + char *s0; U32 max_string_len = 255; /* We may have to reparse the node, artificially stopping filling @@ -14116,11 +14117,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) FILL_NODE(ret, node_type); RExC_emit++; - s = STRING(REGNODE_p(ret)); + s = STRING(REGNODE_p(ret)); s0 = s; - reparse: + reparse: p = RExC_parse; len = 0; @@ -14162,7 +14163,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * The exceptions override this */ Size_t added_len = 1; - oldp = p; + oldp = p; old_old_s = old_s; old_s = s; @@ -14170,62 +14171,62 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) assert( (RExC_flags & RXf_PMf_EXTENDED) == 0 || ! is_PATWS_safe((p), RExC_end, UTF)); - switch ((U8)*p) { + switch ((U8)*p) { const char* message; U32 packed_warn; U8 grok_c_char; - case '^': - case '$': - case '.': - case '[': - case '(': - case ')': - case '|': - goto loopdone; - case '\\': - /* Literal Escapes Switch - - This switch is meant to handle escape sequences that - resolve to a literal character. - - Every escape sequence that represents something - else, like an assertion or a char class, is handled - in the switch marked 'Special Escapes' above in this - routine, but also has an entry here as anything that - isn't explicitly mentioned here will be treated as - an unescaped equivalent literal. - */ - - switch ((U8)*++p) { - - /* These are all the special escapes. */ - case 'A': /* Start assertion */ - case 'b': case 'B': /* Word-boundary assertion*/ - case 'C': /* Single char !DANGEROUS! */ - case 'd': case 'D': /* digit class */ - case 'g': case 'G': /* generic-backref, pos assertion */ - case 'h': case 'H': /* HORIZWS */ - case 'k': case 'K': /* named backref, keep marker */ - case 'p': case 'P': /* Unicode property */ - case 'R': /* LNBREAK */ - case 's': case 'S': /* space class */ - case 'v': case 'V': /* VERTWS */ - case 'w': case 'W': /* word class */ + case '^': + case '$': + case '.': + case '[': + case '(': + case ')': + case '|': + goto loopdone; + case '\\': + /* Literal Escapes Switch + + This switch is meant to handle escape sequences that + resolve to a literal character. + + Every escape sequence that represents something + else, like an assertion or a char class, is handled + in the switch marked 'Special Escapes' above in this + routine, but also has an entry here as anything that + isn't explicitly mentioned here will be treated as + an unescaped equivalent literal. + */ + + switch ((U8)*++p) { + + /* These are all the special escapes. */ + case 'A': /* Start assertion */ + case 'b': case 'B': /* Word-boundary assertion*/ + case 'C': /* Single char !DANGEROUS! */ + case 'd': case 'D': /* digit class */ + case 'g': case 'G': /* generic-backref, pos assertion */ + case 'h': case 'H': /* HORIZWS */ + case 'k': case 'K': /* named backref, keep marker */ + case 'p': case 'P': /* Unicode property */ + case 'R': /* LNBREAK */ + case 's': case 'S': /* space class */ + case 'v': case 'V': /* VERTWS */ + case 'w': case 'W': /* word class */ case 'X': /* eXtended Unicode "combining character sequence" */ - case 'z': case 'Z': /* End of line/string assertion */ - --p; - goto loopdone; - - /* Anything after here is an escape that resolves to a - literal. (Except digits, which may or may not) - */ - case 'n': - ender = '\n'; - p++; - break; - case 'N': /* Handle a single-code point named character. */ + case 'z': case 'Z': /* End of line/string assertion */ + --p; + goto loopdone; + + /* Anything after here is an escape that resolves to a + literal. (Except digits, which may or may not) + */ + case 'n': + ender = '\n'; + p++; + break; + case 'N': /* Handle a single-code point named character. */ RExC_parse = p + 1; if (! grok_bslash_N(pRExC_state, NULL, /* Fail if evaluates to @@ -14269,27 +14270,27 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } break; - case 'r': - ender = '\r'; - p++; - break; - case 't': - ender = '\t'; - p++; - break; - case 'f': - ender = '\f'; - p++; - break; - case 'e': - ender = ESC_NATIVE; - p++; - break; - case 'a': - ender = '\a'; - p++; - break; - case 'o': + case 'r': + ender = '\r'; + p++; + break; + case 't': + ender = '\t'; + p++; + break; + case 'f': + ender = '\f'; + p++; + break; + case 'e': + ender = ESC_NATIVE; + p++; + break; + case 'a': + ender = '\a'; + p++; + break; + case 'o': if (! grok_bslash_o(&p, RExC_end, &ender, @@ -14308,7 +14309,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) warn_non_literal_string(p, packed_warn, message); } break; - case 'x': + case 'x': if (! grok_bslash_x(&p, RExC_end, &ender, @@ -14335,7 +14336,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } #endif break; - case 'c': + case 'c': p++; if (! grok_bslash_c(*p, &grok_c_char, &message, &packed_warn)) @@ -14354,7 +14355,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) warn_non_literal_string(p, packed_warn, message); } - break; + break; case '8': case '9': /* must be a backreference */ --p; /* we have an escape like \8 which cannot be an octal escape @@ -14362,7 +14363,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * escape which may or may not be a legitimate backref. */ goto loopdone; case '1': case '2': case '3':case '4': - case '5': case '6': case '7': + case '5': case '6': case '7': /* When we parse backslash escapes there is ambiguity * between backreferences and octal escapes. Any escape * from \1 - \9 is a backreference, any multi-digit @@ -14387,29 +14388,29 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } /* FALLTHROUGH */ case '0': - { - I32 flags = PERL_SCAN_SILENT_ILLDIGIT + { + I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_NOTIFY_ILLDIGIT; - STRLEN numlen = 3; - ender = grok_oct(p, &numlen, &flags, NULL); - p += numlen; + STRLEN numlen = 3; + ender = grok_oct(p, &numlen, &flags, NULL); + p += numlen; if ( (flags & PERL_SCAN_NOTIFY_ILLDIGIT) && isDIGIT(*p) /* like \08, \178 */ && ckWARN(WARN_REGEXP)) { - reg_warn_non_literal_string( + reg_warn_non_literal_string( p + 1, form_alien_digit_msg(8, numlen, p, RExC_end, UTF, FALSE)); } - } - break; - case '\0': - if (p >= RExC_end) - FAIL("Trailing \\"); - /* FALLTHROUGH */ - default: - if (isALPHANUMERIC(*p)) { + } + break; + case '\0': + if (p >= RExC_end) + FAIL("Trailing \\"); + /* FALLTHROUGH */ + default: + if (isALPHANUMERIC(*p)) { /* An alpha followed by '{' is going to fail next * iteration, so don't output this warning in that * case */ @@ -14417,11 +14418,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) ckWARN2reg(p + 1, "Unrecognized escape \\%.1s" " passed through", p); } - } - goto normal_default; - } /* End of switch on '\' */ - break; - case '{': + } + goto normal_default; + } /* End of switch on '\' */ + break; + case '{': /* Trying to gain new uses for '{' without breaking too * much existing code is hard. The solution currently * adopted is: @@ -14437,7 +14438,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * misspelled the quantifier. Without this warning, * the quantifier would silently be taken as a literal * string of characters instead of a meta construct */ - if (len || (p > RExC_start && isALPHA_A(*(p - 1)))) { + if (len || (p > RExC_start && isALPHA_A(*(p - 1)))) { if ( RExC_strict || ( p > parse_start + 1 && isALPHA_A(*(p - 1)) @@ -14450,28 +14451,28 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } ckWARNreg(p + 1, "Unescaped left brace in regex is" " passed through"); - } - goto normal_default; + } + goto normal_default; case '}': case ']': if (p > RExC_parse && RExC_strict) { ckWARN2reg(p + 1, "Unescaped literal '%c'", *p); } - /*FALLTHROUGH*/ - default: /* A literal character */ - normal_default: - if (! UTF8_IS_INVARIANT(*p) && UTF) { - STRLEN numlen; - ender = utf8n_to_uvchr((U8*)p, RExC_end - p, - &numlen, UTF8_ALLOW_DEFAULT); - p += numlen; - } - else - ender = (U8) *p++; - break; - } /* End of switch on the literal */ - - /* Here, have looked at the literal character, and + /*FALLTHROUGH*/ + default: /* A literal character */ + normal_default: + if (! UTF8_IS_INVARIANT(*p) && UTF) { + STRLEN numlen; + ender = utf8n_to_uvchr((U8*)p, RExC_end - p, + &numlen, UTF8_ALLOW_DEFAULT); + p += numlen; + } + else + ender = (U8) *p++; + break; + } /* End of switch on the literal */ + + /* Here, have looked at the literal character, and * contains its ordinal;

points to the character after it. * */ @@ -14503,7 +14504,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * only thing in its new node */ next_is_quantifier = LIKELY(p < RExC_end) - && UNLIKELY(ISMULT2(p)); + && UNLIKELY(isQUANTIFIER(p, RExC_end)); if (next_is_quantifier && LIKELY(len)) { p = oldp; @@ -14733,20 +14734,20 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * requires UTF-8 to represent. */ : (char) toLOWER_L1(ender); } - } /* End of adding current character to the node */ + } /* End of adding current character to the node */ done_with_this_char: len += added_len; - if (next_is_quantifier) { + if (next_is_quantifier) { /* Here, the next input is a quantifier, and to get here, * the current character is the only one in the node. */ goto loopdone; - } + } - } /* End of loop through literal characters */ + } /* End of loop through literal characters */ /* Here we have either exhausted the input or run out of room in * the node. If the former, we are done. (If we encountered a @@ -15236,7 +15237,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Safefree(locfold_buf); Safefree(loc_correspondence); } - } /* End of verifying node ends with an appropriate char */ + } /* End of verifying node ends with an appropriate char */ /* We need to start the next node at the character that didn't fit * in this one */ @@ -15360,15 +15361,15 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) Set_Node_Length(REGNODE_p(ret), p - parse_start - 1); RExC_parse = p; - { - /* len is STRLEN which is unsigned, need to copy to signed */ - IV iv = len; - if (iv < 0) - vFAIL("Internal disaster"); - } + { + /* len is STRLEN which is unsigned, need to copy to signed */ + IV iv = len; + if (iv < 0) + vFAIL("Internal disaster"); + } - } /* End of label 'defchar:' */ - break; + } /* End of label 'defchar:' */ + break; } /* End of giant switch on input character */ /* Position parse to next real character */ @@ -15408,53 +15409,53 @@ S_populate_ANYOF_from_invlist(pTHX_ regnode *node, SV** invlist_ptr) ANYOF_BITMAP_ZERO(node); if (*invlist_ptr) { - /* This gets set if we actually need to modify things */ - bool change_invlist = FALSE; + /* This gets set if we actually need to modify things */ + bool change_invlist = FALSE; - UV start, end; + UV start, end; - /* Start looking through *invlist_ptr */ - invlist_iterinit(*invlist_ptr); - while (invlist_iternext(*invlist_ptr, &start, &end)) { - UV high; - int i; + /* Start looking through *invlist_ptr */ + invlist_iterinit(*invlist_ptr); + while (invlist_iternext(*invlist_ptr, &start, &end)) { + UV high; + int i; if (end == UV_MAX && start <= NUM_ANYOF_CODE_POINTS) { ANYOF_FLAGS(node) |= ANYOF_MATCHES_ALL_ABOVE_BITMAP; } - /* Quit if are above what we should change */ - if (start >= NUM_ANYOF_CODE_POINTS) { - break; - } + /* Quit if are above what we should change */ + if (start >= NUM_ANYOF_CODE_POINTS) { + break; + } - change_invlist = TRUE; + change_invlist = TRUE; - /* Set all the bits in the range, up to the max that we are doing */ - high = (end < NUM_ANYOF_CODE_POINTS - 1) + /* Set all the bits in the range, up to the max that we are doing */ + high = (end < NUM_ANYOF_CODE_POINTS - 1) ? end : NUM_ANYOF_CODE_POINTS - 1; - for (i = start; i <= (int) high; i++) { + for (i = start; i <= (int) high; i++) { ANYOF_BITMAP_SET(node, i); - } - } - invlist_iterfinish(*invlist_ptr); + } + } + invlist_iterfinish(*invlist_ptr); /* Done with loop; remove any code points that are in the bitmap from * *invlist_ptr; similarly for code points above the bitmap if we have * a flag to match all of them anyways */ - if (change_invlist) { - _invlist_subtract(*invlist_ptr, PL_InBitmap, invlist_ptr); - } + if (change_invlist) { + _invlist_subtract(*invlist_ptr, PL_InBitmap, invlist_ptr); + } if (ANYOF_FLAGS(node) & ANYOF_MATCHES_ALL_ABOVE_BITMAP) { - _invlist_intersection(*invlist_ptr, PL_InBitmap, invlist_ptr); - } + _invlist_intersection(*invlist_ptr, PL_InBitmap, invlist_ptr); + } - /* If have completely emptied it, remove it completely */ - if (_invlist_len(*invlist_ptr) == 0) { - SvREFCNT_dec_NN(*invlist_ptr); - *invlist_ptr = NULL; - } + /* If have completely emptied it, remove it completely */ + if (_invlist_len(*invlist_ptr) == 0) { + SvREFCNT_dec_NN(*invlist_ptr); + *invlist_ptr = NULL; + } } } @@ -16495,7 +16496,7 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, RExC_parse++; RExC_sets_depth++; - node = reg(pRExC_state, 2, flagp, depth+1); + node = reg(pRExC_state, 2, flagp, depth+1); RETURN_FAIL_ON_RESTART(*flagp, flagp); if ( OP(REGNODE_p(node)) != REGEX_SET @@ -17316,7 +17317,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, SV *listsv = NULL; /* List of \p{user-defined} whose definitions aren't available at the time this was called */ STRLEN initial_listsv_len = 0; /* Kind of a kludge to see if it is more - than just initialized. */ + than just initialized. */ SV* properties = NULL; /* Code points that match \p{} \P{} */ SV* posixes = NULL; /* Code points that match classes like [:word:], extended beyond the Latin1 range. These have to @@ -17333,7 +17334,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, leading to less compilation and execution work */ UV element_count = 0; /* Number of distinct elements in the class. - Optimizations may be possible if this is tiny */ + Optimizations may be possible if this is tiny */ AV * multi_char_matches = NULL; /* Code points that fold to more than one character; used under /i */ UV n; @@ -17436,7 +17437,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, assert(RExC_parse <= RExC_end); if (UCHARAT(RExC_parse) == '^') { /* Complement the class */ - RExC_parse++; + RExC_parse++; invert = TRUE; allow_mutiple_chars = FALSE; MARK_NAUGHTY(1); @@ -17471,7 +17472,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* allow 1st char to be ']' (allowing it to be '-' is dealt with later) */ if (UCHARAT(RExC_parse) == ']') - goto charclassloop; + goto charclassloop; while (1) { @@ -17499,23 +17500,23 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, charclassloop: - namedclass = OOB_NAMEDCLASS; /* initialize as illegal */ + namedclass = OOB_NAMEDCLASS; /* initialize as illegal */ save_value = value; save_prevvalue = prevvalue; - if (!range) { - rangebegin = RExC_parse; - element_count++; + if (!range) { + rangebegin = RExC_parse; + element_count++; non_portable_endpoint = 0; - } - if (UTF && ! UTF8_IS_INVARIANT(* RExC_parse)) { - value = utf8n_to_uvchr((U8*)RExC_parse, - RExC_end - RExC_parse, - &numlen, UTF8_ALLOW_DEFAULT); - RExC_parse += numlen; - } - else - value = UCHARAT(RExC_parse++); + } + if (UTF && ! UTF8_IS_INVARIANT(* RExC_parse)) { + value = utf8n_to_uvchr((U8*)RExC_parse, + RExC_end - RExC_parse, + &numlen, UTF8_ALLOW_DEFAULT); + RExC_parse += numlen; + } + else + value = UCHARAT(RExC_parse++); if (value == '[') { char * posix_class_end; @@ -17570,20 +17571,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, vFAIL("Unmatched ["); } - if (UTF && ! UTF8_IS_INVARIANT(UCHARAT(RExC_parse))) { - value = utf8n_to_uvchr((U8*)RExC_parse, - RExC_end - RExC_parse, - &numlen, UTF8_ALLOW_DEFAULT); - RExC_parse += numlen; - } - else - value = UCHARAT(RExC_parse++); + if (UTF && ! UTF8_IS_INVARIANT(UCHARAT(RExC_parse))) { + value = utf8n_to_uvchr((U8*)RExC_parse, + RExC_end - RExC_parse, + &numlen, UTF8_ALLOW_DEFAULT); + RExC_parse += numlen; + } + else + value = UCHARAT(RExC_parse++); - /* Some compilers cannot handle switching on 64-bit integer - * values, therefore value cannot be an UV. Yes, this will - * be a problem later if we want switch on Unicode. - * A similar issue a little bit later when switching on - * namedclass. --jhi */ + /* Some compilers cannot handle switching on 64-bit integer + * values, therefore value cannot be an UV. Yes, this will + * be a problem later if we want switch on Unicode. + * A similar issue a little bit later when switching on + * namedclass. --jhi */ /* If the \ is escaping white space when white space is being * skipped, it means that that white space is wanted literally, and @@ -17594,16 +17595,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, U32 packed_warn; U8 grok_c_char; - case 'w': namedclass = ANYOF_WORDCHAR; break; - case 'W': namedclass = ANYOF_NWORDCHAR; break; - case 's': namedclass = ANYOF_SPACE; break; - case 'S': namedclass = ANYOF_NSPACE; break; - case 'd': namedclass = ANYOF_DIGIT; break; - case 'D': namedclass = ANYOF_NDIGIT; break; - case 'v': namedclass = ANYOF_VERTWS; break; - case 'V': namedclass = ANYOF_NVERTWS; break; - case 'h': namedclass = ANYOF_HORIZWS; break; - case 'H': namedclass = ANYOF_NHORIZWS; break; + case 'w': namedclass = ANYOF_WORDCHAR; break; + case 'W': namedclass = ANYOF_NWORDCHAR; break; + case 's': namedclass = ANYOF_SPACE; break; + case 'S': namedclass = ANYOF_NSPACE; break; + case 'd': namedclass = ANYOF_DIGIT; break; + case 'D': namedclass = ANYOF_NDIGIT; break; + case 'v': namedclass = ANYOF_VERTWS; break; + case 'V': namedclass = ANYOF_NVERTWS; break; + case 'h': namedclass = ANYOF_HORIZWS; break; + case 'H': namedclass = ANYOF_NHORIZWS; break; case 'N': /* Handle \N{NAME} in class */ { const char * const backslash_N_beg = RExC_parse - 2; @@ -17670,10 +17671,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, unicode_range = TRUE; /* \N{} are Unicode */ } break; - case 'p': - case 'P': - { - char *e; + case 'p': + case 'P': + { + char *e; if (RExC_pm_flags & PMf_WILDCARD) { RExC_parse++; @@ -17684,14 +17685,14 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, " wildcard subpatterns", (char) value, *(RExC_parse - 1)); } - /* \p means they want Unicode semantics */ - REQUIRE_UNI_RULES(flagp, 0); + /* \p means they want Unicode semantics */ + REQUIRE_UNI_RULES(flagp, 0); - if (RExC_parse >= RExC_end) - vFAIL2("Empty \\%c", (U8)value); - if (*RExC_parse == '{') { - const U8 c = (U8)value; - e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); + if (RExC_parse >= RExC_end) + vFAIL2("Empty \\%c", (U8)value); + if (*RExC_parse == '{') { + const U8 c = (U8)value; + e = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); if (!e) { RExC_parse++; vFAIL2("Missing right brace on \\%c{}", c); @@ -17703,9 +17704,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * any '^', even when not under /x */ while (isSPACE(*RExC_parse)) { RExC_parse++; - } + } - if (UCHARAT(RExC_parse) == '^') { + if (UCHARAT(RExC_parse) == '^') { /* toggle. (The rhs xor gets the single bit that * differs between P and p; the other xor inverts just @@ -17721,12 +17722,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (e == RExC_parse) vFAIL2("Empty \\%c{}", c); - n = e - RExC_parse; - while (isSPACE(*(RExC_parse + n - 1))) - n--; + n = e - RExC_parse; + while (isSPACE(*(RExC_parse + n - 1))) + n--; - } /* The \p isn't immediately followed by a '{' */ - else if (! isALPHA(*RExC_parse)) { + } /* The \p isn't immediately followed by a '{' */ + else if (! isALPHA(*RExC_parse)) { RExC_parse += (UTF) ? UTF8_SAFE_SKIP(RExC_parse, RExC_end) : 1; @@ -17735,10 +17736,10 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, (U8) value); } else { - e = RExC_parse; - n = 1; - } - { + e = RExC_parse; + n = 1; + } + { char* name = RExC_parse; /* Any message returned about expanding the definition */ @@ -17771,7 +17772,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, mojibake */ RExC_utf8 = TRUE; } - /* diag_listed_as: Can't find Unicode property definition "%s" in regex; marked by <-- HERE in m/%s/ */ + /* diag_listed_as: Can't find Unicode property definition "%s" in regex; marked by <-- HERE in m/%s/ */ vFAIL2utf8f("%" UTF8f, UTF8fARG(SvUTF8(msg), SvCUR(msg), SvPVX(msg))); } @@ -17889,30 +17890,30 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* Invert if asking for the complement */ if (value == 'P') { - _invlist_union_complement_2nd(properties, + _invlist_union_complement_2nd(properties, prop_definition, &properties); } else { _invlist_union(properties, prop_definition, &properties); - } + } } } - RExC_parse = e + 1; + RExC_parse = e + 1; namedclass = ANYOF_UNIPROP; /* no official name, but it's named */ - } - break; - case 'n': value = '\n'; break; - case 'r': value = '\r'; break; - case 't': value = '\t'; break; - case 'f': value = '\f'; break; - case 'b': value = '\b'; break; - case 'e': value = ESC_NATIVE; break; - case 'a': value = '\a'; break; - case 'o': - RExC_parse--; /* function expects to be pointed at the 'o' */ + } + break; + case 'n': value = '\n'; break; + case 'r': value = '\r'; break; + case 't': value = '\t'; break; + case 'f': value = '\f'; break; + case 'b': value = '\b'; break; + case 'e': value = ESC_NATIVE; break; + case 'a': value = '\a'; break; + case 'o': + RExC_parse--; /* function expects to be pointed at the 'o' */ if (! grok_bslash_o(&RExC_parse, RExC_end, &value, @@ -17932,9 +17933,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - case 'x': - RExC_parse--; /* function expects to be pointed at the 'x' */ + break; + case 'x': + RExC_parse--; /* function expects to be pointed at the 'x' */ if (! grok_bslash_x(&RExC_parse, RExC_end, &value, @@ -17954,8 +17955,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - case 'c': + break; + case 'c': if (! grok_bslash_c(*RExC_parse, &grok_c_char, &message, &packed_warn)) { @@ -17974,16 +17975,16 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } non_portable_endpoint++; - break; - case '0': case '1': case '2': case '3': case '4': - case '5': case '6': case '7': - { - /* Take 1-3 octal digits */ - I32 flags = PERL_SCAN_SILENT_ILLDIGIT + break; + case '0': case '1': case '2': case '3': case '4': + case '5': case '6': case '7': + { + /* Take 1-3 octal digits */ + I32 flags = PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_NOTIFY_ILLDIGIT; numlen = (strict) ? 4 : 3; value = grok_oct(--RExC_parse, &numlen, &flags, NULL); - RExC_parse += numlen; + RExC_parse += numlen; if (numlen != 3) { if (strict) { RExC_parse += (UTF) @@ -18005,11 +18006,11 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, if (value < 256) { non_portable_endpoint++; } - break; - } - default: - /* Allow \_ to not give an error */ - if (isWORDCHAR(value) && value != '_') { + break; + } + default: + /* Allow \_ to not give an error */ + if (isWORDCHAR(value) && value != '_') { if (strict) { vFAIL2("Unrecognized escape \\%c in character class", (int)value); @@ -18019,20 +18020,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, "Unrecognized escape \\%c in character class passed through", (int)value); } - } - break; - } /* End of switch on char following backslash */ - } /* end of handling backslash escape sequences */ + } + break; + } /* End of switch on char following backslash */ + } /* end of handling backslash escape sequences */ /* Here, we have the current token in 'value' */ - if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */ + if (namedclass > OOB_NAMEDCLASS) { /* this is a named class \blah */ U8 classnum; - /* a bad range like a-\d, a-[:digit:]. The '-' is taken as a - * literal, as is the character that began the false range, i.e. - * the 'a' in the examples */ - if (range) { + /* a bad range like a-\d, a-[:digit:]. The '-' is taken as a + * literal, as is the character that began the false range, i.e. + * the 'a' in the examples */ + if (range) { const int w = (RExC_parse >= rangebegin) ? RExC_parse - rangebegin : 0; @@ -18050,13 +18051,13 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, prevvalue); } - range = 0; /* this was not a true range */ + range = 0; /* this was not a true range */ element_count += 2; /* So counts for three values */ - } + } classnum = namedclass_to_classnum(namedclass); - if (LOC && namedclass < ANYOF_POSIXL_MAX + if (LOC && namedclass < ANYOF_POSIXL_MAX #ifndef HAS_ISASCII && classnum != _CC_ASCII #endif @@ -18178,8 +18179,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, namedclass % 2 != 0, posixes_ptr); } - } - } /* end of namedclass \blah */ + } + } /* end of namedclass \blah */ SKIP_BRACKETED_WHITE_SPACE(skip_white, RExC_parse, RExC_end); @@ -18192,20 +18193,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * the next real character to be processed is the range indicator--the * minus sign */ - if (range) { + if (range) { #ifdef EBCDIC /* For unicode ranges, we have to test that the Unicode as opposed * to the native values are not decreasing. (Above 255, there is * no difference between native and Unicode) */ - if (unicode_range && prevvalue < 255 && value < 255) { + if (unicode_range && prevvalue < 255 && value < 255) { if (NATIVE_TO_LATIN1(prevvalue) > NATIVE_TO_LATIN1(value)) { goto backwards_range; } } else #endif - if (prevvalue > value) /* b-a */ { - int w; + if (prevvalue > value) /* b-a */ { + int w; #ifdef EBCDIC backwards_range: #endif @@ -18214,9 +18215,9 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, "Invalid [] range \"%" UTF8f "\"", UTF8fARG(UTF, w, rangebegin)); NOT_REACHED; /* NOTREACHED */ - } - } - else { + } + } + else { prevvalue = value; /* save the beginning of the potential range */ if (! stop_at_1 /* Can't be a range if parsing just one thing */ && *RExC_parse == '-') @@ -18253,8 +18254,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, range = 1; /* yeah, it's a range! */ continue; /* but do it the next time */ } - } - } + } + } if (namedclass > OOB_NAMEDCLASS) { continue; @@ -18264,8 +18265,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * is the beginning of the range, if any; or if * not. */ - /* non-Latin1 code point implies unicode semantics. */ - if (value > 255) { + /* non-Latin1 code point implies unicode semantics. */ + if (value > 255) { if (value > MAX_LEGAL_CP && ( value != UV_MAX || prevvalue > MAX_LEGAL_CP)) { @@ -18281,7 +18282,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, PL_extended_cp_format, value); } - } + } /* Ready to process either the single value, or the completed range. * For single-valued non-inverted ranges, we consider the possibility @@ -18518,7 +18519,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, } #endif - range = 0; /* this range (if it was one) is done now */ + range = 0; /* this range (if it was one) is done now */ } /* End of loop through all the text within the brackets */ if ( posix_warnings && av_tindex_skip_len_mg(posix_warnings) >= 0) { @@ -18529,12 +18530,12 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * deal with them by building up a substitute parse string, and recursively * calling reg() on it, instead of proceeding */ if (multi_char_matches) { - SV * substitute_parse = newSVpvn_flags("?:", 2, SVs_TEMP); + SV * substitute_parse = newSVpvn_flags("?:", 2, SVs_TEMP); I32 cp_count; - STRLEN len; - char *save_end = RExC_end; - char *save_parse = RExC_parse; - char *save_start = RExC_start; + STRLEN len; + char *save_end = RExC_end; + char *save_parse = RExC_parse; + char *save_start = RExC_start; Size_t constructed_prefix_len = 0; /* This gives the length of the constructed portion of the substitute parse. */ @@ -18612,20 +18613,20 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * reported. See the comments at the definition of * REPORT_LOCATION_ARGS for details */ RExC_copy_start_in_input = (char *) orig_parse; - RExC_start = RExC_parse = SvPV(substitute_parse, len); + RExC_start = RExC_parse = SvPV(substitute_parse, len); RExC_copy_start_in_constructed = RExC_start + constructed_prefix_len; - RExC_end = RExC_parse + len; + RExC_end = RExC_parse + len; RExC_in_multi_char_class = 1; - ret = reg(pRExC_state, 1, ®_flags, depth+1); + ret = reg(pRExC_state, 1, ®_flags, depth+1); *flagp |= reg_flags & (HASWIDTH|SIMPLE|POSTPONED|RESTART_PARSE|NEED_UTF8); /* And restore so can parse the rest of the pattern */ RExC_parse = save_parse; - RExC_start = RExC_copy_start_in_constructed = RExC_copy_start_in_input = save_start; - RExC_end = save_end; - RExC_in_multi_char_class = 0; + RExC_start = RExC_copy_start_in_constructed = RExC_copy_start_in_input = save_start; + RExC_end = save_end; + RExC_in_multi_char_class = 0; SvREFCNT_dec_NN(multi_char_matches); return ret; } @@ -18771,7 +18772,7 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, /* Now that we have finished adding all the folds, there is no reason * to keep the foldable list separate */ _invlist_union(cp_list, cp_foldable_list, &cp_list); - SvREFCNT_dec_NN(cp_foldable_list); + SvREFCNT_dec_NN(cp_foldable_list); } /* And combine the result (if any) with any inversion lists from posix @@ -19007,8 +19008,8 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, { _invlist_invert(cp_list); - /* Clear the invert flag since have just done it here */ - invert = FALSE; + /* Clear the invert flag since have just done it here */ + invert = FALSE; } /* All possible optimizations below still have these characteristics. @@ -19954,15 +19955,15 @@ S_regclass(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth, * when the target string is UTF-8 (). * */ if (upper_latin1_only_utf8_matches) { - if (cp_list) { - _invlist_union(cp_list, + if (cp_list) { + _invlist_union(cp_list, upper_latin1_only_utf8_matches, &cp_list); - SvREFCNT_dec_NN(upper_latin1_only_utf8_matches); - } - else { - cp_list = upper_latin1_only_utf8_matches; - } + SvREFCNT_dec_NN(upper_latin1_only_utf8_matches); + } + else { + cp_list = upper_latin1_only_utf8_matches; + } ANYOF_FLAGS(REGNODE_p(ret)) |= ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP; } @@ -20017,11 +20018,11 @@ S_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state, if (! cp_list && ! runtime_defns && ! only_utf8_locale_list) { assert(! (ANYOF_FLAGS(node) & ANYOF_SHARED_d_UPPER_LATIN1_UTF8_STRING_MATCHES_non_d_RUNTIME_USER_PROP)); - ARG_SET(node, ANYOF_ONLY_HAS_BITMAP); + ARG_SET(node, ANYOF_ONLY_HAS_BITMAP); } else { - AV * const av = newAV(); - SV *rv; + AV * const av = newAV(); + SV *rv; if (cp_list) { av_store(av, INVLIST_INDEX, SvREFCNT_inc_NN(cp_list)); @@ -20040,10 +20041,10 @@ S_set_ANYOF_arg(pTHX_ RExC_state_t* const pRExC_state, SvREFCNT_inc_NN(runtime_defns)); } - rv = newRV_noinc(MUTABLE_SV(av)); - n = add_data(pRExC_state, STR_WITH_LEN("s")); - RExC_rxi->data->data[n] = (void*)rv; - ARG_SET(node, n); + rv = newRV_noinc(MUTABLE_SV(av)); + n = add_data(pRExC_state, STR_WITH_LEN("s")); + RExC_rxi->data->data[n] = (void*)rv; + ARG_SET(node, n); } } @@ -20097,12 +20098,12 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, assert(! output_invlist || listsvp); if (data && data->count) { - const U32 n = ARG(node); + const U32 n = ARG(node); - if (data->what[n] == 's') { - SV * const rv = MUTABLE_SV(data->data[n]); - AV * const av = MUTABLE_AV(SvRV(rv)); - SV **const ary = AvARRAY(av); + if (data->what[n] == 's') { + SV * const rv = MUTABLE_SV(data->data[n]); + AV * const av = MUTABLE_AV(SvRV(rv)); + SV **const ary = AvARRAY(av); invlist = ary[INVLIST_INDEX]; @@ -20114,7 +20115,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, si = ary[DEFERRED_USER_DEFINED_INDEX]; } - if (doinit && (si || invlist)) { + if (doinit && (si || invlist)) { if (si) { bool user_defined; SV * msg = newSVpvs_flags("", SVs_TEMP); @@ -20156,20 +20157,20 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, : INVLIST_INDEX); si = NULL; } - } - } + } + } } /* If requested, return a printable version of what this ANYOF node matches * */ if (listsvp) { - SV* matches_string = NULL; + SV* matches_string = NULL; /* This function can be called at compile-time, before everything gets * resolved, in which case we return the currently best available * information, which is the string that will eventually be used to do * that resolving, 'si' */ - if (si) { + if (si) { /* Here, we only have 'si' (and possibly some passed-in data in * 'invlist', which is handled below) If the caller only wants * 'si', use that. */ @@ -20268,7 +20269,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, SvCUR_set(matches_string, SvCUR(matches_string) - 1); } } /* end of has an 'si' */ - } + } /* Add the stuff that's already known */ if (invlist) { @@ -20291,7 +20292,7 @@ Perl_get_re_gclass_nonbitmap_data(pTHX_ const regexp *prog, const regnode* node, } } - *listsvp = matches_string; + *listsvp = matches_string; } return invlist; @@ -20347,21 +20348,21 @@ S_skip_to_be_ignored_text(pTHX_ RExC_state_t *pRExC_state, assert( ! UTF || UTF8_IS_INVARIANT(**p) || UTF8_IS_START(**p)); for (;;) { - if (RExC_end - (*p) >= 3 - && *(*p) == '(' - && *(*p + 1) == '?' - && *(*p + 2) == '#') - { - while (*(*p) != ')') { - if ((*p) == RExC_end) - FAIL("Sequence (?#... not terminated"); - (*p)++; - } - (*p)++; - continue; - } - - if (use_xmod) { + if (RExC_end - (*p) >= 3 + && *(*p) == '(' + && *(*p + 1) == '?' + && *(*p + 2) == '#') + { + while (*(*p) != ')') { + if ((*p) == RExC_end) + FAIL("Sequence (?#... not terminated"); + (*p)++; + } + (*p)++; + continue; + } + + if (use_xmod) { const char * save_p = *p; while ((*p) < RExC_end) { STRLEN len; @@ -20378,7 +20379,7 @@ S_skip_to_be_ignored_text(pTHX_ RExC_state_t *pRExC_state, if (*p != save_p) { continue; } - } + } break; } @@ -20432,7 +20433,7 @@ S_change_engine_size(pTHX_ RExC_state_t *pRExC_state, const Ptrdiff_t size) char, regexp_internal); if ( RExC_rxi == NULL ) - FAIL("Regexp out of space"); + FAIL("Regexp out of space"); RXi_SET(RExC_rx, RExC_rxi); RExC_emit_start = RExC_rxi->program; @@ -20473,16 +20474,16 @@ S_regnode_guts(pTHX_ RExC_state_t *pRExC_state, const U8 op, const STRLEN extra_ assert(extra_size >= regarglen[op] || PL_regkind[op] == ANYOF); if (RExC_offsets) { /* MJD */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s:%d: (op %s) %s %" UVuf " (len %" UVuf ") (max %" UVuf ").\n", name, __LINE__, PL_reg_name[op], (UV)(RExC_emit) > RExC_offsets[0] - ? "Overwriting end of array!\n" : "OK", + ? "Overwriting end of array!\n" : "OK", (UV)(RExC_emit), (UV)(RExC_parse - RExC_start), (UV)RExC_offsets[0])); - Set_Node_Offset(REGNODE_p(RExC_emit), RExC_parse + (op == END)); + Set_Node_Offset(REGNODE_p(RExC_emit), RExC_parse + (op == END)); } #endif return(ret); @@ -20627,21 +20628,21 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, const U8 op, RExC_end_op += size; while (src > REGNODE_p(operand)) { - StructCopy(--src, --dst, regnode); + StructCopy(--src, --dst, regnode); #ifdef RE_TRACK_PATTERN_OFFSETS if (RExC_offsets) { /* MJD 20010112 */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s(%d): (op %s) %s copy %" UVuf " -> %" UVuf " (max %" UVuf ").\n", "reginsert", - __LINE__, - PL_reg_name[op], + __LINE__, + PL_reg_name[op], (UV)(REGNODE_OFFSET(dst)) > RExC_offsets[0] - ? "Overwriting end of array!\n" : "OK", + ? "Overwriting end of array!\n" : "OK", (UV)REGNODE_OFFSET(src), (UV)REGNODE_OFFSET(dst), (UV)RExC_offsets[0])); - Set_Node_Offset_To_R(REGNODE_OFFSET(dst), Node_Offset(src)); - Set_Node_Length_To_R(REGNODE_OFFSET(dst), Node_Length(src)); + Set_Node_Offset_To_R(REGNODE_OFFSET(dst), Node_Offset(src)); + Set_Node_Length_To_R(REGNODE_OFFSET(dst), Node_Length(src)); } #endif } @@ -20649,18 +20650,18 @@ S_reginsert(pTHX_ RExC_state_t *pRExC_state, const U8 op, place = REGNODE_p(operand); /* Op node, where operand used to be. */ #ifdef RE_TRACK_PATTERN_OFFSETS if (RExC_offsets) { /* MJD */ - MJD_OFFSET_DEBUG( + MJD_OFFSET_DEBUG( ("%s(%d): (op %s) %s %" UVuf " <- %" UVuf " (max %" UVuf ").\n", "reginsert", - __LINE__, - PL_reg_name[op], + __LINE__, + PL_reg_name[op], (UV)REGNODE_OFFSET(place) > RExC_offsets[0] ? "Overwriting end of array!\n" : "OK", (UV)REGNODE_OFFSET(place), (UV)(RExC_parse - RExC_start), (UV)RExC_offsets[0])); - Set_Node_Offset(place, RExC_parse); - Set_Node_Length(place, 1); + Set_Node_Offset(place, RExC_parse); + Set_Node_Length(place, 1); } #endif src = NEXTOPER(place); @@ -20696,7 +20697,7 @@ S_regtail(pTHX_ RExC_state_t * pRExC_state, * */ scan = (regnode_offset) p; for (;;) { - regnode * const temp = regnext(REGNODE_p(scan)); + regnode * const temp = regnext(REGNODE_p(scan)); DEBUG_PARSE_r({ DEBUG_PARSE_MSG((scan==p ? "tail" : "")); regprop(RExC_rx, RExC_mysv, REGNODE_p(scan), NULL, pRExC_state); @@ -20773,11 +20774,11 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, regnode * const temp = regnext(REGNODE_p(scan)); #ifdef EXPERIMENTAL_INPLACESCAN if (PL_regkind[OP(REGNODE_p(scan))] == EXACT) { - bool unfolded_multi_char; /* Unexamined in this routine */ + bool unfolded_multi_char; /* Unexamined in this routine */ if (join_exact(pRExC_state, scan, &min, &unfolded_multi_char, 1, REGNODE_p(val), depth+1)) return TRUE; /* Was return EXACT */ - } + } #endif if ( exact ) { if (PL_regkind[OP(REGNODE_p(scan))] == EXACT) { @@ -20798,23 +20799,23 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, scan, PL_reg_name[exact]); }); - if (temp == NULL) - break; - scan = REGNODE_OFFSET(temp); + if (temp == NULL) + break; + scan = REGNODE_OFFSET(temp); } DEBUG_PARSE_r({ DEBUG_PARSE_MSG(""); regprop(RExC_rx, RExC_mysv, REGNODE_p(val), NULL, pRExC_state); Perl_re_printf( aTHX_ "~ attach to %s (%" IVdf ") offset to %" IVdf "\n", - SvPV_nolen_const(RExC_mysv), - (IV)val, - (IV)(val - scan) + SvPV_nolen_const(RExC_mysv), + (IV)val, + (IV)(val - scan) ); }); if (reg_off_by_arg[OP(REGNODE_p(scan))]) { assert((UV) (val - scan) <= U32_MAX); - ARG_SET(REGNODE_p(scan), val - scan); + ARG_SET(REGNODE_p(scan), val - scan); } else { if (val - scan > U16_MAX) { @@ -20824,7 +20825,7 @@ S_regtail_study(pTHX_ RExC_state_t *pRExC_state, regnode_offset p, NEXT_OFF(REGNODE_p(scan)) = U16_MAX; return FALSE; } - NEXT_OFF(REGNODE_p(scan)) = val - scan; + NEXT_OFF(REGNODE_p(scan)) = val - scan; } return TRUE; /* Was 'return exact' */ @@ -20903,9 +20904,9 @@ S_regdump_extflags(pTHX_ const char *lead, const U32 flags) for (bit=0; bitcheck_substr || r->check_utf8) Perl_re_printf( aTHX_ - (const char *) - ( r->check_substr == r->substrs->data[1].substr - && r->check_utf8 == r->substrs->data[1].utf8_substr - ? "(checking floating" : "(checking anchored")); + (const char *) + ( r->check_substr == r->substrs->data[1].substr + && r->check_utf8 == r->substrs->data[1].utf8_substr + ? "(checking floating" : "(checking anchored")); if (r->intflags & PREGf_NOSCAN) Perl_re_printf( aTHX_ " noscan"); if (r->extflags & RXf_CHECK_ALL) @@ -21112,29 +21113,29 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ k = PL_regkind[OP(o)]; if (k == EXACT) { - sv_catpvs(sv, " "); - /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) - * is a crude hack but it may be the best for now since - * we have no flag "this EXACTish node was UTF-8" - * --jhi */ - pv_pretty(sv, STRING(o), STR_LEN(o), PL_dump_re_max_len, + sv_catpvs(sv, " "); + /* Using is_utf8_string() (via PERL_PV_UNI_DETECT) + * is a crude hack but it may be the best for now since + * we have no flag "this EXACTish node was UTF-8" + * --jhi */ + pv_pretty(sv, STRING(o), STR_LEN(o), PL_dump_re_max_len, PL_colors[0], PL_colors[1], - PERL_PV_ESCAPE_UNI_DETECT | - PERL_PV_ESCAPE_NONASCII | - PERL_PV_PRETTY_ELLIPSES | - PERL_PV_PRETTY_LTGT | - PERL_PV_PRETTY_NOCLEAR - ); + PERL_PV_ESCAPE_UNI_DETECT | + PERL_PV_ESCAPE_NONASCII | + PERL_PV_PRETTY_ELLIPSES | + PERL_PV_PRETTY_LTGT | + PERL_PV_PRETTY_NOCLEAR + ); } else if (k == TRIE) { - /* print the details of the trie in dumpuntil instead, as - * progi->data isn't available here */ + /* print the details of the trie in dumpuntil instead, as + * progi->data isn't available here */ const char op = OP(o); const U32 n = ARG(o); const reg_ac_data * const ac = IS_TRIE_AC(op) ? (reg_ac_data *)progi->data->data[n] : NULL; const reg_trie_data * const trie - = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; + = (reg_trie_data*)progi->data->data[!IS_TRIE_AC(op) ? n : ac->trie]; Perl_sv_catpvf(aTHX_ sv, "-%s", PL_reg_name[o->flags]); DEBUG_TRIE_COMPILE_r({ @@ -21167,8 +21168,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } } else if (k == CURLY) { U32 lo = ARG1(o), hi = ARG2(o); - if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX) - Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */ + if (OP(o) == CURLYM || OP(o) == CURLYN || OP(o) == CURLYX) + Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); /* Parenth number */ Perl_sv_catpvf(aTHX_ sv, "{%u,", (unsigned) lo); if (hi == REG_INFTY) sv_catpvs(sv, "INFTY"); @@ -21177,14 +21178,14 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ sv_catpvs(sv, "}"); } else if (k == WHILEM && o->flags) /* Ordinal/of */ - Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4); + Perl_sv_catpvf(aTHX_ sv, "[%d/%d]", o->flags & 0xf, o->flags>>4); else if (k == REF || k == OPEN || k == CLOSE || k == GROUPP || OP(o)==ACCEPT) { AV *name_list= NULL; U32 parno= OP(o) == ACCEPT ? (U32)ARG2L(o) : ARG(o); Perl_sv_catpvf(aTHX_ sv, "%" UVuf, (UV)parno); /* Parenth number */ - if ( RXp_PAREN_NAMES(prog) ) { + if ( RXp_PAREN_NAMES(prog) ) { name_list= MUTABLE_AV(progi->data->data[progi->name_list_idx]); } else if ( pRExC_state ) { name_list= RExC_paren_name_list; @@ -21192,8 +21193,8 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ if (name_list) { if ( k != REF || (OP(o) < REFN)) { SV **name= av_fetch(name_list, parno, 0 ); - if (name) - Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name)); + if (name) + Perl_sv_catpvf(aTHX_ sv, " '%" SVf "'", SVfARG(*name)); } else { SV *sv_dat= MUTABLE_SV(progi->data->data[ parno ]); @@ -21242,7 +21243,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } else if (k == LOGICAL) /* 2: embedded, otherwise 1 */ - Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); + Perl_sv_catpvf(aTHX_ sv, "[%d]", o->flags); else if (k == ANYOF || k == ANYOFR) { U8 flags; char * bitmap; @@ -21274,7 +21275,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ arg = ARG(o); } - if (OP(o) == ANYOFL || OP(o) == ANYOFPOSIXL) { + if (OP(o) == ANYOFL || OP(o) == ANYOFPOSIXL) { if (ANYOFL_UTF8_LOCALE_REQD(flags)) { sv_catpvs(sv, "{utf8-locale-reqd}"); } @@ -21328,7 +21329,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } /* Ready to start outputting. First, the initial left bracket */ - Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); + Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); /* ANYOFH by definition doesn't have anything that will fit inside the * bitmap; ANYOFR may or may not. */ @@ -21433,7 +21434,7 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ } /* And finally the matching, closing ']' */ - Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); + Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); if (OP(o) == ANYOFHs) { Perl_sv_catpvf(aTHX_ sv, " (Leading UTF-8 bytes=%s", _byte_dump_string((U8 *) ((struct regnode_anyofhs *) o)->string, FLAGS(o), 1)); @@ -21464,13 +21465,13 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ else if (k == ANYOFM) { SV * cp_list = get_ANYOFM_contents(o); - Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); + Perl_sv_catpvf(aTHX_ sv, "[%s", PL_colors[0]); if (OP(o) == NANYOFM) { _invlist_invert(cp_list); } put_charclass_bitmap_innards(sv, NULL, cp_list, NULL, NULL, 0, TRUE); - Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); + Perl_sv_catpvf(aTHX_ sv, "%s]", PL_colors[1]); SvREFCNT_dec(cp_list); } @@ -21502,11 +21503,11 @@ Perl_regprop(pTHX_ const regexp *prog, SV *sv, const regnode *o, const regmatch_ sv_catpv(sv, bounds[FLAGS(o)]); } else if (k == BRANCHJ && (OP(o) == UNLESSM || OP(o) == IFMATCH)) { - Perl_sv_catpvf(aTHX_ sv, "[%d", -(o->flags)); + Perl_sv_catpvf(aTHX_ sv, "[%d", -(o->flags)); if (o->next_off) { Perl_sv_catpvf(aTHX_ sv, "..-%d", o->flags - o->next_off); } - Perl_sv_catpvf(aTHX_ sv, "]"); + Perl_sv_catpvf(aTHX_ sv, "]"); } else if (OP(o) == SBOL) Perl_sv_catpvf(aTHX_ sv, " /%s/", o->flags ? "\\A" : "^"); @@ -21546,22 +21547,22 @@ Perl_re_intuit_string(pTHX_ REGEXP * const r) PERL_UNUSED_CONTEXT; DEBUG_COMPILE_r( - { + { if (prog->maxlen > 0) { const char * const s = SvPV_nolen_const(RX_UTF8(r) - ? prog->check_utf8 : prog->check_substr); + ? prog->check_utf8 : prog->check_substr); if (!PL_colorset) reginitcolors(); Perl_re_printf( aTHX_ - "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", - PL_colors[4], - RX_UTF8(r) ? "utf8 " : "", - PL_colors[5], PL_colors[0], - s, - PL_colors[1], - (strlen(s) > PL_dump_re_max_len ? "..." : "")); + "%sUsing REx %ssubstr:%s \"%s%.60s%s%s\"\n", + PL_colors[4], + RX_UTF8(r) ? "utf8 " : "", + PL_colors[5], PL_colors[0], + s, + PL_colors[1], + (strlen(s) > PL_dump_re_max_len ? "..." : "")); } - } ); + } ); /* use UTF8 check substring if regexp pattern itself is in UTF8 */ return RX_UTF8(r) ? prog->check_utf8 : prog->check_substr; @@ -21609,7 +21610,7 @@ Perl_pregfree2(pTHX_ REGEXP *rx) SvREFCNT_dec(r->substrs->data[i].substr); SvREFCNT_dec(r->substrs->data[i].utf8_substr); } - Safefree(r->substrs); + Safefree(r->substrs); } RX_MATCH_COPY_FREE(rx); #ifdef PERL_ANY_COW @@ -21656,7 +21657,7 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) PERL_ARGS_ASSERT_REG_TEMP_COPY; if (!dsv) - dsv = (REGEXP*) newSV_type(SVt_REGEXP); + dsv = (REGEXP*) newSV_type(SVt_REGEXP); else { assert(SvTYPE(dsv) == SVt_REGEXP || (SvTYPE(dsv) == SVt_PVLV)); @@ -21673,22 +21674,22 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) } SvLEN_set(dsv, 0); SvCUR_set(dsv, 0); - SvOK_off((SV *)dsv); + SvOK_off((SV *)dsv); - if (islv) { - /* For PVLVs, the head (sv_any) points to an XPVLV, while + if (islv) { + /* For PVLVs, the head (sv_any) points to an XPVLV, while * the LV's xpvlenu_rx will point to a regexp body, which * we allocate here */ - REGEXP *temp = (REGEXP *)newSV_type(SVt_REGEXP); - assert(!SvPVX(dsv)); + REGEXP *temp = (REGEXP *)newSV_type(SVt_REGEXP); + assert(!SvPVX(dsv)); ((XPV*)SvANY(dsv))->xpv_len_u.xpvlenu_rx = temp->sv_any; - temp->sv_any = NULL; - SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; - SvREFCNT_dec_NN(temp); - /* SvCUR still resides in the xpvlv struct, so the regexp copy- - ing below will not set it. */ - SvCUR_set(dsv, SvCUR(ssv)); - } + temp->sv_any = NULL; + SvFLAGS(temp) = (SvFLAGS(temp) & ~SVTYPEMASK) | SVt_NULL; + SvREFCNT_dec_NN(temp); + /* SvCUR still resides in the xpvlv struct, so the regexp copy- + ing below will not set it. */ + SvCUR_set(dsv, SvCUR(ssv)); + } } /* This ensures that SvTHINKFIRST(sv) is true, and hence that sv_force_normal(sv) is called. */ @@ -21702,7 +21703,7 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) The string pointer is copied here, being part of the regexp struct. */ memcpy(&(drx->xpv_cur), &(srx->xpv_cur), - sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur)); + sizeof(regexp) - STRUCT_OFFSET(regexp, xpv_cur)); if (!islv) SvLEN_set(dsv, 0); if (srx->offs) { @@ -21713,15 +21714,15 @@ Perl_reg_temp_copy(pTHX_ REGEXP *dsv, REGEXP *ssv) if (srx->substrs) { int i; Newx(drx->substrs, 1, struct reg_substr_data); - StructCopy(srx->substrs, drx->substrs, struct reg_substr_data); + StructCopy(srx->substrs, drx->substrs, struct reg_substr_data); for (i = 0; i < 2; i++) { SvREFCNT_inc_void(drx->substrs->data[i].substr); SvREFCNT_inc_void(drx->substrs->data[i].utf8_substr); } - /* check_substr and check_utf8, if non-NULL, point to either their - anchored or float namesakes, and don't hold a second reference. */ + /* check_substr and check_utf8, if non-NULL, point to either their + anchored or float namesakes, and don't hold a second reference. */ } RX_MATCH_COPIED_off(dsv); #ifdef PERL_ANY_COW @@ -21763,10 +21764,10 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) } DEBUG_COMPILE_r({ - if (!PL_colorset) - reginitcolors(); - { - SV *dsv= sv_newmortal(); + if (!PL_colorset) + reginitcolors(); + { + SV *dsv= sv_newmortal(); RE_PV_QUOTED_DECL(s, RX_UTF8(rx), dsv, RX_PRECOMP(rx), RX_PRELEN(rx), PL_dump_re_max_len); Perl_re_printf( aTHX_ "%sFreeing REx:%s %s\n", @@ -21782,24 +21783,24 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) S_free_codeblocks(aTHX_ ri->code_blocks); if (ri->data) { - int n = ri->data->count; + int n = ri->data->count; - while (--n >= 0) { + while (--n >= 0) { /* If you add a ->what type here, update the comment in regcomp.h */ - switch (ri->data->what[n]) { - case 'a': - case 'r': - case 's': - case 'S': - case 'u': - SvREFCNT_dec(MUTABLE_SV(ri->data->data[n])); - break; - case 'f': - Safefree(ri->data->data[n]); - break; - case 'l': - case 'L': - break; + switch (ri->data->what[n]) { + case 'a': + case 'r': + case 's': + case 'S': + case 'u': + SvREFCNT_dec(MUTABLE_SV(ri->data->data[n])); + break; + case 'f': + Safefree(ri->data->data[n]); + break; + case 'l': + case 'L': + break; case 'T': { /* Aho Corasick add-on structure for a trie node. Used in stclass optimization only */ @@ -21811,7 +21812,7 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) if ( !refcount ) { PerlMemShared_free(aho->states); PerlMemShared_free(aho->fail); - /* do this last!!!! */ + /* do this last!!!! */ PerlMemShared_free(ri->data->data[n]); /* we should only ever get called once, so * assert as much, and also guard the free @@ -21826,11 +21827,11 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) } } break; - case 't': - { - /* trie structure. */ - U32 refcount; - reg_trie_data *trie=(reg_trie_data*)ri->data->data[n]; + case 't': + { + /* trie structure. */ + U32 refcount; + reg_trie_data *trie=(reg_trie_data*)ri->data->data[n]; OP_REFCNT_LOCK; refcount = --trie->refcount; OP_REFCNT_UNLOCK; @@ -21842,19 +21843,19 @@ Perl_regfree_internal(pTHX_ REGEXP * const rx) PerlMemShared_free(trie->bitmap); if (trie->jump) PerlMemShared_free(trie->jump); - PerlMemShared_free(trie->wordinfo); + PerlMemShared_free(trie->wordinfo); /* do this last!!!! */ PerlMemShared_free(ri->data->data[n]); - } - } - break; - default: - Perl_croak(aTHX_ "panic: regfree data code '%c'", + } + } + break; + default: + Perl_croak(aTHX_ "panic: regfree data code '%c'", ri->data->what[n]); - } - } - Safefree(ri->data->what); - Safefree(ri->data); + } + } + Safefree(ri->data->what); + Safefree(ri->data); } Safefree(ri); @@ -21896,15 +21897,15 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) Copy(r->offs, ret->offs, npar, regexp_paren_pair); if (ret->substrs) { - /* Do it this way to avoid reading from *r after the StructCopy(). - That way, if any of the sv_dup_inc()s dislodge *r from the L1 - cache, it doesn't matter. */ + /* Do it this way to avoid reading from *r after the StructCopy(). + That way, if any of the sv_dup_inc()s dislodge *r from the L1 + cache, it doesn't matter. */ int i; - const bool anchored = r->check_substr - ? r->check_substr == r->substrs->data[0].substr - : r->check_utf8 == r->substrs->data[0].utf8_substr; + const bool anchored = r->check_substr + ? r->check_substr == r->substrs->data[0].substr + : r->check_utf8 == r->substrs->data[0].utf8_substr; Newx(ret->substrs, 1, struct reg_substr_data); - StructCopy(r->substrs, ret->substrs, struct reg_substr_data); + StructCopy(r->substrs, ret->substrs, struct reg_substr_data); for (i = 0; i < 2; i++) { ret->substrs->data[i].substr = @@ -21913,29 +21914,29 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) sv_dup_inc(ret->substrs->data[i].utf8_substr, param); } - /* check_substr and check_utf8, if non-NULL, point to either their - anchored or float namesakes, and don't hold a second reference. */ + /* check_substr and check_utf8, if non-NULL, point to either their + anchored or float namesakes, and don't hold a second reference. */ - if (ret->check_substr) { - if (anchored) { - assert(r->check_utf8 == r->substrs->data[0].utf8_substr); + if (ret->check_substr) { + if (anchored) { + assert(r->check_utf8 == r->substrs->data[0].utf8_substr); - ret->check_substr = ret->substrs->data[0].substr; - ret->check_utf8 = ret->substrs->data[0].utf8_substr; - } else { - assert(r->check_substr == r->substrs->data[1].substr); - assert(r->check_utf8 == r->substrs->data[1].utf8_substr); + ret->check_substr = ret->substrs->data[0].substr; + ret->check_utf8 = ret->substrs->data[0].utf8_substr; + } else { + assert(r->check_substr == r->substrs->data[1].substr); + assert(r->check_utf8 == r->substrs->data[1].utf8_substr); - ret->check_substr = ret->substrs->data[1].substr; - ret->check_utf8 = ret->substrs->data[1].utf8_substr; - } - } else if (ret->check_utf8) { - if (anchored) { - ret->check_utf8 = ret->substrs->data[0].utf8_substr; - } else { - ret->check_utf8 = ret->substrs->data[1].utf8_substr; - } - } + ret->check_substr = ret->substrs->data[1].substr; + ret->check_utf8 = ret->substrs->data[1].utf8_substr; + } + } else if (ret->check_utf8) { + if (anchored) { + ret->check_utf8 = ret->substrs->data[0].utf8_substr; + } else { + ret->check_utf8 = ret->substrs->data[1].utf8_substr; + } + } } RXp_PAREN_NAMES(ret) = hv_dup_inc(RXp_PAREN_NAMES(ret), param); @@ -21944,12 +21945,12 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) Newx(ret->recurse_locinput, r->nparens + 1, char *); if (ret->pprivate) - RXi_SET(ret, CALLREGDUPE_PVT(dstr, param)); + RXi_SET(ret, CALLREGDUPE_PVT(dstr, param)); if (RX_MATCH_COPIED(dstr)) - ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); + ret->subbeg = SAVEPVN(ret->subbeg, ret->sublen); else - ret->subbeg = NULL; + ret->subbeg = NULL; #ifdef PERL_ANY_COW ret->saved_copy = NULL; #endif @@ -21957,9 +21958,9 @@ Perl_re_dup_guts(pTHX_ const REGEXP *sstr, REGEXP *dstr, CLONE_PARAMS *param) /* Whether mother_re be set or no, we need to copy the string. We cannot refrain from copying it when the storage points directly to our mother regexp, because that's - 1: a buffer in a different thread - 2: something we no longer hold a reference on - so we need to copy it locally. */ + 1: a buffer in a different thread + 2: something we no longer hold a reference on + so we need to copy it locally. */ RX_WRAPPED(dstr) = SAVEPVN(RX_WRAPPED_const(sstr), SvCUR(sstr)+1); /* set malloced length to a non-zero value so it will be freed * (otherwise in combination with SVf_FAKE it looks like an alien @@ -22002,37 +22003,37 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) if (ri->code_blocks) { - int n; - Newx(reti->code_blocks, 1, struct reg_code_blocks); - Newx(reti->code_blocks->cb, ri->code_blocks->count, + int n; + Newx(reti->code_blocks, 1, struct reg_code_blocks); + Newx(reti->code_blocks->cb, ri->code_blocks->count, struct reg_code_block); - Copy(ri->code_blocks->cb, reti->code_blocks->cb, + Copy(ri->code_blocks->cb, reti->code_blocks->cb, ri->code_blocks->count, struct reg_code_block); - for (n = 0; n < ri->code_blocks->count; n++) - reti->code_blocks->cb[n].src_regex = (REGEXP*) - sv_dup_inc((SV*)(ri->code_blocks->cb[n].src_regex), param); + for (n = 0; n < ri->code_blocks->count; n++) + reti->code_blocks->cb[n].src_regex = (REGEXP*) + sv_dup_inc((SV*)(ri->code_blocks->cb[n].src_regex), param); reti->code_blocks->count = ri->code_blocks->count; reti->code_blocks->refcnt = 1; } else - reti->code_blocks = NULL; + reti->code_blocks = NULL; reti->regstclass = NULL; if (ri->data) { - struct reg_data *d; + struct reg_data *d; const int count = ri->data->count; - int i; + int i; - Newxc(d, sizeof(struct reg_data) + count*sizeof(void *), - char, struct reg_data); - Newx(d->what, count, U8); + Newxc(d, sizeof(struct reg_data) + count*sizeof(void *), + char, struct reg_data); + Newx(d->what, count, U8); - d->count = count; - for (i = 0; i < count; i++) { - d->what[i] = ri->data->what[i]; - switch (d->what[i]) { - /* see also regcomp.h and regfree_internal() */ + d->count = count; + for (i = 0; i < count; i++) { + d->what[i] = ri->data->what[i]; + switch (d->what[i]) { + /* see also regcomp.h and regfree_internal() */ case 'a': /* actually an AV, but the dup function is identical. values seem to be "plain sv's" generally. */ case 'r': /* a compiled regex (but still just another SV) */ @@ -22042,9 +22043,9 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) case 'S': /* actually an SV, but the dup function is identical. */ case 'u': /* actually an HV, but the dup function is identical. values are "plain sv's" */ - d->data[i] = sv_dup_inc((const SV *)ri->data->data[i], param); - break; - case 'f': + d->data[i] = sv_dup_inc((const SV *)ri->data->data[i], param); + break; + case 'f': /* Synthetic Start Class - "Fake" charclass we generate to optimize * patterns which could start with several different things. Pre-TRIE * this was more important than it is now, however this still helps @@ -22052,40 +22053,40 @@ Perl_regdupe_internal(pTHX_ REGEXP * const rx, CLONE_PARAMS *param) * to [xa]. This is used by Perl_re_intuit_start() and S_find_byclass() * in regexec.c */ - /* This is cheating. */ - Newx(d->data[i], 1, regnode_ssc); - StructCopy(ri->data->data[i], d->data[i], regnode_ssc); - reti->regstclass = (regnode*)d->data[i]; - break; - case 'T': + /* This is cheating. */ + Newx(d->data[i], 1, regnode_ssc); + StructCopy(ri->data->data[i], d->data[i], regnode_ssc); + reti->regstclass = (regnode*)d->data[i]; + break; + case 'T': /* AHO-CORASICK fail table */ /* Trie stclasses are readonly and can thus be shared - * without duplication. We free the stclass in pregfree - * when the corresponding reg_ac_data struct is freed. - */ - reti->regstclass= ri->regstclass; - /* FALLTHROUGH */ - case 't': + * without duplication. We free the stclass in pregfree + * when the corresponding reg_ac_data struct is freed. + */ + reti->regstclass= ri->regstclass; + /* FALLTHROUGH */ + case 't': /* TRIE transition table */ - OP_REFCNT_LOCK; - ((reg_trie_data*)ri->data->data[i])->refcount++; - OP_REFCNT_UNLOCK; - /* FALLTHROUGH */ + OP_REFCNT_LOCK; + ((reg_trie_data*)ri->data->data[i])->refcount++; + OP_REFCNT_UNLOCK; + /* FALLTHROUGH */ case 'l': /* (?{...}) or (??{ ... }) code (cb->block) */ case 'L': /* same when RExC_pm_flags & PMf_HAS_CV and code is not from another regexp */ - d->data[i] = ri->data->data[i]; - break; + d->data[i] = ri->data->data[i]; + break; default: Perl_croak(aTHX_ "panic: re_dup_guts unknown data code '%c'", ri->data->what[i]); - } - } + } + } - reti->data = d; + reti->data = d; } else - reti->data = NULL; + reti->data = NULL; reti->name_list_idx = ri->name_list_idx; @@ -22114,16 +22115,16 @@ Perl_regnext(pTHX_ regnode *p) I32 offset; if (!p) - return(NULL); + return(NULL); if (OP(p) > REGNODE_MAX) { /* regnode.type is unsigned */ - Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", + Perl_croak(aTHX_ "Corrupted regexp opcode %d > %d", (int)OP(p), (int)REGNODE_MAX); } offset = (reg_off_by_arg[OP(p)] ? ARG(p) : NEXT_OFF(p)); if (offset == 0) - return(NULL); + return(NULL); return(p+offset); } @@ -22142,7 +22143,7 @@ S_re_croak(pTHX_ bool utf8, const char* pat,...) PERL_ARGS_ASSERT_RE_CROAK; if (len > 510) - len = 510; + len = 510; Copy(pat, buf, len , char); buf[len] = '\n'; buf[len + 1] = '\0'; @@ -22151,7 +22152,7 @@ S_re_croak(pTHX_ bool utf8, const char* pat,...) va_end(args); message = SvPV_const(msv, len); if (len > 512) - len = 512; + len = 512; Copy(message, buf, len , char); /* len-1 to avoid \n */ Perl_croak(aTHX_ "%" UTF8f, UTF8fARG(utf8, len-1, buf)); @@ -22169,8 +22170,8 @@ Perl_save_re_context(pTHX) /* Save $1..$n (#18107: UTF-8 s/(\w+)/uc($1)/e); AMS 20021106. */ if (PL_curpm) { - const REGEXP * const rx = PM_GETRE(PL_curpm); - if (rx) + const REGEXP * const rx = PM_GETRE(PL_curpm); + if (rx) nparens = RX_NPARENS(rx); } @@ -22209,13 +22210,13 @@ S_put_code_point(pTHX_ SV *sv, UV c) Perl_sv_catpvf(aTHX_ sv, "\\x{%04" UVXf "}", c); } else if (isPRINT(c)) { - const char string = (char) c; + const char string = (char) c; /* We use {phrase} as metanotation in the class, so also escape literal * braces */ - if (isBACKSLASHED_PUNCT(c) || c == '{' || c == '}') - sv_catpvs(sv, "\\"); - sv_catpvn(sv, &string, 1); + if (isBACKSLASHED_PUNCT(c) || c == '{' || c == '}') + sv_catpvs(sv, "\\"); + sv_catpvn(sv, &string, 1); } else if (isMNEMONIC_CNTRL(c)) { Perl_sv_catpvf(aTHX_ sv, "%s", cntrl_to_mnemonic((U8) c)); @@ -22782,10 +22783,10 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv, || ( SvCUR(inverted_display) + inverted_bias < SvCUR(as_is_display) + as_is_bias))) { - sv_catsv(sv, inverted_display); + sv_catsv(sv, inverted_display); } else if (as_is_display) { - sv_catsv(sv, as_is_display); + sv_catsv(sv, as_is_display); } SvREFCNT_dec(as_is_display); @@ -22814,8 +22815,8 @@ S_put_charclass_bitmap_innards(pTHX_ SV *sv, STATIC const regnode * S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, - const regnode *last, const regnode *plast, - SV* sv, I32 indent, U32 depth) + const regnode *last, const regnode *plast, + SV* sv, I32 indent, U32 depth) { U8 op = PSEUDO; /* Arbitrary non-END op. */ const regnode *next; @@ -22836,25 +22837,25 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, while (PL_regkind[op] != END && (!last || node < last)) { assert(node); - /* While that wasn't END last time... */ - NODE_ALIGN(node); - op = OP(node); - if (op == CLOSE || op == SRCLOSE || op == WHILEM) - indent--; - next = regnext((regnode *)node); - - /* Where, what. */ - if (OP(node) == OPTIMIZED) { - if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) - optstart = node; - else - goto after_print; - } else - CLEAR_OPTSTART; + /* While that wasn't END last time... */ + NODE_ALIGN(node); + op = OP(node); + if (op == CLOSE || op == SRCLOSE || op == WHILEM) + indent--; + next = regnext((regnode *)node); + + /* Where, what. */ + if (OP(node) == OPTIMIZED) { + if (!optstart && RE_DEBUG_FLAG(RE_DEBUG_COMPILE_OPTIMISE)) + optstart = node; + else + goto after_print; + } else + CLEAR_OPTSTART; regprop(r, sv, node, NULL, NULL); Perl_re_printf( aTHX_ "%4" IVdf ":%*s%s", (IV)(node - start), - (int)(2*indent + 1), "", SvPVX_const(sv)); + (int)(2*indent + 1), "", SvPVX_const(sv)); if (OP(node) != OPTIMIZED) { if (next == NULL) /* Next ptr. */ @@ -22868,39 +22869,39 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, } after_print: - if (PL_regkind[(U8)op] == BRANCHJ) { - assert(next); - { + if (PL_regkind[(U8)op] == BRANCHJ) { + assert(next); + { const regnode *nnode = (OP(next) == LONGJMP ? regnext((regnode *)next) : next); if (last && nnode > last) nnode = last; DUMPUNTIL(NEXTOPER(NEXTOPER(node)), nnode); - } - } - else if (PL_regkind[(U8)op] == BRANCH) { - assert(next); - DUMPUNTIL(NEXTOPER(node), next); - } - else if ( PL_regkind[(U8)op] == TRIE ) { - const regnode *this_trie = node; - const char op = OP(node); + } + } + else if (PL_regkind[(U8)op] == BRANCH) { + assert(next); + DUMPUNTIL(NEXTOPER(node), next); + } + else if ( PL_regkind[(U8)op] == TRIE ) { + const regnode *this_trie = node; + const char op = OP(node); const U32 n = ARG(node); - const reg_ac_data * const ac = op>=AHOCORASICK ? + const reg_ac_data * const ac = op>=AHOCORASICK ? (reg_ac_data *)ri->data->data[n] : NULL; - const reg_trie_data * const trie = - (reg_trie_data*)ri->data->data[optrie]; + const reg_trie_data * const trie = + (reg_trie_data*)ri->data->data[optrie]; #ifdef DEBUGGING - AV *const trie_words + AV *const trie_words = MUTABLE_AV(ri->data->data[n + TRIE_WORDS_OFFSET]); #endif - const regnode *nextbranch= NULL; - I32 word_idx; + const regnode *nextbranch= NULL; + I32 word_idx; SvPVCLEAR(sv); - for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { - SV ** const elem_ptr = av_fetch(trie_words, word_idx, 0); + for (word_idx= 0; word_idx < (I32)trie->wordcount; word_idx++) { + SV ** const elem_ptr = av_fetch(trie_words, word_idx, 0); Perl_re_indentf( aTHX_ "%s ", indent+3, @@ -22923,41 +22924,41 @@ S_dumpuntil(pTHX_ const regexp *r, const regnode *start, const regnode *node, if (dist) { if (!nextbranch) nextbranch= this_trie + trie->jump[0]; - DUMPUNTIL(this_trie + dist, nextbranch); + DUMPUNTIL(this_trie + dist, nextbranch); } if (nextbranch && PL_regkind[OP(nextbranch)]==BRANCH) nextbranch= regnext((regnode *)nextbranch); } else { Perl_re_printf( aTHX_ "\n"); - } - } - if (last && next > last) - node= last; - else - node= next; - } - else if ( op == CURLY ) { /* "next" might be very big: optimizer */ - DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, + } + } + if (last && next > last) + node= last; + else + node= next; + } + else if ( op == CURLY ) { /* "next" might be very big: optimizer */ + DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, NEXTOPER(node) + EXTRA_STEP_2ARGS + 1); - } - else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { - assert(next); - DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, next); - } - else if ( op == PLUS || op == STAR) { - DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1); - } - else if (PL_regkind[(U8)op] == EXACT || op == ANYOFHs) { + } + else if (PL_regkind[(U8)op] == CURLY && op != CURLYX) { + assert(next); + DUMPUNTIL(NEXTOPER(node) + EXTRA_STEP_2ARGS, next); + } + else if ( op == PLUS || op == STAR) { + DUMPUNTIL(NEXTOPER(node), NEXTOPER(node) + 1); + } + else if (PL_regkind[(U8)op] == EXACT || op == ANYOFHs) { /* Literal string, where present. */ - node += NODE_SZ_STR(node) - 1; - node = NEXTOPER(node); - } - else { - node = NEXTOPER(node); - node += regarglen[(U8)op]; - } - if (op == CURLYX || op == OPEN || op == SROPEN) - indent++; + node += NODE_SZ_STR(node) - 1; + node = NEXTOPER(node); + } + else { + node = NEXTOPER(node); + node += regarglen[(U8)op]; + } + if (op == CURLYX || op == OPEN || op == SROPEN) + indent++; } CLEAR_OPTSTART; #ifdef DEBUG_DUMPUNTIL @@ -23218,7 +23219,7 @@ S_compile_wildcard(pTHX_ const char * subpattern, const STRLEN len, STATIC I32 S_execute_wildcard(pTHX_ REGEXP * const prog, char* stringarg, char *strend, - char *strbeg, SSize_t minend, SV *screamer, U32 nosave) + char *strbeg, SSize_t minend, SV *screamer, U32 nosave) { I32 result; DECLARE_AND_GET_RE_DEBUG_FLAGS; @@ -24912,7 +24913,7 @@ S_parse_uniprop_string(pTHX_ COPHH * hinthash = (IN_PERL_COMPILETIME) ? CopHINTHASH_get(&PL_compiling) : CopHINTHASH_get(PL_curcop); - SV * pu_overrides = cophh_fetch_pv(hinthash, "private_use", 0, 0); + SV * pu_overrides = cophh_fetch_pv(hinthash, "private_use", 0, 0); if (UNLIKELY(pu_overrides && SvPOK(pu_overrides))) { From e513125ac7bdea1f40ab055ab8c72da44de8f869 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 15 Nov 2020 20:57:59 -0700 Subject: [PATCH 448/503] Revamp regcurly(), regpiece() use of it This commit copies portions of new_regcurly(), which has been around since 5.28, into plain regcurly(), as a baby step in preparation for converting entirely to the new one. These functions are used for parsing {m,n} quantifiers. Future commits will add capabilities not available using the old version. The commit adds an optional parameter, to return to the caller information it gleans during parsing. regpiece() is changed by this commit to use this information, instead of itself reparsing the input. Part of the reason for this commit is that changes are planned soon to what is legal syntax. With this commit in place, those changes only have to be done once. This commit also extracts into a function the calculation of the quantifier bounds. This allows the logic for that to be done in one place instead of two. --- embed.fnc | 4 +- embed.h | 1 + proto.h | 7 +- regcomp.c | 225 ++++++++++++++++++++++++++++++++++++++---------------- toke.c | 4 +- 5 files changed, 170 insertions(+), 71 deletions(-) diff --git a/embed.fnc b/embed.fnc index e633097f9b8d..5ff0a9bebe19 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2082,6 +2082,8 @@ ES |void |dump_regex_sets_structures \ # endif ES |void|parse_lparen_question_flags|NN RExC_state_t *pRExC_state ES |regnode_offset|reg_node|NN RExC_state_t *pRExC_state|U8 op +ES |U32 |get_quantifier_value|NN RExC_state_t *pRExC_state \ + |NN const char * start|NN const char * end ES |regnode_offset|regpiece|NN RExC_state_t *pRExC_state \ |NN I32 *flagp|U32 depth ES |bool |grok_bslash_N |NN RExC_state_t *pRExC_state \ @@ -2343,7 +2345,7 @@ EXTp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const unsigned int EpX |SV* |invlist_clone |NN SV* const invlist|NULLOK SV* newlist #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -EXpRT |bool |regcurly |NN const char *s +EXpRT |bool |regcurly |NN const char *s|NN const char *e|NULLOK const char * result[5] #endif #if defined(PERL_IN_REGEXEC_C) ERS |bool |isFOO_utf8_lc |const U8 classnum|NN const U8* character|NN const U8* e diff --git a/embed.h b/embed.h index d3a60006d8a6..159a5e915509 100644 --- a/embed.h +++ b/embed.h @@ -1047,6 +1047,7 @@ #define find_first_differing_byte_pos S_find_first_differing_byte_pos #define get_ANYOFM_contents(a) S_get_ANYOFM_contents(aTHX_ a) #define get_ANYOF_cp_list_for_ssc(a,b) S_get_ANYOF_cp_list_for_ssc(aTHX_ a,b) +#define get_quantifier_value(a,b,c) S_get_quantifier_value(aTHX_ a,b,c) #define grok_bslash_N(a,b,c,d,e,f,g) S_grok_bslash_N(aTHX_ a,b,c,d,e,f,g) #define handle_named_backref(a,b,c,d) S_handle_named_backref(aTHX_ a,b,c,d) #define handle_names_wildcard(a,b,c,d) S_handle_names_wildcard(aTHX_ a,b,c,d) diff --git a/proto.h b/proto.h index 333dde15e62b..aa156b4cad88 100644 --- a/proto.h +++ b/proto.h @@ -5761,6 +5761,9 @@ STATIC SV * S_get_ANYOFM_contents(pTHX_ const regnode * n) STATIC SV* S_get_ANYOF_cp_list_for_ssc(pTHX_ const RExC_state_t *pRExC_state, const regnode_charclass* const node); #define PERL_ARGS_ASSERT_GET_ANYOF_CP_LIST_FOR_SSC \ assert(pRExC_state); assert(node) +STATIC U32 S_get_quantifier_value(pTHX_ RExC_state_t *pRExC_state, const char * start, const char * end); +#define PERL_ARGS_ASSERT_GET_QUANTIFIER_VALUE \ + assert(pRExC_state); assert(start); assert(end) STATIC bool S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, regnode_offset* nodep, UV *code_point_p, int* cp_count, I32 *flagp, const bool strict, const U32 depth); #define PERL_ARGS_ASSERT_GROK_BSLASH_N \ assert(pRExC_state); assert(flagp) @@ -6149,10 +6152,10 @@ PERL_CALLCONV SV* Perl_invlist_clone(pTHX_ SV* const invlist, SV* newlist); assert(invlist) #endif #if defined(PERL_IN_REGCOMP_C) || defined(PERL_IN_TOKE_C) -PERL_CALLCONV bool Perl_regcurly(const char *s) +PERL_CALLCONV bool Perl_regcurly(const char *s, const char *e, const char * result[5]) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_REGCURLY \ - assert(s) + assert(s); assert(e) #endif #if defined(PERL_IN_REGEXEC_C) diff --git a/regcomp.c b/regcomp.c index 7e8425f392b7..8e5305cf7943 100644 --- a/regcomp.c +++ b/regcomp.c @@ -362,7 +362,7 @@ struct RExC_state_t { #define isNON_BRACE_QUANTIFIER(c) ((c) == '*' || (c) == '+' || (c) == '?') #define isQUANTIFIER(s,e) ( isNON_BRACE_QUANTIFIER(*s) \ - || ((*s) == '{' && regcurly(s))) + || ((*s) == '{' && regcurly(s, e, NULL))) /* * Flags to be passed up and down. @@ -12541,31 +12541,150 @@ S_regbranch(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, I32 first, U32 depth) return ret; } -/* - - regcurly - a little FSA that accepts {\d+,?\d*} - Pulled from reg.c. - */ -#ifndef PERL_IN_XSUB_RE bool -Perl_regcurly(const char *s) +Perl_regcurly(const char *s, const char *e, const char * result[5]) { + /* This function matches a {m,n} quantifier. When called with a NULL final + * argument, it simply parses the input from 's' up through 'e-1', and + * returns a boolean as to whether or not this input is syntactically a + * {m,n} quantifier. + * + * When called with a non-NULL final parameter, and when the function + * returns TRUE, it additionally stores information into the array + * specified by that parameter about what it found in the parse. The + * parameter must be a pointer into a 5 element array of 'const char *' + * elements. The returned information is as follows: + * result[RBRACE] points to the closing brace + * result[MIN_S] points to the first byte of the lower bound + * result[MIN_E] points to one beyond the final byte of the lower bound + * result[MAX_S] points to the first byte of the upper bound + * result[MAX_E] points to one beyond the final byte of the upper bound + * + * If the quantifier is of the form {m,} (meaning an infinite upper + * bound), result[MAX_E] is set to result[MAX_S]; what they actually point + * to is irrelevant, just that it's the same place + * + * If instead the quantifier is of the form {m} there is actually only + * one bound, and both the upper and lower result[] elements are set to + * point to it. + * + * This function checks only for syntactic validity; it leaves checking for + * semantic validity and raising any diagnostics to the caller. This + * function is called in multiple places to check for syntax, but only from + * one for semantics. It makes it as simple as possible for the + * syntax-only callers, while furnishing just enough information for the + * semantic caller. + */ + + const char * min_start = NULL; + const char * max_start = NULL; + const char * min_end = NULL; + const char * max_end = NULL; + + bool has_comma = FALSE; + PERL_ARGS_ASSERT_REGCURLY; - if (*s++ != '{') - return FALSE; - if (!isDIGIT(*s)) + if (s >= e || *s++ != '{') return FALSE; - while (isDIGIT(*s)) - s++; + + if isDIGIT(*s) { + min_start = s; + do { + s++; + } while (s < e && isDIGIT(*s)); + min_end = s; + } + if (*s == ',') { + has_comma = TRUE; s++; - while (isDIGIT(*s)) - s++; + if isDIGIT(*s) { + max_start = s; + do { + s++; + } while (s < e && isDIGIT(*s)); + max_end = s; + } + } + + if (s >= e || *s != '}' || ! min_start) { + return FALSE; + } + + if (result) { + +#define RBRACE 0 +#define MIN_S 1 +#define MIN_E 2 +#define MAX_S 3 +#define MAX_E 4 + + result[RBRACE] = s; + + result[MIN_S] = min_start; + result[MIN_E] = min_end; + if (has_comma) { + if (max_start) { + result[MAX_S] = max_start; + result[MAX_E] = max_end; + } + else { + /* Having no value after the comma is signalled by setting + * start and end to the same value. What that value is isn't + * relevant; NULL is chosen simply because it will fail if the + * caller mistakenly uses it */ + result[MAX_S] = result[MAX_E] = NULL; + } + } + else { /* No comma means lower and upper bounds are the same */ + result[MAX_S] = min_start; + result[MAX_E] = min_end; + } } - return *s == '}'; + return TRUE; } -#endif + +U32 +S_get_quantifier_value(pTHX_ RExC_state_t *pRExC_state, + const char * start, const char * end) +{ + /* This is a helper function for regpiece() to compute, given the + * quantifier {m,n}, the value of either m or n, based on the starting + * position 'start' in the string, through the byte 'end-1', returning it + * if valid, and failing appropriately if not. It knows the restrictions + * imposed on quantifier values */ + + UV uv; + STATIC_ASSERT_DECL(REG_INFTY <= U32_MAX); + + PERL_ARGS_ASSERT_GET_QUANTIFIER_VALUE; + + if (grok_atoUV(start, &uv, &end)) { + if (uv < REG_INFTY) { /* A valid, small-enough number */ + return (U32) uv; + } + } + else if (*start == '0') { /* grok_atoUV() fails for only two reasons: + leading zeros or overflow */ + RExC_parse++; + + /* Perhaps too generic a msg for what is only failure from having + * leading zeros, but this is how it's always behaved. */ + vFAIL("Invalid quantifier in {,}"); + NOT_REACHED; /*NOTREACHED*/ + } + + /* Here, found a quantifier, but was too large; either it overflowed or was + * too big a legal number */ + RExC_parse++; + vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1); + + NOT_REACHED; /*NOTREACHED*/ + return U32_MAX; /* Perhaps some compilers will be expecting a return */ +} + /* - regpiece - something followed by possible quantifier * + ? {n,m} * @@ -12588,7 +12707,6 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) { regnode_offset ret; char op; - char *next; I32 flags; const char * const origparse = RExC_parse; I32 min; @@ -12596,8 +12714,6 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) #ifdef RE_TRACK_PATTERN_OFFSETS char *parse_start; #endif - const char *maxpos = NULL; - UV uv; /* Save the original in case we change the emitted regop to a FAIL. */ const regnode_offset orig_emit = RExC_emit; @@ -12620,6 +12736,7 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) op = *RExC_parse; switch (op) { + const char * regcurly_return[5]; case '*': nextchar(pRExC_state); @@ -12638,54 +12755,31 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) case '{': /* A '{' may or may not indicate a quantifier; call regcurly() to determine which */ - if (regcurly(RExC_parse)) { - const char* endptr; - - /* Here is a quantifier, parse for min and max values */ - maxpos = NULL; - next = RExC_parse + 1; - while (isDIGIT(*next) || *next == ',') { - if (*next == ',') { - if (maxpos) - break; - else - maxpos = next; - } - next++; - } + if (regcurly(RExC_parse, RExC_end, regcurly_return)) { + const char * min_start = regcurly_return[MIN_S]; + const char * min_end = regcurly_return[MIN_E]; + const char * max_start = regcurly_return[MAX_S]; + const char * max_end = regcurly_return[MAX_E]; - assert(*next == '}'); + assert(min_start); + assert(min_end > min_start); + min = get_quantifier_value(pRExC_state, min_start, min_end); - if (!maxpos) - maxpos = next; - RExC_parse++; - if (isDIGIT(*RExC_parse)) { - endptr = RExC_end; - if (!grok_atoUV(RExC_parse, &uv, &endptr)) - vFAIL("Invalid quantifier in {,}"); - if (uv >= REG_INFTY) - vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1); - min = (I32)uv; - } else { - min = 0; + if (max_start == max_end) { /* Was of the form {m,} */ + max = REG_INFTY; } - if (*maxpos == ',') - maxpos++; - else - maxpos = RExC_parse; - if (isDIGIT(*maxpos)) { - endptr = RExC_end; - if (!grok_atoUV(maxpos, &uv, &endptr)) - vFAIL("Invalid quantifier in {,}"); - if (uv >= REG_INFTY) - vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1); - max = (I32)uv; - } else { - max = REG_INFTY; /* meaning "infinity" */ + else if (max_start == min_start) { /* Was of the form {m} */ + max = min; } + else { /* Was of the form {m,n} */ + assert(max_end >= max_start); - RExC_parse = next; + max = get_quantifier_value(pRExC_state, max_start, max_end); + } + + RExC_parse = (char *) regcurly_return[RBRACE]; nextchar(pRExC_state); + if (max < min) { /* If can't match, warn and optimize to fail unconditionally */ reginsert(pRExC_state, OPFAIL, orig_emit, depth+1); @@ -12694,15 +12788,14 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) regarglen[OPFAIL] + NODE_STEP_REGNODE; return ret; } - else if (min == max && *RExC_parse == '?') - { + else if (min == max && *RExC_parse == '?') { ckWARN2reg(RExC_parse + 1, "Useless use of greediness modifier '%c'", *RExC_parse); } break; - } /* End of is regcurly() */ + } /* End of is {m,n} */ /* Here was a '{', but what followed it didn't form a quantifier. */ /* FALLTHROUGH */ @@ -12987,7 +13080,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, /* Disambiguate between \N meaning a named character versus \N meaning * [^\n]. The latter is assumed when the {...} following the \N is a legal * quantifier, or if there is no '{' at all */ - if (*p != '{' || regcurly(p)) { + if (*p != '{' || regcurly(p, RExC_end, NULL)) { RExC_parse = p; if (cp_count) { *cp_count = -1; @@ -15376,7 +15469,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) skip_to_be_ignored_text(pRExC_state, &RExC_parse, FALSE /* Don't force to /x */ ); if ( *RExC_parse == '{' - && OP(REGNODE_p(ret)) != SBOL && ! regcurly(RExC_parse)) + && OP(REGNODE_p(ret)) != SBOL && ! regcurly(RExC_parse, RExC_end, NULL)) { if (RExC_strict || new_regcurly(RExC_parse, RExC_end)) { RExC_parse++; diff --git a/toke.c b/toke.c index cf0a06a44a02..fba2382a3347 100644 --- a/toke.c +++ b/toke.c @@ -3627,7 +3627,7 @@ S_scan_const(pTHX_ char *start) else if (PL_lex_inpat && (*s != 'N' || s[1] != '{' - || regcurly(s + 1))) + || regcurly(s + 1, send, NULL))) { *d++ = '\\'; goto default_action; @@ -4353,7 +4353,7 @@ S_intuit_more(pTHX_ char *s, char *e) /* In a pattern, so maybe we have {n,m}. */ if (*s == '{') { - if (regcurly(s)) { + if (regcurly(s, e, NULL)) { return FALSE; } return TRUE; From a25b770c008a6e530595a4b555443e2b65289a65 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 7 Jan 2021 07:41:47 -0700 Subject: [PATCH 449/503] Point to error in malformed /x{y,z}/ Prior to this comment a curly quantifier that had an error in the bounds pointed to the left brace. Now the error message points to the first bound that has a problem. --- regcomp.c | 4 ++-- t/re/reg_mesg.t | 10 ++++++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/regcomp.c b/regcomp.c index 8e5305cf7943..72c0de9667f5 100644 --- a/regcomp.c +++ b/regcomp.c @@ -12668,7 +12668,7 @@ S_get_quantifier_value(pTHX_ RExC_state_t *pRExC_state, } else if (*start == '0') { /* grok_atoUV() fails for only two reasons: leading zeros or overflow */ - RExC_parse++; + RExC_parse = (char * ) end; /* Perhaps too generic a msg for what is only failure from having * leading zeros, but this is how it's always behaved. */ @@ -12678,7 +12678,7 @@ S_get_quantifier_value(pTHX_ RExC_state_t *pRExC_state, /* Here, found a quantifier, but was too large; either it overflowed or was * too big a legal number */ - RExC_parse++; + RExC_parse = (char * ) end; vFAIL2("Quantifier in {,} bigger than %d", REG_INFTY - 1); NOT_REACHED; /*NOTREACHED*/ diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 145a91a6243b..66c98dcd4077 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -174,7 +174,10 @@ my @death = '/((x)/' => 'Unmatched ( {#} m/({#}(x)/', '/{(}/' => 'Unmatched ( {#} m/{({#}}/', # [perl #127599] - "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 {#} m/x{{#}$inf_p1}/", + "/x{$inf_p1}/" => "Quantifier in {,} bigger than $inf_m1 {#} m/x{$inf_p1\{#}}/", + "/x{$inf_p1,}/" => "Quantifier in {,} bigger than $inf_m1 {#} m/x{$inf_p1\{#},}/", + "/x{01,2}/" => "Invalid quantifier in {,} {#} m/x{01{#},2}/", + "/x{1,02}/" => "Invalid quantifier in {,} {#} m/x{1,02{#}}/", '/x**/' => 'Nested quantifiers {#} m/x**{#}/', @@ -456,7 +459,10 @@ my @death_utf8 = mark_as_utf8( '/ネ((ネ)/' => 'Unmatched ( {#} m/ネ({#}(ネ)/', - "/ネ{$inf_p1}ネ/" => "Quantifier in {,} bigger than $inf_m1 {#} m/ネ{{#}$inf_p1}ネ/", + "/ネ{$inf_p1}ネ/" => "Quantifier in {,} bigger than $inf_m1 {#} m/ネ{$inf_p1\{#}}ネ/", + "/ネ{$inf_p1,}ネ/" => "Quantifier in {,} bigger than $inf_m1 {#} m/ネ{$inf_p1\{#},}ネ/", + "/ネ{01}ネ/" => "Invalid quantifier in {,} {#} m/ネ{01{#}}ネ/", + "/ネ{1,02}ネ/" => "Invalid quantifier in {,} {#} m/ネ{1,02{#}}ネ/", '/ネ**ネ/' => 'Nested quantifiers {#} m/ネ**{#}ネ/', From 20420ba9e016c0a7de5df27b5ab1fefd7902a766 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 7 Jan 2021 19:05:06 -0700 Subject: [PATCH 450/503] Allow empty lower bound in /{,n}/ This change has been planned for a long time, bringing Perl into parity with similar languages, but it took many deprecation cycles to be able to reach the point where it could safely go in. This fixes GH #18264 --- embed.fnc | 1 - embed.h | 1 - pod/perldelta.pod | 7 ++++- pod/perlre.pod | 11 +++++--- pod/perlrequick.pod | 4 +++ pod/perlreref.pod | 3 +- pod/perlretut.pod | 23 ++++++++++++---- proto.h | 5 ---- regcomp.c | 67 ++++++++------------------------------------- t/re/re_tests | 4 +++ t/re/reg_mesg.t | 10 +++++-- 11 files changed, 58 insertions(+), 78 deletions(-) diff --git a/embed.fnc b/embed.fnc index 5ff0a9bebe19..a90b32d708dd 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1991,7 +1991,6 @@ EiRT |bool |invlist_is_iterating|NN SV* const invlist EiR |SV* |invlist_contents|NN SV* const invlist \ |const bool traditional_style EixRT |UV |invlist_lowest|NN SV* const invlist -ESRT |bool |new_regcurly |NN const char *s|NN const char *e ERS |SV* |make_exactf_invlist |NN RExC_state_t *pRExC_state \ |NN regnode *node ES |regnode_offset|reg |NN RExC_state_t *pRExC_state \ diff --git a/embed.h b/embed.h index 159a5e915509..3be6c42420b4 100644 --- a/embed.h +++ b/embed.h @@ -1061,7 +1061,6 @@ #define join_exact(a,b,c,d,e,f,g) S_join_exact(aTHX_ a,b,c,d,e,f,g) #define make_exactf_invlist(a,b) S_make_exactf_invlist(aTHX_ a,b) #define make_trie(a,b,c,d,e,f,g,h) S_make_trie(aTHX_ a,b,c,d,e,f,g,h) -#define new_regcurly S_new_regcurly #define nextchar(a) S_nextchar(aTHX_ a) #define output_posix_warnings(a,b) S_output_posix_warnings(aTHX_ a,b) #define parse_lparen_question_flags(a) S_parse_lparen_question_flags(aTHX_ a) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 54089b8e0b6e..d7072d17c524 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -12,7 +12,12 @@ This document describes differences between the 5.33.5 release and the If you are upgrading from an earlier release such as 5.33.4, first read L, which describes differences between 5.33.4 and 5.33.5. -=head1 Modules and Pragmata +=head1 Core Enhancements + +=head2 C is now accepted. + +An empty lower bound is now accepted for regular expression quantifiers, +like C<{,3}> =head2 Updated Modules and Pragmata diff --git a/pod/perlre.pod b/pod/perlre.pod index 308b79253205..83a3b08dfa03 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -865,6 +865,7 @@ X X X<*> X<+> X X<{n}> X<{n,}> X<{n,m}> ? Match 1 or 0 times {n} Match exactly n times {n,} Match at least n times + {,n} Match at most n times {n,m} Match at least n but not more than m times (If a non-escaped curly bracket occurs in a context other than one of @@ -891,13 +892,14 @@ allowing the rest of the pattern to match. If you want it to match the minimum number of times possible, follow the quantifier with a C<"?">. Note that the meanings don't change, just the "greediness": X X X -X X<*?> X<+?> X X<{n}?> X<{n,}?> X<{n,m}?> +X X<*?> X<+?> X X<{n}?> X<{n,}?> X<{,n}?> X<{n,m}?> *? Match 0 or more times, not greedily +? Match 1 or more times, not greedily ?? Match 0 or 1 time, not greedily {n}? Match exactly n times, not greedily (redundant) {n,}? Match at least n times, not greedily + {,n}? Match at most n times, not greedily {n,m}? Match at least n but not more than m times, not greedily Normally when a quantified subpattern does not allow the rest of the @@ -910,6 +912,7 @@ as well. ?+ Match 0 or 1 time and give nothing back {n}+ Match exactly n times and give nothing back (redundant) {n,}+ Match at least n times and give nothing back + {,n}+ Match at most n times and give nothing back {n,m}+ Match at least n but not more than m times and give nothing back For instance, @@ -2334,9 +2337,9 @@ see L. A fundamental feature of regular expression matching involves the notion called I, which is currently used (when needed) -by all regular non-possessive expression quantifiers, namely C<"*">, C<*?>, C<"+">, -C<+?>, C<{n,m}>, and C<{n,m}?>. Backtracking is often optimized -internally, but the general principle outlined here is valid. +by all regular non-possessive expression quantifiers, namely C<"*">, +C<*?>, C<"+">, C<+?>, C<{n,m}>, and C<{n,m}?>. Backtracking is often +optimized internally, but the general principle outlined here is valid. For a regular expression to match, the I regular expression must match, not just part of it. So if the beginning of a pattern containing a diff --git a/pod/perlrequick.pod b/pod/perlrequick.pod index 5c5030c24cea..6a70e9cd0d8b 100644 --- a/pod/perlrequick.pod +++ b/pod/perlrequick.pod @@ -363,6 +363,10 @@ C = match at least C or more times =item * +C = match C times or fewer + +=item * + C = match exactly C times =back diff --git a/pod/perlreref.pod b/pod/perlreref.pod index e54093ccf112..4074e01b8a83 100644 --- a/pod/perlreref.pod +++ b/pod/perlreref.pod @@ -217,6 +217,7 @@ Quantifiers are greedy by default and match the B leftmost. {n,m} {n,m}? {n,m}+ Must occur at least n times but no more than m times {n,} {n,}? {n,}+ Must occur at least n times + {,n} {,n}? {,n}+ Must occur at most n times {n} {n}? {n}+ Must occur exactly n times * *? *+ 0 or more times (same as {0,}) + +? ++ 1 or more times (same as {1,}) @@ -226,8 +227,6 @@ The possessive forms (new in Perl 5.10) prevent backtracking: what gets matched by a pattern with a possessive quantifier will not be backtracked into, even if that causes the whole match to fail. -There is no quantifier C<{,n}>. That's currently illegal. - =head2 EXTENDED CONSTRUCTS (?#text) A comment diff --git a/pod/perlretut.pod b/pod/perlretut.pod index cb4654f552b6..70b16f1ddbd9 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -1048,6 +1048,10 @@ C means: match at least C or more times =item * +C means: match at most C times, or fewer + +=item * + C means: match exactly C times =back @@ -1223,6 +1227,11 @@ possible =item * +C means: match at most C times, but as few times as +possible + +=item * + C means: match exactly C times. Because we match exactly C times, C is equivalent to C and is just there for notational consistency. @@ -1390,8 +1399,12 @@ for C =item * C means: match at least C times, but as many times as possible, -and don't give anything up. C is short for C and C is -short for C. +and don't give anything up. C is short for C. + +=item * + +C means: match as many times as possible up to at most C +times, and don't give anything up. C is short for C. =item * @@ -2243,9 +2256,9 @@ Starting with this section, we will be discussing Perl's set of I. These are extensions to the traditional regular expression syntax that provide powerful new tools for pattern matching. We have already seen extensions in the form of the minimal -matching constructs C, C<*?>, C<+?>, C<{n,m}?>, and C<{n,}?>. Most -of the extensions below have the form C<(?char...)>, where the -C is a character that determines the type of extension. +matching constructs C, C<*?>, C<+?>, C<{n,m}?>, C<{n,}?>, and +C<{,n}?>. Most of the extensions below have the form C<(?char...)>, +where the C is a character that determines the type of extension. The first extension is an embedded comment C<(?#text)>. This embeds a comment into the regular expression without affecting its meaning. The diff --git a/proto.h b/proto.h index aa156b4cad88..7b935c2a9ad9 100644 --- a/proto.h +++ b/proto.h @@ -5817,11 +5817,6 @@ STATIC SV* S_make_exactf_invlist(pTHX_ RExC_state_t *pRExC_state, regnode *node) STATIC I32 S_make_trie(pTHX_ RExC_state_t *pRExC_state, regnode *startbranch, regnode *first, regnode *last, regnode *tail, U32 word_count, U32 flags, U32 depth); #define PERL_ARGS_ASSERT_MAKE_TRIE \ assert(pRExC_state); assert(startbranch); assert(first); assert(last); assert(tail) -STATIC bool S_new_regcurly(const char *s, const char *e) - __attribute__warn_unused_result__; -#define PERL_ARGS_ASSERT_NEW_REGCURLY \ - assert(s); assert(e) - STATIC void S_nextchar(pTHX_ RExC_state_t *pRExC_state); #define PERL_ARGS_ASSERT_NEXTCHAR \ assert(pRExC_state) diff --git a/regcomp.c b/regcomp.c index 72c0de9667f5..64cb5e9628e4 100644 --- a/regcomp.c +++ b/regcomp.c @@ -12607,8 +12607,8 @@ Perl_regcurly(const char *s, const char *e, const char * result[5]) max_end = s; } } - - if (s >= e || *s != '}' || ! min_start) { + /* Need at least one number */ + if (s >= e || *s != '}' || (! min_start && ! max_end)) { return FALSE; } @@ -12761,9 +12761,12 @@ S_regpiece(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) const char * max_start = regcurly_return[MAX_S]; const char * max_end = regcurly_return[MAX_E]; - assert(min_start); - assert(min_end > min_start); - min = get_quantifier_value(pRExC_state, min_start, min_end); + if (min_start) { + min = get_quantifier_value(pRExC_state, min_start, min_end); + } + else { + min = 0; + } if (max_start == max_end) { /* Was of the form {m,} */ max = REG_INFTY; @@ -13428,53 +13431,6 @@ S_compute_EXACTish(RExC_state_t *pRExC_state) return op + EXACTF; } -STATIC bool -S_new_regcurly(const char *s, const char *e) -{ - /* This is a temporary function designed to match the most lenient form of - * a {m,n} quantifier we ever envision, with either number omitted, and - * spaces anywhere between/before/after them. - * - * If this function fails, then the string it matches is very unlikely to - * ever be considered a valid quantifier, so we can allow the '{' that - * begins it to be considered as a literal */ - - bool has_min = FALSE; - bool has_max = FALSE; - - PERL_ARGS_ASSERT_NEW_REGCURLY; - - if (s >= e || *s++ != '{') - return FALSE; - - while (s < e && isSPACE(*s)) { - s++; - } - while (s < e && isDIGIT(*s)) { - has_min = TRUE; - s++; - } - while (s < e && isSPACE(*s)) { - s++; - } - - if (*s == ',') { - s++; - while (s < e && isSPACE(*s)) { - s++; - } - while (s < e && isDIGIT(*s)) { - has_max = TRUE; - s++; - } - while (s < e && isSPACE(*s)) { - s++; - } - } - - return s < e && *s == '}' && (has_min || has_max); -} - /* Parse backref decimal value, unless it's too big to sensibly be a backref, * in which case return I32_MAX (rather than possibly 32-bit wrapping) */ @@ -13910,7 +13866,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) * correspondingly 'P' can be */ if ( RExC_parse - parse_start == 1 && UCHARAT(RExC_parse + 1) == '{' - && UNLIKELY(! new_regcurly(RExC_parse + 1, RExC_end))) + && UNLIKELY(! regcurly(RExC_parse + 1, RExC_end, NULL))) { RExC_parse += 2; vFAIL("Unescaped left brace in regex is illegal here"); @@ -14535,8 +14491,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) if ( RExC_strict || ( p > parse_start + 1 && isALPHA_A(*(p - 1)) - && *(p - 2) == '\\') - || new_regcurly(p, RExC_end)) + && *(p - 2) == '\\')) { RExC_parse = p + 1; vFAIL("Unescaped left brace in regex is " @@ -15471,7 +15426,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) if ( *RExC_parse == '{' && OP(REGNODE_p(ret)) != SBOL && ! regcurly(RExC_parse, RExC_end, NULL)) { - if (RExC_strict || new_regcurly(RExC_parse, RExC_end)) { + if (RExC_strict) { RExC_parse++; vFAIL("Unescaped left brace in regex is illegal here"); } diff --git a/t/re/re_tests b/t/re/re_tests index ff8bd7b43a18..8b1412e1cca7 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -2026,6 +2026,10 @@ AB\s+\x{100} AB \x{100}X y - - ^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + b + y $1 a + b # [GH #18096] ^((\w|<(\s)*(?1)(?3)*>)(?:(?3)*\+(?3)*(?2))*)(?3)*\+ a + + c y $1 a + # [GH #18096] /0?\xdf\xdf\xdf\xdfs\o{500}|/i \o{600} y $& # [GH #18451] +/^a{,2}$/ y # 0 or more +/^a{,2}$/ a y $& a +/^a{,2}$/ aa y $& aa +/^a{,2}$/ aaa n - - # Keep these lines at the end of the file # pat string y/n/etc expr expected-expr skip-reason comment # vim: softtabstop=0 noexpandtab diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index 66c98dcd4077..f5633c3ba0ed 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -310,9 +310,6 @@ my @death = '/\w{/' => 'Unescaped left brace in regex is illegal here {#} m/\w{{#}/', '/\q{/' => 'Unescaped left brace in regex is illegal here {#} m/\q{{#}/', '/\A{/' => 'Unescaped left brace in regex is illegal here {#} m/\A{{#}/', - '/.{, 4 }/' => 'Unescaped left brace in regex is illegal here {#} m/.{{#}, 4 }/', - '/[x]{, 4}/' => 'Unescaped left brace in regex is illegal here {#} m/[x]{{#}, 4}/', - '/\p{Latin}{,4 }/' => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#},4 }/', '/(?<=/' => 'Sequence (?... not terminated {#} m/(?<={#}/', # [perl #128170] '/\p{vertical tab}/' => 'Can\'t find Unicode property definition "vertical tab" {#} m/\\p{vertical tab}{#}/', # [perl #132055] "/$bug133423/" => "Unexpected ']' with no following ')' in (?[... {#} m/(?[(?^:(?[\\]))\\]{#}|2[^^]\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80])R.\\670/", @@ -431,6 +428,13 @@ my @death_only_under_strict = ( => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#}/', '/\x{100}\x/' => "", => "Empty \\x {#} m/\\x{100}\\x{#}/", + + '/.{, 4 }/' => 'Unescaped left brace in regex is passed through {#} m/.{{#}, 4 }/', + => 'Unescaped left brace in regex is illegal here {#} m/.{{#}, 4 }/', + '/[x]{, 4}/' => 'Unescaped left brace in regex is passed through {#} m/[x]{{#}, 4}/', + => 'Unescaped left brace in regex is illegal here {#} m/[x]{{#}, 4}/', + '/\p{Latin}{,4 }/' => 'Unescaped left brace in regex is passed through {#} m/\p{Latin}{{#},4 }/', + => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#},4 }/', ); # These need the character 'ネ' as a marker for mark_as_utf8() From b94d36b981ff593e5ccd66531069f12e0482b4f6 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 19:51:18 -0700 Subject: [PATCH 451/503] toke.c: Slight simplification Rather than know how far we have advanced in parsing when we have to back up, save the checkpoint position and simply backtrack to it. This results in slightly more maintainable code that a future commit will take advantage of. --- toke.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/toke.c b/toke.c index fba2382a3347..ed4fc68f1604 100644 --- a/toke.c +++ b/toke.c @@ -3587,6 +3587,7 @@ S_scan_const(pTHX_ char *start) /* backslashes */ if (*s == '\\' && s+1 < send) { + char* bslash = s; /* point to beginning \ */ char* e; /* Can be used for ending '}', etc. */ s++; @@ -3601,13 +3602,14 @@ S_scan_const(pTHX_ char *start) { /* diag_listed_as: \%d better written as $%d */ Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "\\%c better written as $%c", *s, *s); - *--s = '$'; + s = bslash; + *s = '$'; break; } /* string-change backslash escapes */ if (PL_lex_inwhat != OP_TRANS && *s && memCHRs("lLuUEQF", *s)) { - --s; + s = bslash; break; } /* In a pattern, process \N, but skip any other backslash escapes. @@ -3835,8 +3837,6 @@ S_scan_const(pTHX_ char *start) /* In patterns, we can have \N{U+xxxx.yyyy.zzzz...} */ /* Check the syntax. */ - const char *orig_s; - orig_s = s - 5; if (!isXDIGIT(*s)) { bad_NU: yyerror( @@ -3857,8 +3857,8 @@ S_scan_const(pTHX_ char *start) /* Pass everything through unchanged. * +1 is for the '}' */ - Copy(orig_s, d, e - orig_s + 1, char); - d += e - orig_s + 1; + Copy(bslash, d, e - bslash + 1, char); + d += e - bslash + 1; } else { /* Not a pattern: convert the hex to string */ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES From c4e03e733b121b8cc35108564bddbb4a97d224d9 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 20:03:08 -0700 Subject: [PATCH 452/503] toke.c: Change variable name A future commit will need it to represent just the meaning of the new name --- toke.c | 34 +++++++++++++++++----------------- 1 file changed, 17 insertions(+), 17 deletions(-) diff --git a/toke.c b/toke.c index ed4fc68f1604..a70d605b2525 100644 --- a/toke.c +++ b/toke.c @@ -3588,7 +3588,7 @@ S_scan_const(pTHX_ char *start) /* backslashes */ if (*s == '\\' && s+1 < send) { char* bslash = s; /* point to beginning \ */ - char* e; /* Can be used for ending '}', etc. */ + char* rbrace; /* point to ending '}' */ s++; @@ -3820,7 +3820,7 @@ S_scan_const(pTHX_ char *start) s++; /* If there is no matching '}', it is an error. */ - if (! (e = (char *) memchr(s, '}', send - s))) { + if (! (rbrace = (char *) memchr(s, '}', send - s))) { if (! PL_lex_inpat) { yyerror("Missing right brace on \\N{}"); } else { @@ -3842,11 +3842,11 @@ S_scan_const(pTHX_ char *start) yyerror( "Invalid hexadecimal number in \\N{U+...}" ); - s = e + 1; + s = rbrace + 1; *d++ = '\0'; continue; } - while (++s < e) { + while (++s < rbrace) { if (isXDIGIT(*s)) continue; else if ((*s == '.' || *s == '_') @@ -3857,18 +3857,18 @@ S_scan_const(pTHX_ char *start) /* Pass everything through unchanged. * +1 is for the '}' */ - Copy(bslash, d, e - bslash + 1, char); - d += e - bslash + 1; + Copy(bslash, d, rbrace - bslash + 1, char); + d += rbrace - bslash + 1; } else { /* Not a pattern: convert the hex to string */ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES | PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_SILENT_OVERFLOW | PERL_SCAN_DISALLOW_PREFIX; - STRLEN len = e - s; + STRLEN len = rbrace - s; uv = grok_hex(s, &len, &flags, NULL); - if (len == 0 || (len != (STRLEN)(e - s))) + if (len == 0 || (len != (STRLEN)(rbrace - s))) goto bad_NU; if ( uv > MAX_LEGAL_CP @@ -3890,7 +3890,7 @@ S_scan_const(pTHX_ char *start) || PL_lex_inwhat != OP_TRANS)) { /* See Note on sizing above. */ - const STRLEN extra = OFFUNISKIP(uv) + (send - e) + 1; + const STRLEN extra = OFFUNISKIP(uv) + (send - rbrace) + 1; SvCUR_set(sv, d - SvPVX_const(sv)); SvPOK_on(sv); @@ -3925,7 +3925,7 @@ S_scan_const(pTHX_ char *start) } } else /* Here is \N{NAME} but not \N{U+...}. */ - if (! (res = get_and_check_backslash_N_name_wrapper(s, e))) + if (! (res = get_and_check_backslash_N_name_wrapper(s, rbrace))) { /* Failed. We should die eventually, but for now use a NUL to keep parsing */ *d++ = '\0'; @@ -3965,7 +3965,7 @@ S_scan_const(pTHX_ char *start) /* +1 for trailing NUL */ + initial_len + 1 - + (STRLEN)(send - e)); + + (STRLEN)(send - rbrace)); Copy(initial_text, d, initial_len, char); d += initial_len; while (str < str_end) { @@ -4014,7 +4014,7 @@ S_scan_const(pTHX_ char *start) /* Make sure there is enough space to hold it */ d = off + SvGROW(sv, off + output_length - + (STRLEN)(send - e) + + (STRLEN)(send - rbrace) + 2); /* '}' + NUL */ /* And output it */ Copy(hex_string, d, output_length, char); @@ -4036,7 +4036,7 @@ S_scan_const(pTHX_ char *start) d = off + SvGROW(sv, off + output_length - + (STRLEN)(send - e) + + (STRLEN)(send - rbrace) + 2); /* '}' + NUL */ Copy(hex_string, d, output_length, char); d += output_length; @@ -4059,7 +4059,7 @@ S_scan_const(pTHX_ char *start) "%.*s must not be a named sequence" " in transliteration operator", /* +1 to include the "}" */ - (int) (e + 1 - start), start)); + (int) (rbrace + 1 - start), start)); *d++ = '\0'; goto end_backslash_N; } @@ -4099,11 +4099,11 @@ S_scan_const(pTHX_ char *start) d = SvPVX(sv) + SvCUR(sv); } d_is_utf8 = TRUE; - } else if (len > (STRLEN)(e - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ + } else if (len > (STRLEN)(rbrace - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ /* See Note on sizing above. (NOTE: SvCUR() is not * set correctly here). */ - const STRLEN extra = len + (send - e) + 1; + const STRLEN extra = len + (send - rbrace) + 1; const STRLEN off = d - SvPVX_const(sv); d = off + SvGROW(sv, off + extra); } @@ -4119,7 +4119,7 @@ S_scan_const(pTHX_ char *start) #ifdef EBCDIC backslash_N++; /* \N{} is defined to be Unicode */ #endif - s = e + 1; /* Point to just after the '}' */ + s = rbrace + 1; /* Point to just after the '}' */ continue; /* \c is a control character */ From 6fab1cd3d01b1727683adef1fd9c531f4e7d4d62 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 20:17:19 -0700 Subject: [PATCH 453/503] toke.c: White-space, comment only --- toke.c | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/toke.c b/toke.c index a70d605b2525..cc8d060b2960 100644 --- a/toke.c +++ b/toke.c @@ -3856,7 +3856,7 @@ S_scan_const(pTHX_ char *start) } /* Pass everything through unchanged. - * +1 is for the '}' */ + * +1 is to include the '}' */ Copy(bslash, d, rbrace - bslash + 1, char); d += rbrace - bslash + 1; } @@ -3924,7 +3924,7 @@ S_scan_const(pTHX_ char *start) } } } - else /* Here is \N{NAME} but not \N{U+...}. */ + else /* Here is \N{NAME} but not \N{U+...}. */ if (! (res = get_and_check_backslash_N_name_wrapper(s, rbrace))) { /* Failed. We should die eventually, but for now use a NUL to keep parsing */ @@ -4099,7 +4099,7 @@ S_scan_const(pTHX_ char *start) d = SvPVX(sv) + SvCUR(sv); } d_is_utf8 = TRUE; - } else if (len > (STRLEN)(rbrace - s + 4)) { /* I _guess_ 4 is \N{} --jhi */ + } else if (len > (STRLEN)(rbrace - s + 4)) { /* +4 is for \N{} */ /* See Note on sizing above. (NOTE: SvCUR() is not * set correctly here). */ From fa2251a9e60c97eaa6070019b9da01efb26262dd Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 20:24:33 -0700 Subject: [PATCH 454/503] dquote.c: Change variable name A future commit will need it to represent just the meaning of the new name --- dquote.c | 52 ++++++++++++++++++++++++++-------------------------- 1 file changed, 26 insertions(+), 26 deletions(-) diff --git a/dquote.c b/dquote.c index 8fc4e689fb5a..c1d31c2f0337 100644 --- a/dquote.c +++ b/dquote.c @@ -117,7 +117,7 @@ Perl_form_alien_digit_msg(pTHX_ /* It also isn't a UTF-8 invariant character, so no display shortcuts * are available. Use \\x{...} */ - Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad); + Perl_sv_setpvf(aTHX_ display_char, "\\x{%02x}", *first_bad); } /* Ready to start building the message */ @@ -267,7 +267,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, * UV_MAX, which is normally illegal, reserved for internal use. * UTF is true iff the string *s is encoded in UTF-8. */ - char* e; + char * rbrace; STRLEN numbers_len; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES | PERL_SCAN_DISALLOW_PREFIX @@ -286,27 +286,27 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, (*s)++; if (send <= *s || **s != '{') { - *message = "Missing braces on \\o{}"; - return FALSE; + *message = "Missing braces on \\o{}"; + return FALSE; } - e = (char *) memchr(*s, '}', send - *s); - if (!e) { + rbrace = (char *) memchr(*s, '}', send - *s); + if (!rbrace) { (*s)++; /* Move past the '{' */ while (isOCTAL(**s)) { /* Position beyond the legal digits */ (*s)++; } *message = "Missing right brace on \\o{}"; - return FALSE; + return FALSE; } (*s)++; /* Point to expected first digit (could be first byte of utf8 sequence if not a digit) */ - numbers_len = e - *s; + numbers_len = rbrace - *s; if (numbers_len == 0) { (*s)++; /* Move past the '}' */ - *message = "Empty \\o{}"; - return FALSE; + *message = "Empty \\o{}"; + return FALSE; } *uv = grok_oct(*s, &numbers_len, &flags, NULL); @@ -314,13 +314,13 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, || (! allow_UV_MAX && *uv == UV_MAX))) { *message = form_cp_too_large_msg(8, *s, numbers_len, 0); - *s = e + 1; + *s = rbrace + 1; return FALSE; } /* Note that if has non-octal, will ignore everything starting with that up * to the '}' */ - if (numbers_len != (STRLEN) (e - *s)) { + if (numbers_len != (STRLEN) (rbrace - *s)) { *s += numbers_len; if (strict) { *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1; @@ -342,7 +342,7 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, } /* Return past the '}' */ - *s = e + 1; + *s = rbrace + 1; return TRUE; } @@ -390,7 +390,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, * UV_MAX, which is normally illegal, reserved for internal use. * UTF is true iff the string *s is encoded in UTF-8. */ - char* e; + char * rbrace; STRLEN numbers_len; I32 flags = PERL_SCAN_DISALLOW_PREFIX | PERL_SCAN_SILENT_ILLDIGIT @@ -423,8 +423,8 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, if (**s != '{') { numbers_len = (strict) ? 3 : 2; - *uv = grok_hex(*s, &numbers_len, &flags, NULL); - *s += numbers_len; + *uv = grok_hex(*s, &numbers_len, &flags, NULL); + *s += numbers_len; if (numbers_len != 2 && (strict || (flags & PERL_SCAN_NOTIFY_ILLDIGIT))) { if (numbers_len == 3) { /* numbers_len 3 only happens with strict */ @@ -449,29 +449,29 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, } } } - return TRUE; + return TRUE; } - e = (char *) memchr(*s, '}', send - *s); - if (!e) { + rbrace = (char *) memchr(*s, '}', send - *s); + if (!rbrace) { (*s)++; /* Move past the '{' */ while (*s < send && isXDIGIT(**s)) { /* Position beyond legal digits */ (*s)++; } - *message = "Missing right brace on \\x{}"; - return FALSE; + *message = "Missing right brace on \\x{}"; + return FALSE; } (*s)++; /* Point to expected first digit (could be first byte of utf8 sequence if not a digit) */ - numbers_len = e - *s; + numbers_len = rbrace - *s; if (numbers_len == 0) { if (strict) { (*s)++; /* Move past the } */ *message = "Empty \\x{}"; return FALSE; } - *s = e + 1; + *s = rbrace + 1; *uv = 0; return TRUE; } @@ -483,11 +483,11 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, || (! allow_UV_MAX && *uv == UV_MAX))) { *message = form_cp_too_large_msg(16, *s, numbers_len, 0); - *s = e + 1; + *s = rbrace + 1; return FALSE; } - if (numbers_len != (STRLEN) (e - *s)) { + if (numbers_len != (STRLEN) (rbrace - *s)) { *s += numbers_len; if (strict) { *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1; @@ -509,7 +509,7 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, } /* Return past the '}' */ - *s = e + 1; + *s = rbrace + 1; return TRUE; } From b8df2602b04f250c4d5467c4f180b89c1d0fcd72 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 20:59:54 -0700 Subject: [PATCH 455/503] t/re/reg_mesg.t: Add two missing test cases I noticed in code reading that these error cases weren't tested for. --- t/re/reg_mesg.t | 2 ++ 1 file changed, 2 insertions(+) diff --git a/t/re/reg_mesg.t b/t/re/reg_mesg.t index f5633c3ba0ed..b1a1682ddf9f 100644 --- a/t/re/reg_mesg.t +++ b/t/re/reg_mesg.t @@ -194,6 +194,8 @@ my @death = '/\g/' => 'Unterminated \g... pattern {#} m/\g{#}/', '/\g{1/' => 'Unterminated \g{...} pattern {#} m/\g{1{#}/', + '/\g{-abc}/' => 'Group name must start with a non-digit word character {#} m/\g{-{#}abc}/', + '/(?<;x/' => 'Group name must start with a non-digit word character {#} m/(?<;{#}x/', 'my $m = "\\\"; $m =~ $m', => 'Trailing \ in regex m/\/', From e8ba086966639eb1fc2185bfc1b5026ad30cfdd7 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 21:11:38 -0700 Subject: [PATCH 456/503] regcomp.c: Slight simplification Rather than know how far we have advanced in parsing when we have to back up, use the already-existing checkpoint position. This results in slightly more maintainable code that a future commit will take advantage of. --- regcomp.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/regcomp.c b/regcomp.c index 64cb5e9628e4..650912973747 100644 --- a/regcomp.c +++ b/regcomp.c @@ -14432,7 +14432,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) if ( !isDIGIT(p[1]) || S_backref_value(p, RExC_end) < RExC_npar) { /* Not to be treated as an octal constant, go find backref */ - --p; + p = oldp; goto loopdone; } /* FALLTHROUGH */ From 80318d2b040211edc9d94d10bc5d79497be66324 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 14 Jan 2021 04:52:10 -0700 Subject: [PATCH 457/503] regcomp.c: Move initialization into declaration This is considered better practice. --- regcomp.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/regcomp.c b/regcomp.c index 650912973747..b7208133da9a 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13725,9 +13725,9 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else { STRLEN length; char name = *RExC_parse; - char * endbrace = NULL; + char * endbrace = (char *) memchr(RExC_parse, '}', + RExC_end - RExC_parse); RExC_parse += 2; - endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); if (! endbrace) { vFAIL2("Missing right brace on \\%c{}", name); From abd9c16d55498b521a7dc3e5ae419ed149782f0a Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 14 Jan 2021 04:25:38 -0700 Subject: [PATCH 458/503] regcomp.c: Refactor portions of \g parsing This moves the finding of the matching '}' for \g{ to earlier, and creates a temporary to point to the current position in the parse. This makes it easier to deal with backtracking; we haven't advanced the main parse pointer, so don't have to remember how far we advanced. This will prove advantageous in a future commit. --- regcomp.c | 52 +++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 39 insertions(+), 13 deletions(-) diff --git a/regcomp.c b/regcomp.c index b7208133da9a..a393a9252757 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13938,28 +13938,55 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) { I32 num; bool hasbrace = 0; + char * s = RExC_parse; - if (*RExC_parse == 'g') { + if (*s == 'g') { bool isrel = 0; - RExC_parse++; - if (*RExC_parse == '{') { - RExC_parse++; + s++; + if (*s == '{') { + char * e = (char *) memchr(s, '}', RExC_end - s); + if (! e ) { + + /* Missing '}'. Position after the number to give + * a better indication to the user of where the + * problem is. */ + s++; + if (*s == '-') { + s++; + } + + /* If it looks to be a name and not a number, go + * handle it there */ + if (! isDIGIT(*s)) { + goto parse_named_seq; + } + + do { + s++; + } while isDIGIT(*s); + + RExC_parse = s; + vFAIL("Unterminated \\g{...} pattern"); + } + + s++; /* Past the '{' */ hasbrace = 1; } - if (*RExC_parse == '-') { - RExC_parse++; + + /* Here, have isolated the meat of the construct from any + * surrounding braces */ + + if (*s == '-') { isrel = 1; + s++; } - if (hasbrace && !isDIGIT(*RExC_parse)) { - if (isrel) RExC_parse--; - RExC_parse -= 2; + + if (hasbrace && !isDIGIT(*s)) { goto parse_named_seq; } - if (RExC_parse >= RExC_end) { - goto unterminated_g; - } + RExC_parse = s; num = S_backref_value(RExC_parse, RExC_end); if (num == 0) vFAIL("Reference to invalid group 0"); @@ -13967,7 +13994,6 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) if (isDIGIT(*RExC_parse)) vFAIL("Reference to nonexistent group"); else - unterminated_g: vFAIL("Unterminated \\g... pattern"); } From 12abe3c415ac316306426490edddd357e2cac4d3 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 14 Jan 2021 07:37:55 -0700 Subject: [PATCH 459/503] regcomp.c: Further refactor \g By changing a bool into a pointer, we can avoid some work and prepare for a future commit. --- regcomp.c | 29 +++++++++++++++-------------- 1 file changed, 15 insertions(+), 14 deletions(-) diff --git a/regcomp.c b/regcomp.c index a393a9252757..2f938fb1c852 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13937,7 +13937,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) case '5': case '6': case '7': case '8': case '9': { I32 num; - bool hasbrace = 0; + char * endbrace = NULL; char * s = RExC_parse; if (*s == 'g') { @@ -13945,8 +13945,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) s++; if (*s == '{') { - char * e = (char *) memchr(s, '}', RExC_end - s); - if (! e ) { + endbrace = (char *) memchr(s, '}', RExC_end - s); + if (! endbrace ) { /* Missing '}'. Position after the number to give * a better indication to the user of where the @@ -13971,7 +13971,6 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } s++; /* Past the '{' */ - hasbrace = 1; } /* Here, have isolated the meat of the construct from any @@ -13982,7 +13981,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) s++; } - if (hasbrace && !isDIGIT(*s)) { + if (endbrace && !isDIGIT(*s)) { goto parse_named_seq; } @@ -14030,15 +14029,17 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } /* At this point RExC_parse points at a numeric escape like - * \12 or \88 or something similar, which we should NOT treat - * as an octal escape. It may or may not be a valid backref - * escape. For instance \88888888 is unlikely to be a valid - * backref. */ - while (isDIGIT(*RExC_parse)) - RExC_parse++; - if (hasbrace) { - if (*RExC_parse != '}') - vFAIL("Unterminated \\g{...} pattern"); + * \12 or \88 or the digits in \g{34} or \g34 or something + * similar, which we should NOT treat as an octal escape. It + * may or may not be a valid backref escape. For instance + * \88888888 is unlikely to be a valid backref. + * + * We've already figured out what value the digits represent. + * Now, move the parse to beyond them. */ + if (endbrace) { + RExC_parse = endbrace + 1; + } + else while (isDIGIT(*RExC_parse)) { RExC_parse++; } if (num >= (I32)RExC_npar) { From a44b2be795f4c5f94384c6f6010860588e144b3c Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Fri, 8 Jan 2021 22:02:39 -0700 Subject: [PATCH 460/503] perlre: Note the other forms of \k Not all three synonyms were documented. This also fixes up related comments in regcomp.c to correspond --- pod/perlre.pod | 6 +++++- regcomp.c | 4 ++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/pod/perlre.pod b/pod/perlre.pod index 83a3b08dfa03..7d639b02b4aa 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -1003,6 +1003,8 @@ X<\g> X<\k> X<\K> X curly brackets for safer parsing. \g{name} [5] Named backreference \k [5] Named backreference + \k'name' [5] Named backreference + \k{name} [5] Named backreference \K [6] Keep the stuff left of the \K, don't include it in $& \N [7] Any character but \n. Not affected by /s modifier \v [3] Vertical whitespace @@ -1763,6 +1765,8 @@ support the use of single quotes as a delimiter for the name. =item C<< \k'I' >> +=item C<< \k{I} >> + Named backreference. Similar to numeric backreferences, except that the group is designated by name and not number. If multiple groups have the same name then it refers to the leftmost defined group in @@ -1771,7 +1775,7 @@ the current match. It is an error to refer to a name not defined by a C<< (?>) >> earlier in the pattern. -Both forms are equivalent. +All three forms are equivalent. B In order to make things easier for programmers with experience with the Python or PCRE regex engines, the pattern C<< (?P=I) >> diff --git a/regcomp.c b/regcomp.c index 2f938fb1c852..ac959e37669b 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13907,8 +13907,8 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) RExC_parse = parse_start; goto defchar; - case 'k': /* Handle \k and \k'NAME' */ - parse_named_seq: + case 'k': /* Handle \k and \k'NAME' and \k{NAME} */ + parse_named_seq: /* Also handle non-numeric \g{...} */ { char ch; if ( RExC_parse >= RExC_end - 1 From 1b2f32d508340483aa270e0caf653ba0454345d1 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 14 Jan 2021 07:52:26 -0700 Subject: [PATCH 461/503] Allow blanks within and adjacent to {...} constructs This was the consensus in http://nntp.perl.org/group/perl.perl5.porters/258489 --- dquote.c | 65 ++++++++++++++++++++++---- embed.fnc | 2 +- pod/perldelta.pod | 18 +++++++ pod/perldiag.pod | 9 ---- pod/perlop.pod | 31 ++++++++---- pod/perlre.pod | 23 +++++---- pod/perlrebackslash.pod | 16 +++++++ pod/perlrequick.pod | 2 +- pod/perlretut.pod | 9 +++- proto.h | 2 +- regcomp.c | 101 ++++++++++++++++++++++++++++++---------- t/opbasic/qq.t | 4 +- t/re/pat_advanced.t | 8 ---- t/re/re_tests | 25 ++++++++++ t/re/reg_mesg.t | 21 ++++----- toke.c | 31 +++++++++--- 16 files changed, 276 insertions(+), 91 deletions(-) diff --git a/dquote.c b/dquote.c index c1d31c2f0337..a9fa29c9ad22 100644 --- a/dquote.c +++ b/dquote.c @@ -267,8 +267,10 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, * UV_MAX, which is normally illegal, reserved for internal use. * UTF is true iff the string *s is encoded in UTF-8. */ + char * e; char * rbrace; STRLEN numbers_len; + STRLEN trailing_blanks_len = 0; I32 flags = PERL_SCAN_ALLOW_UNDERSCORES | PERL_SCAN_DISALLOW_PREFIX | PERL_SCAN_SILENT_NON_PORTABLE @@ -293,16 +295,33 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, rbrace = (char *) memchr(*s, '}', send - *s); if (!rbrace) { (*s)++; /* Move past the '{' */ - while (isOCTAL(**s)) { /* Position beyond the legal digits */ + + /* Position beyond the legal digits and blanks */ + while (*s < send && isBLANK(**s)) { + (*s)++; + } + + while (*s < send && isOCTAL(**s)) { (*s)++; } + *message = "Missing right brace on \\o{}"; return FALSE; } - (*s)++; /* Point to expected first digit (could be first byte of utf8 - sequence if not a digit) */ - numbers_len = rbrace - *s; + /* Point to expected first digit (could be first byte of utf8 sequence if + * not a digit) */ + (*s)++; + while (isBLANK(**s)) { + (*s)++; + } + + e = rbrace; + while (*s < e && isBLANK(*(e - 1))) { + e--; + } + + numbers_len = e - *s; if (numbers_len == 0) { (*s)++; /* Move past the '}' */ *message = "Empty \\o{}"; @@ -318,9 +337,14 @@ Perl_grok_bslash_o(pTHX_ char **s, const char * const send, UV *uv, return FALSE; } + while (isBLANK(**s)) { + trailing_blanks_len++; + (*s)++; + } + /* Note that if has non-octal, will ignore everything starting with that up * to the '}' */ - if (numbers_len != (STRLEN) (rbrace - *s)) { + if (numbers_len + trailing_blanks_len != (STRLEN) (e - *s)) { *s += numbers_len; if (strict) { *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1; @@ -390,8 +414,10 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, * UV_MAX, which is normally illegal, reserved for internal use. * UTF is true iff the string *s is encoded in UTF-8. */ + char* e; char * rbrace; STRLEN numbers_len; + STRLEN trailing_blanks_len = 0; I32 flags = PERL_SCAN_DISALLOW_PREFIX | PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_NOTIFY_ILLDIGIT @@ -455,16 +481,32 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, rbrace = (char *) memchr(*s, '}', send - *s); if (!rbrace) { (*s)++; /* Move past the '{' */ - while (*s < send && isXDIGIT(**s)) { /* Position beyond legal digits */ + + /* Position beyond legal blanks and digits */ + while (*s < send && isBLANK(**s)) { (*s)++; } + + while (*s < send && isXDIGIT(**s)) { + (*s)++; + } + *message = "Missing right brace on \\x{}"; return FALSE; } (*s)++; /* Point to expected first digit (could be first byte of utf8 sequence if not a digit) */ - numbers_len = rbrace - *s; + while (isBLANK(**s)) { + (*s)++; + } + + e = rbrace; + while (*s < e && isBLANK(*(e - 1))) { + e--; + } + + numbers_len = e - *s; if (numbers_len == 0) { if (strict) { (*s)++; /* Move past the } */ @@ -483,11 +525,16 @@ Perl_grok_bslash_x(pTHX_ char ** s, const char * const send, UV *uv, || (! allow_UV_MAX && *uv == UV_MAX))) { *message = form_cp_too_large_msg(16, *s, numbers_len, 0); - *s = rbrace + 1; + *s = e + 1; return FALSE; } - if (numbers_len != (STRLEN) (rbrace - *s)) { + while (isBLANK(**s)) { + trailing_blanks_len++; + (*s)++; + } + + if (numbers_len + trailing_blanks_len != (STRLEN) (e - *s)) { *s += numbers_len; if (strict) { *s += (UTF) ? UTF8_SAFE_SKIP(*s, send) : 1; diff --git a/embed.fnc b/embed.fnc index a90b32d708dd..c496e415ced7 100644 --- a/embed.fnc +++ b/embed.fnc @@ -3118,7 +3118,7 @@ S |void |anonymise_cv_maybe |NN GV *gv|NN CV *cv po |void * |more_bodies |const svtype sv_type|const size_t body_size \ |const size_t arena_size EXpR |SV* |get_and_check_backslash_N_name|NN const char* s \ - |NN const char* const e \ + |NN const char* e \ |const bool is_utf8 \ |NN const char** error_msg EXpR |HV* |load_charnames |NN SV * char_name \ diff --git a/pod/perldelta.pod b/pod/perldelta.pod index d7072d17c524..c514b12c4776 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -19,6 +19,24 @@ L, which describes differences between 5.33.4 and 5.33.5. An empty lower bound is now accepted for regular expression quantifiers, like C<{,3}> +=head2 Blanks freely allowed within but adjacent to curly braces + +(in double-quotish contexts and regular expression patterns) + +This means you can write things like S> if you like. This +applies to all such constructs, namely C<\b{}>, C<\g{}>, C<\k{}>, +C<\N{}>, C<\o{}>, and C<\x{}>; as well as the regular expression +quantifier C<{I,I}>. C<\p{}> and C<\P{}> retain their +already-existing, even looser, rules mandated by the Unicode standard +(see L). + +This ability is in effect regardless of the presence of the C +regular expression pattern modifier. + +Additionally, the comma in a regular expression braced quantifier may +have blanks (tabs or spaces) before and/or after the comma, like +S> + =head2 Updated Modules and Pragmata =over 4 diff --git a/pod/perldiag.pod b/pod/perldiag.pod index de9e77241294..9c91630d3970 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -1684,15 +1684,6 @@ defined in the C<:alias> import argument to C, but they could be defined by a translator installed into C<$^H{charnames}>. See L. -=item charnames alias definitions may not contain trailing white-space; -marked by S<<-- HERE> in %s - -(F) You defined a character name which ended in a space -character. Remove the trailing space(s). Usually these names are -defined in the C<:alias> import argument to C, but they -could be defined by a translator installed into C<$^H{charnames}>. -See L. - =item chdir() on unopened filehandle %s (W unopened) You tried chdir() on a filehandle that was never opened. diff --git a/pod/perlop.pod b/pod/perlop.pod index 51303be3a2a2..33e558aa7014 100644 --- a/pod/perlop.pod +++ b/pod/perlop.pod @@ -1594,6 +1594,8 @@ is a word character (meaning it matches C): The following escape sequences are available in constructs that interpolate, and in transliterations whose delimiters aren't single quotes (C<"'">). +In all the ones with braces, any number of blanks and/or tabs adjoining +and within the braces are allowed (and ignored). X<\t> X<\n> X<\r> X<\f> X<\b> X<\a> X<\e> X<\x> X<\0> X<\c> X<\N> X<\N{}> X<\o{}> @@ -1606,6 +1608,8 @@ X<\o{}> \a alarm (bell) (BEL) \e escape (ESC) \x{263A} [1,8] hex char (example shown: SMILEY) + \x{ 263A } Same, but shows optional blanks inside and + adjoining the braces \x1b [2,8] restricted range hex char (example: ESC) \N{name} [3] named Unicode character or character sequence \N{U+263D} [4,8] Unicode character (example: FIRST QUARTER MOON) @@ -1613,6 +1617,11 @@ X<\o{}> \o{23072} [6,8] octal char (example: SMILEY) \033 [7,8] restricted range octal char (example: ESC) +Note that any escape sequence using braces inside interpolated +constructs may have optional blanks (tab or space characters) adjoining +with and inside of the braces, as illustrated above by the second +S> example. + =over 4 =item [1] @@ -1620,10 +1629,13 @@ X<\o{}> The result is the character specified by the hexadecimal number between the braces. See L below for details on which character. -Only hexadecimal digits are valid between the braces. If an invalid -character is encountered, a warning will be issued and the invalid -character and all subsequent characters (valid or invalid) within the -braces will be discarded. +Blanks (tab or space characters) may separate the number from either or +both of the braces. + +Otherwise, only hexadecimal digits are valid between the braces. If an +invalid character is encountered, a warning will be issued and the +invalid character and all subsequent characters (valid or invalid) +within the braces will be discarded. If there are no valid digits between the braces, the generated character is the NULL character (C<\x{00}>). However, an explicit empty brace (C<\x{}>) @@ -1709,10 +1721,13 @@ To get platform independent controls, you can use C<\N{...}>. The result is the character specified by the octal number between the braces. See L below for details on which character. -If a character that isn't an octal digit is encountered, a warning is raised, -and the value is based on the octal digits before it, discarding it and all -following characters up to the closing brace. It is a fatal error if there are -no octal digits at all. +Blanks (tab or space characters) may separate the number from either or +both of the braces. + +Otherwise, if a character that isn't an octal digit is encountered, a +warning is raised, and the value is based on the octal digits before it, +discarding it and all following characters up to the closing brace. It +is a fatal error if there are no octal digits at all. =item [7] diff --git a/pod/perlre.pod b/pod/perlre.pod index 7d639b02b4aa..f963fe76e5c7 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -504,14 +504,13 @@ making Perl's regular expressions more readable. Here's an example: Note that anything inside a C<\Q...\E> stays unaffected by C. And note that C doesn't affect space interpretation within a single multi-character construct. For -example in C<\x{...}>, regardless of the C modifier, there can be no -spaces. Same for a L such as C<{3}> or -C<{5,}>. Similarly, C<(?:...)> can't have a space between the C<"(">, -C<"?">, and C<":">. Within any delimiters for such a -construct, allowed spaces are not affected by C, and depend on the -construct. For example, C<\x{...}> can't have spaces because hexadecimal -numbers don't have spaces in them. But, Unicode properties can have spaces, so -in C<\p{...}> there can be spaces that follow the Unicode rules, for which see +example C<(?:...)> can't have a space between the C<"(">, +C<"?">, and C<":">. Within any delimiters for such a construct, allowed +spaces are not affected by C, and depend on the construct. For +example, all constructs using curly braces as delimiters, such as +C<\x{...}> can have blanks within but adjacent to the braces, but not +elsewhere, and no non-blank space characters. An exception are Unicode +properties which follow Unicode rules, for which see L. X @@ -1193,6 +1192,10 @@ concatenating smaller strings. For example if you have C, and C<$a> contained C<"\g1">, and C<$b> contained C<"37">, you would get C which is probably not what you intended. +If you use braces, you may also optionally add any number of blank +(space or tab) characters within but adjacent to the braces, like +S>, or S }>>. + The C<\g> and C<\k> notations were introduced in Perl 5.10.0. Prior to that there were no named nor relative numbered capture groups. Absolute numbered groups were referred to using C<\1>, @@ -1775,7 +1778,9 @@ the current match. It is an error to refer to a name not defined by a C<< (?>) >> earlier in the pattern. -All three forms are equivalent. +All three forms are equivalent, although with C<< \k{ I } >>, +you may optionally have blanks within but adjacent to the braces, as +shown. B In order to make things easier for programmers with experience with the Python or PCRE regex engines, the pattern C<< (?P=I) >> diff --git a/pod/perlrebackslash.pod b/pod/perlrebackslash.pod index 9500bef527b8..d6539ad99df3 100644 --- a/pod/perlrebackslash.pod +++ b/pod/perlrebackslash.pod @@ -186,6 +186,10 @@ digits. Thus C<\N{U+0041}> means C, and you will rarely see it written without the two leading zeros. C<\N{U+0041}> means "A" even on EBCDIC machines (where the ordinal value of "A" is not 0x41). +Blanks may freely be inserted adjacent to but within the braces +enclosing the name or code point. So S> is perfectly +legal. + It is even possible to give your own names to characters and character sequences by using the L module. These custom names are lexically scoped, and so a given code point may have different names @@ -260,6 +264,9 @@ Mnemonic: I<0>ctal or Ictal. $str =~ /P\053/; # No match, "\053" is "+" and taken literally. /\o{23073}/ # Black foreground, white background smiling face. /\o{4801234567}/ # Raises a warning, and yields chr(4). + /\o{ 400}/ # LATIN CAPITAL LETTER A WITH MACRON + /\o{ 400 }/ # Same. These show blanks are allowed adjacent to + # the braces =head4 Disambiguation rules between old-style octal escapes and backreferences @@ -326,6 +333,8 @@ Mnemonic: heIadecimal. # the Unicode character 2602 is an umbrella. /\x{263B}/ # Black smiling face. /\x{263b}/ # Same, the hex digits A - F are case insensitive. + /\x{ 263b }/ # Same, showing optional blanks adjacent to the + # braces =head2 Modifiers @@ -441,6 +450,7 @@ Mnemonic: Iroup. /(\w+) \g1/; # Finds a duplicated word, (e.g. "cat cat"). /(\w+) \1/; # Same thing; written old-style. /(\w+) \g{1}/; # Same, using the safer braced notation + /(\w+) \g{ 1 }/;# Same, showing optional blanks adjacent to the braces /(.)(.)\g2\g1/; # Match a four letter palindrome (e.g. "ABBA"). @@ -461,6 +471,7 @@ even if the larger pattern also contains capture groups. (B) # Group 3 \g{-1} # Refers to group 3 (B) \g{-3} # Refers to group 1 (A) + \g{ -3 } # Same, showing optional blanks adjacent to the braces ) /x; # Matches "ABBA". @@ -483,6 +494,11 @@ hyphen. /(?\w+) \g{word}/ # Finds duplicated word, (e.g. "cat cat") /(?\w+) \k{word}/ # Same. + /(?\w+) \g{ word }/ # Same, showing optional blanks adjacent to + # the braces + /(?\w+) \k{ word }/ # Same. + /(?\w+) \k/ # Same. There are no braces, so no blanks + # are permitted /(?.)(?.)\g{letter2}\g{letter1}/ # Match a four letter palindrome (e.g. # "ABBA") diff --git a/pod/perlrequick.pod b/pod/perlrequick.pod index 6a70e9cd0d8b..38970dd70a08 100644 --- a/pod/perlrequick.pod +++ b/pod/perlrequick.pod @@ -378,7 +378,7 @@ Here are some examples: /(\w+)\s+\g1/; # match doubled words of arbitrary length $year =~ /^\d{2,4}$/; # make sure year is at least 2 but not more # than 4 digits - $year =~ /^\d{4}$|^\d{2}$/; # better match; throw out 3 digit dates + $year =~ /^\d{ 4 }$|^\d{2}$/; # better match; throw out 3 digit dates These quantifiers will try to match as much of the string as possible, while still allowing the regex to match. So we have diff --git a/pod/perlretut.pod b/pod/perlretut.pod index 70b16f1ddbd9..ce196f30515e 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -1056,6 +1056,9 @@ C means: match exactly C times =back +If you like, you can add blanks (tab or space characters) within the +braces, but adjacent to them, and/or next to the comma (if any). + Here are some examples: /[a-z]+\s+\d*/; # match a lowercase word, at least one space, and @@ -1064,6 +1067,9 @@ Here are some examples: /y(es)?/i; # matches 'y', 'Y', or a case-insensitive 'yes' $year =~ /^\d{2,4}$/; # make sure year is at least 2 but not more # than 4 digits + $year =~ /^\d{ 2, 4 }$/; # Same; for those who like wide open + # spaces. + $year =~ /^\d{2, 4}$/; # Same. $year =~ /^\d{4}$|^\d{2}$/; # better match; throw out 3-digit dates $year =~ /^\d{2}(\d{2})?$/; # same thing written differently. # However, this captures the last two @@ -2002,6 +2008,7 @@ could use $x = "abc\N{MERCURY}def"; $x =~ /\N{MERCURY}/; # matches + $x =~ /\N{ MERCURY }/; # Also matches One can also use "short" names: @@ -2563,7 +2570,7 @@ containing just one word character is a palindrome. Otherwise it must have a word character up front and the same at its end, with another palindrome in between. - /(?: (\w) (?...Here be a palindrome...) \g{-1} | \w? )/x + /(?: (\w) (?...Here be a palindrome...) \g{ -1 } | \w? )/x Adding C<\W*> at either end to eliminate what is to be ignored, we already have the full pattern: diff --git a/proto.h b/proto.h index 7b935c2a9ad9..8a98030d280b 100644 --- a/proto.h +++ b/proto.h @@ -1119,7 +1119,7 @@ PERL_CALLCONV void Perl_free_tied_hv_pool(pTHX); #define PERL_ARGS_ASSERT_FREE_TIED_HV_POOL PERL_CALLCONV void Perl_free_tmps(pTHX); #define PERL_ARGS_ASSERT_FREE_TMPS -PERL_CALLCONV SV* Perl_get_and_check_backslash_N_name(pTHX_ const char* s, const char* const e, const bool is_utf8, const char** error_msg) +PERL_CALLCONV SV* Perl_get_and_check_backslash_N_name(pTHX_ const char* s, const char* e, const bool is_utf8, const char** error_msg) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_GET_AND_CHECK_BACKSLASH_N_NAME \ assert(s); assert(e); assert(error_msg) diff --git a/regcomp.c b/regcomp.c index ac959e37669b..4d56152c761a 100644 --- a/regcomp.c +++ b/regcomp.c @@ -11071,6 +11071,11 @@ S_handle_named_backref(pTHX_ RExC_state_t *pRExC_state, PERL_ARGS_ASSERT_HANDLE_NAMED_BACKREF; + if (RExC_parse != name_start && ch == '}') { + while (isBLANK(*RExC_parse)) { + RExC_parse++; + } + } if (RExC_parse == name_start || *RExC_parse != ch) { /* diag_listed_as: Sequence \%s... not terminated in regex; marked by <-- HERE in m/%s/ */ vFAIL2("Sequence %.3s... not terminated", parse_start); @@ -12588,6 +12593,10 @@ Perl_regcurly(const char *s, const char *e, const char * result[5]) if (s >= e || *s++ != '{') return FALSE; + while (s < e && isBLANK(*s)) { + s++; + } + if isDIGIT(*s) { min_start = s; do { @@ -12596,9 +12605,18 @@ Perl_regcurly(const char *s, const char *e, const char * result[5]) min_end = s; } + while (s < e && isBLANK(*s)) { + s++; + } + if (*s == ',') { has_comma = TRUE; s++; + + while (s < e && isBLANK(*s)) { + s++; + } + if isDIGIT(*s) { max_start = s; do { @@ -12607,6 +12625,10 @@ Perl_regcurly(const char *s, const char *e, const char * result[5]) max_end = s; } } + + while (s < e && isBLANK(*s)) { + s++; + } /* Need at least one number */ if (s >= e || *s != '}' || (! min_start && ! max_end)) { return FALSE; @@ -13056,6 +13078,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, * are already native, so no translation is done. */ char * endbrace; /* points to '}' following the name */ + char * e; /* points to final non-blank before endbrace */ char* p = RExC_parse; /* Temporary */ SV * substitute_parse = NULL; @@ -13075,8 +13098,9 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, } /* The [^\n] meaning of \N ignores spaces and comments under the /x - * modifier. The other meanings do not, so use a temporary until we find - * out which we are being called with */ + * modifier. The other meanings do not (except blanks adjacent to and + * within the braces), so use a temporary until we find out which we are + * being called with */ skip_to_be_ignored_text(pRExC_state, &p, FALSE /* Don't force to /x */ ); @@ -13140,13 +13164,22 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, return TRUE; } - if (endbrace - RExC_parse < 2 || ! strBEGINs(RExC_parse, "U+")) { + while (isBLANK(*RExC_parse)) { + RExC_parse++; + } + + e = endbrace; + while (RExC_parse < e && isBLANK(*(e-1))) { + e--; + } + + if (e - RExC_parse < 2 || ! strBEGINs(RExC_parse, "U+")) { /* Here, the name isn't of the form U+.... This can happen if the * pattern is single-quoted, so didn't get evaluated in toke.c. Now * is the time to find out what the name means */ - const STRLEN name_len = endbrace - RExC_parse; + const STRLEN name_len = e - RExC_parse; SV * value_sv; /* What does this name evaluate to */ SV ** value_svp; const U8 * value; /* string of name's value */ @@ -13171,7 +13204,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, } else { /* Otherwise we have to go out and get the name */ const char * error_msg = NULL; - value_sv = get_and_check_backslash_N_name(RExC_parse, endbrace, + value_sv = get_and_check_backslash_N_name(RExC_parse, e, UTF, &error_msg); if (error_msg) { @@ -13270,7 +13303,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, | PERL_SCAN_NOTIFY_ILLDIGIT | PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES | PERL_SCAN_DISALLOW_PREFIX; - STRLEN len = endbrace - RExC_parse; + STRLEN len = e - RExC_parse; NV overflow_value; char * start_digit = RExC_parse; UV cp = grok_hex(RExC_parse, &len, &flags, &overflow_value); @@ -13287,7 +13320,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, vFAIL(form_cp_too_large_msg(16, start_digit, len, 0)); } - if (RExC_parse >= endbrace) { /* Got to the closing '}' */ + if (RExC_parse >= e) { /* Got to the closing '}' */ if (count) { goto do_concat; } @@ -13311,12 +13344,12 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, * So the next character must be a dot (and the one after that * can't be the endbrace, or we'd have something like \N{U+100.} ) * */ - if (*RExC_parse != '.' || RExC_parse + 1 >= endbrace) { + if (*RExC_parse != '.' || RExC_parse + 1 >= e) { RExC_parse += (RExC_orig_utf8) /* point to after 1st invalid */ ? UTF8SKIP(RExC_parse) : 1; - RExC_parse = MIN(endbrace, RExC_parse);/* Guard against - malformed utf8 */ + RExC_parse = MIN(e, RExC_parse);/* Guard against malformed utf8 + */ goto bad_NU; } @@ -13354,7 +13387,7 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, RExC_parse++; count++; - } while (RExC_parse < endbrace); + } while (RExC_parse < e); if (! node_p) { /* Doesn't want the node */ assert (cp_count); @@ -13727,25 +13760,29 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) char name = *RExC_parse; char * endbrace = (char *) memchr(RExC_parse, '}', RExC_end - RExC_parse); + char * e = endbrace; + RExC_parse += 2; if (! endbrace) { vFAIL2("Missing right brace on \\%c{}", name); } - /* XXX Need to decide whether to take spaces or not. Should be - * consistent with \p{}, but that currently is SPACE, which - * means vertical too, which seems wrong - * while (isBLANK(*RExC_parse)) { + + while (isBLANK(*RExC_parse)) { RExC_parse++; - }*/ - if (endbrace == RExC_parse) { - RExC_parse++; /* After the '}' */ + } + + while (RExC_parse < e && isBLANK(*(e - 1))) { + e--; + } + + if (e == RExC_parse) { + RExC_parse = endbrace + 1; /* After the '}' */ vFAIL2("Empty \\%c{}", name); } - length = endbrace - RExC_parse; - /*while (isBLANK(*(RExC_parse + length - 1))) { - length--; - }*/ + + length = e - RExC_parse; + switch (*RExC_parse) { case 'g': if ( length != 1 @@ -13775,10 +13812,10 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) break; default: bad_bound_type: - RExC_parse = endbrace; + RExC_parse = e; vFAIL2utf8f( "'%" UTF8f "' is an unknown bound type", - UTF8fARG(UTF, length, endbrace - length)); + UTF8fARG(UTF, length, e - length)); NOT_REACHED; /*NOTREACHED*/ } RExC_parse = endbrace; @@ -13921,6 +13958,11 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) vFAIL2("Sequence %.2s... not terminated", parse_start); } else { RExC_parse += 2; + if (ch == '{') { + while (isBLANK(*RExC_parse)) { + RExC_parse++; + } + } ret = handle_named_backref(pRExC_state, flagp, parse_start, @@ -13939,6 +13981,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) I32 num; char * endbrace = NULL; char * s = RExC_parse; + char * e = RExC_end; if (*s == 'g') { bool isrel = 0; @@ -13971,6 +14014,16 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) } s++; /* Past the '{' */ + + while (isBLANK(*s)) { + s++; + } + + /* Ignore trailing blanks */ + e = endbrace; + while (s < e && isBLANK(*(e - 1))) { + e--; + } } /* Here, have isolated the meat of the construct from any diff --git a/t/opbasic/qq.t b/t/opbasic/qq.t index e633783df22f..08560153310c 100644 --- a/t/opbasic/qq.t +++ b/t/opbasic/qq.t @@ -8,7 +8,7 @@ BEGIN { # This file uses a specially crafted is() function rather than that found in # t/test.pl or Test::More. Hence, we place this file in directory t/opbasic. -print q(1..28 +print q(1..30 ); # This is() function is written to avoid "" @@ -47,6 +47,7 @@ is ("\xx9", chr (0) . 'x9'); # This will warn. \x9 is tab in EBCDIC too? is ("\x9_E", chr (9) . '_E'); # This will warn is ("\x{4E}", chr 78); +is ("\x{ 4E }", chr 78); is ("\x{6_9}", chr 105); is ("\x{_6_3}", chr 99); is ("\x{_6B}", chr 107); @@ -68,6 +69,7 @@ is ("\400", chr 0x100); is ("\600", chr 0x180); is ("\777", chr 0x1FF); is ("a\o{120}b", "a" . chr(0x50) . "b"); +is ("a\o{ 120 }b", "a" . chr(0x50) . "b"); is ("a\o{400}b", "a" . chr(0x100) . "b"); is ("a\o{1000}b", "a" . chr(0x200) . "b"); diff --git a/t/re/pat_advanced.t b/t/re/pat_advanced.t index 8c6909569bb9..d67987099a8c 100644 --- a/t/re/pat_advanced.t +++ b/t/re/pat_advanced.t @@ -995,14 +995,6 @@ sub run_tests { like ($@, qr/charnames alias definitions may not contain a sequence of multiple spaces/, "... same under utf8"); } - undef $w; - { - () = eval q ["\N{TRAILING SPACE }"]; - like ($@, qr/charnames alias definitions may not contain trailing white-space/, "Trailing white-space in a charnames alias is fatal"); - eval q [use utf8; () = "\N{TRAILING SPACE }"]; - like ($@, qr/charnames alias definitions may not contain trailing white-space/, "... same under utf8"); - } - undef $w; my $Cedilla_Latin1 = "GAR" . uni_to_native("\xC7") diff --git a/t/re/re_tests b/t/re/re_tests index 8b1412e1cca7..cad545f77deb 100644 --- a/t/re/re_tests +++ b/t/re/re_tests @@ -46,6 +46,7 @@ ab*bc abbbbc y $+[0] 6 \N{3,4} abbbbc y $& abbb \N{3,4} abbbbc y $-[0] 0 \N{3,4} abbbbc y $+[0] 4 +\N{ 3 , 4 } abbbbc y $+[0] 4 /\N {3,4}/x abbbbc y $& abbb /\N {3,4}/x abbbbc y $-[0] 0 /\N {3,4}/x abbbbc y $+[0] 4 @@ -136,14 +137,22 @@ a[^]b]c adc y $& adc \By\B xyz y - - \b n - - \b{gcb} n - - +\b{ gcb } n - - \b{lb} n - - +\b{ lb } n - - \b{sb} n - - +\b{ sb } n - - +\b{ wb } n - - \b{wb} n - - \B y - - \B{gcb} y - - +\B{ gcb } y - - \B{lb} y - - +\B{ lb } y - - \B{sb} y - - +\B{ sb } y - - \B{wb} y - - +\B{ wb } y - - \w a y - - \w - n - - \W a n - - @@ -296,11 +305,15 @@ a[-]?c ac y $& ac \g1 - c - Reference to nonexistent group \g-1 - c - Reference to nonexistent or unclosed group \g{1} - c - Reference to nonexistent group +\g{ 1 } - c - Reference to nonexistent group \g{-1} - c - Reference to nonexistent or unclosed group +\g{ -1 } - c - Reference to nonexistent or unclosed group \g0 - c - Reference to invalid group 0 \g-0 - c - Reference to invalid group 0 \g{0} - c - Reference to invalid group 0 +\g{ 0 } - c - Reference to invalid group 0 \g{-0} - c - Reference to invalid group 0 +\g{ -0 } - c - Reference to invalid group 0 (a)|\1 a y - - (a)|\1 x n - Reference to group in different branch (?:(b)?a)\1 a n - Reference to group that did not match @@ -1331,9 +1344,14 @@ a*(*F) aaaab n - - /foo \k''/ - c - Group name must start with a non-digit word character /foo \k<>/ - c - Group name must start with a non-digit word character /(?as) (\w+) \k (\w+)/ as easy as pie y $1-$2-$3 as-easy-pie +/(?as) (\w+) \k{as} (\w+)/ as easy as pie y $1-$2-$3 as-easy-pie +/(?as) (\w+) \k'as' (\w+)/ as easy as pie y $1-$2-$3 as-easy-pie +/(?as) (\w+) \k{ as } (\w+)/ as easy as pie y $1-$2-$3 as-easy-pie +/(?as) (\w+) \k< as> (\w+)/ as easy as pie c - Group name must start with a non-digit word character # \g{...} with a name as the argument /(?'n'foo) \g{n}/ ..foo foo.. y $1 foo +/(?'n'foo) \g{ n }/ ..foo foo.. y $1 foo /(?'n'foo) \g{n}/ ..foo foo.. yM $+{n} foo miniperl cannot load Tie::Hash::NamedCapture /(?foo) \g{n}/ ..foo foo.. y $1 foo /(?foo) \g{n}/ ..foo foo.. yM $+{n} foo miniperl cannot load Tie::Hash::NamedCapture @@ -1452,7 +1470,9 @@ foo(\h)bar foo\tbar y $1 \t # [perl #60344] Regex lookbehind failure after an (if)then|else in perl 5.10 /\A(?(?=db2)db2|\D+)(? 'Trailing \ in regex m/\/', - '/\x{1/' => 'Missing right brace on \x{} {#} m/\x{1{#}/', + '/\x{ 1 /' => 'Missing right brace on \x{} {#} m/\x{ 1{#} /', '/\x{X/' => 'Missing right brace on \x{} {#} m/\x{{#}X/', '/[\x{X]/' => 'Missing right brace on \x{} {#} m/[\x{{#}X]/', - '/[\x{A]/' => 'Missing right brace on \x{} {#} m/[\x{A{#}]/', + '/[\x{ A ]/' => 'Missing right brace on \x{} {#} m/[\x{ A{#} ]/', - '/\o{1/' => 'Missing right brace on \o{} {#} m/\o{1{#}/', - '/\o{X/' => 'Missing right brace on \o{} {#} m/\o{{#}X/', + '/\o{ 1 /' => 'Missing right brace on \o{} {#} m/\o{ 1{#} /', + '/\o{X/' => 'Missing right brace on \o{} {#} m/\o{{#}X/', '/[\o{X]/' => 'Missing right brace on \o{} {#} m/[\o{{#}X]/', - '/[\o{7]/' => 'Missing right brace on \o{} {#} m/[\o{7{#}]/', + '/[\o{ 7 ]/' => 'Missing right brace on \o{} {#} m/[\o{ 7{#} ]/', '/[[:barf:]]/' => 'POSIX class [:barf:] unknown {#} m/[[:barf:]{#}]/', @@ -430,13 +430,10 @@ my @death_only_under_strict = ( => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#}/', '/\x{100}\x/' => "", => "Empty \\x {#} m/\\x{100}\\x{#}/", - - '/.{, 4 }/' => 'Unescaped left brace in regex is passed through {#} m/.{{#}, 4 }/', - => 'Unescaped left brace in regex is illegal here {#} m/.{{#}, 4 }/', - '/[x]{, 4}/' => 'Unescaped left brace in regex is passed through {#} m/[x]{{#}, 4}/', - => 'Unescaped left brace in regex is illegal here {#} m/[x]{{#}, 4}/', - '/\p{Latin}{,4 }/' => 'Unescaped left brace in regex is passed through {#} m/\p{Latin}{{#},4 }/', - => 'Unescaped left brace in regex is illegal here {#} m/\p{Latin}{{#},4 }/', + '/\o{ 1 20 }/' => 'Non-octal character \' \' terminates \o early. Resolved as "\o{001}" {#} m/\o{ 1 20 }{#}/', + => 'Non-octal character {#} m/\\o{ 1 {#}20 }/', + '/\x{ 5 0 }/' => 'Non-hex character \' \' terminates \x early. Resolved as "\x{05}" {#} m/\x{ 5 0 }{#}/', + => 'Non-hex character {#} m/\\x{ 5 {#}0 }/', ); # These need the character 'ネ' as a marker for mark_as_utf8() diff --git a/toke.c b/toke.c index cc8d060b2960..484dcbb00867 100644 --- a/toke.c +++ b/toke.c @@ -2714,7 +2714,7 @@ S_get_and_check_backslash_N_name_wrapper(pTHX_ const char* s, const char* const SV* Perl_get_and_check_backslash_N_name(pTHX_ const char* s, - const char* const e, + const char* e, const bool is_utf8, const char ** error_msg) { @@ -2744,6 +2744,14 @@ Perl_get_and_check_backslash_N_name(pTHX_ const char* s, assert(e >= s); assert(s > (char *) 3); + while (s < e && isBLANK(*s)) { + s++; + } + + while (s < e && isBLANK(*(e - 1))) { + e--; + } + char_name = newSVpvn_flags(s, e - s, (is_utf8) ? SVf_UTF8 : 0); if (!SvCUR(char_name)) { @@ -3589,7 +3597,8 @@ S_scan_const(pTHX_ char *start) if (*s == '\\' && s+1 < send) { char* bslash = s; /* point to beginning \ */ char* rbrace; /* point to ending '}' */ - + char* e; /* 1 past the meat (non-blanks) before the + brace */ s++; /* warn on \1 - \9 in substitution replacements, but note that \11 @@ -3830,6 +3839,14 @@ S_scan_const(pTHX_ char *start) } /* Here it looks like a named character */ + while (s < rbrace && isBLANK(*s)) { + s++; + } + + e = rbrace; + while (s < e && isBLANK(*(e - 1))) { + e--; + } if (*s == 'U' && s[1] == '+') { /* \N{U+...} */ s += 2; /* Skip to next char after the 'U+' */ @@ -3846,7 +3863,7 @@ S_scan_const(pTHX_ char *start) *d++ = '\0'; continue; } - while (++s < rbrace) { + while (++s < e) { if (isXDIGIT(*s)) continue; else if ((*s == '.' || *s == '_') @@ -3865,10 +3882,10 @@ S_scan_const(pTHX_ char *start) | PERL_SCAN_SILENT_ILLDIGIT | PERL_SCAN_SILENT_OVERFLOW | PERL_SCAN_DISALLOW_PREFIX; - STRLEN len = rbrace - s; + STRLEN len = e - s; uv = grok_hex(s, &len, &flags, NULL); - if (len == 0 || (len != (STRLEN)(rbrace - s))) + if (len == 0 || (len != (STRLEN)(e - s))) goto bad_NU; if ( uv > MAX_LEGAL_CP @@ -3925,7 +3942,7 @@ S_scan_const(pTHX_ char *start) } } else /* Here is \N{NAME} but not \N{U+...}. */ - if (! (res = get_and_check_backslash_N_name_wrapper(s, rbrace))) + if (! (res = get_and_check_backslash_N_name_wrapper(s, e))) { /* Failed. We should die eventually, but for now use a NUL to keep parsing */ *d++ = '\0'; @@ -4099,7 +4116,7 @@ S_scan_const(pTHX_ char *start) d = SvPVX(sv) + SvCUR(sv); } d_is_utf8 = TRUE; - } else if (len > (STRLEN)(rbrace - s + 4)) { /* +4 is for \N{} */ + } else if (len > (STRLEN)(e - s + 4)) { /* +4 is for \N{} */ /* See Note on sizing above. (NOTE: SvCUR() is not * set correctly here). */ From 8e8b1eab53331e23b80288f2b237a391490bdbe1 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Thu, 14 Jan 2021 08:03:21 -0700 Subject: [PATCH 462/503] regcomp.c: White-space and comments --- regcomp.c | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/regcomp.c b/regcomp.c index 4d56152c761a..30608745c2a2 100644 --- a/regcomp.c +++ b/regcomp.c @@ -13051,12 +13051,12 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, * sequence. *node_p will be set to a generated node returned by this * function calling S_reg(). * - * The final possibility is that it is premature to be calling this function; - * the parse needs to be restarted. This can happen when this changes from - * /d to /u rules, or when the pattern needs to be upgraded to UTF-8. The - * latter occurs only when the fifth possibility would otherwise be in - * effect, and is because one of those code points requires the pattern to be - * recompiled as UTF-8. The function returns FALSE, and sets the + * The sixth and final possibility is that it is premature to be calling this + * function; the parse needs to be restarted. This can happen when this + * changes from /d to /u rules, or when the pattern needs to be upgraded to + * UTF-8. The latter occurs only when the fifth possibility would otherwise + * be in effect, and is because one of those code points requires the pattern + * to be recompiled as UTF-8. The function returns FALSE, and sets the * RESTART_PARSE and NEED_UTF8 flags in *flagp, as appropriate. When this * happens, the caller needs to desist from continuing parsing, and return * this information to its caller. This is not set for when there is only one @@ -13342,7 +13342,8 @@ S_grok_bslash_N(pTHX_ RExC_state_t *pRExC_state, * only if that character is a dot separating code points, like a * multiple character sequence (of the form "\N{U+c1.c2. ... }". * So the next character must be a dot (and the one after that - * can't be the endbrace, or we'd have something like \N{U+100.} ) + * can't be the ending brace, or we'd have something like + * \N{U+100.} ) * */ if (*RExC_parse != '.' || RExC_parse + 1 >= e) { RExC_parse += (RExC_orig_utf8) /* point to after 1st invalid */ @@ -14064,12 +14065,12 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) /* Note we do NOT check if num == I32_MAX here, as that is * handled by the RExC_npar check */ - if ( - /* any numeric escape < 10 is always a backref */ - num > 9 - /* any numeric escape < RExC_npar is a backref */ + if ( /* any numeric escape < 10 is always a backref */ + num > 9 + /* any numeric escape < RExC_npar is a backref */ && num >= RExC_npar - /* cannot be an octal escape if it starts with [89] */ + /* cannot be an octal escape if it starts with [89] + * */ && ! inRANGE(*RExC_parse, '8', '9') ) { /* Probably not meant to be a backref, instead likely @@ -14095,6 +14096,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) else while (isDIGIT(*RExC_parse)) { RExC_parse++; } + if (num >= (I32)RExC_npar) { /* It might be a forward reference; we can't fail until we @@ -14493,6 +14495,7 @@ S_regatom(pTHX_ RExC_state_t *pRExC_state, I32 *flagp, U32 depth) goto loopdone; case '1': case '2': case '3':case '4': case '5': case '6': case '7': + /* When we parse backslash escapes there is ambiguity * between backreferences and octal escapes. Any escape * from \1 - \9 is a backreference, any multi-digit From 45ccb3081f160ba7c7492e0d3b19180989efd342 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 17:09:35 +0000 Subject: [PATCH 463/503] Module/CoreList.pm - fixup add missing comma --- dist/Module-CoreList/lib/Module/CoreList.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index d6a318249608..9364fb9512e6 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -18204,7 +18204,7 @@ for my $version ( sort { $a <=> $b } keys %released ) { 'Module::CoreList::Utils'=> '5.20210120', }, removed => { - } + }, } ); From 056eb89f46e3e7cf0605f0c79dc8dcae1508f201 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 17:26:25 +0000 Subject: [PATCH 464/503] Module/CoreList.pm - fixup add (correct) missing comma --- dist/Module-CoreList/lib/Module/CoreList.pm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 9364fb9512e6..2137e6924c19 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -18204,8 +18204,8 @@ for my $version ( sort { $a <=> $b } keys %released ) { 'Module::CoreList::Utils'=> '5.20210120', }, removed => { - }, - } + } + }, ); sub is_core From 35f4fa983ad813f733de669baa61ba6547e239c4 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 17:30:01 +0000 Subject: [PATCH 465/503] Update Module::CoreList for 5.33.6 --- dist/Module-CoreList/lib/Module/CoreList.pm | 94 +++++++++++++++++++++ 1 file changed, 94 insertions(+) diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 2137e6924c19..b0e58ed90a62 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -18199,9 +18199,103 @@ for my $version ( sort { $a <=> $b } keys %released ) { delta_from => 5.033005, changed => { 'B::Op_private' => '5.033006', + 'Carp' => '1.52', + 'Carp::Heavy' => '1.52', + 'Compress::Raw::Bzip2' => '2.100', + 'Compress::Raw::Zlib' => '2.100', + 'Compress::Zlib' => '2.100', 'Config' => '5.033006', + 'DynaLoader' => '1.50', + 'ExtUtils::Command' => '7.58', + 'ExtUtils::Command::MM' => '7.58', + 'ExtUtils::Liblist' => '7.58', + 'ExtUtils::Liblist::Kid'=> '7.58', + 'ExtUtils::MM' => '7.58', + 'ExtUtils::MM_AIX' => '7.58', + 'ExtUtils::MM_Any' => '7.58', + 'ExtUtils::MM_BeOS' => '7.58', + 'ExtUtils::MM_Cygwin' => '7.58', + 'ExtUtils::MM_DOS' => '7.58', + 'ExtUtils::MM_Darwin' => '7.58', + 'ExtUtils::MM_MacOS' => '7.58', + 'ExtUtils::MM_NW5' => '7.58', + 'ExtUtils::MM_OS2' => '7.58', + 'ExtUtils::MM_OS390' => '7.58', + 'ExtUtils::MM_QNX' => '7.58', + 'ExtUtils::MM_UWIN' => '7.58', + 'ExtUtils::MM_Unix' => '7.58', + 'ExtUtils::MM_VMS' => '7.58', + 'ExtUtils::MM_VOS' => '7.58', + 'ExtUtils::MM_Win32' => '7.58', + 'ExtUtils::MM_Win95' => '7.58', + 'ExtUtils::MY' => '7.58', + 'ExtUtils::MakeMaker' => '7.58', + 'ExtUtils::MakeMaker::Config'=> '7.58', + 'ExtUtils::MakeMaker::Locale'=> '7.58', + 'ExtUtils::MakeMaker::version'=> '7.58', + 'ExtUtils::MakeMaker::version::regex'=> '7.58', + 'ExtUtils::Manifest' => '1.73', + 'ExtUtils::Mkbootstrap' => '7.58', + 'ExtUtils::Mksymlists' => '7.58', + 'ExtUtils::testlib' => '7.58', + 'GDBM_File' => '1.19', + 'IO' => '1.45', + 'IO::Compress::Adapter::Bzip2'=> '2.100', + 'IO::Compress::Adapter::Deflate'=> '2.100', + 'IO::Compress::Adapter::Identity'=> '2.100', + 'IO::Compress::Base' => '2.100', + 'IO::Compress::Base::Common'=> '2.100', + 'IO::Compress::Bzip2' => '2.100', + 'IO::Compress::Deflate' => '2.100', + 'IO::Compress::Gzip' => '2.100', + 'IO::Compress::Gzip::Constants'=> '2.100', + 'IO::Compress::RawDeflate'=> '2.100', + 'IO::Compress::Zip' => '2.100', + 'IO::Compress::Zip::Constants'=> '2.100', + 'IO::Compress::Zlib::Constants'=> '2.100', + 'IO::Compress::Zlib::Extra'=> '2.100', + 'IO::Dir' => '1.45', + 'IO::File' => '1.45', + 'IO::Handle' => '1.45', + 'IO::Pipe' => '1.45', + 'IO::Poll' => '1.45', + 'IO::Seekable' => '1.45', + 'IO::Select' => '1.45', + 'IO::Socket' => '1.45', + 'IO::Socket::INET' => '1.45', + 'IO::Socket::UNIX' => '1.45', + 'IO::Uncompress::Adapter::Bunzip2'=> '2.100', + 'IO::Uncompress::Adapter::Identity'=> '2.100', + 'IO::Uncompress::Adapter::Inflate'=> '2.100', + 'IO::Uncompress::AnyInflate'=> '2.100', + 'IO::Uncompress::AnyUncompress'=> '2.100', + 'IO::Uncompress::Base' => '2.100', + 'IO::Uncompress::Bunzip2'=> '2.100', + 'IO::Uncompress::Gunzip'=> '2.100', + 'IO::Uncompress::Inflate'=> '2.100', + 'IO::Uncompress::RawInflate'=> '2.100', + 'IO::Uncompress::Unzip' => '2.100', 'Module::CoreList' => '5.20210120', 'Module::CoreList::Utils'=> '5.20210120', + 'Net::Cmd' => '3.13', + 'Net::Config' => '3.13', + 'Net::Domain' => '3.13', + 'Net::FTP' => '3.13', + 'Net::FTP::A' => '3.13', + 'Net::FTP::E' => '3.13', + 'Net::FTP::I' => '3.13', + 'Net::FTP::L' => '3.13', + 'Net::FTP::dataconn' => '3.13', + 'Net::NNTP' => '3.13', + 'Net::Netrc' => '3.13', + 'Net::POP3' => '3.13', + 'Net::SMTP' => '3.13', + 'Net::Time' => '3.13', + 'POSIX' => '1.97', + 'Socket' => '2.031', + 'XS::APItest' => '1.15', + 'feature' => '1.62', + 'warnings' => '1.50', }, removed => { } From fdc72a2ae4cb8074c5d777e03be987caa8f46b0e Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 18:22:43 +0000 Subject: [PATCH 466/503] Finalize perldelta.pod for 5.33.6 --- pod/perldelta.pod | 147 ++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 124 insertions(+), 23 deletions(-) diff --git a/pod/perldelta.pod b/pod/perldelta.pod index c514b12c4776..0ee662a8e859 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -14,10 +14,10 @@ L, which describes differences between 5.33.4 and 5.33.5. =head1 Core Enhancements -=head2 C is now accepted. +=head2 C is now accepted An empty lower bound is now accepted for regular expression quantifiers, -like C<{,3}> +like C<{,3}>. =head2 Blanks freely allowed within but adjacent to curly braces @@ -35,7 +35,9 @@ regular expression pattern modifier. Additionally, the comma in a regular expression braced quantifier may have blanks (tabs or spaces) before and/or after the comma, like -S> +S>. + +=head1 Modules and Pragmata =head2 Updated Modules and Pragmata @@ -43,10 +45,82 @@ S> =item * +L has been upgraded from version 1.51 to 1.52. + +=item * + +L has been upgraded from version 2.096 to 2.100. + +=item * + +L has been upgraded from version 2.096 to 2.100. + +=item * + +L has been upgraded from version 1.49 to 1.50. + +=item * + +L has been upgraded from version 7.56 to 7.58. + +=item * + +L has been upgraded from version 1.72 to 1.73. + +=item * + L has been upgraded from version 1.61 to 1.62. Added the default enabled C feature. +=item * + +L has been upgraded from version 1.18 to 1.19. + +New functions and compatibility for newer versions of GDBM. +[L] + +=item * + +L has been upgraded from version 1.44 to 1.45. + +IO::Socket now stores error messages in C<$IO::Socket::errstr>, in +addition to in C<$@>. + +=item * + +IO-Compress has been upgraded from version 2.096 to 2.100. + +=item * + +libnet has been upgraded from version 3.12 to 3.13. + +=item * + +L has been upgraded from version 5.20201220 to 5.20210120. + +=item * + +L has been upgraded from version 1.96 to 1.97. + +POSIX::signbit() behaviour has been improved. +[L] + +Documentation for C clarifies that the result is always in English. +(Use C for a localized result.) + +=item * + +L has been upgraded from version 2.030 to 2.031. + +=item * + +L has been upgraded from version 1.49 to 1.50. + +=item * + +L has been upgraded from version 1.14 to 1.15. + =back =head1 Documentation @@ -96,8 +170,8 @@ also states that the result of the function is always in English. =item * -A new example shows how a lexical 'my' variable can be declared -during the initialization of a 'for' loop. +A new example shows how a lexical C variable can be declared +during the initialization of a C loop. =back @@ -145,7 +219,7 @@ L This warning was only issued for positive too-large values when incrementing, and only for negative ones when decrementing. -It is now issued for both of positive or negative too-large values. +It is now issued for both positive or negative too-large values. [L] =back @@ -156,7 +230,8 @@ It is now issued for both of positive or negative too-large values. =item * Configure -A new probe tests for buggy implementations of the gcvt/qgcvt functions. +A new probe checks for buggy libc implementations of the C/C +functions. [L] =back @@ -171,12 +246,12 @@ made: =item * -t/re/opt.t was added, providing a test harness for regexp optimization. +F was added, providing a test harness for regexp optimization. [L] =item * -A workaround for CPAN distributions needing dot in @INC has been removed +A workaround for CPAN distributions needing dot in C<@INC> has been removed [L]. All distributions that previously required the workaround have now been adapted. @@ -192,17 +267,17 @@ adapted. =item Mac OS X A number of system libraries no longer exist as actual files on Big Sur, -even though dlopen will pretend they do, so now we fall back to dlopen +even though C will pretend they do, so now we fall back to C if a library file can not be found. [L] =item MS Windows -perl can now be built with USE_QUADMATH on MS Windows using +perl can now be built with C on MS Windows using (32-bit and 64-bit) mingw-w64 ports of gcc. [L] -THe pl2bat.pl utility now needs access to ExtUtils::PL2Bat. This could +The F utility now needs to C. This could cause failures in parallel builds. =back @@ -227,39 +302,65 @@ now skipped for such op trees. This also addresses [L] Buggy libc implementations of the C and C functions -caused (s)printf to incorrectly truncated %g formatted numbers. A new -Configure probe now checks for this, with the result that the libc +caused C<(s)printf> to incorrectly truncate C<%g> formatted numbers. +A new Configure probe now checks for this, with the result that the libc C will be used in place of C and C. Tests added as part of this fix also revealed related problems in some Windows builds. The makefiles for MINGW builds on Windows have -thus been adjusted to use USE_MINGW_ANSI_STDIO by default, ensuring -that such builds also provide correct (s)printf formatting of numbers. +thus been adjusted to use USE_MINGW_ANSI_STDIO by default, ensuring +that they also provide correct C<(s)printf> formatting of numbers. =item * op.c: croak on "my $_" when "use utf8" is in effect [L] -The lexical topic () feature experiment was removed in Perl v5.24 and -declaring C became a compile time error. However, it was still -possible to make this declaration if utf8 was in effect. +The lexical topic feature experiment was removed in Perl v5.24 and +declaring C became a compile time error. However, it was previously +still possible to make this declaration if C was in effect. =item * regexec.c: Fix assertion failure [L] -Fuzzing triggered an assertion failure when too many characters were -copied into a buffer. +Fuzzing triggered an assertion failure in the regexp engine when too many +characters were copied into a buffer. =back =head1 Acknowledgements -XXX Generate this with: +Perl 5.33.6 represents approximately 4 weeks of development since Perl +5.33.5 and contains approximately 96,000 lines of changes across 450 files +from 26 authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 85,000 lines of changes to 320 .pm, .t, .c and .h files. + +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.6: + +Branislav Zahradník, Chris 'BinGOs' Williams, Craig A. Berry, Dan Book, +Daniel Böhmer, Daniel Laügt, Felipe Gasper, Hugo van der Sanden, James E +Keenan, Kang-min Liu, Karen Etheridge, Karl Williamson, Leon Timmermans, Max +Maischein, Michael G Schwern, Paul Evans, Ricardo Signes, Richard Leach, +Sawyer X, Sergey Poznyakoff, Sisyphus, Steve Hay, TAKAI Kousuke, Tomasz +Konojacki, Tom Hukins, Tony Cook. + +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. - perl Porting/acknowledgements.pl v5.33.5..HEAD +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. =head1 Reporting Bugs From 7b99455fe0a347ad42afab1cd66997f231344818 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Wed, 20 Jan 2021 18:25:42 +0000 Subject: [PATCH 467/503] add new release to perlhist --- pod/perlhist.pod | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 23c7f9888e56..71ecae3f61b1 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -34,7 +34,8 @@ Chris C Williams, Zefram, Ævar Arnfjörð Bjarmason, Stevan Little, Dave Rolsky, Max Maischein, Abigail, Jesse Luehrs, Tony Cook, Dominic Hargreaves, Aaron Crane, Aristotle Pagaltzis, Matthew Horsfall, Peter Martini, Sawyer X, Chad 'Exodist' Granum, Renee Bäcker, Eric Herman, -John SJ Anderson, Karen Etheridge, Zak B. Elep, and Tom Hukins. +John SJ Anderson, Karen Etheridge, Zak B. Elep, Tom Hukins, and Richard +Leach. =head2 PUMPKIN? @@ -702,6 +703,7 @@ the strings?). Steve 5.33.3 2020-Oct-20 Tom H 5.33.4 2020-Nov-20 Max M 5.33.5 2020-Dec-20 + Richard L 5.33.6 2021-Jan-20 =head2 SELECTED RELEASE SIZES From 9e0f024cf71eded2c402a3fc99e8ec6cf311b433 Mon Sep 17 00:00:00 2001 From: Andy Dougherty Date: Wed, 20 Jan 2021 10:20:09 -0500 Subject: [PATCH 468/503] Declare myself an inactive core developer for the present. --- pod/perlgov.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pod/perlgov.pod b/pod/perlgov.pod index 64ba6105802e..e6367714f1e8 100644 --- a/pod/perlgov.pod +++ b/pod/perlgov.pod @@ -474,7 +474,7 @@ The current members of the Perl Core Team are: =item * Abhijit Menon-Sen (inactive) -=item * Andy Dougherty +=item * Andy Dougherty (inactive) =item * Chad Granum From 52208a2c63d49fa37f5ba710f682ff427c74b4a4 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 01:57:41 +0000 Subject: [PATCH 469/503] Update epigraphs.pod with 5.33.6 entry --- Porting/epigraphs.pod | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 90e9e20dcaf8..235d0acbc92e 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -17,6 +17,14 @@ Consult your favorite dictionary for details. =head1 EPIGRAPHS +=head2 v5.33.6 - Edward R. Murrow + +L + + This instrument can teach, it can illuminate; yes, and it can even + inspire. But it can do so only to the extent that humans are determined + to use it to those ends. Otherwise it is merely wires and lights in a box. + =head2 v5.33.5 - Max Weber, (from "Understanding Administration", by Wolfgang Seibel) L From 2fc637b5ccae74ab098be6d1dabc016562bda21d Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 02:00:12 +0000 Subject: [PATCH 470/503] release_schedule.pod - tick off 5.33.6 release --- Porting/release_schedule.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 21ba9a1c6fc3..939baddafe34 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -45,7 +45,7 @@ you should reset the version numbers to the next blead series. 2020-10-20 5.33.3 ✓ Steve Hay 2020-11-20 5.33.4 ✓ Tom Hukins 2020-12-20 5.33.5 ✓ Max Maischein - 2021-01-20 5.33.6 Richard Leach + 2021-01-20 5.33.6 ✓ Richard Leach 2021-02-20 5.33.7 Renee Backer 2021-03-20 5.33.8 Atoomic 2021-04-20 5.33.9 Todd Rinaldo From 3d4bd5710bee9126a9110b4703f15b02ddf917a0 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 02:19:23 +0000 Subject: [PATCH 471/503] New perldelta for 5.33.7 --- MANIFEST | 1 + Makefile.SH | 8 +- pod/.gitignore | 2 +- pod/perl.pod | 1 + pod/perl5336delta.pod | 400 ++++++++++++++++++++++++++++++++++++++ pod/perldelta.pod | 403 ++++++++++++++++++++++----------------- vms/descrip_mms.template | 2 +- win32/GNUmakefile | 4 +- win32/Makefile | 4 +- win32/makefile.mk | 4 +- win32/pod.mak | 4 + 11 files changed, 641 insertions(+), 192 deletions(-) create mode 100644 pod/perl5336delta.pod diff --git a/MANIFEST b/MANIFEST index 134a4ac36292..d094c3e8c624 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5233,6 +5233,7 @@ pod/perl5332delta.pod Perl changes in version 5.33.2 pod/perl5333delta.pod Perl changes in version 5.33.3 pod/perl5334delta.pod Perl changes in version 5.33.4 pod/perl5335delta.pod Perl changes in version 5.33.5 +pod/perl5336delta.pod Perl changes in version 5.33.6 pod/perl561delta.pod Perl changes in version 5.6.1 pod/perl56delta.pod Perl changes in version 5.6 pod/perl581delta.pod Perl changes in version 5.8.1 diff --git a/Makefile.SH b/Makefile.SH index ba8d9bd19d3c..7ff2b144f670 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -589,7 +589,7 @@ esac $spitshell >>$Makefile <<'!NO!SUBS!' -perltoc_pod_prereqs = extra.pods pod/perl5336delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod +perltoc_pod_prereqs = extra.pods pod/perl5337delta.pod pod/perlapi.pod pod/perlintern.pod pod/perlmodlib.pod pod/perluniprops.pod generated_pods = pod/perltoc.pod $(perltoc_pod_prereqs) generated_headers = uudmap.h bitcount.h mg_data.h @@ -1153,9 +1153,9 @@ pod/perlintern.pod: $(MINIPERL_EXE) autodoc.pl embed.fnc pod/perlmodlib.pod: $(MINIPERL_EXE) pod/perlmodlib.PL MANIFEST $(MINIPERL) pod/perlmodlib.PL -q -pod/perl5336delta.pod: pod/perldelta.pod - $(RMS) pod/perl5336delta.pod - $(LNS) perldelta.pod pod/perl5336delta.pod +pod/perl5337delta.pod: pod/perldelta.pod + $(RMS) pod/perl5337delta.pod + $(LNS) perldelta.pod pod/perl5337delta.pod extra.pods: $(MINIPERL_EXE) -@test ! -f extra.pods || rm -f `cat extra.pods` diff --git a/pod/.gitignore b/pod/.gitignore index 5ff5f607bca6..c8d7ad839d4a 100644 --- a/pod/.gitignore +++ b/pod/.gitignore @@ -48,7 +48,7 @@ /roffitall # generated -/perl5336delta.pod +/perl5337delta.pod /perlapi.pod /perlintern.pod /perlmodlib.pod diff --git a/pod/perl.pod b/pod/perl.pod index b9503d53fe07..73877f150751 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -184,6 +184,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perlhist Perl history records perldelta Perl changes since previous version + perl5336delta Perl changes in version 5.33.6 perl5335delta Perl changes in version 5.33.5 perl5334delta Perl changes in version 5.33.4 perl5333delta Perl changes in version 5.33.3 diff --git a/pod/perl5336delta.pod b/pod/perl5336delta.pod new file mode 100644 index 000000000000..9d5a2f9f79d5 --- /dev/null +++ b/pod/perl5336delta.pod @@ -0,0 +1,400 @@ +=encoding utf8 + +=head1 NAME + +perl5336delta - what is new for perl v5.33.6 + +=head1 DESCRIPTION + +This document describes differences between the 5.33.5 release and the +5.33.6 release. + +If you are upgrading from an earlier release such as 5.33.4, first read +L, which describes differences between 5.33.4 and 5.33.5. + +=head1 Core Enhancements + +=head2 C is now accepted + +An empty lower bound is now accepted for regular expression quantifiers, +like C<{,3}>. + +=head2 Blanks freely allowed within but adjacent to curly braces + +(in double-quotish contexts and regular expression patterns) + +This means you can write things like S> if you like. This +applies to all such constructs, namely C<\b{}>, C<\g{}>, C<\k{}>, +C<\N{}>, C<\o{}>, and C<\x{}>; as well as the regular expression +quantifier C<{I,I}>. C<\p{}> and C<\P{}> retain their +already-existing, even looser, rules mandated by the Unicode standard +(see L). + +This ability is in effect regardless of the presence of the C +regular expression pattern modifier. + +Additionally, the comma in a regular expression braced quantifier may +have blanks (tabs or spaces) before and/or after the comma, like +S>. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 1.51 to 1.52. + +=item * + +L has been upgraded from version 2.096 to 2.100. + +=item * + +L has been upgraded from version 2.096 to 2.100. + +=item * + +L has been upgraded from version 1.49 to 1.50. + +=item * + +L has been upgraded from version 7.56 to 7.58. + +=item * + +L has been upgraded from version 1.72 to 1.73. + +=item * + +L has been upgraded from version 1.61 to 1.62. + +Added the default enabled C feature. + +=item * + +L has been upgraded from version 1.18 to 1.19. + +New functions and compatibility for newer versions of GDBM. +[L] + +=item * + +L has been upgraded from version 1.44 to 1.45. + +IO::Socket now stores error messages in C<$IO::Socket::errstr>, in +addition to in C<$@>. + +=item * + +IO-Compress has been upgraded from version 2.096 to 2.100. + +=item * + +libnet has been upgraded from version 3.12 to 3.13. + +=item * + +L has been upgraded from version 5.20201220 to 5.20210120. + +=item * + +L has been upgraded from version 1.96 to 1.97. + +POSIX::signbit() behaviour has been improved. +[L] + +Documentation for C clarifies that the result is always in English. +(Use C for a localized result.) + +=item * + +L has been upgraded from version 2.030 to 2.031. + +=item * + +L has been upgraded from version 1.49 to 1.50. + +=item * + +L has been upgraded from version 1.14 to 1.15. + +=back + +=head1 Documentation + +=head2 New Documentation + +=head3 L + +This document describes the goals, scope, system, and rules for Perl's new +governance model. + +Other pod files, most notably L, were amended to reflect +its adoption. + +=head2 Changes to Existing Documentation + +We have attempted to update the documentation to reflect the changes +listed in this document. If you find any we have missed, open an issue +at L. + +Additionally, the following selected changes have been made: + +=head3 L + +=over 4 + +=item * + +The freenode IRC URL has been updated. + +=back + +=head3 L + +=over 4 + +=item * + +The L entry has been improved and now +also states that the result of the function is always in English. + +=back + +=head3 L + +=over 4 + +=item * + +A new example shows how a lexical C variable can be declared +during the initialization of a C loop. + +=back + +=head1 Diagnostics + +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. + +=head2 New Diagnostics + +=head3 New Errors + +=over 4 + +=item * + +L + +This accompanies the new L feature. + +=back + +=head2 Changes to Existing Diagnostics + +=over 4 + +=item * + +L + +Subroutine argument-count mismatch errors now include the number of +given and expected arguments. + +=item * + +L + +Subroutine argument-count mismatch errors now include the number of +given and expected arguments. + +=item * + +L + +This warning was only issued for positive too-large values when +incrementing, and only for negative ones when decrementing. +It is now issued for both positive or negative too-large values. +[L] + +=back + +=head1 Configuration and Compilation + +=over 4 + +=item * Configure + +A new probe checks for buggy libc implementations of the C/C +functions. +[L] + +=back + +=head1 Testing + +Tests were added and changed to reflect the other additions and +changes in this release. Furthermore, these significant changes were +made: + +=over 4 + +=item * + +F was added, providing a test harness for regexp optimization. +[L] + +=item * + +A workaround for CPAN distributions needing dot in C<@INC> has been removed +[L]. +All distributions that previously required the workaround have now been +adapted. + +=back + +=head1 Platform Support + +=head2 Platform-Specific Notes + +=over 4 + +=item Mac OS X + +A number of system libraries no longer exist as actual files on Big Sur, +even though C will pretend they do, so now we fall back to C +if a library file can not be found. +[L] + +=item MS Windows + +perl can now be built with C on MS Windows using +(32-bit and 64-bit) mingw-w64 ports of gcc. +[L] + +The F utility now needs to C. This could +cause failures in parallel builds. + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +Skip trying to constant fold an incomplete op tree +[L] + +Constant folding of chained comparison op trees could fail under certain +conditions, causing perl to crash. As a quick fix, constant folding is +now skipped for such op trees. This also addresses +[L]. + +=item * + +%g formatting broken on Ubuntu-18.04, NVSIZE == 8 +[L] + +Buggy libc implementations of the C and C functions +caused C<(s)printf> to incorrectly truncate C<%g> formatted numbers. +A new Configure probe now checks for this, with the result that the libc +C will be used in place of C and C. + +Tests added as part of this fix also revealed related problems in +some Windows builds. The makefiles for MINGW builds on Windows have +thus been adjusted to use USE_MINGW_ANSI_STDIO by default, ensuring +that they also provide correct C<(s)printf> formatting of numbers. + +=item * + +op.c: croak on "my $_" when "use utf8" is in effect +[L] + +The lexical topic feature experiment was removed in Perl v5.24 and +declaring C became a compile time error. However, it was previously +still possible to make this declaration if C was in effect. + +=item * + +regexec.c: Fix assertion failure +[L] + +Fuzzing triggered an assertion failure in the regexp engine when too many +characters were copied into a buffer. + +=back + +=head1 Acknowledgements + +Perl 5.33.6 represents approximately 4 weeks of development since Perl +5.33.5 and contains approximately 96,000 lines of changes across 450 files +from 26 authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 85,000 lines of changes to 320 .pm, .t, .c and .h files. + +Perl continues to flourish into its fourth decade thanks to a vibrant +community of users and developers. The following people are known to have +contributed the improvements that became Perl 5.33.6: + +Branislav Zahradník, Chris 'BinGOs' Williams, Craig A. Berry, Dan Book, +Daniel Böhmer, Daniel Laügt, Felipe Gasper, Hugo van der Sanden, James E +Keenan, Kang-min Liu, Karen Etheridge, Karl Williamson, Leon Timmermans, Max +Maischein, Michael G Schwern, Paul Evans, Ricardo Signes, Richard Leach, +Sawyer X, Sergey Poznyakoff, Sisyphus, Steve Hay, TAKAI Kousuke, Tomasz +Konojacki, Tom Hukins, Tony Cook. + +The list above is almost certainly incomplete as it is automatically +generated from version control history. In particular, it does not include +the names of the (very much appreciated) contributors who reported issues to +the Perl bug tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. + +For a more complete list of all of Perl's historical contributors, please +see the F file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the perl bug database +at L. There may also be information at +L, the Perl Home Page. + +If you believe you have an unreported bug, please open an issue at +L. Be sure to trim your bug down to a +tiny but sufficient test case. + +If the bug you are reporting has security implications which make it +inappropriate to send to a public issue tracker, then see +L +for details of how to report the issue. + +=head1 Give Thanks + +If you wish to thank the Perl 5 Porters for the work we had done in Perl 5, +you can do so by running the C program: + + perlthanks + +This will send an email to the Perl 5 Porters list with your show of thanks. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/pod/perldelta.pod b/pod/perldelta.pod index 0ee662a8e859..b2f4d8bbb02c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -2,138 +2,157 @@ =head1 NAME -perldelta - what is new for perl v5.33.6 +[ this is a template for a new perldelta file. Any text flagged as XXX needs +to be processed before release. ] + +perldelta - what is new for perl v5.33.7 =head1 DESCRIPTION -This document describes differences between the 5.33.5 release and the -5.33.6 release. +This document describes differences between the 5.33.6 release and the 5.33.7 +release. -If you are upgrading from an earlier release such as 5.33.4, first read -L, which describes differences between 5.33.4 and 5.33.5. +If you are upgrading from an earlier release such as 5.33.5, first read +L, which describes differences between 5.33.5 and 5.33.6. -=head1 Core Enhancements +=head1 Notice -=head2 C is now accepted +XXX Any important notices here -An empty lower bound is now accepted for regular expression quantifiers, -like C<{,3}>. +=head1 Core Enhancements -=head2 Blanks freely allowed within but adjacent to curly braces +XXX New core language features go here. Summarize user-visible core language +enhancements. Particularly prominent performance optimisations could go +here, but most should go in the L section. -(in double-quotish contexts and regular expression patterns) +[ List each enhancement as a =head2 entry ] -This means you can write things like S> if you like. This -applies to all such constructs, namely C<\b{}>, C<\g{}>, C<\k{}>, -C<\N{}>, C<\o{}>, and C<\x{}>; as well as the regular expression -quantifier C<{I,I}>. C<\p{}> and C<\P{}> retain their -already-existing, even looser, rules mandated by the Unicode standard -(see L). +=head1 Security -This ability is in effect regardless of the presence of the C -regular expression pattern modifier. +XXX Any security-related notices go here. In particular, any security +vulnerabilities closed should be noted here rather than in the +L section. -Additionally, the comma in a regular expression braced quantifier may -have blanks (tabs or spaces) before and/or after the comma, like -S>. +[ List each security issue as a =head2 entry ] -=head1 Modules and Pragmata +=head1 Incompatible Changes -=head2 Updated Modules and Pragmata - -=over 4 +XXX For a release on a stable branch, this section aspires to be: -=item * + There are no changes intentionally incompatible with 5.XXX.XXX + If any exist, they are bugs, and we request that you submit a + report. See L below. -L has been upgraded from version 1.51 to 1.52. +[ List each incompatible change as a =head2 entry ] -=item * +=head1 Deprecations -L has been upgraded from version 2.096 to 2.100. +XXX Any deprecated features, syntax, modules etc. should be listed here. -=item * +=head2 Module removals -L has been upgraded from version 2.096 to 2.100. +XXX Remove this section if not applicable. -=item * +The following modules will be removed from the core distribution in a +future release, and will at that time need to be installed from CPAN. +Distributions on CPAN which require these modules will need to list them as +prerequisites. -L has been upgraded from version 1.49 to 1.50. +The core versions of these modules will now issue C<"deprecated">-category +warnings to alert you to this fact. To silence these deprecation warnings, +install the modules in question from CPAN. -=item * +Note that these are (with rare exceptions) fine modules that you are encouraged +to continue to use. Their disinclusion from core primarily hinges on their +necessity to bootstrapping a fully functional, CPAN-capable Perl installation, +not usually on concerns over their design. -L has been upgraded from version 7.56 to 7.58. +=over -=item * +=item XXX -L has been upgraded from version 1.72 to 1.73. +XXX Note that deprecated modules should be listed here even if they are listed +as an updated module in the L section. -=item * +=back -L has been upgraded from version 1.61 to 1.62. +[ List each other deprecation as a =head2 entry ] -Added the default enabled C feature. +=head1 Performance Enhancements -=item * +XXX Changes which enhance performance without changing behaviour go here. +There may well be none in a stable release. -L has been upgraded from version 1.18 to 1.19. +[ List each enhancement as an =item entry ] -New functions and compatibility for newer versions of GDBM. -[L] +=over 4 =item * -L has been upgraded from version 1.44 to 1.45. +XXX -IO::Socket now stores error messages in C<$IO::Socket::errstr>, in -addition to in C<$@>. +=back -=item * +=head1 Modules and Pragmata -IO-Compress has been upgraded from version 2.096 to 2.100. +XXX All changes to installed files in F, F, F and F +go here. If Module::CoreList is updated, generate an initial draft of the +following sections using F. A paragraph summary +for important changes should then be added by hand. In an ideal world, +dual-life modules would have a F file that could be cribbed. -=item * +The list of new and updated modules is modified automatically as part of +preparing a Perl release, so the only reason to manually add entries here is if +you're summarising the important changes in the module update. (Also, if the +manually-added details don't match the automatically-generated ones, the +release manager will have to investigate the situation carefully.) -libnet has been upgraded from version 3.12 to 3.13. +[ Within each section, list entries as an =item entry ] -=item * +=head2 New Modules and Pragmata -L has been upgraded from version 5.20201220 to 5.20210120. +=over 4 =item * -L has been upgraded from version 1.96 to 1.97. +XXX Remove this section if not applicable. + +=back -POSIX::signbit() behaviour has been improved. -[L] +=head2 Updated Modules and Pragmata -Documentation for C clarifies that the result is always in English. -(Use C for a localized result.) +=over 4 =item * -L has been upgraded from version 2.030 to 2.031. +L has been upgraded from version A.xx to B.yy. -=item * +If there was something important to note about this change, include that here. + +=back -L has been upgraded from version 1.49 to 1.50. +=head2 Removed Modules and Pragmata + +=over 4 =item * -L has been upgraded from version 1.14 to 1.15. +XXX =back =head1 Documentation +XXX Changes to files in F go here. Consider grouping entries by +file and be sure to link to the appropriate page, e.g. L. + =head2 New Documentation -=head3 L +XXX Changes which create B files in F go here. -This document describes the goals, scope, system, and rules for Perl's new -governance model. +=head3 L -Other pod files, most notably L, were amended to reflect -its adoption. +XXX Description of the purpose of the new file here =head2 Changes to Existing Documentation @@ -141,226 +160,250 @@ We have attempted to update the documentation to reflect the changes listed in this document. If you find any we have missed, open an issue at L. +XXX Changes which significantly change existing files in F go here. +However, any changes to F should go in the L +section. + Additionally, the following selected changes have been made: -=head3 L +=head3 L =over 4 =item * -The freenode IRC URL has been updated. +XXX Description of the change here =back -=head3 L +=head1 Diagnostics -=over 4 +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. -=item * +XXX New or changed warnings emitted by the core's C code go here. Also +include any changes in L that reconcile it to the C code. -The L entry has been improved and now -also states that the result of the function is always in English. +=head2 New Diagnostics -=back +XXX Newly added diagnostic messages go under here, separated into New Errors +and New Warnings -=head3 L +=head3 New Errors =over 4 =item * -A new example shows how a lexical C variable can be declared -during the initialization of a C loop. +XXX L =back -=head1 Diagnostics - -The following additions or changes have been made to diagnostic output, -including warnings and fatal error messages. For the complete list of -diagnostic messages, see L. - -=head2 New Diagnostics - -=head3 New Errors +=head3 New Warnings =over 4 =item * -L - -This accompanies the new L feature. +XXX L =back =head2 Changes to Existing Diagnostics +XXX Changes (i.e. rewording) of diagnostic messages go here + =over 4 =item * -L +XXX Describe change here -Subroutine argument-count mismatch errors now include the number of -given and expected arguments. +=back -=item * +=head1 Utility Changes -L +XXX Changes to installed programs such as F and F go here. +Most of these are built within the directory F. -Subroutine argument-count mismatch errors now include the number of -given and expected arguments. +[ List utility changes as a =head2 entry for each utility and =item +entries for each change +Use L with program names to get proper documentation linking. ] -=item * +=head2 L -L +=over 4 -This warning was only issued for positive too-large values when -incrementing, and only for negative ones when decrementing. -It is now issued for both positive or negative too-large values. -[L] +=item * + +XXX =back =head1 Configuration and Compilation +XXX Changes to F, F, F, and analogous tools +go here. Any other changes to the Perl build process should be listed here. +However, any platform-specific changes should be listed in the +L section, instead. + +[ List changes as an =item entry ]. + =over 4 -=item * Configure +=item * -A new probe checks for buggy libc implementations of the C/C -functions. -[L] +XXX =back =head1 Testing +XXX Any significant changes to the testing of a freshly built perl should be +listed here. Changes which create B files in F go here as do any +large changes to the testing harness (e.g. when parallel testing was added). +Changes to existing files in F aren't worth summarizing, although the bugs +that they represent may be covered elsewhere. + +XXX If there were no significant test changes, say this: + +Tests were added and changed to reflect the other additions and changes +in this release. + +XXX If instead there were significant changes, say this: + Tests were added and changed to reflect the other additions and changes in this release. Furthermore, these significant changes were made: +[ List each test improvement as an =item entry ] + =over 4 =item * -F was added, providing a test harness for regexp optimization. -[L] +XXX -=item * +=back + +=head1 Platform Support + +XXX Any changes to platform support should be listed in the sections below. + +[ Within the sections, list each platform as an =item entry with specific +changes as paragraphs below it. ] + +=head2 New Platforms -A workaround for CPAN distributions needing dot in C<@INC> has been removed -[L]. -All distributions that previously required the workaround have now been -adapted. +XXX List any platforms that this version of perl compiles on, that previous +versions did not. These will either be enabled by new files in the F +directories, or new subdirectories and F files at the top level of the +source tree. + +=over 4 + +=item XXX-some-platform + +XXX =back -=head1 Platform Support +=head2 Discontinued Platforms -=head2 Platform-Specific Notes +XXX List any platforms that this version of perl no longer compiles on. =over 4 -=item Mac OS X +=item XXX-some-platform -A number of system libraries no longer exist as actual files on Big Sur, -even though C will pretend they do, so now we fall back to C -if a library file can not be found. -[L] +XXX -=item MS Windows +=back + +=head2 Platform-Specific Notes -perl can now be built with C on MS Windows using -(32-bit and 64-bit) mingw-w64 ports of gcc. -[L] +XXX List any changes for specific platforms. This could include configuration +and compilation changes or changes in portability/compatibility. However, +changes within modules for platforms should generally be listed in the +L section. -The F utility now needs to C. This could -cause failures in parallel builds. +=over 4 + +=item XXX-some-platform + +XXX =back -=head1 Selected Bug Fixes +=head1 Internal Changes + +XXX Changes which affect the interface available to C code go here. Other +significant internal changes for future core maintainers should be noted as +well. + +[ List each change as an =item entry ] =over 4 =item * -Skip trying to constant fold an incomplete op tree -[L] +XXX -Constant folding of chained comparison op trees could fail under certain -conditions, causing perl to crash. As a quick fix, constant folding is -now skipped for such op trees. This also addresses -[L]. +=back -=item * +=head1 Selected Bug Fixes -%g formatting broken on Ubuntu-18.04, NVSIZE == 8 -[L] +XXX Important bug fixes in the core language are summarized here. Bug fixes in +files in F and F are best summarized in L. -Buggy libc implementations of the C and C functions -caused C<(s)printf> to incorrectly truncate C<%g> formatted numbers. -A new Configure probe now checks for this, with the result that the libc -C will be used in place of C and C. +[ List each fix as an =item entry ] -Tests added as part of this fix also revealed related problems in -some Windows builds. The makefiles for MINGW builds on Windows have -thus been adjusted to use USE_MINGW_ANSI_STDIO by default, ensuring -that they also provide correct C<(s)printf> formatting of numbers. +=over 4 =item * -op.c: croak on "my $_" when "use utf8" is in effect -[L] +XXX -The lexical topic feature experiment was removed in Perl v5.24 and -declaring C became a compile time error. However, it was previously -still possible to make this declaration if C was in effect. +=back -=item * +=head1 Known Problems + +XXX Descriptions of platform agnostic bugs we know we can't fix go here. Any +tests that had to be Ced for the release would be noted here. Unfixed +platform specific bugs also go here. -regexec.c: Fix assertion failure -[L] +[ List each fix as an =item entry ] -Fuzzing triggered an assertion failure in the regexp engine when too many -characters were copied into a buffer. +=over 4 + +=item * + +XXX =back -=head1 Acknowledgements +=head1 Errata From Previous Releases -Perl 5.33.6 represents approximately 4 weeks of development since Perl -5.33.5 and contains approximately 96,000 lines of changes across 450 files -from 26 authors. +=over 4 + +=item * -Excluding auto-generated files, documentation and release tools, there were -approximately 85,000 lines of changes to 320 .pm, .t, .c and .h files. +XXX Add anything here that we forgot to add, or were mistaken about, in +the perldelta of a previous release. -Perl continues to flourish into its fourth decade thanks to a vibrant -community of users and developers. The following people are known to have -contributed the improvements that became Perl 5.33.6: +=back + +=head1 Obituary -Branislav Zahradník, Chris 'BinGOs' Williams, Craig A. Berry, Dan Book, -Daniel Böhmer, Daniel Laügt, Felipe Gasper, Hugo van der Sanden, James E -Keenan, Kang-min Liu, Karen Etheridge, Karl Williamson, Leon Timmermans, Max -Maischein, Michael G Schwern, Paul Evans, Ricardo Signes, Richard Leach, -Sawyer X, Sergey Poznyakoff, Sisyphus, Steve Hay, TAKAI Kousuke, Tomasz -Konojacki, Tom Hukins, Tony Cook. +XXX If any significant core contributor or member of the CPAN community has +died, add a short obituary here. -The list above is almost certainly incomplete as it is automatically -generated from version control history. In particular, it does not include -the names of the (very much appreciated) contributors who reported issues to -the Perl bug tracker. +=head1 Acknowledgements -Many of the changes included in this version originated in the CPAN modules -included in Perl's core. We're grateful to the entire CPAN community for -helping Perl to flourish. +XXX Generate this with: -For a more complete list of all of Perl's historical contributors, please -see the F file in the Perl source distribution. + perl Porting/acknowledgements.pl v5.33.6..HEAD =head1 Reporting Bugs diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 925d2c34ca76..126d741a09da 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -313,7 +313,7 @@ utils : $(utils1) $(utils2) $(utils3) $(utils4) $(utils5) extra.pods : miniperl @ @extra_pods.com -PERLDELTA_CURRENT = [.pod]perl5336delta.pod +PERLDELTA_CURRENT = [.pod]perl5337delta.pod $(PERLDELTA_CURRENT) : [.pod]perldelta.pod Copy/NoConfirm/Log $(MMS$SOURCE) $(PERLDELTA_CURRENT) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index af0fdf45045c..98510dbe66c2 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1776,7 +1776,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5337delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1874,7 +1874,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5337delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/Makefile b/win32/Makefile index 4986f0b230c7..7f4ebccd9d4a 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -1240,7 +1240,7 @@ utils: $(PERLEXE) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5337delta.pod cd ..\win32 $(PERLEXE) $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. @@ -1339,7 +1339,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5337delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/makefile.mk b/win32/makefile.mk index 1e2a39c13c67..43b457d593fd 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -1703,7 +1703,7 @@ utils: $(HAVEMINIPERL) ..\utils\Makefile copy ..\README.tw ..\pod\perltw.pod copy ..\README.vos ..\pod\perlvos.pod copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5336delta.pod + copy ..\pod\perldelta.pod ..\pod\perl5337delta.pod $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) $(MINIPERL) -I..\lib ..\autodoc.pl .. $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. @@ -1801,7 +1801,7 @@ distclean: realclean -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5336delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ + perl5337delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ diff --git a/win32/pod.mak b/win32/pod.mak index 1e7329566bfa..1d3cb5083b6a 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -70,6 +70,7 @@ POD = perl.pod \ perl5334delta.pod \ perl5335delta.pod \ perl5336delta.pod \ + perl5337delta.pod \ perl561delta.pod \ perl56delta.pod \ perl581delta.pod \ @@ -238,6 +239,7 @@ MAN = perl.man \ perl5334delta.man \ perl5335delta.man \ perl5336delta.man \ + perl5337delta.man \ perl561delta.man \ perl56delta.man \ perl581delta.man \ @@ -406,6 +408,7 @@ HTML = perl.html \ perl5334delta.html \ perl5335delta.html \ perl5336delta.html \ + perl5337delta.html \ perl561delta.html \ perl56delta.html \ perl581delta.html \ @@ -574,6 +577,7 @@ TEX = perl.tex \ perl5334delta.tex \ perl5335delta.tex \ perl5336delta.tex \ + perl5337delta.tex \ perl561delta.tex \ perl56delta.tex \ perl581delta.tex \ From 3f2bf9069a14cfe5db8009481d207cb24492de4c Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 02:38:55 +0000 Subject: [PATCH 472/503] Porting/epigraphs.pod - satisfy porting tests --- Porting/epigraphs.pod | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 235d0acbc92e..7686f8aac309 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -21,9 +21,9 @@ Consult your favorite dictionary for details. L - This instrument can teach, it can illuminate; yes, and it can even - inspire. But it can do so only to the extent that humans are determined - to use it to those ends. Otherwise it is merely wires and lights in a box. +This instrument can teach, it can illuminate; yes, and it can even +inspire. But it can do so only to the extent that humans are determined +to use it to those ends. Otherwise it is merely wires and lights in a box. =head2 v5.33.5 - Max Weber, (from "Understanding Administration", by Wolfgang Seibel) From 0594e0ad3bfa129d3a242899f8fe2a0adf5e71dd Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 03:10:46 +0000 Subject: [PATCH 473/503] Bump version to 5.33.7 --- Cross/config.sh-arm-linux | 40 ++++++++++++++++---------------- Cross/config.sh-arm-linux-n770 | 40 ++++++++++++++++---------------- INSTALL | 30 ++++++++++++------------ META.json | 2 +- META.yml | 2 +- NetWare/Makefile | 4 ++-- NetWare/config_H.wc | 10 ++++---- Porting/config.sh | 42 +++++++++++++++++----------------- Porting/config_H | 18 +++++++-------- Porting/perldelta_template.pod | 2 +- Porting/todo.pod | 4 ++-- README.haiku | 4 ++-- README.macosx | 8 +++---- README.os2 | 2 +- README.vms | 4 ++-- hints/catamount.sh | 4 ++-- lib/B/Op_private.pm | 2 +- patchlevel.h | 4 ++-- plan9/config_sh.sample | 38 +++++++++++++++--------------- win32/GNUmakefile | 2 +- win32/Makefile | 2 +- win32/makefile.mk | 2 +- 22 files changed, 133 insertions(+), 133 deletions(-) diff --git a/Cross/config.sh-arm-linux b/Cross/config.sh-arm-linux index 0ea35b0ff6e8..8188147ae3ff 100644 --- a/Cross/config.sh-arm-linux +++ b/Cross/config.sh-arm-linux @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='6' +api_subversion='7' api_version='33' -api_versionstring='5.33.6' +api_versionstring='5.33.7' ar='ar' -archlib='/usr/lib/perl5/5.33.6/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.6/armv4l-linux' +archlib='/usr/lib/perl5/5.33.7/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.7/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -55,7 +55,7 @@ castflags='0' cat='cat' cc='cc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.6/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.7/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -825,7 +825,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.6/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.7/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -833,13 +833,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.6' +installprivlib='./install_me_here/usr/lib/perl5/5.33.7' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.6' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.7' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -973,8 +973,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.6' -privlibexp='/usr/lib/perl5/5.33.6' +privlib='/usr/lib/perl5/5.33.7' +privlibexp='/usr/lib/perl5/5.33.7' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1039,17 +1039,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.6' +sitelib='/usr/lib/perl5/site_perl/5.33.7' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.6' +sitelibexp='/usr/lib/perl5/site_perl/5.33.7' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1088,7 +1088,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='6' +subversion='7' sysman='/usr/share/man/man1' tail='' tar='' @@ -1179,8 +1179,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.6' -version_patchlevel_string='version 33 subversion 6' +version='5.33.7' +version_patchlevel_string='version 33 subversion 7' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1194,9 +1194,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=6 +PERL_SUBVERSION=7 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=6 +PERL_API_SUBVERSION=7 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/Cross/config.sh-arm-linux-n770 b/Cross/config.sh-arm-linux-n770 index ca3b2c19770e..ec7832e47bf8 100644 --- a/Cross/config.sh-arm-linux-n770 +++ b/Cross/config.sh-arm-linux-n770 @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/hostname' api_revision='5' -api_subversion='6' +api_subversion='7' api_version='33' -api_versionstring='5.33.6' +api_versionstring='5.33.7' ar='ar' -archlib='/usr/lib/perl5/5.33.6/armv4l-linux' -archlibexp='/usr/lib/perl5/5.33.6/armv4l-linux' +archlib='/usr/lib/perl5/5.33.7/armv4l-linux' +archlibexp='/usr/lib/perl5/5.33.7/armv4l-linux' archname64='' archname='armv4l-linux' archobjs='' @@ -54,7 +54,7 @@ castflags='0' cat='cat' cc='arm-none-linux-gnueabi-gcc' cccdlflags='-fpic' -ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.6/armv4l-linux/CORE' +ccdlflags='-rdynamic -Wl,-rpath,/usr/lib/perl5/5.33.7/armv4l-linux/CORE' ccflags='-fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccflags_uselargefiles='-D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64' ccname='arm-linux-gcc' @@ -823,7 +823,7 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='./install_me_here/usr/lib/perl5/5.33.6/armv4l-linux' +installarchlib='./install_me_here/usr/lib/perl5/5.33.7/armv4l-linux' installbin='./install_me_here/usr/bin' installhtml1dir='' installhtml3dir='' @@ -831,13 +831,13 @@ installman1dir='./install_me_here/usr/share/man/man1' installman3dir='./install_me_here/usr/share/man/man3' installprefix='./install_me_here/usr' installprefixexp='./install_me_here/usr' -installprivlib='./install_me_here/usr/lib/perl5/5.33.6' +installprivlib='./install_me_here/usr/lib/perl5/5.33.7' installscript='./install_me_here/usr/bin' -installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +installsitearch='./install_me_here/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' installsitebin='./install_me_here/usr/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.6' +installsitelib='./install_me_here/usr/lib/perl5/site_perl/5.33.7' installsiteman1dir='./install_me_here/usr/share/man/man1' installsiteman3dir='./install_me_here/usr/share/man/man3' installsitescript='./install_me_here/usr/bin' @@ -971,8 +971,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/usr/lib/perl5/5.33.6' -privlibexp='/usr/lib/perl5/5.33.6' +privlib='/usr/lib/perl5/5.33.7' +privlibexp='/usr/lib/perl5/5.33.7' procselfexe='"/proc/self/exe"' prototype='define' ptrsize='4' @@ -1037,17 +1037,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 6, 17, 29, 31, 0' sig_size='68' signal_t='void' -sitearch='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' -sitearchexp='/usr/lib/perl5/site_perl/5.33.6/armv4l-linux' +sitearch='/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' +sitearchexp='/usr/lib/perl5/site_perl/5.33.7/armv4l-linux' sitebin='/usr/bin' sitebinexp='/usr/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/usr/lib/perl5/site_perl/5.33.6' +sitelib='/usr/lib/perl5/site_perl/5.33.7' sitelib_stem='/usr/lib/perl5/site_perl' -sitelibexp='/usr/lib/perl5/site_perl/5.33.6' +sitelibexp='/usr/lib/perl5/site_perl/5.33.7' siteman1dir='/usr/share/man/man1' siteman1direxp='/usr/share/man/man1' siteman3dir='/usr/share/man/man3' @@ -1086,7 +1086,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/usr/include/string.h' submit='' -subversion='6' +subversion='7' sysman='/usr/share/man/man1' tail='' tar='' @@ -1177,8 +1177,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.6' -version_patchlevel_string='version 33 subversion 6' +version='5.33.7' +version_patchlevel_string='version 33 subversion 7' versiononly='undef' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1192,9 +1192,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=6 +PERL_SUBVERSION=7 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=6 +PERL_API_SUBVERSION=7 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/INSTALL b/INSTALL index 001178a2ba9b..10467fc4c989 100644 --- a/INSTALL +++ b/INSTALL @@ -615,7 +615,7 @@ The directories set up by Configure fall into three broad categories. =item Directories for the perl distribution -By default, Configure will use the following directories for 5.33.6. +By default, Configure will use the following directories for 5.33.7. $version is the full perl version number, including subversion, e.g. 5.12.3, and $archname is a string like sun4-sunos, determined by Configure. The full definitions of all Configure @@ -2438,7 +2438,7 @@ L =head1 Coexistence with earlier versions of perl 5 -Perl 5.33.6 is not binary compatible with earlier versions of Perl. +Perl 5.33.7 is not binary compatible with earlier versions of Perl. In other words, you will have to recompile your XS modules. In general, you can usually safely upgrade from one stable version of Perl @@ -2513,9 +2513,9 @@ won't interfere with another version. (The defaults guarantee this for libraries after 5.6.0, but not for executables. TODO?) One convenient way to do this is by using a separate prefix for each version, such as - sh Configure -Dprefix=/opt/perl5.33.6 + sh Configure -Dprefix=/opt/perl5.33.7 -and adding /opt/perl5.33.6/bin to the shell PATH variable. Such users +and adding /opt/perl5.33.7/bin to the shell PATH variable. Such users may also wish to add a symbolic link /usr/local/bin/perl so that scripts can still start with #!/usr/local/bin/perl. @@ -2528,13 +2528,13 @@ seriously consider using a separate directory, since development subversions may not have all the compatibility wrinkles ironed out yet. -=head2 Upgrading from 5.33.5 or earlier +=head2 Upgrading from 5.33.6 or earlier -B Perl modules having binary parts (meaning that a C compiler is used) will have to be recompiled to be -used with 5.33.6. If you find you do need to rebuild an extension with -5.33.6, you may safely do so without disturbing the older +used with 5.33.7. If you find you do need to rebuild an extension with +5.33.7, you may safely do so without disturbing the older installations. (See L<"Coexistence with earlier versions of perl 5"> above.) @@ -2567,15 +2567,15 @@ Firstly, the bare minimum to run this script print("$f\n"); } -in Linux with perl-5.33.6 is as follows (under $Config{prefix}): +in Linux with perl-5.33.7 is as follows (under $Config{prefix}): ./bin/perl - ./lib/perl5/5.33.6/strict.pm - ./lib/perl5/5.33.6/warnings.pm - ./lib/perl5/5.33.6/i686-linux/File/Glob.pm - ./lib/perl5/5.33.6/feature.pm - ./lib/perl5/5.33.6/XSLoader.pm - ./lib/perl5/5.33.6/i686-linux/auto/File/Glob/Glob.so + ./lib/perl5/5.33.7/strict.pm + ./lib/perl5/5.33.7/warnings.pm + ./lib/perl5/5.33.7/i686-linux/File/Glob.pm + ./lib/perl5/5.33.7/feature.pm + ./lib/perl5/5.33.7/XSLoader.pm + ./lib/perl5/5.33.7/i686-linux/auto/File/Glob/Glob.so Secondly, for perl-5.10.1, the Debian perl-base package contains 591 files, (of which 510 are for lib/unicore) totaling about 3.5MB in its diff --git a/META.json b/META.json index 1bd987002f7b..38066d80acc5 100644 --- a/META.json +++ b/META.json @@ -131,6 +131,6 @@ "url" : "https://github.com/Perl/perl5" } }, - "version" : "5.033006", + "version" : "5.033007", "x_serialization_backend" : "JSON::PP version 4.05" } diff --git a/META.yml b/META.yml index 1e7388dc5919..6d35ec7eb083 100644 --- a/META.yml +++ b/META.yml @@ -118,5 +118,5 @@ resources: homepage: https://www.perl.org/ license: https://dev.perl.org/licenses/ repository: https://github.com/Perl/perl5 -version: '5.033006' +version: '5.033007' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' diff --git a/NetWare/Makefile b/NetWare/Makefile index 3eb56a641e15..8544240e407e 100644 --- a/NetWare/Makefile +++ b/NetWare/Makefile @@ -86,7 +86,7 @@ NLM_VERSION = 3,20,0 # Here comes the CW tools - TO BE FILLED TO BUILD WITH CW - -MODULE_DESC = "Perl 5.33.6 for NetWare" +MODULE_DESC = "Perl 5.33.7 for NetWare" CCTYPE = CodeWarrior C_COMPILER = mwccnlm -c CPP_COMPILER = mwccnlm @@ -462,7 +462,7 @@ INST_NW_TOP2 = $(INST_NW_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -INST_VER = \5.33.6 +INST_VER = \5.33.7 # # Comment this out if you DON'T want your perl installation to have diff --git a/NetWare/config_H.wc b/NetWare/config_H.wc index 045ae574f788..b40e3262060b 100644 --- a/NetWare/config_H.wc +++ b/NetWare/config_H.wc @@ -887,7 +887,7 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "c:\\perl\\5.33.6\\lib\\NetWare-x86-multi-thread" /**/ +#define ARCHLIB "c:\\perl\\5.33.7\\lib\\NetWare-x86-multi-thread" /**/ /*#define ARCHLIB_EXP "" /**/ /* ARCHNAME: @@ -918,8 +918,8 @@ * This symbol is the filename expanded version of the BIN symbol, for * programs that do not want to deal with that at run-time. */ -#define BIN "c:\\perl\\5.33.6\\bin\\NetWare-x86-multi-thread" /**/ -#define BIN_EXP "c:\\perl\\5.33.6\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN "c:\\perl\\5.33.7\\bin\\NetWare-x86-multi-thread" /**/ +#define BIN_EXP "c:\\perl\\5.33.7\\bin\\NetWare-x86-multi-thread" /**/ /* BYTEORDER: * This symbol holds the hexadecimal constant defined in byteorder, @@ -2878,7 +2878,7 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "c:\\perl\\site\\5.33.6\\lib\\NetWare-x86-multi-thread" /**/ +#define SITEARCH "c:\\perl\\site\\5.33.7\\lib\\NetWare-x86-multi-thread" /**/ /*#define SITEARCH_EXP "" /**/ /* SITELIB: @@ -2901,7 +2901,7 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "c:\\perl\\site\\5.33.6\\lib" /**/ +#define SITELIB "c:\\perl\\site\\5.33.7\\lib" /**/ /*#define SITELIB_EXP "" /**/ #define SITELIB_STEM "" /**/ diff --git a/Porting/config.sh b/Porting/config.sh index 4c1cf7b83161..88845e41a641 100644 --- a/Porting/config.sh +++ b/Porting/config.sh @@ -46,12 +46,12 @@ afsroot='/afs' alignbytes='16' aphostname='' api_revision='5' -api_subversion='6' +api_subversion='7' api_version='33' -api_versionstring='5.33.6' +api_versionstring='5.33.7' ar='ar' -archlib='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' -archlibexp='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' +archlib='/opt/perl/lib/5.33.7/x86_64-linux-thread-multi-ld' +archlibexp='/opt/perl/lib/5.33.7/x86_64-linux-thread-multi-ld' archname64='' archname='x86_64-linux-thread-multi-ld' archobjs='' @@ -854,7 +854,7 @@ incpath='' incpth='/usr/lib64/gcc/x86_64-suse-linux/10/include /usr/local/include /usr/lib64/gcc/x86_64-suse-linux/10/include-fixed /usr/lib64/gcc/x86_64-suse-linux/10/../../../../x86_64-suse-linux/include /usr/include' inews='' initialinstalllocation='/opt/perl/bin' -installarchlib='/opt/perl/lib/5.33.6/x86_64-linux-thread-multi-ld' +installarchlib='/opt/perl/lib/5.33.7/x86_64-linux-thread-multi-ld' installbin='/opt/perl/bin' installhtml1dir='' installhtml3dir='' @@ -862,13 +862,13 @@ installman1dir='/opt/perl/man/man1' installman3dir='/opt/perl/man/man3' installprefix='/opt/perl' installprefixexp='/opt/perl' -installprivlib='/opt/perl/lib/5.33.6' +installprivlib='/opt/perl/lib/5.33.7' installscript='/opt/perl/bin' -installsitearch='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' +installsitearch='/opt/perl/lib/site_perl/5.33.7/x86_64-linux-thread-multi-ld' installsitebin='/opt/perl/bin' installsitehtml1dir='' installsitehtml3dir='' -installsitelib='/opt/perl/lib/site_perl/5.33.6' +installsitelib='/opt/perl/lib/site_perl/5.33.7' installsiteman1dir='/opt/perl/man/man1' installsiteman3dir='/opt/perl/man/man3' installsitescript='/opt/perl/bin' @@ -993,7 +993,7 @@ perl_patchlevel='' perl_static_inline='static __inline__' perladmin='yourname@yourhost.yourplace.com' perllibs='-lpthread -lnsl -ldl -lm -lcrypt -lutil -lc' -perlpath='/opt/perl/bin/perl5.33.6' +perlpath='/opt/perl/bin/perl5.33.7' pg='pg' phostname='' pidtype='pid_t' @@ -1002,8 +1002,8 @@ pmake='' pr='' prefix='/opt/perl' prefixexp='/opt/perl' -privlib='/opt/perl/lib/5.33.6' -privlibexp='/opt/perl/lib/5.33.6' +privlib='/opt/perl/lib/5.33.7' +privlibexp='/opt/perl/lib/5.33.7' procselfexe='"/proc/self/exe"' ptrsize='8' quadkind='2' @@ -1068,17 +1068,17 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63, 64, 6, 17, 29, 0' sig_size='68' signal_t='void' -sitearch='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' -sitearchexp='/opt/perl/lib/site_perl/5.33.6/x86_64-linux-thread-multi-ld' +sitearch='/opt/perl/lib/site_perl/5.33.7/x86_64-linux-thread-multi-ld' +sitearchexp='/opt/perl/lib/site_perl/5.33.7/x86_64-linux-thread-multi-ld' sitebin='/opt/perl/bin' sitebinexp='/opt/perl/bin' sitehtml1dir='' sitehtml1direxp='' sitehtml3dir='' sitehtml3direxp='' -sitelib='/opt/perl/lib/site_perl/5.33.6' +sitelib='/opt/perl/lib/site_perl/5.33.7' sitelib_stem='/opt/perl/lib/site_perl' -sitelibexp='/opt/perl/lib/site_perl/5.33.6' +sitelibexp='/opt/perl/lib/site_perl/5.33.7' siteman1dir='/opt/perl/man/man1' siteman1direxp='/opt/perl/man/man1' siteman3dir='/opt/perl/man/man3' @@ -1104,7 +1104,7 @@ src='.' ssizetype='ssize_t' st_ino_sign='1' st_ino_size='8' -startperl='#!/opt/perl/bin/perl5.33.6' +startperl='#!/opt/perl/bin/perl5.33.7' startsh='#!/bin/sh' static_ext=' ' stdchar='char' @@ -1116,7 +1116,7 @@ stdio_ptr='((fp)->_ptr)' stdio_stream_array='' strerror_r_proto='REENTRANT_PROTO_B_IBW' submit='' -subversion='6' +subversion='7' sysman='/usr/share/man/man1' sysroot='' tail='' @@ -1215,8 +1215,8 @@ vendorprefix='' vendorprefixexp='' vendorscript='' vendorscriptexp='' -version='5.33.6' -version_patchlevel_string='version 33 subversion 6' +version='5.33.7' +version_patchlevel_string='version 33 subversion 7' versiononly='define' vi='' xlibpth='/usr/lib/386 /lib/386' @@ -1226,10 +1226,10 @@ zcat='' zip='zip' PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=6 +PERL_SUBVERSION=7 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=6 +PERL_API_SUBVERSION=7 PERL_PATCHLEVEL='' PERL_CONFIG_SH=true : Variables propagated from previous config.sh file. diff --git a/Porting/config_H b/Porting/config_H index 3809fd2bf8cf..54c73d326fc5 100644 --- a/Porting/config_H +++ b/Porting/config_H @@ -1239,8 +1239,8 @@ * This symbol contains the ~name expanded version of ARCHLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define ARCHLIB "/opt/perl/lib/5.33.6/x86_64-linux" /**/ -#define ARCHLIB_EXP "/opt/perl/lib/5.33.6/x86_64-linux" /**/ +#define ARCHLIB "/opt/perl/lib/5.33.7/x86_64-linux" /**/ +#define ARCHLIB_EXP "/opt/perl/lib/5.33.7/x86_64-linux" /**/ /* BIN: * This symbol holds the path of the bin directory where the package will @@ -1293,8 +1293,8 @@ * This symbol contains the ~name expanded version of PRIVLIB, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define PRIVLIB "/opt/perl/lib/5.33.6" /**/ -#define PRIVLIB_EXP "/opt/perl/lib/5.33.6" /**/ +#define PRIVLIB "/opt/perl/lib/5.33.7" /**/ +#define PRIVLIB_EXP "/opt/perl/lib/5.33.7" /**/ /* SITEARCH: * This symbol contains the name of the private library for this package. @@ -1311,8 +1311,8 @@ * This symbol contains the ~name expanded version of SITEARCH, to be used * in programs that are not prepared to deal with ~ expansion at run-time. */ -#define SITEARCH "/opt/perl/lib/site_perl/5.33.6/x86_64-linux" /**/ -#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.6/x86_64-linux" /**/ +#define SITEARCH "/opt/perl/lib/site_perl/5.33.7/x86_64-linux" /**/ +#define SITEARCH_EXP "/opt/perl/lib/site_perl/5.33.7/x86_64-linux" /**/ /* SITELIB: * This symbol contains the name of the private library for this package. @@ -1334,8 +1334,8 @@ * removed. The elements in inc_version_list (inc_version_list.U) can * be tacked onto this variable to generate a list of directories to search. */ -#define SITELIB "/opt/perl/lib/site_perl/5.33.6" /**/ -#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.6" /**/ +#define SITELIB "/opt/perl/lib/site_perl/5.33.7" /**/ +#define SITELIB_EXP "/opt/perl/lib/site_perl/5.33.7" /**/ #define SITELIB_STEM "/opt/perl/lib/site_perl" /**/ /* PERL_VENDORARCH: @@ -4109,7 +4109,7 @@ * script to make sure (one hopes) that it runs with perl and not * some shell. */ -#define STARTPERL "#!/opt/perl/bin/perl5.33.6" /**/ +#define STARTPERL "#!/opt/perl/bin/perl5.33.7" /**/ /* HAS_STDIO_STREAM_ARRAY: * This symbol, if defined, tells that there is an array diff --git a/Porting/perldelta_template.pod b/Porting/perldelta_template.pod index 873655fe2e7e..035726afec30 100644 --- a/Porting/perldelta_template.pod +++ b/Porting/perldelta_template.pod @@ -403,7 +403,7 @@ died, add a short obituary here. XXX Generate this with: - perl Porting/acknowledgements.pl v5.33.6..HEAD + perl Porting/acknowledgements.pl v5.33.7..HEAD =head1 Reporting Bugs diff --git a/Porting/todo.pod b/Porting/todo.pod index 33b2aa09cea7..307058d31d6f 100644 --- a/Porting/todo.pod +++ b/Porting/todo.pod @@ -486,7 +486,7 @@ Natively 64-bit systems need neither -Duse64bitint nor -Duse64bitall. On these systems, it might be the default compilation mode, and there is currently no guarantee that passing no use64bitall option to the Configure process will build a 32bit perl. Implementing -Duse32bit* -options would be nice for perl 5.33.6. +options would be nice for perl 5.33.7. =head2 Profile Perl - am I hot or not? @@ -1189,7 +1189,7 @@ L =head1 Big projects Tasks that will get your name mentioned in the description of the "Highlights -of 5.33.6" +of 5.33.7" =head2 make ithreads more robust diff --git a/README.haiku b/README.haiku index 44c55d0b3241..a50a6d63b893 100644 --- a/README.haiku +++ b/README.haiku @@ -22,9 +22,9 @@ The build procedure is completely standard: Make perl executable and create a symlink for libperl: chmod a+x /boot/common/bin/perl - cd /boot/common/lib; ln -s perl5/5.33.6/BePC-haiku/CORE/libperl.so . + cd /boot/common/lib; ln -s perl5/5.33.7/BePC-haiku/CORE/libperl.so . -Replace C<5.33.6> with your respective version of Perl. +Replace C<5.33.7> with your respective version of Perl. =head1 KNOWN PROBLEMS diff --git a/README.macosx b/README.macosx index d583fe66037d..c3d2556d3124 100644 --- a/README.macosx +++ b/README.macosx @@ -10,9 +10,9 @@ perlmacosx - Perl under Mac OS X This document briefly describes Perl under Mac OS X. - curl -O https://www.cpan.org/src/perl-5.33.6.tar.gz - tar -xzf perl-5.33.6.tar.gz - cd perl-5.33.6 + curl -O https://www.cpan.org/src/perl-5.33.7.tar.gz + tar -xzf perl-5.33.7.tar.gz + cd perl-5.33.7 ./Configure -des -Dprefix=/usr/local/ make make test @@ -20,7 +20,7 @@ This document briefly describes Perl under Mac OS X. =head1 DESCRIPTION -The latest Perl release (5.33.6 as of this writing) builds without changes +The latest Perl release (5.33.7 as of this writing) builds without changes under all versions of Mac OS X from 10.3 "Panther" onwards. In order to build your own version of Perl you will need 'make', diff --git a/README.os2 b/README.os2 index 85b15f9fdd13..d12be9702d5c 100644 --- a/README.os2 +++ b/README.os2 @@ -619,7 +619,7 @@ C in F, see L">. =item Additional Perl modules - unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.6/ + unzip perl_ste.zip -d f:/perllib/lib/site_perl/5.33.7/ Same remark as above applies. Additionally, if this directory is not one of directories on @INC (and @INC is influenced by C), you diff --git a/README.vms b/README.vms index 372c74bd328a..78944879e628 100644 --- a/README.vms +++ b/README.vms @@ -142,11 +142,11 @@ You may need to set up a foreign symbol for the unpacking utility of choice. Once you have done so, use a command like the following to unpack the archive: - vmstar -xvf perl-5^.33^.6.tar + vmstar -xvf perl-5^.33^.7.tar Then set default to the top-level source directory like so: - set default [.perl-5^.33^.6] + set default [.perl-5^.33^.7] and proceed with configuration as described in the next section. diff --git a/hints/catamount.sh b/hints/catamount.sh index dc3e340ad64a..b5ad550df012 100644 --- a/hints/catamount.sh +++ b/hints/catamount.sh @@ -31,11 +31,11 @@ # mkdir -p /opt/perl-catamount # mkdir -p /opt/perl-catamount/include # mkdir -p /opt/perl-catamount/lib -# mkdir -p /opt/perl-catamount/lib/perl5/5.33.6 +# mkdir -p /opt/perl-catamount/lib/perl5/5.33.7 # mkdir -p /opt/perl-catamount/bin # cp *.h /opt/perl-catamount/include # cp libperl.a /opt/perl-catamount/lib -# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.6 +# cp -pr lib/* /opt/perl-catamount/lib/perl5/5.33.7 # cp miniperl perl run.sh cc.sh /opt/perl-catamount/lib # # With the headers and the libperl.a you can embed Perl to your Catamount diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm index 716aec88d6fe..a3666a718169 100644 --- a/lib/B/Op_private.pm +++ b/lib/B/Op_private.pm @@ -118,7 +118,7 @@ package B::Op_private; our %bits; -our $VERSION = "5.033006"; +our $VERSION = "5.033007"; $bits{$_}{3} = 'OPpENTERSUB_AMPER' for qw(entersub rv2cv); $bits{$_}{6} = 'OPpENTERSUB_DB' for qw(entersub rv2cv); diff --git a/patchlevel.h b/patchlevel.h index 7803e0ebdb9d..973071099bd3 100644 --- a/patchlevel.h +++ b/patchlevel.h @@ -39,7 +39,7 @@ Instead use one of the version comparison macros. See C>. #define PERL_REVISION 5 /* age */ #define PERL_VERSION 33 /* epoch */ -#define PERL_SUBVERSION 6 /* generation */ +#define PERL_SUBVERSION 7 /* generation */ /* The following numbers describe the earliest compatible version of Perl ("compatibility" here being defined as sufficient binary/API @@ -60,7 +60,7 @@ Instead use one of the version comparison macros. See C>. */ #define PERL_API_REVISION 5 #define PERL_API_VERSION 33 -#define PERL_API_SUBVERSION 6 +#define PERL_API_SUBVERSION 7 /* XXX Note: The selection of non-default Configure options, such as -Duselonglong may invalidate these settings. Currently, Configure diff --git a/plan9/config_sh.sample b/plan9/config_sh.sample index a639d0f85d5a..d2e89cab2eb1 100644 --- a/plan9/config_sh.sample +++ b/plan9/config_sh.sample @@ -31,12 +31,12 @@ afsroot='/afs' alignbytes='4' aphostname='/bin/uname -n' api_revision='5' -api_subversion='6' +api_subversion='7' api_version='33' -api_versionstring='5.33.6' +api_versionstring='5.33.7' ar='ar' -archlib='/sys/lib/perl5/5.33.6/386' -archlibexp='/sys/lib/perl5/5.33.6/386' +archlib='/sys/lib/perl5/5.33.7/386' +archlibexp='/sys/lib/perl5/5.33.7/386' archname64='' archname='386' archobjs='' @@ -819,17 +819,17 @@ inc_version_list=' ' inc_version_list_init='0' incpath='' inews='' -installarchlib='/sys/lib/perl/5.33.6/386' +installarchlib='/sys/lib/perl/5.33.7/386' installbin='/usr/bin' installman1dir='/sys/man/1pub' installman3dir='/sys/man/2pub' installprefix='/usr' installprefixexp='/usr' -installprivlib='/sys/lib/perl/5.33.6' +installprivlib='/sys/lib/perl/5.33.7' installscript='/usr/bin' -installsitearch='/sys/lib/perl/5.33.6/site_perl/386' +installsitearch='/sys/lib/perl/5.33.7/site_perl/386' installsitebin='/usr/bin' -installsitelib='/sys/lib/perl/5.33.6/site_perl' +installsitelib='/sys/lib/perl/5.33.7/site_perl' installstyle='lib/perl5' installusrbinperl='undef' installvendorarch='' @@ -954,8 +954,8 @@ pmake='' pr='' prefix='/usr' prefixexp='/usr' -privlib='/sys/lib/perl/5.33.6' -privlibexp='/sys/lib/perl/5.33.6' +privlib='/sys/lib/perl/5.33.7' +privlibexp='/sys/lib/perl/5.33.7' procselfexe='' prototype='define' ptrsize='4' @@ -1020,13 +1020,13 @@ sig_num='0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 sig_num_init='0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0' sig_size='50' signal_t='void' -sitearch='/sys/lib/perl/5.33.6/site_perl/386' +sitearch='/sys/lib/perl/5.33.7/site_perl/386' sitearchexp='/sys/lib/perl/site_perl/386' sitebin='/usr/bin' sitebinexp='/usr/bin' -sitelib='/sys/lib/perl/5.33.6/site_perl' -sitelib_stem='/sys/lib/perl/5.33.6/site_perl' -sitelibexp='/sys/lib/perl/5.33.6/site_perl' +sitelib='/sys/lib/perl/5.33.7/site_perl' +sitelib_stem='/sys/lib/perl/5.33.7/site_perl' +sitelibexp='/sys/lib/perl/5.33.7/site_perl' siteprefix='/usr' siteprefixexp='/usr' sizesize='4' @@ -1059,7 +1059,7 @@ stdio_stream_array='' strerror_r_proto='0' strings='/sys/include/ape/string.h' submit='' -subversion='6' +subversion='7' sysman='/sys/man/1pub' tail='' tar='' @@ -1140,8 +1140,8 @@ vendorlib_stem='' vendorlibexp='' vendorprefix='' vendorprefixexp='' -version='5.33.6' -version_patchlevel_string='version 33 subversion 6' +version='5.33.7' +version_patchlevel_string='version 33 subversion 7' versiononly='undef' vi='' xlibpth='' @@ -1155,9 +1155,9 @@ config_args='' config_argc=0 PERL_REVISION=5 PERL_VERSION=33 -PERL_SUBVERSION=6 +PERL_SUBVERSION=7 PERL_API_REVISION=5 PERL_API_VERSION=33 -PERL_API_SUBVERSION=6 +PERL_API_SUBVERSION=7 PERL_PATCHLEVEL= PERL_CONFIG_SH=true diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 98510dbe66c2..4ce7ce71653f 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -64,7 +64,7 @@ INST_TOP := $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER := \5.33.6 +#INST_VER := \5.33.7 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/Makefile b/win32/Makefile index 7f4ebccd9d4a..f4b65338a43b 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -38,7 +38,7 @@ INST_TOP = $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER = \5.33.6 +#INST_VER = \5.33.7 # # Comment this out if you DON'T want your perl installation to have diff --git a/win32/makefile.mk b/win32/makefile.mk index 43b457d593fd..dc2d79d48cfc 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -45,7 +45,7 @@ INST_TOP *= $(INST_DRV)\perl # versioned installation can be obtained by setting INST_TOP above to a # path that includes an arbitrary version string. # -#INST_VER *= \5.33.6 +#INST_VER *= \5.33.7 # # Comment this out if you DON'T want your perl installation to have From 0d0e553791595795fcd221b1d3e396f792bd0966 Mon Sep 17 00:00:00 2001 From: Richard Leach Date: Thu, 21 Jan 2021 03:43:50 +0000 Subject: [PATCH 474/503] Prepare Module::Corelist for 5.33.7 --- dist/Module-CoreList/Changes | 3 +++ dist/Module-CoreList/lib/Module/CoreList.pm | 21 ++++++++++++++++++- .../lib/Module/CoreList/Utils.pm | 9 +++++++- 3 files changed, 31 insertions(+), 2 deletions(-) diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index 27f989929f75..e9ac54e36677 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,3 +1,6 @@ +5.20210220 + - Updated for v5.33.7 + 5.20210120 - Updated for v5.33.6 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index b0e58ed90a62..7d7f9266db1c 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -4,7 +4,7 @@ use strict; our ( %released, %version, %families, %upstream, %bug_tracker, %deprecated, %delta ); use version; -our $VERSION = '5.20210120'; +our $VERSION = '5.20210220'; sub PKG_PATTERN () { q#\A[a-zA-Z_][0-9a-zA-Z_]*(?:(::|')[0-9a-zA-Z_]+)*\z# } sub _looks_like_invocant ($) { local $@; !!eval { $_[0]->isa(__PACKAGE__) } } @@ -373,6 +373,7 @@ sub changes_between { 5.033004 => '2020-11-20', 5.033005 => '2020-12-20', 5.033006 => '2021-01-20', + 5.033007 => '2021-02-20', ); for my $version ( sort { $a <=> $b } keys %released ) { @@ -18300,6 +18301,17 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.033007 => { + delta_from => 5.033006, + changed => { + 'B::Op_private' => '5.033007', + 'Config' => '5.033007', + 'Module::CoreList' => '5.20210220', + 'Module::CoreList::Utils'=> '5.20210220', + }, + removed => { + } + }, ); sub is_core @@ -19470,6 +19482,13 @@ sub is_core removed => { } }, + 5.033007 => { + delta_from => 5.033006, + changed => { + }, + removed => { + } + }, ); %deprecated = _undelta(\%deprecated); diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 8c8752b1f44a..41c1fe68f573 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -4,7 +4,7 @@ use strict; use warnings; use Module::CoreList; -our $VERSION = '5.20210120'; +our $VERSION = '5.20210220'; our %utilities; sub utilities { @@ -1671,6 +1671,13 @@ my %delta = ( removed => { } }, + 5.033007 => { + delta_from => 5.033006, + changed => { + }, + removed => { + } + }, ); %utilities = Module::CoreList::_undelta(\%delta); From fa08f8614adc5988a520a33b805aaf53f0153c46 Mon Sep 17 00:00:00 2001 From: Chris 'BinGOs' Williams Date: Thu, 21 Jan 2021 09:30:07 +0000 Subject: [PATCH 475/503] Who wants to be the disco king? --- Porting/Maintainers.pl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl index 209d2180019f..ebfbf28436e9 100755 --- a/Porting/Maintainers.pl +++ b/Porting/Maintainers.pl @@ -811,7 +811,7 @@ package Maintainers; }, 'Module::CoreList' => { - 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20201120.tar.gz', + 'DISTRIBUTION' => 'BINGOS/Module-CoreList-5.20210120.tar.gz', 'FILES' => q[dist/Module-CoreList], }, From 569e5e25146cd0c2e2edeac803e3a6980ea8cd57 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 23 Jan 2021 13:12:16 +0000 Subject: [PATCH 476/503] 5.32.1 today --- pod/perlhist.pod | 1 + 1 file changed, 1 insertion(+) diff --git a/pod/perlhist.pod b/pod/perlhist.pod index 71ecae3f61b1..6d689e2ee9b4 100644 --- a/pod/perlhist.pod +++ b/pod/perlhist.pod @@ -696,6 +696,7 @@ the strings?). Sawyer X 5.32.0-RC1 2020-Jun-07 Sawyer X 5.32.0 2020-Jun-20 Steve 5.32.1-RC1 2021-Jan-09 + Steve 5.32.1 2021-Jan-23 Sawyer X 5.33.0 2020-Jul-17 The 5.33 development track Ether 5.33.1 2020-Aug-20 From cc2dc6fe69b8ea2d11e2099fd6f74ad1dfeae5bf Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 23 Jan 2021 15:43:35 +0000 Subject: [PATCH 477/503] Add epigraph for 5.32.1 --- Porting/epigraphs.pod | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/Porting/epigraphs.pod b/Porting/epigraphs.pod index 7686f8aac309..2874b83075cd 100644 --- a/Porting/epigraphs.pod +++ b/Porting/epigraphs.pod @@ -89,6 +89,21 @@ L + +As the warning bells rang, inquisitive people were peeping into the star +dressing room. Among them were jugglers in bright robes and turbans, a +roller-skater in a knitted cardigan, a comedian with a powdered white +face and a make-up man. The celebrated guest artiste amazed everyone +with his unusually long, superbly cut tail coat and by wearing a black +domino. Even more astounding were the black magician's two companions: +a tall man in checks with an unsteady pince-nez and a fat black cat +which walked into the dressing room on its hind legs and casually sat +down on the divan, blinking in the light of the unshaded lamps round the +make-up mirror. + =head2 v5.32.1-RC1 - Mikhail Bulgakov, trans. Michael Glenny, "The Heart of a Dog" L From 952423a568b9917495303bcaaea534f6b49fa5b6 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 23 Jan 2021 15:44:51 +0000 Subject: [PATCH 478/503] Tick off release --- Porting/release_schedule.pod | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 939baddafe34..2cfb6b44c688 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -14,7 +14,7 @@ deemed necessary by the Pumpking. =head2 Perl 5.32 2020-06-20 5.32.0 ✓ Sawyer X - 2021-01-23 5.32.1 Steve Hay + 2021-01-23 5.32.1 ✓ Steve Hay =head2 Perl 5.30 From c7a950b85c82cd8f4e440b0a15ce5ed8e56dd5d4 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 23 Jan 2021 15:52:09 +0000 Subject: [PATCH 479/503] Update Module-CoreList with data for 5.32.1 --- dist/Module-CoreList/Changes | 3 +++ dist/Module-CoreList/lib/Module/CoreList.pm | 25 +++++++++++++++++++ .../lib/Module/CoreList/Utils.pm | 7 ++++++ 3 files changed, 35 insertions(+) diff --git a/dist/Module-CoreList/Changes b/dist/Module-CoreList/Changes index e9ac54e36677..21aaecedc9ca 100644 --- a/dist/Module-CoreList/Changes +++ b/dist/Module-CoreList/Changes @@ -1,6 +1,9 @@ 5.20210220 - Updated for v5.33.7 +5.20210123 + - Updated for v5.32.1 + 5.20210120 - Updated for v5.33.6 diff --git a/dist/Module-CoreList/lib/Module/CoreList.pm b/dist/Module-CoreList/lib/Module/CoreList.pm index 7d7f9266db1c..130bb1b7b171 100644 --- a/dist/Module-CoreList/lib/Module/CoreList.pm +++ b/dist/Module-CoreList/lib/Module/CoreList.pm @@ -373,6 +373,7 @@ sub changes_between { 5.033004 => '2020-11-20', 5.033005 => '2020-12-20', 5.033006 => '2021-01-20', + 5.032001 => '2021-01-23', 5.033007 => '2021-02-20', ); @@ -18301,6 +18302,23 @@ for my $version ( sort { $a <=> $b } keys %released ) { removed => { } }, + 5.032001 => { + delta_from => 5.032000, + changed => { + 'B::Op_private' => '5.032001', + 'Config' => '5.032001', + 'Data::Dumper' => '2.174_01', + 'DynaLoader' => '1.47_01', + 'ExtUtils::Liblist::Kid'=> '7.44_01', + 'Module::CoreList' => '5.20210123', + 'Module::CoreList::Utils'=> '5.20210123', + 'Opcode' => '1.48', + 'Safe' => '2.41_01', + 'Win32API::File::inc::ExtUtils::Myconst2perl'=> '1', + }, + removed => { + } + }, 5.033007 => { delta_from => 5.033006, changed => { @@ -19482,6 +19500,13 @@ sub is_core removed => { } }, + 5.032001 => { + delta_from => 5.032, + changed => { + }, + removed => { + } + }, 5.033007 => { delta_from => 5.033006, changed => { diff --git a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm index 41c1fe68f573..7cc27788179e 100644 --- a/dist/Module-CoreList/lib/Module/CoreList/Utils.pm +++ b/dist/Module-CoreList/lib/Module/CoreList/Utils.pm @@ -1671,6 +1671,13 @@ my %delta = ( removed => { } }, + 5.032001 => { + delta_from => 5.032000, + changed => { + }, + removed => { + } + }, 5.033007 => { delta_from => 5.033006, changed => { From 1d0cdb1d0297a40f2060e7372d0417fb2da78c55 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Sat, 23 Jan 2021 16:18:56 +0000 Subject: [PATCH 480/503] Import perl5321delta.pod --- MANIFEST | 1 + pod/perl.pod | 1 + pod/perl5321delta.pod | 266 ++++++++++++++++++++++++++++++++++++++++++ win32/pod.mak | 4 + 4 files changed, 272 insertions(+) create mode 100644 pod/perl5321delta.pod diff --git a/MANIFEST b/MANIFEST index d094c3e8c624..2c9afd4f6d2f 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5227,6 +5227,7 @@ pod/perl5301delta.pod Perl changes in version 5.30.1 pod/perl5302delta.pod Perl changes in version 5.30.2 pod/perl5303delta.pod Perl changes in version 5.30.3 pod/perl5320delta.pod Perl changes in version 5.32.0 +pod/perl5321delta.pod Perl changes in version 5.32.1 pod/perl5330delta.pod Perl changes in version 5.33.0 pod/perl5331delta.pod Perl changes in version 5.33.1 pod/perl5332delta.pod Perl changes in version 5.33.2 diff --git a/pod/perl.pod b/pod/perl.pod index 73877f150751..101b84252808 100644 --- a/pod/perl.pod +++ b/pod/perl.pod @@ -191,6 +191,7 @@ aux h2ph h2xs perlbug pl2pm pod2html pod2man splain xsubpp perl5332delta Perl changes in version 5.33.2 perl5331delta Perl changes in version 5.33.1 perl5330delta Perl changes in version 5.33.0 + perl5321delta Perl changes in version 5.32.1 perl5320delta Perl changes in version 5.32.0 perl5303delta Perl changes in version 5.30.3 perl5302delta Perl changes in version 5.30.2 diff --git a/pod/perl5321delta.pod b/pod/perl5321delta.pod new file mode 100644 index 000000000000..94e294ecf83d --- /dev/null +++ b/pod/perl5321delta.pod @@ -0,0 +1,266 @@ +=encoding utf8 + +=head1 NAME + +perl5321delta - what is new for perl v5.32.1 + +=head1 DESCRIPTION + +This document describes differences between the 5.32.0 release and the 5.32.1 +release. + +If you are upgrading from an earlier release such as 5.31.0, first read +L, which describes differences between 5.31.0 and 5.32.0. + +=head1 Incompatible Changes + +There are no changes intentionally incompatible with Perl 5.32.0. If any +exist, they are bugs, and we request that you submit a report. See +L below. + +=head1 Modules and Pragmata + +=head2 Updated Modules and Pragmata + +=over 4 + +=item * + +L has been upgraded from version 2.174 to 2.174_01. + +A number of memory leaks have been fixed. + +=item * + +L has been upgraded from version 1.47 to 1.47_01. + +=item * + +L has been upgraded from version 5.20200620 to 5.20210123. + +=item * + +L has been upgraded from version 1.47 to 1.48. + +A warning has been added about evaluating untrusted code with the perl +interpreter. + +=item * + +L has been upgraded from version 2.41 to 2.41_01. + +A warning has been added about evaluating untrusted code with the perl +interpreter. + +=back + +=head1 Documentation + +=head2 New Documentation + +=head3 L + +Documentation of the newly formed rules of governance for Perl. + +=head3 L + +Documentation of how the Perl security team operates and how the team evaluates +new security reports. + +=head2 Changes to Existing Documentation + +We have attempted to update the documentation to reflect the changes listed in +this document. If you find any we have missed, open an issue at +L. + +Additionally, the following selected changes have been made: + +=head3 L + +=over 4 + +=item * + +Document range op behaviour change. + +=back + +=head1 Diagnostics + +The following additions or changes have been made to diagnostic output, +including warnings and fatal error messages. For the complete list of +diagnostic messages, see L. + +=head2 Changes to Existing Diagnostics + +=over 4 + +=item * + +L<\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in mE%sE|perldiag/"\K not permitted in lookahead/lookbehind in regex; marked by <-- HERE in m/%s/"> + +This error was incorrectly produced in some cases involving nested lookarounds. +This has been fixed. + +[L] + +=back + +=head1 Configuration and Compilation + +=over 4 + +=item * + +Newer 64-bit versions of the Intel C/C++ compiler are now recognized and have +the correct flags set. + +=item * + +We now trap SIGBUS when F checks for C. + +On several systems the attempt to determine if we need C or similar +results in a SIGBUS instead of the expected SIGSEGV, which previously caused a +core dump. + +[L] + +=back + +=head1 Testing + +Tests were added and changed to reflect the other additions and changes in this +release. + +=head1 Platform Support + +=head2 Platform-Specific Notes + +=over 4 + +=item MacOS (Darwin) + +The hints file for darwin has been updated to handle future macOS versions +beyond 10. Perl can now be built on macOS Big Sur. + +[L, +L] + +=item Minix + +Build errors on Minix have been fixed. + +[L] + +=back + +=head1 Selected Bug Fixes + +=over 4 + +=item * + +Some list assignments involving C on the left-hand side were +over-optimized and produced incorrect results. + +[L, +L] + +=item * + +Fixed a bug in which some regexps with recursive subpatterns matched +incorrectly. + +[L] + +=item * + +Fixed a deadlock that hung the build when Perl is compiled for debugging memory +problems and has PERL_MEM_LOG enabled. + +[L] + +=item * + +Fixed a crash in the use of chained comparison operators when run under "no +warnings 'uninitialized'". + +[L, +L] + +=item * + +Exceptions thrown from destructors during global destruction are no longer +swallowed. + +[L] + +=back + +=head1 Acknowledgements + +Perl 5.32.1 represents approximately 7 months of development since Perl 5.32.0 +and contains approximately 7,000 lines of changes across 80 files from 23 +authors. + +Excluding auto-generated files, documentation and release tools, there were +approximately 1,300 lines of changes to 23 .pm, .t, .c and .h files. + +Perl continues to flourish into its fourth decade thanks to a vibrant community +of users and developers. The following people are known to have contributed +the improvements that became Perl 5.32.1: + +Adam Hartley, Andy Dougherty, Dagfinn Ilmari Mannsåker, Dan Book, David +Mitchell, Graham Knop, Graham Ollis, Hauke D, H.Merijn Brand, Hugo van der +Sanden, John Lightsey, Karen Etheridge, Karl Williamson, Leon Timmermans, Max +Maischein, Nicolas R., Ricardo Signes, Richard Leach, Sawyer X, Sevan Janiyan, +Steve Hay, Tom Hukins, Tony Cook. + +The list above is almost certainly incomplete as it is automatically generated +from version control history. In particular, it does not include the names of +the (very much appreciated) contributors who reported issues to the Perl bug +tracker. + +Many of the changes included in this version originated in the CPAN modules +included in Perl's core. We're grateful to the entire CPAN community for +helping Perl to flourish. + +For a more complete list of all of Perl's historical contributors, please see +the F file in the Perl source distribution. + +=head1 Reporting Bugs + +If you find what you think is a bug, you might check the perl bug database at +L. There may also be information at +L, the Perl Home Page. + +If you believe you have an unreported bug, please open an issue at +L. Be sure to trim your bug down to a +tiny but sufficient test case. + +If the bug you are reporting has security implications which make it +inappropriate to send to a public issue tracker, then see +L for details of how to +report the issue. + +=head1 Give Thanks + +If you wish to thank the Perl 5 Porters for the work we had done in Perl 5, you +can do so by running the C program: + + perlthanks + +This will send an email to the Perl 5 Porters list with your show of thanks. + +=head1 SEE ALSO + +The F file for an explanation of how to view exhaustive details on +what changed. + +The F file for how to build Perl. + +The F file for general stuff. + +The F and F files for copyright information. + +=cut diff --git a/win32/pod.mak b/win32/pod.mak index 1d3cb5083b6a..7133f23a3e0e 100644 --- a/win32/pod.mak +++ b/win32/pod.mak @@ -63,6 +63,7 @@ POD = perl.pod \ perl5302delta.pod \ perl5303delta.pod \ perl5320delta.pod \ + perl5321delta.pod \ perl5330delta.pod \ perl5331delta.pod \ perl5332delta.pod \ @@ -232,6 +233,7 @@ MAN = perl.man \ perl5302delta.man \ perl5303delta.man \ perl5320delta.man \ + perl5321delta.man \ perl5330delta.man \ perl5331delta.man \ perl5332delta.man \ @@ -401,6 +403,7 @@ HTML = perl.html \ perl5302delta.html \ perl5303delta.html \ perl5320delta.html \ + perl5321delta.html \ perl5330delta.html \ perl5331delta.html \ perl5332delta.html \ @@ -570,6 +573,7 @@ TEX = perl.tex \ perl5302delta.tex \ perl5303delta.tex \ perl5320delta.tex \ + perl5321delta.tex \ perl5330delta.tex \ perl5331delta.tex \ perl5332delta.tex \ From 83141f18854bc07b4132f73a235a23b0ef49ff87 Mon Sep 17 00:00:00 2001 From: Sawyer X Date: Sun, 24 Jan 2021 21:11:30 +0100 Subject: [PATCH 481/503] Add freeze explanations --- Porting/release_schedule.pod | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 2cfb6b44c688..12b1b2ad5af8 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -46,9 +46,11 @@ you should reset the version numbers to the next blead series. 2020-11-20 5.33.4 ✓ Tom Hukins 2020-12-20 5.33.5 ✓ Max Maischein 2021-01-20 5.33.6 ✓ Richard Leach - 2021-02-20 5.33.7 Renee Backer - 2021-03-20 5.33.8 Atoomic - 2021-04-20 5.33.9 Todd Rinaldo + 2021-02-20 5.33.7 Renee Backer Contentious changes freeze + 2021-03-20 5.33.8 Atoomic User-visible changes to correctly + functioning programs freeze + 2021-04-20 5.33.9 Todd Rinaldo Full code freeze + 2021-05-20 5.34.0 Sawyer X Stable release! =head1 VICTIMS From 363d555f5b7270e39f32d528de33f616f22bfd6f Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sun, 24 Jan 2021 23:36:08 +0000 Subject: [PATCH 482/503] Rebreak lines to keep porting/podcheck.t happy In 83141f1885, the maximum line length of all lines added was 77, which should have passed the 78 maximum used in t/porting/podcheck.t. There were no tabs in the allegedly offending lines and no '=over' directives in operation. So it's unclear why this failed. Nonetheless, as additional commits are pending, it's expedienct for us to rebreak the lines manually to get the test program to pass and figure out the problem another day. --- Porting/release_schedule.pod | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/Porting/release_schedule.pod b/Porting/release_schedule.pod index 12b1b2ad5af8..47ca623bad43 100644 --- a/Porting/release_schedule.pod +++ b/Porting/release_schedule.pod @@ -47,8 +47,9 @@ you should reset the version numbers to the next blead series. 2020-12-20 5.33.5 ✓ Max Maischein 2021-01-20 5.33.6 ✓ Richard Leach 2021-02-20 5.33.7 Renee Backer Contentious changes freeze - 2021-03-20 5.33.8 Atoomic User-visible changes to correctly - functioning programs freeze + 2021-03-20 5.33.8 Atoomic User-visible changes to + correctly functioning programs + freeze 2021-04-20 5.33.9 Todd Rinaldo Full code freeze 2021-05-20 5.34.0 Sawyer X Stable release! From fd28d2bafae81353689d03f7598fb0f8afe02914 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Mon, 25 Jan 2021 00:07:26 +0000 Subject: [PATCH 483/503] Clarify calculation of max line length Changes in inline comments only; responds to concern raised in commit message for 363d555f5b. --- t/porting/podcheck.t | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/t/porting/podcheck.t b/t/porting/podcheck.t index ca19def72a65..d0961c07faca 100644 --- a/t/porting/podcheck.t +++ b/t/porting/podcheck.t @@ -360,8 +360,8 @@ my $MANIFEST = File::Spec->catfile(File::Spec->updir($original_dir), 'MANIFEST') my $copy_fh; my $MAX_LINE_LENGTH = 78; # 78 columns -my $INDENT = 4; # Things besides =head lines are indented at this - #least much +my $INDENT = 4; # Lines other than '=head' lines are indented at + # least this much # Our warning messages. Better not have [('"] in them, as those are used as # delimiters for variable parts of the messages by poderror. From 43b3b04375fdc4024b512403a3b7517c4c57d698 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Mon, 25 Jan 2021 13:15:32 +0000 Subject: [PATCH 484/503] Restore build with mingw.org compilers using mingw runtimes < 5.0 The Time::HiRes build was broken by 1d96b9c90e and requires a fix similar to daacfc6568 for mingw runtimes < 5.0. A definition of timespec was added in mingwrt-5.0. The compilers from mingw-w64 (which can be singled out by their definition of __MINGW64_VERSION_MAJOR) were not affected since they all have timespec defined anyway. For me, this fixes the build with my mingw.org compilers from 3.4.5 to 4.8.1 inclusive. These are using runtimes 3.15.2 to 4.0.3 (which actually reports itself as 3.20.0!) inclusive. Note that builds with mingw.org compilers using mingwrt >= 5.0 are still broken due to a different problem involving mkstemp(), as documented in 8a217c9aa7. See GH#15446 for more details. --- dist/Time-HiRes/HiRes.xs | 7 +++++-- pod/perldelta.pod | 5 +++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index ec43295e8f2b..14574a88ba1f 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -134,8 +134,11 @@ typedef struct { unsigned __int64 reset_time; } my_cxt_t; -/* Visual C++ 2013 and older don't have the timespec structure */ -# if defined(_MSC_VER) && _MSC_VER < 1900 +/* Visual C++ 2013 and older don't have the timespec structure. + * Neither do mingw.org compilers with MinGW runtimes older than 5.0. */ +# if((defined(_MSC_VER) && _MSC_VER < 1900) || \ + (defined(__MINGW32__) && !defined(__MINGW64_VERSION_MAJOR) && \ + defined(__MINGW32_MAJOR_VERSION) && __MINGW32_MAJOR_VERSION < 5)) struct timespec { time_t tv_sec; long tv_nsec; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b2f4d8bbb02c..b43aea457fc3 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -330,9 +330,10 @@ L section. =over 4 -=item XXX-some-platform +=item Windows -XXX +Building with mingw.org compilers (version 3.4.5 or later) using mingw runtime +versions < 5.0 now works again. This was broken in Perl 5.31.4. =back From fc65ff1f9f343e12605b2676b8ef4e5ca41131b0 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Mon, 25 Jan 2021 13:25:17 +0000 Subject: [PATCH 485/503] Bump $Time::HiRes::VERSION for commit 43b3b04375 --- dist/Time-HiRes/HiRes.pm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/dist/Time-HiRes/HiRes.pm b/dist/Time-HiRes/HiRes.pm index a7600b27893d..9377c3479fbd 100644 --- a/dist/Time-HiRes/HiRes.pm +++ b/dist/Time-HiRes/HiRes.pm @@ -50,7 +50,7 @@ our @EXPORT_OK = qw (usleep sleep ualarm alarm gettimeofday time tv_interval stat lstat utime ); -our $VERSION = '1.9766'; +our $VERSION = '1.9767'; our $XS_VERSION = $VERSION; $VERSION = eval $VERSION; From 341a561fb3c3b40f8730c0c5da27a1ea1136d781 Mon Sep 17 00:00:00 2001 From: Steve Hay Date: Tue, 26 Jan 2021 12:31:02 +0000 Subject: [PATCH 486/503] Restore build with some mingw.org compilers using mingw runtimes >= 3.21 MinGW runtime version 3.21 added a definition of mkstemp(), so requires a fix similar to f33b2f5852 for MinGW-w64's runtime 4.0 onwards. Based on a patch by Dan Collins on GH#15446. This commit also tweaks 43b3b04375, having discovered that mingw runtime 3.22 also contains a definition of timespec. For me, this fixes the build with my mingw.org 5.3.0 compiler using any of the mingw runtimes 3.21, 3.22.4 or 5.0 without breaking older versions such as 4.9.3 with the 3.20 runtime (or even with the withdrawn 4.0.3 runtime, which had __MINGW32_MAJOR/MINOR_VERSION set to 3.20 whilst adding new a __MINGW_MAJOR/MINOR_VERSION set to 4.0). However, 6.3.0 and 7.3.0 have other issues when compiling win32sck.c, while 8.2.0 and 9.2.0 have other issues again when compiling win32.c. See GH#18510 for more details. Also, C++ mode builds with some MinGW/MinGW-w64 compilers are still broken, as documented in 8a217c9aa7. See GH#16459 for more details. --- README.win32 | 8 +++----- dist/Time-HiRes/HiRes.xs | 5 +++-- pod/perldelta.pod | 5 ++++- win32/GNUmakefile | 2 +- win32/makefile.mk | 2 +- win32/win32.c | 4 +++- win32/win32.h | 4 +++- 7 files changed, 18 insertions(+), 12 deletions(-) diff --git a/README.win32 b/README.win32 index 73d74bdee8ab..863c7932d63b 100644 --- a/README.win32 +++ b/README.win32 @@ -41,8 +41,7 @@ following compilers on the Intel x86 architecture: Microsoft Visual C++ version 6.0 or later Intel C++ Compiler (experimental) - Gcc by mingw.org gcc version 3.4.5 or later - with runtime < 3.21 + Gcc by mingw.org gcc version 3.4.5-5.3.0 Gcc by mingw-w64.org gcc version 4.4.3 or later Note that the last two of these are actually competing projects both @@ -324,8 +323,7 @@ L You also need dmake or gmake. See L above on how to get it. -Note that the MinGW build currently requires a MinGW runtime version earlier -than 3.21 (check __MINGW32_MAJOR_VERSION and __MINGW32_MINOR_VERSION). +Note that the MinGW build currently fails with version 6.3.0 or later. Note also that the C++ mode build currently fails with MinGW 3.4.5 and 4.7.2 or later, and with MinGW64 64-bit 6.3.0 or later. @@ -970,6 +968,6 @@ Win9x support was added in 5.6 (Benjamin Stuhl). Support for 64-bit Windows added in 5.8 (ActiveState Corp). -Last updated: 30 April 2019 +Last updated: 26 January 2020 =cut diff --git a/dist/Time-HiRes/HiRes.xs b/dist/Time-HiRes/HiRes.xs index 14574a88ba1f..1b97962b3a6e 100644 --- a/dist/Time-HiRes/HiRes.xs +++ b/dist/Time-HiRes/HiRes.xs @@ -135,10 +135,11 @@ typedef struct { } my_cxt_t; /* Visual C++ 2013 and older don't have the timespec structure. - * Neither do mingw.org compilers with MinGW runtimes older than 5.0. */ + * Neither do mingw.org compilers with MinGW runtimes older than 3.22. */ # if((defined(_MSC_VER) && _MSC_VER < 1900) || \ (defined(__MINGW32__) && !defined(__MINGW64_VERSION_MAJOR) && \ - defined(__MINGW32_MAJOR_VERSION) && __MINGW32_MAJOR_VERSION < 5)) + defined(__MINGW32_MAJOR_VERSION) && (__MINGW32_MAJOR_VERSION < 3 || \ + (__MINGW32_MAJOR_VERSION == 3 && __MINGW32_MINOR_VERSION < 22)))) struct timespec { time_t tv_sec; long tv_nsec; diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b43aea457fc3..b4bc6a0f87c5 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -333,7 +333,10 @@ L section. =item Windows Building with mingw.org compilers (version 3.4.5 or later) using mingw runtime -versions < 5.0 now works again. This was broken in Perl 5.31.4. +versions < 3.22 now works again. This was broken in Perl 5.31.4. + +Building with mingw.org compilers (version 3.4.5 or later) using mingw runtime +versions >= 3.21 now works (for compilers up to version 5.3.0). =back diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 4ce7ce71653f..c704e8a7c798 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -2,7 +2,7 @@ # Makefile to build perl on Windows using GMAKE. # Supported compilers: # Microsoft Visual C++ 7.0 or later -# MinGW with gcc-3.4.5 or later with runtime < 3.21 +# MinGW with gcc-3.4.5-5.3.0 # MinGW64 with gcc-4.4.3 or later # Windows SDK 64-bit compiler and tools # diff --git a/win32/makefile.mk b/win32/makefile.mk index dc2d79d48cfc..683ee135a27a 100644 --- a/win32/makefile.mk +++ b/win32/makefile.mk @@ -2,7 +2,7 @@ # Makefile to build perl on Windows using DMAKE. # Supported compilers: # Microsoft Visual C++ 7.0 or later -# MinGW with gcc-3.4.5 or later with runtime < 3.21 +# MinGW with gcc-3.4.5-5.3.0 # MinGW64 with gcc-4.4.3 or later # Windows SDK 64-bit compiler and tools # diff --git a/win32/win32.c b/win32/win32.c index cdd5685c4176..7163a58fbc3d 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -1160,7 +1160,9 @@ chown(const char *path, uid_t owner, gid_t group) * XXX this needs strengthening (for PerlIO) * -- BKS, 11-11-200 */ -#if !defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4 +#if((!defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4) && \ + (!defined(__MINGW32_MAJOR_VERSION) || __MINGW32_MAJOR_VERSION < 3 || \ + (__MINGW32_MAJOR_VERSION == 3 && __MINGW32_MINOR_VERSION < 21))) int mkstemp(const char *path) { dTHX; diff --git a/win32/win32.h b/win32/win32.h index 2325d0edc963..6d5e186204d5 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -418,7 +418,9 @@ extern void *sbrk(ptrdiff_t need); #endif extern char * getlogin(void); extern int chown(const char *p, uid_t o, gid_t g); -#if !defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4 +#if((!defined(__MINGW64_VERSION_MAJOR) || __MINGW64_VERSION_MAJOR < 4) && \ + (!defined(__MINGW32_MAJOR_VERSION) || __MINGW32_MAJOR_VERSION < 3 || \ + (__MINGW32_MAJOR_VERSION == 3 && __MINGW32_MINOR_VERSION < 21))) extern int mkstemp(const char *path); #endif #endif From 76b7a9755884361239145cf00fcfc17625a42a1a Mon Sep 17 00:00:00 2001 From: xenu Date: Thu, 28 Jan 2021 13:49:52 +0100 Subject: [PATCH 487/503] win32: remove makefile.mk (#18511) Makefile.mk is redundant with GNUmakefile. See https://www.nntp.perl.org/group/perl.perl5.porters/2021/01/msg258848.html for more details. We planned to remove it shortly after the introduction of GNUmakefile but that slipped through the cracks for some reason: https://github.com/Perl/perl5/issues/14341 --- MANIFEST | 1 - Porting/add-package.pl | 4 +- Porting/makerel | 1 - Porting/pod_lib.pl | 1 - Porting/pod_rules.pl | 2 - README.cygwin | 2 +- README.win32 | 60 +- make_ext.pl | 4 - pod/perldelta.pod | 4 + pod/perlmodinstall.pod | 5 +- regen/lib_cleanup.pl | 2 +- t/porting/pod_rules.t | 1 - t/porting/regen.t | 2 +- win32/config.gc | 2 +- win32/makefile.mk | 1961 ---------------------------------------- 15 files changed, 28 insertions(+), 2024 deletions(-) delete mode 100644 win32/makefile.mk diff --git a/MANIFEST b/MANIFEST index 2c9afd4f6d2f..aa3ff73cda36 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6280,7 +6280,6 @@ win32/include/sys/errno2.h Win32 port win32/include/sys/socket.h Win32 port win32/list_static_libs.pl prints libraries for static linking win32/Makefile Win32 makefile for NMAKE (Visual C++ build) -win32/makefile.mk Win32 makefile for DMAKE (BC++, VC++ builds) win32/perlexe.ico perlexe.ico image file win32/perlexe.manifest Assembly manifest file win32/perlexe.rc associated perl binary with icon diff --git a/Porting/add-package.pl b/Porting/add-package.pl index 012aa77894ca..af04c8f8bec8 100755 --- a/Porting/add-package.pl +++ b/Porting/add-package.pl @@ -319,11 +319,11 @@ } } - ### add entries to win32/Makefile and win32/makefile.mk + ### add entries to win32/Makefile ### they contain the following lines: # ./win32/makefile.mk: ..\utils\ptardiff \ # ./win32/makefile.mk: xsubpp instmodsh prove ptar ptardiff - for my $file ( qw[win32/Makefile win32/makefile.mk] ) { + for my $file ( qw[win32/Makefile] ) { unless ( `grep $bin $Repo/$file` ) { print " Adding $bin entries to $file..." if $Verbose; diff --git a/Porting/makerel b/Porting/makerel index e9a7ea41adf0..79c17f484b18 100755 --- a/Porting/makerel +++ b/Porting/makerel @@ -303,7 +303,6 @@ my @writables = qw( lib/warnings.pm win32/GNUmakefile win32/Makefile - win32/makefile.mk win32/config_H.gc win32/config_H.vc uconfig.h diff --git a/Porting/pod_lib.pl b/Porting/pod_lib.pl index 3e6483732333..8f8ebf2ffe95 100644 --- a/Porting/pod_lib.pl +++ b/Porting/pod_lib.pl @@ -186,7 +186,6 @@ =head2 C manifest => 'MANIFEST', vms => 'vms/descrip_mms.template', nmake => 'win32/Makefile', - dmake => 'win32/makefile.mk', gmake => 'win32/GNUmakefile', podmak => 'win32/pod.mak', unix => 'Makefile.SH', diff --git a/Porting/pod_rules.pl b/Porting/pod_rules.pl index 434f1fd35af8..d10c669c4aee 100644 --- a/Porting/pod_rules.pl +++ b/Porting/pod_rules.pl @@ -24,7 +24,6 @@ manifest => 'MANIFEST', vms => 'vms/descrip_mms.template', nmake => 'win32/Makefile', - dmake => 'win32/makefile.mk', gmake => 'win32/GNUmakefile', podmak => 'win32/pod.mak', unix => 'Makefile.SH', @@ -165,7 +164,6 @@ sub do_nmake { } # shut up used only once warning -*do_dmake = *do_dmake = \&do_nmake; *do_gmake = *do_gmake = \&do_nmake; sub do_podmak { diff --git a/README.cygwin b/README.cygwin index 6ad9fb542c15..dec28527052c 100644 --- a/README.cygwin +++ b/README.cygwin @@ -598,7 +598,7 @@ be kept as clean as possible. plan9/mkfile hints/uwin.sh vms/descrip_mms.template - win32/Makefile win32/makefile.mk + win32/Makefile =item Tests diff --git a/README.win32 b/README.win32 index 863c7932d63b..e0075d3f46cd 100644 --- a/README.win32 +++ b/README.win32 @@ -97,20 +97,9 @@ See L below for general hints about this. You need a "make" program to build the sources. If you are using Visual C++ or the Windows SDK tools, you can use nmake supplied with Visual C++ -or Windows SDK. You may also use, for Visual C++ or Windows SDK, dmake or gmake -instead of nmake. dmake is open source software, but is not included with -Visual C++ or Windows SDK. Builds using gcc need dmake or gmake. nmake is not -supported for gcc builds. Parallel building is only supported with dmake and -gmake, not nmake. When using dmake it is recommended to use dmake 4.13 or newer -for parallel building. Older dmakes, in parallel mode, have very high CPU usage -and pound the disk/filing system with duplicate I/O calls in an aggressive -polling loop. - -A port of dmake for Windows is available from: - -L - -Fetch and install dmake somewhere on your path. +or Windows SDK. You may also use gmake instead of nmake. Builds using gcc need +gmake. nmake is not supported for gcc builds. Parallel building is only +supported with gmake, not nmake. =item Command Shell @@ -321,7 +310,8 @@ MinGW64 (version 4.4.3 or later). It can be downloaded here: L L -You also need dmake or gmake. See L above on how to get it. +You also need gmake. Usually it comes with MinGW but its executable may have +a different name, such as mingw32-make.exe. Note that the MinGW build currently fails with version 6.3.0 or later. @@ -354,15 +344,14 @@ unlike GCC. Make sure you are in the "win32" subdirectory under the perl toplevel. This directory contains a "Makefile" that will work with versions of nmake that come with Visual C++ or the Windows SDK, and -a GNU make "GNUmakefile" or dmake "makefile.mk" that will work for all -supported compilers. The defaults in the gmake and dmake makefile are -setup to build using MinGW/gcc. +a GNU make "GNUmakefile" that will work for all supported compilers. +The defaults in the gmake makefile are setup to build using MinGW/gcc. =item * -Edit the GNUmakefile, makefile.mk (or Makefile, if you're using nmake) -and change the values of INST_DRV and INST_TOP. You can also enable -various build flags. These are explained in the makefiles. +Edit the GNUmakefile (or Makefile, if you're using nmake) and change the values +of INST_DRV and INST_TOP. You can also enable various build flags. These are +explained in the makefiles. Note that it is generally not a good idea to try to build a perl with INST_DRV and INST_TOP set to a path that already exists from a previous @@ -378,7 +367,7 @@ F directories. If building with the cross-compiler provided by mingw-w64.org you'll need to uncomment the line that sets -GCCCROSS in the makefile.mk. Do this only if it's the cross-compiler - ie +GCCCROSS in the GNUmakefile. Do this only if it's the cross-compiler - ie only if the bin folder doesn't contain a gcc.exe. (The cross-compiler does not provide a gcc.exe, g++.exe, ar.exe, etc. Instead, all of these executables are prefixed with 'x86_64-w64-mingw32-'.) @@ -394,21 +383,18 @@ Be sure to read the instructions near the top of the makefiles carefully. =item * -Type "dmake" ("gmake" for GNU make, or "nmake" if you are using that make). +Type "gmake" (or "nmake" if you are using that make). This should build everything. Specifically, it will create perl.exe, perl533.dll at the perl toplevel, and various other extension dll's under the lib\auto directory. If the build fails for any reason, make sure you have done the previous steps correctly. -To try dmake's parallel mode, type "dmake -P2", where 2, is the maximum number +To try gmake's parallel mode, type "gmake -j2", where 2, is the maximum number of parallel jobs you want to run. A number of things in the build process will run in parallel, but there are serialization points where you will see just 1 CPU maxed out. This is normal. -Similarly you can build in parallel with GNU make, type "gmake -j2" to -build with two parallel jobs, or higher for more. - If you are advanced enough with building C code, here is a suggestion to speed up building perl, and the later C. Try to keep your PATH environmental variable with the least number of folders possible (remember to keep your C @@ -420,7 +406,7 @@ is the most commonly launched program during the build and later testing. =head2 Testing Perl on Windows -Type "dmake test" (or "gmake test", "nmake test"). This will run most +Type "gmake test" (or "nmake test"). This will run most of the tests from the testsuite (many tests will be skipped). There should be no test failures. @@ -448,7 +434,7 @@ native "cmd.exe", or if you are building from a path that contains spaces. So don't do that. If you are running the tests from a emacs shell window, you may see -failures in op/stat.t. Run "dmake test-notty" in that case. +failures in op/stat.t. Run "gmake test-notty" in that case. Furthermore, you should make sure that during C you do not have any GNU tool packages in your path: some toolkits like Unixutils @@ -467,7 +453,7 @@ Please report any other failures as described under L. =head2 Installation of Perl on Windows -Type "dmake install" (or "gmake install", "nmake install"). This will +Type "gmake install" ("nmake install"). This will put the newly built perl and the libraries under whatever C points to in the Makefile. It will also install the pod documentation under C<$INST_TOP\$INST_VER\lib\pod> and HTML versions of the same @@ -650,25 +636,13 @@ may not provide a testsuite (so "$MAKE test" may not do anything or fail), but most serious ones do. It is important that you use a supported 'make' program, and -ensure Config.pm knows about it. If you don't have nmake, you can -either get dmake from the location mentioned earlier or get an -old version of nmake reportedly available from: - -L - -Another option is to use the make written in Perl, available from -CPAN. - -L - -You may also use dmake or gmake. See L above on how to get it. +ensure Config.pm knows about it. Note that MakeMaker actually emits makefiles with different syntax depending on what 'make' it thinks you are using. Therefore, it is important that one of the following values appears in Config.pm: make='nmake' # MakeMaker emits nmake syntax - make='dmake' # MakeMaker emits dmake syntax any other value # MakeMaker emits generic make syntax (e.g GNU make, or Perl make) diff --git a/make_ext.pl b/make_ext.pl index 79ae1efb1ae9..ba507c8abc33 100644 --- a/make_ext.pl +++ b/make_ext.pl @@ -36,10 +36,6 @@ # # make_ext.pl "MAKE=nmake -nologo" --dir=..\ext --target=clean # -# make_ext.pl MAKE=dmake --dir=..\ext -# -# make_ext.pl MAKE=dmake --dir=..\ext --target=clean -# # Will skip building extensions which are marked with an '!' char. # Mostly because they still not ported to specified platform. # diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b4bc6a0f87c5..f858802a048c 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -338,6 +338,10 @@ versions < 3.22 now works again. This was broken in Perl 5.31.4. Building with mingw.org compilers (version 3.4.5 or later) using mingw runtime versions >= 3.21 now works (for compilers up to version 5.3.0). +Makefile.mk, and thus support for dmake, has been removed. It is still possible +to build Perl on Windows using nmake (Makefile) and GNU make (GNUmakefile). +[L] + =back =head1 Internal Changes diff --git a/pod/perlmodinstall.pod b/pod/perlmodinstall.pod index aba1ab995ff0..b07ef71ecc4b 100644 --- a/pod/perlmodinstall.pod +++ b/pod/perlmodinstall.pod @@ -139,10 +139,7 @@ If you used WinZip, this was already done for you. C. BUILD -You'll need the C utility, available at -L -or dmake, available on CPAN. -L +You'll need either C or C. Does the module require compilation (i.e. does it have files that end in .xs, .c, .h, .y, .cc, .cxx, or .C)? If it does, life is now diff --git a/regen/lib_cleanup.pl b/regen/lib_cleanup.pl index d80a33ce028f..3ba86f99c939 100644 --- a/regen/lib_cleanup.pl +++ b/regen/lib_cleanup.pl @@ -154,7 +154,7 @@ sub edit_win32_makefile { } process('Makefile.SH', 'Makefile.SH', \&edit_makefile_SH, $TAP && '', $Verbose); -foreach ('win32/Makefile', 'win32/makefile.mk', 'win32/GNUmakefile') { +foreach ('win32/Makefile', 'win32/GNUmakefile') { process($_, $_, \&edit_win32_makefile, $TAP && '', $Verbose); } diff --git a/t/porting/pod_rules.t b/t/porting/pod_rules.t index d3b36bab2c9c..00195992c0ca 100644 --- a/t/porting/pod_rules.t +++ b/t/porting/pod_rules.t @@ -6,7 +6,6 @@ # # Why do we test this? # Among other reasons, to check the well-formed-ness of these files: -# win32/makefile.mk # MANIFEST # win32/Makefile # win32/pod.mak diff --git a/t/porting/regen.t b/t/porting/regen.t index 30d7c0fba630..d684fdc19ffa 100644 --- a/t/porting/regen.t +++ b/t/porting/regen.t @@ -26,7 +26,7 @@ if ( $Config{usecrosscompile} ) { skip_all( "Not all files are available during cross-compilation" ); } -my $tests = 25; # I can't see a clean way to calculate this automatically. +my $tests = 24; # I can't see a clean way to calculate this automatically. my %skip = ("regen_perly.pl" => [qw(perly.act perly.h perly.tab)], "regen/keywords.pl" => [qw(keywords.c keywords.h)], diff --git a/win32/config.gc b/win32/config.gc index b6e298f3b5f2..af6fed92fbea 100644 --- a/win32/config.gc +++ b/win32/config.gc @@ -894,7 +894,7 @@ lseektype='long long' mad='undef' mail='' mailx='' -make='dmake' +make='gmake' make_set_make='#' mallocobj='malloc.o' mallocsrc='malloc.c' diff --git a/win32/makefile.mk b/win32/makefile.mk deleted file mode 100644 index 683ee135a27a..000000000000 --- a/win32/makefile.mk +++ /dev/null @@ -1,1961 +0,0 @@ -# -# Makefile to build perl on Windows using DMAKE. -# Supported compilers: -# Microsoft Visual C++ 7.0 or later -# MinGW with gcc-3.4.5-5.3.0 -# MinGW64 with gcc-4.4.3 or later -# Windows SDK 64-bit compiler and tools -# -# This is set up to build a perl.exe that runs off a shared library -# (perl533.dll). Also makes individual DLLs for the XS extensions. -# - -## -## Make sure you read README.win32 *before* you mess with anything here! -## - -# -# Import everything from the environment like NMAKE does. -# -.IMPORT : .EVERYTHING - -## -## Build configuration. Edit the values below to suit your needs. -## - -# -# Set these to wherever you want "dmake install" to put your -# newly built perl. -# -INST_DRV *= c: -INST_TOP *= $(INST_DRV)\perl - -# -# Uncomment if you want to build a 32-bit Perl using a 32-bit compiler -# on a 64-bit version of Windows. -# -#WIN64 *= undef - -# -# Comment this out if you DON'T want your perl installation to be versioned. -# This means that the new installation will overwrite any files from the -# old installation at the same INST_TOP location. Leaving it enabled is -# the safest route, as perl adds the extra version directory to all the -# locations it installs files to. If you disable it, an alternative -# versioned installation can be obtained by setting INST_TOP above to a -# path that includes an arbitrary version string. -# -#INST_VER *= \5.33.7 - -# -# Comment this out if you DON'T want your perl installation to have -# architecture specific components. This means that architecture- -# specific files will be installed along with the architecture-neutral -# files. Leaving it enabled is safer and more flexible, in case you -# want to build multiple flavors of perl and install them together in -# the same location. Commenting it out gives you a simpler -# installation that is easier to understand for beginners. -# -#INST_ARCH *= \$(ARCHNAME) - -# -# Uncomment this if you want perl to run -# $Config{sitelibexp}\sitecustomize.pl -# before anything else. This script can then be set up, for example, -# to add additional entries to @INC. -# -#USE_SITECUST *= define - -# -# uncomment to enable multiple interpreters. This is needed for fork() -# emulation and for thread support, and is auto-enabled by USE_IMP_SYS -# and USE_ITHREADS below. -# -USE_MULTI *= define - -# -# Interpreter cloning/threads; now reasonably complete. -# This should be enabled to get the fork() emulation. This needs (and -# will auto-enable) USE_MULTI above. -# -USE_ITHREADS *= define - -# -# uncomment to enable the implicit "host" layer for all system calls -# made by perl. This is also needed to get fork(). This needs (and -# will auto-enable) USE_MULTI above. -# -USE_IMP_SYS *= define - -# -# Uncomment this if you're building a 32-bit perl and want 64-bit integers. -# (If you're building a 64-bit perl then you will have 64-bit integers whether -# or not this is uncommented.) -# -#USE_64_BIT_INT *= define - -# -# Uncomment this if you want to support the use of long doubles in GCC builds. -# This option is not supported for MSVC builds. -# -#USE_LONG_DOUBLE *= define - -# -# Uncomment this if you want to support the use of __float128s in GCC builds. -# This option is not supported for MSVC builds. -# -#USE_QUADMATH *= define -#I_QUADMATH *= define - -# -# Comment this out if you want to build perl without __USE_MINGW_ANSI_STDIO defined. -# (If you're building perl with USE_LONG_DOUBLE defined then -# __USE_MINGW_ANSI_STDIO will be defined whether or not this is uncommented.) -# The advantage of defining __USE_MINGW_ANSI_STDIO is that it provides correct -# (s)printf formatting of numbers, whereas the MS runtime might not. -# This option has no effect on MSVC builds. -# -USE_MINGW_ANSI_STDIO *= define - -# -# Comment this out if you want the legacy default behavior of including '.' at -# the end of @INC. -# -DEFAULT_INC_EXCLUDES_DOT *= define - -# -# Uncomment this if you want to disable looking up values from -# HKEY_CURRENT_USER\Software\Perl and HKEY_LOCAL_MACHINE\Software\Perl in -# the Registry. -# -#USE_NO_REGISTRY *= define - -# -# uncomment exactly one of the following -# -# Visual C++ .NET 2002/2003 (aka Visual C++ 7.0/7.1) (full version) -#CCTYPE *= MSVC70 -# Visual C++ Toolkit 2003 (aka Visual C++ 7.1) (free command-line tools) -#CCTYPE *= MSVC70FREE -# Windows Server 2003 SP1 Platform SDK (April 2005) (64-bit compiler and tools) -#CCTYPE = SDK2003SP1 -# Visual C++ 2005 (aka Visual C++ 8.0) (full version or Express Edition) -#CCTYPE *= MSVC80 -# Visual C++ 2008 (aka Visual C++ 9.0) (full version or Express Edition) -#CCTYPE *= MSVC90 -# Visual C++ 2010 (aka Visual C++ 10.0) (full version or Express Edition) -#CCTYPE = MSVC100 -# Visual C++ 2012 (aka Visual C++ 11.0) (full version or Express Edition) -#CCTYPE = MSVC110 -# Visual C++ 2013 (aka Visual C++ 12.0) (full version or Express Edition) -#CCTYPE = MSVC120 -# Visual C++ 2015 (aka Visual C++ 14.0) (full version or Express Edition) -#CCTYPE = MSVC140 -# Visual C++ 2017 (aka Visual C++ 14.1) (full version or Community Edition) -#CCTYPE = MSVC141 -# Visual C++ 2019 (aka Visual C++ 14.2) (full version or Community Edition) -#CCTYPE = MSVC142 -# MinGW or mingw-w64 with gcc-3.4.5 or later -#CCTYPE = GCC - -# -# If you are using GCC, 4.3 or later by default we add the -fwrapv option. -# See https://github.com/Perl/perl5/issues/13690 -# -#GCCWRAPV *= define - -# -# If you are using Intel C++ Compiler uncomment this -# -#__ICC *= define - -# -# Uncomment this if you want to build everything in C++ mode -# -#USE_CPLUSPLUS *= define - -# -# uncomment next line if you want debug version of perl (big/slow) -# If not enabled, we automatically try to use maximum optimization -# with all compilers that are known to have a working optimizer. -# -# You can also set CFG = DebugSymbols for a slightly smaller/faster -# debug build without the special debugging code in perl which is -# enabled via -DDEBUGGING; -# -# or you can set CFG = DebugFull for an even fuller (bigger/slower) -# debug build using the debug version of the CRT, and enabling VC++ -# debug features such as extra assertions and invalid parameter warnings -# in perl and CRT code via -D_DEBUG. (Note that the invalid parameter -# handler does get triggered from time to time in this configuration, -# which causes warnings to be printed on STDERR, which in turn causes a -# few tests to fail.) (This configuration is only available for VC++ builds.) -# -#CFG *= Debug - -# -# uncomment to enable linking with setargv.obj under the Visual C -# compiler. Setting this options enables perl to expand wildcards in -# arguments, but it may be harder to use alternate methods like -# File::DosGlob that are more powerful. This option is supported only with -# Visual C. -# -#USE_SETARGV *= define - -# -# set this if you wish to use perl's malloc -# WARNING: Turning this on/off WILL break binary compatibility with extensions -# you may have compiled with/without it. Be prepared to recompile all -# extensions if you change the default. Currently, this cannot be enabled -# if you ask for USE_IMP_SYS above. -# -#PERL_MALLOC *= define - -# -# set this to enable debugging mstats -# This must be enabled to use the Devel::Peek::mstat() function. This cannot -# be enabled without PERL_MALLOC as well. -# -#DEBUG_MSTATS *= define - -# -# set this to additionally provide a statically linked perl-static.exe. -# Note that dynamic loading will not work with this perl, so you must -# include required modules statically using the STATIC_EXT or ALL_STATIC -# variables below. A static library perl533s.lib will also be created. -# Ordinary perl.exe is not affected by this option. -# -#BUILD_STATIC *= define - -# -# in addition to BUILD_STATIC the option ALL_STATIC makes *every* -# extension get statically built. -# This will result in a very large perl executable, but the main purpose -# is to have proper linking set so as to be able to create miscellaneous -# executables with different built-in extensions. It implies BUILD_STATIC. -# -#ALL_STATIC *= define - -# -# set the install location of the compiler -# Running VCVARS32.BAT, VCVARSALL.BAT or similar is *required* when using -# Visual C++. -# -# For GCC builds this should be the directory containing the bin, include, -# lib directories for your compiler. -# - -#CCHOME *= C:\MinGW - -# -# uncomment this if you are using x86_64-w64-mingw32 cross-compiler -# ie if your gcc executable is called 'x86_64-w64-mingw32-gcc' -# instead of the usual 'gcc'. -# -#GCCCROSS *= define - -# -# Additional compiler flags can be specified here. -# -BUILDOPT *= $(BUILDOPTEXTRA) - -# -# This should normally be disabled. Enabling it will disable the File::Glob -# implementation of CORE::glob. -# -#BUILDOPT += -DPERL_EXTERNAL_GLOB - -# -# Perl needs to read scripts in text mode so that the DATA filehandle -# works correctly with seek() and tell(), or around auto-flushes of -# all filehandles (e.g. by system(), backticks, fork(), etc). -# -# The current version on the ByteLoader module on CPAN however only -# works if scripts are read in binary mode. But before you disable text -# mode script reading (and break some DATA filehandle functionality) -# please check first if an updated ByteLoader isn't available on CPAN. -# -BUILDOPT += -DPERL_TEXTMODE_SCRIPTS - -# -# specify semicolon-separated list of extra directories that modules will -# look for libraries (spaces in path names need not be quoted) -# -EXTRALIBDIRS *= - -# -# set this to point to cmd.exe (only needed if you use some -# alternate shell that doesn't grok cmd.exe style commands) -# -#SHELL *= g:\winnt\system32\cmd.exe - -# -# set this to your email address (perl will guess a value from -# your loginname and your hostname, which may not be right) -# -#EMAIL *= - -## -## Build configuration ends. -## - -##################### CHANGE THESE ONLY IF YOU MUST ##################### - -PERL_MALLOC *= undef -DEBUG_MSTATS *= undef - -USE_SITECUST *= undef -USE_MULTI *= undef -USE_ITHREADS *= undef -USE_IMP_SYS *= undef -USE_64_BIT_INT *= undef -USE_LONG_DOUBLE *= undef -USE_QUADMATH *= undef -I_QUADMATH *= undef -DEFAULT_INC_EXCLUDES_DOT *= undef -USE_NO_REGISTRY *= undef - - -.IF "$(USE_IMP_SYS)" == "define" -PERL_MALLOC = undef -.ENDIF - -.IF "$(PERL_MALLOC)" == "undef" -DEBUG_MSTATS = undef -.ENDIF - -.IF "$(DEBUG_MSTATS)" == "define" -BUILDOPT += -DPERL_DEBUGGING_MSTATS -.ENDIF - -.IF "$(USE_IMP_SYS) $(USE_MULTI)" == "define undef" -USE_MULTI != define -.ENDIF - -.IF "$(USE_ITHREADS) $(USE_MULTI)" == "define undef" -USE_MULTI != define -.ENDIF - -.IF "$(USE_SITECUST)" == "define" -BUILDOPT += -DUSE_SITECUSTOMIZE -.ENDIF - -.IF "$(USE_MULTI)" != "undef" -BUILDOPT += -DPERL_IMPLICIT_CONTEXT -.ENDIF - -.IF "$(USE_IMP_SYS)" != "undef" -BUILDOPT += -DPERL_IMPLICIT_SYS -.ENDIF - -.IF "$(USE_NO_REGISTRY)" != "undef" -BUILDOPT += -DWIN32_NO_REGISTRY -.ENDIF - -.IF "$(CCTYPE)" == "GCC" -GCCTARGET := $(shell gcc -dumpmachine & exit /b 0) -.ENDIF - -#no explicit CCTYPE given, do auto detection -.IF "$(CCTYPE)" == "" -GCCTARGET := $(shell gcc -dumpmachine 2>NUL & exit /b 0) -#do we have a GCC? -.IF "$(GCCTARGET)" != "" -CCTYPE = GCC -.ELSE -WIN64 := $(shell for /f "tokens=3 delims=.^ " \ - %i in ('cl ^2^>^&1') do @if "%i" == "32-bit" echo undef) -#major version of CL has diff position based on 32 vs 64 -#Microsoft (R) C/C++ Optimizing Compiler Version 15.00.30729.01 for x64 -#Microsoft (R) 32-bit C/C++ Optimizing Compiler Version 15.00.30729.01 for 80x86 -#use var to capture 1st line only, not 8th token of lines 2 & 3 in cl.exe output -.IF "$(WIN64)" == "undef" -MSVCVER := $(shell (set MSVCVER=) & (for /f "tokens=8,9 delims=.^ " \ - %i in ('cl ^2^>^&1') do @if not defined MSVCVER if %i% geq 19 \ - (set /A "MSVCVER=((%i-5)*10)+(%j/10)") \ - else (set /A "MSVCVER=(%i-6)*10"))) -.ELSE -MSVCVER := $(shell (set MSVCVER=) & (for /f "tokens=7,8 delims=.^ " \ - %i in ('cl ^2^>^&1') do @if not defined MSVCVER if %i% geq 19 \ - (set /A "MSVCVER=((%i-5)*10)+(%j/10)") \ - else (set /A "MSVCVER=(%i-6)*10"))) -.ENDIF -#autodetect failed, reset to empty string -.IF "$(MSVCVER)" == "-50" -CCTYPE := -.ELSE -CCTYPE := MSVC$(MSVCVER) -.ENDIF -.ENDIF -.ENDIF - -# Versions of Visual C++ up to VC++ 7.1 define $(MSVCDir); versions since then -# define $(VCINSTALLDIR) instead, but for VC++ 14.1 we need the subfolder given -# by $(VCToolsInstallDir). -.IF "$(CCHOME)" == "" -.IF "$(CCTYPE)" == "GCC" -CCHOME *= C:\MinGW -.ELIF "$(CCTYPE)" == "MSVC70" || "$(CCTYPE)" == "MSVC70FREE" -CCHOME *= $(MSVCDir) -.ELIF "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -CCHOME *= $(VCToolsInstallDir) -.ELSE -CCHOME *= $(VCINSTALLDIR) -.ENDIF -.ENDIF - -PROCESSOR_ARCHITECTURE *= x86 - -.IF "$(WIN64)" == "undef" -PROCESSOR_ARCHITECTURE = x86 -.ENDIF - -.IF "$(WIN64)" == "" -# When we are running from a 32bit cmd.exe on AMD64 then -# PROCESSOR_ARCHITECTURE is set to x86 and PROCESSOR_ARCHITEW6432 -# is set to AMD64 -.IF "$(PROCESSOR_ARCHITEW6432)" != "" -PROCESSOR_ARCHITECTURE != $(PROCESSOR_ARCHITEW6432) -WIN64 = define -.ELIF "$(PROCESSOR_ARCHITECTURE)" == "AMD64" || "$(PROCESSOR_ARCHITECTURE)" == "IA64" -WIN64 = define -.ELSE -WIN64 = undef -.ENDIF -.ENDIF - -.IF "$(WIN64)" == "define" -USE_64_BIT_INT = define -.ENDIF - -# Disable the long double option for MSVC builds since that compiler -# does not support it. -.IF "$(CCTYPE)" != "GCC" -USE_LONG_DOUBLE != undef -.ENDIF - -# Disable the __foat128 option for MSVC builds since that compiler -# does not support it. -.IF "$(CCTYPE)" != "GCC" -USE_QUADMATH != undef -I_QUADMATH != undef -.ENDIF - -ARCHITECTURE = $(PROCESSOR_ARCHITECTURE) -.IF "$(ARCHITECTURE)" == "AMD64" -ARCHITECTURE = x64 -.ENDIF -.IF "$(ARCHITECTURE)" == "IA64" -ARCHITECTURE = ia64 -.ENDIF - -.IF "$(USE_MULTI)" == "define" -ARCHNAME = MSWin32-$(ARCHITECTURE)-multi -.ELSE -ARCHNAME = MSWin32-$(ARCHITECTURE)-perlio -.ENDIF - -.IF "$(USE_ITHREADS)" == "define" -ARCHNAME !:= $(ARCHNAME)-thread -.ENDIF - -.IF "$(WIN64)" != "define" -.IF "$(USE_64_BIT_INT)" == "define" -ARCHNAME !:= $(ARCHNAME)-64int -.ENDIF -.ENDIF - -.IF "$(USE_LONG_DOUBLE)" == "define" -ARCHNAME !:= $(ARCHNAME)-ld -.ENDIF - -.IF "$(USE_QUADMATH)" == "define" -ARCHNAME !:= $(ARCHNAME)-quadmath -.ENDIF - -# Set the install location of the compiler headers/libraries. -# These are saved into $Config{incpath} and $Config{libpth}. -.IF "$(GCCCROSS)" == "define" -CCINCDIR *= $(CCHOME)\x86_64-w64-mingw32\include -CCLIBDIR *= $(CCHOME)\x86_64-w64-mingw32\lib -.ELIF "$(CCTYPE)" == "GCC" -CCINCDIR *= $(CCHOME)\include -CCLIBDIR *= $(CCHOME)\lib -.ELSE -CCINCDIR *= $(CCHOME)\include -.IF "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -.IF "$(WIN64)" == "define" -CCLIBDIR *= $(CCHOME)\lib\x64 -.ELSE -CCLIBDIR *= $(CCHOME)\lib\x86 -.ENDIF -.ELSE -.IF "$(WIN64)" == "define" -CCLIBDIR *= $(CCHOME)\lib\amd64 -.ELSE -CCLIBDIR *= $(CCHOME)\lib -.ENDIF -.ENDIF -.ENDIF - -# Set DLL location for GCC compilers. -.IF "$(CCTYPE)" == "GCC" -.IF "$(GCCCROSS)" == "define" -CCDLLDIR *= $(CCLIBDIR) -.ELSE -CCDLLDIR *= $(CCHOME)\bin -.ENDIF -.ENDIF - -ARCHDIR = ..\lib\$(ARCHNAME) -COREDIR = ..\lib\CORE -AUTODIR = ..\lib\auto -LIBDIR = ..\lib -EXTDIR = ..\ext -DISTDIR = ..\dist -CPANDIR = ..\cpan -PODDIR = ..\pod -HTMLDIR = .\html - -INST_SCRIPT = $(INST_TOP)$(INST_VER)\bin -INST_BIN = $(INST_SCRIPT)$(INST_ARCH) -INST_LIB = $(INST_TOP)$(INST_VER)\lib -INST_ARCHLIB = $(INST_LIB)$(INST_ARCH) -INST_COREDIR = $(INST_ARCHLIB)\CORE -INST_HTML = $(INST_TOP)$(INST_VER)\html - -# -# Programs to compile, build .lib files and link -# - -.USESHELL : - -MINIBUILDOPT *= - -.IF "$(CCTYPE)" == "GCC" - -.IF "$(GCCCROSS)" == "define" -ARCHPREFIX = x86_64-w64-mingw32- -.ENDIF - -CC = $(ARCHPREFIX)gcc -LINK32 = $(ARCHPREFIX)g++ -LIB32 = $(ARCHPREFIX)ar rc -IMPLIB = $(ARCHPREFIX)dlltool -RSC = $(ARCHPREFIX)windres - -.IF "$(USE_LONG_DOUBLE)" == "define" || "$(USE_MINGW_ANSI_STDIO)" == "define" -BUILDOPT += -D__USE_MINGW_ANSI_STDIO -MINIBUILDOPT += -D__USE_MINGW_ANSI_STDIO -.ENDIF - -GCCVER1:= $(shell for /f "delims=. tokens=1,2,3" %i in ('gcc -dumpversion') do @echo %i) -GCCVER2:= $(shell for /f "delims=. tokens=1,2,3" %i in ('gcc -dumpversion') do @echo %j) -GCCVER3:= $(shell for /f "delims=. tokens=1,2,3" %i in ('gcc -dumpversion') do @echo %k) - -# If you are using GCC, 4.3 or later by default we add the -fwrapv option. -# See https://github.com/Perl/perl5/issues/13690 -# -GCCWRAPV *= $(shell if "$(GCCVER1)"=="4" (if "$(GCCVER2)" geq "3" echo define) else if "$(GCCVER1)" geq "5" (echo define)) - -.IF "$(GCCWRAPV)" == "define" -BUILDOPT += -fwrapv -MINIBUILDOPT += -fwrapv -.ENDIF - -i = .i -o = .o -a = .a - -# -# Options -# - -INCLUDES = -I.\include -I. -I.. -DEFINES = -DWIN32 -.IF "$(WIN64)" == "define" -DEFINES += -DWIN64 -.ENDIF -LOCDEFS = -DPERLDLL -DPERL_CORE -CXX_FLAG = -xc++ - -# Current releases of MinGW 5.1.4 (as of 11-Aug-2009) will fail to link -# correctly if -lmsvcrt is specified explicitly. -LIBC = -#LIBC = -lmsvcrt - -# same libs as MSVC -LIBFILES = $(LIBC) -lmoldname -lkernel32 -luser32 -lgdi32 -lwinspool \ - -lcomdlg32 -ladvapi32 -lshell32 -lole32 -loleaut32 -lnetapi32 \ - -luuid -lws2_32 -lmpr -lwinmm -lversion -lodbc32 -lodbccp32 -lcomctl32 - -.IF "$(USE_QUADMATH)" == "define" -LIBFILES += -lquadmath -.ENDIF - -.IF "$(CFG)" == "Debug" -OPTIMIZE = -g -O2 -LINK_DBG = -g -DEFINES += -DDEBUGGING -.ELIF "$(CFG)" == "DebugSymbols" -OPTIMIZE = -g -O2 -LINK_DBG = -g -.ELSE -OPTIMIZE = -s -O2 -LINK_DBG = -s -.ENDIF - -EXTRACFLAGS = -.IF "$(USE_CPLUSPLUS)" == "define" -EXTRACFLAGS += $(CXX_FLAG) -.ENDIF -CFLAGS = $(EXTRACFLAGS) $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L"$(INST_COREDIR)" -L"$(CCLIBDIR)" -OBJOUT_FLAG = -o -EXEOUT_FLAG = -o -LIBOUT_FLAG = -PDBOUT = - -BUILDOPT += -fno-strict-aliasing -mms-bitfields -MINIBUILDOPT += -fno-strict-aliasing - -TESTPREPGCC = test-prep-gcc - -.ELSE - -# All but the free version of VC++ 7.1 can load DLLs on demand. Makes the test -# suite run in about 10% less time. -.IF "$(CCTYPE)" != "MSVC70FREE" -# If no registry, advapi32 is only used for Perl_pp_getlogin/getlogin/GetUserNameA -# which is rare to execute -.IF "$(USE_NO_REGISTRY)" != "undef" -DELAYLOAD = -DELAYLOAD:ws2_32.dll -DELAYLOAD:advapi32.dll delayimp.lib -MINIDELAYLOAD = -.ELSE -DELAYLOAD = -DELAYLOAD:ws2_32.dll delayimp.lib -#miniperl never does any registry lookups -MINIDELAYLOAD = -DELAYLOAD:advapi32.dll -.ENDIF -.ENDIF - -# Visual C++ 2005 and 2008 (VC++ 8.0 and 9.0) create manifest files for EXEs and -# DLLs. These either need copying everywhere with the binaries, or else need -# embedding in them otherwise MSVCR80.dll or MSVCR90.dll won't be found. For -# simplicity, embed them if they exist (and delete them afterwards so that they -# don't get installed too). -EMBED_EXE_MANI = if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;1 && \ - if exist $@.manifest del $@.manifest -EMBED_DLL_MANI = if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2 && \ - if exist $@.manifest del $@.manifest -# This one is for perl.exe which already has an embedded manifest, so we want to -# append to it, not replace it. -APPEND_EXE_MANI = if exist $@.manifest mt -nologo -manifest $@.manifest -updateresource:$@;1 && \ - if exist $@.manifest del $@.manifest - -# Most relevant compiler-specific options fall into two groups: -# either pre-MSVC80 or MSVC80 onwards, so define a macro for this. -.IF "$(CCTYPE)" == "MSVC70" || "$(CCTYPE)" == "MSVC70FREE" -PREMSVC80 = define -.ELSE -PREMSVC80 = undef -.ENDIF - -.IF "$(__ICC)" != "define" -CC = cl -LINK32 = link -.ELSE -CC = icl -LINK32 = xilink -.ENDIF -LIB32 = $(LINK32) -lib -RSC = rc - -# -# Options -# - -INCLUDES = -I.\include -I. -I.. -#PCHFLAGS = -Fpc:\temp\vcmoduls.pch -YX -DEFINES = -DWIN32 -D_CONSOLE -DNO_STRICT -LOCDEFS = -DPERLDLL -DPERL_CORE -CXX_FLAG = -TP -EHsc -EXTRACFLAGS = -nologo -GF -W3 - -.IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -LIBC = ucrt.lib -.ELSE -LIBC = msvcrt.lib -.ENDIF - -.IF "$(CFG)" == "Debug" -OPTIMIZE = -Od -Zi -LINK_DBG = -debug -DEFINES += -DDEBUGGING -EXTRACFLAGS += -MD -.ELIF "$(CFG)" == "DebugSymbols" -OPTIMIZE = -Od -Zi -LINK_DBG = -debug -EXTRACFLAGS += -MD -.ELIF "$(CFG)" == "DebugFull" -.IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -LIBC = ucrtd.lib -.ELSE -LIBC = msvcrtd.lib -.ENDIF -OPTIMIZE = -Od -Zi -LINK_DBG = -debug -DEFINES += -D_DEBUG -DDEBUGGING -EXTRACFLAGS += -MDd -.ELSE -# Enable Whole Program Optimizations (WPO) and Link Time Code Generation (LTCG). -# -O1 yields smaller code, which turns out to be faster than -O2 on x86 and x64 -OPTIMIZE = -O1 -Zi -GL -# we enable debug symbols in release builds also -LINK_DBG = -debug -opt:ref,icf -ltcg -# you may want to enable this if you want COFF symbols in the executables -# in addition to the PDB symbols. The default Dr. Watson that ships with -# Windows can use the the former but not latter. The free WinDbg can be -# installed to get better stack traces from just the PDB symbols, so we -# avoid the bloat of COFF symbols by default. -#LINK_DBG += -debugtype:both -LIB_FLAGS = -ltcg -EXTRACFLAGS += -MD -.ENDIF - -.IF "$(WIN64)" == "define" -DEFINES += -DWIN64 -OPTIMIZE += -fp:precise -.ENDIF - -# For now, silence warnings from VC++ 8.0 onwards about "unsafe" CRT functions -# and POSIX CRT function names being deprecated. -.IF "$(PREMSVC80)" == "undef" -DEFINES += -D_CRT_SECURE_NO_DEPRECATE -D_CRT_NONSTDC_NO_DEPRECATE -.ENDIF - -# Likewise for deprecated Winsock APIs in VC++ 14.0 onwards for now. -.IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -DEFINES += -D_WINSOCK_DEPRECATED_NO_WARNINGS -.ENDIF - -# The Windows Server 2003 SP1 SDK compiler only defines _configthreadlocale() if -# _MT is defined, i.e. when using /MT (the LIBCMT.lib version of the CRT), which -# the perl build doesn't use. We therefore specify NO_THREAD_SAFE_LOCALE so that -# perl.h doesn't set USE_THREAD_SAFE_LOCALE, which it otherwise would do since -# _MSC_VER is 1400 for this compiler (as per MSVC80). -.IF "$(CCTYPE)" == "SDK2003SP1" -DEFINES += -DNO_THREAD_SAFE_LOCALE -.ENDIF - -# In VS 2005 (VC++ 8.0) Microsoft changes time_t from 32-bit to -# 64-bit, even in 32-bit mode. It also provides the _USE_32BIT_TIME_T -# preprocessor option to revert back to the old functionality for -# backward compatibility. We define this symbol here for older 32-bit -# compilers only (which aren't using it at all) for the sole purpose -# of getting it into $Config{ccflags}. That way if someone builds -# Perl itself with e.g. VC7 but later installs an XS module using VC8 -# the time_t types will still be compatible. -.IF "$(WIN64)" == "undef" -.IF "$(PREMSVC80)" == "define" -BUILDOPT += -D_USE_32BIT_TIME_T -.ENDIF -.ENDIF - -LIBBASEFILES = oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib \ - comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib \ - netapi32.lib uuid.lib ws2_32.lib mpr.lib winmm.lib version.lib \ - odbc32.lib odbccp32.lib comctl32.lib - -.IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -.IF "$(CFG)" == "DebugFull" -LIBBASEFILES += msvcrtd.lib vcruntimed.lib -.ELSE -LIBBASEFILES += msvcrt.lib vcruntime.lib -.ENDIF -.ENDIF - -# Avoid __intel_new_proc_init link error for libircmt. -# libmmd is /MD equivelent, other variants exist. -# libmmd is Intel C's math addon funcs to MS CRT, contains long doubles, C99, -# and optimized C89 funcs -.IF "$(__ICC)" == "define" -LIBBASEFILES += libircmt.lib libmmd.lib -.ENDIF - -# The Windows Server 2003 SP1 SDK compiler links against MSVCRT.dll, which -# doesn't include the buffer overrun verification code used by the /GS switch. -# Since the code links against libraries that are compiled with /GS, this -# "security cookie verification" code must be included via bufferoverflow.lib. -.IF "$(CCTYPE)" == "SDK2003SP1" -LIBBASEFILES += bufferoverflowU.lib -.ENDIF - -LIBFILES = $(LIBBASEFILES) $(LIBC) - -.IF "$(__ICC)" == "define" -EXTRACFLAGS += -Qstd=c99 -.ENDIF -.IF "$(USE_CPLUSPLUS)" == "define" -EXTRACFLAGS += $(CXX_FLAG) -.ENDIF -CFLAGS = $(EXTRACFLAGS) $(INCLUDES) $(DEFINES) $(LOCDEFS) \ - $(PCHFLAGS) $(OPTIMIZE) -LINK_FLAGS = -nologo -nodefaultlib $(LINK_DBG) \ - -libpath:"$(INST_COREDIR)" \ - -machine:$(PROCESSOR_ARCHITECTURE) -LIB_FLAGS += -nologo -OBJOUT_FLAG = -Fo -EXEOUT_FLAG = -Fe -LIBOUT_FLAG = /out: -PDBOUT = -Fd$*.pdb -TESTPREPGCC = - -.ENDIF - -CFLAGS_O = $(CFLAGS) $(BUILDOPT) - -RSC_FLAGS = - -# VS 2017 (VC++ 14.1) requires at minimum Windows 7 SP1 (with latest Windows Updates) - -# For XP support in >= VS 2013 (VC++ 12.0), subsystem is always in Config.pm -# LINK_FLAGS else subsystem is only needed for EXE building, not XS DLL building -# Console vs GUI makes no difference for DLLs, so use default for cleaner -# building cmd lines -.IF "$(CCTYPE)" == "MSVC120" || "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" -.IF "$(WIN64)" == "define" -LINK_FLAGS += -subsystem:console,"5.02" -.ELSE -LINK_FLAGS += -subsystem:console,"5.01" -.ENDIF - -.ELIF "$(CCTYPE)" != "GCC" -PRIV_LINK_FLAGS += -subsystem:console -.ENDIF - -BLINK_FLAGS = $(PRIV_LINK_FLAGS) $(LINK_FLAGS) - -#################### do not edit below this line ####################### -############# NO USER-SERVICEABLE PARTS BEYOND THIS POINT ############## - -# Some old dmakes (including Sarathy's one at -# https://www.cpan.org/authors/id/G/GS/GSAR/dmake-4.1pl1-win32.zip) -# don't support logical OR (||) or logical AND (&&) in conditional -# expressions and hence don't process this makefile correctly. Determine -# whether this is the case so that we can give the user an error message. -.IF 1 == 1 || 1 == 1 -NEWDMAKE = define -.ELSE -NEWDMAKE = undef -.ENDIF - -o *= .obj -a *= .lib - -LKPRE = INPUT ( -LKPOST = ) - -# -# Rules -# - -.SUFFIXES : .c .i $(o) .dll $(a) .exe .rc .res - -.c$(o): - $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $(PDBOUT) $< - -.c.i: - $(CC) -c $(null,$(<:d) $(NULL) -I$(<:d)) $(CFLAGS_O) -E $< >$@ - -.y.c: - $(NOOP) - -$(o).dll: -.IF "$(CCTYPE)" == "GCC" - $(LINK32) -o $@ $(BLINK_FLAGS) $< $(LIBFILES) - $(IMPLIB) --input-def $(*B).def --output-lib $(*B).a $@ -.ELSE - $(LINK32) -dll -implib:$(*B).lib -def:$(*B).def \ - -out:$@ $(BLINK_FLAGS) $(LIBFILES) $< $(LIBPERL) - $(EMBED_DLL_MANI) -.ENDIF - -.rc.res: -.IF "$(CCTYPE)" == "GCC" - $(RSC) --use-temp-file --include-dir=. --include-dir=.. -O COFF -D INCLUDE_MANIFEST -i $< -o $@ -.ELSE - $(RSC) -i.. -DINCLUDE_MANIFEST $< -.ENDIF - -# -# various targets - -#do not put $(MINIPERL) as a dep/prereq in a rule, instead put $(HAVEMINIPERL) -#$(MINIPERL) is not a buildable target, use "dmake mp" if you want to just build -#miniperl alone -MINIPERL = ..\miniperl.exe -HAVEMINIPERL = ..\lib\buildcustomize.pl -MINIDIR = .\mini -PERLEXE = ..\perl.exe -WPERLEXE = ..\wperl.exe -PERLEXESTATIC = ..\perl-static.exe -STATICDIR = .\static.tmp -GLOBEXE = ..\perlglob.exe -CONFIGPM = ..\lib\Config.pm -GENUUDMAP = ..\generate_uudmap.exe -.IF "$(BUILD_STATIC)" == "define" || "$(ALL_STATIC)" == "define" -PERLSTATIC = static -.ELSE -PERLSTATIC = -.ENDIF - -# Unicode data files generated by mktables -UNIDATAFILES = ..\lib\unicore\Decomposition.pl ..\lib\unicore\TestProp.pl \ - ..\lib\unicore\CombiningClass.pl ..\lib\unicore\Name.pl \ - ..\lib\unicore\UCD.pl ..\lib\unicore\Name.pm \ - ..\lib\unicore\mktables.lst - -# Directories of Unicode data files generated by mktables -UNIDATADIR1 = ..\lib\unicore\To -UNIDATADIR2 = ..\lib\unicore\lib - -PERLEXE_MANIFEST= .\perlexe.manifest -PERLEXE_ICO = .\perlexe.ico -PERLEXE_RES = .\perlexe.res -PERLDLL_RES = - -# Nominate a target which causes extensions to be re-built -# This used to be $(PERLEXE), but at worst it is the .dll that they depend -# on and really only the interface - i.e. the .def file used to export symbols -# from the .dll -PERLDEP = $(PERLIMPLIB) - - -PL2BAT = bin\pl2bat.pl - -UTILS = \ - ..\utils\h2ph \ - ..\utils\splain \ - ..\utils\perlbug \ - ..\utils\pl2pm \ - ..\utils\h2xs \ - ..\utils\perldoc \ - ..\utils\perlivp \ - ..\utils\libnetcfg \ - ..\utils\enc2xs \ - ..\utils\encguess \ - ..\utils\piconv \ - ..\utils\corelist \ - ..\utils\cpan \ - ..\utils\xsubpp \ - ..\utils\pod2html \ - ..\utils\prove \ - ..\utils\ptar \ - ..\utils\ptardiff \ - ..\utils\ptargrep \ - ..\utils\zipdetails \ - ..\utils\shasum \ - ..\utils\instmodsh \ - ..\utils\json_pp \ - ..\utils\streamzip \ - bin\exetype.pl \ - bin\runperl.pl \ - bin\pl2bat.pl \ - bin\perlglob.pl \ - bin\search.pl - -.IF "$(CCTYPE)" == "GCC" - -CFGSH_TMPL = config.gc -CFGH_TMPL = config_H.gc -PERLIMPLIB = $(COREDIR)\libperl533$(a) -PERLSTATICLIB = ..\libperl533s$(a) -INT64 = long long - -.ELSE - -CFGSH_TMPL = config.vc -CFGH_TMPL = config_H.vc -INT64 = __int64 - -.ENDIF - -# makedef.pl must be updated if this changes, and this should normally -# only change when there is an incompatible revision of the public API. -PERLIMPLIB *= $(COREDIR)\perl533$(a) -PERLEXPLIB *= $(COREDIR)\perl533.exp -PERLSTATICLIB *= ..\perl533s$(a) -PERLDLL = ..\perl533.dll -PERLDLLBASE = perl533.dll - -#EUMM on Win32 isn't ready for parallel make, so only allow this file to be parallel -#$(MAKE) will contain the -P that this makefile was called with, which is bad for -#make_ext.pl since upto jobs*jobs processes will run instead of jobs -#also any recipie containing $(MAKE) is special cased by dmake to execute recipes -#containing $(MAKE) when "dmake -n" is executed, which causes recursive calls -#to dmake, which means "dmake -n" is then broken as a diagnostic tool since -#"dmake -n" will invoke all the make_ext.pl scripts build things instead of -#showing what to build since $(MAKE) is an arg to make_ext.pl, not an invocation -#of the dmake process -PLMAKE = dmake - -XCOPY = xcopy /f /r /i /d /y -RCOPY = xcopy /f /r /i /e /d /y -NOOP = @rem - -#first ones are arrange in compile time order for faster parallel building -#see #123867 for details -MICROCORE_SRC = \ - ..\toke.c \ - ..\regcomp.c \ - ..\regexec.c \ - ..\op.c \ - ..\sv.c \ - ..\pp.c \ - ..\pp_ctl.c \ - ..\pp_sys.c \ - ..\pp_pack.c \ - ..\pp_hot.c \ - ..\gv.c \ - ..\perl.c \ - ..\utf8.c \ - ..\dump.c \ - ..\hv.c \ - ..\av.c \ - ..\caretx.c \ - ..\deb.c \ - ..\doio.c \ - ..\doop.c \ - ..\dquote.c \ - ..\globals.c \ - ..\mro_core.c \ - ..\locale.c \ - ..\keywords.c \ - ..\mathoms.c \ - ..\mg.c \ - ..\numeric.c \ - ..\pad.c \ - ..\perly.c \ - ..\pp_sort.c \ - ..\reentr.c \ - ..\run.c \ - ..\scope.c \ - ..\taint.c \ - ..\time64.c \ - ..\universal.c \ - ..\util.c - -EXTRACORE_SRC += perllib.c - -.IF "$(PERL_MALLOC)" == "define" -EXTRACORE_SRC += ..\malloc.c -.ENDIF - -EXTRACORE_SRC += ..\perlio.c - -WIN32_SRC = \ - .\win32.c \ - .\win32io.c \ - .\win32sck.c \ - .\win32thread.c \ - .\fcrypt.c - -CORE_NOCFG_H = \ - ..\av.h \ - ..\cop.h \ - ..\cv.h \ - ..\dosish.h \ - ..\embed.h \ - ..\form.h \ - ..\gv.h \ - ..\handy.h \ - ..\hv.h \ - ..\hv_func.h \ - ..\iperlsys.h \ - ..\mg.h \ - ..\nostdio.h \ - ..\op.h \ - ..\opcode.h \ - ..\perl.h \ - ..\perlapi.h \ - ..\perlsdio.h \ - ..\perly.h \ - ..\pp.h \ - ..\proto.h \ - ..\regcomp.h \ - ..\regexp.h \ - ..\scope.h \ - ..\sv.h \ - ..\thread.h \ - ..\unixish.h \ - ..\utf8.h \ - ..\util.h \ - ..\warnings.h \ - ..\XSUB.h \ - ..\EXTERN.h \ - ..\perlvars.h \ - ..\intrpvar.h \ - .\include\dirent.h \ - .\include\netdb.h \ - .\include\sys\errno2.h \ - .\include\sys\socket.h \ - .\win32.h - -CORE_H = $(CORE_NOCFG_H) .\config.h ..\git_version.h - -UUDMAP_H = ..\uudmap.h -BITCOUNT_H = ..\bitcount.h -MG_DATA_H = ..\mg_data.h -GENERATED_HEADERS = $(UUDMAP_H) $(BITCOUNT_H) $(MG_DATA_H) - -HAVE_COREDIR = .\.coreheaders - -MICROCORE_OBJ = $(MICROCORE_SRC:db:+$(o)) -CORE_OBJ = $(MICROCORE_OBJ) $(EXTRACORE_SRC:db:+$(o)) -WIN32_OBJ = $(WIN32_SRC:db:+$(o)) -MINICORE_OBJ = $(MINIDIR)\{$(MICROCORE_OBJ:f) miniperlmain$(o) perlio$(o)} -MINIWIN32_OBJ = $(MINIDIR)\{$(WIN32_OBJ:f)} -MINI_OBJ = $(MINICORE_OBJ) $(MINIWIN32_OBJ) -DLL_OBJ = $(DYNALOADER) - -PERLDLL_OBJ = $(CORE_OBJ) -PERLEXE_OBJ = perlmain$(o) -PERLEXEST_OBJ = perlmainst$(o) - -PERLDLL_OBJ += $(WIN32_OBJ) $(DLL_OBJ) - -.IF "$(USE_SETARGV)" != "" -SETARGV_OBJ = setargv$(o) -.ENDIF - -.IF "$(ALL_STATIC)" == "define" -# some exclusions, unfortunately, until fixed: -# - MakeMaker isn't capable enough for SDBM_File (small bug) -STATIC_EXT = * !SDBM_File -NORMALIZE_STATIC = Normalize_static -.ELSE -# specify static extensions here, for example: -# (be sure to include Win32CORE to load Win32 on demand) -#STATIC_EXT = Win32CORE Cwd Compress/Raw/Zlib -STATIC_EXT = Win32CORE -NORMALIZE_DYN = Normalize_dyn -.ENDIF - -DYNALOADER = ..\DynaLoader$(o) - -# vars must be separated by "\t+~\t+", since we're using the tempfile -# version of config_sh.pl (we were overflowing someone's buffer by -# trying to fit them all on the command line) -# -- BKS 10-17-1999 -CFG_VARS = \ - INST_TOP=$(INST_TOP) ~ \ - INST_VER=$(INST_VER) ~ \ - INST_ARCH=$(INST_ARCH) ~ \ - archname=$(ARCHNAME) ~ \ - cc=$(CC) ~ \ - ld=$(LINK32) ~ \ - ccflags=$(EXTRACFLAGS) $(DEFINES) $(BUILDOPT) ~ \ - usecplusplus=$(USE_CPLUSPLUS) ~ \ - cf_email=$(EMAIL) ~ \ - d_mymalloc=$(PERL_MALLOC) ~ \ - libs=$(LIBFILES:f) ~ \ - incpath=$(CCINCDIR) ~ \ - iquadmath=$(I_QUADMATH) ~ \ - libperl=$(PERLIMPLIB:f) ~ \ - libpth=$(CCLIBDIR);$(EXTRALIBDIRS) ~ \ - libc=$(LIBC) ~ \ - make=$(PLMAKE) ~ \ - _o=$(o) ~ \ - obj_ext=$(o) ~ \ - _a=$(a) ~ \ - lib_ext=$(a) ~ \ - static_ext=$(STATIC_EXT) ~ \ - usethreads=$(USE_ITHREADS) ~ \ - useithreads=$(USE_ITHREADS) ~ \ - usemultiplicity=$(USE_MULTI) ~ \ - use64bitint=$(USE_64_BIT_INT) ~ \ - uselongdouble=$(USE_LONG_DOUBLE) ~ \ - usequadmath=$(USE_QUADMATH) ~ \ - usesitecustomize=$(USE_SITECUST) ~ \ - default_inc_excludes_dot=$(DEFAULT_INC_EXCLUDES_DOT) ~ \ - LINK_FLAGS=$(LINK_FLAGS) ~ \ - optimize=$(OPTIMIZE) ~ \ - ARCHPREFIX=$(ARCHPREFIX) ~ \ - WIN64=$(WIN64) - -# -# Top targets -# - -all : CHECKDMAKE rebasePE Extensions_nonxs $(PERLSTATIC) - -info : -.IF "$(CCTYPE)" == "GCC" - @echo # CCTYPE=$(CCTYPE)&& \ - echo # CC=$(CC)&& \ - echo # GCCVER=$(GCCVER1).$(GCCVER2).$(GCCVER3)&& \ - echo # GCCTARGET=$(GCCTARGET)&& \ - echo # GCCCROSS=$(GCCCROSS)&& \ - echo # WIN64=$(WIN64)&& \ - echo # ARCHITECTURE=$(ARCHITECTURE)&& \ - echo # ARCHNAME=$(ARCHNAME)&& \ - echo # MAKE=$(PLMAKE) -.ELSE - @echo # CCTYPE=$(CCTYPE)&& \ - echo # WIN64=$(WIN64)&& \ - echo # ARCHITECTURE=$(ARCHITECTURE)&& \ - echo # ARCHNAME=$(ARCHNAME)&& \ - echo # MAKE=$(PLMAKE) -.ENDIF -.IF "$(CCTYPE)" == "" - @echo Unable to detect gcc and/or architecture! - @exit 1 -.ENDIF - - -..\regcomp$(o) : ..\regnodes.h ..\regcharclass.h - -..\regexec$(o) : ..\regnodes.h ..\regcharclass.h - -reonly : ..\regnodes.h $(UNIDATAFILES) Extensions_reonly - -static: $(PERLEXESTATIC) - -#---------------------------------------------------------------- - -CHECKDMAKE : -.IF "$(NEWDMAKE)" == "define" - $(NOOP) -.ELSE - @echo Your dmake doesn't support ^|^| or ^&^& in conditional expressions. - @echo Please get the latest dmake from https://metacpan.org/release/dmake - @exit 1 -.ENDIF - -$(GLOBEXE) : perlglob.c -.IF "$(CCTYPE)" == "GCC" - $(LINK32) $(EXTRACFLAGS) $(OPTIMIZE) $(BLINK_FLAGS) -mconsole -o $@ perlglob.c $(LIBFILES) -.ELSE - $(CC) $(EXTRACFLAGS) $(OPTIMIZE) $(PDBOUT) -Fe$@ perlglob.c -link $(BLINK_FLAGS) \ - setargv$(o) $(LIBFILES) && $(EMBED_EXE_MANI) -.ENDIF - -..\git_version.h : $(HAVEMINIPERL) ..\make_patchnum.pl - $(MINIPERL) -I..\lib ..\make_patchnum.pl - -# make sure that we recompile perl.c if the git version changes -..\perl$(o) : ..\git_version.h - -..\config.sh : $(CFGSH_TMPL) config_sh.PL FindExt.pm $(HAVEMINIPERL) - $(MINIPERL) -I..\lib config_sh.PL --cfgsh-option-file \ - $(mktmp $(CFG_VARS)) $(CFGSH_TMPL) > ..\config.sh - -# This target is for when changes to the main config.sh happen. -# Edit config.gc, then make perl using GCC in a minimal configuration (i.e. -# with MULTI, ITHREADS, IMP_SYS and LARGE_FILES off), then make -# this target to regenerate config_H.gc. -regen_config_h: - $(MINIPERL) -I..\lib config_sh.PL --prebuilt --cfgsh-option-file $(mktmp $(CFG_VARS)) \ - $(CFGSH_TMPL) > ..\config.sh - $(MINIPERL) -I..\lib ..\configpm --chdir=.. - -del /f $(CFGH_TMPL) - -$(MINIPERL) -I..\lib config_h.PL "ARCHPREFIX=$(ARCHPREFIX)" - rename config.h $(CFGH_TMPL) - -$(CONFIGPM) .\config.h .UPDATEALL: ..\config.sh config_h.PL - $(MINIPERL) -I..\lib ..\configpm --chdir=.. - -$(MINIPERL) -I..\lib config_h.PL "ARCHPREFIX=$(ARCHPREFIX)" - -# See the comment in Makefile.SH explaining this seemingly cranky ordering -..\lib\buildcustomize.pl : $(MINI_OBJ) ..\write_buildcustomize.pl -.IF "$(CCTYPE)" == "GCC" - $(LINK32) -v -mconsole -o $(MINIPERL) $(BLINK_FLAGS) \ - $(mktmp $(LKPRE) $(MINI_OBJ) $(LIBFILES) $(LKPOST)) -.ELSE - $(LINK32) -out:$(MINIPERL) $(BLINK_FLAGS) \ - @$(mktmp $(DELAYLOAD) $(MINIDELAYLOAD) $(LIBFILES) $(MINI_OBJ)) - $(EMBED_EXE_MANI:s/$@/$(MINIPERL)/) -.ENDIF - $(MINIPERL) -I..\lib -f ..\write_buildcustomize.pl .. - -#convinence target, get a working miniperl -mp : $(CONFIGPM) - -$(MINIDIR)\.exists : $(CFGH_TMPL) - if not exist "$(MINIDIR)" mkdir "$(MINIDIR)" -# -# Copy the template config.h and set configurables at the end of it -# as per the options chosen and compiler used. -# Note: This config.h is only used to build miniperl.exe anyway, but -# it's as well to have its options correct to be sure that it builds -# and so that it's "-V" options are correct for use by makedef.pl. The -# real config.h used to build perl.exe is generated from the top-level -# config_h.SH by config_h.PL (run by miniperl.exe). -# -# MINIDIR generates config.h so miniperl.exe is not rebuilt when the 2nd -# config.h is generated in CONFIGPM target, see also the comments for $(MINI_OBJ). - copy $(CFGH_TMPL) config.h - @(echo.&& \ - echo #ifndef _config_h_footer_&& \ - echo #define _config_h_footer_&& \ - echo #undef PTRSIZE&& \ - echo #undef SSize_t&& \ - echo #undef HAS_ATOLL&& \ - echo #undef HAS_STRTOLL&& \ - echo #undef HAS_STRTOULL&& \ - echo #undef Size_t_size&& \ - echo #undef IVTYPE&& \ - echo #undef UVTYPE&& \ - echo #undef IVSIZE&& \ - echo #undef UVSIZE&& \ - echo #undef NV_PRESERVES_UV&& \ - echo #undef NV_PRESERVES_UV_BITS&& \ - echo #undef IVdf&& \ - echo #undef UVuf&& \ - echo #undef UVof&& \ - echo #undef UVxf&& \ - echo #undef UVXf&& \ - echo #undef USE_64_BIT_INT&& \ - echo #undef Gconvert&& \ - echo #undef HAS_FREXPL&& \ - echo #undef HAS_ISNANL&& \ - echo #undef HAS_MODFL&& \ - echo #undef HAS_MODFL_PROTO&& \ - echo #undef HAS_SQRTL&& \ - echo #undef HAS_STRTOLD&& \ - echo #undef I_QUADMATH&& \ - echo #undef PERL_PRIfldbl&& \ - echo #undef PERL_PRIgldbl&& \ - echo #undef PERL_PRIeldbl&& \ - echo #undef PERL_SCNfldbl&& \ - echo #undef NVTYPE&& \ - echo #undef NVSIZE&& \ - echo #undef LONG_DOUBLESIZE&& \ - echo #undef NV_OVERFLOWS_INTEGERS_AT&& \ - echo #undef NVef&& \ - echo #undef NVff&& \ - echo #undef NVgf&& \ - echo #undef USE_LONG_DOUBLE&& \ - echo #undef USE_QUADMATH&& \ - echo #undef USE_CPLUSPLUS)>> config.h -.IF "$(CCTYPE)" == "MSVC140" || "$(CCTYPE)" == "MSVC141" || "$(CCTYPE)" == "MSVC142" - @(echo #undef FILE_ptr&& \ - echo #undef FILE_cnt&& \ - echo #undef FILE_base&& \ - echo #undef FILE_bufsiz&& \ - echo #define FILE_ptr^(fp^) PERLIO_FILE_ptr^(fp^)&& \ - echo #define FILE_cnt^(fp^) PERLIO_FILE_cnt^(fp^)&& \ - echo #define FILE_base^(fp^) PERLIO_FILE_base^(fp^)&& \ - echo #define FILE_bufsiz^(fp^) ^(PERLIO_FILE_cnt^(fp^) + PERLIO_FILE_ptr^(fp^) - PERLIO_FILE_base^(fp^)^)&& \ - echo #define I_STDBOOL)>> config.h -.ENDIF -.IF "$(WIN64)"=="define" -.IF "$(CCTYPE)" == "GCC" - @(echo #define LONG_DOUBLESIZE ^16)>> config.h -.ELSE - @(echo #define LONG_DOUBLESIZE ^8)>> config.h -.ENDIF - @(echo #define PTRSIZE ^8&& \ - echo #define SSize_t $(INT64)&& \ - echo #define HAS_ATOLL&& \ - echo #define HAS_STRTOLL&& \ - echo #define HAS_STRTOULL&& \ - echo #define Size_t_size ^8)>> config.h -.ELSE -.IF "$(CCTYPE)" == "GCC" - @(echo #define LONG_DOUBLESIZE ^12)>> config.h -.ELSE - @(echo #define LONG_DOUBLESIZE ^8)>> config.h -.ENDIF - @(echo #define PTRSIZE ^4&& \ - echo #define SSize_t int&& \ - echo #undef HAS_ATOLL&& \ - echo #undef HAS_STRTOLL&& \ - echo #undef HAS_STRTOULL&& \ - echo #define Size_t_size ^4)>> config.h -.ENDIF -.IF "$(USE_64_BIT_INT)"=="define" - @(echo #define IVTYPE $(INT64)&& \ - echo #define UVTYPE unsigned $(INT64)&& \ - echo #define IVSIZE ^8&& \ - echo #define UVSIZE ^8)>> config.h -.IF "$(USE_LONG_DOUBLE)"=="define" - @(echo #define NV_PRESERVES_UV&& \ - echo #define NV_PRESERVES_UV_BITS 64)>> config.h -.ELSE -.IF "$(USE_QUADMATH)"=="define" - @(echo #define NV_PRESERVES_UV&& \ - echo #define NV_PRESERVES_UV_BITS 64)>> config.h -.ELSE - @(echo #undef NV_PRESERVES_UV&& \ - echo #define NV_PRESERVES_UV_BITS 53)>> config.h -.ENDIF -.ENDIF - @(echo #define IVdf "I64d"&& \ - echo #define UVuf "I64u"&& \ - echo #define UVof "I64o"&& \ - echo #define UVxf "I64x"&& \ - echo #define UVXf "I64X"&& \ - echo #define USE_64_BIT_INT)>> config.h -.ELSE - @(echo #define IVTYPE long&& \ - echo #define UVTYPE unsigned long&& \ - echo #define IVSIZE ^4&& \ - echo #define UVSIZE ^4&& \ - echo #define NV_PRESERVES_UV&& \ - echo #define NV_PRESERVES_UV_BITS 32&& \ - echo #define IVdf "ld"&& \ - echo #define UVuf "lu"&& \ - echo #define UVof "lo"&& \ - echo #define UVxf "lx"&& \ - echo #define UVXf "lX"&& \ - echo #undef USE_64_BIT_INT)>> config.h -.ENDIF -.IF "$(USE_LONG_DOUBLE)"=="define" - @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%.*""Lg",^(n^),^(x^)^)&& \ - echo #define HAS_FREXPL&& \ - echo #define HAS_ISNANL&& \ - echo #define HAS_MODFL&& \ - echo #define HAS_MODFL_PROTO&& \ - echo #define HAS_SQRTL&& \ - echo #define HAS_STRTOLD&& \ - echo #define PERL_PRIfldbl "Lf"&& \ - echo #define PERL_PRIgldbl "Lg"&& \ - echo #define PERL_PRIeldbl "Le"&& \ - echo #define PERL_SCNfldbl "Lf"&& \ - echo #define NVTYPE long double&& \ - echo #define NVSIZE LONG_DOUBLESIZE&& \ - echo #define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0*2.0*2.0*2.0&& \ - echo #define NVef "Le"&& \ - echo #define NVff "Lf"&& \ - echo #define NVgf "Lg"&& \ - echo #undef I_QUADMATH&& \ - echo #undef USE_QUADMATH&& \ - echo #define USE_LONG_DOUBLE)>> config.h -.ELSE -.IF "$(USE_QUADMATH)"=="define" - @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%%.*""Lg",^(n^),^(x^)^)&& \ - echo #define HAS_FREXPL&& \ - echo #define HAS_ISNANL&& \ - echo #define HAS_MODFL&& \ - echo #define HAS_MODFL_PROTO&& \ - echo #define HAS_SQRTL&& \ - echo #define HAS_STRTOLD&& \ - echo #define PERL_PRIfldbl "Lf"&& \ - echo #define PERL_PRIgldbl "Lg"&& \ - echo #define PERL_PRIeldbl "Le"&& \ - echo #define PERL_SCNfldbl "Lf"&& \ - echo #define NVTYPE __float128&& \ - echo #define NVSIZE 16&& \ - echo #define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*256.0*2.0&& \ - echo #define NVef "Qe"&& \ - echo #define NVff "Qf"&& \ - echo #define NVgf "Qg"&& \ - echo #undef USE_LONG_DOUBLE&& \ - echo #define I_QUADMATH&& \ - echo #define USE_QUADMATH)>> config.h -.ELSE - @(echo #define Gconvert^(x,n,t,b^) sprintf^(^(b^),"%.*g",^(n^),^(x^)^)&& \ - echo #undef HAS_FREXPL&& \ - echo #undef HAS_ISNANL&& \ - echo #undef HAS_MODFL&& \ - echo #undef HAS_MODFL_PROTO&& \ - echo #undef HAS_SQRTL&& \ - echo #undef HAS_STRTOLD&& \ - echo #undef PERL_PRIfldbl&& \ - echo #undef PERL_PRIgldbl&& \ - echo #undef PERL_PRIeldbl&& \ - echo #undef PERL_SCNfldbl&& \ - echo #define NVTYPE double&& \ - echo #define NVSIZE ^8&& \ - echo #define NV_OVERFLOWS_INTEGERS_AT 256.0*256.0*256.0*256.0*256.0*256.0*2.0*2.0*2.0*2.0*2.0&& \ - echo #define NVef "e"&& \ - echo #define NVff "f"&& \ - echo #define NVgf "g"&& \ - echo #undef I_QUADMATH&& \ - echo #undef USE_QUADMATH&& \ - echo #undef USE_LONG_DOUBLE)>> config.h -.ENDIF -.ENDIF -.IF "$(USE_CPLUSPLUS)"=="define" - @(echo #define USE_CPLUSPLUS&& \ - echo #endif)>> config.h -.ELSE - @(echo #undef USE_CPLUSPLUS&& \ - echo #endif)>> config.h -.ENDIF -#separate line since this is sentinal that this target is done - @rem. > $(MINIDIR)\.exists - -$(MINICORE_OBJ) : $(CORE_NOCFG_H) - $(CC) -c $(CFLAGS) $(MINIBUILDOPT) -DPERL_EXTERNAL_GLOB -DPERL_IS_MINIPERL $(OBJOUT_FLAG)$@ $(PDBOUT) ..\$(*B).c - -$(MINIWIN32_OBJ) : $(CORE_NOCFG_H) - $(CC) -c $(CFLAGS) $(MINIBUILDOPT) -DPERL_IS_MINIPERL $(OBJOUT_FLAG)$@ $(PDBOUT) $(*B).c - -# -DPERL_IMPLICIT_SYS needs C++ for perllib.c -# rules wrapped in .IFs break Win9X build (we end up with unbalanced []s -# unless the .IF is true), so instead we use a .ELSE with the default. -# This is the only file that depends on perlhost.h, vmem.h, and vdir.h - -perllib$(o) : perllib.c perllibst.h .\perlhost.h .\vdir.h .\vmem.h -.IF "$(USE_IMP_SYS)" == "define" - $(CC) -c -I. $(CFLAGS_O) $(CXX_FLAG) $(OBJOUT_FLAG)$@ $(PDBOUT) perllib.c -.ELSE - $(CC) -c -I. $(CFLAGS_O) $(OBJOUT_FLAG)$@ $(PDBOUT) perllib.c -.ENDIF - -# 1. we don't want to rebuild miniperl.exe when config.h changes -# 2. we don't want to rebuild miniperl.exe with non-default config.h -# 3. we can't have miniperl.exe depend on git_version.h, as miniperl creates it -$(MINI_OBJ) : $(MINIDIR)\.exists $(CORE_NOCFG_H) - -$(WIN32_OBJ) : $(CORE_H) - -$(CORE_OBJ) : $(CORE_H) - -$(DLL_OBJ) : $(CORE_H) - - -perllibst.h : $(HAVEMINIPERL) $(CONFIGPM) create_perllibst_h.pl - $(MINIPERL) -I..\lib create_perllibst_h.pl - -perldll.def : $(HAVEMINIPERL) $(CONFIGPM) ..\embed.fnc ..\makedef.pl - $(MINIPERL) -I..\lib -w ..\makedef.pl PLATFORM=win32 $(OPTIMIZE) $(DEFINES) \ - $(BUILDOPT) CCTYPE=$(CCTYPE) TARG_DIR=..\ > perldll.def - -$(PERLEXPLIB) $(PERLIMPLIB) .UPDATEALL : perldll.def -.IF "$(CCTYPE)" == "GCC" - $(IMPLIB) -k -d perldll.def -D $(PERLDLLBASE) -l $(PERLIMPLIB) -e $(PERLEXPLIB) -.ELSE #VC family - lib -def:perldll.def -machine:$(ARCHITECTURE) /OUT:$(PERLIMPLIB) -.ENDIF - -$(PERLDLL): $(PERLEXPLIB) $(PERLDLL_OBJ) $(PERLDLL_RES) Extensions_static -.IF "$(CCTYPE)" == "GCC" - $(LINK32) -mdll -o $@ $(BLINK_FLAGS) \ - $(PERLDLL_OBJ) $(shell @type Extensions_static) $(LIBFILES) $(PERLEXPLIB) -.ELSE - $(LINK32) -dll -out:$@ $(BLINK_FLAGS) \ - @Extensions_static \ - @$(mktmp $(DELAYLOAD) $(LIBFILES) \ - $(PERLDLL_RES) $(PERLDLL_OBJ) $(PERLEXPLIB)) - $(EMBED_DLL_MANI) -.ENDIF - -$(PERLSTATICLIB): $(PERLDLL_OBJ) Extensions_static -.IF "$(CCTYPE)" == "GCC" - $(LIB32) $(LIB_FLAGS) $@ $(PERLDLL_OBJ) - if exist $(STATICDIR) rmdir /s /q $(STATICDIR) - for %i in ($(shell @type Extensions_static)) do \ - @mkdir $(STATICDIR) && cd $(STATICDIR) && \ - $(ARCHPREFIX)ar x ..\%i && \ - $(ARCHPREFIX)ar q ..\$@ *$(o) && \ - cd .. && rmdir /s /q $(STATICDIR) -.ELSE - $(LIB32) $(LIB_FLAGS) -out:$@ @Extensions_static \ - @$(mktmp $(PERLDLL_OBJ)) -.ENDIF - $(XCOPY) $(PERLSTATICLIB) $(COREDIR)\$(NULL) - -$(PERLEXE_RES): perlexe.rc $(PERLEXE_MANIFEST) $(PERLEXE_ICO) - -$(MINIDIR)\globals$(o) : $(GENERATED_HEADERS) - -$(GENUUDMAP) $(GENERATED_HEADERS) .UPDATEALL : ..\mg_raw.h -.IF "$(CCTYPE)" == "GCC" - $(LINK32) $(CFLAGS_O) -o..\generate_uudmap.exe ..\generate_uudmap.c \ - $(BLINK_FLAGS) -x $(mktmp $(LKPRE) $(LIBFILES) $(LKPOST)) -.ELSE - $(CC) $(CFLAGS_O) $(PDBOUT) -Fe..\generate_uudmap.exe ..\generate_uudmap.c @$(mktmp -link $(LIBFILES)) -link $(BLINK_FLAGS) - $(EMBED_EXE_MANI:s/$@/..\generate_uudmap.exe/) -.ENDIF - $(GENUUDMAP) $(GENERATED_HEADERS) - -MakePPPort : $(HAVEMINIPERL) $(CONFIGPM) - $(MINIPERL) -I..\lib ..\mkppport - -# also known as $(HAVE_COREDIR) -.\.coreheaders : $(CORE_H) - $(XCOPY) *.h $(COREDIR)\*.* && $(RCOPY) include $(COREDIR)\*.* && $(XCOPY) ..\*.h $(COREDIR)\*.* - rem. > $@ - -perlmain$(o) : runperl.c $(CONFIGPM) - $(CC) $(CFLAGS_O:s,-DPERLDLL,-UPERLDLL,) $(OBJOUT_FLAG)$@ $(PDBOUT) -c runperl.c - -perlmainst$(o) : runperl.c $(CONFIGPM) - $(CC) $(CFLAGS_O) $(OBJOUT_FLAG)$@ $(PDBOUT) -c runperl.c - -$(PERLEXE): $(CONFIGPM) $(PERLEXE_OBJ) $(PERLEXE_RES) $(PERLIMPLIB) -.IF "$(CCTYPE)" == "GCC" - $(LINK32) -mconsole -o $@ $(BLINK_FLAGS) \ - $(PERLEXE_OBJ) $(PERLEXE_RES) $(PERLIMPLIB) $(LIBFILES) -.ELSE - $(LINK32) -out:$@ $(BLINK_FLAGS) \ - $(PERLEXE_OBJ) $(PERLEXE_RES) $(PERLIMPLIB) $(LIBFILES) $(SETARGV_OBJ) - $(APPEND_EXE_MANI) -.ENDIF - copy $(PERLEXE) $(WPERLEXE) - $(MINIPERL) -I..\lib bin\exetype.pl $(WPERLEXE) WINDOWS - -$(PERLEXESTATIC): $(PERLSTATICLIB) $(CONFIGPM) $(PERLEXEST_OBJ) $(PERLEXE_RES) -.IF "$(CCTYPE)" == "GCC" - $(LINK32) -mconsole -o $@ $(BLINK_FLAGS) \ - $(PERLEXEST_OBJ) $(PERLEXE_RES) $(PERLSTATICLIB) $(LIBFILES) -.ELSE - $(LINK32) -out:$@ $(BLINK_FLAGS) \ - $(PERLEXEST_OBJ) $(PERLEXE_RES) $(PERLSTATICLIB) $(LIBFILES) $(SETARGV_OBJ) - $(APPEND_EXE_MANI) -.ENDIF - -#------------------------------------------------------------------------------- -# There's no direct way to mark a dependency on -# DynaLoader.pm, so this will have to do - -#most of deps of this target are in DYNALOADER and therefore omitted here -Extensions : $(PERLDEP) $(DYNALOADER) Extension_lib $(GLOBEXE) MakePPPort - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic !Unicode/Normalize - -Normalize_static : $(CONFIGPM) $(GLOBEXE) $(HAVE_COREDIR) $(UNIDATAFILES) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --static +Unicode/Normalize - -Normalize_dyn : $(PERLDEP) $(DYNALOADER) $(GLOBEXE) $(UNIDATAFILES) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic +Unicode/Normalize - -Extensions_reonly : $(PERLDEP) $(DYNALOADER) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --dynamic +re - -Exts_static_general : ..\make_ext.pl $(CONFIGPM) Extension_lib $(GLOBEXE) $(HAVE_COREDIR) MakePPPort - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --static !Unicode/Normalize - -Extensions_static : list_static_libs.pl Exts_static_general $(NORMALIZE_STATIC) - $(MINIPERL) -I..\lib list_static_libs.pl > Extensions_static - -Extensions_nonxs : ..\make_ext.pl ..\pod\perlfunc.pod $(CONFIGPM) $(GLOBEXE) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --nonxs !libs - -Extension_lib : ..\make_ext.pl $(CONFIGPM) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) lib - -#lib must be built, it can't be buildcustomize.pl-ed, and is required for XS building -$(DYNALOADER) : ..\make_ext.pl $(CONFIGPM) $(HAVE_COREDIR) - $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(EXTDIR) --dir=$(DISTDIR) --dynaloader - -Extensions_clean : - -if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --all --target=clean - -Extensions_realclean : - -if exist $(MINIPERL) $(MINIPERL) -I..\lib ..\make_ext.pl "MAKE=$(PLMAKE)" --dir=$(CPANDIR) --dir=$(DISTDIR) --dir=$(EXTDIR) --all --target=realclean - -# all PE files need to be built by the time this target runs, PP files can still -# be running in parallel like UNIDATAFILES, this target a placeholder for the -# future -.IF "$(PERLSTATIC)"=="static" -rebasePE : Extensions $(PERLDLL) $(PERLEXE) $(PERLEXESTATIC) -.ELSE -rebasePE : Extensions $(PERLDLL) $(NORMALIZE_DYN) $(PERLEXE) -.ENDIF - $(NOOP) - -#------------------------------------------------------------------------------- - - -doc: $(PERLEXE) $(PERLDLL) ..\pod\perltoc.pod - $(PERLEXE) ..\installhtml --podroot=.. --htmldir=$(HTMLDIR) \ - --podpath=pod:lib:utils --htmlroot="file://$(INST_HTML:s,:,|,)"\ - --recurse - -..\utils\Makefile: $(CONFIGPM) ..\utils\Makefile.PL - $(MINIPERL) -I..\lib ..\utils\Makefile.PL .. - -# Note that this next section is parsed (and regenerated) by pod/buildtoc -# so please check that script before making structural changes here -utils: $(HAVEMINIPERL) ..\utils\Makefile - cd ..\utils && $(PLMAKE) PERL=$(MINIPERL) - copy ..\README.aix ..\pod\perlaix.pod - copy ..\README.amiga ..\pod\perlamiga.pod - copy ..\README.android ..\pod\perlandroid.pod - copy ..\README.bs2000 ..\pod\perlbs2000.pod - copy ..\README.cn ..\pod\perlcn.pod - copy ..\README.cygwin ..\pod\perlcygwin.pod - copy ..\README.dos ..\pod\perldos.pod - copy ..\README.freebsd ..\pod\perlfreebsd.pod - copy ..\README.haiku ..\pod\perlhaiku.pod - copy ..\README.hpux ..\pod\perlhpux.pod - copy ..\README.hurd ..\pod\perlhurd.pod - copy ..\README.irix ..\pod\perlirix.pod - copy ..\README.jp ..\pod\perljp.pod - copy ..\README.ko ..\pod\perlko.pod - copy ..\README.linux ..\pod\perllinux.pod - copy ..\README.macos ..\pod\perlmacos.pod - copy ..\README.macosx ..\pod\perlmacosx.pod - copy ..\README.netware ..\pod\perlnetware.pod - copy ..\README.openbsd ..\pod\perlopenbsd.pod - copy ..\README.os2 ..\pod\perlos2.pod - copy ..\README.os390 ..\pod\perlos390.pod - copy ..\README.os400 ..\pod\perlos400.pod - copy ..\README.plan9 ..\pod\perlplan9.pod - copy ..\README.qnx ..\pod\perlqnx.pod - copy ..\README.riscos ..\pod\perlriscos.pod - copy ..\README.solaris ..\pod\perlsolaris.pod - copy ..\README.synology ..\pod\perlsynology.pod - copy ..\README.tru64 ..\pod\perltru64.pod - copy ..\README.tw ..\pod\perltw.pod - copy ..\README.vos ..\pod\perlvos.pod - copy ..\README.win32 ..\pod\perlwin32.pod - copy ..\pod\perldelta.pod ..\pod\perl5337delta.pod - $(MINIPERL) -I..\lib $(PL2BAT) $(UTILS) - $(MINIPERL) -I..\lib ..\autodoc.pl .. - $(MINIPERL) -I..\lib ..\pod\perlmodlib.PL -q .. - -..\pod\perltoc.pod: $(PERLEXE) $(PERLDLL) Extensions Extensions_nonxs $(NORMALIZE_DYN) utils - $(PERLEXE) -f ..\pod\buildtoc -q - -# Note that the pod cleanup in this next section is parsed (and regenerated -# by pod/buildtoc so please check that script before making changes here - -distclean: realclean - -del /f $(MINIPERL) $(PERLEXE) $(PERLDLL) $(GLOBEXE) \ - $(PERLIMPLIB) ..\miniperl$(a) $(PERLEXESTATIC) $(PERLSTATICLIB) - -del /f $(LIBDIR)\Encode.pm $(LIBDIR)\encoding.pm $(LIBDIR)\Errno.pm - -del /f $(LIBDIR)\Config.pod $(LIBDIR)\POSIX.pod $(LIBDIR)\threads.pm - -del /f $(LIBDIR)\.exists $(LIBDIR)\attributes.pm $(LIBDIR)\DynaLoader.pm - -del /f $(LIBDIR)\Fcntl.pm $(LIBDIR)\IO.pm $(LIBDIR)\Opcode.pm - -del /f $(LIBDIR)\ops.pm $(LIBDIR)\Safe.pm - -del /f $(LIBDIR)\SDBM_File.pm $(LIBDIR)\Socket.pm $(LIBDIR)\POSIX.pm - -del /f $(LIBDIR)\B.pm $(LIBDIR)\O.pm $(LIBDIR)\re.pm - -del /f $(LIBDIR)\File\Glob.pm - -del /f $(LIBDIR)\Sys\Hostname.pm - -del /f $(LIBDIR)\Time\HiRes.pm - -del /f $(LIBDIR)\Unicode\Normalize.pm - -del /f $(LIBDIR)\Math\BigInt\FastCalc.pm - -del /f $(LIBDIR)\Storable.pm - -del /f $(LIBDIR)\Win32.pm - -del /f $(LIBDIR)\Win32CORE.pm - -del /f $(LIBDIR)\Win32API\File.pm - -del /f $(LIBDIR)\Win32API\File\cFile.pc - -del /f $(LIBDIR)\buildcustomize.pl - -del /f $(DISTDIR)\XSLoader\XSLoader.pm - -del /f *.def *.map - -if exist $(LIBDIR)\Amiga rmdir /s /q $(LIBDIR)\Amiga - -if exist $(LIBDIR)\App rmdir /s /q $(LIBDIR)\App - -if exist $(LIBDIR)\Archive rmdir /s /q $(LIBDIR)\Archive - -if exist $(LIBDIR)\Attribute rmdir /s /q $(LIBDIR)\Attribute - -if exist $(LIBDIR)\autodie rmdir /s /q $(LIBDIR)\autodie - -if exist $(LIBDIR)\Carp rmdir /s /q $(LIBDIR)\Carp - -if exist $(LIBDIR)\Compress rmdir /s /q $(LIBDIR)\Compress - -if exist $(LIBDIR)\Config\Perl rmdir /s /q $(LIBDIR)\Config\Perl - -if exist $(LIBDIR)\CPAN rmdir /s /q $(LIBDIR)\CPAN - -if exist $(LIBDIR)\Data rmdir /s /q $(LIBDIR)\Data - -if exist $(LIBDIR)\Devel rmdir /s /q $(LIBDIR)\Devel - -if exist $(LIBDIR)\Digest rmdir /s /q $(LIBDIR)\Digest - -if exist $(LIBDIR)\Encode rmdir /s /q $(LIBDIR)\Encode - -if exist $(LIBDIR)\encoding rmdir /s /q $(LIBDIR)\encoding - -if exist $(LIBDIR)\Exporter rmdir /s /q $(LIBDIR)\Exporter - -if exist $(LIBDIR)\ExtUtils\CBuilder rmdir /s /q $(LIBDIR)\ExtUtils\CBuilder - -if exist $(LIBDIR)\ExtUtils\Command rmdir /s /q $(LIBDIR)\ExtUtils\Command - -if exist $(LIBDIR)\ExtUtils\Constant rmdir /s /q $(LIBDIR)\ExtUtils\Constant - -if exist $(LIBDIR)\ExtUtils\Liblist rmdir /s /q $(LIBDIR)\ExtUtils\Liblist - -if exist $(LIBDIR)\ExtUtils\MakeMaker rmdir /s /q $(LIBDIR)\ExtUtils\MakeMaker - -if exist $(LIBDIR)\ExtUtils\ParseXS rmdir /s /q $(LIBDIR)\ExtUtils\ParseXS - -if exist $(LIBDIR)\ExtUtils\Typemaps rmdir /s /q $(LIBDIR)\ExtUtils\Typemaps - -if exist $(LIBDIR)\File\Spec rmdir /s /q $(LIBDIR)\File\Spec - -if exist $(LIBDIR)\Filter rmdir /s /q $(LIBDIR)\Filter - -if exist $(LIBDIR)\Hash rmdir /s /q $(LIBDIR)\Hash - -if exist $(LIBDIR)\HTTP rmdir /s /q $(LIBDIR)\HTTP - -if exist $(LIBDIR)\I18N rmdir /s /q $(LIBDIR)\I18N - -if exist $(LIBDIR)\inc rmdir /s /q $(LIBDIR)\inc - -if exist $(LIBDIR)\IO rmdir /s /q $(LIBDIR)\IO - -if exist $(LIBDIR)\IPC rmdir /s /q $(LIBDIR)\IPC - -if exist $(LIBDIR)\JSON rmdir /s /q $(LIBDIR)\JSON - -if exist $(LIBDIR)\List rmdir /s /q $(LIBDIR)\List - -if exist $(LIBDIR)\Locale rmdir /s /q $(LIBDIR)\Locale - -if exist $(LIBDIR)\Math rmdir /s /q $(LIBDIR)\Math - -if exist $(LIBDIR)\Memoize rmdir /s /q $(LIBDIR)\Memoize - -if exist $(LIBDIR)\MIME rmdir /s /q $(LIBDIR)\MIME - -if exist $(LIBDIR)\Module rmdir /s /q $(LIBDIR)\Module - -if exist $(LIBDIR)\Net\FTP rmdir /s /q $(LIBDIR)\Net\FTP - -if exist $(LIBDIR)\Params rmdir /s /q $(LIBDIR)\Params - -if exist $(LIBDIR)\Parse rmdir /s /q $(LIBDIR)\Parse - -if exist $(LIBDIR)\Perl rmdir /s /q $(LIBDIR)\Perl - -if exist $(LIBDIR)\PerlIO rmdir /s /q $(LIBDIR)\PerlIO - -if exist $(LIBDIR)\Pod\Perldoc rmdir /s /q $(LIBDIR)\Pod\Perldoc - -if exist $(LIBDIR)\Pod\Simple rmdir /s /q $(LIBDIR)\Pod\Simple - -if exist $(LIBDIR)\Pod\Text rmdir /s /q $(LIBDIR)\Pod\Text - -if exist $(LIBDIR)\Scalar rmdir /s /q $(LIBDIR)\Scalar - -if exist $(LIBDIR)\Search rmdir /s /q $(LIBDIR)\Search - -if exist $(LIBDIR)\Sub rmdir /s /q $(LIBDIR)\Sub - -if exist $(LIBDIR)\Sys rmdir /s /q $(LIBDIR)\Sys - -if exist $(LIBDIR)\TAP rmdir /s /q $(LIBDIR)\TAP - -if exist $(LIBDIR)\Term rmdir /s /q $(LIBDIR)\Term - -if exist $(LIBDIR)\Test rmdir /s /q $(LIBDIR)\Test - -if exist $(LIBDIR)\Test2 rmdir /s /q $(LIBDIR)\Test2 - -if exist $(LIBDIR)\Text rmdir /s /q $(LIBDIR)\Text - -if exist $(LIBDIR)\Thread rmdir /s /q $(LIBDIR)\Thread - -if exist $(LIBDIR)\threads rmdir /s /q $(LIBDIR)\threads - -if exist $(LIBDIR)\Tie\Hash rmdir /s /q $(LIBDIR)\Tie\Hash - -if exist $(LIBDIR)\Unicode\Collate rmdir /s /q $(LIBDIR)\Unicode\Collate - -if exist $(LIBDIR)\Unicode\Collate\Locale rmdir /s /q $(LIBDIR)\Unicode\Collate\Locale - -if exist $(LIBDIR)\version rmdir /s /q $(LIBDIR)\version - -if exist $(LIBDIR)\VMS rmdir /s /q $(LIBDIR)\VMS - -if exist $(LIBDIR)\Win32API rmdir /s /q $(LIBDIR)\Win32API - -if exist $(LIBDIR)\XS rmdir /s /q $(LIBDIR)\XS - -cd $(PODDIR) && del /f *.html *.bat roffitall \ - perl5337delta.pod perlaix.pod perlamiga.pod perlandroid.pod \ - perlapi.pod perlbs2000.pod perlcn.pod perlcygwin.pod \ - perldos.pod perlfreebsd.pod perlhaiku.pod perlhpux.pod \ - perlhurd.pod perlintern.pod perlirix.pod perljp.pod perlko.pod \ - perllinux.pod perlmacos.pod perlmacosx.pod perlmodlib.pod \ - perlnetware.pod perlopenbsd.pod perlos2.pod perlos390.pod \ - perlos400.pod perlplan9.pod perlqnx.pod perlriscos.pod \ - perlsolaris.pod perlsynology.pod perltoc.pod perltru64.pod \ - perltw.pod perluniprops.pod perlvos.pod perlwin32.pod - -cd ..\utils && del /f h2ph splain perlbug pl2pm h2xs \ - perldoc perlivp libnetcfg enc2xs encguess piconv cpan streamzip *.bat \ - xsubpp pod2html instmodsh json_pp prove ptar ptardiff ptargrep shasum corelist zipdetails - -del /f ..\config.sh perlmain.c dlutils.c config.h.new \ - perlmainst.c - -del /f $(CONFIGPM) - -del /f ..\lib\Config_git.pl - -del /f bin\*.bat - -del /f perllibst.h - -del /f $(PERLEXE_RES) perl.base - -cd .. && del /s *$(a) *.map *.pdb *.ilk *.bs *$(o) .exists pm_to_blib ppport.h - -cd $(EXTDIR) && del /s *.def Makefile Makefile.old - -cd $(DISTDIR) && del /s *.def Makefile Makefile.old - -cd $(CPANDIR) && del /s *.def Makefile Makefile.old - -del /s ..\utils\Makefile - -if exist $(AUTODIR) rmdir /s /q $(AUTODIR) - -if exist $(COREDIR) rmdir /s /q $(COREDIR) - -if exist pod2htmd.tmp del pod2htmd.tmp - -if exist $(HTMLDIR) rmdir /s /q $(HTMLDIR) - -del /f ..\t\test_state - -install : all installbare installhtml - -installbare : utils ..\pod\perltoc.pod - $(PERLEXE) ..\installperl - if exist $(WPERLEXE) $(XCOPY) $(WPERLEXE) $(INST_BIN)\*.* - if exist $(PERLEXESTATIC) $(XCOPY) $(PERLEXESTATIC) $(INST_BIN)\*.* - $(XCOPY) $(GLOBEXE) $(INST_BIN)\*.* - if exist ..\perl*.pdb $(XCOPY) ..\perl*.pdb $(INST_BIN)\*.* - $(XCOPY) bin\*.bat $(INST_SCRIPT)\*.* - -installhtml : doc - $(RCOPY) $(HTMLDIR)\*.* $(INST_HTML)\*.* - -inst_lib : $(CONFIGPM) - $(RCOPY) ..\lib $(INST_LIB)\*.* - -$(UNIDATAFILES) ..\pod\perluniprops.pod .UPDATEALL : ..\lib\unicore\mktables $(CONFIGPM) - $(MINIPERL) -I..\lib ..\lib\unicore\mktables -C ..\lib\unicore -P ..\pod -maketest -makelist -p - -minitest : .\config.h $(HAVEMINIPERL) ..\git_version.h $(GLOBEXE) $(CONFIGPM) $(UNIDATAFILES) $(TESTPREPGCC) - $(XCOPY) $(MINIPERL) ..\t\$(NULL) - if exist ..\t\perl.exe del /f ..\t\perl.exe - rename ..\t\miniperl.exe perl.exe - $(XCOPY) $(GLOBEXE) ..\t\$(NULL) -# Note this perl.exe is miniperl - cd ..\t && perl.exe TEST base/*.t comp/*.t cmd/*.t run/*.t io/*.t re/*.t opbasic/*.t op/*.t uni/*.t perf/*.t pragma/*.t - -test-prep : all utils ..\pod\perltoc.pod $(TESTPREPGCC) - $(XCOPY) $(PERLEXE) ..\t\$(NULL) && $(XCOPY) $(PERLDLL) ..\t\$(NULL) \ - && $(XCOPY) $(GLOBEXE) ..\t\$(NULL) - -# If building with gcc versions 4.x.x or greater, then -# the GCC helper DLL will also need copied to the test directory. -# The name of the dll can change, depending upon which vendor has supplied -# your compiler, and upon the values of "x". -# libstdc++-6.dll is copied if it exists as it, too, may then be needed. -# Without this copying, the op/taint.t test script will fail. - -.IF "$(CCTYPE)" == "GCC" - -test-prep-gcc : - if exist $(CCDLLDIR)\libgcc_s_seh-1.dll $(XCOPY) $(CCDLLDIR)\libgcc_s_seh-1.dll ..\t\$(NULL) - if exist $(CCDLLDIR)\libgcc_s_sjlj-1.dll $(XCOPY) $(CCDLLDIR)\libgcc_s_sjlj-1.dll ..\t\$(NULL) - if exist $(CCDLLDIR)\libgcc_s_dw2-1.dll $(XCOPY) $(CCDLLDIR)\libgcc_s_dw2-1.dll ..\t\$(NULL) - if exist $(CCDLLDIR)\libstdc++-6.dll $(XCOPY) $(CCDLLDIR)\libstdc++-6.dll ..\t\$(NULL) - if exist $(CCDLLDIR)\libwinpthread-1.dll $(XCOPY) $(CCDLLDIR)\libwinpthread-1.dll ..\t\$(NULL) - if exist $(CCDLLDIR)\libquadmath-0.dll $(XCOPY) $(CCDLLDIR)\libquadmath-0.dll ..\t\$(NULL) - -.ENDIF - -test : test-prep - set PERL_STATIC_EXT=$(STATIC_EXT) && \ - cd ..\t && perl.exe harness $(TEST_SWITCHES) $(TEST_FILES) - -test_porting : test-prep - set PERL_STATIC_EXT=$(STATIC_EXT) && \ - cd ..\t && perl.exe harness $(TEST_SWITCHES) porting\*.t ..\lib\diagnostics.t - -test-reonly : reonly utils - $(XCOPY) $(PERLEXE) ..\t\$(NULL) - $(XCOPY) $(PERLDLL) ..\t\$(NULL) - $(XCOPY) $(GLOBEXE) ..\t\$(NULL) - cd ..\t && perl.exe harness $(OPT) -re \bpat\\/ $(EXTRA) - -regen : - cd .. && regen.pl - -test-notty : test-prep - set PERL_STATIC_EXT=$(STATIC_EXT) && \ - set PERL_SKIP_TTY_TEST=1 && \ - cd ..\t && perl.exe harness $(TEST_SWITCHES) $(TEST_FILES) - -_test : - $(XCOPY) $(PERLEXE) ..\t\$(NULL) - $(XCOPY) $(PERLDLL) ..\t\$(NULL) - $(XCOPY) $(GLOBEXE) ..\t\$(NULL) - set PERL_STATIC_EXT=$(STATIC_EXT) && \ - cd ..\t && perl.exe harness $(TEST_SWITCHES) $(TEST_FILES) - -_clean : - -@erase miniperlmain$(o) - -@erase $(MINIPERL) - -@erase perlglob$(o) - -@erase perlmain$(o) - -@erase perlmainst$(o) - -@erase /f config.h - -@erase /f ..\git_version.h - -@erase $(GLOBEXE) - -@erase $(PERLEXE) - -@erase $(WPERLEXE) - -@erase $(PERLEXESTATIC) - -@erase $(PERLSTATICLIB) - -@erase $(PERLDLL) - -@erase $(CORE_OBJ) - -@erase $(GENUUDMAP) $(GENUUDMAP_OBJ) $(GENERATED_HEADERS) - -@erase .coreheaders - -if exist $(MINIDIR) rmdir /s /q $(MINIDIR) - -if exist $(UNIDATADIR1) rmdir /s /q $(UNIDATADIR1) - -if exist $(UNIDATADIR2) rmdir /s /q $(UNIDATADIR2) - -@erase $(UNIDATAFILES) - -@erase $(WIN32_OBJ) - -@erase $(DLL_OBJ) - -@erase ..\*$(o) ..\*$(a) ..\*.exp *$(o) *$(a) *.exp *.res - -@erase ..\t\*.exe ..\t\*.dll ..\t\*.bat - -@erase *.ilk - -@erase *.pdb ..\*.pdb - -@erase Extensions_static - -clean : Extensions_clean _clean - -realclean : Extensions_realclean _clean - -# Handy way to run perlbug -ok without having to install and run the -# installed perlbug. We don't re-run the tests here - we trust the user. -# Please *don't* use this unless all tests pass. -# If you want to report test failures, use "dmake nok" instead. -ok: utils $(PERLEXE) $(PERLDLL) Extensions_nonxs Extensions - $(PERLEXE) ..\utils\perlbug -ok -s "(UNINSTALLED)" - -okfile: utils $(PERLEXE) $(PERLDLL) Extensions_nonxs Extensions - $(PERLEXE) ..\utils\perlbug -ok -s "(UNINSTALLED)" -F perl.ok - -nok: utils $(PERLEXE) $(PERLDLL) Extensions_nonxs Extensions - $(PERLEXE) ..\utils\perlbug -nok -s "(UNINSTALLED)" - -nokfile: utils $(PERLEXE) $(PERLDLL) Extensions_nonxs Extensions - $(PERLEXE) ..\utils\perlbug -nok -s "(UNINSTALLED)" -F perl.nok - From 5c10055a4c2731eebe01289fec8d4720e79add07 Mon Sep 17 00:00:00 2001 From: Tomasz Konojacki Date: Wed, 20 Jan 2021 22:15:21 +0100 Subject: [PATCH 488/503] Set $Config{libpth} properly for MinGW builds Previously the default libpth consisted of just a single folder and failed to include the directory that contains the majority of the libraries. This is a fairly important issue but no one noticed it for two reasons: 1. EU::MM on Windows *always* links XS modules with the libraries from $Config{libs}, so you'd notice that linking doesn't work only if you needed a library that isn't listed there. 2. Strawberry Perl has a workaround for this issue[1]. I'm only using MinGW-w64 compilers, so I have no idea how library paths work on MinGW.org builds. It's possible that the previous libpth worked fine with them. Either way, this commit only adds new paths to libpth, it doesn't modify the one that was already there, so it's unlikely it will break anything. [1] - https://github.com/StrawberryPerl/Perl-Dist-Strawberry/blob/2112b8a590882e913e98e4aa2dced4f34c4fea79/lib/Perl/Dist/Strawberry/Step/InstallPerlCore.pm#L136 --- win32/GNUmakefile | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/win32/GNUmakefile b/win32/GNUmakefile index c704e8a7c798..edfd0882b4ef 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -493,6 +493,13 @@ ifeq ($(USE_QUADMATH),define) ARCHNAME := $(ARCHNAME)-quadmath endif +ifeq ($(CCTYPE),GCC) +GCCVER := $(shell $(GCCBIN) -dumpversion) +GCCVER1 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('$(GCCBIN) -dumpversion') do echo %%i) +GCCVER2 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('$(GCCBIN) -dumpversion') do echo %%j) +GCCVER3 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('$(GCCBIN) -dumpversion') do echo %%k) +endif + # Set the install location of the compiler headers/libraries. # These are saved into $Config{incpath} and $Config{libpth}. ifneq ($(GCCCROSS),) @@ -501,7 +508,7 @@ CCLIBDIR := $(CCHOME)\$(GCCCROSS)\lib ARCHPREFIX := $(GCCCROSS)- else ifeq ($(CCTYPE),GCC) CCINCDIR := $(CCHOME)\include -CCLIBDIR := $(CCHOME)\lib +CCLIBDIR := $(CCHOME)\lib;$(CCHOME)\$(GCCTARGET)\lib;$(CCHOME)\lib\gcc\$(GCCTARGET)\$(GCCVER) ARCHPREFIX := else CCINCDIR := $(CCHOME)\include @@ -530,7 +537,7 @@ endif # Set DLL location for GCC compilers. ifeq ($(CCTYPE),GCC) ifneq ($(GCCCROSS),) -CCDLLDIR := $(CCLIBDIR) +CCDLLDIR := $(CCHOME)\$(GCCCROSS)\lib else CCDLLDIR := $(CCHOME)\bin endif @@ -575,9 +582,6 @@ BUILDOPT += -D__USE_MINGW_ANSI_STDIO MINIBUILDOPT += -D__USE_MINGW_ANSI_STDIO endif -GCCVER1 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%i) -GCCVER2 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%j) -GCCVER3 := $(shell for /f "delims=. tokens=1,2,3" %%i in ('gcc -dumpversion') do echo %%k) # If you are using GCC, 4.3 or later by default we add the -fwrapv option. # See https://github.com/Perl/perl5/issues/13690 @@ -627,7 +631,7 @@ ifeq ($(USE_CPLUSPLUS),define) EXTRACFLAGS += $(CXX_FLAG) endif CFLAGS = $(EXTRACFLAGS) $(INCLUDES) $(DEFINES) $(LOCDEFS) $(OPTIMIZE) -LINK_FLAGS = $(LINK_DBG) -L"$(INST_COREDIR)" -L"$(CCLIBDIR)" +LINK_FLAGS = $(LINK_DBG) -L"$(INST_COREDIR)" -L"$(subst ;," -L",$(CCLIBDIR))" OBJOUT_FLAG = -o EXEOUT_FLAG = -o LIBOUT_FLAG = From 57092531ca2360776c3c5703068fcc2daa633a53 Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Thu, 28 Dec 2017 19:23:03 +0100 Subject: [PATCH 489/503] Enforce STOP_AT_PARTIAL in $PerlIO::encoding::fallback PerlIO::encoding has a $fallback variable that allows one to set the behavior on a encoding/decoding error, for example to make it throw an exception on error. What is not documented (actually the example in the documentation is even missing this) is that PerlIO::encoding needs the (equally undocumented) Encode::STOP_AT_PARTIAL flag to be set, otherwise a multi-byte character spanning buffer boundaries will be interpreted as two invalid byte sequences. I could have fixed the documentation, but instead I fixed the code to always pass this flag to Encode, simplifying the use and making the current documentation correct again. --- ext/PerlIO-encoding/encoding.pm | 5 ++--- ext/PerlIO-encoding/encoding.xs | 15 +++++++++++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/ext/PerlIO-encoding/encoding.pm b/ext/PerlIO-encoding/encoding.pm index daf44571880e..c80a96e7a754 100644 --- a/ext/PerlIO-encoding/encoding.pm +++ b/ext/PerlIO-encoding/encoding.pm @@ -1,7 +1,7 @@ package PerlIO::encoding; use strict; -our $VERSION = '0.28'; +our $VERSION = '0.29'; our $DEBUG = 0; $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; @@ -13,8 +13,7 @@ $DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; require XSLoader; XSLoader::load(); -our $fallback = - Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::ONLY_PRAGMA_WARNINGS()|Encode::STOP_AT_PARTIAL(); +our $fallback = Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::ONLY_PRAGMA_WARNINGS(); 1; __END__ diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 9d98d878db22..1db9eba81e12 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -5,6 +5,10 @@ #define U8 U8 #define OUR_DEFAULT_FB "Encode::PERLQQ" +#define OUR_STOP_AT_PARTIAL "Encode::STOP_AT_PARTIAL" + +/* This will be set during BOOT */ +static unsigned int encode_stop_at_partial = 0; #if defined(USE_PERLIO) @@ -164,6 +168,7 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * } e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0)); + SvUV_set(e->chk, SvUV(e->chk) | encode_stop_at_partial); e->inEncodeCall = 0; FREETMPS; @@ -662,6 +667,16 @@ BOOT: } SPAGAIN; sv_setsv(chk, POPs); + + PUSHMARK(sp); + PUTBACK; + if (call_pv(OUR_STOP_AT_PARTIAL, G_SCALAR) != 1) { + /* should never happen */ + Perl_die(aTHX_ "%s did not return a value", OUR_STOP_AT_PARTIAL); + } + SPAGAIN; + encode_stop_at_partial = POPu; + PUTBACK; #ifdef PERLIO_LAYERS PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_encode)); From 79a3675f89ea7d9d801c159a22ea1e1f8058e9c3 Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Thu, 4 Jan 2018 19:56:03 +0100 Subject: [PATCH 490/503] Disallow coderef in $PerlIO::encoding::fallback Encode allows one to pass a coderef instead of a set of flags to handle. This however doesn't allow one to pass STOP_AT_PARTIAL, which means it has always been buggy on buffer boundaries. With my new automatic STOP_AT_PARTIAL passing this would result in an unpredictable value. Instead we now disallow it in PerlIO::encoding. --- ext/PerlIO-encoding/encoding.xs | 2 ++ 1 file changed, 2 insertions(+) diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 1db9eba81e12..720808d87dcf 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -168,6 +168,8 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * } e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0)); + if (SvROK(e->chk)) + Perl_croak(aTHX_ "PerlIO::encoding::fallback must be an integer"); SvUV_set(e->chk, SvUV(e->chk) | encode_stop_at_partial); e->inEncodeCall = 0; From 370c6ab2e9608a94096854c61d976ccf65bb2c13 Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Tue, 19 Jan 2021 19:53:08 +0100 Subject: [PATCH 491/503] Omit setting of $PerlIO::encoding::fallback from xs It's also set from encoding.pm, doing it double serves no purpose --- ext/PerlIO-encoding/encoding.xs | 14 +------------- 1 file changed, 1 insertion(+), 13 deletions(-) diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 720808d87dcf..15709d24dd0a 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -652,23 +652,11 @@ BOOT: * is invoked without prior "use Encode". -- dankogai */ PUSHSTACKi(PERLSI_MAGIC); - if (!get_cvs(OUR_DEFAULT_FB, 0)) { -#if 0 - /* This would just be an irritant now loading works */ - Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'"); -#endif + if (!get_cvs(OUR_STOP_AT_PARTIAL, 0)) { /* The SV is magically freed by load_module */ load_module(PERL_LOADMOD_NOIMPORT, newSVpvs("Encode"), Nullsv, Nullsv); assert(sp == PL_stack_sp); } - PUSHMARK(sp); - PUTBACK; - if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) { - /* should never happen */ - Perl_die(aTHX_ "%s did not return a value",OUR_DEFAULT_FB); - } - SPAGAIN; - sv_setsv(chk, POPs); PUSHMARK(sp); PUTBACK; From 034aa3082b067ebeeb73f269627b26aa149f6e6f Mon Sep 17 00:00:00 2001 From: Leon Timmermans Date: Tue, 19 Jan 2021 20:21:05 +0100 Subject: [PATCH 492/503] Force disable LEAVE_SRC in $PerlIO::encoding::fallback Setting $PerlIO::encoding::fallback to any value containing LEAVE_SRC will result in an infinite loop of the first buffer of input. This is never desirable. --- ext/PerlIO-encoding/encoding.xs | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/ext/PerlIO-encoding/encoding.xs b/ext/PerlIO-encoding/encoding.xs index 15709d24dd0a..9deb20bf2670 100644 --- a/ext/PerlIO-encoding/encoding.xs +++ b/ext/PerlIO-encoding/encoding.xs @@ -6,9 +6,11 @@ #define OUR_DEFAULT_FB "Encode::PERLQQ" #define OUR_STOP_AT_PARTIAL "Encode::STOP_AT_PARTIAL" +#define OUR_LEAVE_SRC "Encode::LEAVE_SRC" /* This will be set during BOOT */ static unsigned int encode_stop_at_partial = 0; +static unsigned int encode_leave_src = 0; #if defined(USE_PERLIO) @@ -170,7 +172,7 @@ PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs * e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0)); if (SvROK(e->chk)) Perl_croak(aTHX_ "PerlIO::encoding::fallback must be an integer"); - SvUV_set(e->chk, SvUV(e->chk) | encode_stop_at_partial); + SvUV_set(e->chk, SvUV(e->chk) & ~encode_leave_src | encode_stop_at_partial); e->inEncodeCall = 0; FREETMPS; @@ -667,6 +669,15 @@ BOOT: SPAGAIN; encode_stop_at_partial = POPu; + PUSHMARK(sp); + PUTBACK; + if (call_pv(OUR_LEAVE_SRC, G_SCALAR) != 1) { + /* should never happen */ + Perl_die(aTHX_ "%s did not return a value", OUR_LEAVE_SRC); + } + SPAGAIN; + encode_leave_src = POPu; + PUTBACK; #ifdef PERLIO_LAYERS PerlIO_define_layer(aTHX_ PERLIO_FUNCS_CAST(&PerlIO_encode)); From cac138107138a9814b32c4de74426225628f1646 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sun, 17 Jan 2021 21:45:20 -0700 Subject: [PATCH 493/503] Add missing entries to perldiag; GH #18276 The ticket mentions yet another message, not addressed in this commit, "Insecure private-use override". That message is part of a hook for a so-far unimplemented module, so it actually doesn't ever get raised. Committer: One correction per Grinnz comment in https://github.com/Perl/perl5/pull/18491 --- pod/perldiag.pod | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) diff --git a/pod/perldiag.pod b/pod/perldiag.pod index 9c91630d3970..63f57f220ef0 100644 --- a/pod/perldiag.pod +++ b/pod/perldiag.pod @@ -2195,6 +2195,20 @@ single form when it must operate on them directly. Either you've passed an invalid file specification to Perl, or you've found a case the conversion routines don't handle. Drat. +=item Error %s in expansion of %s + +(F) An error was encountered in handling a user-defined property +(L). These are +programmer written subroutines, hence subject to errors that may +prevent them from compiling or running. The calls to these subs are +C'd, and if there is a failure, this message is raised, using the +contents of C<$@> from the failed C. + +Another possibility is that tainted data was encountered somewhere in +the chain of expanding the property. If so, the message wording will +indicate that this is the problem. See L. + =item Eval-group in insecure regular expression (F) Perl detected tainted data when trying to compile a regular @@ -2836,6 +2850,16 @@ not match 8 spaces. text. You should check the pattern to ensure that recursive patterns either consume text or fail. +=item Infinite recursion in user-defined property + +(F) A user-defined property (L) can depend on the definitions of other user-defined +properties. If the chain of dependencies leads back to this property, +infinite recursion would occur, were it not for the check that raised +this error. + +Restructure your property definitions to avoid this. + =item Infinite recursion via empty pattern (F) You tried to use the empty pattern inside of a regex code block, @@ -6273,6 +6297,20 @@ lexicals that are initialized only once (see L): This use of C in a false conditional was deprecated beginning in Perl 5.10 and became a fatal error in Perl 5.30. +=item Timeout waiting for another thread to define \p{%s} + +(F) The first time a user-defined property +(L) is used, its +definition is looked up and converted into an internal form for more +efficient handling in subsequent uses. There could be a race if two or +more threads tried to do this processing nearly simultaneously. +Instead, a critical section is created around this task, locking out all +but one thread from doing it. This message indicates that the thread +that is doing the conversion is taking an unexpectedly long time. The +timeout exists solely to prevent deadlock; it's long enough that the +system was likely thrashing and about to crash. There is no real remedy but +rebooting. + =item times not implemented (F) Your version of the C library apparently doesn't do times(). I @@ -6846,6 +6884,13 @@ for the list of known options. Llist]> documentation of the C<-C> switch for the list of known options. +=item Unknown user-defined property name \p{%s} + +(F) You specified to use a property within the C<\p{...}> which was a +syntactically valid user-defined property, but no definition was found +for it by the time one was required to proceed. Check your spelling. +See L. + =item Unknown verb pattern '%s' in regex; marked by S<<-- HERE> in m/%s/ (F) You either made a typo or have incorrectly put a C<*> quantifier From 01900a5f2323125cf6be2b31b3866a63489bfb03 Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Sat, 30 Jan 2021 21:21:04 +0000 Subject: [PATCH 494/503] Additional guidance against "FATAL => 'all'". For: https://github.com/Perl/perl5/pull/18385 --- lib/warnings.pm | 7 +++++-- regen/warnings.pl | 7 +++++-- 2 files changed, 10 insertions(+), 4 deletions(-) diff --git a/lib/warnings.pm b/lib/warnings.pm index d1c17ab70020..da1ca6caa4db 100644 --- a/lib/warnings.pm +++ b/lib/warnings.pm @@ -5,7 +5,7 @@ package warnings; -our $VERSION = "1.50"; +our $VERSION = "1.51"; # Verify that we're called correctly so that warnings will work. # Can't use Carp, since Carp uses us! @@ -1052,7 +1052,7 @@ The L module on CPAN offers one example of a warnings subset that the module's authors believe is relatively safe to fatalize. -B users of FATAL warnings, especially those using +B Users of FATAL warnings, especially those using C<< FATAL => 'all' >>, should be fully aware that they are risking future portability of their programs by doing so. Perl makes absolutely no commitments to not introduce new warnings or warnings categories in the @@ -1120,6 +1120,9 @@ use: use v5.20; # Perl 5.20 or greater is required for the following use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';" +However, you should still heed the guidance earlier in this section against +using C 'all';>. + If you want your program to be compatible with versions of Perl before 5.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In previous versions of Perl, the behavior of the statements diff --git a/regen/warnings.pl b/regen/warnings.pl index 0ca928b6f0cd..f08d2d63795b 100644 --- a/regen/warnings.pl +++ b/regen/warnings.pl @@ -16,7 +16,7 @@ # # This script is normally invoked from regen.pl. -$VERSION = '1.50'; +$VERSION = '1.51'; BEGIN { require './regen/regen_lib.pl'; @@ -1210,7 +1210,7 @@ =head2 Fatal Warnings a warnings subset that the module's authors believe is relatively safe to fatalize. -B users of FATAL warnings, especially those using +B Users of FATAL warnings, especially those using C<< FATAL => 'all' >>, should be fully aware that they are risking future portability of their programs by doing so. Perl makes absolutely no commitments to not introduce new warnings or warnings categories in the @@ -1278,6 +1278,9 @@ =head2 Fatal Warnings use v5.20; # Perl 5.20 or greater is required for the following use warnings 'FATAL'; # short form of "use warnings FATAL => 'all';" +However, you should still heed the guidance earlier in this section against +using C 'all';>. + If you want your program to be compatible with versions of Perl before 5.20, you must use C<< use warnings FATAL => 'all'; >> instead. (In previous versions of Perl, the behavior of the statements From a19f6621766baa4f472625c06f146105b33d441d Mon Sep 17 00:00:00 2001 From: James E Keenan Date: Fri, 15 Jan 2021 16:09:27 -0500 Subject: [PATCH 495/503] Provide guidance for dynamic modifiers For: https://github.com/Perl/perl5/issues/18387 --- pod/perlre.pod | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/pod/perlre.pod b/pod/perlre.pod index f963fe76e5c7..bd49ac7e9eba 100644 --- a/pod/perlre.pod +++ b/pod/perlre.pod @@ -313,7 +313,8 @@ The default behavior for matching can be changed, using various modifiers. Modifiers that relate to the interpretation of the pattern are listed just below. Modifiers that alter the way a pattern is used by Perl are detailed in L and -L. +L. Modifiers can be added +dynamically; see L below. =over 4 From 05423e5e683162413b0048fac4fbed90902387cf Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Wed, 13 Jan 2021 15:10:43 -0700 Subject: [PATCH 496/503] perlretut: Grammar, clarifications, white-space --- pod/perlretut.pod | 52 +++++++++++++++++++++++++---------------------- 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/pod/perlretut.pod b/pod/perlretut.pod index ce196f30515e..ea127a3ec445 100644 --- a/pod/perlretut.pod +++ b/pod/perlretut.pod @@ -20,8 +20,10 @@ expressions will allow you to manipulate text with surprising ease. What is a regular expression? At its most basic, a regular expression is a template that is used to determine if a string has certain characteristics. The string is most often some text, such as a line, -sentence, web page, or even a whole book, but less commonly it could be -some binary data as well. +sentence, web page, or even a whole book, but it doesn't have to be. It +could be binary data, for example. Biologists often use Perl to look +for patterns in long DNA sequences. + Suppose we want to determine if the text in variable, C<$var> contains the sequence of characters S> (blanks added for legibility). We can write in Perl @@ -29,8 +31,9 @@ the sequence of characters S> $var =~ m/mushroom/ The value of this expression will be TRUE if C<$var> contains that -sequence of characters, and FALSE otherwise. The portion enclosed in -C<'E'> characters denotes the characteristic we are looking for. +sequence of characters anywhere within it, and FALSE otherwise. The +portion enclosed in C<'E'> characters denotes the characteristic we +are looking for. We use the term I for it. The process of looking to see if the pattern occurs in the string is called I, and the C<"=~"> operator along with the C tell Perl to try to match the pattern @@ -60,7 +63,7 @@ many examples. The first part of the tutorial will progress from the simplest word searches to the basic regular expression concepts. If you master the first part, you will have all the tools needed to solve about 98% of your needs. The second part of the tutorial is for those -comfortable with the basics and hungry for more power tools. It +comfortable with the basics, and hungry for more power tools. It discusses the more advanced regular expression operators and introduces the latest cutting-edge innovations. @@ -135,7 +138,7 @@ And finally, the C default delimiters for a match can be changed to arbitrary delimiters by putting an C<'m'> out front: "Hello World" =~ m!World!; # matches, delimited by '!' - "Hello World" =~ m{World}; # matches, note the matching '{}' + "Hello World" =~ m{World}; # matches, note the paired '{}' "/usr/bin/perl" =~ m"/perl"; # matches after '/usr/bin', # '/' becomes an ordinary char @@ -151,7 +154,7 @@ Let's consider how different regexps would match C<"Hello World">: "Hello World" =~ /oW/; # doesn't match "Hello World" =~ /World /; # doesn't match -The first regexp C doesn't match because regexps are +The first regexp C doesn't match because regexps are by default case-sensitive. The second regexp matches because the substring S> occurs in the string S>. The space character C<' '> is treated like any other character in a regexp and is @@ -169,8 +172,8 @@ always match at the earliest possible point in the string: "That hat is red" =~ /hat/; # matches 'hat' in 'That' With respect to character matching, there are a few more points you -need to know about. First of all, not all characters can be used "as -is" in a match. Some characters, called I, are +need to know about. First of all, not all characters can be used +"as-is" in a match. Some characters, called I, are generally reserved for use in regexp notation. The metacharacters are {}[]()^$.|*+?-#\ @@ -832,8 +835,8 @@ Counting the opening parentheses to get the correct number for a backreference is error-prone as soon as there is more than one capturing group. A more convenient technique became available with Perl 5.10: relative backreferences. To refer to the immediately -preceding capture group one now may write C<\g{-1}>, the next but -last is available via C<\g{-2}>, and so on. +preceding capture group one now may write C<\g-1> or C<\g{-1}>, the next but +last is available via C<\g-2> or C<\g{-2}>, and so on. Another good reason in addition to readability and maintainability for using relative backreferences is illustrated by the following example, @@ -1989,10 +1992,11 @@ C<\x>I (without curly braces and I are two hex digits) doesn't go further than 255. (Starting in Perl 5.14, if you're an octal fan, you can also use C<\o{oct}>.) - /\x{263a}/; # match a Unicode smiley face :) + /\x{263a}/; # match a Unicode smiley face :) + /\x{ 263a }/; # Same B: In Perl 5.6.0 it used to be that one needed to say C to use any Unicode features. This is no more the case: for +utf8> to use any Unicode features. This is no longer the case: for almost all Unicode processing, the explicit C pragma is not needed. (The only case where it matters is if your Perl script is in Unicode and encoded in UTF-8, then an explicit C is needed.) @@ -2070,16 +2074,16 @@ C<\p{Mark}>, meaning things like accent marks. The Unicode C<\p{Script}> and C<\p{Script_Extensions}> properties are used to categorize every Unicode character into the language script it -is written in. (C is an improved version of -C