In perl.git, the branch smoke-me/leont/utf8-readline has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/fbb3cdcafb787e327084040c6793905f934169d8?hp=d617336d18f19d144cd6c137a14fa7e61e33f2d2>
discards d617336d18f19d144cd6c137a14fa7e61e33f2d2 (commit)
discards bddc2c36a3d3450725be5e5cf44647b1efd5e842 (commit)
discards 3aa9eb77caea63cec141e5ce3a960a97127576ac (commit)
discards ac0b74f2ec75b76cfb15223e29f34930b2d25ccd (commit)
- Log -----------------------------------------------------------------
commit fbb3cdcafb787e327084040c6793905f934169d8
Author: Leon Timmermans <faw...@gmail.com>
Date: Mon Apr 9 21:49:11 2012 +0200
Made :utf8 an actual layer
It will check the input for validity, by default strict validity though
less strict forms are provided. This also means PerlIO::get_layers doesn't
return a "utf8" pseudo-layer anymore, which can break some code making that
assumption.
M cpan/CPAN-Meta-YAML/t/11_read_string.t
M lib/PerlIO.pm
M perlio.c
M perliol.h
M pod/perldiag.pod
M pod/perlfunc.pod
M pod/perliol.pod
M pod/perlrun.pod
M pod/perlunifaq.pod
M pod/perluniintro.pod
M t/io/crlf.t
M t/io/layers.t
M t/io/utf8.t
M t/op/print.t
M universal.c
commit 0beddaab07b31f51bb9da07ab7e709b005b2030c
Author: Leon Timmermans <faw...@gmail.com>
Date: Mon Nov 14 12:15:18 2016 +0100
Make :encoding use the new readdelim method
M ext/PerlIO-encoding/encoding.pm
M ext/PerlIO-encoding/encoding.xs
commit a9ca4cc037e49f4f7b9bd656af26c0567314492d
Author: Leon Timmermans <faw...@gmail.com>
Date: Mon Nov 14 12:04:51 2016 +0100
Add fast readdelim to main buffering layers
M perlio.c
M perliol.h
commit 0815d18ed2c6ff3e6314956ec9f18b37ad386f0d
Author: Leon Timmermans <faw...@gmail.com>
Date: Sun Dec 11 15:44:52 2016 +0100
Implement new style readline and the slow fallback
M embed.fnc
M embed.h
M perlio.c
M perliol.h
M proto.h
M sv.c
-----------------------------------------------------------------------
Summary of changes:
MANIFEST | 19 +
META.json | 1 +
META.yml | 1 +
Porting/Maintainers.pl | 35 +-
Porting/bench.pl | 100 +-
Porting/checkAUTHORS.pl | 1 +
configpm | 11 +-
configure.com | 55 +-
cpan/Encode/Encode.pm | 31 +-
cpan/Encode/Encode.xs | 519 +++---
cpan/Encode/Encode/_T.e2x | 6 +-
cpan/Encode/Makefile.PL | 13 +-
cpan/Encode/Unicode/Makefile.PL | 2 +-
cpan/Encode/Unicode/Unicode.pm | 2 +-
cpan/Encode/Unicode/Unicode.xs | 110 +-
cpan/Encode/bin/enc2xs | 58 +-
cpan/Encode/encoding.pm | 4 +-
cpan/Encode/lib/Encode/Alias.pm | 14 +-
cpan/Encode/lib/Encode/CN/HZ.pm | 5 +-
cpan/Encode/lib/Encode/MIME/Header.pm | 471 ++++--
cpan/Encode/lib/Encode/MIME/Name.pm | 14 +-
cpan/Encode/t/Aliases.t | 2 +-
cpan/Encode/t/Encode.t | 54 +-
cpan/Encode/t/at-cn.t | 4 +-
cpan/Encode/t/at-tw.t | 4 +-
cpan/Encode/t/decode.t | 56 +-
cpan/Encode/t/enc_data.t | 8 +-
cpan/Encode/t/enc_eucjp.t | 2 +-
cpan/Encode/t/enc_module.t | 8 +-
cpan/Encode/t/enc_utf8.t | 2 +-
cpan/Encode/t/encoding-locale.t | 2 +-
cpan/Encode/t/encoding.t | 6 +-
cpan/Encode/t/fallback.t | 2 +-
cpan/Encode/t/jperl.t | 6 +-
cpan/Encode/t/magic.t | 144 ++
cpan/Encode/t/mime-header.t | 215 ++-
cpan/Encode/t/mime-name.t | 34 +-
cpan/Encode/t/rt113164.t | 38 +
cpan/Encode/t/rt65541.t | 29 +
cpan/Encode/t/rt76824.t | 60 +
cpan/Encode/t/rt85489.t | 48 +
cpan/Encode/t/rt86327.t | 33 +
cpan/Encode/t/taint.t | 28 +-
cpan/Encode/t/utf8ref.t | 21 +-
cpan/Encode/t/utf8strict.t | 51 +-
cpan/Locale-Codes/lib/Locale/Codes.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Codes.pod | 53 +
cpan/Locale-Codes/lib/Locale/Codes/Changes.pod | 24 +-
cpan/Locale-Codes/lib/Locale/Codes/Constants.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Codes/Country.pm | 2 +-
.../Locale-Codes/lib/Locale/Codes/Country_Codes.pm | 17 +-
.../lib/Locale/Codes/Country_Retired.pm | 13 +-
cpan/Locale-Codes/lib/Locale/Codes/Currency.pm | 2 +-
.../lib/Locale/Codes/Currency_Codes.pm | 4 +-
.../lib/Locale/Codes/Currency_Retired.pm | 4 +-
cpan/Locale-Codes/lib/Locale/Codes/LangExt.pm | 2 +-
.../Locale-Codes/lib/Locale/Codes/LangExt_Codes.pm | 4 +-
.../lib/Locale/Codes/LangExt_Retired.pm | 4 +-
cpan/Locale-Codes/lib/Locale/Codes/LangFam.pm | 2 +-
.../Locale-Codes/lib/Locale/Codes/LangFam_Codes.pm | 4 +-
.../lib/Locale/Codes/LangFam_Retired.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Codes/LangVar.pm | 2 +-
.../Locale-Codes/lib/Locale/Codes/LangVar_Codes.pm | 4 +-
.../lib/Locale/Codes/LangVar_Retired.pm | 4 +-
cpan/Locale-Codes/lib/Locale/Codes/Language.pm | 2 +-
.../lib/Locale/Codes/Language_Codes.pm | 4 +-
.../lib/Locale/Codes/Language_Retired.pm | 4 +-
cpan/Locale-Codes/lib/Locale/Codes/Script.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Codes/Script_Codes.pm | 4 +-
.../lib/Locale/Codes/Script_Retired.pm | 4 +-
cpan/Locale-Codes/lib/Locale/Country.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Currency.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Language.pm | 2 +-
cpan/Locale-Codes/lib/Locale/Script.pm | 2 +-
cpan/Math-BigInt-FastCalc/FastCalc.xs | 13 +-
.../lib/Math/BigInt/FastCalc.pm | 59 +-
cpan/Math-BigInt-FastCalc/t/bigintfc.t | 25 +-
.../t/biglog.t | 2 +-
.../t/bigroot.t | 2 +-
cpan/Math-BigInt-FastCalc/t/bootstrap.t | 1 -
cpan/Math-BigInt-FastCalc/t/leak.t | 5 +-
cpan/Math-BigInt-FastCalc/t/mbi_rand.t | 123 +-
cpan/Math-BigInt/lib/Math/BigFloat.pm | 148 +-
cpan/Math-BigInt/lib/Math/BigInt.pm | 93 +-
cpan/Math-BigInt/lib/Math/BigInt/Calc.pm | 1241 ++++++---------
cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm | 5 +-
cpan/Math-BigInt/lib/Math/BigInt/Lib.pm | 1673 ++++++++++++++++++++
.../t/Math/BigFloat/{Subclass.pm => #Subclass.pm#} | 0
cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm | 36 +-
cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm | 1018 ++++++++++++
cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm | 4 +-
cpan/Math-BigInt/t/bare_mbf.t | 2 +-
cpan/Math-BigInt/t/bare_mbi.t | 4 +-
cpan/Math-BigInt/t/bare_mif.t | 6 +-
cpan/Math-BigInt/t/bigfltpm.inc | 2 +-
cpan/Math-BigInt/t/bigfltpm.t | 49 +-
cpan/Math-BigInt/t/bigintc.t | 9 +-
cpan/Math-BigInt/t/bigintpm.inc | 10 +-
cpan/Math-BigInt/t/bigintpm.t | 42 +-
cpan/Math-BigInt/t/biglog.t | 2 +-
cpan/Math-BigInt/t/bigroot.t | 2 +-
cpan/Math-BigInt/t/calling.t | 7 +-
cpan/Math-BigInt/t/mbf_ali.t | 2 +-
cpan/Math-BigInt/t/mbi_ali.t | 2 +-
cpan/Math-BigInt/t/mbi_rand.t | 22 +-
cpan/Math-BigInt/t/mbimbf.inc | 2 +-
cpan/Math-BigInt/t/mbimbf.t | 4 +-
cpan/Math-BigInt/t/new-mbf.t | 1 -
cpan/Math-BigInt/t/sub_ali.t | 2 +-
cpan/Math-BigInt/t/sub_mbf.t | 4 +-
cpan/Math-BigInt/t/sub_mbi.t | 2 +-
cpan/Math-BigInt/t/sub_mif.t | 2 +-
cpan/Math-BigInt/t/upgrade.inc | 4 +-
cpan/Math-BigInt/t/upgrade.t | 2 +-
cpan/Math-BigInt/t/upgradef.t | 2 +-
cpan/Math-BigInt/t/use_lib1.t | 4 +-
cpan/Math-BigInt/t/use_lib2.t | 4 +-
cpan/Math-BigInt/t/use_lib3.t | 4 +-
cpan/Math-BigInt/t/use_lib4.t | 4 +-
cpan/Math-BigInt/t/use_mbfw.t | 8 +-
cpan/Math-BigInt/t/with_sub.t | 6 +-
cpan/Math-BigRat/lib/Math/BigRat.pm | 397 ++---
cpan/Math-BigRat/t/Math/BigRat/Test.pm | 12 +-
cpan/Math-BigRat/t/bigfltrt.t | 2 +-
cpan/Math-BigRat/t/bigratpm.t | 2 +-
cpan/Test-Simple/lib/Test/Builder.pm | 34 +-
cpan/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 +-
cpan/Test-Simple/lib/Test/Builder/Tester/Color.pm | 2 +-
cpan/Test-Simple/lib/Test/Builder/TodoDiag.pm | 2 +-
cpan/Test-Simple/lib/Test/More.pm | 13 +-
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 +-
cpan/Test-Simple/lib/Test/Tester/CaptureRunner.pm | 2 +-
cpan/Test-Simple/lib/Test/Tester/Delegate.pm | 12 +-
cpan/Test-Simple/lib/Test/use/ok.pm | 2 +-
cpan/Test-Simple/lib/Test2.pm | 12 +-
cpan/Test-Simple/lib/Test2/API.pm | 7 +-
cpan/Test-Simple/lib/Test2/API/Breakage.pm | 2 +-
cpan/Test-Simple/lib/Test2/API/Context.pm | 11 +-
cpan/Test-Simple/lib/Test2/API/Instance.pm | 10 +-
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/Exception.pm | 2 +-
cpan/Test-Simple/lib/Test2/Event/Generic.pm | 2 +-
cpan/Test-Simple/lib/Test2/Event/Info.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/Plan.pm | 2 +-
cpan/Test-Simple/lib/Test2/Event/Skip.pm | 2 +-
cpan/Test-Simple/lib/Test2/Event/Subtest.pm | 2 +-
cpan/Test-Simple/lib/Test2/Event/Waiting.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 | 14 +-
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 | 3 +-
cpan/Test-Simple/lib/Test2/IPC/Driver.pm | 2 +-
cpan/Test-Simple/lib/Test2/IPC/Driver/Files.pm | 17 +-
cpan/Test-Simple/lib/Test2/Util.pm | 6 +-
cpan/Test-Simple/lib/Test2/Util/ExternalMeta.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 +-
cpan/Test-Simple/t/Legacy/Regression/6_cmp_ok.t | 17 +
cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t | 31 +
cpan/Test-Simple/t/Legacy/auto.t | 8 +-
cpan/Test-Simple/t/Legacy/fail-more.t | 11 +-
.../t/Legacy_And_Test2/hidden_warnings.t | 20 +
cpan/Test-Simple/t/Test2/behavior/Formatter.t | 2 +-
cpan/Test-Simple/t/Test2/modules/Event/Info.t | 6 +
.../Test-Simple/t/Test2/modules/IPC/Driver/Files.t | 71 +-
cpan/Time-Local/lib/Time/Local.pm | 59 +-
cpan/Unicode-Collate/Collate.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/Big5.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/GB2312.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/JISX0208.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/Korean.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/Pinyin.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/Stroke.pm | 2 +-
cpan/Unicode-Collate/Collate/CJK/Zhuyin.pm | 2 +-
cpan/Unicode-Collate/Collate/Locale.pm | 47 +-
cpan/Unicode-Collate/Collate/Locale/af.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ar.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/as.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/az.pl | 4 +-
cpan/Unicode-Collate/Collate/Locale/be.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/bn.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ca.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/cs.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/cy.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/da.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/de_at_ph.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/de_phone.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ee.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/eo.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/es.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/es_trad.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/et.pl | 4 +-
cpan/Unicode-Collate/Collate/Locale/fa.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/fi.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/fi_phone.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/fil.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/fo.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/fr_ca.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/gu.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ha.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/haw.pl | 51 +-
cpan/Unicode-Collate/Collate/Locale/he.pl | 7 +
cpan/Unicode-Collate/Collate/Locale/hi.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/hr.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/hu.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/hy.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ig.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/is.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ja.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/kk.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/kl.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/kn.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ko.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/kok.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ln.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/lt.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/lv.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/mk.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ml.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/mr.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/mt.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/nb.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/nn.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/nso.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/om.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/or.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/pa.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/pl.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ro.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sa.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/se.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/si.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/si_dict.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sk.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sl.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sq.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sr.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sv.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/sv_refo.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ta.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/te.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/th.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/tn.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/to.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/tr.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ug_cyrl.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/uk.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/ur.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/vi.pl | 2 +-
.../Collate/Locale/{de_at_ph.pl => vo.pl} | 4 +-
cpan/Unicode-Collate/Collate/Locale/wae.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/wo.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/yo.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh_big5.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh_gb.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh_pin.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh_strk.pl | 2 +-
cpan/Unicode-Collate/Collate/Locale/zh_zhu.pl | 2 +-
cpan/Unicode-Collate/t/loc_az.t | 17 +-
cpan/Unicode-Collate/t/loc_cs.t | 10 +-
cpan/Unicode-Collate/t/loc_de.t | 33 +-
cpan/Unicode-Collate/t/loc_deat.t | 16 +-
cpan/Unicode-Collate/t/loc_deph.t | 28 +-
cpan/Unicode-Collate/t/loc_es.t | 2 +-
cpan/Unicode-Collate/t/loc_estr.t | 2 +-
cpan/Unicode-Collate/t/loc_et.t | 13 +-
cpan/Unicode-Collate/t/loc_ha.t | 12 +-
cpan/Unicode-Collate/t/loc_haw.t | 22 +-
cpan/Unicode-Collate/t/{loc_si.t => loc_he.t} | 41 +-
cpan/Unicode-Collate/t/loc_ig.t | 16 +-
cpan/Unicode-Collate/t/loc_vo.t | 105 ++
cpan/bignum/lib/Math/BigFloat/Trace.pm | 6 +-
cpan/bignum/lib/Math/BigInt/Trace.pm | 6 +-
cpan/bignum/lib/bigint.pm | 37 +-
cpan/bignum/lib/bignum.pm | 58 +-
cpan/bignum/lib/bigrat.pm | 36 +-
cpan/bignum/t/infnan.inc | 1 -
dist/IO/IO.pm | 2 +-
dist/IO/IO.xs | 3 +-
dist/IO/t/io_leak.t | 37 +
dist/Time-HiRes/Changes | 15 +-
dist/Time-HiRes/HiRes.pm | 2 +-
ext/PerlIO-scalar/scalar.pm | 2 +-
ext/PerlIO-scalar/scalar.xs | 15 +-
ext/XS-APItest/t/utf8.t | 2 +-
hv.c | 1 +
hv_func.h | 679 +++-----
lib/locale.t | 6 +-
mathoms.c | 2 +
op.c | 10 +-
parser.h | 2 +-
perlio.c | 11 +-
perly.act | 8 +-
perly.c | 512 +++---
perly.h | 10 +-
perly.tab | 2 +-
perly.y | 6 +-
pod/.gitignore | 6 +-
pod/perldelta.pod | 15 +-
pod/perlmod.pod | 56 +-
sv.c | 2 +-
t/comp/parser.t | 10 +-
t/io/perlio.t | 2 +-
t/op/repeat.t | 11 +-
t/perf/benchmarks | 67 +-
t/porting/customized.dat | 7 +-
t/re/reg_eval.t | 6 +
t/test.pl | 5 +-
toke.c | 40 +-
universal.c | 4 -
utf8.c | 7 +-
325 files changed, 7128 insertions(+), 3206 deletions(-)
create mode 100644 cpan/Encode/t/magic.t
create mode 100644 cpan/Encode/t/rt113164.t
create mode 100644 cpan/Encode/t/rt65541.t
create mode 100644 cpan/Encode/t/rt76824.t
create mode 100644 cpan/Encode/t/rt85489.t
create mode 100644 cpan/Encode/t/rt86327.t
copy cpan/{Math-BigInt => Math-BigInt-FastCalc}/t/biglog.t (99%)
copy cpan/{Math-BigInt => Math-BigInt-FastCalc}/t/bigroot.t (97%)
create mode 100644 cpan/Math-BigInt/lib/Math/BigInt/Lib.pm
copy cpan/Math-BigInt/t/Math/BigFloat/{Subclass.pm => #Subclass.pm#} (100%)
create mode 100644 cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm
create mode 100644 cpan/Test-Simple/t/Legacy/Regression/6_cmp_ok.t
create mode 100644 cpan/Test-Simple/t/Legacy/Regression/736_use_ok.t
create mode 100644 cpan/Test-Simple/t/Legacy_And_Test2/hidden_warnings.t
create mode 100644 cpan/Unicode-Collate/Collate/Locale/he.pl
copy cpan/Unicode-Collate/Collate/Locale/{de_at_ph.pl => vo.pl} (91%)
copy cpan/Unicode-Collate/t/{loc_si.t => loc_he.t} (50%)
create mode 100644 cpan/Unicode-Collate/t/loc_vo.t
create mode 100644 dist/IO/t/io_leak.t
diff --git a/MANIFEST b/MANIFEST
index c8cf0559aa..2c89f48fe6 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -968,6 +968,7 @@ cpan/Encode/t/jisx0212.utf test data
cpan/Encode/t/jperl.t test script
cpan/Encode/t/ksc5601.enc test data
cpan/Encode/t/ksc5601.utf test data
+cpan/Encode/t/magic.t test script
cpan/Encode/t/mime-header.t test script
cpan/Encode/t/mime-name.t test script
cpan/Encode/t/mime_header_iso2022jp.t test script
@@ -975,6 +976,11 @@ cpan/Encode/t/Mod_EUCJP.pm module that
t/enc_module.enc uses
cpan/Encode/t/perlio.t test script
cpan/Encode/t/piconv.t Test for piconv.t
cpan/Encode/t/rt.pl test script
+cpan/Encode/t/rt113164.t test script
+cpan/Encode/t/rt65541.t test script
+cpan/Encode/t/rt76824.t test script
+cpan/Encode/t/rt85489.t test script
+cpan/Encode/t/rt86327.t test script
cpan/Encode/t/taint.t
cpan/Encode/t/unibench.pl benchmark script
cpan/Encode/t/Unicode.t test script
@@ -1684,6 +1690,7 @@ cpan/Math-BigInt/lib/Math/BigFloat.pm An
arbitrary precision floating-point ari
cpan/Math-BigInt/lib/Math/BigInt.pm An arbitrary precision integer
arithmetic package
cpan/Math-BigInt/lib/Math/BigInt/Calc.pm Pure Perl module to support
Math::BigInt
cpan/Math-BigInt/lib/Math/BigInt/CalcEmu.pm Pure Perl module to support
Math::BigInt
+cpan/Math-BigInt/lib/Math/BigInt/Lib.pm
cpan/Math-BigInt/t/_e_math.t Helper routine in BigFloat for _e math
cpan/Math-BigInt/t/alias.inc Support for BigInt tests
cpan/Math-BigInt/t/bare_mbf.t Test MBF under Math::BigInt::BareCalc
@@ -1723,8 +1730,10 @@ cpan/Math-BigInt/t/from_oct-mbf.t Test
Math::BigInt
cpan/Math-BigInt/t/inf_nan.t Special tests for inf and *NaN* handling
cpan/Math-BigInt/t/isa.t Test for Math::BigInt inheritance
cpan/Math-BigInt/t/lib_load.t Test sane lib names
+cpan/Math-BigInt/t/Math/BigFloat/#Subclass.pm#
cpan/Math-BigInt/t/Math/BigFloat/Subclass.pm Empty subclass of BigFloat for
test
cpan/Math-BigInt/t/Math/BigInt/BareCalc.pm Bigint's simulation of Calc
+cpan/Math-BigInt/t/Math/BigInt/Lib/Minimal.pm
cpan/Math-BigInt/t/Math/BigInt/Lib/TestUtil.pm Test Math::BigInt
cpan/Math-BigInt/t/Math/BigInt/Scalar.pm Pure Perl module to support
Math::BigInt
cpan/Math-BigInt/t/Math/BigInt/Subclass.pm Empty subclass of BigInt for
test
@@ -1770,6 +1779,8 @@ cpan/Math-BigInt/t/with_sub.t Test use
Math::BigFloat with => package
cpan/Math-BigInt-FastCalc/FastCalc.xs Math::BigInt::FastCalc extension
cpan/Math-BigInt-FastCalc/lib/Math/BigInt/FastCalc.pm Math::BigInt::FastCalc
extension
cpan/Math-BigInt-FastCalc/t/bigintfc.t Math::BigInt::FastCalc extension
+cpan/Math-BigInt-FastCalc/t/biglog.t
+cpan/Math-BigInt-FastCalc/t/bigroot.t
cpan/Math-BigInt-FastCalc/t/bootstrap.t Math::BigInt::FastCalc extension
cpan/Math-BigInt-FastCalc/t/leak.t test for memory leaks in
Math::BigInt::FastCalc
cpan/Math-BigInt-FastCalc/t/mbi_rand.t Math::BigInt::FastCalc extension
@@ -2704,6 +2715,8 @@ cpan/Test-Simple/t/Legacy/plan_shouldnt_import.t
cpan/Test-Simple/t/Legacy/plan_skip_all.t
cpan/Test-Simple/t/Legacy/Regression/637.t
cpan/Test-Simple/t/Legacy/Regression/683_thread_todo.t
+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/require_ok.t
cpan/Test-Simple/t/Legacy/run_test.t
cpan/Test-Simple/t/Legacy/simple.t
@@ -2748,6 +2761,7 @@ cpan/Test-Simple/t/Legacy/useing.t
cpan/Test-Simple/t/Legacy/utf8.t
cpan/Test-Simple/t/Legacy/versions.t
cpan/Test-Simple/t/Legacy_And_Test2/builder_loaded_late.t
+cpan/Test-Simple/t/Legacy_And_Test2/hidden_warnings.t
cpan/Test-Simple/t/lib/Dev/Null.pm
cpan/Test-Simple/t/lib/Dummy.pm
cpan/Test-Simple/t/lib/MyOverload.pm
@@ -2923,6 +2937,7 @@ cpan/Unicode-Collate/Collate/Locale/fr_ca.pl
Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/gu.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/ha.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/haw.pl Unicode::Collate
+cpan/Unicode-Collate/Collate/Locale/he.pl
cpan/Unicode-Collate/Collate/Locale/hi.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/hr.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/hu.pl Unicode::Collate
@@ -2970,6 +2985,7 @@ cpan/Unicode-Collate/Collate/Locale/ug_cyrl.pl
Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/uk.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/ur.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/vi.pl Unicode::Collate
+cpan/Unicode-Collate/Collate/Locale/vo.pl
cpan/Unicode-Collate/Collate/Locale/wae.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/wo.pl Unicode::Collate
cpan/Unicode-Collate/Collate/Locale/yo.pl Unicode::Collate
@@ -3036,6 +3052,7 @@ cpan/Unicode-Collate/t/loc_frca.t Unicode::Collate
cpan/Unicode-Collate/t/loc_gu.t Unicode::Collate
cpan/Unicode-Collate/t/loc_ha.t Unicode::Collate
cpan/Unicode-Collate/t/loc_haw.t Unicode::Collate
+cpan/Unicode-Collate/t/loc_he.t
cpan/Unicode-Collate/t/loc_hi.t Unicode::Collate
cpan/Unicode-Collate/t/loc_hr.t Unicode::Collate
cpan/Unicode-Collate/t/loc_hu.t Unicode::Collate
@@ -3090,6 +3107,7 @@ cpan/Unicode-Collate/t/loc_ugcy.t Unicode::Collate
cpan/Unicode-Collate/t/loc_uk.t Unicode::Collate
cpan/Unicode-Collate/t/loc_ur.t Unicode::Collate
cpan/Unicode-Collate/t/loc_vi.t Unicode::Collate
+cpan/Unicode-Collate/t/loc_vo.t
cpan/Unicode-Collate/t/loc_wae.t Unicode::Collate
cpan/Unicode-Collate/t/loc_wo.t Unicode::Collate
cpan/Unicode-Collate/t/loc_yo.t Unicode::Collate
@@ -3433,6 +3451,7 @@ dist/IO/t/io_dir.t See if
directory-related methods from IO work
dist/IO/t/io_dup.t See if dup()-related methods from IO work
dist/IO/t/io_file.t See if binmode()-related methods on IO::File
work
dist/IO/t/io_file_export.t Test IO::File exports
+dist/IO/t/io_leak.t See if IO leaks SVs (only run in core)
dist/IO/t/io_linenum.t See if I/O line numbers are tracked correctly
dist/IO/t/io_multihomed.t See if INET sockets work with multi-homed hosts
dist/IO/t/io_pipe.t See if pipe()-related methods from IO work
diff --git a/META.json b/META.json
index a8f7f9ec80..0c22a756e2 100644
--- a/META.json
+++ b/META.json
@@ -85,6 +85,7 @@
"dist/IO/t/io_dup.t",
"dist/IO/t/io_file.t",
"dist/IO/t/io_file_export.t",
+ "dist/IO/t/io_leak.t",
"dist/IO/t/io_linenum.t",
"dist/IO/t/io_multihomed.t",
"dist/IO/t/io_pipe.t",
diff --git a/META.yml b/META.yml
index 8cc5c5f19e..b5496d4a6b 100644
--- a/META.yml
+++ b/META.yml
@@ -82,6 +82,7 @@ no_index:
- dist/IO/t/io_dup.t
- dist/IO/t/io_file.t
- dist/IO/t/io_file_export.t
+ - dist/IO/t/io_leak.t
- dist/IO/t/io_linenum.t
- dist/IO/t/io_multihomed.t
- dist/IO/t/io_pipe.t
diff --git a/Porting/Maintainers.pl b/Porting/Maintainers.pl
index f0d4f77d31..a759592d84 100755
--- a/Porting/Maintainers.pl
+++ b/Porting/Maintainers.pl
@@ -188,10 +188,9 @@ use File::Glob qw(:case);
},
'bignum' => {
- 'DISTRIBUTION' => 'PJACKLAM/bignum-0.43.tar.gz',
+ 'DISTRIBUTION' => 'PJACKLAM/bignum-0.45.tar.gz',
'FILES' => q[cpan/bignum],
'EXCLUDED' => [
- qr{^inc/Module/},
qr{^t/author-},
qw( t/00sig.t
t/01load.t
@@ -199,13 +198,6 @@ use File::Glob qw(:case);
t/03podcov.t
),
],
- 'CUSTOMIZED' => [
- qw(
- lib/Math/BigFloat/Trace.pm
- lib/Math/BigInt/Trace.pm lib/bigint.pm
- lib/bignum.pm lib/bigrat.pm
- )
- ],
},
'Carp' => {
@@ -404,9 +396,9 @@ use File::Glob qw(:case);
},
'Encode' => {
- 'DISTRIBUTION' => 'DANKOGAI/Encode-2.86.tar.gz',
+ 'DISTRIBUTION' => 'DANKOGAI/Encode-2.88.tar.gz',
'FILES' => q[cpan/Encode],
- 'CUSTOMIZED' => [ qw[ Encode.xs ] ],
+ 'CUSTOMIZED' => [ qw(Unicode/Unicode.pm) ],
},
'encoding::warnings' => {
@@ -733,7 +725,7 @@ use File::Glob qw(:case);
},
'Locale-Codes' => {
- 'DISTRIBUTION' => 'SBECK/Locale-Codes-3.40.tar.gz',
+ 'DISTRIBUTION' => 'SBECK/Locale-Codes-3.42.tar.gz',
'FILES' => q[cpan/Locale-Codes],
'EXCLUDED' => [
qw( README.first
@@ -769,10 +761,9 @@ use File::Glob qw(:case);
},
'Math::BigInt' => {
- 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999727.tar.gz',
+ 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-1.999803.tar.gz',
'FILES' => q[cpan/Math-BigInt],
'EXCLUDED' => [
- qr{^inc/},
qr{^examples/},
qr{^t/author-},
qw( t/00sig.t
@@ -784,10 +775,11 @@ use File::Glob qw(:case);
},
'Math::BigInt::FastCalc' => {
- 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.42.tar.gz',
+ 'DISTRIBUTION' => 'PJACKLAM/Math-BigInt-FastCalc-0.5003.tar.gz',
'FILES' => q[cpan/Math-BigInt-FastCalc],
'EXCLUDED' => [
- qr{^inc/},
+ qr{^t/author-},
+ qr{^t/Math/BigInt/Lib/TestUtil.pm},
qw( t/00sig.t
t/01load.t
t/02pod.t
@@ -807,10 +799,9 @@ use File::Glob qw(:case);
},
'Math::BigRat' => {
- 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.260804.tar.gz',
+ 'DISTRIBUTION' => 'PJACKLAM/Math-BigRat-0.2609.tar.gz',
'FILES' => q[cpan/Math-BigRat],
'EXCLUDED' => [
- qr{^inc/},
qr{^t/author-},
qw( t/00sig.t
t/01load.t
@@ -1175,7 +1166,7 @@ use File::Glob qw(:case);
},
'Test::Simple' => {
- 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302062.tar.gz',
+ 'DISTRIBUTION' => 'EXODIST/Test-Simple-1.302067.tar.gz',
'FILES' => q[cpan/Test-Simple],
'EXCLUDED' => [
qr{^examples/},
@@ -1288,12 +1279,12 @@ use File::Glob qw(:case);
},
'Time::HiRes' => {
- 'DISTRIBUTION' => 'JHI/Time-HiRes-1.9740.tar.gz',
+ 'DISTRIBUTION' => 'JHI/Time-HiRes-1.9741.tar.gz',
'FILES' => q[dist/Time-HiRes],
},
'Time::Local' => {
- 'DISTRIBUTION' => 'DROLSKY/Time-Local-1.24.tar.gz',
+ 'DISTRIBUTION' => 'DROLSKY/Time-Local-1.25.tar.gz',
'FILES' => q[cpan/Time-Local],
'EXCLUDED' => [
qr{^xt/},
@@ -1312,7 +1303,7 @@ use File::Glob qw(:case);
},
'Unicode::Collate' => {
- 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.18.tar.gz',
+ 'DISTRIBUTION' => 'SADAHIRO/Unicode-Collate-1.19.tar.gz',
'FILES' => q[cpan/Unicode-Collate],
'EXCLUDED' => [
qr{N$},
diff --git a/Porting/bench.pl b/Porting/bench.pl
index be46c0e07c..62c6aaff54 100755
--- a/Porting/bench.pl
+++ b/Porting/bench.pl
@@ -25,6 +25,15 @@ perls.
bench.pl --action=selftest
+ # Run bench on blead, which is then modified and timed again
+
+ bench.pl [options] --write=blead.time -- ./perl=blead
+ # hack hack hack
+ bench.pl --read=blead.time -- ./perl=hacked
+
+ # You can also combine --read with --write
+ bench.pl --read=blead.time --write=last.time -- ./perl=hacked
+
=head1 DESCRIPTION
By default, F<bench.pl> will run code snippets found in
@@ -42,10 +51,14 @@ measurements, such as instruction reads, conditional branch
misses etc.
There are options to write the raw data to a file, and to read it back.
This means that you can view the same run data in different views with
-different selection and sort options.
+different selection and sort options. You can also use this mechanism
+to save the results of timing one perl, and then read it back while timing
+a modification, so that you dont have rerun the same tests on the same
+perl over and over, or have two perls built at the same time.
The optional C<=label> after each perl executable is used in the display
-output.
+output. If you are doing a two step benchmark then you should provide
+a label for at least the "base" perl.
=head1 OPTIONS
@@ -264,7 +277,9 @@ Display progress information.
--write=I<file>
Save the raw data to the specified file. It can be read back later with
-C<--read>.
+C<--read>. If combined with C<--read> then the output file will be
+the merge of the file read and any additional perls added on the command
+line.
Requires C<JSON::PP> to be available.
@@ -315,6 +330,7 @@ usage: $0 [options] -- perl[=label] ...
[default: 0].
--perlargs=foo Optional command-line args to pass to each perl to run.
--raw Display raw data counts rather than percentages.
+ --show Show results even though we are going to write results.
--sort=field:perl Sort the tests based on the value of 'field' in the
column 'perl'. The perl value is as per --norm.
-r|--read=file Read in previously saved data from the specified file.
@@ -351,6 +367,7 @@ my %OPTS = (
perlargs => '',
raw => 0,
read => undef,
+ show => 0,
sort => undef,
tests => undef,
verbose => 0,
@@ -376,6 +393,7 @@ my %OPTS = (
'perlargs=s' => \$OPTS{perlargs},
'raw' => \$OPTS{raw},
'read|r=s' => \$OPTS{read},
+ 'show!' => \$OPTS{show},
'sort=s' => \$OPTS{sort},
'tests=s' => \$OPTS{tests},
'verbose' => \$OPTS{verbose},
@@ -385,10 +403,6 @@ my %OPTS = (
usage if $OPTS{help};
- if (defined $OPTS{read} and defined $OPTS{write}) {
- die "Error: can't specify both --read and --write options\n";
- }
-
if (defined $OPTS{read} or defined $OPTS{write}) {
# fail early if it's not present
require JSON::PP;
@@ -438,21 +452,6 @@ my %OPTS = (
die "Error: Can't specify both --bisect and --write\n"
if defined $OPTS{write};
}
- elsif (defined $OPTS{read}) {
- if (@ARGV) {
- die "Error: no perl executables may be specified with --read\n"
- }
- }
- elsif ($OPTS{raw}) {
- unless (@ARGV) {
- die "Error: at least one perl executable must be specified\n";
- }
- }
- else {
- unless (@ARGV >= 2) {
- die "Error: at least two perl executables must be specified\n";
- }
- }
if ($OPTS{action} eq 'grind') {
do_grind(\@ARGV);
@@ -494,6 +493,7 @@ sub filter_tests {
delete $tests->{$_} unless exists $t{$_};
}
}
+ die "Error: no tests to run\n" unless %$tests;
}
@@ -526,7 +526,7 @@ sub read_tests_file {
sub select_a_perl {
my ($perl, $perls, $who) = @_;
-
+ $perls||=[];
if ($perl =~ /^[0-9]$/) {
die "Error: $who value $perl outside range 0.." . $#$perls . "\n"
unless $perl < @$perls;
@@ -550,8 +550,9 @@ sub select_a_perl {
# 'perl-under-test's (PUTs)
sub process_puts {
+ my $read_perls= shift;
my @res_puts; # returned, each item is [ perlexe, label, @putargs ]
- my %seen;
+ my %seen= map { $_->[1] => 1 } @$read_perls;
my @putargs; # collect not-perls into args per PUT
for my $p (reverse @_) {
@@ -674,9 +675,9 @@ sub do_grind {
if $bisect_min > $bisect_max;
}
- if (defined $OPTS{read}) {
+ if ($OPTS{read}) {
open my $in, '<:encoding(UTF-8)', $OPTS{read}
- or die " Error: can't open $OPTS{read} for reading: $!\n";
+ or die " Error: can't open '$OPTS{read}' for reading: $!\n";
my $data = do { local $/; <$in> };
close $in;
@@ -695,23 +696,30 @@ sub do_grind {
$order = [ sort keys %$tests ];
}
}
- else {
- # How many times to execute the loop for the two trials. The lower
- # value is intended to do the loop enough times that branch
- # prediction has taken hold; the higher loop allows us to see the
- # branch misses after that
- $loop_counts = [10, 20];
-
- ($tests, $order) = read_tests_file($OPTS{benchfile});
- die "Error: only a single test may be specified with --bisect\n"
- if defined $OPTS{bisect} and keys %$tests != 1;
-
- $perls = [ process_puts(@$perl_args) ];
+ if (@$perl_args) {
+ unless ($loop_counts) {
+ # How many times to execute the loop for the two trials. The lower
+ # value is intended to do the loop enough times that branch
+ # prediction has taken hold; the higher loop allows us to see the
+ # branch misses after that
+ $loop_counts = [10, 20];
+
+ ($tests, $order) = read_tests_file($OPTS{benchfile});
+ die "Error: only a single test may be specified with --bisect\n"
+ if defined $OPTS{bisect} and keys %$tests != 1;
+ }
- $results = grind_run($tests, $order, $perls, $loop_counts);
+ my @run_perls= process_puts($perls, @$perl_args);
+ push @$perls, @run_perls;
+ die "Error: Not enough perls to run a report, and --write not
specified.\n"
+ if @$perls < 2 and !$OPTS{write};
+ $results = grind_run($tests, $order, \@run_perls, $loop_counts,
$results);
}
+ if (!$perls or !@$perls) {
+ die "Error: nothing to do: no perls to run, no data to read.\n";
+ }
# now that we have a list of perls, use it to process the
# 'perl' component of the --norm and --sort args
@@ -736,11 +744,14 @@ sub do_grind {
});
open my $out, '>:encoding(UTF-8)', $OPTS{write}
- or die " Error: can't open $OPTS{write} for writing: $!\n";
+ or die "Error: can't open '$OPTS{write}' for writing: $!\n";
print $out $json or die "Error: writing to file '$OPTS{write}': $!\n";
close $out or die "Error: closing file '$OPTS{write}': $!\n";
}
- else {
+ if (!$OPTS{write} or $OPTS{show}) {
+ if (@$perls < 2) {
+ die "Error: need more than one perl to do a report.\n";
+ }
my ($processed, $averages) =
grind_process($results, $perls, $loop_counts);
@@ -773,7 +784,7 @@ sub do_grind {
# Return a hash ref suitable for input to grind_process()
sub grind_run {
- my ($tests, $order, $perls, $counts) = @_;
+ my ($tests, $order, $perls, $counts, $results) = @_;
# Build a list of all the jobs to run
@@ -837,7 +848,6 @@ sub grind_run {
my $running = 0; # count of executing jobs
my %pids; # map pids to jobs
my %fds; # map fds to jobs
- my %results;
my $select = IO::Select->new();
while (@jobs or $running) {
@@ -938,7 +948,7 @@ sub grind_run {
. "Output\n$o";
}
- $results{$j->{test}}{$j->{plabel}}[$j->{active}][$j->{loopix}]
+ $results->{$j->{test}}{$j->{plabel}}[$j->{active}][$j->{loopix}]
= parse_cachegrind($output, $j->{id}, $j->{perl});
}
@@ -961,7 +971,7 @@ sub grind_run {
}
}
- return \%results;
+ return $results;
}
diff --git a/Porting/checkAUTHORS.pl b/Porting/checkAUTHORS.pl
index b869c11703..4204304536 100755
--- a/Porting/checkAUTHORS.pl
+++ b/Porting/checkAUTHORS.pl
@@ -598,6 +598,7 @@ david\100justatheory.com david\100wheeler.net
+ david\100kineticode.com
+ david\100wheeler.com
+ david\100wheeler.net
+whatever\100davidnicol.com davidnicol\100gmail.com
dennis\100booking.com dennis\100camel.ams6.corp.booking.com
+ dennis.kaarsemaker\100booking.com
+ dennis\100kaarsemaker.net
diff --git a/configpm b/configpm
index c62f0fc3bf..d2ba35cec3 100755
--- a/configpm
+++ b/configpm
@@ -557,8 +557,15 @@ sub myconfig {
local *_ = \my $a;
$_ = <<'!END!';
EOT
-
-$heavy_txt .= join('', sort @v_others) . "!END!\n";
+#proper lexicographical order of the keys
+$heavy_txt .= join('',
+ map { $_->[-1] }
+ sort {$a->[0] cmp $b->[0] }
+ map {
+ /^([^=]+)/ ? [ $1, $_ ]
+ : [ $_, $_ ] # shouldnt happen
+ } @v_others
+) . "!END!\n";
# Only need the dynamic byteorder code in Config.pm if 'byteorder' is one of
# the precached keys
diff --git a/configure.com b/configure.com
index ddcd9b4b28..2e5b8106ed 100644
--- a/configure.com
+++ b/configure.com
@@ -66,8 +66,6 @@ $ dynamic_ext = ""
$ nonxs_ext = ""
$ nonxs_ext2 = ""
$ vms_default_directory_name = F$ENVIRONMENT("DEFAULT")
-$ max_allowed_dir_depth = 3 ! e.g. [A.B.PERLxxx] not [A.B.C.PERLxxx]
-$! max_allowed_dir_depth = 2 ! e.g. [A.PERLxxx] not [A.B.PERLxxx]
$!
$! Sebastian Bazley's request: close the CONFIG handle with /NOLOG
$! qualifier "just in case" (configure.com is re @ed in a bad state).
@@ -447,28 +445,27 @@ $ GOTO Beyond_manifest
$ ENDIF
$ ELSE
$! MANIFEST. has been found and we have set def'ed there.
-$! Time to bail out before it's too late, i.e. too deep.
-$! Depth check is unnecessary on Alpha VMS V7.2++ (even for ODS-2).
-$ tmp = f$extract(1,3,f$edit(f$getsyi("VERSION"),"TRIM,COLLAPSE"))
-$ IF (tmp .GES. "7.2") .AND. (F$GETSYI("HW_MODEL") .GE. 1024) THEN GOTO
Beyond_depth_check
-$! Depth check also unnecessary on ODS 5 (or later) file systems.
-$ tmp = F$INTEGER(F$GETDVI(F$ENVIRONMENT("DEFAULT"),"ACPTYPE") - "F11V")
-$ IF (tmp .GE. 5) THEN GOTO Beyond_depth_check
-$ IF (F$ELEMENT(max_allowed_dir_depth,".",F$ENVIRONMENT("DEFAULT")).nes.".")
-$ THEN
-$ TYPE SYS$INPUT:
-$ DECK
-%Config-E-VMS, ERROR:
- Sorry! It apears as though your perl build sub-directory is already too
- deep into the VMS file system. Please try moving stuff into a shallower
- directory (or altering the "max_allowed_dir_depth" parameter).
-$ EOD
-$ echo4 "ABORTING..."
-$ SET DEFAULT 'vms_default_directory_name' !be kind rewind
-$ STOP
-$ EXIT !2 !$STATUS = "%X00000002" (error)
-$ ENDIF
-$Beyond_depth_check:
+$!
+$ escape_extended_chars: subroutine
+$ string = 'p1' ! It's the name of the symbol
+$ chars_to_escape = p2
+$ sindex = 0
+$ slength = f$length(string)
+$ loop_over_chars:
+$ if sindex .eq. slength then goto end_loop_over_chars
+$ char = f$extract(sindex, 1, string)
+$ if f$locate(char, chars_to_escape) .lt. f$length(chars_to_escape)
+$ then
+$ string = f$extract(0, sindex, string) + "^" + f$extract(sindex,
slength, string)
+$ slength = slength + 1 ! we've increased overall length by 1
+$ sindex = sindex + 1 ! don't check the char we just escaped again
+$ endif
+$ sindex = sindex + 1
+$ goto loop_over_chars
+$ end_loop_over_chars:
+$ 'p1' == string
+$!
+$ endsubroutine
$!
$! after finding MANIFEST let's create (but not yet enter) the UU subdirectory
$!
@@ -511,6 +508,9 @@ $ line = F$EDIT(line,"TRIM, COMPRESS")
$ file_2_find = F$EXTRACT(0,F$LOCATE(" ",line),line)
$ IF F$LOCATE("/",file_2_find) .NE. F$LENGTH(file_2_find)
$ THEN
+$ escaped_fname == file_2_find
+$ call escape_extended_chars escaped_fname "~!#&\'`()+@{},;[]%^=\"
+$ file_2_find = escaped_fname
$Re_strip_line_manifest:
$ loca = F$LOCATE("/",file_2_find)
$ ante = F$EXTRACT(0,loca,file_2_find)
@@ -5533,10 +5533,9 @@ $ IF use64bitint .OR. use64bitint .EQS. "define"
$ THEN
$ ivtype = "''i64type'"
$ uvtype = "''u64type'"
-$ ELSE
-$ i64size="undef"
-$ u64size="undef"
$ ENDIF
+$ i64size="8"
+$ u64size="8"
$!
$ doublemantbits = "52"
$ IF uselongdouble .OR. uselongdouble .EQS. "define"
@@ -5550,7 +5549,6 @@ $!
$ tmp = "''ivtype'"
$ GOSUB type_size_check
$ ivsize = tmp
-$ IF use64bitint .OR. use64bitint .EQS. "define" THEN i64size = tmp
$ IF ivtype .eqs. "long"
$ THEN longsize = tmp
$ ELSE
@@ -5562,7 +5560,6 @@ $!
$ tmp = "''uvtype'"
$ GOSUB type_size_check
$ uvsize = tmp
-$ IF use64bitint .OR. use64bitint .EQS. "define" THEN u64size = tmp
$!
$ tmp = "''i8type'"
$ GOSUB type_size_check
diff --git a/cpan/Encode/Encode.pm b/cpan/Encode/Encode.pm
index bda8e1b316..57b4292279 100644
--- a/cpan/Encode/Encode.pm
+++ b/cpan/Encode/Encode.pm
@@ -1,10 +1,10 @@
#
-# $Id: Encode.pm,v 2.86 2016/08/10 18:08:01 dankogai Exp $
+# $Id: Encode.pm,v 2.88 2016/11/29 23:30:30 dankogai Exp dankogai $
#
package Encode;
use strict;
use warnings;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.86 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.88 $ =~ /(\d+)/g;
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
use XSLoader ();
XSLoader::load( __PACKAGE__, $VERSION );
@@ -15,7 +15,7 @@ use Exporter 5.57 'import';
our @EXPORT = qw(
decode decode_utf8 encode encode_utf8 str2bytes bytes2str
- encodings find_encoding clone_encoding
+ encodings find_encoding find_mime_encoding clone_encoding
);
our @FB_FLAGS = qw(
DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
@@ -102,6 +102,8 @@ sub define_encoding {
sub getEncoding {
my ( $class, $name, $skip_external ) = @_;
+ defined($name) or return;
+
$name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
ref($name) && $name->can('renew') and return $name;
@@ -130,6 +132,14 @@ sub find_encoding($;$) {
return __PACKAGE__->getEncoding( $name, $skip_external );
}
+sub find_mime_encoding($;$) {
+ my ( $mime_name, $skip_external ) = @_;
+ eval { require Encode::MIME::Name; };
+ $@ and return;
+ my $name = Encode::MIME::Name::get_encode_name( $mime_name );
+ return find_encoding( $name, $skip_external );
+}
+
sub resolve_alias($) {
my $obj = find_encoding(shift);
defined $obj and return $obj->name;
@@ -254,6 +264,7 @@ sub from_to($$$;$) {
sub encode_utf8($) {
my ($str) = @_;
+ return undef unless defined $str;
utf8::encode($str);
return $str;
}
@@ -576,6 +587,20 @@ name of the encoding object.
See L<Encode::Encoding> for details.
+=head3 find_mime_encoding
+
+ [$obj =] find_mime_encoding(MIME_ENCODING)
+
+Returns the I<encoding object> corresponding to I<MIME_ENCODING>. Acts
+same as C<find_encoding()> but C<mime_name()> of returned object must
+match to I<MIME_ENCODING>. So as opposite of C<find_encoding()>
+canonical names and aliases are not used when searching for object.
+
+ find_mime_encoding("utf8"); # returns undef because "utf8" is not valid
I<MIME_ENCODING>
+ find_mime_encoding("utf-8"); # returns encode object "utf-8-strict"
+ find_mime_encoding("UTF-8"); # same as "utf-8" because I<MIME_ENCODING> is
case insensitive
+ find_mime_encoding("utf-8-strict"); returns undef because "utf-8-strict"
is not valid I<MIME_ENCODING>
+
=head3 from_to
[$length =] from_to($octets, FROM_ENC, TO_ENC [, CHECK])
diff --git a/cpan/Encode/Encode.xs b/cpan/Encode/Encode.xs
index 222f39b2ea..b5160d2516 100644
--- a/cpan/Encode/Encode.xs
+++ b/cpan/Encode/Encode.xs
@@ -1,5 +1,5 @@
/*
- $Id: Encode.xs,v 2.37 2016/08/10 18:08:45 dankogai Exp dankogai $
+ $Id: Encode.xs,v 2.39 2016/11/29 23:29:23 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
@@ -31,6 +31,10 @@
UNIMPLEMENTED(_encoded_utf8_to_bytes, I32)
UNIMPLEMENTED(_encoded_bytes_to_utf8, I32)
+#ifndef SvIV_nomg
+#define SvIV_nomg SvIV
+#endif
+
#ifdef UTF8_DISALLOW_ILLEGAL_INTERCHANGE
# define UTF8_ALLOW_STRICT UTF8_DISALLOW_ILLEGAL_INTERCHANGE
#else
@@ -76,6 +80,37 @@ call_failure(SV * routine, U8 * done, U8 * dest, U8 * orig)
PERL_UNUSED_VAR(orig);
}
+static void
+utf8_safe_downgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool modify)
+{
+ if (!modify) {
+ SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen));
+ SvUTF8_on(tmp);
+ if (SvTAINTED(*src))
+ SvTAINTED_on(tmp);
+ *src = tmp;
+ *s = (U8 *)SvPVX(*src);
+ }
+ if (*slen) {
+ if (!utf8_to_bytes(*s, slen))
+ croak("Wide character");
+ SvCUR_set(*src, *slen);
+ }
+ SvUTF8_off(*src);
+}
+
+static void
+utf8_safe_upgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool modify)
+{
+ if (!modify) {
+ SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen));
+ if (SvTAINTED(*src))
+ SvTAINTED_on(tmp);
+ *src = tmp;
+ }
+ sv_utf8_upgrade_nomg(*src);
+ *s = (U8 *)SvPV_nomg(*src, *slen);
+}
#define ERR_ENCODE_NOMAP "\"\\x{%04" UVxf "}\" does not map to %s"
#define ERR_DECODE_NOMAP "%s \"\\x%02" UVXf "\" does not map to Unicode"
@@ -104,18 +139,16 @@ do_fallback_cb(pTHX_ UV ch, SV *fallback_cb)
}
static SV *
-encode_method(pTHX_ const encode_t * enc, const encpage_t * dir, SV * src,
+encode_method(pTHX_ const encode_t * enc, const encpage_t * dir, SV * src, U8
* s, STRLEN slen,
int check, STRLEN * offset, SV * term, int * retcode,
SV *fallback_cb)
{
- STRLEN slen;
- U8 *s = (U8 *) SvPV(src, slen);
STRLEN tlen = slen;
STRLEN ddone = 0;
STRLEN sdone = 0;
/* We allocate slen+1.
PerlIO dumps core if this value is smaller than this. */
- SV *dst = sv_2mortal(newSV(slen+1));
+ SV *dst = newSV(slen+1);
U8 *d = (U8 *)SvPVX(dst);
STRLEN dlen = SvLEN(dst)-1;
int code = 0;
@@ -191,10 +224,10 @@ encode_method(pTHX_ const encode_t * enc, const encpage_t
* dir, SV * src,
if (dir == enc->f_utf8) {
STRLEN clen;
UV ch =
- utf8n_to_uvuni(s+slen, (SvCUR(src)-slen),
+ utf8n_to_uvuni(s+slen, (tlen-sdone-slen),
&clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY);
/* if non-representable multibyte prefix at end of current buffer -
break*/
- if (clen > tlen - sdone) break;
+ if (clen > tlen - sdone - slen) break;
if (check & ENCODE_DIE_ON_ERR) {
Perl_croak(aTHX_ ERR_ENCODE_NOMAP,
(UV)ch, enc->name[0]);
@@ -211,7 +244,7 @@ encode_method(pTHX_ const encode_t * enc, const encpage_t *
dir, SV * src,
SV* subchar =
(fallback_cb != &PL_sv_undef)
? do_fallback_cb(aTHX_ ch, fallback_cb)
- : newSVpvf(check & ENCODE_PERLQQ ? "\\x{%04"UVxf"}" :
+ : newSVpvf(check & ENCODE_PERLQQ ? "\\x{%04" UVxf "}" :
check & ENCODE_HTMLCREF ? "&#%" UVuf ";" :
"&#x%" UVxf ";", (UV)ch);
SvUTF8_off(subchar); /* make sure no decoded string gets in */
@@ -279,6 +312,7 @@ encode_method(pTHX_ const encode_t * enc, const encpage_t *
dir, SV * src,
sv_setpvn(src, (char*)s+slen, sdone);
}
SvCUR_set(src, sdone);
+ SvSETMAGIC(src);
}
/* warn("check = 0x%X, code = 0x%d\n", check, code); */
@@ -318,6 +352,62 @@ strict_utf8(pTHX_ SV* sv)
return SvTRUE(*svp);
}
+/*
+ * https://github.com/dankogai/p5-encode/pull/56#issuecomment-231959126
+ */
+#ifndef UNICODE_IS_NONCHAR
+#define UNICODE_IS_NONCHAR(c) ((c >= 0xFDD0 && c <= 0xFDEF) || (c & 0xFFFE) ==
0xFFFE)
+#endif
+
+#ifndef UNICODE_IS_SUPER
+#define UNICODE_IS_SUPER(c) (c > PERL_UNICODE_MAX)
+#endif
+
+#define UNICODE_IS_STRICT(c) (!UNICODE_IS_SURROGATE(c) &&
!UNICODE_IS_NONCHAR(c) && !UNICODE_IS_SUPER(c))
+
+#ifndef UTF_ACCUMULATION_OVERFLOW_MASK
+#ifndef CHARBITS
+#define CHARBITS CHAR_BIT
+#endif
+#define UTF_ACCUMULATION_OVERFLOW_MASK (((UV) UTF_CONTINUATION_MASK) <<
((sizeof(UV) * CHARBITS) - UTF_ACCUMULATION_SHIFT))
+#endif
+
+/*
+ * Convert non strict utf8 sequence of len >= 2 to unicode codepoint
+ */
+static UV
+convert_utf8_multi_seq(U8* s, STRLEN len, STRLEN *rlen)
+{
+ UV uv;
+ U8 *ptr = s;
+ bool overflowed = 0;
+
+ uv = NATIVE_TO_UTF(*s) & UTF_START_MASK(len);
+
+ len--;
+ s++;
+
+ while (len--) {
+ if (!UTF8_IS_CONTINUATION(*s)) {
+ *rlen = s-ptr;
+ return 0;
+ }
+ if (uv & UTF_ACCUMULATION_OVERFLOW_MASK)
+ overflowed = 1;
+ uv = UTF8_ACCUMULATE(uv, *s);
+ s++;
+ }
+
+ *rlen = s-ptr;
+
+ if (overflowed || *rlen > (STRLEN)UNISKIP(uv)) {
+ *rlen = 1;
+ return 0;
+ }
+
+ return uv;
+}
+
static U8*
process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
bool encode, bool strict, bool stop_at_partial)
@@ -336,7 +426,7 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
}
else {
fallback_cb = &PL_sv_undef;
- check = SvIV(check_sv);
+ check = SvIV_nomg(check_sv);
}
SvPOK_only(dst);
@@ -351,39 +441,30 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
continue;
}
+ ulen = 1;
if (UTF8_IS_START(*s)) {
U8 skip = UTF8SKIP(s);
if ((s + skip) > e) {
if (stop_at_partial || (check & ENCODE_STOP_AT_PARTIAL)) {
const U8 *p = s + 1;
for (; p < e; p++) {
- if (!UTF8_IS_CONTINUATION(*p))
+ if (!UTF8_IS_CONTINUATION(*p)) {
+ ulen = p-s;
goto malformed_byte;
+ }
}
break;
}
+ ulen = e-s;
goto malformed_byte;
}
- uv = utf8n_to_uvuni(s, e - s, &ulen,
- UTF8_CHECK_ONLY | (strict ? UTF8_ALLOW_STRICT :
-
UTF8_ALLOW_NONSTRICT)
- );
-#if 1 /* perl-5.8.6 and older do not check UTF8_ALLOW_LONG */
- if (strict && uv > PERL_UNICODE_MAX)
- ulen = (STRLEN) -1;
-#endif
- if (ulen == (STRLEN) -1) {
- if (strict) {
- uv = utf8n_to_uvuni(s, e - s, &ulen,
- UTF8_CHECK_ONLY |
UTF8_ALLOW_NONSTRICT);
- if (ulen == (STRLEN) -1)
- goto malformed_byte;
- goto malformed;
- }
+ uv = convert_utf8_multi_seq(s, skip, &ulen);
+ if (uv == 0)
goto malformed_byte;
- }
+ else if (strict && !UNICODE_IS_STRICT(uv))
+ goto malformed;
/* Whole char is good */
@@ -396,7 +477,8 @@ process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
/* If we get here there is something wrong with alleged UTF-8 */
malformed_byte:
uv = (UV)*s;
- ulen = 1;
+ if (ulen == 0)
+ ulen = 1;
malformed:
if (check & ENCODE_DIE_ON_ERR){
@@ -456,10 +538,6 @@ MODULE = Encode PACKAGE = Encode::utf8 PREFIX
= Method_
PROTOTYPES: DISABLE
-#ifndef SvIsCOW
-# define SvIsCOW(sv) (SvREADONLY(sv) && SvFAKE(sv))
-#endif
-
void
Method_decode_xs(obj,src,check_sv = &PL_sv_no)
SV * obj
@@ -472,23 +550,26 @@ PREINIT:
SV *dst;
bool renewed = 0;
int check;
+ bool modify;
+INIT:
+ SvGETMAGIC(src);
+ SvGETMAGIC(check_sv);
+ check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC :
SvIV_nomg(check_sv);
+ modify = (check && !(check & ENCODE_LEAVE_SRC));
CODE:
{
- dSP; ENTER; SAVETMPS;
- if (src == &PL_sv_undef || SvROK(src)) src = sv_2mortal(newSV(0));
- check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
- if (!(check & ENCODE_LEAVE_SRC) && SvIsCOW(src)) {
- /*
- * disassociate from any other scalars before doing
- * in-place modifications
- */
- sv_force_normal(src);
- }
- s = (U8 *) SvPV(src, slen);
- e = (U8 *) SvEND(src);
+ dSP;
+ if (!SvOK(src))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
+ if (SvUTF8(src))
+ utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
+ e = s+slen;
+
/*
* PerlIO check -- we assume the object is of PerlIO if renewed
*/
+ ENTER; SAVETMPS;
PUSHMARK(sp);
XPUSHs(obj);
PUTBACK;
@@ -503,28 +584,17 @@ CODE:
FREETMPS; LEAVE;
/* end PerlIO check */
- if (SvUTF8(src)) {
- s = utf8_to_bytes(s,&slen);
- if (s) {
- SvCUR_set(src,slen);
- SvUTF8_off(src);
- e = s+slen;
- }
- else {
- croak("Cannot decode string with wide characters");
- }
- }
-
dst = sv_2mortal(newSV(slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
s = process_utf8(aTHX_ dst, s, e, check_sv, 0, strict_utf8(aTHX_ obj),
renewed);
/* Clear out translated part of source unless asked not to */
- if (check && !(check & ENCODE_LEAVE_SRC)){
+ if (modify) {
slen = e-s;
if (slen) {
sv_setpvn(src, (char*)s, slen);
}
SvCUR_set(src, slen);
+ SvSETMAGIC(src);
}
SvUTF8_on(dst);
if (SvTAINTED(src)) SvTAINTED_on(dst); /* propagate taintedness */
@@ -543,12 +613,18 @@ PREINIT:
U8 *e;
SV *dst;
int check;
+ bool modify;
+INIT:
+ SvGETMAGIC(src);
+ SvGETMAGIC(check_sv);
+ check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC :
SvIV_nomg(check_sv);
+ modify = (check && !(check & ENCODE_LEAVE_SRC));
CODE:
{
- check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC : SvIV(check_sv);
- if (src == &PL_sv_undef || SvROK(src)) src = sv_2mortal(newSV(0));
- s = (U8 *) SvPV(src, slen);
- e = (U8 *) SvEND(src);
+ if (!SvOK(src))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
+ e = s+slen;
dst = sv_2mortal(newSV(slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
if (SvUTF8(src)) {
/* Already encoded */
@@ -584,12 +660,13 @@ CODE:
}
/* Clear out translated part of source unless asked not to */
- if (check && !(check & ENCODE_LEAVE_SRC)){
+ if (modify) {
slen = e-s;
if (slen) {
sv_setpvn(src, (char*)s, slen);
}
SvCUR_set(src, slen);
+ SvSETMAGIC(src);
}
SvPOK_only(dst);
SvUTF8_off(dst);
@@ -638,24 +715,35 @@ SV * src
SV * off
SV * term
SV * check_sv
-CODE:
-{
+PREINIT:
int check;
- SV *fallback_cb = &PL_sv_undef;
- encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
- STRLEN offset = (STRLEN)SvIV(off);
+ SV *fallback_cb;
+ bool modify;
+ encode_t *enc;
+ STRLEN offset;
int code = 0;
- if (SvUTF8(src)) {
- sv_utf8_downgrade(src, FALSE);
- }
- if (SvROK(check_sv)){
- fallback_cb = check_sv;
- check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as FB_PERLQQ */
- }else{
- check = SvIV(check_sv);
- }
- sv_catsv(dst, encode_method(aTHX_ enc, enc->t_utf8, src, check,
- &offset, term, &code, fallback_cb));
+ U8 *s;
+ STRLEN slen;
+ SV *tmp;
+INIT:
+ SvGETMAGIC(src);
+ SvGETMAGIC(check_sv);
+ check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC :
SvIV_nomg(check_sv);
+ fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
+ modify = (check && !(check & ENCODE_LEAVE_SRC));
+ enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
+ offset = (STRLEN)SvIV(off);
+CODE:
+{
+ if (!SvOK(src))
+ XSRETURN_NO;
+ s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
+ if (SvUTF8(src))
+ utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
+ tmp = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
+ &offset, term, &code, fallback_cb);
+ sv_catsv(dst, tmp);
+ SvREFCNT_dec(tmp);
SvIV_set(off, (IV)offset);
if (code == ENCODE_FOUND_TERM) {
ST(0) = &PL_sv_yes;
@@ -665,79 +753,70 @@ CODE:
XSRETURN(1);
}
-void
+SV *
Method_decode(obj,src,check_sv = &PL_sv_no)
SV * obj
SV * src
SV * check_sv
+PREINIT:
+ int check;
+ SV *fallback_cb;
+ bool modify;
+ encode_t *enc;
+ U8 *s;
+ STRLEN slen;
+INIT:
+ SvGETMAGIC(src);
+ SvGETMAGIC(check_sv);
+ check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC :
SvIV_nomg(check_sv);
+ fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
+ modify = (check && !(check & ENCODE_LEAVE_SRC));
+ enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
CODE:
{
- int check;
- SV *fallback_cb = &PL_sv_undef;
- encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
- if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) {
- SV *tmp;
- tmp = sv_newmortal();
- sv_copypv(tmp, src);
- src = tmp;
- }
- if (SvUTF8(src)) {
- sv_utf8_downgrade(src, FALSE);
- }
- if (SvROK(check_sv)){
- fallback_cb = check_sv;
- check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as FB_PERLQQ */
- }else{
- check = SvIV(check_sv);
- }
- ST(0) = encode_method(aTHX_ enc, enc->t_utf8, src, check,
+ if (!SvOK(src))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
+ if (SvUTF8(src))
+ utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
+ RETVAL = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
NULL, Nullsv, NULL, fallback_cb);
- SvUTF8_on(ST(0));
- XSRETURN(1);
+ SvUTF8_on(RETVAL);
}
+OUTPUT:
+ RETVAL
-
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
-#endif
-
-#ifndef SvPV_force_flags_nolen
-# define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, &PL_na, flags))
-#endif
-
-void
+SV *
Method_encode(obj,src,check_sv = &PL_sv_no)
SV * obj
SV * src
SV * check_sv
+PREINIT:
+ int check;
+ SV *fallback_cb;
+ bool modify;
+ encode_t *enc;
+ U8 *s;
+ STRLEN slen;
+INIT:
+ SvGETMAGIC(src);
+ SvGETMAGIC(check_sv);
+ check = SvROK(check_sv) ? ENCODE_PERLQQ|ENCODE_LEAVE_SRC :
SvIV_nomg(check_sv);
+ fallback_cb = SvROK(check_sv) ? check_sv : &PL_sv_undef;
+ modify = (check && !(check & ENCODE_LEAVE_SRC));
+ enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
CODE:
{
- int check;
- SV *fallback_cb = &PL_sv_undef;
- encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
- if (SvREADONLY(src) || SvSMAGICAL(src) || SvGMAGICAL(src) || !SvPOK(src)) {
- /*
- SV *tmp;
- tmp = sv_newmortal();
- sv_copypv(tmp, src);
- src = tmp;
- */
- src = sv_mortalcopy(src);
- SvPV_force_nolen(src);
- }
- sv_utf8_upgrade(src);
- if (SvROK(check_sv)){
- fallback_cb = check_sv;
- check = ENCODE_PERLQQ|ENCODE_LEAVE_SRC; /* same as FB_PERLQQ */
- }else{
- check = SvIV(check_sv);
- }
- ST(0) = encode_method(aTHX_ enc, enc->f_utf8, src, check,
+ if (!SvOK(src))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(src, slen) : (U8 *)SvPV_nomg(src, slen);
+ if (!SvUTF8(src))
+ utf8_safe_upgrade(aTHX_ &src, &s, &slen, modify);
+ RETVAL = encode_method(aTHX_ enc, enc->f_utf8, src, s, slen, check,
NULL, Nullsv, NULL, fallback_cb);
- XSRETURN(1);
}
+OUTPUT:
+ RETVAL
void
Method_needs_lines(obj)
@@ -753,6 +832,8 @@ CODE:
void
Method_perlio_ok(obj)
SV * obj
+PREINIT:
+ SV *sv;
CODE:
{
/* encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj))); */
@@ -762,7 +843,8 @@ CODE:
eval_pv("require PerlIO::encoding", 0);
SPAGAIN;
- if (SvTRUE(get_sv("@", 0))) {
+ sv = get_sv("@", 0);
+ if (SvTRUE(sv)) {
ST(0) = &PL_sv_no;
}else{
ST(0) = &PL_sv_yes;
@@ -773,6 +855,8 @@ CODE:
void
Method_mime_name(obj)
SV * obj
+PREINIT:
+ SV *sv;
CODE:
{
encode_t *enc = INT2PTR(encode_t *, SvIV(SvRV(obj)));
@@ -780,7 +864,8 @@ CODE:
eval_pv("require Encode::MIME::Name", 0);
SPAGAIN;
- if (SvTRUE(get_sv("@", 0))) {
+ sv = get_sv("@", 0);
+ if (SvTRUE(sv)) {
ST(0) = &PL_sv_undef;
}else{
ENTER;
@@ -903,17 +988,16 @@ bool
is_utf8(sv, check = 0)
SV * sv
int check
+PREINIT:
+ char *str;
+ STRLEN len;
CODE:
{
- if (SvGMAGICAL(sv)) /* it could be $1, for example */
- sv = newSVsv(sv); /* GMAGIG will be done */
+ SvGETMAGIC(sv); /* SvGETMAGIC() can modify SvOK flag */
+ str = SvOK(sv) ? SvPV_nomg(sv, len) : NULL; /* SvPV() can modify SvUTF8
flag */
RETVAL = SvUTF8(sv) ? TRUE : FALSE;
- if (RETVAL &&
- check &&
- !is_utf8_string((U8*)SvPVX(sv), SvCUR(sv)))
+ if (RETVAL && check && (!str || !is_utf8_string((U8 *)str, len)))
RETVAL = FALSE;
- if (sv != ST(0))
- SvREFCNT_dec(sv); /* it was a temp copy */
}
OUTPUT:
RETVAL
@@ -923,13 +1007,14 @@ _utf8_on(sv)
SV * sv
CODE:
{
- if (SvPOK(sv)) {
- SV *rsv = newSViv(SvUTF8(sv));
- RETVAL = rsv;
- if (SvIsCOW(sv)) sv_force_normal(sv);
- SvUTF8_on(sv);
+ SvGETMAGIC(sv);
+ if (!SvTAINTED(sv) && SvPOKp(sv)) {
+ if (SvTHINKFIRST(sv)) sv_force_normal(sv);
+ RETVAL = newSViv(SvUTF8(sv));
+ SvUTF8_on(sv);
+ SvSETMAGIC(sv);
} else {
- RETVAL = &PL_sv_undef;
+ RETVAL = &PL_sv_undef;
}
}
OUTPUT:
@@ -940,124 +1025,38 @@ _utf8_off(sv)
SV * sv
CODE:
{
- if (SvPOK(sv)) {
- SV *rsv = newSViv(SvUTF8(sv));
- RETVAL = rsv;
- if (SvIsCOW(sv)) sv_force_normal(sv);
- SvUTF8_off(sv);
+ SvGETMAGIC(sv);
+ if (!SvTAINTED(sv) && SvPOKp(sv)) {
+ if (SvTHINKFIRST(sv)) sv_force_normal(sv);
+ RETVAL = newSViv(SvUTF8(sv));
+ SvUTF8_off(sv);
+ SvSETMAGIC(sv);
} else {
- RETVAL = &PL_sv_undef;
+ RETVAL = &PL_sv_undef;
}
}
OUTPUT:
RETVAL
-int
-DIE_ON_ERR()
-CODE:
- RETVAL = ENCODE_DIE_ON_ERR;
-OUTPUT:
- RETVAL
-
-int
-WARN_ON_ERR()
-CODE:
- RETVAL = ENCODE_WARN_ON_ERR;
-OUTPUT:
- RETVAL
-
-int
-LEAVE_SRC()
-CODE:
- RETVAL = ENCODE_LEAVE_SRC;
-OUTPUT:
- RETVAL
-
-int
-RETURN_ON_ERR()
-CODE:
- RETVAL = ENCODE_RETURN_ON_ERR;
-OUTPUT:
- RETVAL
-
-int
-PERLQQ()
-CODE:
- RETVAL = ENCODE_PERLQQ;
-OUTPUT:
- RETVAL
-
-int
-HTMLCREF()
-CODE:
- RETVAL = ENCODE_HTMLCREF;
-OUTPUT:
- RETVAL
-
-int
-XMLCREF()
-CODE:
- RETVAL = ENCODE_XMLCREF;
-OUTPUT:
- RETVAL
-
-int
-STOP_AT_PARTIAL()
-CODE:
- RETVAL = ENCODE_STOP_AT_PARTIAL;
-OUTPUT:
- RETVAL
-
-int
-FB_DEFAULT()
-CODE:
- RETVAL = ENCODE_FB_DEFAULT;
-OUTPUT:
- RETVAL
-
-int
-FB_CROAK()
-CODE:
- RETVAL = ENCODE_FB_CROAK;
-OUTPUT:
- RETVAL
-
-int
-FB_QUIET()
-CODE:
- RETVAL = ENCODE_FB_QUIET;
-OUTPUT:
- RETVAL
-
-int
-FB_WARN()
-CODE:
- RETVAL = ENCODE_FB_WARN;
-OUTPUT:
- RETVAL
-
-int
-FB_PERLQQ()
-CODE:
- RETVAL = ENCODE_FB_PERLQQ;
-OUTPUT:
- RETVAL
-
-int
-FB_HTMLCREF()
-CODE:
- RETVAL = ENCODE_FB_HTMLCREF;
-OUTPUT:
- RETVAL
-
-int
-FB_XMLCREF()
-CODE:
- RETVAL = ENCODE_FB_XMLCREF;
-OUTPUT:
- RETVAL
-
BOOT:
{
+ HV *stash = gv_stashpvn("Encode", strlen("Encode"), GV_ADD);
+ newCONSTSUB(stash, "DIE_ON_ERR", newSViv(ENCODE_DIE_ON_ERR));
+ newCONSTSUB(stash, "WARN_ON_ERR", newSViv(ENCODE_WARN_ON_ERR));
+ newCONSTSUB(stash, "RETURN_ON_ERR", newSViv(ENCODE_RETURN_ON_ERR));
+ newCONSTSUB(stash, "LEAVE_SRC", newSViv(ENCODE_LEAVE_SRC));
+ newCONSTSUB(stash, "PERLQQ", newSViv(ENCODE_PERLQQ));
+ newCONSTSUB(stash, "HTMLCREF", newSViv(ENCODE_HTMLCREF));
+ newCONSTSUB(stash, "XMLCREF", newSViv(ENCODE_XMLCREF));
+ newCONSTSUB(stash, "STOP_AT_PARTIAL", newSViv(ENCODE_STOP_AT_PARTIAL));
+ newCONSTSUB(stash, "FB_DEFAULT", newSViv(ENCODE_FB_DEFAULT));
+ newCONSTSUB(stash, "FB_CROAK", newSViv(ENCODE_FB_CROAK));
+ newCONSTSUB(stash, "FB_QUIET", newSViv(ENCODE_FB_QUIET));
+ newCONSTSUB(stash, "FB_WARN", newSViv(ENCODE_FB_WARN));
+ newCONSTSUB(stash, "FB_PERLQQ", newSViv(ENCODE_FB_PERLQQ));
+ newCONSTSUB(stash, "FB_HTMLCREF", newSViv(ENCODE_FB_HTMLCREF));
+ newCONSTSUB(stash, "FB_XMLCREF", newSViv(ENCODE_FB_XMLCREF));
+}
+{
#include "def_t.exh"
}
diff --git a/cpan/Encode/Encode/_T.e2x b/cpan/Encode/Encode/_T.e2x
index 6cf5f293d5..7b9a67e43d 100644
--- a/cpan/Encode/Encode/_T.e2x
+++ b/cpan/Encode/Encode/_T.e2x
@@ -2,6 +2,8 @@ use strict;
# Adjust the number here!
use Test::More tests => 2;
-use_ok('Encode');
-use_ok('Encode::$_Name_');
+BEGIN {
+ use_ok('Encode');
+ use_ok('Encode::$_Name_');
+}
# Add more test here!
diff --git a/cpan/Encode/Makefile.PL b/cpan/Encode/Makefile.PL
index c87153bbb3..8203105247 100644
--- a/cpan/Encode/Makefile.PL
+++ b/cpan/Encode/Makefile.PL
@@ -1,16 +1,26 @@
#
-# $Id: Makefile.PL,v 2.17 2016/08/04 03:15:58 dankogai Exp $
+# $Id: Makefile.PL,v 2.18 2016/11/29 23:29:23 dankogai Exp dankogai $
#
use 5.007003;
use strict;
use warnings;
use ExtUtils::MakeMaker;
use File::Spec;
+use Config;
# Just for sure :)
my %ARGV = map { my @r = split /=/,$_; defined $r[1] or $r[1]=1; @r } @ARGV;
$ARGV{DEBUG} and warn "$_ => $ARGV{$_}\n" for sort keys %ARGV;
$ENV{PERL_CORE} ||= $ARGV{PERL_CORE} if $ARGV{PERL_CORE};
+# similar strictness as in core
+my $ccflags = $Config{ccflags};
+if (!$ENV{PERL_CORE}) {
+ if ($Config{gccversion}) {
+ $ccflags .= ' -Werror=declaration-after-statement';
+ $ccflags .= ' -Wpointer-sign' unless $Config{d_cplusplus};
+ $ccflags .= ' -fpermissive' if $Config{d_cplusplus};
+ }
+}
my %tables =
(
@@ -45,6 +55,7 @@ WriteMakefile(
SUFFIX => 'gz',
DIST_DEFAULT => 'all tardist',
},
+ CCFLAGS => $ccflags,
INC => '-I' . File::Spec->catfile( '.', 'Encode' ),
LICENSE => 'perl',
PREREQ_PM => {
diff --git a/cpan/Encode/Unicode/Makefile.PL b/cpan/Encode/Unicode/Makefile.PL
index ce48b7aace..b28d16bb96 100644
--- a/cpan/Encode/Unicode/Makefile.PL
+++ b/cpan/Encode/Unicode/Makefile.PL
@@ -3,7 +3,7 @@ use strict;
use ExtUtils::MakeMaker;
WriteMakefile(
- INC => "-I../Encode",
+ INC => "-I../Encode",
NAME => 'Encode::Unicode',
VERSION_FROM => "Unicode.pm",
MAN3PODS => {},
diff --git a/cpan/Encode/Unicode/Unicode.pm b/cpan/Encode/Unicode/Unicode.pm
index 7dec3e3815..fc1d3d1382 100644
--- a/cpan/Encode/Unicode/Unicode.pm
+++ b/cpan/Encode/Unicode/Unicode.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
no warnings 'redefine';
-our $VERSION = do { my @r = ( q$Revision: 2.15 $ =~ /\d+/g ); sprintf "%d." .
"%02d" x $#r, @r };
+our $VERSION = do { my @r = ( q$Revision: 2.15_01 $ =~ /\d+/g ); sprintf "%d."
. "%02d" x $#r, @r };
use XSLoader;
XSLoader::load( __PACKAGE__, $VERSION );
diff --git a/cpan/Encode/Unicode/Unicode.xs b/cpan/Encode/Unicode/Unicode.xs
index 3bad2adae0..117e14d83f 100644
--- a/cpan/Encode/Unicode/Unicode.xs
+++ b/cpan/Encode/Unicode/Unicode.xs
@@ -1,5 +1,5 @@
/*
- $Id: Unicode.xs,v 2.14 2016/01/22 06:33:07 dankogai Exp $
+ $Id: Unicode.xs,v 2.15 2016/11/29 23:29:23 dankogai Exp dankogai $
*/
#define PERL_NO_GET_CONTEXT
@@ -125,8 +125,6 @@ PROTOTYPES: DISABLE
#define attr(k, l) (hv_exists((HV *)SvRV(obj),k,l) ? \
*hv_fetch((HV *)SvRV(obj),k,l,0) : &PL_sv_undef)
-#define attr_true(k, l) (hv_exists((HV *)SvRV(obj),k,l) ? \
- SvTRUE(*hv_fetch((HV *)SvRV(obj),k,l,0)) : FALSE)
void
decode_xs(obj, str, check = 0)
@@ -135,26 +133,54 @@ SV * str
IV check
CODE:
{
- U8 endian = *((U8 *)SvPV_nolen(attr("endian", 6)));
- int size = SvIV(attr("size", 4));
+ SV *sve = attr("endian", 6);
+ U8 endian = *((U8 *)SvPV_nolen(sve));
+ SV *svs = attr("size", 4);
+ int size = SvIV(svs);
int ucs2 = -1; /* only needed in the event of surrogate pairs */
SV *result = newSVpvn("",0);
STRLEN usize = (size > 0 ? size : 1); /* protect against rogue size<=0 */
STRLEN ulen;
STRLEN resultbuflen;
U8 *resultbuf;
- U8 *s = (U8 *)SvPVbyte(str,ulen);
- U8 *e = (U8 *)SvEND(str);
+ U8 *s;
+ U8 *e;
+ bool modify = (check && !(check & ENCODE_LEAVE_SRC));
+ bool temp_result;
+
+ SvGETMAGIC(str);
+ if (!SvOK(str))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(str, ulen) : (U8 *)SvPV_nomg(str, ulen);
+ if (SvUTF8(str)) {
+ if (!modify) {
+ SV *tmp = sv_2mortal(newSVpvn((char *)s, ulen));
+ SvUTF8_on(tmp);
+ if (SvTAINTED(str))
+ SvTAINTED_on(tmp);
+ str = tmp;
+ s = (U8 *)SvPVX(str);
+ }
+ if (ulen) {
+ if (!utf8_to_bytes(s, &ulen))
+ croak("Wide character");
+ SvCUR_set(str, ulen);
+ }
+ SvUTF8_off(str);
+ }
+ e = s+ulen;
+
/* Optimise for the common case of being called from PerlIOEncode_fill()
with a standard length buffer. In this case the result SV's buffer is
only used temporarily, so we can afford to allocate the maximum needed
and not care about unused space. */
- const bool temp_result = (ulen == PERLIO_BUFSIZ);
+ temp_result = (ulen == PERLIO_BUFSIZ);
ST(0) = sv_2mortal(result);
SvUTF8_on(result);
if (!endian && s+size <= e) {
+ SV *sv;
UV bom;
endian = (size == 4) ? 'N' : 'n';
bom = enc_unpack(aTHX_ &s,e,size,endian);
@@ -183,8 +209,9 @@ CODE:
}
#if 1
/* Update endian for next sequence */
- if (attr_true("renewed", 7)) {
- hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+ sv = attr("renewed", 7);
+ if (SvTRUE(sv)) {
+ (void)hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char
*)&endian,1),0);
}
#endif
}
@@ -202,11 +229,12 @@ CODE:
U8 *d;
if (issurrogate(ord)) {
if (ucs2 == -1) {
- ucs2 = attr_true("ucs2", 4);
+ SV *sv = attr("ucs2", 4);
+ ucs2 = SvTRUE(sv);
}
if (ucs2 || size == 4) {
if (check) {
- croak("%"SVf":no surrogates allowed %"UVxf,
+ croak("%" SVf ":no surrogates allowed %" UVxf,
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
}
@@ -216,7 +244,7 @@ CODE:
UV lo;
if (!isHiSurrogate(ord)) {
if (check) {
- croak("%"SVf":Malformed HI surrogate %"UVxf,
+ croak("%" SVf ":Malformed HI surrogate %" UVxf,
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
}
@@ -231,7 +259,7 @@ CODE:
break;
}
else {
- croak("%"SVf":Malformed HI surrogate %"UVxf,
+ croak("%" SVf ":Malformed HI surrogate %" UVxf,
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
}
@@ -244,7 +272,7 @@ CODE:
lo = enc_unpack(aTHX_ &s,e,size,endian);
if (!isLoSurrogate(lo)) {
if (check) {
- croak("%"SVf":Malformed LO surrogate %"UVxf,
+ croak("%" SVf ":Malformed LO surrogate %" UVxf,
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
}
@@ -262,7 +290,7 @@ CODE:
if ((ord & 0xFFFE) == 0xFFFE || (ord >= 0xFDD0 && ord <= 0xFDEF)) {
if (check) {
- croak("%"SVf":Unicode character %"UVxf" is illegal",
+ croak("%" SVf ":Unicode character %" UVxf " is illegal",
*hv_fetch((HV *)SvRV(obj),"Name",4,0),
ord);
} else {
@@ -295,7 +323,7 @@ CODE:
if (s < e) {
/* unlikely to happen because it's fixed-length -- dankogai */
if (check & ENCODE_WARN_ON_ERR) {
- Perl_warner(aTHX_ packWARN(WARN_UTF8),"%"SVf":Partial character",
+ Perl_warner(aTHX_ packWARN(WARN_UTF8),"%" SVf ":Partial character",
*hv_fetch((HV *)SvRV(obj),"Name",4,0));
}
}
@@ -308,6 +336,7 @@ CODE:
SvCUR_set(str,0);
}
*SvEND(str) = '\0';
+ SvSETMAGIC(str);
}
if (!temp_result) shrink_buffer(result);
@@ -322,19 +351,40 @@ SV * utf8
IV check
CODE:
{
- U8 endian = *((U8 *)SvPV_nolen(attr("endian", 6)));
- const int size = SvIV(attr("size", 4));
+ SV *sve = attr("endian", 6);
+ U8 endian = *((U8 *)SvPV_nolen(sve));
+ SV *svs = attr("size", 4);
+ const int size = SvIV(svs);
int ucs2 = -1; /* only needed if there is invalid_ucs2 input */
const STRLEN usize = (size > 0 ? size : 1);
SV *result = newSVpvn("", 0);
STRLEN ulen;
- U8 *s = (U8 *) SvPVutf8(utf8, ulen);
- const U8 *e = (U8 *) SvEND(utf8);
+ U8 *s;
+ U8 *e;
+ bool modify = (check && !(check & ENCODE_LEAVE_SRC));
+ bool temp_result;
+
+ SvGETMAGIC(utf8);
+ if (!SvOK(utf8))
+ XSRETURN_UNDEF;
+ s = modify ? (U8 *)SvPV_force_nomg(utf8, ulen) : (U8 *)SvPV_nomg(utf8,
ulen);
+ if (!SvUTF8(utf8)) {
+ if (!modify) {
+ SV *tmp = sv_2mortal(newSVpvn((char *)s, ulen));
+ if (SvTAINTED(utf8))
+ SvTAINTED_on(tmp);
+ utf8 = tmp;
+ }
+ sv_utf8_upgrade_nomg(utf8);
+ s = (U8 *)SvPV_nomg(utf8, ulen);
+ }
+ e = s+ulen;
+
/* Optimise for the common case of being called from PerlIOEncode_flush()
with a standard length buffer. In this case the result SV's buffer is
only used temporarily, so we can afford to allocate the maximum needed
and not care about unused space. */
- const bool temp_result = (ulen == PERLIO_BUFSIZ);
+ temp_result = (ulen == PERLIO_BUFSIZ);
ST(0) = sv_2mortal(result);
@@ -344,12 +394,14 @@ CODE:
SvGROW(result, ((ulen+1) * usize));
if (!endian) {
+ SV *sv;
endian = (size == 4) ? 'N' : 'n';
enc_pack(aTHX_ result,size,endian,BOM_BE);
#if 1
/* Update endian for next sequence */
- if (attr_true("renewed", 7)) {
- hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char *)&endian,1),0);
+ sv = attr("renewed", 7);
+ if (SvTRUE(sv)) {
+ (void)hv_store((HV *)SvRV(obj),"endian",6,newSVpv((char
*)&endian,1),0);
}
#endif
}
@@ -364,11 +416,12 @@ CODE:
if (size != 4 && invalid_ucs2(ord)) {
if (!issurrogate(ord)) {
if (ucs2 == -1) {
- ucs2 = attr_true("ucs2", 4);
+ SV *sv = attr("ucs2", 4);
+ ucs2 = SvTRUE(sv);
}
if (ucs2 || ord > 0x10FFFF) {
if (check) {
- croak("%"SVf":code point \"\\x{%"UVxf"}\" too high",
+ croak("%" SVf ":code point \"\\x{%" UVxf "}\" too high",
*hv_fetch((HV *)SvRV(obj),"Name",4,0),ord);
}
enc_pack(aTHX_ result,size,endian,FBCHAR);
@@ -394,7 +447,7 @@ CODE:
But this is critical when you choose to LEAVE_SRC
in which case we die */
if (check & (ENCODE_DIE_ON_ERR|ENCODE_LEAVE_SRC)) {
- Perl_croak(aTHX_ "%"SVf":partial character is not allowed "
+ Perl_croak(aTHX_ "%" SVf ":partial character is not allowed "
"when CHECK = 0x%" UVuf,
*hv_fetch((HV *)SvRV(obj),"Name",4,0), check);
}
@@ -408,12 +461,11 @@ CODE:
SvCUR_set(utf8,0);
}
*SvEND(utf8) = '\0';
+ SvSETMAGIC(utf8);
}
if (!temp_result) shrink_buffer(result);
if (SvTAINTED(utf8)) SvTAINTED_on(result); /* propagate taintedness */
- SvSETMAGIC(utf8);
-
XSRETURN(1);
}
diff --git a/cpan/Encode/bin/enc2xs b/cpan/Encode/bin/enc2xs
index f2a228f68b..bd39639ae8 100644
--- a/cpan/Encode/bin/enc2xs
+++ b/cpan/Encode/bin/enc2xs
@@ -11,7 +11,7 @@ use warnings;
use Getopt::Std;
use Config;
my @orig_ARGV = @ARGV;
-our $VERSION = do { my @r = (q$Revision: 2.19 $ =~ /\d+/g); sprintf
"%d."."%02d" x $#r, @r };
+our $VERSION = do { my @r = (q$Revision: 2.20 $ =~ /\d+/g); sprintf
"%d."."%02d" x $#r, @r };
# These may get re-ordered.
# RAW is a do_now as inserted by &enter
@@ -123,7 +123,10 @@ my %encode_types = (U => \&encode_U,
);
# Win32 does not expand globs on command line
-eval "\@ARGV = map(glob(\$_),\@ARGV)" if ($^O eq 'MSWin32');
+if ($^O eq 'MSWin32' and !$ENV{PERL_CORE}) {
+ eval "\@ARGV = map(glob(\$_),\@ARGV)";
+ @ARGV = @orig_ARGV unless @ARGV;
+}
my %opt;
# I think these are:
@@ -134,6 +137,8 @@ my %opt;
# -o <output> to specify the output file name (else it's the first arg)
# -f <inlist> to give a file with a list of input files (else use the args)
# -n <name> to name the encoding (else use the basename of the input file.
+#Getopt::Long::Configure("bundling");
+#GetOptions(\%opt, qw(C M=s S Q q O o=s f=s n=s v));
getopts('CM:SQqOo:f:n:v',\%opt);
$opt{M} and make_makefile_pl($opt{M}, @ARGV);
@@ -196,9 +201,9 @@ sub compiler_info {
# This really should go first, else the die here causes empty (non-erroneous)
# output files to be written.
my @encfiles;
-if (exists $opt{'f'}) {
+if (exists $opt{f}) {
# -F is followed by name of file containing list of filenames
- my $flist = $opt{'f'};
+ my $flist = $opt{f};
open(FLIST,$flist) || die "Cannot open $flist:$!";
chomp(@encfiles = <FLIST>);
close(FLIST);
@@ -206,9 +211,15 @@ if (exists $opt{'f'}) {
@encfiles = @ARGV;
}
-my $cname = (exists $opt{'o'}) ? $opt{'o'} : shift(@ARGV);
+my $cname = $opt{o} ? $opt{o} : shift(@ARGV);
+unless ($cname) { #debuging a win32 nmake error-only. works via cmdline
+ print "\nARGV:";
+ print "$_ " for @ARGV;
+ print "\nopt:";
+ print " $_ => ",defined $opt{$_}?$opt{$_}:"undef","\n" for keys %opt;
+}
chmod(0666,$cname) if -f $cname && !-w $cname;
-open(C,">$cname") || die "Cannot open $cname:$!";
+open(C,">", $cname) || die "Cannot open $cname:$!";
my $dname = $cname;
my $hname = $cname;
@@ -220,10 +231,10 @@ if ($cname =~ /\.(c|xs)$/i) # VMS may have upcased
filenames with DECC$ARGV_PARS
$doC = 1;
$dname =~ s/(\.[^\.]*)?$/.exh/;
chmod(0666,$dname) if -f $cname && !-w $dname;
- open(D,">$dname") || die "Cannot open $dname:$!";
+ open(D,">", $dname) || die "Cannot open $dname:$!";
$hname =~ s/(\.[^\.]*)?$/.h/;
chmod(0666,$hname) if -f $cname && !-w $hname;
- open(H,">$hname") || die "Cannot open $hname:$!";
+ open(H,">", $hname) || die "Cannot open $hname:$!";
foreach my $fh (\*C,\*D,\*H)
{
@@ -469,7 +480,9 @@ sub compile_ucm
$erep = $attr{'subchar'};
$erep =~ s/^\s+//; $erep =~ s/\s+$//;
}
- print "Reading $name ($cs)\n";
+ print "Reading $name ($cs)\n"
+ unless defined $ENV{MAKEFLAGS}
+ and $ENV{MAKEFLAGS} =~ /\b(s|silent|quiet)\b/;
my $nfb = 0;
my $hfb = 0;
while (<$fh>)
@@ -755,9 +768,17 @@ sub addstrings
if ($a->{'Forward'})
{
my ($cpp, $static, $sized) = compiler_info(1);
- my $var = $static ? 'static const' : 'extern';
my $count = $sized ? scalar(@{$a->{'Entries'}}) : '';
- print $fh "$var encpage_t $name\[$count];\n";
+ if ($static) {
+ # we cannot ask Config for d_plusplus since we can override CC=g++-6 on
the cmdline
+ print $fh "#ifdef __cplusplus\n"; # -fpermissive since g++-6
+ print $fh "extern encpage_t $name\[$count];\n";
+ print $fh "#else\n";
+ print $fh "static const encpage_t $name\[$count];\n";
+ print $fh "#endif\n";
+ } else {
+ print $fh "extern encpage_t $name\[$count];\n";
+ }
}
$a->{'DoneStrings'} = 1;
foreach my $b (@{$a->{'Entries'}})
@@ -848,9 +869,16 @@ sub outtable
outtable($fh,$t,$bigname) unless $t->{'Done'};
}
my ($cpp, $static) = compiler_info(0);
- my $var = $static ? 'static const ' : '';
- print $fh "\n${var}encpage_t $name\[",
- scalar(@{$a->{'Entries'}}), "] = {\n";
+ my $count = scalar(@{$a->{'Entries'}});
+ if ($static) {
+ print $fh "#ifdef __cplusplus\n"; # -fpermissive since g++-6
+ print $fh "encpage_t $name\[$count] = {\n";
+ print $fh "#else\n";
+ print $fh "static const encpage_t $name\[$count] = {\n";
+ print $fh "#endif\n";
+ } else {
+ print $fh "\nencpage_t $name\[$count] = {\n";
+ }
foreach my $b (@{$a->{'Entries'}})
{
my ($sc,$ec,$out,$t,$end,$l,$fb) = @$b;
@@ -1104,7 +1132,7 @@ sub _print_expand{
if ((my $d = dirname($dst)) ne '.'){
-d $d or mkdir $d, 0755 or die "mkdir $d : $!";
}
- open my $out, ">$dst" or die "$!";
+ open my $out, ">", $dst or die "$!";
my $asis = 0;
while (<$in>){
if (/^#### END_OF_HEADER/){
diff --git a/cpan/Encode/encoding.pm b/cpan/Encode/encoding.pm
index 754b3acb03..dc342683ee 100644
--- a/cpan/Encode/encoding.pm
+++ b/cpan/Encode/encoding.pm
@@ -1,6 +1,6 @@
-# $Id: encoding.pm,v 2.18 2016/08/10 18:08:45 dankogai Exp dankogai $
+# $Id: encoding.pm,v 2.19 2016/11/01 13:30:38 dankogai Exp $
package encoding;
-our $VERSION = sprintf "%d.%02d", q$Revision: 2.18 $ =~ /(\d+)/g;
+our $VERSION = sprintf "%d.%02d", q$Revision: 2.19 $ =~ /(\d+)/g;
use Encode;
use strict;
diff --git a/cpan/Encode/lib/Encode/Alias.pm b/cpan/Encode/lib/Encode/Alias.pm
index 04ad4967c9..0a252560f5 100644
--- a/cpan/Encode/lib/Encode/Alias.pm
+++ b/cpan/Encode/lib/Encode/Alias.pm
@@ -2,7 +2,7 @@ package Encode::Alias;
use strict;
use warnings;
no warnings 'redefine';
-our $VERSION = do { my @r = ( q$Revision: 2.20 $ =~ /\d+/g ); sprintf "%d." .
"%02d" x $#r, @r };
+our $VERSION = do { my @r = ( q$Revision: 2.21 $ =~ /\d+/g ); sprintf "%d." .
"%02d" x $#r, @r };
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
use Exporter 'import';
@@ -79,8 +79,10 @@ sub find_alias {
sub define_alias {
while (@_) {
- my ( $alias, $name ) = splice( @_, 0, 2 );
- unshift( @Alias, $alias => $name ); # newer one has precedence
+ my $alias = shift;
+ my $name = shift;
+ unshift( @Alias, $alias => $name ) # newer one has precedence
+ if defined $alias;
if ( ref($alias) ) {
**** PATCH TRUNCATED AT 2000 LINES -- 16253 NOT SHOWN ****
--
Perl5 Master Repository
