Control: tag -1 patch
On Sat, Jul 08, 2023 at 07:17:23PM +0300, Niko Tyni wrote:
> Source: liblmdb-file-perl
> Version: 0.12-4
> Severity: important
> Tags: ftbfs trixie sid upstream
> Forwarded: https://rt.cpan.org/Public/Bug/Display.html?id=148421
> User: debian-p...@lists.debian.org
> Usertags: perl-5.38-transition
>
> This package fails to build with Perl 5.38 (currently in experimental).
> /usr/bin/ld: LMDB.o: in function `XS_LMDB_File__cmp':
> ././LMDB.c:2731: undefined reference to `Perl_do_vecget'
Here's a patch I just sent upstream that works around this by copying
a simplified version of Perl_do_vecget into this module.
--
Niko Tyni nt...@debian.org
>From 1469c3d13a99f401ac2457b37564bc7aedcf050a Mon Sep 17 00:00:00 2001
From: Niko Tyni
Date: Sat, 19 Aug 2023 21:08:33 +0100
Subject: [PATCH] Lift vecget function from Perl core for 5.38 compatibility
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
As suggested by Petr Písař.
Simplified to only handle size <= 8 as the module only needs size==2.
Bug: https://rt.cpan.org/Ticket/Display.html?id=148421
Bug-Debian: https://bugs.debian.org/1040655
---
LMDB.xs | 45 -
1 file changed, 44 insertions(+), 1 deletion(-)
diff --git a/LMDB.xs b/LMDB.xs
index f474abb..647e463 100644
--- a/LMDB.xs
+++ b/LMDB.xs
@@ -110,6 +110,49 @@ S_mySvPVutf8(pTHX_ SV *sv, STRLEN *const len) {
typedef IV MyInt;
+/* lifted from Perl core and simplified [rt.cpan.org #148421] */
+STATIC UV
+my_do_vecget(pTHX_ SV *sv, STRLEN offset, int size)
+{
+STRLEN srclen;
+const I32 svpv_flags = ((PL_op->op_flags & OPf_MOD || LVRET)
+ ? SV_UNDEF_RETURNS_NULL : 0);
+unsigned char *s = (unsigned char *)
+SvPV_flags(sv, srclen, (svpv_flags|SV_GMAGIC));
+UV retnum = 0;
+
+if (!s) {
+ s = (unsigned char *)"";
+}
+
+/* aka. PERL_ARGS_ASSERT_DO_VECGET */
+assert(sv);
+/* sanity checks to make sure the premises for our simplifications still hold */
+assert(LMDB_OFLAGN <= 8);
+if (size != LMDB_OFLAGN)
+Perl_croak(aTHX_ "This is a crippled version of vecget that supports size==%d (LMDB_OFLAGN)", LMDB_OFLAGN);
+
+if (SvUTF8(sv)) {
+if (Perl_sv_utf8_downgrade_flags(aTHX_ sv, TRUE, 0)) {
+/* PVX may have changed */
+s = (unsigned char *) SvPV_flags(sv, srclen, svpv_flags);
+}
+else {
+Perl_croak(aTHX_ "Use of strings with code points over 0xFF"
+ " as arguments to vec is forbidden");
+}
+}
+
+STRLEN bitoffs = ((offset % 8) * size) % 8;
+STRLEN uoffset = offset / (8 / size);
+
+if (uoffset >= srclen)
+return 0;
+
+retnum = (s[uoffset] >> bitoffs) & nBIT_MASK(size);
+return retnum;
+}
+
static void
populateStat(pTHX_ HV** hashptr, int res, MDB_stat *stat)
{
@@ -152,7 +195,7 @@ typedef struct {
START_MY_CXT
-#define LMDB_OFLAGS TOHIWORD(Perl_do_vecget(aTHX_ MY_CXT.OFlags, dbi, LMDB_OFLAGN))
+#define LMDB_OFLAGS TOHIWORD(my_do_vecget(aTHX_ MY_CXT.OFlags, dbi, LMDB_OFLAGN))
#define MY_CMP *av_fetch(MY_CXT.Cmps, MY_CXT.curdb, 1)
#define MY_DCMP *av_fetch(MY_CXT.DCmps, MY_CXT.curdb, 1)
--
2.39.1
