pg.ddx.io pgsql-hackers@postgresql.org mailing list archive
help / color / mirror / Atom feedResidual cleanups for tied objects in PL/Perl
29+ messages / 4 participants
[nested] [flat]
* Residual cleanups for tied objects in PL/Perl
@ 2026-08-16 17:38 Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 2 replies; 29+ messages in thread
From: Tom Lane @ 2026-08-16 17:38 UTC (permalink / raw)
To: pgsql-hackers@lists.postgresql.org
The attached patch fixes a null pointer dereference case in
hstore_plperl, and an infinite-loop case in plperl itself.
These were left out of the recent plperl security patch because
they are not security matters according to our current rules;
but they are certainly bugs that ought to be fixed.
The test cases I have that reach these bugs require Perl "Tie"
modules that aren't present in common Perl installations,
so I'm not planning on trying to construct regression test
entries for them. But I've attached two SQL scripts that
cause failures without the patch.
One interesting point is that Claude Opus, which constructed
these test cases, seemed to think that we ought to be able
to read out the values assigned to the tied array or hash.
But what the repaired code actually produces is SQL NULLs.
AFAICT we are getting Perl "undef" values out of hv_iternext
or av_fetch, so it's hard to see how we could do any better.
I think what is going on here is that the test functions are
failing to install enough infrastructure for the tied object
to produce any output, but maybe someone who knows more Perl
than me can correct that guess.
regards, tom lane
CREATE EXTENSION plperl;
CREATE EXTENSION hstore;
CREATE EXTENSION hstore_plperl;
CREATE FUNCTION tied_hstore() RETURNS hstore
LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
use Tie::Hash;
my %h;
tie %h, 'Tie::StdHash';
$h{a} = '1';
$h{b} = '2';
return \%h;
$$;
SELECT tied_hstore();
CREATE EXTENSION plperlu;
CREATE FUNCTION tied_setof_text() RETURNS SETOF text
LANGUAGE plperlu AS $$
use Tie::Array;
my @a;
tie @a, 'Tie::StdArray';
@a = ('p', 'q', 'r');
return \@a;
$$;
SELECT * FROM tied_setof_text();
Attachments:
[text/x-diff] v1-0001-Close-up-some-more-gaps-in-plperl-and-hstore_plpe.patch (2.4K, ../../569769.1786901901@sss.pgh.pa.us/2-v1-0001-Close-up-some-more-gaps-in-plperl-and-hstore_plpe.patch)
download | inline diff:
From 41ffa719335d3d04c4576cfb35935d47954cd779 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Sun, 16 Aug 2026 13:20:07 -0400
Subject: [PATCH v1] Close up some more gaps in plperl and hstore_plperl.
plperl_to_hstore() failed to check for a null-pointer result from
HeVAL(), leading to SIGSEGV. This is possible at least with tied
hashes. Interpret such a result as SQL NULL, as we do elsewhere.
plperl_func_handler()'s stanza for handling an arrayref result in
a SETOF function could loop forever (or at least till OOM) when
given a tied array, since av_fetch won't necessarily ever return
a null pointer in that case. Be consistent with the other places
where we traverse a perl array: call av_len() once and use that
value as the loop limit, silently ignoring any null pointers we
get back from that range of subscripts.
The known test cases for these errors require perl's Tie modules,
which are often not present, so it doesn't seem worth the trouble
to create regression test cases that would cover them.
Reported-by: Claude Code (via Noah Misch)
Author: Tom Lane <tgl@sss.pgh.pa.us>
Backpatch-through: 14
---
contrib/hstore_plperl/hstore_plperl.c | 2 +-
src/pl/plperl/plperl.c | 11 ++++++-----
2 files changed, 7 insertions(+), 6 deletions(-)
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index d7f1b8ddb48..197d84141e5 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -150,7 +150,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key));
pairs[i].needfree = true;
- if (!SvOK(value))
+ if (!value || !SvOK(value))
{
pairs[i].val = NULL;
pairs[i].vallen = 0;
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..3d4b675762d 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -2478,14 +2478,15 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (sav)
{
dTHX;
- int i = 0;
- SV **svp = 0;
AV *rav = (AV *) SvRV(sav);
+ int alen = av_len(rav) + 1;
- while ((svp = av_fetch(rav, i, FALSE)) != NULL)
+ for (int i = 0; i < alen; i++)
{
- plperl_return_next_internal(*svp);
- i++;
+ SV **svp = av_fetch(rav, i, FALSE);
+
+ if (svp)
+ plperl_return_next_internal(*svp);
}
}
else if (SvOK(perlret))
--
2.52.0
[text/plain] test_tied_hstore.sql (298B, ../../569769.1786901901@sss.pgh.pa.us/3-test_tied_hstore.sql)
download | inline:
CREATE EXTENSION plperl;
CREATE EXTENSION hstore;
CREATE EXTENSION hstore_plperl;
CREATE FUNCTION tied_hstore() RETURNS hstore
LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
use Tie::Hash;
my %h;
tie %h, 'Tie::StdHash';
$h{a} = '1';
$h{b} = '2';
return \%h;
$$;
SELECT tied_hstore();
[text/plain] test_tied_array.sql (232B, ../../569769.1786901901@sss.pgh.pa.us/4-test_tied_array.sql)
download | inline:
CREATE EXTENSION plperlu;
CREATE FUNCTION tied_setof_text() RETURNS SETOF text
LANGUAGE plperlu AS $$
use Tie::Array;
my @a;
tie @a, 'Tie::StdArray';
@a = ('p', 'q', 'r');
return \@a;
$$;
SELECT * FROM tied_setof_text();
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-16 18:47 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-16 19:04 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
1 sibling, 1 reply; 29+ messages in thread
From: Andrew Dunstan @ 2026-08-16 18:47 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; pgsql-hackers@lists.postgresql.org
On 2026-08-16 Su 1:38 PM, Tom Lane wrote:
> The attached patch fixes a null pointer dereference case in
> hstore_plperl, and an infinite-loop case in plperl itself.
> These were left out of the recent plperl security patch because
> they are not security matters according to our current rules;
> but they are certainly bugs that ought to be fixed.
>
> The test cases I have that reach these bugs require Perl "Tie"
> modules that aren't present in common Perl installations,
> so I'm not planning on trying to construct regression test
> entries for them. But I've attached two SQL scripts that
> cause failures without the patch.
Which modules?
>
> One interesting point is that Claude Opus, which constructed
> these test cases, seemed to think that we ought to be able
> to read out the values assigned to the tied array or hash.
> But what the repaired code actually produces is SQL NULLs.
> AFAICT we are getting Perl "undef" values out of hv_iternext
> or av_fetch, so it's hard to see how we could do any better.
At first glance I'm inclined to agree with Opus.
>
> I think what is going on here is that the test functions are
> failing to install enough infrastructure for the tied object
> to produce any output, but maybe someone who knows more Perl
> than me can correct that guess.
>
>
I wonder if it's conflicting with our opcode restrictions. I'll play
around a bit with it.
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
@ 2026-08-16 19:04 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:10 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
0 siblings, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-16 19:04 UTC (permalink / raw)
To: Andrew Dunstan <andrew@dunslane.net>; +Cc: pgsql-hackers@lists.postgresql.org
Andrew Dunstan <andrew@dunslane.net> writes:
> On 2026-08-16 Su 1:38 PM, Tom Lane wrote:
>> The test cases I have that reach these bugs require Perl "Tie"
>> modules that aren't present in common Perl installations,
>> so I'm not planning on trying to construct regression test
>> entries for them. But I've attached two SQL scripts that
>> cause failures without the patch.
> Which modules?
At least Tie::Array isn't present in RHEL10's standard perl
package set --- I had to install "perl-Tie" to get that test
case to run here.
>> One interesting point is that Claude Opus, which constructed
>> these test cases, seemed to think that we ought to be able
>> to read out the values assigned to the tied array or hash.
>> But what the repaired code actually produces is SQL NULLs.
>> AFAICT we are getting Perl "undef" values out of hv_iternext
>> or av_fetch, so it's hard to see how we could do any better.
> At first glance I'm inclined to agree with Opus.
If we can make it work, I'm all for that, but I wonder how many
other places have the same issue.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
2026-08-16 19:04 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-16 21:10 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-17 18:44 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
0 siblings, 1 reply; 29+ messages in thread
From: Andrew Dunstan @ 2026-08-16 21:10 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: pgsql-hackers@lists.postgresql.org
On 2026-08-16 Su 3:04 PM, Tom Lane wrote:
> Andrew Dunstan <andrew@dunslane.net> writes:
>> On 2026-08-16 Su 1:38 PM, Tom Lane wrote:
>>> The test cases I have that reach these bugs require Perl "Tie"
>>> modules that aren't present in common Perl installations,
>>> so I'm not planning on trying to construct regression test
>>> entries for them. But I've attached two SQL scripts that
>>> cause failures without the patch.
>> Which modules?
> At least Tie::Array isn't present in RHEL10's standard perl
> package set --- I had to install "perl-Tie" to get that test
> case to run here.
That seems odd, given that we use Tie::Hash and Tie::StdHash in
src/pl/plperl/plc_trusted.pl
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
2026-08-16 19:04 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:10 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
@ 2026-08-17 18:44 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-17 18:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 1 reply; 29+ messages in thread
From: Andrew Dunstan @ 2026-08-17 18:44 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: pgsql-hackers@lists.postgresql.org
On 2026-08-16 Su 5:10 PM, Andrew Dunstan wrote:
>
> On 2026-08-16 Su 3:04 PM, Tom Lane wrote:
>> Andrew Dunstan <andrew@dunslane.net> writes:
>>> On 2026-08-16 Su 1:38 PM, Tom Lane wrote:
>>>> The test cases I have that reach these bugs require Perl "Tie"
>>>> modules that aren't present in common Perl installations,
>>>> so I'm not planning on trying to construct regression test
>>>> entries for them. But I've attached two SQL scripts that
>>>> cause failures without the patch.
>>> Which modules?
>> At least Tie::Array isn't present in RHEL10's standard perl
>> package set --- I had to install "perl-Tie" to get that test
>> case to run here.
>
>
> That seems odd, given that we use Tie::Hash and Tie::StdHash in
> src/pl/plperl/plc_trusted.pl
>
>
Answering myself, it appears that those are part of RHEL10's perl-libs
package, while Tie::Array and Tie::StdArray are part of the perl-Tie
package. That seems at first glance like a really awful packaging
decision, something not entirely without precedent.
cheers
andrew
--
Andrew Dunstan
EDB: https://www.enterprisedb.com
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
2026-08-16 19:04 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:10 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
2026-08-17 18:44 ` Re: Residual cleanups for tied objects in PL/Perl Andrew Dunstan <andrew@dunslane.net>
@ 2026-08-17 18:58 ` Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 0 replies; 29+ messages in thread
From: Tom Lane @ 2026-08-17 18:58 UTC (permalink / raw)
To: Andrew Dunstan <andrew@dunslane.net>; +Cc: pgsql-hackers@lists.postgresql.org
Andrew Dunstan <andrew@dunslane.net> writes:
> Answering myself, it appears that those are part of RHEL10's perl-libs
> package, while Tie::Array and Tie::StdArray are part of the perl-Tie
> package. That seems at first glance like a really awful packaging
> decision, something not entirely without precedent.
Poking around, it looks like they may have done that because
parent.pm ("use parent" support) requires Tie::StdHash, and they
wanted that in the base installation. It does seem pretty strange
though. There is not much in perl-Tie:
$ rpm -ql perl-Tie
/usr/share/man/man3/Tie::Array.3pm.gz
/usr/share/man/man3/Tie::Handle.3pm.gz
/usr/share/man/man3/Tie::Scalar.3pm.gz
/usr/share/man/man3/Tie::StdHandle.3pm.gz
/usr/share/man/man3/Tie::SubstrHash.3pm.gz
/usr/share/perl5/Tie
/usr/share/perl5/Tie/Array.pm
/usr/share/perl5/Tie/Handle.pm
/usr/share/perl5/Tie/Scalar.pm
/usr/share/perl5/Tie/StdHandle.pm
/usr/share/perl5/Tie/SubstrHash.pm
I see the same division in RHEL9. Don't have a live RHEL8
installation to check anymore.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-16 20:08 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
1 sibling, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-16 20:08 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; andrew@dunslane.net; +Cc: pgsql-hackers@lists.postgresql.org
вс, 16 авг. 2026 г. в 22:38, Tom Lane <tgl@sss.pgh.pa.us>:One interesting
point is that Claude Opus, which constructed
> these test cases, seemed to think that we ought to be able
> to read out the values assigned to the tied array or hash.
> But what the repaired code actually produces is SQL NULLs.
> AFAICT we are getting Perl "undef" values out of hv_iternext
> or av_fetch, so it's hard to see how we could do any better.
>
> Hi Tom!
A tied hash does not store the value in HeVAL(). hv_iternext() leaves that
pointer unset. Tom's NULL check therefore always takes the SQL NULL path,
even when FETCH would return a real value. hv_iterval() plus SvGETMAGIC()
is what actually runs FETCH.
The same applies to a tied array. av_len() stops the infinite loop, but
av_fetch() still returns a magic SV whose SvOK() is false until GETMAGIC.
Without that, SETOF also yields NULLs.
The attached patch includes regress tests. They use a small inline TIEHASH
/ TIEARRAY class, not Tie::Hash or Tie::Array.
--
Regards,
Rachitskiy Andrey
Attachments:
[text/x-patch] 0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch (5.1K, ../../CAB8bMivzt9CGJWM--i3V5MUSXL2FSK2b1DPiJYow2rd9y6pu9A@mail.gmail.com/3-0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch)
download | inline diff:
diff --git a/contrib/hstore_plperl/expected/hstore_plperl.out b/contrib/hstore_plperl/expected/hstore_plperl.out
index 1ab09a94cda..958c1d3056d 100644
--- a/contrib/hstore_plperl/expected/hstore_plperl.out
+++ b/contrib/hstore_plperl/expected/hstore_plperl.out
@@ -62,6 +62,33 @@ ERROR: cannot transform non-hash Perl value to hstore
CONTEXT: PL/Perl function "test2"
DROP FUNCTION test2();
DROP FUNCTION test2arr();
+-- Tied hash via an inline class (no Tie::Hash).
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1';
+ $h{b} = '2';
+ $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_hstore();
+ tied_hstore
+-------------------------------
+ "a"=>"1", "b"=>"2", "c"=>NULL
+(1 row)
+
+DROP FUNCTION tied_hstore();
DROP EXTENSION hstore_plperl;
DROP EXTENSION hstore;
DROP EXTENSION plperl;
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index d7f1b8ddb48..ee63c7d4492 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -138,7 +138,15 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
while ((he = hv_iternext(hv)))
{
char *key = sv2cstr(HeSVKEY_force(he));
- SV *value = HeVAL(he);
+ SV *value;
+
+ /*
+ * Tied hashes leave HeVAL() unset. hv_iterval() plus
+ * SvGETMAGIC() runs FETCH.
+ */
+ value = hv_iterval(hv, he);
+ if (value)
+ SvGETMAGIC(value);
if (i >= pcount)
{
@@ -150,7 +158,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key));
pairs[i].needfree = true;
- if (!SvOK(value))
+ if (!value || !SvOK(value))
{
pairs[i].val = NULL;
pairs[i].vallen = 0;
diff --git a/contrib/hstore_plperl/sql/hstore_plperl.sql b/contrib/hstore_plperl/sql/hstore_plperl.sql
index ad1db7eae17..9624453b2df 100644
--- a/contrib/hstore_plperl/sql/hstore_plperl.sql
+++ b/contrib/hstore_plperl/sql/hstore_plperl.sql
@@ -54,6 +54,31 @@ SELECT test2();
DROP FUNCTION test2();
DROP FUNCTION test2arr();
+-- Tied hash via an inline class (no Tie::Hash).
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl
+TRANSFORM FOR TYPE hstore
+AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1';
+ $h{b} = '2';
+ $h{c} = undef;
+ return \%h;
+$$;
+
+SELECT tied_hstore();
+
+DROP FUNCTION tied_hstore();
+
DROP EXTENSION hstore_plperl;
DROP EXTENSION hstore;
diff --git a/src/pl/plperl/expected/plperl.out b/src/pl/plperl/expected/plperl.out
index e3d7c8896a2..4fedc2c62b0 100644
--- a/src/pl/plperl/expected/plperl.out
+++ b/src/pl/plperl/expected/plperl.out
@@ -792,3 +792,28 @@ SELECT self_modify(42);
126
(1 row)
+-- Tied array via an inline class (no Tie::Array). av_fetch on a tied
+-- array never returns NULL, so walking until it does would not stop.
+CREATE OR REPLACE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a';
+ $a[1] = 'b';
+ $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_setof();
+ tied_setof
+------------
+ a
+ b
+ c
+(3 rows)
+
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..14cb7a21162 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -2478,14 +2478,18 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (sav)
{
dTHX;
- int i = 0;
- SV **svp = 0;
AV *rav = (AV *) SvRV(sav);
+ int alen = av_len(rav) + 1;
- while ((svp = av_fetch(rav, i, FALSE)) != NULL)
+ for (int i = 0; i < alen; i++)
{
- plperl_return_next_internal(*svp);
- i++;
+ SV **svp = av_fetch(rav, i, FALSE);
+
+ if (svp)
+ {
+ SvGETMAGIC(*svp);
+ plperl_return_next_internal(*svp);
+ }
}
}
else if (SvOK(perlret))
diff --git a/src/pl/plperl/sql/plperl.sql b/src/pl/plperl/sql/plperl.sql
index bb0b8ce4cb6..d5f37e5e16e 100644
--- a/src/pl/plperl/sql/plperl.sql
+++ b/src/pl/plperl/sql/plperl.sql
@@ -521,3 +521,24 @@ $$ LANGUAGE plperl;
SELECT self_modify(42);
SELECT self_modify(42);
+
+-- Tied array via an inline class (no Tie::Array). av_fetch on a tied
+-- array never returns NULL, so walking until it does would not stop.
+CREATE OR REPLACE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a';
+ $a[1] = 'b';
+ $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+
+SELECT * FROM tied_setof();
+
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-16 20:26 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-16 20:26 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
> A tied hash does not store the value in HeVAL(). hv_iternext() leaves that
> pointer unset. Tom's NULL check therefore always takes the SQL NULL path,
> even when FETCH would return a real value. hv_iterval() plus SvGETMAGIC()
> is what actually runs FETCH.
> The same applies to a tied array. av_len() stops the infinite loop, but
> av_fetch() still returns a magic SV whose SvOK() is false until GETMAGIC.
> Without that, SETOF also yields NULLs.
Hmm. I confirm that adding SvGETMAGIC() makes the tied-array test
work (didn't try the hash case). But to my previous point, where
else would we need to call it, if we're going to try to support
such cases? Also, what exactly are the preconditions for that
function? Looking at the perl header files here, it looks like
sv being nonnull is required and sufficient ... but your patch
is inconsistent about checking that.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-16 21:40 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-16 21:40 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 01:26, Tom Lane <tgl@sss.pgh.pa.us>:
> But to my previous point, where
> else would we need to call it, if we're going to try to support
> such cases? Also, what exactly are the preconditions for that
> function?
If we want a tied hash or array to convert like an ordinary one, GETMAGIC
is still needed before SvOK() / SvROK() in plperl_sv_to_datum() and
jsonb_plperl's SV_to_JsonbValue(). plperl_build_tuple_result() still
uses HeVAL() and will crash on a tied hash the same way hstore_plperl
did. That loop also calls hek2cstr(), which uses FREETMPS, so
hek2cstr() has to run before hv_iterval().
The trigger path does not return a hash. After "MODIFY",
plperl_modify_tuple() walks $_TD->{new} with HeVAL(). PL/Perl already
filled that hash from the tuple, so it is not tied. A crash would
need the trigger to tie that hash itself, for example
tie %{$_TD->{new}}, 'SomeTie';
$_TD->{new}{v} = 'from_tie';
return 'MODIFY';
Looking at the perl header files here, it looks like
> sv being nonnull is required and sufficient ... but your patch
> is inconsistent about checking that.
>
> Yes. Non-NULL is required and sufficient.
The extra NULL checks on the hstore side are not needed after
hv_iterval(). I left the old HeVAL() guards in because the point was
to show that FETCH results are available, and why a NULL check on
HeVAL() always yields SQL NULL. The if (svp) in the SETOF loop is
only because av_fetch() returns NULL for a missing element.
> That seems odd, given that we use Tie::Hash and Tie::StdHash in
> src/pl/plperl/plc_trusted.pl
Trusted plperl replaces require with pp_require_safe, which only
succeeds if the module is already in %INC. Otherwise it dies with
"Unable to load Tie/Array.pm into plperl". tie itself is allowed.
plperlu can load the modules as usual.
Proof:
```
\set ON_ERROR_STOP off
CREATE EXTENSION IF NOT EXISTS plperl;
CREATE EXTENSION IF NOT EXISTS plperlu;
\echo === 1) plperl: use Tie::Array ===
CREATE OR REPLACE FUNCTION try_use_tie_array() RETURNS text
LANGUAGE plperl AS $$
use Tie::Array;
return 'loaded';
$$;
SELECT try_use_tie_array();
\echo === 3) plperl: tie with inline class (no use) ===
CREATE OR REPLACE FUNCTION try_tie_inline() RETURNS text
LANGUAGE plperl AS $$
{
package PLPerlProofTie;
sub TIEARRAY { bless [], $_[0] }
sub STORE { $_[0][$_[1]] = $_[2] }
sub FETCH { $_[0][$_[1]] }
sub FETCHSIZE { scalar @{$_[0]} }
}
my @a;
tie @a, 'PLPerlProofTie';
$a[0] = 'ok';
return $a[0];
$$;
SELECT try_tie_inline();
\echo === 4) plperlu: use Tie::Array ===
CREATE OR REPLACE FUNCTION try_use_tie_array_u() RETURNS text
LANGUAGE plperlu AS $$
use Tie::Array;
return 'loaded';
$$;
SELECT try_use_tie_array_u();
```
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-16 22:24 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-16 22:24 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 02:40, Andrey Rachitskiy <pl0h0yp1@gmail.com>:
> If we want a tied hash or array to convert like an ordinary one, GETMAGIC
> is still needed before SvOK() / SvROK() in plperl_sv_to_datum() and
> jsonb_plperl's SV_to_JsonbValue(). plperl_build_tuple_result() still
> uses HeVAL() and will crash on a tied hash the same way hstore_plperl
> did. That loop also calls hek2cstr(), which uses FREETMPS, so
> hek2cstr() has to run before hv_iterval().
>
>
The first patch tries to close every Perl-to-SQL path that still
ignored FETCH on tied values.
The trigger path does not return a hash. After "MODIFY",
plperl_modify_tuple() walks $_TD->{new}. That hash is normally filled
by PL/Perl from the tuple, so it is not tied. The loop is still fixed,
so the HeVAL() bug is not left behind if a trigger replaces that hash
with a tied one.
The second patch is regress only. Separate files cover the cases the
code patch touches: SETOF text, scalar text, composite, integer[], a
BEFORE INSERT trigger that swaps in a tied $_TD->{new}, hstore, and
jsonb. The classes are small inline TIEHASH / TIEARRAY / TIESCALAR
helpers, not Tie::Hash or Tie::Array.
--
Regards,
Rachitskiy Andrey
Attachments:
[text/x-patch] 0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch (3.7K, ../../CAB8bMisM-qSPw2qVnyjTp862LVAKpfX33_y-H1MBGzjAfwAQcg@mail.gmail.com/3-0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch)
download | inline diff:
From: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Subject: [PATCH 1/2] Honor Perl FETCH for tied hashes and arrays
Tied hashes leave HeVAL() unset after hv_iternext(). Call hv_iterval()
and SvGETMAGIC() so FETCH actually runs. For SETOF arrays, walk with
av_len() and run GETMAGIC on each element.
Apply the same pattern in plperl_sv_to_datum(), jsonb_plperl, and the
composite and trigger hash walkers.
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index d7f1b8ddb48..ad205c8bcfc 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -138,7 +138,14 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
while ((he = hv_iternext(hv)))
{
char *key = sv2cstr(HeSVKEY_force(he));
- SV *value = HeVAL(he);
+ SV *value;
+
+ /*
+ * Tied hashes leave HeVAL() unset. hv_iterval() plus
+ * SvGETMAGIC() runs FETCH.
+ */
+ value = hv_iterval(hv, he);
+ SvGETMAGIC(value);
if (i >= pcount)
{
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 97d147cc65a..097c43cfb08 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -186,6 +186,9 @@ SV_to_JsonbValue(SV *in, JsonbInState *jsonb_state, bool is_elem)
/* this can recurse via AV_to_JsonbValue() or HV_to_JsonbValue() */
check_stack_depth();
+ /* Tied values leave SvOK() false until FETCH. */
+ SvGETMAGIC(in);
+
/* Dereference references recursively. */
while (SvROK(in))
{
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..4910bb1f80b 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1092,11 +1092,19 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td)
hv_iterinit(perlhash);
while ((he = hv_iternext(perlhash)))
{
- SV *val = HeVAL(he);
- char *key = hek2cstr(he);
- int attn = SPI_fnumber(td, key);
+ char *key;
+ SV *val;
+ int attn;
Form_pg_attribute attr;
+ /*
+ * Tied hashes leave HeVAL() unset. hek2cstr() uses FREETMPS, so
+ * it must run before hv_iterval().
+ */
+ key = hek2cstr(he);
+ val = hv_iterval(perlhash, he);
+ attn = SPI_fnumber(td, key);
+
if (attn == SPI_ERROR_NOATTRIBUTE)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
@@ -1348,6 +1356,12 @@ plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
* VOID. In the latter case, we should pay no attention to the last Perl
* statement's result, and this is a convenient means to ensure that.
*/
+ if (sv)
+ {
+ dTHX;
+ SvGETMAGIC(sv);
+ }
+
if (!sv || !SvOK(sv) || typid == VOIDOID)
{
/* look up type info if they did not pass it */
@@ -1803,11 +1817,16 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
hv_iterinit(hvNew);
while ((he = hv_iternext(hvNew)))
{
- char *key = hek2cstr(he);
- SV *val = HeVAL(he);
- int attn = SPI_fnumber(tupdesc, key);
+ char *key;
+ SV *val;
+ int attn;
Form_pg_attribute attr;
+ /* hek2cstr() uses FREETMPS, so it must run before hv_iterval(). */
+ key = hek2cstr(he);
+ val = hv_iterval(hvNew, he);
+ attn = SPI_fnumber(tupdesc, key);
+
if (attn == SPI_ERROR_NOATTRIBUTE)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
@@ -2478,14 +2497,18 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (sav)
{
dTHX;
- int i = 0;
- SV **svp = 0;
AV *rav = (AV *) SvRV(sav);
+ int alen = av_len(rav) + 1;
- while ((svp = av_fetch(rav, i, FALSE)) != NULL)
+ for (int i = 0; i < alen; i++)
{
- plperl_return_next_internal(*svp);
- i++;
+ SV **svp = av_fetch(rav, i, FALSE);
+
+ if (svp)
+ {
+ SvGETMAGIC(*svp);
+ plperl_return_next_internal(*svp);
+ }
}
}
else if (SvOK(perlret))
[text/x-patch] 0002-Add-regress-tests-for-tied-Perl-hashes-and-arrays.patch (12.5K, ../../CAB8bMisM-qSPw2qVnyjTp862LVAKpfX33_y-H1MBGzjAfwAQcg@mail.gmail.com/4-0002-Add-regress-tests-for-tied-Perl-hashes-and-arrays.patch)
download | inline diff:
From: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Subject: [PATCH 2/2] Add regress tests for tied Perl hashes and arrays
Inline tie classes without Tie::Hash / Tie::Array. Trusted plperl
cannot require those modules. Shared class setup is only in
plperl_tied, where several functions reuse it.
diff --git a/contrib/hstore_plperl/Makefile b/contrib/hstore_plperl/Makefile
index 9065f164088..efb0640902c 100644
--- a/contrib/hstore_plperl/Makefile
+++ b/contrib/hstore_plperl/Makefile
@@ -10,7 +10,7 @@ PGFILEDESC = "hstore_plperl - hstore transform for plperl"
EXTENSION = hstore_plperl hstore_plperlu
DATA = hstore_plperl--1.0.sql hstore_plperlu--1.0.sql
-REGRESS = hstore_plperl hstore_plperlu create_transform
+REGRESS = hstore_plperl hstore_plperlu hstore_plperl_tied create_transform
EXTRA_INSTALL = contrib/hstore
ifdef USE_PGXS
diff --git a/contrib/hstore_plperl/expected/hstore_plperl_tied.out b/contrib/hstore_plperl/expected/hstore_plperl_tied.out
new file mode 100644
index 00000000000..2cd85facd5a
--- /dev/null
+++ b/contrib/hstore_plperl/expected/hstore_plperl_tied.out
@@ -0,0 +1,26 @@
+CREATE EXTENSION hstore_plperl CASCADE;
+NOTICE: installing required extension "hstore"
+NOTICE: installing required extension "plperl"
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1'; $h{b} = '2'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_hstore();
+ tied_hstore
+-------------------------------
+ "a"=>"1", "b"=>"2", "c"=>NULL
+(1 row)
+
+DROP FUNCTION tied_hstore();
+DROP EXTENSION hstore_plperl, hstore, plperl;
diff --git a/contrib/hstore_plperl/meson.build b/contrib/hstore_plperl/meson.build
index 705dbe69a46..0f12bdc7101 100644
--- a/contrib/hstore_plperl/meson.build
+++ b/contrib/hstore_plperl/meson.build
@@ -45,6 +45,7 @@ tests += {
'sql': [
'hstore_plperl',
'hstore_plperlu',
+ 'hstore_plperl_tied',
'create_transform',
],
},
diff --git a/contrib/hstore_plperl/sql/hstore_plperl_tied.sql b/contrib/hstore_plperl/sql/hstore_plperl_tied.sql
new file mode 100644
index 00000000000..229b7bbaecf
--- /dev/null
+++ b/contrib/hstore_plperl/sql/hstore_plperl_tied.sql
@@ -0,0 +1,21 @@
+CREATE EXTENSION hstore_plperl CASCADE;
+
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1'; $h{b} = '2'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_hstore();
+
+DROP FUNCTION tied_hstore();
+DROP EXTENSION hstore_plperl, hstore, plperl;
diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile
index ba9480e819b..8f8ea1ff2e7 100644
--- a/contrib/jsonb_plperl/Makefile
+++ b/contrib/jsonb_plperl/Makefile
@@ -11,7 +11,7 @@ PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
EXTENSION = jsonb_plperlu jsonb_plperl
DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
-REGRESS = jsonb_plperl jsonb_plperlu
+REGRESS = jsonb_plperl jsonb_plperlu jsonb_plperl_tied
SHLIB_LINK += $(filter -lm, $(LIBS))
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out b/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out
new file mode 100644
index 00000000000..74acace939c
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out
@@ -0,0 +1,45 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+NOTICE: installing required extension "plperl"
+CREATE FUNCTION tied_jsonb_hash() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = 1; $h{b} = 'boo'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_jsonb_hash();
+ tied_jsonb_hash
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION tied_jsonb_array() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 'boo';
+ return \@a;
+$$;
+SELECT tied_jsonb_array();
+ tied_jsonb_array
+------------------
+ [1, "boo"]
+(1 row)
+
+DROP FUNCTION tied_jsonb_hash(), tied_jsonb_array();
+DROP EXTENSION jsonb_plperl, plperl;
diff --git a/contrib/jsonb_plperl/meson.build b/contrib/jsonb_plperl/meson.build
index 8bfabee5455..27654ce8d55 100644
--- a/contrib/jsonb_plperl/meson.build
+++ b/contrib/jsonb_plperl/meson.build
@@ -46,6 +46,7 @@ tests += {
'sql': [
'jsonb_plperl',
'jsonb_plperlu',
+ 'jsonb_plperl_tied',
],
},
}
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql b/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql
new file mode 100644
index 00000000000..e687547d682
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql
@@ -0,0 +1,37 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+
+CREATE FUNCTION tied_jsonb_hash() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = 1; $h{b} = 'boo'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_jsonb_hash();
+
+CREATE FUNCTION tied_jsonb_array() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 'boo';
+ return \@a;
+$$;
+SELECT tied_jsonb_array();
+
+DROP FUNCTION tied_jsonb_hash(), tied_jsonb_array();
+DROP EXTENSION jsonb_plperl, plperl;
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index d7c8917f822..85729434853 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -63,7 +63,7 @@ endif
REGRESS_OPTS = --dbname=$(PL_TESTDB) --dlpath=$(top_builddir)/src/test/regress
REGRESS = plperl_setup plperl plperl_lc plperl_trigger plperl_shared \
plperl_elog plperl_unicode plperl_util plperl_init plperlu plperl_array \
- plperl_call plperl_transaction plperl_env
+ plperl_call plperl_transaction plperl_env plperl_tied
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
diff --git a/src/pl/plperl/expected/plperl_tied.out b/src/pl/plperl/expected/plperl_tied.out
new file mode 100644
index 00000000000..1bb67cff356
--- /dev/null
+++ b/src/pl/plperl/expected/plperl_tied.out
@@ -0,0 +1,98 @@
+-- Tied Perl values via inline classes (no Tie::Hash / Tie::Array).
+-- Trusted plperl cannot require those modules.
+DO $$
+{
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+
+ package PLPerlTiedScalar;
+ sub TIESCALAR { my $s; bless \$s, $_[0] }
+ sub STORE { ${$_[0]} = $_[1] }
+ sub FETCH { ${$_[0]} }
+}
+$$ LANGUAGE plperl;
+CREATE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a'; $a[1] = 'b'; $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_setof();
+ tied_setof
+------------
+ a
+ b
+ c
+(3 rows)
+
+CREATE FUNCTION tied_scalar() RETURNS text AS $$
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = 'hello';
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar();
+ tied_scalar
+-------------
+ hello
+(1 row)
+
+CREATE TYPE tiedrowperl AS (f1 integer, f2 text, f3 text);
+CREATE FUNCTION tied_composite() RETURNS tiedrowperl AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{f1} = 1; $h{f2} = 'hello'; $h{f3} = 'world';
+ return \%h;
+$$ LANGUAGE plperl;
+SELECT tied_composite();
+ tied_composite
+-----------------
+ (1,hello,world)
+(1 row)
+
+CREATE FUNCTION tied_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 2; $a[2] = 3;
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT tied_int_array();
+ tied_int_array
+----------------
+ {1,2,3}
+(1 row)
+
+-- Artificial: replace $_TD->{new} with a tied hash.
+CREATE TABLE tied_trigger_test (i int, v text);
+CREATE FUNCTION tied_modify() RETURNS trigger AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{i} = $_TD->{new}{i};
+ $h{v} = 'from_tie';
+ $_TD->{new} = \%h;
+ return 'MODIFY';
+$$ LANGUAGE plperl;
+CREATE TRIGGER tied_modify_trig BEFORE INSERT ON tied_trigger_test
+FOR EACH ROW EXECUTE PROCEDURE tied_modify();
+INSERT INTO tied_trigger_test (i, v) VALUES (1, 'orig');
+SELECT i, v FROM tied_trigger_test;
+ i | v
+---+----------
+ 1 | from_tie
+(1 row)
+
+DROP TRIGGER tied_modify_trig ON tied_trigger_test;
+DROP FUNCTION tied_modify(), tied_setof(), tied_scalar(),
+ tied_composite(), tied_int_array();
+DROP TABLE tied_trigger_test;
+DROP TYPE tiedrowperl;
diff --git a/src/pl/plperl/meson.build b/src/pl/plperl/meson.build
index ff41812ca46..5c055f4f662 100644
--- a/src/pl/plperl/meson.build
+++ b/src/pl/plperl/meson.build
@@ -96,6 +96,7 @@ tests += {
'plperl_call',
'plperl_transaction',
'plperl_env',
+ 'plperl_tied',
],
'regress_args': ['--dlpath', meson.project_build_root() / 'src/test/regress'],
},
diff --git a/src/pl/plperl/sql/plperl_tied.sql b/src/pl/plperl/sql/plperl_tied.sql
new file mode 100644
index 00000000000..bf0498c8592
--- /dev/null
+++ b/src/pl/plperl/sql/plperl_tied.sql
@@ -0,0 +1,78 @@
+-- Tied Perl values via inline classes (no Tie::Hash / Tie::Array).
+-- Trusted plperl cannot require those modules.
+
+DO $$
+{
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+
+ package PLPerlTiedScalar;
+ sub TIESCALAR { my $s; bless \$s, $_[0] }
+ sub STORE { ${$_[0]} = $_[1] }
+ sub FETCH { ${$_[0]} }
+}
+$$ LANGUAGE plperl;
+
+CREATE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a'; $a[1] = 'b'; $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_setof();
+
+CREATE FUNCTION tied_scalar() RETURNS text AS $$
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = 'hello';
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar();
+
+CREATE TYPE tiedrowperl AS (f1 integer, f2 text, f3 text);
+CREATE FUNCTION tied_composite() RETURNS tiedrowperl AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{f1} = 1; $h{f2} = 'hello'; $h{f3} = 'world';
+ return \%h;
+$$ LANGUAGE plperl;
+SELECT tied_composite();
+
+CREATE FUNCTION tied_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 2; $a[2] = 3;
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT tied_int_array();
+
+-- Artificial: replace $_TD->{new} with a tied hash.
+CREATE TABLE tied_trigger_test (i int, v text);
+CREATE FUNCTION tied_modify() RETURNS trigger AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{i} = $_TD->{new}{i};
+ $h{v} = 'from_tie';
+ $_TD->{new} = \%h;
+ return 'MODIFY';
+$$ LANGUAGE plperl;
+CREATE TRIGGER tied_modify_trig BEFORE INSERT ON tied_trigger_test
+FOR EACH ROW EXECUTE PROCEDURE tied_modify();
+INSERT INTO tied_trigger_test (i, v) VALUES (1, 'orig');
+SELECT i, v FROM tied_trigger_test;
+
+DROP TRIGGER tied_modify_trig ON tied_trigger_test;
+DROP FUNCTION tied_modify(), tied_setof(), tied_scalar(),
+ tied_composite(), tied_int_array();
+DROP TABLE tied_trigger_test;
+DROP TYPE tiedrowperl;
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-17 06:05 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-17 06:05 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 03:24, Andrey Rachitskiy <pl0h0yp1@gmail.com>:
> The first patch tries to close every Perl-to-SQL path that still
> ignored FETCH on tied values.
>
> I have attached v2.
The previous version missed a few GETMAGIC call sites:
get_perl_array_ref(), the trigger return value, $_TD->{new} before
the SvOK() / SvROK() checks, and the start of return_next(). A tied
scalar whose FETCH returns an arrayref or a hashref still looked like
undef.
That also made the SETOF walker cleaner. The loop only walks with
av_len() and calls return_next(). FETCH lives in return_next() and
plperl_sv_to_datum(), so the loop does not run GETMAGIC on each
element itself.
The regress patch covers those cases. tied_scalar_setof and
tied_scalar_int_array wrap an arrayref in a tied scalar. tied_modify
uses tied scalars for $_TD->{new} and for the "MODIFY" return.
--
Regards,
Rachitskiy Andrey
Attachments:
[text/x-patch] v2-0002-Add-regress-tests-for-tied-Perl-hashes-and-arrays.patch (14.1K, ../../CAB8bMivZFmWh9vvkF5HBT+Cy9y=nA2NbGhxQapGPUaZ-mNerSA@mail.gmail.com/3-v2-0002-Add-regress-tests-for-tied-Perl-hashes-and-arrays.patch)
download | inline diff:
From: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Subject: [PATCH 2/2] Add regress tests for tied Perl hashes and arrays
Inline tie classes without Tie::Hash / Tie::Array. Trusted plperl
cannot require those modules. Shared class setup is only in
plperl_tied, where several functions reuse it. Include tied scalars
that wrap arrayrefs and trigger return / $_TD->{new} values.
diff --git a/contrib/hstore_plperl/Makefile b/contrib/hstore_plperl/Makefile
index 9065f164088..efb0640902c 100644
--- a/contrib/hstore_plperl/Makefile
+++ b/contrib/hstore_plperl/Makefile
@@ -10,7 +10,7 @@ PGFILEDESC = "hstore_plperl - hstore transform for plperl"
EXTENSION = hstore_plperl hstore_plperlu
DATA = hstore_plperl--1.0.sql hstore_plperlu--1.0.sql
-REGRESS = hstore_plperl hstore_plperlu create_transform
+REGRESS = hstore_plperl hstore_plperlu hstore_plperl_tied create_transform
EXTRA_INSTALL = contrib/hstore
ifdef USE_PGXS
diff --git a/contrib/hstore_plperl/expected/hstore_plperl_tied.out b/contrib/hstore_plperl/expected/hstore_plperl_tied.out
new file mode 100644
index 00000000000..2cd85facd5a
--- /dev/null
+++ b/contrib/hstore_plperl/expected/hstore_plperl_tied.out
@@ -0,0 +1,26 @@
+CREATE EXTENSION hstore_plperl CASCADE;
+NOTICE: installing required extension "hstore"
+NOTICE: installing required extension "plperl"
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1'; $h{b} = '2'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_hstore();
+ tied_hstore
+-------------------------------
+ "a"=>"1", "b"=>"2", "c"=>NULL
+(1 row)
+
+DROP FUNCTION tied_hstore();
+DROP EXTENSION hstore_plperl, hstore, plperl;
diff --git a/contrib/hstore_plperl/meson.build b/contrib/hstore_plperl/meson.build
index 705dbe69a46..0f12bdc7101 100644
--- a/contrib/hstore_plperl/meson.build
+++ b/contrib/hstore_plperl/meson.build
@@ -45,6 +45,7 @@ tests += {
'sql': [
'hstore_plperl',
'hstore_plperlu',
+ 'hstore_plperl_tied',
'create_transform',
],
},
diff --git a/contrib/hstore_plperl/sql/hstore_plperl_tied.sql b/contrib/hstore_plperl/sql/hstore_plperl_tied.sql
new file mode 100644
index 00000000000..229b7bbaecf
--- /dev/null
+++ b/contrib/hstore_plperl/sql/hstore_plperl_tied.sql
@@ -0,0 +1,21 @@
+CREATE EXTENSION hstore_plperl CASCADE;
+
+CREATE FUNCTION tied_hstore() RETURNS hstore
+LANGUAGE plperl TRANSFORM FOR TYPE hstore AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = '1'; $h{b} = '2'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_hstore();
+
+DROP FUNCTION tied_hstore();
+DROP EXTENSION hstore_plperl, hstore, plperl;
diff --git a/contrib/jsonb_plperl/Makefile b/contrib/jsonb_plperl/Makefile
index ba9480e819b..8f8ea1ff2e7 100644
--- a/contrib/jsonb_plperl/Makefile
+++ b/contrib/jsonb_plperl/Makefile
@@ -11,7 +11,7 @@ PG_CPPFLAGS = -I$(top_srcdir)/src/pl/plperl
EXTENSION = jsonb_plperlu jsonb_plperl
DATA = jsonb_plperlu--1.0.sql jsonb_plperl--1.0.sql
-REGRESS = jsonb_plperl jsonb_plperlu
+REGRESS = jsonb_plperl jsonb_plperlu jsonb_plperl_tied
SHLIB_LINK += $(filter -lm, $(LIBS))
diff --git a/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out b/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out
new file mode 100644
index 00000000000..74acace939c
--- /dev/null
+++ b/contrib/jsonb_plperl/expected/jsonb_plperl_tied.out
@@ -0,0 +1,45 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+NOTICE: installing required extension "plperl"
+CREATE FUNCTION tied_jsonb_hash() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = 1; $h{b} = 'boo'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_jsonb_hash();
+ tied_jsonb_hash
+---------------------------------
+ {"a": 1, "b": "boo", "c": null}
+(1 row)
+
+CREATE FUNCTION tied_jsonb_array() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 'boo';
+ return \@a;
+$$;
+SELECT tied_jsonb_array();
+ tied_jsonb_array
+------------------
+ [1, "boo"]
+(1 row)
+
+DROP FUNCTION tied_jsonb_hash(), tied_jsonb_array();
+DROP EXTENSION jsonb_plperl, plperl;
diff --git a/contrib/jsonb_plperl/meson.build b/contrib/jsonb_plperl/meson.build
index 8bfabee5455..27654ce8d55 100644
--- a/contrib/jsonb_plperl/meson.build
+++ b/contrib/jsonb_plperl/meson.build
@@ -46,6 +46,7 @@ tests += {
'sql': [
'jsonb_plperl',
'jsonb_plperlu',
+ 'jsonb_plperl_tied',
],
},
}
diff --git a/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql b/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql
new file mode 100644
index 00000000000..e687547d682
--- /dev/null
+++ b/contrib/jsonb_plperl/sql/jsonb_plperl_tied.sql
@@ -0,0 +1,37 @@
+CREATE EXTENSION jsonb_plperl CASCADE;
+
+CREATE FUNCTION tied_jsonb_hash() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+ }
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{a} = 1; $h{b} = 'boo'; $h{c} = undef;
+ return \%h;
+$$;
+SELECT tied_jsonb_hash();
+
+CREATE FUNCTION tied_jsonb_array() RETURNS jsonb
+LANGUAGE plperl TRANSFORM FOR TYPE jsonb AS $$
+ {
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+ }
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 'boo';
+ return \@a;
+$$;
+SELECT tied_jsonb_array();
+
+DROP FUNCTION tied_jsonb_hash(), tied_jsonb_array();
+DROP EXTENSION jsonb_plperl, plperl;
diff --git a/src/pl/plperl/GNUmakefile b/src/pl/plperl/GNUmakefile
index d7c8917f822..85729434853 100644
--- a/src/pl/plperl/GNUmakefile
+++ b/src/pl/plperl/GNUmakefile
@@ -63,7 +63,7 @@ endif
REGRESS_OPTS = --dbname=$(PL_TESTDB) --dlpath=$(top_builddir)/src/test/regress
REGRESS = plperl_setup plperl plperl_lc plperl_trigger plperl_shared \
plperl_elog plperl_unicode plperl_util plperl_init plperlu plperl_array \
- plperl_call plperl_transaction plperl_env
+ plperl_call plperl_transaction plperl_env plperl_tied
# if Perl can support two interpreters in one backend,
# test plperl-and-plperlu cases
ifneq ($(PERL),)
diff --git a/src/pl/plperl/expected/plperl_tied.out b/src/pl/plperl/expected/plperl_tied.out
new file mode 100644
index 00000000000..3d09085b955
--- /dev/null
+++ b/src/pl/plperl/expected/plperl_tied.out
@@ -0,0 +1,137 @@
+-- Tied Perl values via inline classes (no Tie::Hash / Tie::Array).
+-- Trusted plperl cannot require those modules.
+DO $$
+{
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+
+ package PLPerlTiedScalar;
+ sub TIESCALAR { my $s; bless \$s, $_[0] }
+ sub STORE { ${$_[0]} = $_[1] }
+ sub FETCH { ${$_[0]} }
+}
+$$ LANGUAGE plperl;
+CREATE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a'; $a[1] = 'b'; $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_setof();
+ tied_setof
+------------
+ a
+ b
+ c
+(3 rows)
+
+CREATE FUNCTION tied_scalar() RETURNS text AS $$
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = 'hello';
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar();
+ tied_scalar
+-------------
+ hello
+(1 row)
+
+CREATE TYPE tiedrowperl AS (f1 integer, f2 text, f3 text);
+CREATE FUNCTION tied_composite() RETURNS tiedrowperl AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{f1} = 1; $h{f2} = 'hello'; $h{f3} = 'world';
+ return \%h;
+$$ LANGUAGE plperl;
+SELECT tied_composite();
+ tied_composite
+-----------------
+ (1,hello,world)
+(1 row)
+
+CREATE FUNCTION tied_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 2; $a[2] = 3;
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT tied_int_array();
+ tied_int_array
+----------------
+ {1,2,3}
+(1 row)
+
+-- Tied scalar whose FETCH returns an arrayref.
+CREATE FUNCTION tied_scalar_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'x'; $a[1] = 'y';
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = \@a;
+ return $s;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_scalar_setof();
+ tied_scalar_setof
+-------------------
+ x
+ y
+(2 rows)
+
+CREATE FUNCTION tied_scalar_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 4; $a[1] = 5;
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = \@a;
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar_int_array();
+ tied_scalar_int_array
+-----------------------
+ {4,5}
+(1 row)
+
+-- Artificial: $_TD->{new} and the trigger return value are tied scalars.
+CREATE TABLE tied_trigger_test (i int, v text);
+CREATE FUNCTION tied_modify() RETURNS trigger AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{i} = $_TD->{new}{i};
+ $h{v} = 'from_tie';
+ my $new;
+ tie $new, 'PLPerlTiedScalar';
+ $new = \%h;
+ $_TD->{new} = $new;
+ my $ret;
+ tie $ret, 'PLPerlTiedScalar';
+ $ret = 'MODIFY';
+ return $ret;
+$$ LANGUAGE plperl;
+CREATE TRIGGER tied_modify_trig BEFORE INSERT ON tied_trigger_test
+FOR EACH ROW EXECUTE PROCEDURE tied_modify();
+INSERT INTO tied_trigger_test (i, v) VALUES (1, 'orig');
+SELECT i, v FROM tied_trigger_test;
+ i | v
+---+----------
+ 1 | from_tie
+(1 row)
+
+DROP TRIGGER tied_modify_trig ON tied_trigger_test;
+DROP FUNCTION tied_modify(), tied_setof(), tied_scalar(),
+ tied_composite(), tied_int_array(),
+ tied_scalar_setof(), tied_scalar_int_array();
+DROP TABLE tied_trigger_test;
+DROP TYPE tiedrowperl;
diff --git a/src/pl/plperl/meson.build b/src/pl/plperl/meson.build
index ff41812ca46..5c055f4f662 100644
--- a/src/pl/plperl/meson.build
+++ b/src/pl/plperl/meson.build
@@ -96,6 +96,7 @@ tests += {
'plperl_call',
'plperl_transaction',
'plperl_env',
+ 'plperl_tied',
],
'regress_args': ['--dlpath', meson.project_build_root() / 'src/test/regress'],
},
diff --git a/src/pl/plperl/sql/plperl_tied.sql b/src/pl/plperl/sql/plperl_tied.sql
new file mode 100644
index 00000000000..7701a53839b
--- /dev/null
+++ b/src/pl/plperl/sql/plperl_tied.sql
@@ -0,0 +1,108 @@
+-- Tied Perl values via inline classes (no Tie::Hash / Tie::Array).
+-- Trusted plperl cannot require those modules.
+
+DO $$
+{
+ package PLPerlTiedHash;
+ sub TIEHASH { bless {}, $_[0] }
+ sub STORE { $_[0]{$_[1]} = $_[2] }
+ sub FETCH { $_[0]{$_[1]} }
+ sub FIRSTKEY { my $a = keys %{$_[0]}; each %{$_[0]} }
+ sub NEXTKEY { each %{$_[0]} }
+
+ package PLPerlTiedArray;
+ sub TIEARRAY { bless [], $_[0] }
+ sub STORE { $_[0][$_[1]] = $_[2] }
+ sub FETCH { $_[0][$_[1]] }
+ sub FETCHSIZE { scalar @{$_[0]} }
+
+ package PLPerlTiedScalar;
+ sub TIESCALAR { my $s; bless \$s, $_[0] }
+ sub STORE { ${$_[0]} = $_[1] }
+ sub FETCH { ${$_[0]} }
+}
+$$ LANGUAGE plperl;
+
+CREATE FUNCTION tied_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'a'; $a[1] = 'b'; $a[2] = 'c';
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_setof();
+
+CREATE FUNCTION tied_scalar() RETURNS text AS $$
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = 'hello';
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar();
+
+CREATE TYPE tiedrowperl AS (f1 integer, f2 text, f3 text);
+CREATE FUNCTION tied_composite() RETURNS tiedrowperl AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{f1} = 1; $h{f2} = 'hello'; $h{f3} = 'world';
+ return \%h;
+$$ LANGUAGE plperl;
+SELECT tied_composite();
+
+CREATE FUNCTION tied_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 1; $a[1] = 2; $a[2] = 3;
+ return \@a;
+$$ LANGUAGE plperl;
+SELECT tied_int_array();
+
+-- Tied scalar whose FETCH returns an arrayref.
+CREATE FUNCTION tied_scalar_setof() RETURNS SETOF text AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 'x'; $a[1] = 'y';
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = \@a;
+ return $s;
+$$ LANGUAGE plperl;
+SELECT * FROM tied_scalar_setof();
+
+CREATE FUNCTION tied_scalar_int_array() RETURNS integer[] AS $$
+ my @a;
+ tie @a, 'PLPerlTiedArray';
+ $a[0] = 4; $a[1] = 5;
+ my $s;
+ tie $s, 'PLPerlTiedScalar';
+ $s = \@a;
+ return $s;
+$$ LANGUAGE plperl;
+SELECT tied_scalar_int_array();
+
+-- Artificial: $_TD->{new} and the trigger return value are tied scalars.
+CREATE TABLE tied_trigger_test (i int, v text);
+CREATE FUNCTION tied_modify() RETURNS trigger AS $$
+ my %h;
+ tie %h, 'PLPerlTiedHash';
+ $h{i} = $_TD->{new}{i};
+ $h{v} = 'from_tie';
+ my $new;
+ tie $new, 'PLPerlTiedScalar';
+ $new = \%h;
+ $_TD->{new} = $new;
+ my $ret;
+ tie $ret, 'PLPerlTiedScalar';
+ $ret = 'MODIFY';
+ return $ret;
+$$ LANGUAGE plperl;
+CREATE TRIGGER tied_modify_trig BEFORE INSERT ON tied_trigger_test
+FOR EACH ROW EXECUTE PROCEDURE tied_modify();
+INSERT INTO tied_trigger_test (i, v) VALUES (1, 'orig');
+SELECT i, v FROM tied_trigger_test;
+
+DROP TRIGGER tied_modify_trig ON tied_trigger_test;
+DROP FUNCTION tied_modify(), tied_setof(), tied_scalar(),
+ tied_composite(), tied_int_array(),
+ tied_scalar_setof(), tied_scalar_int_array();
+DROP TABLE tied_trigger_test;
+DROP TYPE tiedrowperl;
[text/x-patch] v2-0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch (5.4K, ../../CAB8bMivZFmWh9vvkF5HBT+Cy9y=nA2NbGhxQapGPUaZ-mNerSA@mail.gmail.com/4-v2-0001-Honor-Perl-FETCH-for-tied-hashes-and-arrays.patch)
download | inline diff:
From: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Subject: [PATCH 1/2] Honor Perl FETCH for tied hashes and arrays
Tied hashes leave HeVAL() unset after hv_iternext(). Call hv_iterval()
and SvGETMAGIC() so FETCH actually runs. For SETOF arrays, walk with
av_len() and run GETMAGIC via return_next / plperl_sv_to_datum.
Apply the same pattern in get_perl_array_ref(), plperl_sv_to_datum(),
jsonb_plperl, composite and trigger hash walkers, and the remaining
SvOK() checks on trigger / return_next entry points.
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index d7f1b8ddb48..ad205c8bcfc 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -138,7 +138,14 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
while ((he = hv_iternext(hv)))
{
char *key = sv2cstr(HeSVKEY_force(he));
- SV *value = HeVAL(he);
+ SV *value;
+
+ /*
+ * Tied hashes leave HeVAL() unset. hv_iterval() plus
+ * SvGETMAGIC() runs FETCH.
+ */
+ value = hv_iterval(hv, he);
+ SvGETMAGIC(value);
if (i >= pcount)
{
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 97d147cc65a..097c43cfb08 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -186,6 +186,9 @@ SV_to_JsonbValue(SV *in, JsonbInState *jsonb_state, bool is_elem)
/* this can recurse via AV_to_JsonbValue() or HV_to_JsonbValue() */
check_stack_depth();
+ /* Tied values leave SvOK() false until FETCH. */
+ SvGETMAGIC(in);
+
/* Dereference references recursively. */
while (SvROK(in))
{
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..874e7e310b6 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1092,11 +1092,19 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td)
hv_iterinit(perlhash);
while ((he = hv_iternext(perlhash)))
{
- SV *val = HeVAL(he);
- char *key = hek2cstr(he);
- int attn = SPI_fnumber(td, key);
+ char *key;
+ SV *val;
+ int attn;
Form_pg_attribute attr;
+ /*
+ * Tied hashes leave HeVAL() unset. hek2cstr() uses FREETMPS, so
+ * it must run before hv_iterval().
+ */
+ key = hek2cstr(he);
+ val = hv_iterval(perlhash, he);
+ attn = SPI_fnumber(td, key);
+
if (attn == SPI_ERROR_NOATTRIBUTE)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
@@ -1145,6 +1153,12 @@ get_perl_array_ref(SV *sv)
{
dTHX;
+ if (!sv)
+ return NULL;
+
+ /* Tied scalars leave SvOK()/SvROK() false until FETCH. */
+ SvGETMAGIC(sv);
+
if (SvOK(sv) && SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
@@ -1154,9 +1168,13 @@ get_perl_array_ref(SV *sv)
HV *hv = (HV *) SvRV(sv);
SV **sav = hv_fetch_string(hv, "array");
- if (sav && *sav && SvOK(*sav) && SvROK(*sav) &&
- SvTYPE(SvRV(*sav)) == SVt_PVAV)
- return *sav;
+ if (sav && *sav)
+ {
+ SvGETMAGIC(*sav);
+ if (SvOK(*sav) && SvROK(*sav) &&
+ SvTYPE(SvRV(*sav)) == SVt_PVAV)
+ return *sav;
+ }
elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
}
@@ -1348,6 +1366,12 @@ plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
* VOID. In the latter case, we should pay no attention to the last Perl
* statement's result, and this is a convenient means to ensure that.
*/
+ if (sv)
+ {
+ dTHX;
+ SvGETMAGIC(sv);
+ }
+
if (!sv || !SvOK(sv) || typid == VOIDOID)
{
/* look up type info if they did not pass it */
@@ -1787,6 +1811,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist")));
+ SvGETMAGIC(*svp);
if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
@@ -1803,11 +1828,16 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
hv_iterinit(hvNew);
while ((he = hv_iternext(hvNew)))
{
- char *key = hek2cstr(he);
- SV *val = HeVAL(he);
- int attn = SPI_fnumber(tupdesc, key);
+ char *key;
+ SV *val;
+ int attn;
Form_pg_attribute attr;
+ /* hek2cstr() uses FREETMPS, so it must run before hv_iterval(). */
+ key = hek2cstr(he);
+ val = hv_iterval(hvNew, he);
+ attn = SPI_fnumber(tupdesc, key);
+
if (attn == SPI_ERROR_NOATTRIBUTE)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
@@ -2478,14 +2508,15 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (sav)
{
dTHX;
- int i = 0;
- SV **svp = 0;
AV *rav = (AV *) SvRV(sav);
+ int alen = av_len(rav) + 1;
- while ((svp = av_fetch(rav, i, FALSE)) != NULL)
+ for (int i = 0; i < alen; i++)
{
- plperl_return_next_internal(*svp);
- i++;
+ SV **svp = av_fetch(rav, i, FALSE);
+
+ if (svp)
+ plperl_return_next_internal(*svp);
}
}
else if (SvOK(perlret))
@@ -2573,6 +2604,13 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed");
+ if (perlret)
+ {
+ dTHX;
+
+ SvGETMAGIC(perlret);
+ }
+
if (perlret == NULL || !SvOK(perlret))
{
/* undef result means go ahead with original tuple */
@@ -3293,6 +3331,13 @@ plperl_return_next_internal(SV *sv)
if (!sv)
return;
+ {
+ dTHX;
+
+ /* Tied scalars leave SvOK()/SvROK() false until FETCH. */
+ SvGETMAGIC(sv);
+ }
+
prodesc = current_call_data->prodesc;
fcinfo = current_call_data->fcinfo;
rsi = (ReturnSetInfo *) fcinfo->resultinfo;
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-17 15:41 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 2 replies; 29+ messages in thread
From: Tom Lane @ 2026-08-17 15:41 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
> I have attached v2.
v2 looks like a bunch of very random changes. I would like to see
more consistency in the code, ie exactly one pattern for iterating
through hashes and exactly one pattern for iterating through arrays.
We'd not have had the original infinite-loop problem in the first
place if plperl_func_handler() hadn't seen fit to use av_fetch() in a
way randomly different from every other usage. We still have multiple
patterns for iterating through hashes: why do a couple of places use
hv_iternextsv when the others don't? And why do we use hek2cstr
in some places and not others?
(oh, and for extra credit: why is there a second call of hv_iterinit
in plperl_build_tuple_result and plperl_modify_tuple?)
I think we'd be well advised to clean up that inconsistency, and then
inject tied-object handling in the same way in each loop.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-17 16:49 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
1 sibling, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-17 16:49 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
I spent some time digging through the Perl documentation and source
code, and I'm starting to have doubts about this idea of "fix it
by applying SvGETMAGIC to array/hash entries". I can't see anything
in the documentation recommending such an approach, and I don't see
any of their own code doing so either. Pretty much all their calls
to SvGETMAGIC are in functions that have been passed a scalar value
from elsewhere. So while this may work today, I'm unconvinced that
it's idiomatic or future-proof. Can you point at any production code
that is doing it this way?
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-17 17:21 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-17 17:21 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 21:49, Tom Lane <tgl@sss.pgh.pa.us>:
> I spent some time digging through the Perl documentation and source
> code, and I'm starting to have doubts about this idea of "fix it
> by applying SvGETMAGIC to array/hash entries". I can't see anything
> in the documentation recommending such an approach, and I don't see
> any of their own code doing so either. Pretty much all their calls
> to SvGETMAGIC are in functions that have been passed a scalar value
> from elsewhere. So while this may work today, I'm unconvinced that
> it's idiomatic or future-proof. Can you point at any production code
> that is doing it this way?
>
> https://perldoc.perl.org/perlguts - generic C code must call the
SvGETMAGIC() macro to invoke any 'get' magic if they use an SV obtained
from external sources in functions that don't handle magic. See perlapi for
a description of these functions.
https://perldoc.perl.org/perlapi#SvGETMAGIC - This is an idiomatic way.
I can search for the production code, but there are many xs modules on
metacpan and everyone uses this approach, as it is described in the
documentation. As an example, let's use the Encode module
https://github.com/Perl/perl5/blob/c31ca2013f287840fcddf498ead9602666569966/cpan/Encode/Encode
.xs#L349
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-17 17:26 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-17 17:26 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 22:21, Andrey Rachitskiy <pl0h0yp1@gmail.com>:
> As an example, let's use the Encode module
> https://github.com/Perl/perl5/blob/c31ca2013f287840fcddf498ead9602666569966/cpan/Encode/Encode
> .xs#L349
>
sorry, here is the correct link - `
https://github.com/Perl/perl5/blob/c31ca2013f287840fcddf498ead9602666569966/cpan/Encode/Encode.xs#L1...`
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-17 17:58 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:08 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-17 17:58 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
> sorry, here is the correct link - `
> https://github.com/Perl/perl5/blob/c31ca2013f287840fcddf498ead9602666569966/cpan/Encode/Encode.xs#L1...`
Yeah, this is an example of the pattern I was talking about: functions
calling SvGETMAGIC on random SV*'s that are passed to them. What
I do not see is SvGETMAGIC being called on values obtained from
hv_iternext or av_fetch. Maybe all the internal usages in Perl are
working with hashes/arrays that they know aren't tied, but that
seems unlikely.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-17 18:08 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:25 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-17 18:08 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Looking a bit more at the issue of standardizing our
perl-array-scanning code, I noticed that av_len returns SSize_t
not int, creating an overflow risk since we aren't consistent
about assigning the result to something wider than int. This
would only result in truncating the output not anything more
exciting, but it's still bad. Also, it seems from looking at
the Perl sources that they prefer to use av_count() to compute
the loop limit. That's the same as av_len()+1 (except it returns
Size_t), but I think that's a better habit to be in since it
removes the risk of forgetting to add 1. So here is a patch
that just cleans up those issues.
I'm inclined to push this, and separately push a patch to
clean up the inconsistent hash accessing logic, and then deal
with magic objects on top of that.
regards, tom lane
Attachments:
[text/x-diff] v2-0001-Make-plperl-s-handling-of-Perl-arrays-safer-and-m.patch (4.9K, ../../822136.1786990108@sss.pgh.pa.us/2-v2-0001-Make-plperl-s-handling-of-Perl-arrays-safer-and-m.patch)
download | inline diff:
From 51d0d098b82276657fcc4e8d80c87ba3cf514f98 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Mon, 17 Aug 2026 13:37:33 -0400
Subject: [PATCH v2] Make plperl's handling of Perl arrays safer and more
consistent.
plperl_func_handler()'s stanza for handling an arrayref result in
a SETOF function could loop forever (or at least till OOM) when
given a tied array, since av_fetch won't necessarily ever return
a null pointer in that case. Be consistent with the other places
where we traverse a perl array: call av_len() once and use len+1
as the loop limit, silently ignoring any null pointers we get back
from that range of subscripts.
But actually, Perl's preferred locution for this seems to be to
use av_count() not av_len()+1. av_count() seems better since
there's less risk of forgetting to add 1. Also, both of those
functions return Size_t (or SSize_t) not int, creating at least
a theoretical overflow hazard. While we're modernizing this,
let's use the correct variable type where we can, and include an
overflow check where we can't.
Reported-by: Claude Code (via Noah Misch)
Author: Tom Lane <tgl@sss.pgh.pa.us>
Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us
Backpatch-through: 14
---
contrib/jsonb_plperl/jsonb_plperl.c | 5 ++--
src/pl/plperl/plperl.c | 41 ++++++++++++++++++++++-------
2 files changed, 33 insertions(+), 13 deletions(-)
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 97d147cc65a..00a99d303c6 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -135,12 +135,11 @@ static void
AV_to_JsonbValue(AV *in, JsonbInState *jsonb_state)
{
dTHX;
- SSize_t pcount = av_len(in) + 1;
- SSize_t i;
+ Size_t pcount = av_count(in);
pushJsonbValue(jsonb_state, WJB_BEGIN_ARRAY, NULL);
- for (i = 0; i < pcount; i++)
+ for (Size_t i = 0; i < pcount; i++)
{
SV **value = av_fetch(in, i, FALSE);
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index eba91f2d7d6..8175407849e 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -279,6 +279,7 @@ static void array_to_datum_internal(AV *av, ArrayBuildState **astatep,
int *ndims, int *dims, int cur_depth,
Oid elemtypid, int32 typmod,
FmgrInfo *finfo, Oid typioparam);
+static int av_count_limit(AV *av);
static Datum plperl_hash_to_datum(SV *src, TupleDesc td);
static void plperl_init_shared_libs(pTHX);
@@ -1173,8 +1174,8 @@ get_perl_array_ref(SV *sv)
* is frozen).
*
* Caller is required to have set dims[cur_depth - 1] to the length of the
- * input array, i.e., av_len(av) + 1. We make this requirement so as to
- * avoid reading av_len() twice, which is hazardous for tied arrays.
+ * input array, i.e., av_count_limit(av). We make this requirement so as to
+ * avoid reading av_count() twice, which is hazardous for tied arrays.
*/
static void
array_to_datum_internal(AV *av, ArrayBuildState **astatep,
@@ -1214,11 +1215,11 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep,
errmsg("number of array dimensions exceeds the maximum allowed (%d)",
MAXDIM)));
/* OK, add a dimension */
- dims[*ndims] = av_len(nav) + 1;
+ dims[*ndims] = av_count_limit(nav);
(*ndims)++;
}
else if (cur_depth >= *ndims ||
- av_len(nav) + 1 != dims[cur_depth])
+ av_count_limit(nav) != dims[cur_depth])
ereport(ERROR,
(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
errmsg("multidimensional arrays must have array expressions with matching dimensions")));
@@ -1260,6 +1261,25 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep,
}
}
+/*
+ * av_count returns Size_t, so at least in theory it could overrun INT_MAX.
+ * As long as we have to check, let's throw error for anything above
+ * MaxArraySize, which will surely fail later.
+ */
+static int
+av_count_limit(AV *av)
+{
+ dTHX;
+ Size_t cnt = av_count(av);
+
+ if (cnt > MaxArraySize)
+ ereport(ERROR,
+ (errcode(ERRCODE_PROGRAM_LIMIT_EXCEEDED),
+ errmsg("array size exceeds the maximum allowed (%zu)",
+ MaxArraySize)));
+ return (int) cnt;
+}
+
/*
* convert perl array ref to a datum
*/
@@ -1287,7 +1307,7 @@ plperl_array_to_datum(SV *src, Oid typid, int32 typmod)
_sv_to_datum_finfo(elemtypid, &finfo, &typioparam);
memset(dims, 0, sizeof(dims));
- dims[0] = av_len(nav) + 1;
+ dims[0] = av_count_limit(nav);
array_to_datum_internal(nav, &astate,
&ndims, dims, 1,
@@ -2478,14 +2498,15 @@ plperl_func_handler(PG_FUNCTION_ARGS)
if (sav)
{
dTHX;
- int i = 0;
- SV **svp = 0;
AV *rav = (AV *) SvRV(sav);
+ Size_t alen = av_count(rav);
- while ((svp = av_fetch(rav, i, FALSE)) != NULL)
+ for (Size_t i = 0; i < alen; i++)
{
- plperl_return_next_internal(*svp);
- i++;
+ SV **svp = av_fetch(rav, i, FALSE);
+
+ if (svp)
+ plperl_return_next_internal(*svp);
}
}
else if (SvOK(perlret))
--
2.52.0
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:08 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-17 18:25 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 19:07 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-17 18:25 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
пн, 17 авг. 2026 г. в 23:08, Tom Lane <tgl@sss.pgh.pa.us>:
> Looking a bit more at the issue of standardizing our
> perl-array-scanning code, I noticed that av_len returns SSize_t
> not int, creating an overflow risk since we aren't consistent
> about assigning the result to something wider than int. This
> would only result in truncating the output not anything more
> exciting, but it's still bad. Also, it seems from looking at
> the Perl sources that they prefer to use av_count() to compute
> the loop limit. That's the same as av_len()+1 (except it returns
> Size_t), but I think that's a better habit to be in since it
> removes the risk of forgetting to add 1. So here is a patch
> that just cleans up those issues.
>
> The patch looks good to me.
Apparently av_fetch works as follows:
av_fetch returns SV** pointing to the real array element (for regular
arrays) OR mortal SV (for tied arrays)
- for regular arrays, the returned SV is NOT mortal — it lives in the
array
- for tied arrays, the returned SV MAY be mortal (temporary) because
it's created on the fly as a proxy
Calling SvGETMAGIC is critical because it:
- for regular SV: does nothing
- for magical SV: calls the FETCH method and turns the temporary "proxy"
into a real value.
--
Regards,
Rachitskiy Andrey
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:08 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:25 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-17 19:07 ` Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 0 replies; 29+ messages in thread
From: Tom Lane @ 2026-08-17 19:07 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
>> The patch looks good to me.
Pushed that bit, then.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-17 20:42 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
1 sibling, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-17 20:42 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
I wrote:
> We still have multiple
> patterns for iterating through hashes: why do a couple of places use
> hv_iternextsv when the others don't? And why do we use hek2cstr
> in some places and not others?
Here's a patch to try to clean that up. I think it is wrong that
the extension modules don't use hek2cstr, so I made them do so.
(But we probably shouldn't back-patch that: it's a user-visible
behavioral change and we've not gotten actual field complaints AFAIR.)
> (oh, and for extra credit: why is there a second call of hv_iterinit
> in plperl_build_tuple_result and plperl_modify_tuple?)
That seems to be just cargo-culted, so I removed those calls.
regards, tom lane
Attachments:
[text/x-diff] v1-0001-Make-plperl-s-handling-of-Perl-hashes-more-consis.patch (7.8K, ../../1132241.1786999322@sss.pgh.pa.us/2-v1-0001-Make-plperl-s-handling-of-Perl-hashes-more-consis.patch)
download | inline diff:
From d7b4ef67b382308f4ad3537afa1725acfce35720 Mon Sep 17 00:00:00 2001
From: Tom Lane <tgl@sss.pgh.pa.us>
Date: Mon, 17 Aug 2026 16:38:10 -0400
Subject: [PATCH v1] Make plperl's handling of Perl hashes more consistent.
Make hek2cstr() available in plperl.h, so that it can be used
in hstore_plperl and jsonb_plperl. Those modules were previously
using different coding techniques that probably don't get
conversion from Perl strings to the database encoding quite right.
(I'd prefer to make hek2cstr() non-inline, but cross-extension calls
are messy and plperl has avoided them up to now, so stick with the
existing approach.)
Consistently use hv_iternext, hek2cstr, and HeVAL for hash iterations,
with one exception in plperl_trusted_init: there, hv_iternextsv is
fine since we don't actually care about the hash keys. (A later
patch will remove the HeVAL calls again, but for now we just want
consistency.)
Remove unnecessary extra calls of hv_iterinit.
Remove duplicative pstrdup's in plperl_to_hstore.
Author: Tom Lane <tgl@sss.pgh.pa.us>
Discussion: https://postgr.es/m/569769.1786901901@sss.pgh.pa.us
Backpatch-through: 14
---
contrib/hstore_plperl/hstore_plperl.c | 6 +--
contrib/jsonb_plperl/jsonb_plperl.c | 13 +++---
src/pl/plperl/plperl.c | 59 +--------------------------
src/pl/plperl/plperl.h | 55 +++++++++++++++++++++++++
4 files changed, 66 insertions(+), 67 deletions(-)
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index d7f1b8ddb48..91dc0771fab 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -137,7 +137,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
i = 0;
while ((he = hv_iternext(hv)))
{
- char *key = sv2cstr(HeSVKEY_force(he));
+ char *key = hek2cstr(he);
SV *value = HeVAL(he);
if (i >= pcount)
@@ -146,7 +146,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
pairs = repalloc_array(pairs, Pairs, pcount);
}
- pairs[i].key = pstrdup(key);
+ pairs[i].key = key;
pairs[i].keylen = hstoreCheckKeyLen(strlen(pairs[i].key));
pairs[i].needfree = true;
@@ -158,7 +158,7 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
}
else
{
- pairs[i].val = pstrdup(sv2cstr(value));
+ pairs[i].val = sv2cstr(value);
pairs[i].vallen = hstoreCheckValLen(strlen(pairs[i].val));
pairs[i].isnull = false;
}
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index 00a99d303c6..b43101bd5a6 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -155,9 +155,7 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state)
{
dTHX;
JsonbValue key;
- SV *val;
- char *kstr;
- I32 klen;
+ HE *he;
key.type = jbvString;
@@ -165,10 +163,13 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state)
(void) hv_iterinit(obj);
- while ((val = hv_iternextsv(obj, &kstr, &klen)))
+ while ((he = hv_iternext(obj)))
{
- key.val.string.val = pnstrdup(kstr, klen);
- key.val.string.len = klen;
+ char *k = hek2cstr(he);
+ SV *val = HeVAL(he);
+
+ key.val.string.val = k;
+ key.val.string.len = strlen(k);
pushJsonbValue(jsonb_state, WJB_KEY, &key);
SV_to_JsonbValue(val, jsonb_state, false);
}
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index 8175407849e..ab1c60a0022 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -288,7 +288,6 @@ static void plperl_untrusted_init(void);
static HV *plperl_spi_execute_fetch_result(SPITupleTable *tuptable,
uint64 processed, int status);
static void plperl_return_next_internal(SV *sv);
-static char *hek2cstr(HE *he);
static SV **hv_store_string(HV *hv, const char *key, SV *val);
static SV **hv_fetch_string(HV *hv, const char *key);
static void plperl_create_sub(plperl_proc_desc *prodesc, const char *s,
@@ -322,60 +321,6 @@ SvREFCNT_dec_current(SV *sv)
SvREFCNT_dec(sv);
}
-/*
- * convert a HE (hash entry) key to a cstr in the current database encoding
- */
-static char *
-hek2cstr(HE *he)
-{
- dTHX;
- char *ret;
- SV *sv;
-
- /*
- * HeSVKEY_force will return a temporary mortal SV*, so we need to make
- * sure to free it with ENTER/SAVE/FREE/LEAVE
- */
- ENTER;
- SAVETMPS;
-
- /*-------------------------
- * Unfortunately, while HeUTF8 is true for most things > 256, for values
- * 128..255 it's not, but perl will treat them as unicode code points if
- * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
- * for more)
- *
- * So if we did the expected:
- * if (HeUTF8(he))
- * utf_u2e(key...);
- * else // must be ascii
- * return HePV(he);
- * we won't match columns with codepoints from 128..255
- *
- * For a more concrete example given a column with the name of the unicode
- * codepoint U+00ae (registered sign) and a UTF8 database and the perl
- * return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
- * 0 and HePV() would give us a char * with 1 byte contains the decimal
- * value 174
- *
- * Perl has the brains to know when it should utf8 encode 174 properly, so
- * here we force it into an SV so that perl will figure it out and do the
- * right thing
- *-------------------------
- */
-
- sv = HeSVKEY_force(he);
- if (HeUTF8(he))
- SvUTF8_on(sv);
- ret = sv2cstr(sv);
-
- /* free sv */
- FREETMPS;
- LEAVE;
-
- return ret;
-}
-
/*
* _PG_init() - library load-time initialization
@@ -1093,8 +1038,8 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td)
hv_iterinit(perlhash);
while ((he = hv_iternext(perlhash)))
{
- SV *val = HeVAL(he);
char *key = hek2cstr(he);
+ SV *val = HeVAL(he);
int attn = SPI_fnumber(td, key);
Form_pg_attribute attr;
@@ -1120,7 +1065,6 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td)
pfree(key);
}
- hv_iterinit(perlhash);
tup = heap_form_tuple(td, values, nulls);
pfree(values);
@@ -1857,7 +1801,6 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
pfree(key);
}
- hv_iterinit(hvNew);
rtup = heap_modify_tuple(otup, tupdesc, modvalues, modnulls, modrepls);
diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h
index 4c03f9e0df6..33180b16b6e 100644
--- a/src/pl/plperl/plperl.h
+++ b/src/pl/plperl/plperl.h
@@ -163,6 +163,61 @@ cstr2sv(const char *str)
return sv;
}
+/*
+ * Convert a HE (hash entry) key to a cstr in the current database encoding.
+ * The result is palloc'd.
+ */
+static inline char *
+hek2cstr(HE *he)
+{
+ dTHX;
+ char *ret;
+ SV *sv;
+
+ /*
+ * HeSVKEY_force will return a temporary mortal SV*, so we need to make
+ * sure to free it with ENTER/SAVE/FREE/LEAVE
+ */
+ ENTER;
+ SAVETMPS;
+
+ /*-------------------------
+ * Unfortunately, while HeUTF8 is true for most things > 256, for values
+ * 128..255 it's not, but perl will treat them as unicode code points if
+ * the utf8 flag is not set ( see The "Unicode Bug" in perldoc perlunicode
+ * for more)
+ *
+ * So if we did the expected:
+ * if (HeUTF8(he))
+ * utf_u2e(key...);
+ * else // must be ascii
+ * return HePV(he);
+ * we won't match columns with codepoints from 128..255
+ *
+ * For a more concrete example given a column with the name of the unicode
+ * codepoint U+00ae (registered sign) and a UTF8 database and the perl
+ * return_next { "\N{U+00ae}=>'text } would always fail as heUTF8 returns
+ * 0 and HePV() would give us a char * with 1 byte contains the decimal
+ * value 174
+ *
+ * Perl has the brains to know when it should utf8 encode 174 properly, so
+ * here we force it into an SV so that perl will figure it out and do the
+ * right thing
+ *-------------------------
+ */
+
+ sv = HeSVKEY_force(he);
+ if (HeUTF8(he))
+ SvUTF8_on(sv);
+ ret = sv2cstr(sv);
+
+ /* free sv */
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+}
+
/*
* croak() with specified message, which is given in the database encoding.
*
--
2.52.0
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-18 05:27 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 1 reply; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-18 05:27 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Hi, Tom!
> Here's a patch to try to clean that up. I think it is wrong that
> the extension modules don't use hek2cstr, so I made them do so.
> (But we probably shouldn't back-patch that: it's a user-visible
> behavioral change and we've not gotten actual field complaints AFAIR.)
>
Agreed
path looks good for me
> > (oh, and for extra credit: why is there a second call of hv_iterinit
> > in plperl_build_tuple_result and plperl_modify_tuple?)
>
> That seems to be just cargo-culted, so I removed those calls.
>
hv_iterinit is good practice to clean up the iterator state, but here it's
redundant and misleading.
--
Regards,
Rachitskiy Andrey
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-18 11:58 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 15:17 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 21:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
0 siblings, 2 replies; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-18 11:58 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
вт, 18 авг. 2026 г. в 10:27, Andrey Rachitskiy <pl0h0yp1@gmail.com>:
>
> Hi, Tom!
>
>> Here's a patch to try to clean that up. I think it is wrong that
>> the extension modules don't use hek2cstr, so I made them do so.
>> (But we probably shouldn't back-patch that: it's a user-visible
>> behavioral change and we've not gotten actual field complaints AFAIR.)
>>
>
> Agreed
> path looks good for me
>
>
>
Tom, I've put together a SvGETMAGIC version on top of your last patch.
Thoughts?
--
Regards,
Rachitskiy Andrey
Attachments:
[text/x-patch] after-hash-cleanup_add_svgetmagic.patch (6.2K, ../../CAB8bMivHNm5ySE_krD7KfKsCzA_7FpDppwypf0bz5oeQ+VKz7Q@mail.gmail.com/3-after-hash-cleanup_add_svgetmagic.patch)
download | inline diff:
From: Andrey Rachitskiy <pl0h0yp1@gmail.com>
Subject: [PATCH v4 2/3] Honor Perl FETCH for tied hashes and arrays
After the hash-iteration cleanup, replace HeVAL() with hv_iterval()
so tied hash values run FETCH. Call SvGETMAGIC via
plperl_materialize_sv() at conversion entry, before SvOK/SvROK.
diff --git a/contrib/hstore_plperl/hstore_plperl.c b/contrib/hstore_plperl/hstore_plperl.c
index 6665300d6d8..3ef40466022 100644
--- a/contrib/hstore_plperl/hstore_plperl.c
+++ b/contrib/hstore_plperl/hstore_plperl.c
@@ -138,7 +138,9 @@ plperl_to_hstore(PG_FUNCTION_ARGS)
while ((he = hv_iternext(hv)))
{
char *key = hek2cstr(he);
- SV *value = HeVAL(he);
+ SV *value = hv_iterval(hv, he);
+
+ plperl_materialize_sv(value);
if (i >= pcount)
{
diff --git a/contrib/jsonb_plperl/jsonb_plperl.c b/contrib/jsonb_plperl/jsonb_plperl.c
index b43101bd5a6..07584654e2b 100644
--- a/contrib/jsonb_plperl/jsonb_plperl.c
+++ b/contrib/jsonb_plperl/jsonb_plperl.c
@@ -166,7 +166,7 @@ HV_to_JsonbValue(HV *obj, JsonbInState *jsonb_state)
while ((he = hv_iternext(obj)))
{
char *k = hek2cstr(he);
- SV *val = HeVAL(he);
+ SV *val = hv_iterval(obj, he);
key.val.string.val = k;
key.val.string.len = strlen(k);
@@ -186,6 +186,8 @@ SV_to_JsonbValue(SV *in, JsonbInState *jsonb_state, bool is_elem)
/* this can recurse via AV_to_JsonbValue() or HV_to_JsonbValue() */
check_stack_depth();
+ plperl_materialize_sv(in);
+
/* Dereference references recursively. */
while (SvROK(in))
{
diff --git a/src/pl/plperl/plperl.c b/src/pl/plperl/plperl.c
index ab1c60a0022..aaaaaaaaaaa 100644
--- a/src/pl/plperl/plperl.c
+++ b/src/pl/plperl/plperl.c
@@ -1039,7 +1039,7 @@ plperl_build_tuple_result(HV *perlhash, TupleDesc td)
while ((he = hv_iternext(perlhash)))
{
char *key = hek2cstr(he);
- SV *val = HeVAL(he);
+ SV *val = hv_iterval(perlhash, he);
int attn = SPI_fnumber(td, key);
Form_pg_attribute attr;
@@ -1084,11 +1084,17 @@ plperl_hash_to_datum(SV *src, TupleDesc td)
* if we are an array ref return the reference. this is special in that if we
* are a PostgreSQL::InServer::ARRAY object we will return the 'magic' array.
+ *
+ * The caller must already have invoked plperl_materialize_sv() on sv.
+ * sv may be NULL.
*/
static SV *
get_perl_array_ref(SV *sv)
{
dTHX;
+ if (!sv)
+ return NULL;
+
if (SvOK(sv) && SvROK(sv))
{
if (SvTYPE(SvRV(sv)) == SVt_PVAV)
@@ -1099,9 +1105,13 @@ get_perl_array_ref(SV *sv)
HV *hv = (HV *) SvRV(sv);
SV **sav = hv_fetch_string(hv, "array");
- if (sav && *sav && SvOK(*sav) && SvROK(*sav) &&
- SvTYPE(SvRV(*sav)) == SVt_PVAV)
- return *sav;
+ if (sav && *sav)
+ {
+ plperl_materialize_sv(*sav);
+ if (SvOK(*sav) && SvROK(*sav) &&
+ SvTYPE(SvRV(*sav)) == SVt_PVAV)
+ return *sav;
+ }
elog(ERROR, "could not get array reference from PostgreSQL::InServer::ARRAY object");
}
@@ -1135,9 +1145,11 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep,
{
/* fetch the array element */
SV **svp = av_fetch(av, i, FALSE);
+ SV *elem = svp ? *svp : NULL;
+ SV *sav;
- /* see if this element is an array, if so get that */
- SV *sav = svp ? get_perl_array_ref(*svp) : NULL;
+ plperl_materialize_sv(elem);
+ sav = get_perl_array_ref(elem);
/* multi-dimensional array? */
if (sav)
@@ -1185,13 +1197,13 @@ array_to_datum_internal(AV *av, ArrayBuildState **astatep,
(errcode(ERRCODE_INVALID_TEXT_REPRESENTATION),
errmsg("multidimensional arrays must have array expressions with matching dimensions")));
- dat = plperl_sv_to_datum(svp ? *svp : NULL,
- elemtypid,
- typmod,
- NULL,
- finfo,
- typioparam,
- &isnull);
+ dat = plperl_sv_to_datum(elem,
+ elemtypid,
+ typmod,
+ NULL,
+ finfo,
+ typioparam,
+ &isnull);
/* Create ArrayBuildState if we didn't already */
if (*astatep == NULL)
@@ -1301,6 +1313,8 @@ plperl_sv_to_datum(SV *sv, Oid typid, int32 typmod,
FmgrInfo tmp;
Oid funcid;
+ plperl_materialize_sv(sv);
+
/* we might recurse */
check_stack_depth();
@@ -1751,6 +1765,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
ereport(ERROR,
(errcode(ERRCODE_UNDEFINED_COLUMN),
errmsg("$_TD->{new} does not exist")));
+ plperl_materialize_sv(*svp);
if (!SvOK(*svp) || !SvROK(*svp) || SvTYPE(SvRV(*svp)) != SVt_PVHV)
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
@@ -1768,7 +1783,7 @@ plperl_modify_tuple(HV *hvTD, TriggerData *tdata, HeapTuple otup)
while ((he = hv_iternext(hvNew)))
{
char *key = hek2cstr(he);
- SV *val = HeVAL(he);
+ SV *val = hv_iterval(hvNew, he);
int attn = SPI_fnumber(tupdesc, key);
Form_pg_attribute attr;
@@ -2437,6 +2452,7 @@ plperl_func_handler(PG_FUNCTION_ARGS)
* SRFs that didn't know about return_next(). Any other sort of return
* value is an error, except undef which means return an empty set.
*/
+ plperl_materialize_sv(perlret);
sav = get_perl_array_ref(perlret);
if (sav)
{
@@ -2537,6 +2553,8 @@ plperl_trigger_handler(PG_FUNCTION_ARGS)
if (SPI_finish() != SPI_OK_FINISH)
elog(ERROR, "SPI_finish() failed");
+ plperl_materialize_sv(perlret);
+
if (perlret == NULL || !SvOK(perlret))
{
/* undef result means go ahead with original tuple */
@@ -3335,6 +3353,7 @@ plperl_return_next_internal(SV *sv)
{
HeapTuple tuple;
+ plperl_materialize_sv(sv);
if (!(SvOK(sv) && SvROK(sv) && SvTYPE(SvRV(sv)) == SVt_PVHV))
ereport(ERROR,
(errcode(ERRCODE_DATATYPE_MISMATCH),
diff --git a/src/pl/plperl/plperl.h b/src/pl/plperl/plperl.h
index 33180b16b6e..bbbbbbbbbbb 100644
--- a/src/pl/plperl/plperl.h
+++ b/src/pl/plperl/plperl.h
@@ -163,9 +163,24 @@ cstr2sv(const char *str)
return sv;
}
+/*
+ * Invoke SvGETMAGIC before SvOK/SvROK. Tied scalars stay magical.
+ * A second call on the same SV re-runs FETCH.
+ */
+static inline void
+plperl_materialize_sv(SV *sv)
+{
+ dTHX;
+
+ if (sv)
+ SvGETMAGIC(sv);
+}
+
/*
* Convert a HE (hash entry) key to a cstr in the current database encoding.
* The result is palloc'd.
+ *
+ * Uses FREETMPS, so call this before hv_iterval() if both are needed.
*/
static inline char *
hek2cstr(HE *he)
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-18 15:17 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 15:48 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
1 sibling, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-18 15:17 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
> Tom, I've put together a SvGETMAGIC version on top of your last patch.
> Thoughts?
I've not read the whole thing, but I noticed
/*
* Convert a HE (hash entry) key to a cstr in the current database encoding.
* The result is palloc'd.
+ *
+ * Uses FREETMPS, so call this before hv_iterval() if both are needed.
*/
static inline char *
hek2cstr(HE *he)
and you had a similar comment in your earlier draft. I think this is
nonsense though. hek2cstr does the full ENTER; SAVETMPS; FREETMPS;
LEAVE; dance, so unless I totally misunderstand that API, it's
destroying only its own temps not any pre-existing ones. Also,
if there actually is an ordering dependency there, how is the existing
coding working (where the two callers of hek2cstr do so in randomly
different orders?) I changed that ordering in my patch only for
cosmetic reasons, not because I expect it to make a difference.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 15:17 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-18 15:48 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 0 replies; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-18 15:48 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
вт, 18 авг. 2026 г. в 20:17, Tom Lane <tgl@sss.pgh.pa.us>:
> I've not read the whole thing, but I noticed
>
> /*
> * Convert a HE (hash entry) key to a cstr in the current database
> encoding.
> * The result is palloc'd.
> + *
> + * Uses FREETMPS, so call this before hv_iterval() if both are needed.
> */
> static inline char *
> hek2cstr(HE *he)
>
> and you had a similar comment in your earlier draft. I think this is
> nonsense though. hek2cstr does the full ENTER; SAVETMPS; FREETMPS;
> LEAVE; dance, so unless I totally misunderstand that API, it's
> destroying only its own temps not any pre-existing ones. Also,
> if there actually is an ordering dependency there, how is the existing
> coding working (where the two callers of hek2cstr do so in randomly
> different orders?) I changed that ordering in my patch only for
> cosmetic reasons, not because I expect it to make a difference.
>
You are right. The comment can be dropped.
I had read FREETMPS as discarding every mortal in sight. It does not.
SAVETMPS records the current index on the temp stack. FREETMPS only drops
SVs pushed after that mark. The nested ENTER/SAVETMPS/FREETMPS/LEAVE in
hek2cstr() therefore frees the mortal from HeSVKEY_force(), and nothing
that the caller already held.
--
Regards,
Rachitskiy Andrey
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
@ 2026-08-18 21:58 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:09 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
1 sibling, 1 reply; 29+ messages in thread
From: Tom Lane @ 2026-08-18 21:58 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
Andrey Rachitskiy <pl0h0yp1@gmail.com> writes:
>>> Here's a patch to try to clean that up. I think it is wrong that
>>> the extension modules don't use hek2cstr, so I made them do so.
>>> (But we probably shouldn't back-patch that: it's a user-visible
>>> behavioral change and we've not gotten actual field complaints AFAIR.)
>> Agreed
>> path looks good for me
OK, applied that to HEAD only. I've been dithering about how much
behavioral change we want to put into the back branches, and have
gotten cold feet about changing anything we don't clearly have to;
particularly in v14 whose next release will be its last. So what
I've done is to back-patch a fix for just the null-pointer dereference
problems (see c0641ae4e and siblings). The hek2cstr change and
hash-usage consistency fixes went into HEAD only, and I'm intending
the same for the fixes to allow fetching from tied arrays/hashes.
I'd possibly be more excited about treating those as back-patch
material, if we'd had more than zero complaints about plperl not
working with tied objects. But we haven't AFAIR, and there might
even be someone who's surprised if it starts to work.
I plan to study your patch more closely tomorrow.
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 21:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-19 18:09 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:22 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-09-30 16:17 ` Re: Residual cleanups for tied objects in PL/Perl Kirill Reshke <reshkekirill@gmail.com>
0 siblings, 2 replies; 29+ messages in thread
From: Tom Lane @ 2026-08-19 18:09 UTC (permalink / raw)
To: Andrey Rachitskiy <pl0h0yp1@gmail.com>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
I wrote:
> I plan to study your patch more closely tomorrow.
Pushed after some mostly-cosmetic fiddling, and I incorporated
your test cases from upthread. Thanks for working on this!
regards, tom lane
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 21:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:09 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-08-19 18:22 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
1 sibling, 0 replies; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-08-19 18:22 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
ср, 19 авг. 2026 г. в 23:09, Tom Lane <tgl@sss.pgh.pa.us>:
> Pushed after some mostly-cosmetic fiddling, and I incorporated
> your test cases from upthread. Thanks for working on this!
>
>
Dear Tom,
I would like to express my sincere gratitude. Thank you for the review and
merging.
It is a great honor to work with you and have the opportunity to learn from
such a professional.
This is an invaluable experience.
--
Regards,
Rachitskiy Andrey
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 21:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:09 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
@ 2026-09-30 16:17 ` Kirill Reshke <reshkekirill@gmail.com>
2026-09-30 18:35 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
1 sibling, 1 reply; 29+ messages in thread
From: Kirill Reshke @ 2026-09-30 16:17 UTC (permalink / raw)
To: Tom Lane <tgl@sss.pgh.pa.us>; +Cc: Andrey Rachitskiy <pl0h0yp1@gmail.com>; andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
On Wed, 19 Aug 2026 at 23:10, Tom Lane <tgl@sss.pgh.pa.us> wrote:
>
> I wrote:
> > I plan to study your patch more closely tomorrow.
>
> Pushed after some mostly-cosmetic fiddling, and I incorporated
> your test cases from upthread. Thanks for working on this!
>
> regards, tom lane
>
HI!
I was running some random fuzzing recently, and I bumped into another
related issue. Not sure if this is worth fixing, but maybe it is worth
reporting. No modules required. A trusted plperl function that returns
a SETOF result as a tied array whose class does not implement
FETCHSIZE exits. Fails on current master 1f7013fe089 and 19beta4
b73d13c32c8.
CREATE EXTENSION plperl;
CREATE OR REPLACE FUNCTION pl_mf_tr() RETURNS SETOF int LANGUAGE plperl AS $$
package MF;
sub TIEARRAY { my $c = shift; bless { }, $c }
sub FETCH { 42 }
my @a; tie @a, 'MF';
return \@a;
$$;
SELECT count(*) FROM pl_mf_tr();
Breakpoint 1, __GI_exit (status=255) at ./stdlib/exit.c:137
warning: 137 ./stdlib/exit.c: No such file or directory
(gdb) bt
#0 __GI_exit (status=255) at ./stdlib/exit.c:137
#1 0x0000713157470bef in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#2 0x0000713157470cc6 in Perl_my_failure_exit () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#3 0x000071315756cef3 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#4 0x00007131574fd71b in Perl_croak_sv () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#5 0x00007131574fd72d in Perl_die_sv () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#6 0x000071315757b0b0 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#7 0x000071315751ec7e in Perl_runops_standard () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#8 0x00007131574691af in Perl_call_sv () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#9 0x00007131574fa38a in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#10 0x00007131574fd763 in Perl_vcroak () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#11 0x00007131574fe2ea in Perl_croak () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#12 0x0000713157478eff in Perl_gv_fetchmethod_pvn_flags () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#13 0x00007131574790fc in Perl_gv_fetchmethod_sv_flags () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#14 0x000071315752f7a7 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#15 0x000071315751ec7e in Perl_runops_standard () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#16 0x00007131574691af in Perl_call_sv () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#17 0x0000713157504368 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#18 0x0000713157504733 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
#19 0x00007131575019f8 in Perl_mg_size () from
/lib/x86_64-linux-gnu/libperl.so.5.38
#20 0x00007131643797ce in Perl_av_count (av=0x5d7778b83290,
my_perl=0x5d7778b49cf0) at
/usr/lib/x86_64-linux-gnu/perl/5.38/CORE/inline.h:61
#21 Perl_av_count (av=0x5d7778b83290, my_perl=0x5d7778b49cf0) at
/usr/lib/x86_64-linux-gnu/perl/5.38/CORE/inline.h:56
#22 plperl_func_handler (fcinfo=<optimized out>) at plperl.c:2461
#23 plperl_call_handler (fcinfo=0x5d7778c26630) at plperl.c:1864
--
Best regards,
Kirill Reshke
^ permalink raw reply [nested|flat] 29+ messages in thread
* Re: Residual cleanups for tied objects in PL/Perl
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Re: Residual cleanups for tied objects in PL/Perl Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 21:58 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:09 ` Re: Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-09-30 16:17 ` Re: Residual cleanups for tied objects in PL/Perl Kirill Reshke <reshkekirill@gmail.com>
@ 2026-09-30 18:35 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
0 siblings, 0 replies; 29+ messages in thread
From: Andrey Rachitskiy @ 2026-09-30 18:35 UTC (permalink / raw)
To: Kirill Reshke <reshkekirill@gmail.com>; +Cc: Tom Lane <tgl@sss.pgh.pa.us>; andrew@dunslane.net; pgsql-hackers@lists.postgresql.org
ср, 30 сент. 2026 г. в 21:18, Kirill Reshke <reshkekirill@gmail.com>:
> On Wed, 19 Aug 2026 at 23:10, Tom Lane <tgl@sss.pgh.pa.us> wrote:
> >
> > I wrote:
> > > I plan to study your patch more closely tomorrow.
> >
> > Pushed after some mostly-cosmetic fiddling, and I incorporated
> > your test cases from upthread. Thanks for working on this!
> >
> > regards, tom lane
> >
>
>
> HI!
> I was running some random fuzzing recently, and I bumped into another
> related issue. Not sure if this is worth fixing, but maybe it is worth
> reporting. No modules required. A trusted plperl function that returns
> a SETOF result as a tied array whose class does not implement
> FETCHSIZE exits. Fails on current master 1f7013fe089 and 19beta4
> b73d13c32c8.
>
>
> CREATE EXTENSION plperl;
>
> CREATE OR REPLACE FUNCTION pl_mf_tr() RETURNS SETOF int LANGUAGE plperl AS
> $$
> package MF;
> sub TIEARRAY { my $c = shift; bless { }, $c }
> sub FETCH { 42 }
> my @a; tie @a, 'MF';
> return \@a;
> $$;
>
> SELECT count(*) FROM pl_mf_tr();
>
>
> Breakpoint 1, __GI_exit (status=255) at ./stdlib/exit.c:137
> warning: 137 ./stdlib/exit.c: No such file or directory
> (gdb) bt
> #0 __GI_exit (status=255) at ./stdlib/exit.c:137
> #1 0x0000713157470bef in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #2 0x0000713157470cc6 in Perl_my_failure_exit () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #3 0x000071315756cef3 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #4 0x00007131574fd71b in Perl_croak_sv () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #5 0x00007131574fd72d in Perl_die_sv () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #6 0x000071315757b0b0 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #7 0x000071315751ec7e in Perl_runops_standard () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #8 0x00007131574691af in Perl_call_sv () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #9 0x00007131574fa38a in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #10 0x00007131574fd763 in Perl_vcroak () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #11 0x00007131574fe2ea in Perl_croak () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #12 0x0000713157478eff in Perl_gv_fetchmethod_pvn_flags () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #13 0x00007131574790fc in Perl_gv_fetchmethod_sv_flags () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #14 0x000071315752f7a7 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #15 0x000071315751ec7e in Perl_runops_standard () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #16 0x00007131574691af in Perl_call_sv () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #17 0x0000713157504368 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #18 0x0000713157504733 in ?? () from /lib/x86_64-linux-gnu/libperl.so.5.38
> #19 0x00007131575019f8 in Perl_mg_size () from
> /lib/x86_64-linux-gnu/libperl.so.5.38
> #20 0x00007131643797ce in Perl_av_count (av=0x5d7778b83290,
> my_perl=0x5d7778b49cf0) at
> /usr/lib/x86_64-linux-gnu/perl/5.38/CORE/inline.h:61
> #21 Perl_av_count (av=0x5d7778b83290, my_perl=0x5d7778b49cf0) at
> /usr/lib/x86_64-linux-gnu/perl/5.38/CORE/inline.h:56
> #22 plperl_func_handler (fcinfo=<optimized out>) at plperl.c:2461
> #23 plperl_call_handler (fcinfo=0x5d7778c26630) at plperl.c:1864
>
>
>
> --
> Best regards,
> Kirill Reshke
>
Hi, Kirill!
I, Tom, and the security team are aware of it. I found this a while ago. I
proposed a patch on how to close this issue (the sec team may have their
own solution). I think the issue will be resolved in the near future.
--
Regards,
Rachitskiy Andrey
^ permalink raw reply [nested|flat] 29+ messages in thread
end of thread, other threads:[~2026-09-30 18:35 UTC | newest]
Thread overview: 29+ messages (download: mbox mbox.gz follow: Atom feed)
-- links below jump to the message on this page --
2026-08-16 17:38 Residual cleanups for tied objects in PL/Perl Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 18:47 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-16 19:04 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:10 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-17 18:44 ` Andrew Dunstan <andrew@dunslane.net>
2026-08-17 18:58 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 20:08 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 20:26 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-16 21:40 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-16 22:24 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 06:05 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 15:41 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 16:49 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 17:21 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:26 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 17:58 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:08 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 18:25 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-17 19:07 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-17 20:42 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 05:27 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 11:58 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 15:17 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-18 15:48 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-08-18 21:58 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:09 ` Tom Lane <tgl@sss.pgh.pa.us>
2026-08-19 18:22 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
2026-09-30 16:17 ` Kirill Reshke <reshkekirill@gmail.com>
2026-09-30 18:35 ` Andrey Rachitskiy <pl0h0yp1@gmail.com>
This inbox is served by DDX for PostgreSQL; see mirroring instructions
for how to clone and mirror all data and code used for this inbox