vndb/fu
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

json_parse()/pgtypes: Fix accidental creation of read-only array/hash values

Browse source 
&PL_sv_* shouldn't be used when constructing arrays or hashes in this
context.
This commit is contained in:
Yorhel 2025-04-28 10:20:53 +02:00
parent 817fa600d0
commit d0c5397e2d
8 changed files with 45 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

8
t/json_parse.t
View file

@ -2,7 +2,7 @@ use v5.36;
use Test::More;
use FU::Util 'json_parse';
no warnings 'experimental::builtin';
use builtin 'is_bool', 'created_as_number';
use builtin 'is_bool', 'created_as_number', 'true', 'false';
use Config;
my @error = (
@ -236,4 +236,10 @@ ok !eval { json_parse '{"":{"":{"":{"":1}}}}', max_depth => 4; 1 };
ok !eval { json_parse '"string"', max_size => 7 };
}
# Mutable hashes/arrays
my $d = json_parse('[true,false,null,{"a":true,"b":false,"c":null}]');
is_deeply $d, [true,false,undef,{a => true, b => false, c => undef}];
$_ = 1 for @{$d}[0,1,2], values $d->[3]->%*;
is_deeply $d, [1,1,1,{a => 1, b => 1, c => 1}];
done_testing;

1
t/pgconnect.t
View file

@ -197,6 +197,7 @@ subtest '$st->kvv', sub {
is_deeply $conn->q('SELECT 1 WHERE false')->kvv, {};
is_deeply $conn->q('SELECT 1')->kvv, {1=>1};
is_deeply $conn->q('SELECT 1, null UNION ALL SELECT 3, 2')->kvv, {1=>undef,3=>2};
$conn->q('SELECT 1')->kvv->{1} = 0;
};
subtest '$st->kva', sub {

7
t/pgtypes-dynamic.t
View file

@ -96,10 +96,15 @@ subtest 'custom types', sub {
);
_
is_deeply $txn->q(q{SELECT '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'::fupg_test_table[]})->val, [
$val = $txn->q(q{SELECT '{"(\"(2,{},bb)\",)","(\"(,,)\",bb)"}'::fupg_test_table[]})->val;
is_deeply $val, [
{ rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef },
{ rec => { a => undef, aenum => undef, domain => undef }, dom => 'bb' },
];
$val->[0] = 0;
$val->[1]{rec}{a} = 0;
$val->[1]{rec} = 0;
$val->[1]{dom} = 0;
is $txn->q('SELECT $1::fupg_test_table[]', [
{ rec => { a => 2, aenum => [], domain => 'bb' }, dom => undef },

16
t/pgtypes.t
View file

@ -21,10 +21,12 @@ sub v($type, $p_in, @args) {
my $test = "$type $s_in" =~ s/\n/\\n/rg;
utf8::encode($test);
{
my $res = $conn->q("SELECT \$1::$type", $s_in)->text_params->val;
my $array = $conn->q("SELECT \$1::$type", $s_in)->text_params->flat;
my $res = $array->[0];
ok is_bool($res), "$test is bool" if $type eq 'bool';
ok created_as_number($res), "$test is number" if $type =~ /^(int|float)\d/;
is_deeply $res, $p_out, "$test text->bin";
$array->[0] = 0; # Must be writable
}
{
my $res = $conn->q("SELECT \$1::$type", $p_in)->text_results->val;
@ -41,7 +43,11 @@ sub f($type, $p_in) {
ok !eval { $conn->q("SELECT \$1::$type", $p_in)->val; 1 }, "$test fail";
}
ok !defined $conn->q('SELECT pg_sleep(0)')->val; # void
{ # void
my $array = $conn->q('SELECT pg_sleep(0)')->flat;
ok !defined $array->[0];
$array->[0] = 0;
}
v bool => true, undef, 1, 't';
v bool => false, undef, 0, 'f';
@ -166,4 +172,10 @@ is $conn->q('SELECT ($1::int2[])[2]', [1,2,3,4])->val, 2;
is $conn->q('SELECT ($1::int2vector)[1]', [1,2,3,4])->val, 2;
is $conn->q('SELECT ($1::oidvector)[1]', [1,2,3,4])->val, 2;
{
my $v = $conn->q("SELECT '{t,f,NULL}'::bool[]")->val;
is_deeply $v, [true, false, undef];
$_ = 0 for @$v;
}
done_testing;