diff --git a/steps/perl-5.17.4/files/Compress-Raw-Zlib_config.in b/steps/perl-5.17.4/files/Compress-Raw-Zlib_config.in new file mode 100644 index 00000000..3bbcf2f4 --- /dev/null +++ b/steps/perl-5.17.4/files/Compress-Raw-Zlib_config.in @@ -0,0 +1,5 @@ +BUILD_ZLIB = False +INCLUDE = /usr/include +LIB = /usr/lib/i386-unknown-linux-musl +OLD_ZLIB = False +GZIP_OS_CODE = AUTO_DETECT diff --git a/steps/perl-5.17.4/pass1.sh b/steps/perl-5.17.4/pass1.sh new file mode 100755 index 00000000..464b14f5 --- /dev/null +++ b/steps/perl-5.17.4/pass1.sh @@ -0,0 +1,103 @@ +# SPDX-FileCopyrightText: 2025 fosslinux +# +# SPDX-License-Identifier: GPL-3.0-or-later + +src_prepare() { + default + + mv Compress-Raw-Zlib_config.in cpan/Compress-Raw-Zlib/config.in + + # Remove miscellaneous pregenerated files + rm -f Porting/Glossary \ + cpan/Devel-PPPort/parts/apidoc.fnc Configure config_h.SH \ + x2p/a2p.c cpan/Win32API-File/cFile.pc cpan/Sys-Syslog/win32/Win32.pm \ + utils/Makefile + rm win32/perlexe.ico + rm -r cpan/Compress-Raw-Zlib/zlib-src + + # Generated tests + rm cpan/Devel-PPPort/t/*.t cpan/Unicode-Collate/Collate/keys.txt + + # Partially generated file + #sed -i '/GENERATED CODE/q' utf8.h + + # Regenerate other prebuilt header files + # Taken from headers of regen scripts + rm -f lib/warnings.pm warnings.h regnodes.h reentr.h reentr.c \ + overload.h overload.c opcode.h opnames.h pp_proto.h \ + keywords.h embed.h embedvar.h perlapi.c perlapi.h \ + proto.h lib/overload/numbers.pm regcharclass.h perly.{tab,h,act} \ + mg_{raw.h,vtable.h,names.c} keywords.c l1_char_class_tab.h \ + lib/feature.pm unicode_constants.h charclass_invlists.h + perl regen.pl + perl regen_perly.pl -b bison-2.3 + perl regen/keywords.pl + perl regen/mk_PL_charclass.pl + perl regen/mk_invlists.pl + perl regen/unicode_constants.pl + perl regen/regcharclass.pl + + # regenerate configure + ln -s ../metaconfig*/.package . + ln -s ../metaconfig*/U . + metaconfig -m + + # Glossary + pushd Porting + ln -s /usr/lib/perl5/5.6.2/U . + makegloss + popd + + bash cpan/Devel-PPPort/devel/mkapidoc.sh . \ + cpan/Devel-PPPort/parts/apidoc.fnc \ + cpan/Devel-PPPort/parts/embed.fnc + + # Remove lines from MANIFEST that we have deleted + while read -r line; do + f="$(echo "${line}" | cut -d' ' -f1)" + if [ -e "${f}" ]; then + echo "${line}" + fi + done < MANIFEST > MANIFEST.new + mv MANIFEST.new MANIFEST +} + +src_configure() { + ./Configure -des \ + -Dprefix="${PREFIX}" \ + -Dcc=gcc \ + -Dusedl=false \ + -Ddate=':' \ + -Dusedevel \ + -Uversiononly \ + -Dccflags="-U__DATE__ -U__TIME__" \ + -Darchname="i386-linux" \ + -Dmyhostname="(none)" \ + -Dmaildomain="(none)" + + # Remains unclear why this is necessary + pushd x2p + ./Makefile.SH + make depend + popd + + pushd utils + bash Makefile.SH + popd +} + +src_compile() { + pushd x2p + make BYACC=yacc run_byacc + popd + + # there are concurrency issues + make -j1 PREFIX="${PREFIX}" +} + +src_install() { + default + + # Remove messed up manpages + rm "${DESTDIR}/"*.0 +} diff --git a/steps/perl-5.17.4/patches/0001-Revert-regen-regcharclass.pl-Generate-macros-for-X-p.patch b/steps/perl-5.17.4/patches/0001-Revert-regen-regcharclass.pl-Generate-macros-for-X-p.patch new file mode 100644 index 00000000..c2b001c5 --- /dev/null +++ b/steps/perl-5.17.4/patches/0001-Revert-regen-regcharclass.pl-Generate-macros-for-X-p.patch @@ -0,0 +1,53 @@ +From 914c32b1b85e310c832192ef133d2eb8b7108bfa Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 23:38:59 +1000 +Subject: [PATCH] Revert "regen/regcharclass.pl: Generate macros for \X + processing" + +This reverts commit 612ead590b8b5f05e4060738540192ece946c340. +--- + regen/regcharclass.pl | 28 ---------------------------- + 1 file changed, 28 deletions(-) + +diff --git perl-5.17.4/regen/regcharclass.pl perl-5.17.4/regen/regcharclass.pl +index 7d126428ef..e11b97003e 100755 +--- perl-5.17.4/regen/regcharclass.pl ++++ perl-5.17.4/regen/regcharclass.pl +@@ -1133,34 +1133,6 @@ SURROGATE: Surrogate characters + => UTF8 :fast + \p{Gc=Cs} + +-GCB_L: Grapheme_Cluster_Break=L +-=> UTF8 :fast +-\p{_X_GCB_L} +- +-GCB_LV_LVT_V: Grapheme_Cluster_Break=(LV or LVT or V) +-=> UTF8 :fast +-\p{_X_LV_LVT_V} +- +-GCB_Prepend: Grapheme_Cluster_Break=Prepend +-=> UTF8 :fast +-\p{_X_GCB_Prepend} +- +-GCB_RI: Grapheme_Cluster_Break=RI +-=> UTF8 :fast +-\p{_X_RI} +- +-GCB_SPECIAL_BEGIN: Grapheme_Cluster_Break=special_begins +-=> UTF8 :fast +-\p{_X_Special_Begin} +- +-GCB_T: Grapheme_Cluster_Break=T +-=> UTF8 :fast +-\p{_X_GCB_T} +- +-GCB_V: Grapheme_Cluster_Break=V +-=> UTF8 :fast +-\p{_X_GCB_V} +- + # This program was run with this enabled, and the results copied to utf8.h; + # then this was commented out because it takes so long to figure out these 2 + # million code points. The results would not change unless utf8.h decides it +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0002-Revert-regexec.c-Use-new-macros-instead-of-swashes.patch b/steps/perl-5.17.4/patches/0002-Revert-regexec.c-Use-new-macros-instead-of-swashes.patch new file mode 100644 index 00000000..064ddcde --- /dev/null +++ b/steps/perl-5.17.4/patches/0002-Revert-regexec.c-Use-new-macros-instead-of-swashes.patch @@ -0,0 +1,464 @@ +From 1bfcdd572f51f5db59c6c3b91f28c5b3141215bb Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 17:24:24 +1000 +Subject: [PATCH] Revert "regexec.c: Use new macros instead of swashes" + +This reverts commit 45fdf108c5f4d5c719b8d2f7389c81e54795bad7. +--- + embed.fnc | 9 ++ + embedvar.h | 7 ++ + intrpvar.h | 7 ++ + regen/unicode_constants.pl | 3 + + regexec.c | 78 ++++++++++------ + sv.c | 8 ++ + utf8.c | 180 +++++++++++++++++++++++++++++++++++++ + 7 files changed, 265 insertions(+), 27 deletions(-) + +diff --git perl-5.17.4/embed.fnc perl-5.17.4/embed.fnc +index 0db9300b3b..e45e6889c9 100644 +--- perl-5.17.4/embed.fnc ++++ perl-5.17.4/embed.fnc +@@ -660,7 +660,16 @@ ApR |bool |is_utf8_punct |NN const U8 *p + ApR |bool |is_utf8_xdigit |NN const U8 *p + ApR |bool |is_utf8_mark |NN const U8 *p + EXpR |bool |is_utf8_X_extend |NN const U8 *p ++EXpR |bool |is_utf8_X_prepend |NN const U8 *p + EXpR |bool |is_utf8_X_regular_begin|NN const U8 *p ++EXpR |bool |is_utf8_X_special_begin|NN const U8 *p ++EXpR |bool |is_utf8_X_L |NN const U8 *p ++EXpR |bool |is_utf8_X_RI |NN const U8 *p ++:not currently used EXpR |bool |is_utf8_X_LV |NN const U8 *p ++EXpR |bool |is_utf8_X_LVT |NN const U8 *p ++EXpR |bool |is_utf8_X_LV_LVT_V |NN const U8 *p ++EXpR |bool |is_utf8_X_T |NN const U8 *p ++EXpR |bool |is_utf8_X_V |NN const U8 *p + : Used in perly.y + p |OP* |jmaybe |NN OP *o + : Used in pp.c +diff --git perl-5.17.4/embedvar.h perl-5.17.4/embedvar.h +index b9fabab437..f306f2f2f7 100644 +--- perl-5.17.4/embedvar.h ++++ perl-5.17.4/embedvar.h +@@ -353,9 +353,16 @@ + #define PL_unitcheckav_save (vTHX->Iunitcheckav_save) + #define PL_unlockhook (vTHX->Iunlockhook) + #define PL_unsafe (vTHX->Iunsafe) ++#define PL_utf8_X_L (vTHX->Iutf8_X_L) + #define PL_utf8_X_LVT (vTHX->Iutf8_X_LVT) ++#define PL_utf8_X_LV_LVT_V (vTHX->Iutf8_X_LV_LVT_V) ++#define PL_utf8_X_RI (vTHX->Iutf8_X_RI) ++#define PL_utf8_X_T (vTHX->Iutf8_X_T) ++#define PL_utf8_X_V (vTHX->Iutf8_X_V) + #define PL_utf8_X_extend (vTHX->Iutf8_X_extend) ++#define PL_utf8_X_prepend (vTHX->Iutf8_X_prepend) + #define PL_utf8_X_regular_begin (vTHX->Iutf8_X_regular_begin) ++#define PL_utf8_X_special_begin (vTHX->Iutf8_X_special_begin) + #define PL_utf8_alnum (vTHX->Iutf8_alnum) + #define PL_utf8_alpha (vTHX->Iutf8_alpha) + #define PL_utf8_blank (vTHX->Iutf8_blank) +diff --git perl-5.17.4/intrpvar.h perl-5.17.4/intrpvar.h +index 40a6aa1e9d..e306ebbb31 100644 +--- perl-5.17.4/intrpvar.h ++++ perl-5.17.4/intrpvar.h +@@ -628,7 +628,14 @@ PERLVAR(I, utf8_xdigit, SV *) + PERLVAR(I, utf8_mark, SV *) + PERLVAR(I, utf8_X_regular_begin, SV *) + PERLVAR(I, utf8_X_extend, SV *) ++PERLVAR(I, utf8_X_prepend, SV *) ++PERLVAR(I, utf8_X_special_begin, SV *) ++PERLVAR(I, utf8_X_L, SV *) + PERLVAR(I, utf8_X_LVT, SV *) ++PERLVAR(I, utf8_X_RI, SV *) ++PERLVAR(I, utf8_X_T, SV *) ++PERLVAR(I, utf8_X_V, SV *) ++PERLVAR(I, utf8_X_LV_LVT_V, SV *) + PERLVAR(I, utf8_toupper, SV *) + PERLVAR(I, utf8_totitle, SV *) + PERLVAR(I, utf8_tolower, SV *) +diff --git perl-5.17.4/regen/unicode_constants.pl perl-5.17.4/regen/unicode_constants.pl +index e3d588a599..ab1ab8f326 100644 +--- perl-5.17.4/regen/unicode_constants.pl ++++ perl-5.17.4/regen/unicode_constants.pl +@@ -134,6 +134,9 @@ __DATA__ + 03C5 first + 03C5 tail + ++1100 ++1160 ++11A8 + 2010 string + D800 first FIRST_SURROGATE + +diff --git perl-5.17.4/regexec.c perl-5.17.4/regexec.c +index f207cdaf88..2676ebb92e 100644 +--- perl-5.17.4/regexec.c ++++ perl-5.17.4/regexec.c +@@ -145,7 +145,14 @@ + /* No asserts are done for some of these, in case called on a */ \ + /* Unicode version in which they map to nothing */ \ + LOAD_UTF8_CHARCLASS(X_regular_begin, HYPHEN_UTF8); \ ++ LOAD_UTF8_CHARCLASS_NO_CHECK(X_special_begin); \ + LOAD_UTF8_CHARCLASS(X_extend, COMBINING_GRAVE_ACCENT_UTF8); \ ++ LOAD_UTF8_CHARCLASS_NO_CHECK(X_prepend);/* empty in most releases*/ \ ++ LOAD_UTF8_CHARCLASS(X_L, HANGUL_CHOSEONG_KIYEOK_UTF8); \ ++ LOAD_UTF8_CHARCLASS(X_LV_LVT_V, HANGUL_JUNGSEONG_FILLER_UTF8); \ ++ LOAD_UTF8_CHARCLASS_NO_CHECK(X_RI); /* empty in many releases */ \ ++ LOAD_UTF8_CHARCLASS(X_T, HANGUL_JONGSEONG_KIYEOK_UTF8); \ ++ LOAD_UTF8_CHARCLASS(X_V, HANGUL_JUNGSEONG_FILLER_UTF8) + + #define PLACEHOLDER /* Something for the preprocessor to grab onto */ + +@@ -4084,8 +4091,6 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + locinput += 2; + } + else { +- STRLEN len; +- + /* In case have to backtrack to beginning, then match '.' */ + char *starting = locinput; + +@@ -4094,12 +4099,16 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + + LOAD_UTF8_CHARCLASS_GCB(); + +- /* Match (prepend)* */ +- while (locinput < PL_regeol +- && (len = is_GCB_Prepend_utf8(locinput))) +- { +- previous_prepend = locinput; +- locinput += len; ++ /* Match (prepend)*, but don't bother trying if empty (as ++ * being set to _undef indicates) */ ++ if (PL_utf8_X_prepend != &PL_sv_undef) { ++ while (locinput < PL_regeol ++ && swash_fetch(PL_utf8_X_prepend, ++ (U8*)locinput, utf8_target)) ++ { ++ previous_prepend = locinput; ++ locinput += UTF8SKIP(locinput); ++ } + } + + /* As noted above, if we matched a prepend character, but +@@ -4109,7 +4118,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + && (locinput >= PL_regeol + || (! swash_fetch(PL_utf8_X_regular_begin, + (U8*)locinput, utf8_target) +- && ! is_GCB_SPECIAL_BEGIN_utf8(locinput))) ++ && ! swash_fetch(PL_utf8_X_special_begin, ++ (U8*)locinput, utf8_target))) + ) + { + locinput = previous_prepend; +@@ -4124,7 +4134,9 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + (U8*)locinput, utf8_target)) { + locinput += UTF8SKIP(locinput); + } +- else if (! is_GCB_SPECIAL_BEGIN_utf8(locinput)) { ++ else if (! swash_fetch(PL_utf8_X_special_begin, ++ (U8*)locinput, utf8_target)) ++ { + + /* Here did not match the required 'Begin' in the + * second term. So just match the very first +@@ -4136,20 +4148,26 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + /* Here is a special begin. It can be composed of + * several individual characters. One possibility is + * RI+ */ +- if ((len = is_GCB_RI_utf8(locinput))) { +- locinput += len; ++ if (swash_fetch(PL_utf8_X_RI, ++ (U8*)locinput, utf8_target)) ++ { ++ locinput += UTF8SKIP(locinput); + while (locinput < PL_regeol +- && (len = is_GCB_RI_utf8(locinput))) ++ && swash_fetch(PL_utf8_X_RI, ++ (U8*)locinput, utf8_target)) + { +- locinput += len; ++ locinput += UTF8SKIP(locinput); + } +- } else if ((len = is_GCB_T_utf8(locinput))) { +- /* Another possibility is T+ */ +- locinput += len; ++ } else /* Another possibility is T+ */ ++ if (swash_fetch(PL_utf8_X_T, ++ (U8*)locinput, utf8_target)) ++ { ++ locinput += UTF8SKIP(locinput); + while (locinput < PL_regeol +- && (len = is_GCB_T_utf8(locinput))) ++ && swash_fetch(PL_utf8_X_T, ++ (U8*)locinput, utf8_target)) + { +- locinput += len; ++ locinput += UTF8SKIP(locinput); + } + } else { + +@@ -4160,9 +4178,10 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + + /* Match L* */ + while (locinput < PL_regeol +- && (len = is_GCB_L_utf8(locinput))) ++ && swash_fetch(PL_utf8_X_L, ++ (U8*)locinput, utf8_target)) + { +- locinput += len; ++ locinput += UTF8SKIP(locinput); + } + + /* Here, have exhausted L*. If the next character +@@ -4172,7 +4191,8 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + * Are done. */ + + if (locinput < PL_regeol +- && is_GCB_LV_LVT_V_utf8(locinput)) ++ && swash_fetch(PL_utf8_X_LV_LVT_V, ++ (U8*)locinput, utf8_target)) + { + + /* Otherwise keep going. Must be LV, LVT or V. +@@ -4185,18 +4205,22 @@ S_regmatch(pTHX_ regmatch_info *reginfo, char *startpos, regnode *prog) + * V* */ + locinput += UTF8SKIP(locinput); + while (locinput < PL_regeol +- && (len = is_GCB_V_utf8(locinput))) ++ && swash_fetch(PL_utf8_X_V, ++ (U8*)locinput, ++ utf8_target)) + { +- locinput += len; ++ locinput += UTF8SKIP(locinput); + } + } + + /* And any of LV, LVT, or V can be followed +- * by T* */ ++ * by T* */ + while (locinput < PL_regeol +- && (len = is_GCB_T_utf8(locinput))) ++ && swash_fetch(PL_utf8_X_T, ++ (U8*)locinput, ++ utf8_target)) + { +- locinput += len; ++ locinput += UTF8SKIP(locinput); + } + } + } +diff --git perl-5.17.4/sv.c perl-5.17.4/sv.c +index 89699be4b2..b22e728275 100644 +--- perl-5.17.4/sv.c ++++ perl-5.17.4/sv.c +@@ -13379,7 +13379,15 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, + PL_utf8_mark = sv_dup_inc(proto_perl->Iutf8_mark, param); + PL_utf8_X_regular_begin = sv_dup_inc(proto_perl->Iutf8_X_regular_begin, param); + PL_utf8_X_extend = sv_dup_inc(proto_perl->Iutf8_X_extend, param); ++ PL_utf8_X_prepend = sv_dup_inc(proto_perl->Iutf8_X_prepend, param); ++ PL_utf8_X_special_begin = sv_dup_inc(proto_perl->Iutf8_X_special_begin, param); ++ PL_utf8_X_L = sv_dup_inc(proto_perl->Iutf8_X_L, param); ++ /*not currently used: PL_utf8_X_LV = sv_dup_inc(proto_perl->Iutf8_X_LV, param);*/ + PL_utf8_X_LVT = sv_dup_inc(proto_perl->Iutf8_X_LVT, param); ++ PL_utf8_X_RI = sv_dup_inc(proto_perl->Iutf8_X_RI, param); ++ PL_utf8_X_T = sv_dup_inc(proto_perl->Iutf8_X_T, param); ++ PL_utf8_X_V = sv_dup_inc(proto_perl->Iutf8_X_V, param); ++ PL_utf8_X_LV_LVT_V = sv_dup_inc(proto_perl->Iutf8_X_LV_LVT_V, param); + PL_utf8_toupper = sv_dup_inc(proto_perl->Iutf8_toupper, param); + PL_utf8_totitle = sv_dup_inc(proto_perl->Iutf8_totitle, param); + PL_utf8_tolower = sv_dup_inc(proto_perl->Iutf8_tolower, param); +diff --git perl-5.17.4/utf8.c perl-5.17.4/utf8.c +index 660002388f..2172d311b4 100644 +--- perl-5.17.4/utf8.c ++++ perl-5.17.4/utf8.c +@@ -2229,6 +2229,186 @@ Perl_is_utf8_X_extend(pTHX_ const U8 *p) + return is_utf8_common(p, &PL_utf8_X_extend, "_X_Extend"); + } + ++bool ++Perl_is_utf8_X_prepend(pTHX_ const U8 *p) ++{ ++ /* If no code points in the Unicode version being worked on match ++ * GCB=Prepend, this will set PL_utf8_X_prepend to &PL_sv_undef during its ++ * first call. Otherwise, it will set it to a swash created for it. ++ * swash_fetch() hence can't be used without checking first if it is valid ++ * to do so. */ ++ ++ dVAR; ++ bool initialized = cBOOL(PL_utf8_X_prepend); ++ bool ret; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_PREPEND; ++ ++ if (PL_utf8_X_prepend == &PL_sv_undef) { ++ return FALSE; ++ } ++ ++ if ((ret = is_utf8_common(p, &PL_utf8_X_prepend, "_X_GCB_Prepend")) ++ || initialized) ++ { ++ return ret; ++ } ++ ++ /* Here the code point being checked was not a prepend, and we hadn't ++ * initialized PL_utf8_X_prepend, so we don't know if it is just this ++ * particular input code point that didn't match, or if the table is ++ * completely empty. The is_utf8_common() call did the initialization, so ++ * we can inspect the swash's inversion list to find out. If there are no ++ * elements in its inversion list, it's empty, and nothing will ever match, ++ * so set things up so we can skip the check in future calls. */ ++ if (_invlist_len(_get_swash_invlist(PL_utf8_X_prepend)) == 0) { ++ SvREFCNT_dec(PL_utf8_X_prepend); ++ PL_utf8_X_prepend = &PL_sv_undef; ++ } ++ ++ return FALSE; ++} ++ ++bool ++Perl_is_utf8_X_special_begin(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_SPECIAL_BEGIN; ++ ++ return is_utf8_common(p, &PL_utf8_X_special_begin, "_X_Special_Begin"); ++} ++ ++bool ++Perl_is_utf8_X_L(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_L; ++ ++ return is_utf8_common(p, &PL_utf8_X_L, "_X_GCB_L"); ++} ++ ++bool ++Perl_is_utf8_X_RI(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_RI; ++ ++ return is_utf8_common(p, &PL_utf8_X_RI, "_X_RI"); ++} ++ ++/* These constants are for finding GCB=LV and GCB=LVT. These are for the ++ * pre-composed Hangul syllables, which are all in a contiguous block and ++ * arranged there in such a way so as to facilitate alorithmic determination of ++ * their characteristics. As such, they don't need a swash, but can be ++ * determined by simple arithmetic. Almost all are GCB=LVT, but every 28th one ++ * is a GCB=LV */ ++#define SBASE 0xAC00 /* Start of block */ ++#define SCount 11172 /* Length of block */ ++#define TCount 28 ++ ++#if 0 /* This routine is not currently used */ ++bool ++Perl_is_utf8_X_LV(pTHX_ const U8 *p) ++{ ++ /* Unlike most other similarly named routines here, this does not create a ++ * swash, so swash_fetch() cannot be used on PL_utf8_X_LV. */ ++ ++ dVAR; ++ ++ UV cp = valid_utf8_to_uvchr(p, NULL); ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_LV; ++ ++ /* The earliest Unicode releases did not have these precomposed Hangul ++ * syllables. Set to point to undef in that case, so will return false on ++ * every call */ ++ if (! PL_utf8_X_LV) { /* Set up if this is the first time called */ ++ PL_utf8_X_LV = swash_init("utf8", "_X_GCB_LV", &PL_sv_undef, 1, 0); ++ if (_invlist_len(_get_swash_invlist(PL_utf8_X_LV)) == 0) { ++ SvREFCNT_dec(PL_utf8_X_LV); ++ PL_utf8_X_LV = &PL_sv_undef; ++ } ++ } ++ ++ return (PL_utf8_X_LV != &PL_sv_undef ++ && cp >= SBASE && cp < SBASE + SCount ++ && (cp - SBASE) % TCount == 0); /* Only every TCount one is LV */ ++} ++#endif ++ ++bool ++Perl_is_utf8_X_LVT(pTHX_ const U8 *p) ++{ ++ /* Unlike most other similarly named routines here, this does not create a ++ * swash, so swash_fetch() cannot be used on PL_utf8_X_LVT. */ ++ ++ dVAR; ++ ++ UV cp = valid_utf8_to_uvchr(p, NULL); ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_LVT; ++ ++ /* The earliest Unicode releases did not have these precomposed Hangul ++ * syllables. Set to point to undef in that case, so will return false on ++ * every call */ ++ if (! PL_utf8_X_LVT) { /* Set up if this is the first time called */ ++ PL_utf8_X_LVT = swash_init("utf8", "_X_GCB_LVT", &PL_sv_undef, 1, 0); ++ if (_invlist_len(_get_swash_invlist(PL_utf8_X_LVT)) == 0) { ++ SvREFCNT_dec(PL_utf8_X_LVT); ++ PL_utf8_X_LVT = &PL_sv_undef; ++ } ++ } ++ ++ return (PL_utf8_X_LVT != &PL_sv_undef ++ && cp >= SBASE && cp < SBASE + SCount ++ && (cp - SBASE) % TCount != 0); /* All but every TCount one is LV */ ++} ++ ++bool ++Perl_is_utf8_X_T(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_T; ++ ++ return is_utf8_common(p, &PL_utf8_X_T, "_X_GCB_T"); ++} ++ ++bool ++Perl_is_utf8_X_V(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_V; ++ ++ return is_utf8_common(p, &PL_utf8_X_V, "_X_GCB_V"); ++} ++ ++bool ++Perl_is_utf8_X_LV_LVT_V(pTHX_ const U8 *p) ++{ ++ dVAR; ++ ++ PERL_ARGS_ASSERT_IS_UTF8_X_LV_LVT_V; ++ ++ return is_utf8_common(p, &PL_utf8_X_LV_LVT_V, "_X_LV_LVT_V"); ++} ++ ++bool ++Perl__is_utf8_quotemeta(pTHX_ const U8 *p) ++{ ++ /* For exclusive use of pp_quotemeta() */ ++ ++ dVAR; ++ ++ PERL_ARGS_ASSERT__IS_UTF8_QUOTEMETA; ++ ++ return is_utf8_common(p, &PL_utf8_quotemeta, "_Perl_Quotemeta"); ++} ++ + /* + =for apidoc to_utf8_case + +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0003-Revert-Use-macro-not-swash-for-utf8-quotemeta.patch b/steps/perl-5.17.4/patches/0003-Revert-Use-macro-not-swash-for-utf8-quotemeta.patch new file mode 100644 index 00000000..54dde26f --- /dev/null +++ b/steps/perl-5.17.4/patches/0003-Revert-Use-macro-not-swash-for-utf8-quotemeta.patch @@ -0,0 +1,102 @@ +From 070b9010ff7a44dbdce15dfea579089bfbdff821 Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 23:48:33 +1000 +Subject: [PATCH] Revert "Use macro not swash for utf8 quotemeta" + +This reverts commit 685289b5657b776e8a3871de68a57785e6ccd797. +--- + embed.fnc | 1 + + embed.h | 3 +++ + intrpvar.h | 1 + + pp.c | 3 +-- + regen/regcharclass.pl | 4 ---- + sv.c | 1 + + utf8.c | 11 +++++++++++ + 7 files changed, 18 insertions(+), 6 deletions(-) + +diff --git perl-5.17.4/embed.fnc perl-5.17.4/embed.fnc +index 0db9300b3b..466025950e 100644 +--- perl-5.17.4/embed.fnc ++++ perl-5.17.4/embed.fnc +@@ -614,6 +614,7 @@ EXp |UV |_to_fold_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const + #endif + #if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) + p |UV |_to_upper_title_latin1|const U8 c|NN U8 *p|NN STRLEN *lenp|const char S_or_s ++ApRM |bool |_is_utf8_quotemeta|NN const U8 *p + #endif + Ap |UV |to_uni_lower |UV c|NN U8 *p|NN STRLEN *lenp + Amp |UV |to_uni_fold |UV c|NN U8 *p|NN STRLEN *lenp +diff --git perl-5.17.4/embed.h perl-5.17.4/embed.h +index e0afb124b0..3ffe84f220 100644 +--- perl-5.17.4/embed.h ++++ perl-5.17.4/embed.h +@@ -789,6 +789,9 @@ + #define warn_nocontext Perl_warn_nocontext + #define warner_nocontext Perl_warner_nocontext + #endif ++#if defined(PERL_IN_UTF8_C) || defined(PERL_IN_PP_C) ++#define _is_utf8_quotemeta(a) Perl__is_utf8_quotemeta(aTHX_ a) ++#endif + #if defined(PERL_MAD) + #define newFORM(a,b,c) Perl_newFORM(aTHX_ a,b,c) + #endif +diff --git perl-5.17.4/intrpvar.h perl-5.17.4/intrpvar.h +index 40a6aa1e9d..641cac6268 100644 +--- perl-5.17.4/intrpvar.h ++++ perl-5.17.4/intrpvar.h +@@ -633,6 +633,7 @@ PERLVAR(I, utf8_toupper, SV *) + PERLVAR(I, utf8_totitle, SV *) + PERLVAR(I, utf8_tolower, SV *) + PERLVAR(I, utf8_tofold, SV *) ++PERLVAR(I, utf8_quotemeta, SV *) + PERLVAR(I, last_swash_hv, HV *) + PERLVAR(I, last_swash_tmps, U8 *) + PERLVAR(I, last_swash_slen, STRLEN) +diff --git perl-5.17.4/pp.c perl-5.17.4/pp.c +index f99c460a8d..fa741b8b29 100644 +--- perl-5.17.4/pp.c ++++ perl-5.17.4/pp.c +@@ -29,7 +29,6 @@ + #include "keywords.h" + + #include "reentr.h" +-#include "regcharclass.h" + + /* XXX I can't imagine anyone who doesn't have this actually _needs_ + it, since pid_t is an integral type. +@@ -4090,7 +4089,7 @@ PP(pp_quotemeta) + to_quote = TRUE; + } + } +- else if (is_QUOTEMETA_high(s)) { ++ else if (_is_utf8_quotemeta((U8 *) s)) { + to_quote = TRUE; + } + +diff --git perl-5.17.4/regen/regcharclass.pl perl-5.17.4/regen/regcharclass.pl +index 7d126428ef..d1df1f5086 100755 +--- perl-5.17.4/regen/regcharclass.pl ++++ perl-5.17.4/regen/regcharclass.pl +@@ -1176,7 +1176,3 @@ GCB_V: Grapheme_Cluster_Break=V + UTF8_CHAR: Matches utf8 from 1 to 5 bytes + => UTF8 :safe only_ebcdic_platform + 0x0 - 0x3FFFFF: +- +-QUOTEMETA: Meta-characters that \Q should quote +-=> high :fast +-\p{_Perl_Quotemeta} +diff --git perl-5.17.4/sv.c perl-5.17.4/sv.c +index 89699be4b2..8b46b4d9f7 100644 +--- perl-5.17.4/sv.c ++++ perl-5.17.4/sv.c +@@ -13390,6 +13390,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, + PL_utf8_idcont = sv_dup_inc(proto_perl->Iutf8_idcont, param); + PL_utf8_xidcont = sv_dup_inc(proto_perl->Iutf8_xidcont, param); + PL_utf8_foldable = sv_dup_inc(proto_perl->Iutf8_foldable, param); ++ PL_utf8_quotemeta = sv_dup_inc(proto_perl->Iutf8_quotemeta, param); + PL_ASCII = sv_dup_inc(proto_perl->IASCII, param); + PL_AboveLatin1 = sv_dup_inc(proto_perl->IAboveLatin1, param); + PL_Latin1 = sv_dup_inc(proto_perl->ILatin1, param); +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0011-Revert-Upgrade-Socket-from-2.004-to-2.006.patch b/steps/perl-5.17.4/patches/0011-Revert-Upgrade-Socket-from-2.004-to-2.006.patch new file mode 100644 index 00000000..5ad7b947 --- /dev/null +++ b/steps/perl-5.17.4/patches/0011-Revert-Upgrade-Socket-from-2.004-to-2.006.patch @@ -0,0 +1,270 @@ +From f1fabc56fb9cd2417f5423fdc73ab73574ea8c8e Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 23:58:47 +1000 +Subject: [PATCH 1/4] Revert "Upgrade Socket from 2.004 to 2.006" + +This reverts commit aff163d96ea1505927d05ead3078b1d7bb3bfa93. +--- + Porting/Maintainers.pl | 2 +- + cpan/Socket/Makefile.PL | 8 +----- + cpan/Socket/Socket.pm | 6 +--- + cpan/Socket/Socket.xs | 59 ++++++++++++---------------------------- + cpan/Socket/t/sockaddr.t | 10 ++----- + pod/perldelta.pod | 5 +--- + 6 files changed, 25 insertions(+), 65 deletions(-) + +diff --git perl-5.17.4/Porting/Maintainers.pl perl-5.17.4/Porting/Maintainers.pl +index e107f710e0..54ab2c1352 100755 +--- perl-5.17.4/Porting/Maintainers.pl ++++ perl-5.17.4/Porting/Maintainers.pl +@@ -1636,7 +1636,7 @@ use File::Glob qw(:case); + + 'Socket' => { + 'MAINTAINER' => 'pevans', +- 'DISTRIBUTION' => 'PEVANS/Socket-2.006.tar.gz', ++ 'DISTRIBUTION' => 'PEVANS/Socket-2.004.tar.gz', + 'FILES' => q[cpan/Socket], + 'UPSTREAM' => 'cpan', + }, +diff --git perl-5.17.4/cpan/Socket/Makefile.PL perl-5.17.4/cpan/Socket/Makefile.PL +index 639a57c4d6..9e76dcea96 100644 +--- perl-5.17.4/cpan/Socket/Makefile.PL ++++ perl-5.17.4/cpan/Socket/Makefile.PL +@@ -108,19 +108,13 @@ check_for( + main => "struct sockaddr_in6 sin6; sin6.sin6_scope_id = 0;" + ); + ++# TODO: Needs adding to perl5 core before importing dual-life again + check_for( + confkey => "d_ip_mreq", + define => "HAS_IP_MREQ", + main => "struct ip_mreq mreq; mreq.imr_multiaddr.s_addr = INADDR_ANY;" + ); + +-# TODO: Needs adding to perl5 core before importing dual-life again +-check_for( +- confkey => "d_ip_mreq_source", +- define => "HAS_IP_MREQ_SOURCE", +- main => "struct ip_mreq_source mreq; mreq.imr_multiaddr.s_addr = INADDR_ANY;" +-); +- + check_for( + confkey => "d_ipv6_mreq", + define => "HAS_IPV6_MREQ", +diff --git perl-5.17.4/cpan/Socket/Socket.pm perl-5.17.4/cpan/Socket/Socket.pm +index c0dc4aa7dd..83729b290d 100644 +--- perl-5.17.4/cpan/Socket/Socket.pm ++++ perl-5.17.4/cpan/Socket/Socket.pm +@@ -3,7 +3,7 @@ package Socket; + use strict; + { use 5.006001; } + +-our $VERSION = '2.006'; ++our $VERSION = '2.004'; + + =head1 NAME + +@@ -184,8 +184,6 @@ opaque string representing the IP address (you can use inet_ntoa() to convert + the address to the four-dotted numeric format). Will croak if the structure + does not represent an C address. + +-In scalar context will return just the IP address. +- + =head2 $sockaddr = sockaddr_in $port, $ip_address + + =head2 ($port, $ip_address) = sockaddr_in $sockaddr +@@ -213,8 +211,6 @@ flow label. (You can use inet_ntop() to convert the address to the usual + string format). Will croak if the structure does not represent an C + address. + +-In scalar context will return just the IP address. +- + =head2 $sockaddr = sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]] + + =head2 ($port, $ip6_address, $scope_id, $flowinfo) = sockaddr_in6 $sockaddr +diff --git perl-5.17.4/cpan/Socket/Socket.xs perl-5.17.4/cpan/Socket/Socket.xs +index e99eac12ef..0bdebf5ca4 100644 +--- perl-5.17.4/cpan/Socket/Socket.xs ++++ perl-5.17.4/cpan/Socket/Socket.xs +@@ -179,9 +179,6 @@ static void *my_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 kl, + #ifndef mPUSHp + # define mPUSHp(p,l) sv_setpvn_mg(PUSHs(sv_newmortal()), (p), (l)) + #endif /* !mPUSHp */ +-#ifndef mPUSHs +-# define mPUSHs(s) PUSHs(sv_2mortal(s)) +-#endif /* !mPUSHs */ + + #ifndef CvCONST_on + # undef newCONSTSUB +@@ -789,7 +786,8 @@ unpack_sockaddr_in(sin_sv) + { + STRLEN sockaddrlen; + struct sockaddr_in addr; +- SV *ip_address_sv; ++ unsigned short port; ++ struct in_addr ip_address; + char * sin = SvPVbyte(sin_sv,sockaddrlen); + if (sockaddrlen != sizeof(addr)) { + croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, +@@ -800,16 +798,12 @@ unpack_sockaddr_in(sin_sv) + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_in", addr.sin_family, AF_INET); + } +- ip_address_sv = newSVpvn((char *)&addr.sin_addr, sizeof(addr.sin_addr)); ++ port = ntohs(addr.sin_port); ++ ip_address = addr.sin_addr; + +- if(GIMME_V == G_ARRAY) { +- EXTEND(SP, 2); +- mPUSHi(ntohs(addr.sin_port)); +- mPUSHs(ip_address_sv); +- } +- else { +- mPUSHs(ip_address_sv); +- } ++ EXTEND(SP, 2); ++ PUSHs(sv_2mortal(newSViv((IV) port))); ++ PUSHs(sv_2mortal(newSVpvn((char *)&ip_address, sizeof(ip_address)))); + } + + void +@@ -860,7 +854,6 @@ unpack_sockaddr_in6(sin6_sv) + STRLEN addrlen; + struct sockaddr_in6 sin6; + char * addrbytes = SvPVbyte(sin6_sv, addrlen); +- SV *ip_address_sv; + if (addrlen != sizeof(sin6)) + croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, + "Socket::unpack_sockaddr_in6", (UV)addrlen, (UV)sizeof(sin6)); +@@ -868,22 +861,15 @@ unpack_sockaddr_in6(sin6_sv) + if (sin6.sin6_family != AF_INET6) + croak("Bad address family for %s, got %d, should be %d", + "Socket::unpack_sockaddr_in6", sin6.sin6_family, AF_INET6); +- ip_address_sv = newSVpvn((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr)); +- +- if(GIMME_V == G_ARRAY) { +- EXTEND(SP, 4); +- mPUSHi(ntohs(sin6.sin6_port)); +- mPUSHs(ip_address_sv); ++ EXTEND(SP, 4); ++ mPUSHi(ntohs(sin6.sin6_port)); ++ mPUSHp((char *)&sin6.sin6_addr, sizeof(sin6.sin6_addr)); + # ifdef HAS_SIN6_SCOPE_ID +- mPUSHi(sin6.sin6_scope_id); ++ mPUSHi(sin6.sin6_scope_id); + # else +- mPUSHi(0); ++ mPUSHi(0); + # endif +- mPUSHi(ntohl(sin6.sin6_flowinfo)); +- } +- else { +- mPUSHs(ip_address_sv); +- } ++ mPUSHi(ntohl(sin6.sin6_flowinfo)); + #else + ST(0) = (SV*)not_here("pack_sockaddr_in6"); + #endif +@@ -912,20 +898,11 @@ inet_ntop(af, ip_address_sv) + + struct_size = sizeof(addr); + +- switch(af) { +- case AF_INET: +- if(addrlen != 4) +- croak("Bad address length for Socket::inet_ntop on AF_INET;" +- " got %d, should be 4"); +- break; ++ if (af != AF_INET + #ifdef AF_INET6 +- case AF_INET6: +- if(addrlen != 16) +- croak("Bad address length for Socket::inet_ntop on AF_INET6;" +- " got %d, should be 16"); +- break; ++ && af != AF_INET6 + #endif +- default: ++ ) { + croak("Bad address family for %s, got %d, should be" + #ifdef AF_INET6 + " either AF_INET or AF_INET6", +@@ -1049,7 +1026,7 @@ pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef) + SV * interface + CODE: + { +-#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) ++#if defined(HAS_IP_MREQ) && defined (IP_ADD_SOURCE_MEMBERSHIP) + struct ip_mreq_source mreq; + char * multiaddrbytes; + char * sourcebytes; +@@ -1092,7 +1069,7 @@ unpack_ip_mreq_source(mreq_sv) + SV * mreq_sv + PPCODE: + { +-#if defined(HAS_IP_MREQ_SOURCE) && defined (IP_ADD_SOURCE_MEMBERSHIP) ++#if defined(HAS_IP_MREQ) && defined (IP_ADD_SOURCE_MEMBERSHIP) + struct ip_mreq_source mreq; + STRLEN mreqlen; + char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); +diff --git perl-5.17.4/cpan/Socket/t/sockaddr.t perl-5.17.4/cpan/Socket/t/sockaddr.t +index 1ae24a0bba..63cce24309 100644 +--- perl-5.17.4/cpan/Socket/t/sockaddr.t ++++ perl-5.17.4/cpan/Socket/t/sockaddr.t +@@ -10,7 +10,7 @@ use Socket qw( + sockaddr_family + sockaddr_un + ); +-use Test::More tests => 33; ++use Test::More tests => 31; + + # inet_aton, inet_ntoa + { +@@ -73,8 +73,6 @@ SKIP: { + is( (unpack_sockaddr_in($sin))[0] , 100, 'pack_sockaddr_in->unpack_sockaddr_in port'); + is(inet_ntoa((unpack_sockaddr_in($sin))[1]), "10.20.30.40", 'pack_sockaddr_in->unpack_sockaddr_in addr'); + +- is(inet_ntoa(scalar unpack_sockaddr_in($sin)), "10.20.30.40", 'unpack_sockaddr_in in scalar context yields addr'); +- + is_deeply( [ sockaddr_in($sin) ], [ unpack_sockaddr_in($sin) ], + 'sockaddr_in in list context unpacks' ); + +@@ -85,8 +83,8 @@ SKIP: { + # pack_sockaddr_in6, unpack_sockaddr_in6 + # sockaddr_in6 + SKIP: { +- skip "No AF_INET6", 9 unless my $AF_INET6 = eval { Socket::AF_INET6() }; +- skip "Cannot pack_sockaddr_in6()", 9 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; ++ skip "No AF_INET6", 8 unless my $AF_INET6 = eval { Socket::AF_INET6() }; ++ skip "Cannot pack_sockaddr_in6()", 8 unless my $sin6 = eval { Socket::pack_sockaddr_in6(0x1234, "0123456789abcdef", 0, 89) }; + + ok(defined $sin6, 'pack_sockaddr_in6 defined'); + +@@ -97,8 +95,6 @@ SKIP: { + is((Socket::unpack_sockaddr_in6($sin6))[2], 0, 'pack_sockaddr_in6->unpack_sockaddr_in6 scope_id'); + is((Socket::unpack_sockaddr_in6($sin6))[3], 89, 'pack_sockaddr_in6->unpack_sockaddr_in6 flowinfo'); + +- is(scalar Socket::unpack_sockaddr_in6($sin6), "0123456789abcdef", 'unpack_sockaddr_in6 in scalar context yields addr'); +- + is_deeply( [ Socket::sockaddr_in6($sin6) ], [ Socket::unpack_sockaddr_in6($sin6) ], + 'sockaddr_in6 in list context unpacks' ); + +diff --git perl-5.17.4/pod/perldelta.pod perl-5.17.4/pod/perldelta.pod +index 52eaf8f1f5..78f169f953 100644 +--- perl-5.17.4/pod/perldelta.pod ++++ perl-5.17.4/pod/perldelta.pod +@@ -308,10 +308,7 @@ opcodes. + + =item * + +-L has been upgraded from version 2.004 to 2.006. +-C and C now return just the IP +-address in scalar context, and C now guards against incorrect +-length scalars being passed in. ++L has been upgraded from version A.xx to B.yy. + + =item * + +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0012-Revert-Upgrade-Socket-to-2.004.patch b/steps/perl-5.17.4/patches/0012-Revert-Upgrade-Socket-to-2.004.patch new file mode 100644 index 00000000..91b672a4 --- /dev/null +++ b/steps/perl-5.17.4/patches/0012-Revert-Upgrade-Socket-to-2.004.patch @@ -0,0 +1,69 @@ +From de7b91dbf552295709c29dec46ab735b141b3881 Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 23:59:12 +1000 +Subject: [PATCH 2/4] Revert "Upgrade Socket to 2.004" + +This reverts commit b43fc6a1c1224963b2a2430029a638a4294147d0. +--- + Porting/Maintainers.pl | 2 +- + cpan/Socket/Socket.pm | 2 +- + cpan/Socket/t/ip_mreq.t | 2 +- + pod/perldelta.pod | 3 +++ + 4 files changed, 6 insertions(+), 3 deletions(-) + +diff --git perl-5.17.4/Porting/Maintainers.pl perl-5.17.4/Porting/Maintainers.pl +index 54ab2c1352..3b3004f6c3 100755 +--- perl-5.17.4/Porting/Maintainers.pl ++++ perl-5.17.4/Porting/Maintainers.pl +@@ -1636,7 +1636,7 @@ use File::Glob qw(:case); + + 'Socket' => { + 'MAINTAINER' => 'pevans', +- 'DISTRIBUTION' => 'PEVANS/Socket-2.004.tar.gz', ++ 'DISTRIBUTION' => 'PEVANS/Socket-2.003.tar.gz', + 'FILES' => q[cpan/Socket], + 'UPSTREAM' => 'cpan', + }, +diff --git perl-5.17.4/cpan/Socket/Socket.pm perl-5.17.4/cpan/Socket/Socket.pm +index 83729b290d..d9bbfae258 100644 +--- perl-5.17.4/cpan/Socket/Socket.pm ++++ perl-5.17.4/cpan/Socket/Socket.pm +@@ -3,7 +3,7 @@ package Socket; + use strict; + { use 5.006001; } + +-our $VERSION = '2.004'; ++our $VERSION = '2.003'; + + =head1 NAME + +diff --git perl-5.17.4/cpan/Socket/t/ip_mreq.t perl-5.17.4/cpan/Socket/t/ip_mreq.t +index 2ed76062c1..2a99509904 100644 +--- perl-5.17.4/cpan/Socket/t/ip_mreq.t ++++ perl-5.17.4/cpan/Socket/t/ip_mreq.t +@@ -31,7 +31,7 @@ is( (unpack_ip_mreq pack_ip_mreq "\xe0\0\0\1")[1], INADDR_ANY, 'pack_ip_mreq int + + SKIP: { + my $mreq; +- skip "No pack_ip_mreq_source", 3 unless defined eval { $mreq = pack_ip_mreq_source "\xe0\0\0\2", "\x0a\0\0\1", INADDR_ANY }; ++ skip 3, "No pack_ip_mreq_source" unless defined eval { $mreq = pack_ip_mreq_source "\xe0\0\0\2", "\x0a\0\0\1", INADDR_ANY }; + + @unpacked = unpack_ip_mreq_source $mreq; + +diff --git perl-5.17.4/pod/perldelta.pod perl-5.17.4/pod/perldelta.pod +index 78f169f953..a64c1a9143 100644 +--- perl-5.17.4/pod/perldelta.pod ++++ perl-5.17.4/pod/perldelta.pod +@@ -316,6 +316,9 @@ L has been upgraded from version 2.38 to 2.39. This contains various + bugfixes, including compatibility fixes for older versions of Perl and vstring + handling. + ++L has been upgraded from version 2.002 to 2.003. Constants and ++functions required for IP multicast source group membership have been added. ++ + =item * + + L has been upgraded from version 0.31 to 0.32. This includes +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0013-Revert-Upgrade-Socket-from-2.002-to-2.003.patch b/steps/perl-5.17.4/patches/0013-Revert-Upgrade-Socket-from-2.002-to-2.003.patch new file mode 100644 index 00000000..8b71f028 --- /dev/null +++ b/steps/perl-5.17.4/patches/0013-Revert-Upgrade-Socket-from-2.002-to-2.003.patch @@ -0,0 +1,270 @@ +From a70ed0b00a2650fa5a9cc238460e9602a3df9df1 Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Fri, 22 Aug 2025 23:59:39 +1000 +Subject: [PATCH 3/4] Revert "Upgrade Socket from 2.002 to 2.003" + +This reverts commit d4ada64ad845b1ffe124cf230a345b847e43d755. +--- + Porting/Maintainers.pl | 2 +- + cpan/Socket/Makefile.PL | 22 ++++++-------- + cpan/Socket/Socket.pm | 36 +++++++--------------- + cpan/Socket/Socket.xs | 67 ----------------------------------------- + cpan/Socket/t/ip_mreq.t | 14 +-------- + pod/perldelta.pod | 4 +++ + 6 files changed, 27 insertions(+), 118 deletions(-) + +diff --git perl-5.17.4/Porting/Maintainers.pl perl-5.17.4/Porting/Maintainers.pl +index 3b3004f6c3..e38daab394 100755 +--- perl-5.17.4/Porting/Maintainers.pl ++++ perl-5.17.4/Porting/Maintainers.pl +@@ -1636,7 +1636,7 @@ use File::Glob qw(:case); + + 'Socket' => { + 'MAINTAINER' => 'pevans', +- 'DISTRIBUTION' => 'PEVANS/Socket-2.003.tar.gz', ++ 'DISTRIBUTION' => 'PEVANS/Socket-2.002.tar.gz', + 'FILES' => q[cpan/Socket], + 'UPSTREAM' => 'cpan', + }, +diff --git perl-5.17.4/cpan/Socket/Makefile.PL perl-5.17.4/cpan/Socket/Makefile.PL +index 9e76dcea96..3be198e024 100644 +--- perl-5.17.4/cpan/Socket/Makefile.PL ++++ perl-5.17.4/cpan/Socket/Makefile.PL +@@ -161,14 +161,13 @@ my @names = ( + + IOV_MAX + +- IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_DROP_MEMBERSHIP +- IP_DROP_SOURCE_MEMBERSHIP IP_HDRINCL IP_MULTICAST_IF IP_MULTICAST_LOOP +- IP_MULTICAST_TTL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS +- IP_TTL ++ IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_HDRINCL IP_MULTICAST_IF ++ IP_MULTICAST_LOOP IP_MULTICAST_TTL IP_OPTIONS IP_RECVOPTS ++ IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TTL + +- IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP +- IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS +- IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY ++ IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER ++ IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP ++ IPV6_UNICAST_HOPS IPV6_V6ONLY + + MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_DONTWAIT MSG_EOF + MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FIN MSG_MAXIOVLEN MSG_MCAST +@@ -201,11 +200,10 @@ my @names = ( + SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO + SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE + +- TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO +- TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL +- TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT +- TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT +- TCP_WINDOW_CLAMP ++ TCP_KEEPALIVE TCP_MAXRT TCP_MAXSEG TCP_NODELAY TCP_STDURG TCP_CORK ++ TCP_KEEPIDLE TCP_KEEPINTVL TCP_KEEPCNT TCP_SYNCNT TCP_LINGER2 ++ TCP_DEFER_ACCEPT TCP_WINDOW_CLAMP TCP_INFO TCP_QUICKACK TCP_CONGESTION ++ TCP_MD5SIG + + UIO_MAXIOV + ), +diff --git perl-5.17.4/cpan/Socket/Socket.pm perl-5.17.4/cpan/Socket/Socket.pm +index d9bbfae258..41f214d8fe 100644 +--- perl-5.17.4/cpan/Socket/Socket.pm ++++ perl-5.17.4/cpan/Socket/Socket.pm +@@ -3,7 +3,7 @@ package Socket; + use strict; + { use 5.006001; } + +-our $VERSION = '2.003'; ++our $VERSION = '2.002'; + + =head1 NAME + +@@ -260,18 +260,6 @@ sockopts. + Takes an C structure. Returns a list of two elements; the IPv4 + multicast address and interface address. + +-=head2 $ip_mreq_source = pack_ip_mreq_source $multiaddr, $source, $interface +- +-Takes an IPv4 multicast address, source address, and optionally an interface +-address (or C). Returns the C structure with those +-arguments packed in. Suitable for use with the C +-and C sockopts. +- +-=head2 ($multiaddr, $source, $interface) = unpack_ip_mreq_source $ip_mreq +- +-Takes an C structure. Returns a list of three elements; the +-IPv4 multicast address, source address and interface address. +- + =head2 $ipv6_mreq = pack_ipv6_mreq $multiaddr6, $ifindex + + Takes an IPv6 multicast address and an interface number. Returns the +@@ -748,26 +736,24 @@ our @EXPORT_OK = qw( + + SOCK_NONBLOCK SOCK_CLOEXEC + +- IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_DROP_MEMBERSHIP +- IP_DROP_SOURCE_MEMBERSHIP IP_MULTICAST_IF IP_MULTICAST_LOOP +- IP_MULTICAST_TTL ++ IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_MULTICAST_IF ++ IP_MULTICAST_LOOP IP_MULTICAST_TTL + + IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_TCP + IPPROTO_UDP + +- TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT TCP_INFO +- TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL +- TCP_LINGER2 TCP_MAXRT TCP_MAXSEG TCP_MD5SIG TCP_NODELAY TCP_NOOPT +- TCP_NOPUSH TCP_QUICKACK TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT +- TCP_WINDOW_CLAMP ++ TCP_CONGESTION TCP_CORK TCP_DEFER_ACCEPT TCP_INFO TCP_KEEPALIVE ++ TCP_KEEPCNT TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG ++ TCP_MD5SIG TCP_NODELAY TCP_QUICKACK TCP_STDURG TCP_SYNCNT ++ TCP_WINDOW_CLAMP + + IN6ADDR_ANY IN6ADDR_LOOPBACK + +- IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP +- IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS +- IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_UNICAST_HOPS IPV6_V6ONLY ++ IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER ++ IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP ++ IPV6_UNICAST_HOPS IPV6_V6ONLY + +- pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source ++ pack_ip_mreq unpack_ip_mreq + + pack_ipv6_mreq unpack_ipv6_mreq + +diff --git perl-5.17.4/cpan/Socket/Socket.xs perl-5.17.4/cpan/Socket/Socket.xs +index 0bdebf5ca4..f22c1f3001 100644 +--- perl-5.17.4/cpan/Socket/Socket.xs ++++ perl-5.17.4/cpan/Socket/Socket.xs +@@ -1019,73 +1019,6 @@ unpack_ip_mreq(mreq_sv) + #endif + } + +-void +-pack_ip_mreq_source(multiaddr, source, interface=&PL_sv_undef) +- SV * multiaddr +- SV * source +- SV * interface +- CODE: +- { +-#if defined(HAS_IP_MREQ) && defined (IP_ADD_SOURCE_MEMBERSHIP) +- struct ip_mreq_source mreq; +- char * multiaddrbytes; +- char * sourcebytes; +- char * interfacebytes; +- STRLEN len; +- if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) +- croak("Wide character in %s", "Socket::pack_ip_mreq_source"); +- multiaddrbytes = SvPVbyte(multiaddr, len); +- if (len != sizeof(mreq.imr_multiaddr)) +- croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); +- if (DO_UTF8(source) && !sv_utf8_downgrade(source, 1)) +- croak("Wide character in %s", "Socket::pack_ip_mreq_source"); +- if (len != sizeof(mreq.imr_sourceaddr)) +- croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_sourceaddr)); +- sourcebytes = SvPVbyte(source, len); +- Zero(&mreq, sizeof(mreq), char); +- Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); +- Copy(sourcebytes, &mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr), char); +- if(SvOK(interface)) { +- if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) +- croak("Wide character in %s", "Socket::pack_ip_mreq"); +- interfacebytes = SvPVbyte(interface, len); +- if (len != sizeof(mreq.imr_interface)) +- croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); +- Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); +- } +- else +- mreq.imr_interface.s_addr = INADDR_ANY; +- ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); +-#else +- not_here("pack_ip_mreq_source"); +-#endif +- } +- +-void +-unpack_ip_mreq_source(mreq_sv) +- SV * mreq_sv +- PPCODE: +- { +-#if defined(HAS_IP_MREQ) && defined (IP_ADD_SOURCE_MEMBERSHIP) +- struct ip_mreq_source mreq; +- STRLEN mreqlen; +- char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); +- if (mreqlen != sizeof(mreq)) +- croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, +- "Socket::unpack_ip_mreq_source", (UV)mreqlen, (UV)sizeof(mreq)); +- Copy(mreqbytes, &mreq, sizeof(mreq), char); +- EXTEND(SP, 3); +- mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); +- mPUSHp((char *)&mreq.imr_sourceaddr, sizeof(mreq.imr_sourceaddr)); +- mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); +-#else +- not_here("unpack_ip_mreq_source"); +-#endif +- } +- + void + pack_ipv6_mreq(multiaddr, interface) + SV * multiaddr +diff --git perl-5.17.4/cpan/Socket/t/ip_mreq.t perl-5.17.4/cpan/Socket/t/ip_mreq.t +index 2a99509904..f08920c437 100644 +--- perl-5.17.4/cpan/Socket/t/ip_mreq.t ++++ perl-5.17.4/cpan/Socket/t/ip_mreq.t +@@ -5,7 +5,6 @@ use Test::More; + use Socket qw( + INADDR_ANY + pack_ip_mreq unpack_ip_mreq +- pack_ip_mreq_source unpack_ip_mreq_source + ); + + # Check that pack/unpack_ip_mreq either croak with "Not implemented", or +@@ -20,7 +19,7 @@ if( !defined $packed ) { + die $@; + } + +-plan tests => 6; ++plan tests => 3; + + my @unpacked = unpack_ip_mreq $packed; + +@@ -28,14 +27,3 @@ is( $unpacked[0], "\xe0\0\0\1", 'unpack_ip_mreq multiaddr' ); + is( $unpacked[1], INADDR_ANY, 'unpack_ip_mreq interface' ); + + is( (unpack_ip_mreq pack_ip_mreq "\xe0\0\0\1")[1], INADDR_ANY, 'pack_ip_mreq interface defaults to INADDR_ANY' ); +- +-SKIP: { +- my $mreq; +- skip 3, "No pack_ip_mreq_source" unless defined eval { $mreq = pack_ip_mreq_source "\xe0\0\0\2", "\x0a\0\0\1", INADDR_ANY }; +- +- @unpacked = unpack_ip_mreq_source $mreq; +- +- is( $unpacked[0], "\xe0\0\0\2", 'unpack_ip_mreq_source multiaddr' ); +- is( $unpacked[1], "\x0a\0\0\1", 'unpack_ip_mreq_source source' ); +- is( $unpacked[2], INADDR_ANY, 'unpack_ip_mreq_source interface' ); +-} +diff --git perl-5.17.4/pod/perldelta.pod perl-5.17.4/pod/perldelta.pod +index a64c1a9143..65a9378242 100644 +--- perl-5.17.4/pod/perldelta.pod ++++ perl-5.17.4/pod/perldelta.pod +@@ -324,6 +324,10 @@ functions required for IP multicast source group membership have been added. + L has been upgraded from version 0.31 to 0.32. This includes + several documentation and bug fixes. + ++L has been upgraded from version 2.37 to 2.38. It can now freeze ++and thaw vstrings correctly. This causes a slight incompatible change in ++the storage format, so the format version has increased to 2.9. ++ + =item * + + L has been upgraded from version 1.40 to 1.41. This adds the +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/0014-Revert-Upgrade-Socket-to-2.002.patch b/steps/perl-5.17.4/patches/0014-Revert-Upgrade-Socket-to-2.002.patch new file mode 100644 index 00000000..efd27d55 --- /dev/null +++ b/steps/perl-5.17.4/patches/0014-Revert-Upgrade-Socket-to-2.002.patch @@ -0,0 +1,344 @@ +From abdda3c270bcbe62f91b979b0b15b34fa3d164fe Mon Sep 17 00:00:00 2001 +From: Samuel Tyler +Date: Sat, 23 Aug 2025 00:00:00 +1000 +Subject: [PATCH 4/4] Revert "Upgrade Socket to 2.002" + +This reverts commit 3be135d8cfe01725ff3bdfcc1b4a30206a1e0ed2. +--- + MANIFEST | 1 - + Porting/Maintainers.pl | 2 +- + cpan/Socket/Makefile.PL | 26 +++---------- + cpan/Socket/Socket.pm | 38 +++---------------- + cpan/Socket/Socket.xs | 81 +++++------------------------------------ + cpan/Socket/t/ip_mreq.t | 29 --------------- + pod/perldelta.pod | 6 +++ + 7 files changed, 29 insertions(+), 154 deletions(-) + delete mode 100644 cpan/Socket/t/ip_mreq.t + +diff --git perl-5.17.4/MANIFEST perl-5.17.4/MANIFEST +index 6883a5f76f..3397344adf 100644 +--- perl-5.17.4/MANIFEST ++++ perl-5.17.4/MANIFEST +@@ -2229,7 +2229,6 @@ cpan/Socket/Socket.pm Socket extension Perl module + cpan/Socket/Socket.xs Socket extension external subroutines + cpan/Socket/t/getaddrinfo.t See if Socket::getaddrinfo works + cpan/Socket/t/getnameinfo.t See if Socket::getnameinfo works +-cpan/Socket/t/ip_mreq.t See if (un)pack_ip_mreq work + cpan/Socket/t/ipv6_mreq.t See if (un)pack_ipv6_mreq work + cpan/Socket/t/sockaddr.t + cpan/Socket/t/socketpair.t See if socketpair works +diff --git perl-5.17.4/Porting/Maintainers.pl perl-5.17.4/Porting/Maintainers.pl +index e38daab394..131493c9c9 100755 +--- perl-5.17.4/Porting/Maintainers.pl ++++ perl-5.17.4/Porting/Maintainers.pl +@@ -1636,7 +1636,7 @@ use File::Glob qw(:case); + + 'Socket' => { + 'MAINTAINER' => 'pevans', +- 'DISTRIBUTION' => 'PEVANS/Socket-2.002.tar.gz', ++ 'DISTRIBUTION' => 'PEVANS/Socket-2.001.tar.gz', + 'FILES' => q[cpan/Socket], + 'UPSTREAM' => 'cpan', + }, +diff --git perl-5.17.4/cpan/Socket/Makefile.PL perl-5.17.4/cpan/Socket/Makefile.PL +index 3be198e024..9a8f65d274 100644 +--- perl-5.17.4/cpan/Socket/Makefile.PL ++++ perl-5.17.4/cpan/Socket/Makefile.PL +@@ -30,15 +30,10 @@ sub check_for + open( my $file_source_fh, ">", $file_source ) or die "Cannot write $file_source - $!"; + print $file_source_fh <<"EOF"; + #include +-#ifdef WIN32 +-# include +-# include +-#else +-# include +-# include +-# include +-# include +-#endif ++#include ++#include ++#include ++#include + int main(int argc, char *argv[]) + { + (void)argc; +@@ -108,13 +103,6 @@ check_for( + main => "struct sockaddr_in6 sin6; sin6.sin6_scope_id = 0;" + ); + +-# TODO: Needs adding to perl5 core before importing dual-life again +-check_for( +- confkey => "d_ip_mreq", +- define => "HAS_IP_MREQ", +- main => "struct ip_mreq mreq; mreq.imr_multiaddr.s_addr = INADDR_ANY;" +-); +- + check_for( + confkey => "d_ipv6_mreq", + define => "HAS_IPV6_MREQ", +@@ -161,9 +149,8 @@ my @names = ( + + IOV_MAX + +- IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_HDRINCL IP_MULTICAST_IF +- IP_MULTICAST_LOOP IP_MULTICAST_TTL IP_OPTIONS IP_RECVOPTS +- IP_RECVRETOPTS IP_RETOPTS IP_TOS IP_TTL ++ IP_OPTIONS IP_HDRINCL IP_TOS IP_TTL IP_RECVOPTS IP_RECVRETOPTS ++ IP_RETOPTS + + IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_MTU IPV6_MTU_DISCOVER + IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP +@@ -185,7 +172,6 @@ my @names = ( + SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_TIMESTAMP + + SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM +- SOCK_NONBLOCK SOCK_CLOEXEC + + SOL_SOCKET + +diff --git perl-5.17.4/cpan/Socket/Socket.pm perl-5.17.4/cpan/Socket/Socket.pm +index 41f214d8fe..e12d8517de 100644 +--- perl-5.17.4/cpan/Socket/Socket.pm ++++ perl-5.17.4/cpan/Socket/Socket.pm +@@ -3,7 +3,7 @@ package Socket; + use strict; + { use 5.006001; } + +-our $VERSION = '2.002'; ++our $VERSION = '2.001'; + + =head1 NAME + +@@ -87,13 +87,6 @@ functions as sockaddr_family(). + Socket type constants to use as the second argument to socket(), or the value + of the C socket option. + +-=head2 SOCK_NONBLOCK. SOCK_CLOEXEC +- +-Linux-specific shortcuts to specify the C and C flags +-during a C call. +- +- socket( my $sockh, PF_INET, SOCK_DGRAM|SOCK_NONBLOCK, 0 ) +- + =head2 SOL_SOCKET + + Socket option level constant for setsockopt() and getsockopt(). +@@ -248,25 +241,13 @@ pack_sockaddr_un() or unpack_sockaddr_un() explicitly. + + These are only supported if your system has EFE. + +-=head2 $ip_mreq = pack_ip_mreq $multiaddr, $interface +- +-Takes an IPv4 multicast address and optionally an interface address (or +-C). Returns the C structure with those arguments packed +-in. Suitable for use with the C and C +-sockopts. +- +-=head2 ($multiaddr, $interface) = unpack_ip_mreq $ip_mreq ++=head2 $ipv6_mreq = pack_ipv6_mreq $ip6_address, $ifindex + +-Takes an C structure. Returns a list of two elements; the IPv4 +-multicast address and interface address. ++Takes an IPv6 address and an interface number. Returns the C ++structure with those arguments packed in. Suitable for use with the ++C and C sockopts. + +-=head2 $ipv6_mreq = pack_ipv6_mreq $multiaddr6, $ifindex +- +-Takes an IPv6 multicast address and an interface number. Returns the +-C structure with those arguments packed in. Suitable for use with +-the C and C sockopts. +- +-=head2 ($multiaddr6, $ifindex) = unpack_ipv6_mreq $ipv6_mreq ++=head2 ($ip6_address, $ifindex) = unpack_ipv6_mreq $ipv6_mreq + + Takes an C structure. Returns a list of two elements; the IPv6 + address and an interface number. +@@ -734,11 +715,6 @@ our @EXPORT = qw( + our @EXPORT_OK = qw( + CR LF CRLF $CR $LF $CRLF + +- SOCK_NONBLOCK SOCK_CLOEXEC +- +- IP_ADD_MEMBERSHIP IP_DROP_MEMBERSHIP IP_MULTICAST_IF +- IP_MULTICAST_LOOP IP_MULTICAST_TTL +- + IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_TCP + IPPROTO_UDP + +@@ -753,8 +729,6 @@ our @EXPORT_OK = qw( + IPV6_MULTICAST_HOPS IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP + IPV6_UNICAST_HOPS IPV6_V6ONLY + +- pack_ip_mreq unpack_ip_mreq +- + pack_ipv6_mreq unpack_ipv6_mreq + + inet_pton inet_ntop +diff --git perl-5.17.4/cpan/Socket/Socket.xs perl-5.17.4/cpan/Socket/Socket.xs +index f22c1f3001..5ddd0e9d8e 100644 +--- perl-5.17.4/cpan/Socket/Socket.xs ++++ perl-5.17.4/cpan/Socket/Socket.xs +@@ -44,10 +44,6 @@ + # include + #endif + +-#ifdef WIN32 +-# include +-#endif +- + #ifdef NETWARE + NETDB_DEFINE_CONTEXT + NETINET_DEFINE_CONTEXT +@@ -963,84 +959,27 @@ inet_pton(af, host) + #endif + + void +-pack_ip_mreq(multiaddr, interface=&PL_sv_undef) +- SV * multiaddr +- SV * interface +- CODE: +- { +-#ifdef HAS_IP_MREQ +- struct ip_mreq mreq; +- char * multiaddrbytes; +- char * interfacebytes; +- STRLEN len; +- if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) +- croak("Wide character in %s", "Socket::pack_ip_mreq"); +- multiaddrbytes = SvPVbyte(multiaddr, len); +- if (len != sizeof(mreq.imr_multiaddr)) +- croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_multiaddr)); +- Zero(&mreq, sizeof(mreq), char); +- Copy(multiaddrbytes, &mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr), char); +- if(SvOK(interface)) { +- if (DO_UTF8(interface) && !sv_utf8_downgrade(interface, 1)) +- croak("Wide character in %s", "Socket::pack_ip_mreq"); +- interfacebytes = SvPVbyte(interface, len); +- if (len != sizeof(mreq.imr_interface)) +- croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ip_mreq", (UV)len, (UV)sizeof(mreq.imr_interface)); +- Copy(interfacebytes, &mreq.imr_interface, sizeof(mreq.imr_interface), char); +- } +- else +- mreq.imr_interface.s_addr = INADDR_ANY; +- ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); +-#else +- not_here("pack_ip_mreq"); +-#endif +- } +- +-void +-unpack_ip_mreq(mreq_sv) +- SV * mreq_sv +- PPCODE: +- { +-#ifdef HAS_IP_MREQ +- struct ip_mreq mreq; +- STRLEN mreqlen; +- char * mreqbytes = SvPVbyte(mreq_sv, mreqlen); +- if (mreqlen != sizeof(mreq)) +- croak("Bad arg length for %s, length is %"UVuf", should be %"UVuf, +- "Socket::unpack_ip_mreq", (UV)mreqlen, (UV)sizeof(mreq)); +- Copy(mreqbytes, &mreq, sizeof(mreq), char); +- EXTEND(SP, 2); +- mPUSHp((char *)&mreq.imr_multiaddr, sizeof(mreq.imr_multiaddr)); +- mPUSHp((char *)&mreq.imr_interface, sizeof(mreq.imr_interface)); +-#else +- not_here("unpack_ip_mreq"); +-#endif +- } +- +-void +-pack_ipv6_mreq(multiaddr, interface) +- SV * multiaddr ++pack_ipv6_mreq(addr, interface) ++ SV * addr + unsigned int interface + CODE: + { + #ifdef HAS_IPV6_MREQ + struct ipv6_mreq mreq; +- char * multiaddrbytes; +- STRLEN len; +- if (DO_UTF8(multiaddr) && !sv_utf8_downgrade(multiaddr, 1)) ++ char * addrbytes; ++ STRLEN addrlen; ++ if (DO_UTF8(addr) && !sv_utf8_downgrade(addr, 1)) + croak("Wide character in %s", "Socket::pack_ipv6_mreq"); +- multiaddrbytes = SvPVbyte(multiaddr, len); +- if (len != sizeof(mreq.ipv6mr_multiaddr)) ++ addrbytes = SvPVbyte(addr, addrlen); ++ if (addrlen != sizeof(mreq.ipv6mr_multiaddr)) + croak("Bad arg length %s, length is %"UVuf", should be %"UVuf, +- "Socket::pack_ipv6_mreq", (UV)len, (UV)sizeof(mreq.ipv6mr_multiaddr)); ++ "Socket::pack_ipv6_mreq", (UV)addrlen, (UV)sizeof(mreq.ipv6mr_multiaddr)); + Zero(&mreq, sizeof(mreq), char); +- Copy(multiaddrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); ++ Copy(addrbytes, &mreq.ipv6mr_multiaddr, sizeof(mreq.ipv6mr_multiaddr), char); + mreq.ipv6mr_interface = interface; + ST(0) = sv_2mortal(newSVpvn((char *)&mreq, sizeof(mreq))); + #else +- not_here("pack_ipv6_mreq"); ++ ST(0) = (SV*)not_here("pack_ipv6_mreq"); + #endif + } + +diff --git perl-5.17.4/cpan/Socket/t/ip_mreq.t perl-5.17.4/cpan/Socket/t/ip_mreq.t +deleted file mode 100644 +index f08920c437..0000000000 +--- perl-5.17.4/cpan/Socket/t/ip_mreq.t ++++ /dev/null +@@ -1,29 +0,0 @@ +-use strict; +-use warnings; +-use Test::More; +- +-use Socket qw( +- INADDR_ANY +- pack_ip_mreq unpack_ip_mreq +-); +- +-# Check that pack/unpack_ip_mreq either croak with "Not implemented", or +-# roundtrip as identity +- +-my $packed; +-eval { +- $packed = pack_ip_mreq "\xe0\0\0\1", INADDR_ANY; +-}; +-if( !defined $packed ) { +- plan skip_all => "No pack_ip_mreq" if $@ =~ m/ not implemented /; +- die $@; +-} +- +-plan tests => 3; +- +-my @unpacked = unpack_ip_mreq $packed; +- +-is( $unpacked[0], "\xe0\0\0\1", 'unpack_ip_mreq multiaddr' ); +-is( $unpacked[1], INADDR_ANY, 'unpack_ip_mreq interface' ); +- +-is( (unpack_ip_mreq pack_ip_mreq "\xe0\0\0\1")[1], INADDR_ANY, 'pack_ip_mreq interface defaults to INADDR_ANY' ); +diff --git perl-5.17.4/pod/perldelta.pod perl-5.17.4/pod/perldelta.pod +index 65a9378242..957169ec2f 100644 +--- perl-5.17.4/pod/perldelta.pod ++++ perl-5.17.4/pod/perldelta.pod +@@ -250,6 +250,12 @@ trailing semicolons in formats. + L has been upgraded from version 0.9130 to 0.9131. This resolves + issues with the SQLite source engine. + ++=back ++ ++=head2 Removed Modules and Pragmata ++ ++=over 4 ++ + =item * + + L has been upgraded from version 1.826 to 1.827. The main Perl module +-- +2.49.1 + diff --git a/steps/perl-5.17.4/patches/a2p-c-bison.patch b/steps/perl-5.17.4/patches/a2p-c-bison.patch new file mode 100644 index 00000000..66bbbfdc --- /dev/null +++ b/steps/perl-5.17.4/patches/a2p-c-bison.patch @@ -0,0 +1,11 @@ +--- perl-5.17.4/x2p/Makefile.SH 2025-07-17 18:07:55.350717970 +1000 ++++ perl-5.17.4/x2p/Makefile.SH 2025-07-17 18:09:02.340711269 +1000 +@@ -123,7 +123,7 @@ + sed -e 's/(yyn = yydefred\[yystate\])/((yyn = yydefred[yystate]))/' \ + -e 's/(yys = getenv("YYDEBUG"))/((yys = getenv("YYDEBUG")))/' \ + -e 's/^yyerrlab://' \ +- -e 's/^ goto yyerrlab;//' \ ++ -e 's/^ *goto yyerrlab;//' \ + -e 's/^yynewerror://' \ + -e 's/^ goto yynewerror;//' \ + -e 's|^static char yysccsid\(.*\)|/* static char yysccsid\1 */|' \ diff --git a/steps/perl-5.17.4/patches/duplicate-invlists-defn.patch b/steps/perl-5.17.4/patches/duplicate-invlists-defn.patch new file mode 100644 index 00000000..28a71eef --- /dev/null +++ b/steps/perl-5.17.4/patches/duplicate-invlists-defn.patch @@ -0,0 +1,10 @@ +--- perl-5.17.4/ext/re/Makefile.PL 2025-08-22 23:08:38.443022450 +1000 ++++ perl-5.17.4/ext/re/Makefile.PL 2025-08-23 11:26:37.737298348 +1000 +@@ -31,6 +31,7 @@ + re_comp.c : $regcomp_c + - \$(RM_F) re_comp.c + \$(CP) $regcomp_c re_comp.c ++ sed -i '/charclass_invlists.h/ s/.*/UV NonL1_Perl_Non_Final_Folds_invlist[];/' re_comp.c + + re_comp\$(OBJ_EXT) : re_comp.c dquote_static.c inline_invlist.c + diff --git a/steps/perl-5.17.4/reenable-regcharclass.patch b/steps/perl-5.17.4/reenable-regcharclass.patch new file mode 100644 index 00000000..30af8f15 --- /dev/null +++ b/steps/perl-5.17.4/reenable-regcharclass.patch @@ -0,0 +1,17 @@ +diff --git perl-5.18.4/regen/regcharclass.pl perl-5.18.4/regen/regcharclass.pl +index f5cf315a54..81dcdc578d 100755 +--- perl-5.18.4/regen/regcharclass.pl ++++ perl-5.18.4/regen/regcharclass.pl +@@ -1468,9 +1468,9 @@ GCB_V: Grapheme_Cluster_Break=V + # million code points. The results would not change unless utf8.h decides it + # wants a maximum other than 4 bytes, or this program creates better + # optimizations +-#UTF8_CHAR: Matches utf8 from 1 to 4 bytes +-#=> UTF8 :safe only_ascii_platform +-#0x0 - 0x1FFFFF ++UTF8_CHAR: Matches utf8 from 1 to 4 bytes ++=> UTF8 :safe only_ascii_platform ++0x0 - 0x1FFFFF + + # This hasn't been commented out, because we haven't an EBCDIC platform to run + # it on, and the 3 types of EBCDIC allegedly supported by Perl would have diff --git a/steps/perl-5.17.4/sources b/steps/perl-5.17.4/sources new file mode 100644 index 00000000..b0bff9cd --- /dev/null +++ b/steps/perl-5.17.4/sources @@ -0,0 +1,2 @@ +https://www.cpan.org/src/5.0/perl-5.17.4.tar.bz2 42e7eb0d726a6344bc54140be8a0e3636330e1be7be8793e0fb74f415666b95b +git://github.com/Perl/metaconfig~79b14e84d83fb88c2b1a07e0dec3b62ccb9a388c https://github.com/Perl/metaconfig/archive/79b14e84d83fb88c2b1a07e0dec3b62ccb9a388c.tar.gz 857e295a3e3ff3121339b348fd295e03459ce8dc3a382870e94f98c2da99a573