From 5bc4f2ce6497b691bc6d99bd4210224006440df8 Mon Sep 17 00:00:00 2001 From: Utkarsh Gupta Date: Tue, 16 Jul 2019 02:48:30 +0530 Subject: New upstream version 0.007 --- Changes | 3 + META.json | 186 ++-- META.yml | 160 ++-- Makefile.PL | 8 +- README | 8 +- filehandles.xs | 2 + lib/bareword/filehandles.pm | 10 +- ppport.h | 2198 ++++++++++++++++++++++++++++--------------- t/basic.t | 18 +- 9 files changed, 1652 insertions(+), 941 deletions(-) diff --git a/Changes b/Changes index e933d53..d962a27 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,8 @@ Revision history for bareword::filehandles +0.007 2019-05-27 20:15:54+01:00 Europe/London + - Disable checking filetest ops on perl < 5.31.1 (RT#127073) + 0.006 2018-04-26 22:36:49+01:00 Europe/London - Only use Lexical::SealRequireHints before perl 5.12 diff --git a/META.json b/META.json index 9f52fda..9aad774 100644 --- a/META.json +++ b/META.json @@ -72,7 +72,7 @@ "provides" : { "bareword::filehandles" : { "file" : "lib/bareword/filehandles.pm", - "version" : "0.006" + "version" : "0.007" } }, "release_status" : "stable", @@ -84,10 +84,10 @@ "web" : "https://github.com/ilmari/bareword-filehandles" } }, - "version" : "0.006", + "version" : "0.007", "x_Dist_Zilla" : { "perl" : { - "version" : "5.026000" + "version" : "5.030000" }, "plugins" : [ { @@ -102,19 +102,19 @@ "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." } }, "name" : "@Git/Check", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], - "commit_msg" : "v%v%n%n%c" + "commit_msg" : "v%V%n%n%c" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [], @@ -122,7 +122,7 @@ "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { @@ -130,7 +130,7 @@ } }, "name" : "@Git/Commit", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Tag", @@ -139,12 +139,12 @@ "branch" : null, "changelog" : "Changes", "signed" : 0, - "tag" : "v0.006", - "tag_format" : "v%v", - "tag_message" : "v%v" + "tag" : "v0.007", + "tag_format" : "v%V", + "tag_message" : "v%V" }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { @@ -152,7 +152,7 @@ } }, "name" : "@Git/Tag", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Push", @@ -164,12 +164,12 @@ "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." } }, "name" : "@Git/Push", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::NextVersion", @@ -180,18 +180,18 @@ "version_regexp" : "(?^:^v(.+)$)" }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." } }, "name" : "Git::NextVersion", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Contributors", "config" : { "Dist::Zilla::Plugin::Git::Contributors" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "include_authors" : 0, "include_releaser" : 1, "order_by" : "name", @@ -199,7 +199,7 @@ } }, "name" : "Git::Contributors", - "version" : "0.034" + "version" : "0.035" }, { "class" : "Dist::Zilla::Plugin::Git::GatherDir", @@ -220,7 +220,7 @@ } }, "name" : "Git::GatherDir", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::PodWeaver", @@ -326,70 +326,23 @@ "class" : "Dist::Zilla::Plugin::DynamicPrereqs", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { - "Module::Metadata" : "1.000033", - "version" : "0.004" + "Module::Metadata" : "1.000036", + "version" : "0.006" } }, "name" : "DynamicPrereqs", - "version" : "0.034" + "version" : "0.035" }, { "class" : "Dist::Zilla::Plugin::DynamicPrereqs", "config" : { "Dist::Zilla::Role::ModuleMetadata" : { - "Module::Metadata" : "1.000033", - "version" : "0.004" + "Module::Metadata" : "1.000036", + "version" : "0.006" } }, "name" : "LSRH", - "version" : "0.034" - }, - { - "class" : "Dist::Zilla::Plugin::PruneCruft", - "name" : "@Starter/PruneCruft", - "version" : "6.012" - }, - { - "class" : "Dist::Zilla::Plugin::ManifestSkip", - "name" : "@Starter/ManifestSkip", - "version" : "6.012" - }, - { - "class" : "Dist::Zilla::Plugin::MetaConfig", - "name" : "@Starter/MetaConfig", - "version" : "6.012" - }, - { - "class" : "Dist::Zilla::Plugin::MetaProvides::Package", - "config" : { - "Dist::Zilla::Plugin::MetaProvides::Package" : { - "finder_objects" : [ - { - "class" : "Dist::Zilla::Plugin::FinderCode", - "name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM", - "version" : "6.012" - } - ], - "include_underscores" : 0 - }, - "Dist::Zilla::Role::MetaProvider::Provider" : { - "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", - "inherit_missing" : 1, - "inherit_version" : 1, - "meta_noindex" : 1 - }, - "Dist::Zilla::Role::ModuleMetadata" : { - "Module::Metadata" : "1.000033", - "version" : "0.004" - } - }, - "name" : "@Starter/MetaProvides::Package", - "version" : "2.004003" - }, - { - "class" : "Dist::Zilla::Plugin::MetaNoIndex", - "name" : "@Starter/MetaNoIndex", - "version" : "6.012" + "version" : "0.035" }, { "class" : "Dist::Zilla::Plugin::MetaYAML", @@ -416,16 +369,6 @@ "name" : "@Starter/ReadmeAnyFromPod", "version" : "0.163250" }, - { - "class" : "Dist::Zilla::Plugin::ExecDir", - "name" : "@Starter/ExecDir", - "version" : "6.012" - }, - { - "class" : "Dist::Zilla::Plugin::ShareDir", - "name" : "@Starter/ShareDir", - "version" : "6.012" - }, { "class" : "Dist::Zilla::Plugin::PodSyntaxTests", "name" : "@Starter/PodSyntaxTests", @@ -475,8 +418,13 @@ "version" : "6.012" }, { - "class" : "Dist::Zilla::Plugin::TestRelease", - "name" : "@Starter/TestRelease", + "class" : "Dist::Zilla::Plugin::PruneCruft", + "name" : "@Starter/PruneCruft", + "version" : "6.012" + }, + { + "class" : "Dist::Zilla::Plugin::ManifestSkip", + "name" : "@Starter/ManifestSkip", "version" : "6.012" }, { @@ -489,6 +437,11 @@ "name" : "@Starter/RunExtraTests", "version" : "0.029" }, + { + "class" : "Dist::Zilla::Plugin::TestRelease", + "name" : "@Starter/TestRelease", + "version" : "6.012" + }, { "class" : "Dist::Zilla::Plugin::ConfirmRelease", "name" : "@Starter/ConfirmRelease", @@ -499,6 +452,53 @@ "name" : "@Starter/UploadToCPAN", "version" : "6.012" }, + { + "class" : "Dist::Zilla::Plugin::MetaConfig", + "name" : "@Starter/MetaConfig", + "version" : "6.012" + }, + { + "class" : "Dist::Zilla::Plugin::MetaNoIndex", + "name" : "@Starter/MetaNoIndex", + "version" : "6.012" + }, + { + "class" : "Dist::Zilla::Plugin::MetaProvides::Package", + "config" : { + "Dist::Zilla::Plugin::MetaProvides::Package" : { + "finder_objects" : [ + { + "class" : "Dist::Zilla::Plugin::FinderCode", + "name" : "@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM", + "version" : "6.012" + } + ], + "include_underscores" : 0 + }, + "Dist::Zilla::Role::MetaProvider::Provider" : { + "$Dist::Zilla::Role::MetaProvider::Provider::VERSION" : "2.002004", + "inherit_missing" : 1, + "inherit_version" : 1, + "meta_noindex" : 1 + }, + "Dist::Zilla::Role::ModuleMetadata" : { + "Module::Metadata" : "1.000036", + "version" : "0.006" + } + }, + "name" : "@Starter/MetaProvides::Package", + "version" : "2.004003" + }, + { + "class" : "Dist::Zilla::Plugin::ShareDir", + "name" : "@Starter/ShareDir", + "version" : "6.012" + }, + { + "class" : "Dist::Zilla::Plugin::ExecDir", + "name" : "@Starter/ExecDir", + "version" : "6.012" + }, { "class" : "Dist::Zilla::Plugin::Prereqs", "config" : { @@ -549,14 +549,14 @@ { "class" : "Dist::Zilla::Plugin::GithubMeta", "name" : "GithubMeta", - "version" : "0.54" + "version" : "0.58" }, { "class" : "Dist::Zilla::Plugin::Git::Commit", "config" : { "Dist::Zilla::Plugin::Git::Commit" : { "add_files_in" : [], - "commit_msg" : "v%v%n%n%c" + "commit_msg" : "v%V%n%n%c" }, "Dist::Zilla::Role::Git::DirtyFiles" : { "allow_dirty" : [ @@ -567,7 +567,7 @@ "changelog" : "Changes" }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." }, "Dist::Zilla::Role::Git::StringFormatter" : { @@ -575,7 +575,7 @@ } }, "name" : "Git::Commit", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::Git::Push", @@ -587,12 +587,12 @@ "remotes_must_exist" : 1 }, "Dist::Zilla::Role::Git::Repo" : { - "git_version" : "2.17.0", + "git_version" : "2.21.0", "repo_root" : "." } }, "name" : "Git::Push", - "version" : "2.043" + "version" : "2.046" }, { "class" : "Dist::Zilla::Plugin::FinderCode", @@ -658,7 +658,7 @@ "version" : "6.012" } }, - "x_generated_by_perl" : "v5.26.0", - "x_serialization_backend" : "Cpanel::JSON::XS version 3.0233" + "x_generated_by_perl" : "v5.30.0", + "x_serialization_backend" : "Cpanel::JSON::XS version 4.11" } diff --git a/META.yml b/META.yml index 010d0f0..3c15e14 100644 --- a/META.yml +++ b/META.yml @@ -28,7 +28,7 @@ no_index: provides: bareword::filehandles: file: lib/bareword/filehandles.pm - version: '0.006' + version: '0.007' requires: B::Hooks::OP::Check: '0' XSLoader: '0' @@ -39,10 +39,10 @@ requires: resources: homepage: https://github.com/ilmari/bareword-filehandles repository: https://github.com/ilmari/bareword-filehandles.git -version: '0.006' +version: '0.007' x_Dist_Zilla: perl: - version: '5.026000' + version: '5.030000' plugins: - class: Dist::Zilla::Plugin::Git::Check @@ -54,27 +54,27 @@ x_Dist_Zilla: allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . name: '@Git/Check' - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] - commit_msg: v%v%n%n%c + commit_msg: v%V%n%n%c Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: [] allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git/Commit' - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::Tag config: @@ -82,16 +82,16 @@ x_Dist_Zilla: branch: ~ changelog: Changes signed: 0 - tag: v0.006 - tag_format: v%v - tag_message: v%v + tag: v0.007 + tag_format: v%V + tag_message: v%V Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: '@Git/Tag' - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::Push config: @@ -100,10 +100,10 @@ x_Dist_Zilla: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . name: '@Git/Push' - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::NextVersion config: @@ -112,21 +112,21 @@ x_Dist_Zilla: version_by_branch: 0 version_regexp: (?^:^v(.+)$) Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . name: Git::NextVersion - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::Contributors config: Dist::Zilla::Plugin::Git::Contributors: - git_version: 2.17.0 + git_version: 2.21.0 include_authors: 0 include_releaser: 1 order_by: name paths: [] name: Git::Contributors - version: '0.034' + version: '0.035' - class: Dist::Zilla::Plugin::Git::GatherDir config: @@ -142,7 +142,7 @@ x_Dist_Zilla: Dist::Zilla::Plugin::Git::GatherDir: include_untracked: 0 name: Git::GatherDir - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::PodWeaver config: @@ -225,54 +225,18 @@ x_Dist_Zilla: class: Dist::Zilla::Plugin::DynamicPrereqs config: Dist::Zilla::Role::ModuleMetadata: - Module::Metadata: '1.000033' - version: '0.004' + Module::Metadata: '1.000036' + version: '0.006' name: DynamicPrereqs - version: '0.034' + version: '0.035' - class: Dist::Zilla::Plugin::DynamicPrereqs config: Dist::Zilla::Role::ModuleMetadata: - Module::Metadata: '1.000033' - version: '0.004' + Module::Metadata: '1.000036' + version: '0.006' name: LSRH - version: '0.034' - - - class: Dist::Zilla::Plugin::PruneCruft - name: '@Starter/PruneCruft' - version: '6.012' - - - class: Dist::Zilla::Plugin::ManifestSkip - name: '@Starter/ManifestSkip' - version: '6.012' - - - class: Dist::Zilla::Plugin::MetaConfig - name: '@Starter/MetaConfig' - version: '6.012' - - - class: Dist::Zilla::Plugin::MetaProvides::Package - config: - Dist::Zilla::Plugin::MetaProvides::Package: - finder_objects: - - - class: Dist::Zilla::Plugin::FinderCode - name: '@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM' - version: '6.012' - include_underscores: 0 - Dist::Zilla::Role::MetaProvider::Provider: - $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' - inherit_missing: '1' - inherit_version: '1' - meta_noindex: '1' - Dist::Zilla::Role::ModuleMetadata: - Module::Metadata: '1.000033' - version: '0.004' - name: '@Starter/MetaProvides::Package' - version: '2.004003' - - - class: Dist::Zilla::Plugin::MetaNoIndex - name: '@Starter/MetaNoIndex' - version: '6.012' + version: '0.035' - class: Dist::Zilla::Plugin::MetaYAML name: '@Starter/MetaYAML' @@ -292,14 +256,6 @@ x_Dist_Zilla: version: '0.006' name: '@Starter/ReadmeAnyFromPod' version: '0.163250' - - - class: Dist::Zilla::Plugin::ExecDir - name: '@Starter/ExecDir' - version: '6.012' - - - class: Dist::Zilla::Plugin::ShareDir - name: '@Starter/ShareDir' - version: '6.012' - class: Dist::Zilla::Plugin::PodSyntaxTests name: '@Starter/PodSyntaxTests' @@ -338,8 +294,12 @@ x_Dist_Zilla: name: '@Starter/Manifest' version: '6.012' - - class: Dist::Zilla::Plugin::TestRelease - name: '@Starter/TestRelease' + class: Dist::Zilla::Plugin::PruneCruft + name: '@Starter/PruneCruft' + version: '6.012' + - + class: Dist::Zilla::Plugin::ManifestSkip + name: '@Starter/ManifestSkip' version: '6.012' - class: Dist::Zilla::Plugin::RunExtraTests @@ -348,6 +308,10 @@ x_Dist_Zilla: default_jobs: 1 name: '@Starter/RunExtraTests' version: '0.029' + - + class: Dist::Zilla::Plugin::TestRelease + name: '@Starter/TestRelease' + version: '6.012' - class: Dist::Zilla::Plugin::ConfirmRelease name: '@Starter/ConfirmRelease' @@ -356,6 +320,42 @@ x_Dist_Zilla: class: Dist::Zilla::Plugin::UploadToCPAN name: '@Starter/UploadToCPAN' version: '6.012' + - + class: Dist::Zilla::Plugin::MetaConfig + name: '@Starter/MetaConfig' + version: '6.012' + - + class: Dist::Zilla::Plugin::MetaNoIndex + name: '@Starter/MetaNoIndex' + version: '6.012' + - + class: Dist::Zilla::Plugin::MetaProvides::Package + config: + Dist::Zilla::Plugin::MetaProvides::Package: + finder_objects: + - + class: Dist::Zilla::Plugin::FinderCode + name: '@Starter/MetaProvides::Package/AUTOVIV/:InstallModulesPM' + version: '6.012' + include_underscores: 0 + Dist::Zilla::Role::MetaProvider::Provider: + $Dist::Zilla::Role::MetaProvider::Provider::VERSION: '2.002004' + inherit_missing: '1' + inherit_version: '1' + meta_noindex: '1' + Dist::Zilla::Role::ModuleMetadata: + Module::Metadata: '1.000036' + version: '0.006' + name: '@Starter/MetaProvides::Package' + version: '2.004003' + - + class: Dist::Zilla::Plugin::ShareDir + name: '@Starter/ShareDir' + version: '6.012' + - + class: Dist::Zilla::Plugin::ExecDir + name: '@Starter/ExecDir' + version: '6.012' - class: Dist::Zilla::Plugin::Prereqs config: @@ -395,13 +395,13 @@ x_Dist_Zilla: - class: Dist::Zilla::Plugin::GithubMeta name: GithubMeta - version: '0.54' + version: '0.58' - class: Dist::Zilla::Plugin::Git::Commit config: Dist::Zilla::Plugin::Git::Commit: add_files_in: [] - commit_msg: v%v%n%n%c + commit_msg: v%V%n%n%c Dist::Zilla::Role::Git::DirtyFiles: allow_dirty: - Changes @@ -409,12 +409,12 @@ x_Dist_Zilla: allow_dirty_match: [] changelog: Changes Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . Dist::Zilla::Role::Git::StringFormatter: time_zone: local name: Git::Commit - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::Git::Push config: @@ -423,10 +423,10 @@ x_Dist_Zilla: - origin remotes_must_exist: 1 Dist::Zilla::Role::Git::Repo: - git_version: 2.17.0 + git_version: 2.21.0 repo_root: . name: Git::Push - version: '2.043' + version: '2.046' - class: Dist::Zilla::Plugin::FinderCode name: ':InstallModules' @@ -476,5 +476,5 @@ x_Dist_Zilla: config: is_trial: '0' version: '6.012' -x_generated_by_perl: v5.26.0 -x_serialization_backend: 'YAML::Tiny version 1.70' +x_generated_by_perl: v5.30.0 +x_serialization_backend: 'YAML::Tiny version 1.73' diff --git a/Makefile.PL b/Makefile.PL index 9444c37..5e0c1c1 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -33,7 +33,7 @@ my %WriteMakefileArgs = ( "File::Spec" => 0, "Test::More" => "0.88" }, - "VERSION" => "0.006", + "VERSION" => "0.007", "test" => { "TESTS" => "t/*.t" } @@ -51,7 +51,7 @@ my %FallbackPrereqs = ( "warnings" => 0 ); -# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.034 +# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.035 use ExtUtils::Depends; %WriteMakefileArgs = ( %WriteMakefileArgs, @@ -61,7 +61,7 @@ use ExtUtils::Depends; )->get_makefile_vars, ); -# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.034 +# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.035 if ("$]" < 5.012) { requires('Lexical::SealRequireHints', 0.005) } @@ -79,7 +79,7 @@ delete $WriteMakefileArgs{CONFIGURE_REQUIRES} WriteMakefile(%WriteMakefileArgs); -# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.034 +# inserted by Dist::Zilla::Plugin::DynamicPrereqs 0.035 sub _add_prereq { my ($mm_key, $module, $version_or_range) = @_; $version_or_range ||= 0; diff --git a/README b/README index 0a188a7..1a03343 100644 --- a/README +++ b/README @@ -4,7 +4,7 @@ NAME VERSION - version 0.006 + version 0.007 SYNOPSIS @@ -34,6 +34,12 @@ METHODS Enables bareword filehandles for the remainder of the scope being compiled. +LIMITATIONS + + Filetest operators (-X) can not be checked on Perl versions before + 5.32, because hooking the op check function for these breaks stacked + tests, e.g. -f -w -x $file. + SEE ALSO perlfunc, B::Hooks::OP::Check. diff --git a/filehandles.xs b/filehandles.xs index f262e89..b24b929 100644 --- a/filehandles.xs +++ b/filehandles.xs @@ -146,6 +146,7 @@ BOOT: bareword_check(stat, OP_STAT); bareword_check(stat, OP_LSTAT); +#if PERL_VERSION_GE(5,31,1) bareword_check(stat, OP_FTRREAD); bareword_check(stat, OP_FTRWRITE); bareword_check(stat, OP_FTREXEC); @@ -173,3 +174,4 @@ BOOT: bareword_check(stat, OP_FTTTY); bareword_check(stat, OP_FTTEXT); bareword_check(stat, OP_FTBINARY); +#endif diff --git a/lib/bareword/filehandles.pm b/lib/bareword/filehandles.pm index bbc6b26..4aba388 100644 --- a/lib/bareword/filehandles.pm +++ b/lib/bareword/filehandles.pm @@ -1,6 +1,6 @@ package bareword::filehandles; # ABSTRACT: disables bareword filehandles -$bareword::filehandles::VERSION = '0.006'; +$bareword::filehandles::VERSION = '0.007'; { use 5.008001; } use strict; use warnings; @@ -39,7 +39,7 @@ bareword::filehandles - disables bareword filehandles =head1 VERSION -version 0.006 +version 0.007 =head1 SYNOPSIS @@ -69,6 +69,12 @@ compiled. Enables bareword filehandles for the remainder of the scope being compiled. +=head1 LIMITATIONS + +L (C<-X>) can not be checked on Perl +versions before 5.32, because hooking the op check function for these +breaks stacked tests, e.g. C<-f -w -x $file>. + =head1 SEE ALSO L, diff --git a/ppport.h b/ppport.h index 082befd..57d6df2 100644 --- a/ppport.h +++ b/ppport.h @@ -4,9 +4,9 @@ /* ---------------------------------------------------------------------- - ppport.h -- Perl/Pollution/Portability Version 3.42 + ppport.h -- Perl/Pollution/Portability Version 3.52 - Automatically created by Devel::PPPort running under perl 5.026000. + Automatically created by Devel::PPPort running under perl 5.030000. Do NOT edit this file directly! -- Edit PPPort_pm.PL and the includes in parts/inc/ instead. @@ -21,7 +21,7 @@ SKIP =head1 NAME -ppport.h - Perl/Pollution/Portability version 3.42 +ppport.h - Perl/Pollution/Portability version 3.52 =head1 SYNOPSIS @@ -56,7 +56,7 @@ ppport.h - Perl/Pollution/Portability version 3.42 =head1 COMPATIBILITY This version of F is designed to support operation with Perl -installations back to 5.003, and has been tested up to 5.20. +installations back to 5.003, and has been tested up to 5.30. =head1 OPTIONS @@ -239,6 +239,7 @@ same function or variable in your project. my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL + my_strnlen() NEED_my_strnlen NEED_my_strnlen_GLOBAL newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL @@ -255,6 +256,7 @@ same function or variable in your project. sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL + utf8_to_uvchr_buf() NEED_utf8_to_uvchr_buf NEED_utf8_to_uvchr_buf_GLOBAL vload_module() NEED_vload_module NEED_vload_module_GLOBAL vmess() NEED_vmess NEED_vmess_GLOBAL vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL @@ -389,7 +391,7 @@ use strict; # Disable broken TRIE-optimization BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if "$]" >= 5.009004 && "$]" <= 5.009005 } -my $VERSION = 3.42; +my $VERSION = 3.52; my %opt = ( quiet => 0, @@ -458,6 +460,7 @@ my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ : die "invalid spec: $_" } qw( AvFILLp|5.004050||p AvFILL||| +BOM_UTF8||| BhkDISABLE||5.024000| BhkENABLE||5.024000| BhkENTRY_set||5.024000| @@ -546,6 +549,7 @@ IVSIZE|5.006000||p IVTYPE|5.006000||p IVdf|5.006000||p LEAVE||| +LIKELY|||p LINKLIST||5.013006| LVRET||| MARK||| @@ -749,6 +753,7 @@ PL_sv_arenaroot|5.004050||p PL_sv_no|5.004050||pn PL_sv_undef|5.004050||pn PL_sv_yes|5.004050||pn +PL_sv_zero|||n PL_tainted|5.004050||p PL_tainting|5.004050||p PL_tokenbuf|5.024000||p @@ -825,11 +830,22 @@ PerlIO_stdout||5.007003| PerlIO_tell||5.007003| PerlIO_unread||5.007003| PerlIO_write||5.007003| +PerlLIO_dup2_cloexec||| +PerlLIO_dup_cloexec||| +PerlLIO_open3_cloexec||| +PerlLIO_open_cloexec||| +PerlProc_pipe_cloexec||| +PerlSock_accept_cloexec||| +PerlSock_socket_cloexec||| +PerlSock_socketpair_cloexec||| +Perl_langinfo|||n +Perl_setlocale|||n PoisonFree|5.009004||p PoisonNew|5.009004||p PoisonWith|5.009004||p Poison|5.008000||p READ_XDIGIT||5.017006| +REPLACEMENT_CHARACTER_UTF8||| RESTORE_LC_NUMERIC||5.024000| RETVAL|||n Renewc||| @@ -931,6 +947,7 @@ SvPOK_only||| SvPOK_on||| SvPOKp||| SvPOK||| +SvPVCLEAR||| SvPVX_const|5.009003||p SvPVX_mutable|5.009003||p SvPVX||| @@ -968,6 +985,9 @@ SvPVutf8x||5.006000| SvPVutf8||5.006000| SvPVx||| SvPV||| +SvREADONLY_off||| +SvREADONLY_on||| +SvREADONLY||| SvREFCNT_dec_NN||5.017007| SvREFCNT_dec||| SvREFCNT_inc_NN|5.009004||p @@ -1019,8 +1039,16 @@ SvVOK||5.008001| SvVSTRING_mg|5.009004||p THIS|||n UNDERBAR|5.009002||p +UNICODE_REPLACEMENT|||p +UNLIKELY|||p UTF8SKIP||5.006000| +UTF8_IS_INVARIANT||| +UTF8_IS_NONCHAR||| +UTF8_IS_SUPER||| +UTF8_IS_SURROGATE||| UTF8_MAXBYTES|5.009002||p +UTF8_SAFE_SKIP|||p +UVCHR_IS_INVARIANT||| UVCHR_SKIP||5.022000| UVSIZE|5.006000||p UVTYPE|5.006000||p @@ -1118,19 +1146,25 @@ XopENTRY||5.024000| XopFLAGS||5.013007| ZeroD|5.009002||p Zero||| +__ASSERT_|||p _aMY_CXT|5.007003||p -_core_swash_init||| -_load_PL_utf8_foldclosures||| +_inverse_folds||| +_is_grapheme||| +_is_in_locale_category||| +_new_invlist_C_array||| _pMY_CXT|5.007003||p -_to_fold_latin1||| +_to_fold_latin1|||n _to_upper_title_latin1||| _to_utf8_case||| +_variant_byte_number|||n +_warn_problematic_locale|||n aMY_CXT_|5.007003||p aMY_CXT|5.007003||p aTHXR_|5.024000||p aTHXR|5.024000||p aTHX_|5.006000||p aTHX|5.006000||p +abort_execution||| add_above_Latin1_folds||| add_data|||n add_multi_match||| @@ -1139,7 +1173,6 @@ adjust_size_and_find_bucket|||n advance_one_LB||| advance_one_SB||| advance_one_WB||| -alloc_maybe_populate_EXACT||| allocmy||| amagic_call||| amagic_cmp_locale||| @@ -1154,6 +1187,7 @@ ao||| apply_attrs_my||| apply_attrs||| apply||| +argvout_final||| assert_uft8_cache_coherent||| assignment_type||| atfork_lock||5.007003|n @@ -1169,16 +1203,18 @@ av_fill||| av_iter_p||5.011000| av_len||| av_make||| +av_nonelem||| av_pop||| av_push||| av_reify||| av_shift||| av_store||| -av_tindex||5.017009| -av_top_index||5.017009| +av_tindex|5.017009|5.017009|p +av_top_index|5.017009|5.017009|p av_undef||| av_unshift||| ax|||n +backup_one_GCB||| backup_one_LB||| backup_one_SB||| backup_one_WB||| @@ -1208,9 +1244,19 @@ cast_i32||5.006000|n cast_iv||5.006000|n cast_ulong||5.006000|n cast_uv||5.006000|n +category_name|||n +change_engine_size||| +check_and_deprecate||| check_type_and_open||| check_uni||| checkcomma||| +ckWARN2_d||| +ckWARN2||| +ckWARN3_d||| +ckWARN3||| +ckWARN4_d||| +ckWARN4||| +ckWARN_d||| ckWARN|5.006000||p ck_entersub_args_core||| ck_entersub_args_list||5.013006| @@ -1254,6 +1300,7 @@ cophh_store_sv||5.013007| core_prototype||| coresub_op||| cr_textfilter||| +croak_caller|||vn croak_memory_wrap|5.019003||pn croak_no_mem|||n croak_no_modify|5.013003||pn @@ -1276,6 +1323,7 @@ cv_const_sv_or_av|||n cv_const_sv||5.003070|n cv_dump||| cv_forget_slab||| +cv_get_call_checker_flags||| cv_get_call_checker||5.013006| cv_name||5.021005| cv_set_call_checker_flags||5.021004| @@ -1322,8 +1370,8 @@ debug_start_match||| deb||5.007003|v defelem_target||| del_sv||| +delimcpy_no_escape|||n delimcpy||5.004000|n -deprecate_commaless_var_list||| despatch_signals||5.007001| destroy_matcher||| die_nocontext|||vn @@ -1343,7 +1391,6 @@ do_delete_local||| do_dump_pad||| do_eof||| do_exec3||| -do_execfree||| do_exec||| do_gv_dump||5.006000| do_gvgv_dump||5.006000| @@ -1384,6 +1431,7 @@ do_vecget||| do_vecset||| do_vop||| docatch||| +does_utf8_overflow|||n doeval_compile||| dofile||| dofindlabel||| @@ -1417,6 +1465,7 @@ dump_indent||5.006000|v dump_mstats||| dump_packsubs_perl||| dump_packsubs||5.006000| +dump_regex_sets_structures||| dump_sub_perl||| dump_sub||5.006000| dump_sv_child||| @@ -1426,7 +1475,9 @@ dump_trie||| dump_vindent||5.006000| dumpuntil||| dup_attrlist||| +dup_warnings||| edit_distance|||n +emulate_setlocale|||n eval_pv|5.006000||p eval_sv|5.006000||p exec_failed||| @@ -1448,12 +1499,16 @@ find_default_stash||| find_hash_subscript||| find_in_my_stash||| find_lexical_cv||| +find_next_masked|||n find_runcv_where||| find_runcv||5.008001| find_rundefsv||5.013002| find_script||| +find_span_end_mask|||n +find_span_end|||n first_symbol|||n fixup_errno_string||| +foldEQ_latin1_s2_folded|||n foldEQ_latin1||5.013008|n foldEQ_locale||5.013002|n foldEQ_utf8||5.013002| @@ -1477,7 +1532,9 @@ free_global_struct||| free_tied_hv_pool||| free_tmps||| gen_constant_list||| +get_ANYOFM_contents||| get_ANYOF_cp_list_for_ssc||| +get_and_check_backslash_N_name_wrapper||| get_and_check_backslash_N_name||| get_aux_mg||| get_av|5.006000||p @@ -1573,6 +1630,7 @@ gv_stashsv||| handle_named_backref||| handle_possible_posix||| handle_regex_sets||| +handle_user_defined_property||| he_dup||| hek_dup||| hfree_next_entry||| @@ -1615,6 +1673,7 @@ hv_notallowed||| hv_placeholders_get||5.009003| hv_placeholders_p||| hv_placeholders_set||5.009003| +hv_pushkv||| hv_rand_set||5.018000| hv_riter_p||5.009003| hv_riter_set||5.009003| @@ -1640,11 +1699,13 @@ init_global_struct||| init_ids||| init_interp||| init_main_stash||| +init_named_cv||| init_perllib||| init_postdump_symbols||| init_predump_symbols||| init_stacks||5.005000| init_tm||5.007002| +init_uniprops||| inplace_aassign||| instr|||n intro_my||5.004000| @@ -1653,44 +1714,89 @@ intuit_more||| invert||| invoke_exception_hook||| io_close||| +isALNUMC_A|||p isALNUMC|5.006000||p -isALPHANUMERIC||5.017008| -isALPHA||| +isALNUM_A|||p +isALNUM|||p +isALPHANUMERIC_A|||p +isALPHANUMERIC|5.017008|5.017008|p +isALPHA_A|||p +isALPHA|||p +isASCII_A|||p isASCII|5.006000||p +isBLANK_A|||p isBLANK|5.006001||p +isC9_STRICT_UTF8_CHAR|||n +isCNTRL_A|||p isCNTRL|5.006000||p -isDIGIT||| -isFOO_lc||| +isDIGIT_A|||p +isDIGIT|||p +isFF_OVERLONG|||n isFOO_utf8_lc||| -isGCB|||n +isGCB||| +isGRAPH_A|||p isGRAPH|5.006000||p -isIDCONT||5.017008| -isIDFIRST||| +isIDCONT_A|||p +isIDCONT|5.017008|5.017008|p +isIDFIRST_A|||p +isIDFIRST|||p isLB||| -isLOWER||| -isOCTAL||5.013005| +isLOWER_A|||p +isLOWER|||p +isOCTAL_A|||p +isOCTAL|5.013005|5.013005|p +isPRINT_A|||p isPRINT|5.004000||p +isPSXSPC_A|||p isPSXSPC|5.006001||p +isPUNCT_A|||p isPUNCT|5.006000||p isSB||| -isSPACE||| -isUPPER||| -isUTF8_CHAR||5.021001| +isSCRIPT_RUN||| +isSPACE_A|||p +isSPACE|||p +isSTRICT_UTF8_CHAR|||n +isUPPER_A|||p +isUPPER|||p +isUTF8_CHAR_flags||| +isUTF8_CHAR||5.021001|n isWB||| -isWORDCHAR||5.013006| +isWORDCHAR_A|||p +isWORDCHAR|5.013006|5.013006|p +isXDIGIT_A|||p isXDIGIT|5.006000||p is_an_int||| -is_ascii_string||5.011000| +is_ascii_string||5.011000|n +is_c9strict_utf8_string_loclen|||n +is_c9strict_utf8_string_loc|||n +is_c9strict_utf8_string|||n is_handle_constructor|||n is_invariant_string||5.021007|n is_lvalue_sub||5.007001| is_safe_syscall||5.019004| is_ssc_worth_it|||n +is_strict_utf8_string_loclen|||n +is_strict_utf8_string_loc|||n +is_strict_utf8_string|||n is_utf8_char_buf||5.015008|n +is_utf8_common_with_len||| is_utf8_common||| +is_utf8_cp_above_31_bits|||n +is_utf8_fixed_width_buf_flags|||n +is_utf8_fixed_width_buf_loc_flags|||n +is_utf8_fixed_width_buf_loclen_flags|||n +is_utf8_invariant_string_loc|||n +is_utf8_invariant_string|||n +is_utf8_non_invariant_string|||n +is_utf8_overlong_given_start_byte_ok|||n +is_utf8_string_flags|||n +is_utf8_string_loc_flags|||n +is_utf8_string_loclen_flags|||n is_utf8_string_loclen||5.009003|n is_utf8_string_loc||5.008001|n is_utf8_string||5.006001|n +is_utf8_valid_partial_char_flags|||n +is_utf8_valid_partial_char|||n isa_lookup||| isinfnansv||| isinfnan||5.021004|n @@ -1766,6 +1872,7 @@ magic_setisa||| magic_setlvref||| magic_setmglob||| magic_setnkeys||| +magic_setnonelem||| magic_setpack||| magic_setpos||| magic_setregexp||| @@ -1809,6 +1916,7 @@ mg_find_mglob||| mg_findext|5.013008||pn mg_find|||n mg_free_type||5.013006| +mg_freeext||| mg_free||| mg_get||| mg_localize||| @@ -1839,14 +1947,13 @@ mro_register||5.010001| mro_set_mro||5.010001| mro_set_private_data||5.010001| mul128||| -mulexp10|||n +multiconcat_stringify||| multideref_stringify||| my_atof2||5.007002| +my_atof3||| my_atof||5.006000| my_attrs||| -my_bcopy||5.004050|n my_bytes_to_utf8|||n -my_bzero|||n my_chsize||| my_clearenv||| my_cxt_index||| @@ -1860,8 +1967,11 @@ my_fork||5.007003|n my_kid||| my_lstat_flags||| my_lstat||5.024000| -my_memcmp|||n -my_memset|||n +my_memrchr|||n +my_mkostemp|||n +my_mkstemp_cloexec|||n +my_mkstemp|||n +my_nl_langinfo|||n my_pclose||5.003070| my_popen_list||5.007001| my_popen||5.003070| @@ -1871,9 +1981,12 @@ my_socketpair||5.007003|n my_sprintf|5.009003||pvn my_stat_flags||| my_stat||5.024000| +my_strerror||| my_strftime||5.007002| my_strlcat|5.009004||pn my_strlcpy|5.009004||pn +my_strnlen|||pn +my_strtod|||n my_unexec||| my_vsnprintf||5.009004|n need_utf8|||n @@ -1946,6 +2059,8 @@ newSVpvs_share|5.009003||p newSVpvs|5.009003||p newSVpv||| newSVrv||| +newSVsv_flags||| +newSVsv_nomg||| newSVsv||| newSVuv|5.006000||p newSV||| @@ -1957,9 +2072,14 @@ newXS_deffile||| newXS_len_flags||| newXSproto||5.006000| newXS||5.006000| +new_collate||| new_constant||| +new_ctype||| new_he||| new_logop||| +new_msg_hv||| +new_numeric||| +new_regcurly|||n new_stackinfo||5.005000| new_version||5.009000| next_symbol||| @@ -1973,12 +2093,14 @@ noperl_die|||vn not_a_number||| not_incrementable||| nothreadhook||5.008000| +notify_parser_that_changed_to_utf8||| nuke_stacks||| num_overflow|||n oopsAV||| oopsHV||| op_append_elem||5.013006| op_append_list||5.013006| +op_class||| op_clear||| op_contextualize||5.013006| op_convert_list||5.021006| @@ -2002,7 +2124,9 @@ opmethod_stash||| opslab_force_free||| opslab_free_nopad||| opslab_free||| -output_or_return_posix_warnings||| +optimize_optree||| +optimize_op||| +output_posix_warnings||| pMY_CXT_|5.007003||p pMY_CXT|5.007003||p pTHX_|5.006000||p @@ -2047,8 +2171,8 @@ parse_body||| parse_gv_stash_name||| parse_ident||| parse_lparen_question_flags||| -parse_subsignature||| parse_unicode_opts||| +parse_uniprop_string||| parser_dup||| parser_free_nexttoke_ops||| parser_free||| @@ -2077,6 +2201,8 @@ pregexec||| pregfree2||5.011000| pregfree||| prescan_version||5.011004| +print_bytes_for_locale||| +print_collxfrm_input_and_return||| printbuf||| printf_nocontext|||vn process_special_blocks||| @@ -2098,7 +2224,6 @@ pv_escape|5.009004||p pv_pretty|5.009004||p pv_uni_display||5.007003| qerror||| -qsortsvu||| quadmath_format_needed|||n quadmath_format_single|||n re_compile||5.009005| @@ -2146,7 +2271,6 @@ reg_numbered_buff_fetch||| reg_numbered_buff_length||| reg_numbered_buff_store||| reg_qr_package||| -reg_recode||| reg_scan_name||| reg_skipcomment|||n reg_temp_copy||| @@ -2154,6 +2278,7 @@ reganode||| regatom||| regbranch||| regclass||| +regcp_restore||| regcppop||| regcppush||| regcurly|||n @@ -2188,6 +2313,7 @@ report_wrongway_fh||| require_pv||5.006000| require_tie_mod||| restore_magic||| +restore_switched_locale||| rninstr|||n rpeep||| rsignal_restore||| @@ -2259,6 +2385,7 @@ save_shared_pvref||5.007003| save_sptr||| save_strlen||| save_svref||| +save_to_buffer|||n save_vptr||5.006000| savepvn||| savepvs||5.009003| @@ -2288,23 +2415,28 @@ scan_inputsymbol||| scan_num||5.007001| scan_oct||| scan_pat||| -scan_str||| scan_subst||| scan_trans||| scan_version||5.009001| scan_vstring||5.009005| -scan_word||| search_const||| seed||5.008001| sequence_num||| set_ANYOF_arg||| set_caret_X||| set_context||5.006000|n -set_numeric_local||5.006000| set_numeric_radix||5.006000| set_numeric_standard||5.006000| +set_numeric_underlying||| set_padlist|||n +set_regex_pv||| setdefout||| +setfd_cloexec_for_nonsysfd||| +setfd_cloexec_or_inhexec_by_sysfdness||| +setfd_cloexec|||n +setfd_inhexec_for_sysfd||| +setfd_inhexec|||n +setlocale_debug_string|||n share_hek_flags||| share_hek||5.004000| should_warn_nl|||n @@ -2312,7 +2444,6 @@ si_dup||| sighandler|||n simplify_sort||| skip_to_be_ignored_text||| -skipspace_flags||| softref2xv||| sortcv_stacked||| sortcv_xsub||| @@ -2490,12 +2621,15 @@ sv_replace||| sv_report_used||| sv_resetpvn||| sv_reset||| +sv_rvunweaken||| sv_rvweaken||5.006000| +sv_set_undef||| sv_sethek||| sv_setiv_mg|5.004050||p sv_setiv||| sv_setnv_mg|5.006000||p sv_setnv||| +sv_setpv_bufsize||| sv_setpv_mg|5.004050||p sv_setpvf_mg_nocontext|||pvn sv_setpvf_mg|5.006000|5.004000|pv @@ -2520,6 +2654,7 @@ sv_setsv_nomg|5.007002||p sv_setsv||| sv_setuv_mg|5.004050||p sv_setuv|5.004000||p +sv_string_from_errnum||| sv_tainted||5.004000| sv_taint||5.004000| sv_true||5.005000| @@ -2534,6 +2669,8 @@ sv_upgrade||| sv_usepvn_flags||5.009004| sv_usepvn_mg|5.004050||p sv_usepvn||| +sv_utf8_decode||| +sv_utf8_downgrade||| sv_utf8_encode||5.006000| sv_utf8_upgrade_flags_grow||5.011000| sv_utf8_upgrade_flags||5.007002| @@ -2550,7 +2687,9 @@ sv_vsetpvf|5.006000|5.004000|p svtype||| swallow_bom||| swatch_get||| -sync_locale||5.021004| +switch_category_locale_to_template||| +switch_to_global_locale|||n +sync_locale||5.021004|n sys_init3||5.010000|n sys_init||5.010000|n sys_intern_clear||| @@ -2561,35 +2700,39 @@ taint_env||| taint_proper||| tied_method|||v tmps_grow_p||| +toFOLD_utf8_safe||| toFOLD_utf8||5.019001| toFOLD_uvchr||5.023009| toFOLD||5.019001| toLOWER_L1||5.019001| toLOWER_LC||5.004000| +toLOWER_utf8_safe||| toLOWER_utf8||5.015007| toLOWER_uvchr||5.023009| toLOWER||| +toTITLE_utf8_safe||| toTITLE_utf8||5.015007| toTITLE_uvchr||5.023009| toTITLE||5.019001| +toUPPER_utf8_safe||| toUPPER_utf8||5.015007| toUPPER_uvchr||5.023009| toUPPER||| to_byte_substr||| to_lower_latin1|||n -to_utf8_fold||5.015007| -to_utf8_lower||5.015007| to_utf8_substr||| -to_utf8_title||5.015007| -to_utf8_upper||5.015007| tokenize_use||| tokeq||| tokereport||| too_few_arguments_pv||| too_many_arguments_pv||| translate_substr_offsets|||n +traverse_op_tree||| try_amagic_bin||| try_amagic_un||| +turkic_fc||| +turkic_lc||| +turkic_uc||| uiv_2buf|||n unlnk||| unpack_rec||| @@ -2607,12 +2750,17 @@ utf16_textfilter||| utf16_to_utf8_reversed||5.006001| utf16_to_utf8||5.006001| utf8_distance||5.006000| +utf8_hop_back|||n +utf8_hop_forward|||n +utf8_hop_safe|||n utf8_hop||5.006000|n utf8_length||5.007001| utf8_mg_len_cache_update||| utf8_mg_pos_cache_update||| -utf8_to_uvchr_buf||5.015009| -utf8n_to_uvchr||5.007001| +utf8_to_uvchr_buf|5.015009|5.015009|p +utf8_to_uvchr|||p +utf8n_to_uvchr_error|||n +utf8n_to_uvchr||5.007001|n utf8n_to_uvuni||5.007001| utilize||| uvchr_to_utf8_flags||5.007003| @@ -2620,7 +2768,9 @@ uvchr_to_utf8||5.007001| uvoffuni_to_utf8_flags||5.019004| uvuni_to_utf8_flags||5.007003| uvuni_to_utf8||5.007001| +valid_utf8_to_uvchr|||n validate_suid||| +variant_under_utf8_count|||n varname||| vcmp||5.009000| vcroak||5.006000| @@ -2640,6 +2790,7 @@ vwarner||5.006000| vwarn||5.006000| wait4pid||| warn_nocontext|||pvn +warn_on_first_deprecated_use||| warn_sv|5.013001||p warner_nocontext|||vn warner|5.006000|5.004000|pv @@ -2651,6 +2802,7 @@ whichsig_pv||5.015004| whichsig_sv||5.015004| whichsig||| win32_croak_not_implemented|||n +win32_setlocale||| with_queued_errors||| wrap_op_checker||5.015008| write_to_stderr||| @@ -2662,6 +2814,7 @@ yyerror_pv||| yyerror||| yylex||| yyparse||| +yyquit||| yyunlex||| yywarn||| ); @@ -3827,748 +3980,1510 @@ __DATA__ #ifndef UVSIZE # define UVSIZE IVSIZE #endif -#ifndef sv_setuv -# define sv_setuv(sv, uv) \ - STMT_START { \ - UV TeMpUv = uv; \ - if (TeMpUv <= IV_MAX) \ - sv_setiv(sv, TeMpUv); \ - else \ - sv_setnv(sv, (double)TeMpUv); \ - } STMT_END +#ifndef cBOOL +# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0) +#endif + +#ifndef OpHAS_SIBLING +# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) +#endif + +#ifndef OpSIBLING +# define OpSIBLING(o) (0 + (o)->op_sibling) +#endif + +#ifndef OpMORESIB_set +# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib)) +#endif + +#ifndef OpLASTSIB_set +# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL) +#endif + +#ifndef OpMAYBESIB_set +# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib)) +#endif + +#ifndef HEf_SVKEY +# define HEf_SVKEY -2 +#endif + +#if defined(DEBUGGING) && !defined(__COVERITY__) +#ifndef __ASSERT_ +# define __ASSERT_(statement) assert(statement), +#endif + +#else +#ifndef __ASSERT_ +# define __ASSERT_(statement) +#endif + +#endif + +#ifndef SvRX +#if defined(NEED_SvRX) +static void * DPPP_(my_SvRX)(pTHX_ SV *rv); +static +#else +extern void * DPPP_(my_SvRX)(pTHX_ SV *rv); +#endif + +#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL) + +#ifdef SvRX +# undef SvRX +#endif +#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a) + + +void * +DPPP_(my_SvRX)(pTHX_ SV *rv) +{ + if (SvROK(rv)) { + SV *sv = SvRV(rv); + if (SvMAGICAL(sv)) { + MAGIC *mg = mg_find(sv, PERL_MAGIC_qr); + if (mg && mg->mg_obj) { + return mg->mg_obj; + } + } + } + return 0; +} +#endif +#endif +#ifndef SvRXOK +# define SvRXOK(sv) (!!SvRX(sv)) +#endif + +#ifndef PERL_UNUSED_DECL +# ifdef HASATTRIBUTE +# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) +# define PERL_UNUSED_DECL +# else +# define PERL_UNUSED_DECL __attribute__((unused)) +# endif +# else +# define PERL_UNUSED_DECL +# endif +#endif + +#ifndef PERL_UNUSED_ARG +# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ +# include +# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) +# else +# define PERL_UNUSED_ARG(x) ((void)x) +# endif +#endif + +#ifndef PERL_UNUSED_VAR +# define PERL_UNUSED_VAR(x) ((void)x) +#endif + +#ifndef PERL_UNUSED_CONTEXT +# ifdef USE_ITHREADS +# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) +# else +# define PERL_UNUSED_CONTEXT +# endif +#endif + +#ifndef PERL_UNUSED_RESULT +# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) +# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END +# else +# define PERL_UNUSED_RESULT(v) ((void)(v)) +# endif +#endif +#ifndef NOOP +# define NOOP /*EMPTY*/(void)0 +#endif + +#ifndef dNOOP +# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL +#endif + +#ifndef NVTYPE +# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +# define NVTYPE long double +# else +# define NVTYPE double +# endif +typedef NVTYPE NV; +#endif + +#ifndef INT2PTR +# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) +# define PTRV UV +# define INT2PTR(any,d) (any)(d) +# else +# if PTRSIZE == LONGSIZE +# define PTRV unsigned long +# else +# define PTRV unsigned +# endif +# define INT2PTR(any,d) (any)(PTRV)(d) +# endif +#endif + +#ifndef PTR2ul +# if PTRSIZE == LONGSIZE +# define PTR2ul(p) (unsigned long)(p) +# else +# define PTR2ul(p) INT2PTR(unsigned long,p) +# endif +#endif +#ifndef PTR2nat +# define PTR2nat(p) (PTRV)(p) +#endif + +#ifndef NUM2PTR +# define NUM2PTR(any,d) (any)PTR2nat(d) +#endif + +#ifndef PTR2IV +# define PTR2IV(p) INT2PTR(IV,p) +#endif + +#ifndef PTR2UV +# define PTR2UV(p) INT2PTR(UV,p) +#endif + +#ifndef PTR2NV +# define PTR2NV(p) NUM2PTR(NV,p) +#endif + +#undef START_EXTERN_C +#undef END_EXTERN_C +#undef EXTERN_C +#ifdef __cplusplus +# define START_EXTERN_C extern "C" { +# define END_EXTERN_C } +# define EXTERN_C extern "C" +#else +# define START_EXTERN_C +# define END_EXTERN_C +# define EXTERN_C extern +#endif + +#if defined(PERL_GCC_PEDANTIC) +# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN +# define PERL_GCC_BRACE_GROUPS_FORBIDDEN +# endif +#endif + +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) +# ifndef PERL_USE_GCC_BRACE_GROUPS +# define PERL_USE_GCC_BRACE_GROUPS +# endif +#endif + +#undef STMT_START +#undef STMT_END +#ifdef PERL_USE_GCC_BRACE_GROUPS +# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ +# define STMT_END ) +#else +# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) +# define STMT_START if (1) +# define STMT_END else (void)0 +# else +# define STMT_START do +# define STMT_END while (0) +# endif +#endif +#ifndef boolSV +# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#endif + +/* DEFSV appears first in 5.004_56 */ +#ifndef DEFSV +# define DEFSV GvSV(PL_defgv) +#endif + +#ifndef SAVE_DEFSV +# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) +#endif + +#ifndef DEFSV_set +# define DEFSV_set(sv) (DEFSV = (sv)) +#endif + +/* Older perls (<=5.003) lack AvFILLp */ +#ifndef AvFILLp +# define AvFILLp AvFILL +#endif +#ifndef av_tindex +# define av_tindex AvFILL +#endif + +#ifndef av_top_index +# define av_top_index AvFILL +#endif +#ifndef ERRSV +# define ERRSV get_sv("@",FALSE) +#endif + +/* Hint: gv_stashpvn + * This function's backport doesn't support the length parameter, but + * rather ignores it. Portability can only be ensured if the length + * parameter is used for speed reasons, but the length can always be + * correctly computed from the string argument. + */ +#ifndef gv_stashpvn +# define gv_stashpvn(str,len,create) gv_stashpv(str,create) +#endif + +/* Replace: 1 */ +#ifndef get_cv +# define get_cv perl_get_cv +#endif + +#ifndef get_sv +# define get_sv perl_get_sv +#endif + +#ifndef get_av +# define get_av perl_get_av #endif -#ifndef newSVuv -# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) + +#ifndef get_hv +# define get_hv perl_get_hv #endif -#ifndef sv_2uv -# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) + +/* Replace: 0 */ +#ifndef dUNDERBAR +# define dUNDERBAR dNOOP #endif -#ifndef SvUVX -# define SvUVX(sv) ((UV)SvIVX(sv)) +#ifndef UNDERBAR +# define UNDERBAR DEFSV +#endif +#ifndef dAX +# define dAX I32 ax = MARK - PL_stack_base + 1 #endif -#ifndef SvUVXx -# define SvUVXx(sv) SvUVX(sv) +#ifndef dITEMS +# define dITEMS I32 items = SP - MARK +#endif +#ifndef dXSTARG +# define dXSTARG SV * targ = sv_newmortal() +#endif +#ifndef dAXMARK +# define dAXMARK I32 ax = POPMARK; \ + register SV ** const mark = PL_stack_base + ax++ +#endif +#ifndef XSprePUSH +# define XSprePUSH (sp = PL_stack_base + ax - 1) #endif -#ifndef SvUV -# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) +#if (PERL_BCDVERSION < 0x5005000) +# undef XSRETURN +# define XSRETURN(off) \ + STMT_START { \ + PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ + return; \ + } STMT_END +#endif +#ifndef XSPROTO +# define XSPROTO(name) void name(pTHX_ CV* cv) #endif -#ifndef SvUVx -# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) +#ifndef SVfARG +# define SVfARG(p) ((void*)(p)) +#endif +#ifndef PERL_ABS +# define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) +#endif +#ifndef dVAR +# define dVAR dNOOP +#endif +#ifndef SVf +# define SVf "_" +#endif +#ifndef UTF8_MAXBYTES +# define UTF8_MAXBYTES UTF8_MAXLEN +#endif +#ifndef CPERLscope +# define CPERLscope(x) x +#endif +#ifndef PERL_HASH +# define PERL_HASH(hash,str,len) \ + STMT_START { \ + const char *s_PeRlHaSh = str; \ + I32 i_PeRlHaSh = len; \ + U32 hash_PeRlHaSh = 0; \ + while (i_PeRlHaSh--) \ + hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ + (hash) = hash_PeRlHaSh; \ + } STMT_END #endif -/* Hint: sv_uv - * Always use the SvUVx() macro instead of sv_uv(). +#ifndef PERLIO_FUNCS_DECL +# 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 +#endif + +/* provide these typedefs for older perls */ +#if (PERL_BCDVERSION < 0x5009003) + +# ifdef ARGSproto +typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); +# else +typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); +# endif + +typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); + +#endif + +#ifndef WIDEST_UTYPE +# ifdef QUADKIND +# ifdef U64TYPE +# define WIDEST_UTYPE U64TYPE +# else +# define WIDEST_UTYPE Quad_t +# endif +# else +# define WIDEST_UTYPE U32 +# endif +#endif + +#ifdef EBCDIC + +/* This is the first version where these macros are fully correct. Relying on + * the C library functions, as earlier releases did, causes problems with + * locales */ +# if (PERL_BCDVERSION < 0x5022000) +# undef isALNUM +# undef isALNUM_A +# undef isALNUMC +# undef isALNUMC_A +# undef isALPHA +# undef isALPHA_A +# undef isALPHANUMERIC +# undef isALPHANUMERIC_A +# undef isASCII +# undef isASCII_A +# undef isBLANK +# undef isBLANK_A +# undef isCNTRL +# undef isCNTRL_A +# undef isDIGIT +# undef isDIGIT_A +# undef isGRAPH +# undef isGRAPH_A +# undef isIDCONT +# undef isIDCONT_A +# undef isIDFIRST +# undef isIDFIRST_A +# undef isLOWER +# undef isLOWER_A +# undef isOCTAL +# undef isOCTAL_A +# undef isPRINT +# undef isPRINT_A +# undef isPSXSPC +# undef isPSXSPC_A +# undef isPUNCT +# undef isPUNCT_A +# undef isSPACE +# undef isSPACE_A +# undef isUPPER +# undef isUPPER_A +# undef isWORDCHAR +# undef isWORDCHAR_A +# undef isXDIGIT +# undef isXDIGIT_A +# endif +#ifndef isASCII +# define isASCII(c) (isCNTRL(c) || isPRINT(c)) +#endif + + /* The below is accurate for all EBCDIC code pages supported by + * all the versions of Perl overridden by this */ +#ifndef isCNTRL +# define isCNTRL(c) ( (c) == '\0' || (c) == '\a' || (c) == '\b' \ + || (c) == '\f' || (c) == '\n' || (c) == '\r' \ + || (c) == '\t' || (c) == '\v' \ + || ((c) <= 3 && (c) >= 1) /* SOH, STX, ETX */ \ + || (c) == 7 /* U+7F DEL */ \ + || ((c) <= 0x13 && (c) >= 0x0E) /* SO, SI */ \ + /* DLE, DC[1-3] */ \ + || (c) == 0x18 /* U+18 CAN */ \ + || (c) == 0x19 /* U+19 EOM */ \ + || ((c) <= 0x1F && (c) >= 0x1C) /* [FGRU]S */ \ + || (c) == 0x26 /* U+17 ETB */ \ + || (c) == 0x27 /* U+1B ESC */ \ + || (c) == 0x2D /* U+05 ENQ */ \ + || (c) == 0x2E /* U+06 ACK */ \ + || (c) == 0x32 /* U+16 SYN */ \ + || (c) == 0x37 /* U+04 EOT */ \ + || (c) == 0x3C /* U+14 DC4 */ \ + || (c) == 0x3D /* U+15 NAK */ \ + || (c) == 0x3F /* U+1A SUB */ \ + ) +#endif + +/* The ordering of the tests in this and isUPPER are to exclude most characters + * early */ +#ifndef isLOWER +# define isLOWER(c) ( (c) >= 'a' && (c) <= 'z' \ + && ( (c) <= 'i' \ + || ((c) >= 'j' && (c) <= 'r') \ + || (c) >= 's')) +#endif + +#ifndef isUPPER +# define isUPPER(c) ( (c) >= 'A' && (c) <= 'Z' \ + && ( (c) <= 'I' \ + || ((c) >= 'J' && (c) <= 'R') \ + || (c) >= 'S')) +#endif + +#else /* Above is EBCDIC; below is ASCII */ + +# if (PERL_BCDVERSION < 0x5004000) +/* The implementation of these in older perl versions can give wrong results if + * the C program locale is set to other than the C locale */ +# undef isALNUM +# undef isALNUM_A +# undef isALPHA +# undef isALPHA_A +# undef isDIGIT +# undef isDIGIT_A +# undef isIDFIRST +# undef isIDFIRST_A +# undef isLOWER +# undef isLOWER_A +# undef isUPPER +# undef isUPPER_A +# endif + +# if (PERL_BCDVERSION < 0x5008000) +/* Hint: isCNTRL + * Earlier perls omitted DEL */ +# undef isCNTRL +# endif + +# if (PERL_BCDVERSION < 0x5010000) +/* Hint: isPRINT + * The implementation in older perl versions includes all of the + * isSPACE() characters, which is wrong. The version provided by + * Devel::PPPort always overrides a present buggy version. */ -#ifndef sv_uv -# define sv_uv(sv) SvUVx(sv) +# undef isPRINT +# undef isPRINT_A +# endif + +# if (PERL_BCDVERSION < 0x5014000) +/* Hint: isASCII + * The implementation in older perl versions always returned true if the + * parameter was a signed char + */ +# undef isASCII +# undef isASCII_A +# endif + +# if (PERL_BCDVERSION < 0x5020000) +/* Hint: isSPACE + * The implementation in older perl versions didn't include \v */ +# undef isSPACE +# undef isSPACE_A +# endif +#ifndef isASCII +# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127) #endif -#if !defined(SvUOK) && defined(SvIOK_UV) -# define SvUOK(sv) SvIOK_UV(sv) +#ifndef isCNTRL +# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) +#endif + +#ifndef isLOWER +# define isLOWER(c) ((c) >= 'a' && (c) <= 'z') +#endif + +#ifndef isUPPER +# define isUPPER(c) ((c) <= 'Z' && (c) >= 'A') +#endif + +#endif /* Below are definitions common to EBCDIC and ASCII */ +#ifndef isALNUM +# define isALNUM(c) isWORDCHAR(c) +#endif + +#ifndef isALNUMC +# define isALNUMC(c) isALPHANUMERIC(c) +#endif + +#ifndef isALPHA +# define isALPHA(c) (isUPPER(c) || isLOWER(c)) +#endif + +#ifndef isALPHANUMERIC +# define isALPHANUMERIC(c) (isALPHA(c) || isDIGIT(c)) +#endif + +#ifndef isBLANK +# define isBLANK(c) ((c) == ' ' || (c) == '\t') +#endif + +#ifndef isDIGIT +# define isDIGIT(c) ((c) <= '9' && (c) >= '0') +#endif + +#ifndef isGRAPH +# define isGRAPH(c) (isWORDCHAR(c) || isPUNCT(c)) +#endif + +#ifndef isIDCONT +# define isIDCONT(c) isWORDCHAR(c) +#endif + +#ifndef isIDFIRST +# define isIDFIRST(c) (isALPHA(c) || (c) == '_') +#endif + +#ifndef isOCTAL +# define isOCTAL(c) (((WIDEST_UTYPE)((c)) & ~7) == '0') +#endif + +#ifndef isPRINT +# define isPRINT(c) (isGRAPH(c) || (c) == ' ') +#endif + +#ifndef isPSXSPC +# define isPSXSPC(c) isSPACE(c) +#endif + +#ifndef isPUNCT +# define isPUNCT(c) ( (c) == '-' || (c) == '!' || (c) == '"' \ + || (c) == '#' || (c) == '$' || (c) == '%' \ + || (c) == '&' || (c) == '\'' || (c) == '(' \ + || (c) == ')' || (c) == '*' || (c) == '+' \ + || (c) == ',' || (c) == '.' || (c) == '/' \ + || (c) == ':' || (c) == ';' || (c) == '<' \ + || (c) == '=' || (c) == '>' || (c) == '?' \ + || (c) == '@' || (c) == '[' || (c) == '\\' \ + || (c) == ']' || (c) == '^' || (c) == '_' \ + || (c) == '`' || (c) == '{' || (c) == '|' \ + || (c) == '}' || (c) == '~') +#endif + +#ifndef isSPACE +# define isSPACE(c) ( isBLANK(c) || (c) == '\n' || (c) == '\r' \ + || (c) == '\v' || (c) == '\f') +#endif + +#ifndef isWORDCHAR +# define isWORDCHAR(c) (isALPHANUMERIC(c) || (c) == '_') +#endif + +#ifndef isXDIGIT +# define isXDIGIT(c) ( isDIGIT(c) \ + || ((c) >= 'a' && (c) <= 'f') \ + || ((c) >= 'A' && (c) <= 'F')) +#endif +#ifndef isALNUM_A +# define isALNUM_A isALNUM +#endif + +#ifndef isALNUMC_A +# define isALNUMC_A isALNUMC +#endif + +#ifndef isALPHA_A +# define isALPHA_A isALPHA +#endif + +#ifndef isALPHANUMERIC_A +# define isALPHANUMERIC_A isALPHANUMERIC +#endif + +#ifndef isASCII_A +# define isASCII_A isASCII +#endif + +#ifndef isBLANK_A +# define isBLANK_A isBLANK +#endif + +#ifndef isCNTRL_A +# define isCNTRL_A isCNTRL +#endif + +#ifndef isDIGIT_A +# define isDIGIT_A isDIGIT +#endif + +#ifndef isGRAPH_A +# define isGRAPH_A isGRAPH +#endif + +#ifndef isIDCONT_A +# define isIDCONT_A isIDCONT +#endif + +#ifndef isIDFIRST_A +# define isIDFIRST_A isIDFIRST +#endif + +#ifndef isLOWER_A +# define isLOWER_A isLOWER +#endif + +#ifndef isOCTAL_A +# define isOCTAL_A isOCTAL +#endif + +#ifndef isPRINT_A +# define isPRINT_A isPRINT +#endif + +#ifndef isPSXSPC_A +# define isPSXSPC_A isPSXSPC +#endif + +#ifndef isPUNCT_A +# define isPUNCT_A isPUNCT +#endif + +#ifndef isSPACE_A +# define isSPACE_A isSPACE +#endif + +#ifndef isUPPER_A +# define isUPPER_A isUPPER +#endif + +#ifndef isWORDCHAR_A +# define isWORDCHAR_A isWORDCHAR +#endif + +#ifndef isXDIGIT_A +# define isXDIGIT_A isXDIGIT +#endif + +/* Until we figure out how to support this in older perls... */ +#if (PERL_BCDVERSION >= 0x5008000) +#ifndef HeUTF8 +# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ + SvUTF8(HeKEY_sv(he)) : \ + (U32)HeKUTF8(he)) +#endif + +#endif +#ifndef C_ARRAY_LENGTH +# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) +#endif + +#ifndef C_ARRAY_END +# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) +#endif +#ifndef LIKELY +# define LIKELY(x) (x) +#endif + +#ifndef UNLIKELY +# define UNLIKELY(x) (x) +#endif +#ifndef UNICODE_REPLACEMENT +# define UNICODE_REPLACEMENT 0xFFFD +#endif + +#ifndef MUTABLE_PTR +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +# define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) +#else +# define MUTABLE_PTR(p) ((void *) (p)) #endif -#ifndef XST_mUV -# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) #endif - -#ifndef XSRETURN_UV -# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END +#ifndef MUTABLE_SV +# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) #endif -#ifndef PUSHu -# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END +#ifndef WARN_ALL +# define WARN_ALL 0 #endif -#ifndef XPUSHu -# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END +#ifndef WARN_CLOSURE +# define WARN_CLOSURE 1 #endif -#ifdef HAS_MEMCMP -#ifndef memNE -# define memNE(s1,s2,l) (memcmp(s1,s2,l)) +#ifndef WARN_DEPRECATED +# define WARN_DEPRECATED 2 #endif -#ifndef memEQ -# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) +#ifndef WARN_EXITING +# define WARN_EXITING 3 #endif -#else -#ifndef memNE -# define memNE(s1,s2,l) (bcmp(s1,s2,l)) +#ifndef WARN_GLOB +# define WARN_GLOB 4 #endif -#ifndef memEQ -# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) +#ifndef WARN_IO +# define WARN_IO 5 #endif -#endif -#ifndef memEQs -# define memEQs(s1, l, s2) \ - (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) +#ifndef WARN_CLOSED +# define WARN_CLOSED 6 #endif -#ifndef memNEs -# define memNEs(s1, l, s2) !memEQs(s1, l, s2) +#ifndef WARN_EXEC +# define WARN_EXEC 7 #endif -#ifndef MoveD -# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) + +#ifndef WARN_LAYER +# define WARN_LAYER 8 #endif -#ifndef CopyD -# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) +#ifndef WARN_NEWLINE +# define WARN_NEWLINE 9 #endif -#ifdef HAS_MEMSET -#ifndef ZeroD -# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) +#ifndef WARN_PIPE +# define WARN_PIPE 10 #endif -#else -#ifndef ZeroD -# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) +#ifndef WARN_UNOPENED +# define WARN_UNOPENED 11 #endif +#ifndef WARN_MISC +# define WARN_MISC 12 #endif -#ifndef PoisonWith -# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) + +#ifndef WARN_NUMERIC +# define WARN_NUMERIC 13 #endif -#ifndef PoisonNew -# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) +#ifndef WARN_ONCE +# define WARN_ONCE 14 #endif -#ifndef PoisonFree -# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) +#ifndef WARN_OVERFLOW +# define WARN_OVERFLOW 15 #endif -#ifndef Poison -# define Poison(d,n,t) PoisonFree(d,n,t) +#ifndef WARN_PACK +# define WARN_PACK 16 #endif -#ifndef Newx -# define Newx(v,n,t) New(0,v,n,t) + +#ifndef WARN_PORTABLE +# define WARN_PORTABLE 17 #endif -#ifndef Newxc -# define Newxc(v,n,t,c) Newc(0,v,n,t,c) +#ifndef WARN_RECURSION +# define WARN_RECURSION 18 #endif -#ifndef Newxz -# define Newxz(v,n,t) Newz(0,v,n,t) +#ifndef WARN_REDEFINE +# define WARN_REDEFINE 19 #endif -#ifndef PERL_MAGIC_sv -# define PERL_MAGIC_sv '\0' + +#ifndef WARN_REGEXP +# define WARN_REGEXP 20 #endif -#ifndef PERL_MAGIC_overload -# define PERL_MAGIC_overload 'A' +#ifndef WARN_SEVERE +# define WARN_SEVERE 21 #endif -#ifndef PERL_MAGIC_overload_elem -# define PERL_MAGIC_overload_elem 'a' +#ifndef WARN_DEBUGGING +# define WARN_DEBUGGING 22 #endif -#ifndef PERL_MAGIC_overload_table -# define PERL_MAGIC_overload_table 'c' +#ifndef WARN_INPLACE +# define WARN_INPLACE 23 #endif -#ifndef PERL_MAGIC_bm -# define PERL_MAGIC_bm 'B' +#ifndef WARN_INTERNAL +# define WARN_INTERNAL 24 #endif -#ifndef PERL_MAGIC_regdata -# define PERL_MAGIC_regdata 'D' +#ifndef WARN_MALLOC +# define WARN_MALLOC 25 #endif -#ifndef PERL_MAGIC_regdatum -# define PERL_MAGIC_regdatum 'd' +#ifndef WARN_SIGNAL +# define WARN_SIGNAL 26 #endif -#ifndef PERL_MAGIC_env -# define PERL_MAGIC_env 'E' +#ifndef WARN_SUBSTR +# define WARN_SUBSTR 27 #endif -#ifndef PERL_MAGIC_envelem -# define PERL_MAGIC_envelem 'e' +#ifndef WARN_SYNTAX +# define WARN_SYNTAX 28 #endif -#ifndef PERL_MAGIC_fm -# define PERL_MAGIC_fm 'f' +#ifndef WARN_AMBIGUOUS +# define WARN_AMBIGUOUS 29 #endif -#ifndef PERL_MAGIC_regex_global -# define PERL_MAGIC_regex_global 'g' +#ifndef WARN_BAREWORD +# define WARN_BAREWORD 30 #endif -#ifndef PERL_MAGIC_isa -# define PERL_MAGIC_isa 'I' +#ifndef WARN_DIGIT +# define WARN_DIGIT 31 #endif -#ifndef PERL_MAGIC_isaelem -# define PERL_MAGIC_isaelem 'i' +#ifndef WARN_PARENTHESIS +# define WARN_PARENTHESIS 32 #endif -#ifndef PERL_MAGIC_nkeys -# define PERL_MAGIC_nkeys 'k' +#ifndef WARN_PRECEDENCE +# define WARN_PRECEDENCE 33 #endif -#ifndef PERL_MAGIC_dbfile -# define PERL_MAGIC_dbfile 'L' +#ifndef WARN_PRINTF +# define WARN_PRINTF 34 #endif -#ifndef PERL_MAGIC_dbline -# define PERL_MAGIC_dbline 'l' +#ifndef WARN_PROTOTYPE +# define WARN_PROTOTYPE 35 #endif -#ifndef PERL_MAGIC_mutex -# define PERL_MAGIC_mutex 'm' +#ifndef WARN_QW +# define WARN_QW 36 #endif -#ifndef PERL_MAGIC_shared -# define PERL_MAGIC_shared 'N' +#ifndef WARN_RESERVED +# define WARN_RESERVED 37 #endif -#ifndef PERL_MAGIC_shared_scalar -# define PERL_MAGIC_shared_scalar 'n' +#ifndef WARN_SEMICOLON +# define WARN_SEMICOLON 38 #endif -#ifndef PERL_MAGIC_collxfrm -# define PERL_MAGIC_collxfrm 'o' +#ifndef WARN_TAINT +# define WARN_TAINT 39 #endif -#ifndef PERL_MAGIC_tied -# define PERL_MAGIC_tied 'P' +#ifndef WARN_THREADS +# define WARN_THREADS 40 #endif -#ifndef PERL_MAGIC_tiedelem -# define PERL_MAGIC_tiedelem 'p' +#ifndef WARN_UNINITIALIZED +# define WARN_UNINITIALIZED 41 #endif -#ifndef PERL_MAGIC_tiedscalar -# define PERL_MAGIC_tiedscalar 'q' +#ifndef WARN_UNPACK +# define WARN_UNPACK 42 #endif -#ifndef PERL_MAGIC_qr -# define PERL_MAGIC_qr 'r' +#ifndef WARN_UNTIE +# define WARN_UNTIE 43 #endif -#ifndef PERL_MAGIC_sig -# define PERL_MAGIC_sig 'S' +#ifndef WARN_UTF8 +# define WARN_UTF8 44 #endif -#ifndef PERL_MAGIC_sigelem -# define PERL_MAGIC_sigelem 's' +#ifndef WARN_VOID +# define WARN_VOID 45 #endif -#ifndef PERL_MAGIC_taint -# define PERL_MAGIC_taint 't' +#ifndef WARN_ASSERTIONS +# define WARN_ASSERTIONS 46 +#endif +#ifndef packWARN +# define packWARN(a) (a) #endif -#ifndef PERL_MAGIC_uvar -# define PERL_MAGIC_uvar 'U' +#ifndef ckWARN +# ifdef G_WARN_ON +# define ckWARN(a) (PL_dowarn & G_WARN_ON) +# else +# define ckWARN(a) PL_dowarn +# endif #endif -#ifndef PERL_MAGIC_uvar_elem -# define PERL_MAGIC_uvar_elem 'u' +#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner) +#if defined(NEED_warner) +static void DPPP_(my_warner)(U32 err, const char *pat, ...); +static +#else +extern void DPPP_(my_warner)(U32 err, const char *pat, ...); #endif -#ifndef PERL_MAGIC_vstring -# define PERL_MAGIC_vstring 'V' +#if defined(NEED_warner) || defined(NEED_warner_GLOBAL) + +#define Perl_warner DPPP_(my_warner) + + +void +DPPP_(my_warner)(U32 err, const char *pat, ...) +{ + SV *sv; + va_list args; + + PERL_UNUSED_ARG(err); + + va_start(args, pat); + sv = vnewSVpvf(pat, &args); + va_end(args); + sv_2mortal(sv); + warn("%s", SvPV_nolen(sv)); +} + +#define warner Perl_warner + +#define Perl_warner_nocontext Perl_warner + +#endif #endif -#ifndef PERL_MAGIC_vec -# define PERL_MAGIC_vec 'v' +#define _ppport_MIN(a,b) (((a) <= (b)) ? (a) : (b)) +#ifndef sv_setuv +# define sv_setuv(sv, uv) \ + STMT_START { \ + UV TeMpUv = uv; \ + if (TeMpUv <= IV_MAX) \ + sv_setiv(sv, TeMpUv); \ + else \ + sv_setnv(sv, (double)TeMpUv); \ + } STMT_END #endif - -#ifndef PERL_MAGIC_utf8 -# define PERL_MAGIC_utf8 'w' +#ifndef newSVuv +# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) #endif - -#ifndef PERL_MAGIC_substr -# define PERL_MAGIC_substr 'x' +#ifndef sv_2uv +# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) #endif -#ifndef PERL_MAGIC_defelem -# define PERL_MAGIC_defelem 'y' +#ifndef SvUVX +# define SvUVX(sv) ((UV)SvIVX(sv)) #endif -#ifndef PERL_MAGIC_glob -# define PERL_MAGIC_glob '*' +#ifndef SvUVXx +# define SvUVXx(sv) SvUVX(sv) #endif -#ifndef PERL_MAGIC_arylen -# define PERL_MAGIC_arylen '#' +#ifndef SvUV +# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) #endif -#ifndef PERL_MAGIC_pos -# define PERL_MAGIC_pos '.' +#ifndef SvUVx +# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) #endif -#ifndef PERL_MAGIC_backref -# define PERL_MAGIC_backref '<' +/* Hint: sv_uv + * Always use the SvUVx() macro instead of sv_uv(). + */ +#ifndef sv_uv +# define sv_uv(sv) SvUVx(sv) #endif -#ifndef PERL_MAGIC_ext -# define PERL_MAGIC_ext '~' +#if !defined(SvUOK) && defined(SvIOK_UV) +# define SvUOK(sv) SvIOK_UV(sv) #endif -#ifndef cBOOL -# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0) +#ifndef XST_mUV +# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) #endif -#ifndef OpHAS_SIBLING -# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) +#ifndef XSRETURN_UV +# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END #endif - -#ifndef OpSIBLING -# define OpSIBLING(o) (0 + (o)->op_sibling) +#ifndef PUSHu +# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END #endif -#ifndef OpMORESIB_set -# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib)) +#ifndef XPUSHu +# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END #endif -#ifndef OpLASTSIB_set -# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL) -#endif +#if defined UTF8SKIP -#ifndef OpMAYBESIB_set -# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib)) +/* Don't use official version because it uses MIN, which may not be available */ +#undef UTF8_SAFE_SKIP +#ifndef UTF8_SAFE_SKIP +# define UTF8_SAFE_SKIP(s, e) ( \ + ((((e) - (s)) <= 0) \ + ? 0 \ + : _ppport_MIN(((e) - (s)), UTF8SKIP(s)))) #endif -#ifndef HEf_SVKEY -# define HEf_SVKEY -2 #endif -#ifndef SvRX -#if defined(NEED_SvRX) -static void * DPPP_(my_SvRX)(pTHX_ SV *rv); +#if !defined(my_strnlen) +#if defined(NEED_my_strnlen) +static STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen); static #else -extern void * DPPP_(my_SvRX)(pTHX_ SV *rv); +extern STRLEN DPPP_(my_my_strnlen)(const char *str, Size_t maxlen); #endif -#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL) +#if defined(NEED_my_strnlen) || defined(NEED_my_strnlen_GLOBAL) -#ifdef SvRX -# undef SvRX -#endif -#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a) +#define my_strnlen DPPP_(my_my_strnlen) +#define Perl_my_strnlen DPPP_(my_my_strnlen) -void * -DPPP_(my_SvRX)(pTHX_ SV *rv) +STRLEN +DPPP_(my_my_strnlen)(const char *str, Size_t maxlen) { - if (SvROK(rv)) { - SV *sv = SvRV(rv); - if (SvMAGICAL(sv)) { - MAGIC *mg = mg_find(sv, PERL_MAGIC_qr); - if (mg && mg->mg_obj) { - return mg->mg_obj; - } - } - } - return 0; + const char *p = str; + + while(maxlen-- && *p) + p++; + + return p - str; } + #endif #endif -#ifndef SvRXOK -# define SvRXOK(sv) (!!SvRX(sv)) + +#if (PERL_BCDVERSION < 0x5031002) + /* Versions prior to this accepted things that are now considered + * malformations, and didn't return -1 on error with warnings enabled + * */ +# undef utf8_to_uvchr_buf #endif -#ifndef PERL_UNUSED_DECL -# ifdef HASATTRIBUTE -# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) -# define PERL_UNUSED_DECL +/* This implementation brings modern, generally more restricted standards to + * utf8_to_uvchr_buf. Some of these are security related, and clearly must + * be done. But its arguable that the others need not, and hence should not. + * The reason they're here is that a module that intends to play with the + * latest perls shoud be able to work the same in all releases. An example is + * that perl no longer accepts any UV for a code point, but limits them to + * IV_MAX or below. This is for future internal use of the larger code points. + * If it turns out that some of these changes are breaking code that isn't + * intended to work with modern perls, the tighter restrictions could be + * relaxed. khw thinks this is unlikely, but has been wrong in the past. */ + +#ifndef utf8_to_uvchr_buf + /* Choose which underlying implementation to use. At least one must be + * present or the perl is too early to handle this function */ +# if defined(utf8n_to_uvchr) || defined(utf8_to_uv) +# if defined(utf8n_to_uvchr) /* This is the preferred implementation */ +# define _ppport_utf8_to_uvchr_buf_callee utf8n_to_uvchr # else -# define PERL_UNUSED_DECL __attribute__((unused)) +# define _ppport_utf8_to_uvchr_buf_callee utf8_to_uv # endif -# else -# define PERL_UNUSED_DECL -# endif -#endif -#ifndef PERL_UNUSED_ARG -# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */ -# include -# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x)) -# else -# define PERL_UNUSED_ARG(x) ((void)x) # endif -#endif -#ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)x) +#ifdef _ppport_utf8_to_uvchr_buf_callee +# if defined(NEED_utf8_to_uvchr_buf) +static UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen); +static +#else +extern UV DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 * s, const U8 * send, STRLEN * retlen); #endif -#ifndef PERL_UNUSED_CONTEXT -# ifdef USE_ITHREADS -# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) -# else -# define PERL_UNUSED_CONTEXT -# endif -#endif +#if defined(NEED_utf8_to_uvchr_buf) || defined(NEED_utf8_to_uvchr_buf_GLOBAL) -#ifndef PERL_UNUSED_RESULT -# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT) -# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END -# else -# define PERL_UNUSED_RESULT(v) ((void)(v)) -# endif -#endif -#ifndef NOOP -# define NOOP /*EMPTY*/(void)0 +#ifdef utf8_to_uvchr_buf +# undef utf8_to_uvchr_buf #endif +#define utf8_to_uvchr_buf(a,b,c) DPPP_(my_utf8_to_uvchr_buf)(aTHX_ a,b,c) +#define Perl_utf8_to_uvchr_buf DPPP_(my_utf8_to_uvchr_buf) -#ifndef dNOOP -# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL -#endif -#ifndef NVTYPE -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# define NVTYPE long double -# else -# define NVTYPE double -# endif -typedef NVTYPE NV; -#endif +UV +DPPP_(my_utf8_to_uvchr_buf)(pTHX_ const U8 *s, const U8 *send, STRLEN *retlen) +{ + UV ret; + STRLEN curlen; + bool overflows = 0; + const U8 *cur_s = s; + const bool do_warnings = ckWARN_d(WARN_UTF8); + + if (send > s) { + curlen = send - s; + } + else { + assert(0); /* Modern perls die under this circumstance */ + curlen = 0; + if (! do_warnings) { /* Handle empty here if no warnings needed */ + if (retlen) *retlen = 0; + return UNICODE_REPLACEMENT; + } + } -#ifndef INT2PTR -# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE) -# define PTRV UV -# define INT2PTR(any,d) (any)(d) -# else -# if PTRSIZE == LONGSIZE -# define PTRV unsigned long -# else -# define PTRV unsigned -# endif -# define INT2PTR(any,d) (any)(PTRV)(d) -# endif -#endif + /* The modern version allows anything that evaluates to a legal UV, but not + * overlongs nor an empty input */ + ret = _ppport_utf8_to_uvchr_buf_callee( + s, curlen, retlen, (UTF8_ALLOW_ANYUV + & ~(UTF8_ALLOW_LONG|UTF8_ALLOW_EMPTY))); -#ifndef PTR2ul -# if PTRSIZE == LONGSIZE -# define PTR2ul(p) (unsigned long)(p) -# else -# define PTR2ul(p) INT2PTR(unsigned long,p) -# endif -#endif -#ifndef PTR2nat -# define PTR2nat(p) (PTRV)(p) -#endif + /* But actually, modern versions restrict the UV to being no more than what + * an IV can hold */ + if (ret > PERL_INT_MAX) { + overflows = 1; + } -#ifndef NUM2PTR -# define NUM2PTR(any,d) (any)PTR2nat(d) -#endif +# if (PERL_BCDVERSION < 0x5026000) +# ifndef EBCDIC -#ifndef PTR2IV -# define PTR2IV(p) INT2PTR(IV,p) -#endif + /* There are bugs in versions earlier than this on non-EBCDIC platforms + * in which it did not detect all instances of overflow, which could be + * a security hole. Also, earlier versions did not allow the overflow + * malformation under any circumstances, and modern ones do. So we + * need to check here. */ -#ifndef PTR2UV -# define PTR2UV(p) INT2PTR(UV,p) + else if (curlen > 0 && *s >= 0xFE) { + + /* If the main routine detected overflow, great; it returned 0. But if the + * input's first byte indicates it could overflow, we need to verify. + * First, on a 32-bit machine the first byte being at least \xFE + * automatically is overflow */ + if (sizeof(ret) < 8) { + overflows = 1; + } + else { + const U8 highest[] = /* 2*63-1 */ + "\xFF\x80\x87\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF\xBF"; + const U8 *cur_h = highest; + + for (cur_s = s; cur_s < send; cur_s++, cur_h++) { + if (UNLIKELY(*cur_s == *cur_h)) { + continue; + } + + /* If this byte is larger than the corresponding highest UTF-8 + * byte, the sequence overflows; otherwise the byte is less than + * (as we handled the equality case above), and so the sequence + * doesn't overflow */ + overflows = *cur_s > *cur_h; + break; + + } + + /* Here, either we set the bool and broke out of the loop, or got + * to the end and all bytes are the same which indicates it doesn't + * overflow. */ + } + } + +# endif +# endif /* < 5.26 */ + + if (UNLIKELY(overflows)) { + if (! do_warnings) { + if (retlen) { + *retlen = _ppport_MIN(*retlen, UTF8SKIP(s)); + *retlen = _ppport_MIN(*retlen, curlen); + } + return UNICODE_REPLACEMENT; + } + else { + + /* On versions that correctly detect overflow, but forbid it + * always, 0 will be returned, but also a warning will have been + * raised. Don't repeat it */ + if (ret != 0) { + /* We use the error message in use from 5.8-5.14 */ + Perl_warner(aTHX_ packWARN(WARN_UTF8), + "Malformed UTF-8 character (overflow at 0x%" UVxf + ", byte 0x%02x, after start byte 0x%02x)", + ret, *cur_s, *s); + } + if (retlen) { + *retlen = (STRLEN) -1; + } + return 0; + } + } + + /* If failed and warnings are off, to emulate the behavior of the real + * utf8_to_uvchr(), try again, allowing anything. (Note a return of 0 is + * ok if the input was '\0') */ + if (UNLIKELY(ret == 0 && (curlen == 0 || *s != '\0'))) { + + /* If curlen is 0, we already handled the case where warnings are + * disabled, so this 'if' will be true, and we won't look at the + * contents of 's' */ + if (do_warnings) { + *retlen = (STRLEN) -1; + } + else { + ret = _ppport_utf8_to_uvchr_buf_callee( + s, curlen, retlen, UTF8_ALLOW_ANY); + /* Override with the REPLACEMENT character, as that is what the + * modern version of this function returns */ + ret = UNICODE_REPLACEMENT; + +# if (PERL_BCDVERSION < 0x5016000) + + /* Versions earlier than this don't necessarily return the proper + * length. It should not extend past the end of string, nor past + * what the first byte indicates the length is, nor past the + * continuation characters */ + if (retlen && *retlen >= 0) { + *retlen = _ppport_MIN(*retlen, curlen); + *retlen = _ppport_MIN(*retlen, UTF8SKIP(s)); + unsigned int i = 1; + do { + if (s[i] < 0x80 || s[i] > 0xBF) { + *retlen = i; + break; + } + } while (++i < *retlen); + } + +# endif + + } + } + + return ret; +} + +# endif +#endif #endif -#ifndef PTR2NV -# define PTR2NV(p) NUM2PTR(NV,p) +#if defined(UTF8SKIP) && defined(utf8_to_uvchr_buf) +#undef utf8_to_uvchr /* Always redefine this unsafe function so that it refuses + to read past a NUL, making it much less likely to read + off the end of the buffer. A NUL indicates the start + of the next character anyway. If the input isn't + NUL-terminated, the function remains unsafe, as it + always has been. */ +#ifndef utf8_to_uvchr +# define utf8_to_uvchr(s, lp) \ + ((*(s) == '\0') \ + ? utf8_to_uvchr_buf(s,((s)+1), lp) /* Handle single NUL specially */ \ + : utf8_to_uvchr_buf(s, (s) + my_strnlen((char *) (s), UTF8SKIP(s)), (lp))) #endif -#undef START_EXTERN_C -#undef END_EXTERN_C -#undef EXTERN_C -#ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } -# define EXTERN_C extern "C" -#else -# define START_EXTERN_C -# define END_EXTERN_C -# define EXTERN_C extern #endif -#if defined(PERL_GCC_PEDANTIC) -# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN -# define PERL_GCC_BRACE_GROUPS_FORBIDDEN -# endif +#ifdef HAS_MEMCMP +#ifndef memNE +# define memNE(s1,s2,l) (memcmp(s1,s2,l)) #endif -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus) -# ifndef PERL_USE_GCC_BRACE_GROUPS -# define PERL_USE_GCC_BRACE_GROUPS -# endif +#ifndef memEQ +# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) #endif -#undef STMT_START -#undef STMT_END -#ifdef PERL_USE_GCC_BRACE_GROUPS -# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ -# define STMT_END ) #else -# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) -# define STMT_START if (1) -# define STMT_END else (void)0 -# else -# define STMT_START do -# define STMT_END while (0) -# endif -#endif -#ifndef boolSV -# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) +#ifndef memNE +# define memNE(s1,s2,l) (bcmp(s1,s2,l)) #endif -/* DEFSV appears first in 5.004_56 */ -#ifndef DEFSV -# define DEFSV GvSV(PL_defgv) +#ifndef memEQ +# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) #endif -#ifndef SAVE_DEFSV -# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) #endif - -#ifndef DEFSV_set -# define DEFSV_set(sv) (DEFSV = (sv)) +#ifndef memEQs +# define memEQs(s1, l, s2) \ + (sizeof(s2)-1 == l && memEQ(s1, (s2 ""), (sizeof(s2)-1))) #endif -/* Older perls (<=5.003) lack AvFILLp */ -#ifndef AvFILLp -# define AvFILLp AvFILL +#ifndef memNEs +# define memNEs(s1, l, s2) !memEQs(s1, l, s2) #endif -#ifndef ERRSV -# define ERRSV get_sv("@",FALSE) +#ifndef MoveD +# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) #endif -/* Hint: gv_stashpvn - * This function's backport doesn't support the length parameter, but - * rather ignores it. Portability can only be ensured if the length - * parameter is used for speed reasons, but the length can always be - * correctly computed from the string argument. - */ -#ifndef gv_stashpvn -# define gv_stashpvn(str,len,create) gv_stashpv(str,create) +#ifndef CopyD +# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) #endif -/* Replace: 1 */ -#ifndef get_cv -# define get_cv perl_get_cv +#ifdef HAS_MEMSET +#ifndef ZeroD +# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) #endif -#ifndef get_sv -# define get_sv perl_get_sv +#else +#ifndef ZeroD +# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) #endif -#ifndef get_av -# define get_av perl_get_av +#endif +#ifndef PoisonWith +# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) #endif -#ifndef get_hv -# define get_hv perl_get_hv +#ifndef PoisonNew +# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) #endif -/* Replace: 0 */ -#ifndef dUNDERBAR -# define dUNDERBAR dNOOP +#ifndef PoisonFree +# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) #endif -#ifndef UNDERBAR -# define UNDERBAR DEFSV +#ifndef Poison +# define Poison(d,n,t) PoisonFree(d,n,t) #endif -#ifndef dAX -# define dAX I32 ax = MARK - PL_stack_base + 1 +#ifndef Newx +# define Newx(v,n,t) New(0,v,n,t) #endif -#ifndef dITEMS -# define dITEMS I32 items = SP - MARK -#endif -#ifndef dXSTARG -# define dXSTARG SV * targ = sv_newmortal() +#ifndef Newxc +# define Newxc(v,n,t,c) Newc(0,v,n,t,c) #endif -#ifndef dAXMARK -# define dAXMARK I32 ax = POPMARK; \ - register SV ** const mark = PL_stack_base + ax++ + +#ifndef Newxz +# define Newxz(v,n,t) Newz(0,v,n,t) #endif -#ifndef XSprePUSH -# define XSprePUSH (sp = PL_stack_base + ax - 1) +#ifndef PERL_MAGIC_sv +# define PERL_MAGIC_sv '\0' #endif -#if (PERL_BCDVERSION < 0x5005000) -# undef XSRETURN -# define XSRETURN(off) \ - STMT_START { \ - PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ - return; \ - } STMT_END +#ifndef PERL_MAGIC_overload +# define PERL_MAGIC_overload 'A' #endif -#ifndef XSPROTO -# define XSPROTO(name) void name(pTHX_ CV* cv) + +#ifndef PERL_MAGIC_overload_elem +# define PERL_MAGIC_overload_elem 'a' #endif -#ifndef SVfARG -# define SVfARG(p) ((void*)(p)) +#ifndef PERL_MAGIC_overload_table +# define PERL_MAGIC_overload_table 'c' #endif -#ifndef PERL_ABS -# define PERL_ABS(x) ((x) < 0 ? -(x) : (x)) + +#ifndef PERL_MAGIC_bm +# define PERL_MAGIC_bm 'B' #endif -#ifndef dVAR -# define dVAR dNOOP + +#ifndef PERL_MAGIC_regdata +# define PERL_MAGIC_regdata 'D' #endif -#ifndef SVf -# define SVf "_" + +#ifndef PERL_MAGIC_regdatum +# define PERL_MAGIC_regdatum 'd' #endif -#ifndef UTF8_MAXBYTES -# define UTF8_MAXBYTES UTF8_MAXLEN + +#ifndef PERL_MAGIC_env +# define PERL_MAGIC_env 'E' #endif -#ifndef CPERLscope -# define CPERLscope(x) x + +#ifndef PERL_MAGIC_envelem +# define PERL_MAGIC_envelem 'e' #endif -#ifndef PERL_HASH -# define PERL_HASH(hash,str,len) \ - STMT_START { \ - const char *s_PeRlHaSh = str; \ - I32 i_PeRlHaSh = len; \ - U32 hash_PeRlHaSh = 0; \ - while (i_PeRlHaSh--) \ - hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \ - (hash) = hash_PeRlHaSh; \ - } STMT_END + +#ifndef PERL_MAGIC_fm +# define PERL_MAGIC_fm 'f' #endif -#ifndef PERLIO_FUNCS_DECL -# 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 +#ifndef PERL_MAGIC_regex_global +# define PERL_MAGIC_regex_global 'g' #endif -/* provide these typedefs for older perls */ -#if (PERL_BCDVERSION < 0x5009003) +#ifndef PERL_MAGIC_isa +# define PERL_MAGIC_isa 'I' +#endif -# ifdef ARGSproto -typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto); -# else -typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX); -# endif +#ifndef PERL_MAGIC_isaelem +# define PERL_MAGIC_isaelem 'i' +#endif -typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); +#ifndef PERL_MAGIC_nkeys +# define PERL_MAGIC_nkeys 'k' +#endif +#ifndef PERL_MAGIC_dbfile +# define PERL_MAGIC_dbfile 'L' #endif -#ifndef isPSXSPC -# define isPSXSPC(c) (isSPACE(c) || (c) == '\v') + +#ifndef PERL_MAGIC_dbline +# define PERL_MAGIC_dbline 'l' #endif -#ifndef isBLANK -# define isBLANK(c) ((c) == ' ' || (c) == '\t') +#ifndef PERL_MAGIC_mutex +# define PERL_MAGIC_mutex 'm' #endif -#ifdef EBCDIC -#ifndef isALNUMC -# define isALNUMC(c) isalnum(c) +#ifndef PERL_MAGIC_shared +# define PERL_MAGIC_shared 'N' #endif -#ifndef isASCII -# define isASCII(c) isascii(c) +#ifndef PERL_MAGIC_shared_scalar +# define PERL_MAGIC_shared_scalar 'n' #endif -#ifndef isCNTRL -# define isCNTRL(c) iscntrl(c) +#ifndef PERL_MAGIC_collxfrm +# define PERL_MAGIC_collxfrm 'o' #endif -#ifndef isGRAPH -# define isGRAPH(c) isgraph(c) +#ifndef PERL_MAGIC_tied +# define PERL_MAGIC_tied 'P' #endif -#ifndef isPRINT -# define isPRINT(c) isprint(c) +#ifndef PERL_MAGIC_tiedelem +# define PERL_MAGIC_tiedelem 'p' #endif -#ifndef isPUNCT -# define isPUNCT(c) ispunct(c) +#ifndef PERL_MAGIC_tiedscalar +# define PERL_MAGIC_tiedscalar 'q' #endif -#ifndef isXDIGIT -# define isXDIGIT(c) isxdigit(c) +#ifndef PERL_MAGIC_qr +# define PERL_MAGIC_qr 'r' #endif -#else -# if (PERL_BCDVERSION < 0x5010000) -/* Hint: isPRINT - * The implementation in older perl versions includes all of the - * isSPACE() characters, which is wrong. The version provided by - * Devel::PPPort always overrides a present buggy version. - */ -# undef isPRINT -# endif +#ifndef PERL_MAGIC_sig +# define PERL_MAGIC_sig 'S' +#endif -#ifndef WIDEST_UTYPE -# ifdef QUADKIND -# ifdef U64TYPE -# define WIDEST_UTYPE U64TYPE -# else -# define WIDEST_UTYPE Quad_t -# endif -# else -# define WIDEST_UTYPE U32 -# endif +#ifndef PERL_MAGIC_sigelem +# define PERL_MAGIC_sigelem 's' #endif -#ifndef isALNUMC -# define isALNUMC(c) (isALPHA(c) || isDIGIT(c)) + +#ifndef PERL_MAGIC_taint +# define PERL_MAGIC_taint 't' #endif -#ifndef isASCII -# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127) +#ifndef PERL_MAGIC_uvar +# define PERL_MAGIC_uvar 'U' #endif -#ifndef isCNTRL -# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127) +#ifndef PERL_MAGIC_uvar_elem +# define PERL_MAGIC_uvar_elem 'u' #endif -#ifndef isGRAPH -# define isGRAPH(c) (isALNUM(c) || isPUNCT(c)) +#ifndef PERL_MAGIC_vstring +# define PERL_MAGIC_vstring 'V' #endif -#ifndef isPRINT -# define isPRINT(c) (((c) >= 32 && (c) < 127)) +#ifndef PERL_MAGIC_vec +# define PERL_MAGIC_vec 'v' #endif -#ifndef isPUNCT -# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126)) +#ifndef PERL_MAGIC_utf8 +# define PERL_MAGIC_utf8 'w' #endif -#ifndef isXDIGIT -# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F')) +#ifndef PERL_MAGIC_substr +# define PERL_MAGIC_substr 'x' #endif +#ifndef PERL_MAGIC_defelem +# define PERL_MAGIC_defelem 'y' #endif -/* Until we figure out how to support this in older perls... */ -#if (PERL_BCDVERSION >= 0x5008000) -#ifndef HeUTF8 -# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \ - SvUTF8(HeKEY_sv(he)) : \ - (U32)HeKUTF8(he)) +#ifndef PERL_MAGIC_glob +# define PERL_MAGIC_glob '*' #endif -#endif -#ifndef C_ARRAY_LENGTH -# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0])) +#ifndef PERL_MAGIC_arylen +# define PERL_MAGIC_arylen '#' #endif -#ifndef C_ARRAY_END -# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a)) +#ifndef PERL_MAGIC_pos +# define PERL_MAGIC_pos '.' #endif -#ifndef MUTABLE_PTR -#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define MUTABLE_PTR(p) ({ void *_p = (p); _p; }) -#else -# define MUTABLE_PTR(p) ((void *) (p)) -#endif +#ifndef PERL_MAGIC_backref +# define PERL_MAGIC_backref '<' #endif -#ifndef MUTABLE_SV -# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p)) + +#ifndef PERL_MAGIC_ext +# define PERL_MAGIC_ext '~' #endif #ifdef NEED_mess_sv @@ -4585,8 +5500,8 @@ typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*); # if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) ) # define D_PPP_FIX_UTF8_ERRSV(errsv, sv) \ STMT_START { \ - if (sv != ERRSV) \ - SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \ + if (sv != errsv) \ + SvFLAGS(errsv) = (SvFLAGS(errsv) & ~SVf_UTF8) | \ (SvFLAGS(sv) & SVf_UTF8); \ } STMT_END # else @@ -6220,239 +7135,6 @@ DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int t #ifndef gv_init_pvn # define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE) #endif -#ifndef WARN_ALL -# define WARN_ALL 0 -#endif - -#ifndef WARN_CLOSURE -# define WARN_CLOSURE 1 -#endif - -#ifndef WARN_DEPRECATED -# define WARN_DEPRECATED 2 -#endif - -#ifndef WARN_EXITING -# define WARN_EXITING 3 -#endif - -#ifndef WARN_GLOB -# define WARN_GLOB 4 -#endif - -#ifndef WARN_IO -# define WARN_IO 5 -#endif - -#ifndef WARN_CLOSED -# define WARN_CLOSED 6 -#endif - -#ifndef WARN_EXEC -# define WARN_EXEC 7 -#endif - -#ifndef WARN_LAYER -# define WARN_LAYER 8 -#endif - -#ifndef WARN_NEWLINE -# define WARN_NEWLINE 9 -#endif - -#ifndef WARN_PIPE -# define WARN_PIPE 10 -#endif - -#ifndef WARN_UNOPENED -# define WARN_UNOPENED 11 -#endif - -#ifndef WARN_MISC -# define WARN_MISC 12 -#endif - -#ifndef WARN_NUMERIC -# define WARN_NUMERIC 13 -#endif - -#ifndef WARN_ONCE -# define WARN_ONCE 14 -#endif - -#ifndef WARN_OVERFLOW -# define WARN_OVERFLOW 15 -#endif - -#ifndef WARN_PACK -# define WARN_PACK 16 -#endif - -#ifndef WARN_PORTABLE -# define WARN_PORTABLE 17 -#endif - -#ifndef WARN_RECURSION -# define WARN_RECURSION 18 -#endif - -#ifndef WARN_REDEFINE -# define WARN_REDEFINE 19 -#endif - -#ifndef WARN_REGEXP -# define WARN_REGEXP 20 -#endif - -#ifndef WARN_SEVERE -# define WARN_SEVERE 21 -#endif - -#ifndef WARN_DEBUGGING -# define WARN_DEBUGGING 22 -#endif - -#ifndef WARN_INPLACE -# define WARN_INPLACE 23 -#endif - -#ifndef WARN_INTERNAL -# define WARN_INTERNAL 24 -#endif - -#ifndef WARN_MALLOC -# define WARN_MALLOC 25 -#endif - -#ifndef WARN_SIGNAL -# define WARN_SIGNAL 26 -#endif - -#ifndef WARN_SUBSTR -# define WARN_SUBSTR 27 -#endif - -#ifndef WARN_SYNTAX -# define WARN_SYNTAX 28 -#endif - -#ifndef WARN_AMBIGUOUS -# define WARN_AMBIGUOUS 29 -#endif - -#ifndef WARN_BAREWORD -# define WARN_BAREWORD 30 -#endif - -#ifndef WARN_DIGIT -# define WARN_DIGIT 31 -#endif - -#ifndef WARN_PARENTHESIS -# define WARN_PARENTHESIS 32 -#endif - -#ifndef WARN_PRECEDENCE -# define WARN_PRECEDENCE 33 -#endif - -#ifndef WARN_PRINTF -# define WARN_PRINTF 34 -#endif - -#ifndef WARN_PROTOTYPE -# define WARN_PROTOTYPE 35 -#endif - -#ifndef WARN_QW -# define WARN_QW 36 -#endif - -#ifndef WARN_RESERVED -# define WARN_RESERVED 37 -#endif - -#ifndef WARN_SEMICOLON -# define WARN_SEMICOLON 38 -#endif - -#ifndef WARN_TAINT -# define WARN_TAINT 39 -#endif - -#ifndef WARN_THREADS -# define WARN_THREADS 40 -#endif - -#ifndef WARN_UNINITIALIZED -# define WARN_UNINITIALIZED 41 -#endif - -#ifndef WARN_UNPACK -# define WARN_UNPACK 42 -#endif - -#ifndef WARN_UNTIE -# define WARN_UNTIE 43 -#endif - -#ifndef WARN_UTF8 -# define WARN_UTF8 44 -#endif - -#ifndef WARN_VOID -# define WARN_VOID 45 -#endif - -#ifndef WARN_ASSERTIONS -# define WARN_ASSERTIONS 46 -#endif -#ifndef packWARN -# define packWARN(a) (a) -#endif - -#ifndef ckWARN -# ifdef G_WARN_ON -# define ckWARN(a) (PL_dowarn & G_WARN_ON) -# else -# define ckWARN(a) PL_dowarn -# endif -#endif - -#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner) -#if defined(NEED_warner) -static void DPPP_(my_warner)(U32 err, const char *pat, ...); -static -#else -extern void DPPP_(my_warner)(U32 err, const char *pat, ...); -#endif - -#if defined(NEED_warner) || defined(NEED_warner_GLOBAL) - -#define Perl_warner DPPP_(my_warner) - - -void -DPPP_(my_warner)(U32 err, const char *pat, ...) -{ - SV *sv; - va_list args; - - PERL_UNUSED_ARG(err); - - va_start(args, pat); - sv = vnewSVpvf(pat, &args); - va_end(args); - sv_2mortal(sv); - warn("%s", SvPV_nolen(sv)); -} - -#define warner Perl_warner - -#define Perl_warner_nocontext Perl_warner - -#endif -#endif /* concatenating with "" ensures that only literal strings are accepted as argument * note that STR_WITH_LEN() can't be used as argument to macros or functions that @@ -7788,7 +8470,7 @@ DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str, STRLEN wrote = 0; STRLEN chsize = 0; STRLEN readsize = 1; -#if defined(is_utf8_string) && defined(utf8_to_uvchr) +#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf) bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0; #endif const char *pv = str; @@ -7798,15 +8480,15 @@ DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str, if (!(flags & PERL_PV_ESCAPE_NOCLEAR)) sv_setpvs(dsv, ""); -#if defined(is_utf8_string) && defined(utf8_to_uvchr) +#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf) if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count)) isuni = 1; #endif for (; pv < end && (!max || wrote < max) ; pv += readsize) { const UV u = -#if defined(is_utf8_string) && defined(utf8_to_uvchr) - isuni ? utf8_to_uvchr((U8*)pv, &readsize) : +#if defined(is_utf8_string) && defined(utf8_to_uvchr_buf) + isuni ? utf8_to_uvchr_buf((U8*)pv, end, &readsize) : #endif (U8)*pv; const U8 c = (U8)u & 0xFF; diff --git a/t/basic.t b/t/basic.t index 18b2ace..61bf675 100644 --- a/t/basic.t +++ b/t/basic.t @@ -15,9 +15,12 @@ foreach my $func (qw( socket socketpair bind connect listen accept shutdown getsockopt setsockopt getsockname getpeername truncate chdir pipe )) { - eval "sub { no bareword::filehandles; $func BAREWORD }"; - $@ =~ s/-([oO])/"-".chr(ord($1)^0x20)/e if "$]" < 5.008008; # workaround Perl RT#36672 - like "$@", qr/^Use of bareword filehandle in \Q$func\E\b/, "$func BAREWORD dies"; + SKIP: { + skip "Can't check filetest '$func' on Perl < 5.31.1", 1 if "$]" < 5.031001 and $func =~ /\A-.\z/; + eval "sub { no bareword::filehandles; $func BAREWORD }"; + $@ =~ s/-([oO])/"-".chr(ord($1)^0x20)/e if "$]" < 5.008008; # workaround Perl RT#36672 + like "$@", qr/^Use of bareword filehandle in \Q$func\E\b/, "$func BAREWORD dies"; + } foreach my $fh ("", qw(STDIN STDERR STDOUT DATA ARGV)) { eval "sub { no bareword::filehandles; $func $fh }"; unlike "$@", qr/Use of bareword filehandle/, "$func $fh lives"; @@ -29,5 +32,14 @@ foreach my $func (qw(accept pipe socketpair)) { like "$@", qr/^Use of bareword filehandle in \Q$func\E\b/, "$func my \$fh, BAREWORD dies"; } + +SKIP: { + skip "no stacked file tests on perl $]", 2 if "$]" < 5.010; + my $warnings = ''; + local $SIG{__WARN__} = sub { $warnings .= $_[0] }; + ok -d -e ".", "stacked file test works"; + is $warnings, '', "no warnings for stacked file test"; +}; + done_testing; -- cgit v1.2.3